Code covered by the BSD License  

Highlights from
slatec

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

[sfac,dfac,kprint]=check1(sfac,dfac,kprint);
function [sfac,dfac,kprint]=check1(sfac,dfac,kprint);
persistent ca ctrue5 ctrue6 cv cx da dtrue1 dtrue3 dtrue5 dv dx firstCall i itrue2 itrue3 jump lenmlv np1 sa stemp strue strue2 strue4 sx ; if isempty(firstCall),firstCall=1;end; 

if isempty(i), i=0; end;
global combla_2; if isempty(combla_2), combla_2=0; end;
global combla_4; if isempty(combla_4), combla_4=0; end;
global combla_5; if isempty(combla_5), combla_5=0; end;
if isempty(jump), jump=0; end;
if isempty(lenmlv), lenmlv=0; end;
global combla_6; if isempty(combla_6), combla_6=0; end;
global combla_3; if isempty(combla_3), combla_3=0; end;
if isempty(np1), np1=0; end;
global combla_1; if isempty(combla_1), combla_1=0; end;
if isempty(sa), sa=0; end;
if isempty(stemp), stemp=0; end;
% common :: ;
global combla_7; if isempty(combla_7), combla_7=false; end;
%% common /combla/ nprint , icase , n , incx , incy , mode , pass;
%% common /combla/ combla_1 , combla_2 , combla_3 , combla_4 , combla_5 , combla_6 , combla_7;
if isempty(itrue2), itrue2=zeros(1,5); end;
if isempty(itrue3), itrue3=zeros(1,5); end;
if isempty(da), da=0; end;
if isempty(dx), dx=zeros(1,8); end;
if isempty(dv), dv=zeros(8,5,2); end;
if isempty(dtrue1), dtrue1=zeros(1,5); end;
if isempty(dtrue3), dtrue3=zeros(1,5); end;
if isempty(dtrue5), dtrue5=zeros(8,5,2); end;
if isempty(strue2), strue2=zeros(1,5); end;
if isempty(strue4), strue4=zeros(1,5); end;
if isempty(strue), strue=zeros(1,8); end;
if isempty(sx), sx=zeros(1,8); end;
if isempty(ca), ca=0; end;
if isempty(cv), cv=zeros(8,5,2); end;
if isempty(ctrue5), ctrue5=zeros(8,5,2); end;
if isempty(ctrue6), ctrue6=zeros(8,5,2); end;
if isempty(cx), cx=zeros(1,8); end;
if firstCall,   sa =[.3];  end;
if firstCall,  da =[.3d0];  end;
if firstCall,  ca=[complex(.4,-.7)];  end;
if firstCall,   dv=[.1d0,2.0d0,2.0d0,2.0d0,2.0d0,2.0d0,2.0d0,2.0d0,.3d0,3.0d0,3.0d0,3.0d0,3.0d0,3.0d0,3.0d0,3.0d0,.3d0,-.4d0,4.0d0,4.0d0,4.0d0,4.0d0,4.0d0,4.0d0,.2d0,-.6d0,.3d0,5.0d0,5.0d0,5.0d0,5.0d0,5.0d0,.1d0,-.3d0,.5d0,-.1d0,6.0d0,6.0d0,6.0d0,6.0d0,.1d0,8.0d0,8.0d0,8.0d0,8.0d0,8.0d0,8.0d0,8.0d0,.3d0,9.0d0,9.0d0,9.0d0,9.0d0,9.0d0,9.0d0,9.0d0,.3d0,2.0d0,-.4d0,2.0d0,2.0d0,2.0d0,2.0d0,2.0d0,.2d0,3.0d0,-.6d0,5.0d0,.3d0,2.0d0,2.0d0,2.0d0,.1d0,4.0d0,-.3d0,6.0d0,-.5d0,7.0d0,-.1d0,3.0d0];  end;
if firstCall,   cv=[complex(.1,.1),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(.3,-.4),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(.1,-.3),complex(.5,-.1),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(.1,.1),complex(-.6,.1),complex(.1,-.3),complex(7.,8.),complex(7.,8.),complex(7.,8.),complex(7.,8.),complex(7.,8.),complex(.3,.1),complex(.1,.4),complex(.4,.1),complex(.1,.2),complex(2.,3.),complex(2.,3.),complex(2.,3.),complex(2.,3.),complex(.1,.1),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(.3,-.4),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(.1,-.3),complex(8.,9.),complex(.5,-.1),complex(2.,5.),complex(2.,5.),complex(2.,5.),complex(2.,5.),complex(2.,5.),complex(.1,.1),complex(3.,6.),complex(-.6,.1),complex(4.,7.),complex(.1,-.3),complex(7.,2.),complex(7.,2.),complex(7.,2.),complex(.3,.1),complex(5.,8.),complex(.1,.4),complex(6.,9.),complex(.4,.1),complex(8.,3.),complex(.1,.2),complex(9.,4.)];  end;
if firstCall,   strue2=[.0,.5,.6,.7,.7];  end;
if firstCall,   strue4=[.0,.7,1.,1.3,1.7];  end;
if firstCall,   dtrue1=[.0d0,.3d0,.5d0,.7d0,.6d0];  end;
if firstCall,   dtrue3=[.0d0,.3d0,.7d0,1.1d0,1.0d0];  end;
if firstCall,   dtrue5=[.10d0,2.0d0,2.0d0,2.0d0,2.0d0,2.0d0,2.0d0,2.0d0,.09d0,3.0d0,3.0d0,3.0d0,3.0d0,3.0d0,3.0d0,3.0d0,.09d0,-.12d0,4.0d0,4.0d0,4.0d0,4.0d0,4.0d0,4.0d0,.06d0,-.18d0,.09d0,5.0d0,5.0d0,5.0d0,5.0d0,5.0d0,.03d0,-.09d0,.15d0,-.03d0,6.0d0,6.0d0,6.0d0,6.0d0,.10d0,8.0d0,8.0d0,8.0d0,8.0d0,8.0d0,8.0d0,8.0d0,.09d0,9.0d0,9.0d0,9.0d0,9.0d0,9.0d0,9.0d0,9.0d0,.09d0,2.0d0,-.12d0,2.0d0,2.0d0,2.0d0,2.0d0,2.0d0,.06d0,3.0d0,-.18d0,5.0d0,.09d0,2.0d0,2.0d0,2.0d0,.03d0,4.0d0,-.09d0,6.0d0,-.15d0,7.0d0,-.03d0,3.0d0];  end;
if firstCall,   ctrue5=[complex(.1,.1),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(-.16,-.37),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(-.17,-.19),complex(.13,-.39),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(.11,-.03),complex(-.17,.46),complex(-.17,-.19),complex(7.,8.),complex(7.,8.),complex(7.,8.),complex(7.,8.),complex(7.,8.),complex(.19,-.17),complex(.32,.09),complex(.23,-.24),complex(.18,.01),complex(2.,3.),complex(2.,3.),complex(2.,3.),complex(2.,3.),complex(.1,.1),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(-.16,-.37),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(-.17,-.19),complex(8.,9.),complex(.13,-.39),complex(2.,5.),complex(2.,5.),complex(2.,5.),complex(2.,5.),complex(2.,5.),complex(.11,-.03),complex(3.,6.),complex(-.17,.46),complex(4.,7.),complex(-.17,-.19),complex(7.,2.),complex(7.,2.),complex(7.,2.),complex(.19,-.17),complex(5.,8.),complex(.32,.09),complex(6.,9.),complex(.23,-.24),complex(8.,3.),complex(.18,.01),complex(9.,4.)];  end;
if firstCall,   ctrue6=[complex(.1,.1),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(1.,2.),complex(.09,-.12),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(3.,4.),complex(.03,-.09),complex(.15,-.03),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(5.,6.),complex(.03,.03),complex(-.18,.03),complex(.03,-.09),complex(7.,8.),complex(7.,8.),complex(7.,8.),complex(7.,8.),complex(7.,8.),complex(.09,.03),complex(.03,.12),complex(.12,.03),complex(.03,.06),complex(2.,3.),complex(2.,3.),complex(2.,3.),complex(2.,3.),complex(.1,.1),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(4.,5.),complex(.09,-.12),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(6.,7.),complex(.03,-.09),complex(8.,9.),complex(.15,-.03),complex(2.,5.),complex(2.,5.),complex(2.,5.),complex(2.,5.),complex(2.,5.),complex(.03,.03),complex(3.,6.),complex(-.18,.03),complex(4.,7.),complex(.03,-.09),complex(7.,2.),complex(7.,2.),complex(7.,2.),complex(.09,.03),complex(5.,8.),complex(.03,.12),complex(6.,9.),complex(.12,.03),complex(8.,3.),complex(.03,.06),complex(9.,4.)];  end;
if firstCall,   itrue2=[0,1,2,2,3];  end;
if firstCall,   itrue3=[0,1,2,2,2];  end;ctrue5=reshape(ctrue5,[8,5,2]);ctrue6=reshape(ctrue6,[8,5,2]);cv=reshape(cv,[8,5,2]);dtrue5=reshape(dtrue5,[8,5,2]);dv=reshape(dv,[8,5,2]);
firstCall=0;
jump = fix(combla_2 - 25);
for combla_4 = 1 : 2;
for np1 = 1 : 5;
combla_3 = fix(np1 - 1);
lenmlv = 2.*max(combla_3,1);
for i = 1 : lenmlv;
sx(i) = dv(i,np1,combla_4);
dx(i) = dv(i,np1,combla_4);
cx(i) = cv(i,np1,combla_4);
end; i = fix(lenmlv+1);
if( jump==2 )
[dumvar1,dumvar2,dumvar3,dumvar3,dfac,kprint]=dtest(1,dnrm2(combla_3,dx,combla_4),dtrue1(sub2ind(size(dtrue1),max(np1,1)):end),dtrue1(sub2ind(size(dtrue1),max(np1,1)):end),dfac,kprint);   dumvar3i=find((dtrue1(sub2ind(size(dtrue1),max(np1,1)):end))~=(dumvar3));   dtrue1(np1-1+dumvar3i)=dumvar3(dumvar3i); 
elseif( jump==3 ) ;
[dumvar1,dumvar2,dumvar3,dumvar3,sfac,kprint]=stest(1,scnrm2(combla_3,cx,combla_4),strue2(sub2ind(size(strue2),max(np1,1)):end),strue2(sub2ind(size(strue2),max(np1,1)):end),sfac,kprint);   dumvar3i=find((strue2(sub2ind(size(strue2),max(np1,1)):end))~=(dumvar3));   strue2(np1-1+dumvar3i)=dumvar3(dumvar3i); 
elseif( jump==4 ) ;
stemp = dtrue3(np1);
stemp_orig=stemp;    [dumvar1,dumvar2,stemp,dumvar4,sfac,kprint]=stest(1,sasum(combla_3,sx,combla_4),stemp,stemp,sfac,kprint);    stemp(dumvar4~=stemp_orig)=dumvar4(dumvar4~=stemp_orig);
elseif( jump==5 ) ;
[dumvar1,dumvar2,dumvar3,dumvar3,dfac,kprint]=dtest(1,dasum(combla_3,dx,combla_4),dtrue3(sub2ind(size(dtrue3),max(np1,1)):end),dtrue3(sub2ind(size(dtrue3),max(np1,1)):end),dfac,kprint);   dumvar3i=find((dtrue3(sub2ind(size(dtrue3),max(np1,1)):end))~=(dumvar3));   dtrue3(np1-1+dumvar3i)=dumvar3(dumvar3i); 
elseif( jump==6 ) ;
[dumvar1,dumvar2,dumvar3,dumvar3,sfac,kprint]=stest(1,scasum(combla_3,cx,combla_4),strue4(sub2ind(size(strue4),max(np1,1)):end),strue4(sub2ind(size(strue4),max(np1,1)):end),sfac,kprint);   dumvar3i=find((strue4(sub2ind(size(strue4),max(np1,1)):end))~=(dumvar3));   strue4(np1-1+dumvar3i)=dumvar3(dumvar3i); 
elseif( jump==7 ) ;
[combla_3,sa,sx,combla_4]=sscal(combla_3,sa,sx,combla_4);
for i = 1 : lenmlv;
strue(i) = dtrue5(i,np1,combla_4);
end; i = fix(lenmlv+1);
strue_orig=strue;    [lenmlv,sx,strue,dumvar4,sfac,kprint]=stest(lenmlv,sx,strue,strue,sfac,kprint);    strue(dumvar4~=strue_orig)=dumvar4(dumvar4~=strue_orig);
elseif( jump==8 ) ;
[combla_3,da,dx,combla_4]=dscal(combla_3,da,dx,combla_4);
[lenmlv,dx,dumvar3,dumvar3,dfac,kprint]=dtest(lenmlv,dx,dtrue5(sub2ind(size(dtrue5),1,np1,combla_4):end),dtrue5(sub2ind(size(dtrue5),1,np1,combla_4):end),dfac,kprint);      dtrue5(sub2ind(size(dtrue5),1,np1,combla_4):end)=dumvar3; 
elseif( jump==9 ) ;
[combla_3,ca,cx,combla_4]=cscal(combla_3,ca,cx,combla_4);
%Barrowes - commented out calls to stest with complex variables
%!!   CALL STEST(2*len,cx,ctrue5(1,np1,INCx),ctrue5(1,np1,INCx),Sfac,%!!Kprint)
elseif( jump==10 ) ;
[combla_3,sa,cx,combla_4]=csscal(combla_3,sa,cx,combla_4);
%Barrowes - commented out calls to stest with complex variables
%!!   CALL STEST(2*len,cx,ctrue6(1,np1,INCx),ctrue6(1,np1,INCx),Sfac,%!!Kprint)
elseif( jump==11 ) ;
[dumvar1,dumvar2,itrue2(sub2ind(size(itrue2),max(np1,1)):end),kprint]=itest(1,isamax(combla_3,sx,combla_4),itrue2(sub2ind(size(itrue2),max(np1,1)):end),kprint);
elseif( jump==12 ) ;
[dumvar1,dumvar2,itrue2(sub2ind(size(itrue2),max(np1,1)):end),kprint]=itest(1,idamax(combla_3,dx,combla_4),itrue2(sub2ind(size(itrue2),max(np1,1)):end),kprint);
elseif( jump==13 ) ;
[dumvar1,dumvar2,itrue3(sub2ind(size(itrue3),max(np1,1)):end),kprint]=itest(1,icamax(combla_3,cx,combla_4),itrue3(sub2ind(size(itrue3),max(np1,1)):end),kprint);
else;
stemp = dtrue1(np1);
stemp_orig=stemp;    [dumvar1,dumvar2,stemp,dumvar4,sfac,kprint]=stest(1,snrm2(combla_3,sx,combla_4),stemp,stemp,sfac,kprint);    stemp(dumvar4~=stemp_orig)=dumvar4(dumvar4~=stemp_orig);
end;
end; np1 = fix(5+1);
end; combla_4 = fix(2+1);
end %subroutine check1

Contact us