[lun,kprint,ipass]=ssrtqc(lun,kprint,ipass);

function [lun,kprint,ipass]=ssrtqc(lun,kprint,ipass);
persistent fail firstCall i ier ix iy j kabs kflag kkflag n nerr nn ntest x xs y yc ; if isempty(firstCall),firstCall=1;end; 

if isempty(n), n=9; end;
if isempty(ntest), ntest=4 ; end;
if isempty(fail), fail=false; end;
if isempty(x), x=zeros(n,ntest); end;
if isempty(xs), xs=zeros(n,ntest); end;
if isempty(y), y=zeros(1,n); end;
if isempty(yc), yc=zeros(1,n); end;
if isempty(ix), ix=zeros(n,ntest); end;
if isempty(iy), iy=zeros(1,n); end;
if isempty(kflag), kflag=zeros(1,ntest); end;
if isempty(j), j=0; end;
if isempty(i), i=0; end;
if isempty(kabs), kabs=0; end;
if isempty(ier), ier=0; end;
if isempty(nerr), nerr=0; end;
if isempty(nn), nn=0; end;
if isempty(kkflag), kkflag=0; end;
if firstCall,   kflag(1)=[2];  end;
if firstCall, [ x([1:n],1)]=[36.,54.,-1.,29.,1.,80.,98.,99.,55.]; end;
if firstCall, [ ix([1:n],1)]=[3,5,4,1,2,9,6,7,8]; end;
if firstCall, [ xs([1:n],1)]=[-1.,1.,29.,36.,54.,55.,80.,98.,99.]; end;
if firstCall,   kflag(2)=[-1];  end;
if firstCall, [ x([1:n],2)]=[1.,2.,3.,4.,5.,6.,7.,8.,9.]; end;
if firstCall, [ ix([1:n],2)]=[9,8,7,6,5,4,3,2,1]; end;
if firstCall, [ xs([1:n],2)]=[9.,8.,7.,6.,5.,4.,3.,2.,1.]; end;
if firstCall,   kflag(3)=[-2];  end;
if firstCall, [ x([1:n],3)]=[-9.,-8.,-7.,-6.,-5.,-4.,-3.,-2.,-1.]; end;
if firstCall, [ ix([1:n],3)]=[9,8,7,6,5,4,3,2,1]; end;
if firstCall, [ xs([1:n],3)]=[-1.,-2.,-3.,-4.,-5.,-6.,-7.,-8.,-9.]; end;
if firstCall,   kflag(4)=[1];  end;
if firstCall, [ x([1:n],4)]=[36.,54.,-1.,29.,1.,80.,98.,99.,55.]; end;
if firstCall, [ ix([1:n],4)]=[3,5,4,1,2,9,6,7,8]; end;
if firstCall, [ xs([1:n],4)]=[-1.,1.,29.,36.,54.,55.,80.,98.,99.]; end;ix=reshape(ix,[n,ntest]);x=reshape(x,[n,ntest]);xs=reshape(xs,[n,ntest]);
firstCall=0;
if( kprint>=2 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%s','%2i' ' \n'], '=================');
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], 'OUTPUT FROM SSRTQC');
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '=================');
end;
ipass = 1;
for j = 1 : ntest;
for i = 1 : n;
y(i) = x(i,j);
yc(i) = x(i,j);
end; i = fix(n+1);
[y,yc,n,kflag(j)]=ssort(y,yc,n,kflag(j));
kabs = fix(abs(kflag(j)));
fail = false;
for i = 1 : n;
fail = fail |(y(i)~=xs(i,j)) |((kabs==1) &(yc(i)~=x(i,j))) |((kabs==2) &(yc(i)~=xs(i,j)));
end; i = fix(n+1);
if( fail )
ipass = 0;
if( kprint>0 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%s','%2i' ' \n'], 'SSORT FAILED TEST ' , j);
end;
else;
if( kprint>=2 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%s','%2i' ' \n'], 'SSORT PASSED TEST ' , j);
end;
end;
if((fail &&(kprint>=2)) ||(kprint>=3) )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%s','%2i' ' \n'], '------------------------');
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], 'DETAILS OF SSORT TEST ' , j);
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '------------------------');
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '1ST ARGUMENT (VECTOR TO BE SORTED)');
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '             INPUT = ' , x(i,j)); end;
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '   COMPUTED OUTPUT = ' , y(i)); end;
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '    CORRECT OUTPUT = ' , xs(i,j)); end;
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '2ND ARGUMENT (VECTOR CARRIED ALONG)');
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '             INPUT = ' , x(i,j)); end;
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '   COMPUTED OUTPUT = ' , yc(i)); end;
if( kabs==1 )
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '    CORRECT OUTPUT = ' , x(i,j)); end;
else;
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '    CORRECT OUTPUT = ' , xs(i,j)); end;
end;
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '3RD ARGUMENT (VECTOR LENGTH)');
writef(lun,[repmat(' ',1,1),'%s',repmat('%4i',1,9) ' \n'], '             INPUT = ' , n);
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '4TH ARGUMENT (TYPE OF SORT)');
writef(lun,[repmat(' ',1,1),'%s',repmat('%4i',1,9) ' \n'], '             INPUT = ' , kflag(j));
end;
end; j = fix(ntest+1);
for j = 1 : ntest;
for i = 1 : n;
y(i) = x(i,j);
end; i = fix(n+1);
[y,n,iy,kflag(j),ier]=spsort(y,n,iy,kflag(j),ier);
kabs = fix(abs(kflag(j)));
fail = false |(ier>0);
for i = 1 : n;
fail = fail |(iy(i)~=ix(i,j)) |((kabs==1) &(y(i)~=x(i,j))) |((kabs==2) &(y(i)~=xs(i,j)));
end; i = fix(n+1);
if( fail )
ipass = 0;
if( kprint>0 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%s','%2i' ' \n'], 'SPSORT FAILED TEST ' , j);
end;
else;
if( kprint>=2 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%s','%2i' ' \n'], 'SPSORT PASSED TEST ' , j);
end;
end;
if((fail &&(kprint>=2)) ||(kprint>=3) )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%s','%2i' ' \n'], '-------------------------');
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], 'DETAILS OF SPSORT TEST ' , j);
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '-------------------------');
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '1ST ARGUMENT (VECTOR TO BE SORTED)');
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '             INPUT = ' , x(i,j)); end;
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '   COMPUTED OUTPUT = ' , y(i)); end;
if( kabs==1 )
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '    CORRECT OUTPUT = ' , x(i,j)); end;
else;
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '    CORRECT OUTPUT = ' , xs(i,j)); end;
end;
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '2ND ARGUMENT (VECTOR LENGTH)');
writef(lun,[repmat(' ',1,1),'%s',repmat('%4i',1,9) ' \n'], '             INPUT = ' , n);
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '3RD ARGUMENT (PERMUTATION VECTOR)');
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4i',1,9) ' \n'], '   COMPUTED OUTPUT = ' , iy(i)); end;
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4i',1,9) ' \n'], '    CORRECT OUTPUT = ' , ix(i,j)); end;
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '4TH ARGUMENT (TYPE OF SORT)');
writef(lun,[repmat(' ',1,1),'%s',repmat('%4i',1,9) ' \n'], '             INPUT = ' , kflag(j));
end;
end; j = fix(ntest+1);
if( kprint<=2 )
xsetf(0);
else;
xsetf(-1);
end;
nn = -1;
kkflag = 1;
if( kprint>=3 )
writef(lun,['%0.15g \n']);
end;
xerclr;
[y,nn,iy,kkflag,ier]=spsort(y,nn,iy,kkflag,ier);
if( numxer(nerr)~=ier )
ipass = 0;
end;
nn = 1;
kkflag = 0;
if( kprint>=3 )
writef(lun,['%0.15g \n']);
end;
xerclr;
[y,nn,iy,kkflag,ier]=spsort(y,nn,iy,kkflag,ier);
if( numxer(nerr)~=ier )
ipass = 0;
end;
if((kprint>=2) &&(ipass==1) )
writef(lun,['%0.15g \n']);
writef(lun,['%s \n'], ' SPSORT PASSED ERROR MESSAGE TESTS');
elseif((kprint>=1) &&(ipass==0) ) ;
writef(lun,['%0.15g \n']);
writef(lun,['%s \n'], ' SPSORT FAILED ERROR MESSAGE TESTS');
end;
for j = 1 : ntest;
kabs = fix(abs(kflag(j)));
for i = 1 : n;
y(i) = x(i,j);
if( kabs==1 )
iy(i) = fix(i);
else;
iy(i) = fix(ix(i,j));
end;
end; i = fix(n+1);
[y,n,iy,ier]=spperm(y,n,iy,ier);
fail = false |(ier>0);
for i = 1 : n;
fail = fail |((kabs==1) &(iy(i)~=i)) |((kabs==2) &(iy(i)~=ix(i,j))) |((kabs==1) &(y(i)~=x(i,j))) |((kabs==2) &(y(i)~=xs(i,j)));
end; i = fix(n+1);
if( fail )
ipass = 0;
if( kprint>0 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%s','%2i' ' \n'], 'SPPERM FAILED TEST ' , j);
end;
else;
if( kprint>=2 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%s','%2i' ' \n'], 'SPPERM PASSED TEST ' , j);
end;
end;
if((fail &&(kprint>=2)) ||(kprint>=3) )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%s','%2i' ' \n'], '------------------------');
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], 'DETAILS OF SPPERM TEST' , j);
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '------------------------');
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '1ST ARGUMENT (VECTOR TO BE PERMUTED)');
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '             INPUT =' , x(i,j)); end;
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '   COMPUTED OUTPUT =' , y(i)); end;
if( kabs==1 )
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '    CORRECT OUTPUT =' , x(i,j)); end;
else;
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4.0f',1,9) ' \n'], '    CORRECT OUTPUT =' , xs(i,j)); end;
end;
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '2ND ARGUMENT (VECTOR LENGTH)');
writef(lun,[repmat(' ',1,1),'%s',repmat('%4i',1,9) ' \n'], '             INPUT =' , n);
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '3RD ARGUMENT (PERMUTATION VECTOR)');
for i=(1):(n), writef(lun,[repmat(' ',1,1),'%s',repmat('%4i',1,9) ' \n'], '             INPUT =' , iy(i)); end;
writef(lun,[repmat(' ',1,1),'%s','%2i' ' \n'], '4TH ARGUMENT (ERROR FLAG)');
writef(lun,[repmat(' ',1,1),'%s',repmat('%4i',1,9) ' \n'], '             OUTPUT =' , ier);
end;
end; j = fix(ntest+1);
if( kprint<=2 )
xsetf(0);
else;
xsetf(-1);
end;
nn = -1;
if( kprint>=3 )
writef(lun,['%0.15g \n']);
end;
xerclr;
[y,nn,iy,ier]=spperm(y,nn,iy,ier);
if( numxer(nerr)~=ier )
ipass = 0;
end;
nn = 1;
iy(1) = 5;
if( kprint>=3 )
writef(lun,['%0.15g \n']);
end;
xerclr;
[y,nn,iy,ier]=spperm(y,nn,iy,ier);
if( numxer(nerr)~=ier )
ipass = 0;
end;
if((kprint>=2) &&(ipass==1) )
writef(lun,['%0.15g \n']);
writef(lun,['%s \n'], ' SPPERM PASSED ERROR MESSAGE TESTS');
elseif((kprint>=1) &&(ipass==0) ) ;
writef(lun,['%0.15g \n']);
writef(lun,['%s \n'], ' SPPERM FAILED ERROR MESSAGE TESTS');
end;
return;
%format[1x,a,i2);
%format(1x,a,i2);
%format(1x,a,9f4.0);
%format(1x,a,9i4);
end %subroutine ssrtqc