Code covered by the BSD License  

Highlights from
slatec

from slatec by Ben Barrowes
The slatec library converted into matlab functions.

[ix,iy,n,kflag]=isort(ix,iy,n,kflag);
function [ix,iy,n,kflag]=isort(ix,iy,n,kflag);
%***BEGIN PROLOGUE  ISORT
%***PURPOSE  Sort an array and optionally make the same interchanges in
%            an auxiliary array.  The array may be sorted in increasing
%            or decreasing order.  A slightly modified QUICKSORT
%            algorithm is used.
%***LIBRARY   SLATEC
%***CATEGORY  N6A2A
%***TYPE      INTEGER (SSORT-S, DSORT-D, ISORT-I)
%***KEYWORDS  SINGLETON QUICKSORT, SORT, SORTING
%***AUTHOR  Jones, R. E., (SNLA)
%           Kahaner, D. K., (NBS)
%           Wisniewski, J. A., (SNLA)
%***DESCRIPTION
%
%   ISORT sorts array IX and optionally makes the same interchanges in
%   array IY.  The array IX may be sorted in increasing order or
%   decreasing order.  A slightly modified quicksort algorithm is used.
%
%   Description of Parameters
%      IX - integer array of values to be sorted
%      IY - integer array to be (optionally) carried along
%      N  - number of values in integer array IX to be sorted
%      KFLAG - control parameter
%            =  2  means sort IX in increasing order and carry IY along.
%            =  1  means sort IX in increasing order (ignoring IY)
%            = -1  means sort IX in decreasing order (ignoring IY)
%            = -2  means sort IX in decreasing order and carry IY along.
%
%***REFERENCES  R. C. Singleton, Algorithm 347, An efficient algorithm
%                 for sorting with minimal storage, Communications of
%                 the ACM, 12, 3 (1969), pp. 185-187.
%***ROUTINES CALLED  XERMSG
%***REVISION HISTORY  (YYMMDD)
%   761118  DATE WRITTEN
%   810801  Modified by David K. Kahaner.
%   890531  Changed all specific intrinsics to generic.  (WRB)
%   890831  Modified array declarations.  (WRB)
%   891009  Removed unreferenced statement labels.  (WRB)
%   891009  REVISION DATE from Version 3.2
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
%   901012  Declared all variables; changed X,Y to IX,IY. (M. McClain)
%   920501  Reformatted the REFERENCES section.  (DWL, WRB)
%   920519  Clarified error messages.  (DWL)
%   920801  Declarations section rebuilt and code restructured to use
%           IF-THEN-ELSE-ENDIF.  (RWC, WRB)
%***end PROLOGUE  ISORT
%     .. Scalar Arguments ..
persistent gt i ij il iu j k kk l m nn r t tt tty ty ; 

if isempty(gt), gt=zeros(1,3); end;
%     .. Array Arguments ..
ix_shape=size(ix);ix=reshape(ix,1,[]);
iy_shape=size(iy);iy=reshape(iy,1,[]);
%     .. Local Scalars ..
if isempty(r), r=0; end;
if isempty(i), i=0; end;
if isempty(ij), ij=0; end;
if isempty(j), j=0; end;
if isempty(k), k=0; end;
if isempty(kk), kk=0; end;
if isempty(l), l=0; end;
if isempty(m), m=0; end;
if isempty(nn), nn=0; end;
if isempty(t), t=0; end;
if isempty(tt), tt=0; end;
if isempty(tty), tty=0; end;
if isempty(ty), ty=0; end;
%     .. Local Arrays ..
if isempty(il), il=zeros(1,21); end;
if isempty(iu), iu=zeros(1,21); end;
%     .. External Subroutines ..
%     .. Intrinsic Functions ..
%***FIRST EXECUTABLE STATEMENT  ISORT
nn = fix(n);
if( nn<1 )
xermsg('SLATEC','ISORT','The number of values to be sorted is not positive.',1,1);
ix_shape=zeros(ix_shape);ix_shape(:)=ix(1:numel(ix_shape));ix=ix_shape;
iy_shape=zeros(iy_shape);iy_shape(:)=iy(1:numel(iy_shape));iy=iy_shape;
return;
else;
%
kk = fix(abs(kflag));
if( kk~=1 && kk~=2 )
xermsg('SLATEC','ISORT','The sort control parameter, K, is not 2, 1, -1, or -2.',2,1);
ix_shape=zeros(ix_shape);ix_shape(:)=ix(1:numel(ix_shape));ix=ix_shape;
iy_shape=zeros(iy_shape);iy_shape(:)=iy(1:numel(iy_shape));iy=iy_shape;
return;
else;
%
%     Alter array IX to get decreasing order if needed
%
if( kflag<=-1 )
for i = 1 : nn;
ix(i) = fix(-ix(i));
end; i = fix(nn+1);
end;
%
if( kk==2 )
%
%     Sort IX and carry IY along
%
m = 1;
i = 1;
j = fix(nn);
r = 0.375e0;
%
gt(:)=0;
while( true );
if(gt(3)==0)
if(gt(2)==0)
if(gt(1)==0)
if( i==j )
gt(3)=1;
continue;
end;
if( r<=0.5898437e0 )
r = r + 3.90625e-2;
else;
r = r - 0.21875e0;
end;
%
end;
gt(1)=0;
k = fix(i);
%
%     Select a central element of the array and savemlv it in location T
%
ij = fix(i + fix((j-i).*r));
t = fix(ix(ij));
ty = fix(iy(ij));
%
%     If first element of array is greater than T, interchange with T
%
if( ix(i)>t )
ix(ij) = fix(ix(i));
ix(i) = fix(t);
t = fix(ix(ij));
iy(ij) = fix(iy(i));
iy(i) = fix(ty);
ty = fix(iy(ij));
end;
l = fix(j);
%
%     If last element of array is less than T, interchange with T
%
if( ix(j)<t )
ix(ij) = fix(ix(j));
ix(j) = fix(t);
t = fix(ix(ij));
iy(ij) = fix(iy(j));
iy(j) = fix(ty);
ty = fix(iy(ij));
%
%        If first element of array is greater than T, interchange with T
%
if( ix(i)>t )
ix(ij) = fix(ix(i));
ix(i) = fix(t);
t = fix(ix(ij));
iy(ij) = fix(iy(i));
iy(i) = fix(ty);
ty = fix(iy(ij));
end;
end;
%
%     Find an element in the second half of the array which is smaller
%     than T
%
while( true );
l = fix(l - 1);
if( ix(l)<=t )
%
%     Find an element in the first half of the array which is greater
%     than T
%
while( true );
k = fix(k + 1);
if( ix(k)>=t )
break;
end;
end;
%
%     Interchange these elements
%
if( k>l )
break;
end;
tt = fix(ix(l));
ix(l) = fix(ix(k));
ix(k) = fix(tt);
tty = fix(iy(l));
iy(l) = fix(iy(k));
iy(k) = fix(tty);
end;
end;
%
%     Save upper and lower subscripts of the array yet to be sorted
%
if( l-i>j-k )
il(m) = fix(i);
iu(m) = fix(l);
i = fix(k);
m = fix(m + 1);
else;
il(m) = fix(k);
iu(m) = fix(j);
j = fix(l);
m = fix(m + 1);
end;
%
end;
gt(2)=0;
if( j-i>=1 )
gt(1)=1;
continue;
end;
if( i==1 )
continue;
end;
i = fix(i - 1);
%
while( true );
i = fix(i + 1);
if( i==j )
break;
end;
t = fix(ix(i+1));
ty = fix(iy(i+1));
if( ix(i)>t )
k = fix(i);
%
while( true );
ix(k+1) = fix(ix(k));
iy(k+1) = fix(iy(k));
k = fix(k - 1);
if( t>=ix(k) )
break;
end;
end;
ix(k+1) = fix(t);
iy(k+1) = fix(ty);
end;
end;
%
%     Begin again on another portion of the unsorted array
%
end;
gt(3)=0;
m = fix(m - 1);
if( m==0 )
break;
end;
i = fix(il(m));
j = fix(iu(m));
gt(2)=1;
end;
if( kflag<=-1 )
for i = 1 : nn;
ix(i) = fix(-ix(i));
end; i = fix(nn+1);
end;
ix_shape=zeros(ix_shape);ix_shape(:)=ix(1:numel(ix_shape));ix=ix_shape;
iy_shape=zeros(iy_shape);iy_shape(:)=iy(1:numel(iy_shape));iy=iy_shape;
return;
else;
%
%     Sort IX only
%
m = 1;
i = 1;
j = fix(nn);
r = 0.375e0;
end;
end;
end;
%
gt(:)=0;
while( true );
if(gt(3)==0)
if(gt(2)==0)
if(gt(1)==0)
if( i==j )
gt(3)=1;
continue;
end;
if( r<=0.5898437e0 )
r = r + 3.90625e-2;
else;
r = r - 0.21875e0;
end;
%
end;
gt(1)=0;
k = fix(i);
%
%     Select a central element of the array and savemlv it in location T
%
ij = fix(i + fix((j-i).*r));
t = fix(ix(ij));
%
%     If first element of array is greater than T, interchange with T
%
if( ix(i)>t )
ix(ij) = fix(ix(i));
ix(i) = fix(t);
t = fix(ix(ij));
end;
l = fix(j);
%
%     If last element of array is less than than T, interchange with T
%
if( ix(j)<t )
ix(ij) = fix(ix(j));
ix(j) = fix(t);
t = fix(ix(ij));
%
%        If first element of array is greater than T, interchange with T
%
if( ix(i)>t )
ix(ij) = fix(ix(i));
ix(i) = fix(t);
t = fix(ix(ij));
end;
end;
%
%     Find an element in the second half of the array which is smaller
%     than T
%
while( true );
l = fix(l - 1);
if( ix(l)<=t )
%
%     Find an element in the first half of the array which is greater
%     than T
%
while( true );
k = fix(k + 1);
if( ix(k)>=t )
break;
end;
end;
%
%     Interchange these elements
%
if( k>l )
break;
end;
tt = fix(ix(l));
ix(l) = fix(ix(k));
ix(k) = fix(tt);
end;
end;
%
%     Save upper and lower subscripts of the array yet to be sorted
%
if( l-i>j-k )
il(m) = fix(i);
iu(m) = fix(l);
i = fix(k);
m = fix(m + 1);
else;
il(m) = fix(k);
iu(m) = fix(j);
j = fix(l);
m = fix(m + 1);
end;
%
end;
gt(2)=0;
if( j-i>=1 )
gt(1)=1;
continue;
end;
if( i==1 )
continue;
end;
i = fix(i - 1);
%
while( true );
i = fix(i + 1);
if( i==j )
break;
end;
t = fix(ix(i+1));
if( ix(i)>t )
k = fix(i);
%
while( true );
ix(k+1) = fix(ix(k));
k = fix(k - 1);
if( t>=ix(k) )
break;
end;
end;
ix(k+1) = fix(t);
end;
end;
%
%     Begin again on another portion of the unsorted array
%
end;
gt(3)=0;
m = fix(m - 1);
if( m==0 )
break;
end;
i = fix(il(m));
j = fix(iu(m));
gt(2)=1;
end;
%
%     Clean up
%
if( kflag<=-1 )
for i = 1 : nn;
ix(i) = fix(-ix(i));
end; i = fix(nn+1);
end;
ix_shape=zeros(ix_shape);ix_shape(:)=ix(1:numel(ix_shape));ix=ix_shape;
iy_shape=zeros(iy_shape);iy_shape(:)=iy(1:numel(iy_shape));iy=iy_shape;
end %subroutine isort
%DECK ISSBCG

Contact us at files@mathworks.com