Code covered by the BSD License  

Highlights from
slatec

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

[sname,eps,thresh,nout,kprint,fatal,nidim,idim_v,nkb,kb,nalf,alf,nbet,bet,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g]=schk22(sname,eps,thresh,nout,kprint,fatal,nidim,idim_v,nkb,kb,nalf,alf,nbet,bet,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g)
function [sname,eps,thresh,nout,kprint,fatal,nidim,idim_v,nkb,kb,nalf,alf,nbet,bet,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g]=schk22(sname,eps,thresh,nout,kprint,fatal,nidim,idim_v,nkb,kb,nalf,alf,nbet,bet,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g);
persistent alpha als banded beta bls err errmax firstCall ftl full half i ia ib ic ich ik in incx incxs incy incys isame ix iy k ks laa lda ldas lx ly n nc nerr nk ns null packed reset transl uplo uplos zero ; if isempty(firstCall),firstCall=1;end; 

if isempty(zero), zero=0.0; end;
if isempty(half), half=0.5 ; end;
a_orig=a;a_shape=[nmax,nmax];a=reshape([a_orig(1:min(prod(a_shape),numel(a_orig))),zeros(1,max(0,prod(a_shape)-numel(a_orig)))],a_shape);
if isempty(alpha), alpha=0; end;
if isempty(als), als=0; end;
if isempty(beta), beta=0; end;
if isempty(bls), bls=0; end;
if isempty(err), err=0; end;
if isempty(errmax), errmax=0; end;
if isempty(transl), transl=0; end;
if isempty(i), i=0; end;
if isempty(ia), ia=0; end;
if isempty(ib), ib=0; end;
if isempty(ic), ic=0; end;
if isempty(ik), ik=0; end;
if isempty(in), in=0; end;
if isempty(incx), incx=0; end;
if isempty(incxs), incxs=0; end;
if isempty(incy), incy=0; end;
if isempty(incys), incys=0; end;
if isempty(ix), ix=0; end;
if isempty(iy), iy=0; end;
if isempty(k), k=0; end;
if isempty(ks), ks=0; end;
if isempty(laa), laa=0; end;
if isempty(lda), lda=0; end;
if isempty(ldas), ldas=0; end;
if isempty(lx), lx=0; end;
if isempty(ly), ly=0; end;
if isempty(n), n=0; end;
% integer ::nargs ;
if isempty(nc), nc=0; end;
if isempty(nk), nk=0; end;
if isempty(ns), ns=0; end;
if isempty(nerr), nerr=0; end;
if isempty(banded), banded=false; end;
if isempty(ftl), ftl=false; end;
if isempty(full), full=false; end;
if isempty(null), null=false; end;
if isempty(packed), packed=false; end;
if isempty(reset), reset=false; end;
if isempty(uplo), uplo=repmat(' ',1,1); end;
if isempty(uplos), uplos=repmat(' ',1,1); end;
if isempty(ich), ich=repmat(' ',1,2); end;
if isempty(isame), isame=zeros(1,13); end;
if firstCall,   ich=['UL'];  end;
firstCall=0;
full = strcmp(deblank(sname([3:3])),deblank('Y'));
banded = strcmp(deblank(sname([3:3])),deblank('B'));
packed = strcmp(deblank(sname([3:3])),deblank('P'));
if( full )
nargs = 10;
elseif( banded ) ;
nargs = 11;
elseif( packed ) ;
nargs = 9;
end;
nc = 0;
reset = true;
errmax = zero;
for in = 1 : nidim;
n = fix(idim_v(in));
if( banded )
nk = fix(nkb);
else;
nk = 1;
end;
for ik = 1 : nk;
if( banded )
k = fix(kb(ik));
else;
k = fix(n - 1);
end;
if( banded )
lda = fix(k + 1);
else;
lda = fix(n);
end;
if( lda<nmax )
lda = fix(lda + 1);
end;
if( lda<=nmax )
if( packed )
laa =fix(fix((n.*(n+1))./2));
else;
laa = fix(lda.*n);
end;
null = n<=0;
for ic = 1 : 2;
uplo = ich([ic:ic]);
transl = zero;
n_orig=n; k_orig=k;    [sname([2:min(length(sname),3)]),uplo,dumvar3,n,dumvar5,a,nmax,aa,lda,k,dumvar11,reset,transl]=smake2(sname([2:min(length(sname),3)]),uplo,' ',n,n,a,nmax,aa,lda,k,k,reset,transl);    k(dumvar11~=k_orig)=dumvar11(dumvar11~=k_orig); n(dumvar5~=n_orig)=dumvar5(dumvar5~=n_orig);
for ix = 1 : ninc;
incx = fix(inc(ix));
lx = fix(abs(incx).*n);
transl = half;
[dumvar1,dumvar2,dumvar3,dumvar4,n,x,dumvar7,xx,dumvar9,dumvar10,dumvar11,reset,transl]=smake2('GE',' ',' ',1,n,x,1,xx,abs(incx),0,n-1,reset,transl);
if( n>1 )
x(fix(n./2)) = zero;
xx(1+(abs(incx).*(fix(n./2)-1))) = zero;
end;
for iy = 1 : ninc;
incy = fix(inc(iy));
ly = fix(abs(incy).*n);
for ia = 1 : nalf;
alpha = alf(ia);
for ib = 1 : nbet;
beta = bet(ib);
transl = zero;
[dumvar1,dumvar2,dumvar3,dumvar4,n,y,dumvar7,yy,dumvar9,dumvar10,dumvar11,reset,transl]=smake2('GE',' ',' ',1,n,y,1,yy,abs(incy),0,n-1,reset,transl);
nc = fix(nc + 1);
uplos = uplo;
ns = fix(n);
ks = fix(k);
als = alpha;
for i = 1 : laa;
as(i) = aa(i);
end; i = fix(laa+1);
ldas = fix(lda);
for i = 1 : lx;
xs(i) = xx(i);
end; i = fix(lx+1);
incxs = fix(incx);
bls = beta;
for i = 1 : ly;
ys(i) = yy(i);
end; i = fix(ly+1);
incys = fix(incy);
if( full )
[uplo,n,alpha,aa,lda,xx,incx,beta,yy,incy]=ssymv(uplo,n,alpha,aa,lda,xx,incx,beta,yy,incy);
elseif( banded ) ;
[uplo,n,k,alpha,aa,lda,xx,incx,beta,yy,incy]=ssbmv(uplo,n,k,alpha,aa,lda,xx,incx,beta,yy,incy);
elseif( packed ) ;
[uplo,n,alpha,aa,xx,incx,beta,yy,incy]=sspmv(uplo,n,alpha,aa,xx,incx,beta,yy,incy);
end;
if( numxer(nerr)~=0 )
if( kprint>=2 )
writef(nout,[' ** FATAL ERROR - ERROR-EXIT TAKEN ON VALID call *','*' ' \n']);
end;
fatal = true;
end;
isame(1) = strcmp(deblank(uplo),deblank(uplos));
isame(2) = ns==n;
if( full )
isame(3) = als==alpha;
[isame(4) ,as,aa,laa]=lse(as,aa,laa);
isame(5) = ldas==lda;
[isame(6) ,xs,xx,lx]=lse(xs,xx,lx);
isame(7) = incxs==incx;
isame(8) = bls==beta;
if( null )
[isame(9) ,ys,yy,ly]=lse(ys,yy,ly);
else;
[isame(9) ,dumvar2,dumvar3,dumvar4,n,ys,yy]=lseres('GE',' ',1,n,ys,yy,abs(incy));
end;
isame(10) = incys==incy;
elseif( banded ) ;
isame(3) = ks==k;
isame(4) = als==alpha;
[isame(5) ,as,aa,laa]=lse(as,aa,laa);
isame(6) = ldas==lda;
[isame(7) ,xs,xx,lx]=lse(xs,xx,lx);
isame(8) = incxs==incx;
isame(9) = bls==beta;
if( null )
[isame(10) ,ys,yy,ly]=lse(ys,yy,ly);
else;
[isame(10) ,dumvar2,dumvar3,dumvar4,n,ys,yy]=lseres('GE',' ',1,n,ys,yy,abs(incy));
end;
isame(11) = incys==incy;
elseif( packed ) ;
isame(3) = als==alpha;
[isame(4) ,as,aa,laa]=lse(as,aa,laa);
[isame(5) ,xs,xx,lx]=lse(xs,xx,lx);
isame(6) = incxs==incx;
isame(7) = bls==beta;
if( null )
[isame(8) ,ys,yy,ly]=lse(ys,yy,ly);
else;
[isame(8) ,dumvar2,dumvar3,dumvar4,n,ys,yy]=lseres('GE',' ',1,n,ys,yy,abs(incy));
end;
isame(9) = incys==incy;
end;
for i = 1 : nargs;
if( ~isame(i) )
fatal = true;
if( kprint>=2 )
writef(nout,[' ** FATAL ERROR - PARAMETER NUMBER ','%2i',' WAS CH','ANGED INCORRECTLY **' ' \n'], i);
end;
end;
end; i = fix(nargs+1);
ftl = false;
if( ~null )
n_orig=n;    [dumvar1,n,dumvar3,alpha,a,nmax,x,incx,beta,y,incy,yt,g,yy,eps,err,ftl,nout,dumvar19,kprint]=smvch('N',n,n,alpha,a,nmax,x,incx,beta,y,incy,yt,g,yy,eps,err,ftl,nout,true,kprint);    n(dumvar3~=n_orig)=dumvar3(dumvar3~=n_orig);
errmax = max(errmax,err);
end;
if( ftl )
fatal = true;
if( kprint>=3 )
writef(nout,[' ** ','%6s',' FAILED ON call NUMBER:' ' \n'], sname);
if( full )
writef(nout,[repmat(' ',1,1),'%6i',': ','%6s','(''','%1s',''',','%3i',',','%4.1f',', A,','%3i',', X,','%2i',',','%4.1f',', Y,','%2i',')             .' ' \n'], nc , sname , uplo , n , alpha ,lda , incx , beta , incy);
elseif( banded ) ;
writef(nout,[repmat(' ',1,1),'%6i',': ','%6s','(''','%1s',''',',repmat(['%3i',','] ,1,2),'%4.1f',', A,','%3i',', X,','%2i',',','%4.1f',', Y,','%2i',')         .' ' \n'], nc , sname , uplo , n , k ,alpha , lda , incx , beta , incy);
elseif( packed ) ;
writef(nout,[repmat(' ',1,1),'%6i',': ','%6s','(''','%1s',''',','%3i',',','%4.1f',', AP',', X,','%2i',',','%4.1f',', Y,','%2i',')                .' ' \n'], nc , sname , uplo , n , alpha ,incx , beta , incy);
end;
end;
end;
end; ib = fix(nbet+1);
end; ia = fix(nalf+1);
end; iy = fix(ninc+1);
end; ix = fix(ninc+1);
end; ic = fix(2+1);
end;
end; ik = fix(nk+1);
end; in = fix(nidim+1);
if( ~(fatal) )
if( kprint>=3 )
if( errmax<thresh )
writef(nout,[' ','%6s',' PASSED THE COMPUTATIONAL TESTS (','%6i',' CALL','S)' ' \n'], sname , nc);
else;
writef(nout,[' ','%6s',' COMPLETED THE COMPUTATIONAL TESTS (','%6i',' C','ALLS)', '\n ' ,' ** BUT WITH MAXIMUM TEST RATIO','%8.2f',' - SUSPECT **' ' \n'], sname , nc , errmax);
end;
end;
end;
a_orig(1:prod(a_shape))=a;a=a_orig;
return;
%format (' ',a6,' PASSED THE COMPUTATIONAL TESTS (',i6,' CALL','S)');
%format (' ** FATAL ERROR - PARAMETER NUMBER ',i2,' WAS CH','ANGED INCORRECTLY **');
%format (' ',a6,' COMPLETED THE COMPUTATIONAL TESTS (',i6,' C','ALLS)',/' ** BUT WITH MAXIMUM TEST RATIO',f8.2,' - SUSPECT **');
%format (' ** ',a6,' FAILED ON call NUMBER:');
%format (1X,i6,': ',a6,'(''',a1,''',',i3,',',f4.1,', AP',', X,',i2,',',f4.1,', Y,',i2,')                .');
%format (1X,i6,': ',a6,'(''',a1,''',',2(i3,','),f4.1,', A,',i3,', X,',i2,',',f4.1,', Y,',i2,')         .');
%format (1X,i6,': ',a6,'(''',a1,''',',i3,',',f4.1,', A,',i3,', X,',i2,',',f4.1,', Y,',i2,')             .');
%format (' ** FATAL ERROR - ERROR-EXIT TAKEN ON VALID call *','*');
a_orig(1:prod(a_shape))=a;a=a_orig;
end %subroutine schk22

Contact us