Code covered by the BSD License  

Highlights from
slatec

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

[lun,kprint,ipass]=eg8ck(lun,kprint,ipass);
function [lun,kprint,ipass]=eg8ck(lun,kprint,ipass);
% common :: ;
persistent ansmlv atol bb en er ex fatal i icase ie ierr igo ii ik ix iy k ke kk kode kx m n nm nz sig summlv t1 t2 tol xx y ; 

global feinx_1; if isempty(feinx_1), feinx_1=0; end;
global feinx_2; if isempty(feinx_2), feinx_2=0; end;
global feinx_3; if isempty(feinx_3), feinx_3=0; end;
%% common /feinx / x , a , fkm;
%% common /feinx / feinx_1 , feinx_2 , feinx_3;
if isempty(i), i=0; end;
if isempty(icase), icase=0; end;
if isempty(ie), ie=0; end;
if isempty(ierr), ierr=0; end;
if isempty(ii), ii=0; end;
if isempty(ik), ik=0; end;
if isempty(ix), ix=0; end;
if isempty(iy), iy=0; end;
if isempty(k), k=0; end;
if isempty(ke), ke=0; end;
if isempty(kk), kk=0; end;
if isempty(kode), kode=0; end;
if isempty(kx), kx=0; end;
if isempty(m), m=0; end;
if isempty(n), n=0; end;
if isempty(nm), nm=0; end;
if isempty(nz), nz=0; end;
if isempty(igo), igo=0; end;
if isempty(ansmlv), ansmlv=0; end;
if isempty(atol), atol=0; end;
if isempty(bb), bb=0; end;
if isempty(en), en=zeros(1,4); end;
if isempty(er), er=0; end;
if isempty(ex), ex=0; end;
if isempty(sig), sig=0; end;
if isempty(summlv), summlv=0; end;
if isempty(tol), tol=0; end;
if isempty(t1), t1=0; end;
if isempty(t2), t2=0; end;
if isempty(xx), xx=zeros(1,5); end;
if isempty(y), y=zeros(1,4); end;
if isempty(fatal), fatal=false; end;
if( kprint>=2 )
writef(lun,['1', '\n ' ,' QUICK CHECK FOR EXINT AND GAUS8', '\n '  ' \n']);
end;
%format ('1'/' QUICK CHECK FOR EXINT AND GAUS8'];
ipass = 1;
tol = sqrt(max(r1mach(4),1.0e-18));
igo=1;
for kode = 1 : 2;
ik = fix(kode - 1);
feinx_3 = ik;
for n = 1 : 8: 25 ;
for m = 1 : 4;
nm = fix(n + m - 1);
for ix = 1 : 8: 25 ;
feinx_1 = ix - 0.20e0;
[feinx_1,n,kode,m,tol,en,nz,ierr]=exint(feinx_1,n,kode,m,tol,en,nz,ierr);
kx = fix(feinx_1 + 0.5e0);
if( kx==0 )
kx = 1;
end;
icase = 1;
feinx_2 = n;
if( kx>n )
icase = 2;
feinx_2 = nm;
if( kx<nm )
icase = 3;
feinx_2 = kx;
end;
end;
sig = 3.0e0./feinx_1;
t2 = 1.0e0;
summlv = 0.0e0;
while (1);
t1 = t2;
t2 = t2 + sig;
atol = tol;
[dumvar1,t1,t2,atol,ansmlv,ierr]=gaus8(@fein,t1,t2,atol,ansmlv,ierr);
summlv = summlv + ansmlv;
if( abs(ansmlv)<abs(summlv).*tol )
break;
end;
end;
ex = 1.0e0;
if( kode==1 )
ex = exp(-feinx_1);
end;
bb = feinx_2;
if( icase==3 )
iy = fix(kx - n + 1);
y(iy) = summlv;
ke = fix(m - iy);
ie = fix(iy - 1);
kk = fix(iy);
ii = fix(iy);
elseif( icase~=2 ) ;
y(1) = summlv;
if( m==1 )
for i = 1 : m;
er = abs((y(i)-en(i))./y(i));
if( er>tol )
writef(lun,[ '\n ' , '\n ' ,' ERROR IN EG8CK COMPARISON TEST', '\n '  ' \n']);
ipass = 0;
igo=0;
break;
end;
end;
if(igo==0)
break;
end;
continue;
end;
ke = fix(m - 1);
kk = 1;
else;
y(m) = summlv;
if( m==1 )
for i = 1 : m;
er = abs((y(i)-en(i))./y(i));
if( er>tol )
writef(lun,[ '\n ' , '\n ' ,' ERROR IN EG8CK COMPARISON TEST', '\n '  ' \n']);
ipass = 0;
igo=0;
break;
end;
end;
if(igo==0)
break;
end;
continue;
end;
ie = fix(m - 1);
ii = fix(m);
bb = feinx_2 - 1.0e0;
for i = 1 : ie;
y(ii-1) =(ex-bb.*y(ii))./feinx_1;
bb = bb - 1.0e0;
ii = fix(ii - 1);
end; i = fix(ie+1);
for i = 1 : m;
er = abs((y(i)-en(i))./y(i));
if( er>tol )
writef(lun,[ '\n ' , '\n ' ,' ERROR IN EG8CK COMPARISON TEST', '\n '  ' \n']);
ipass = 0;
igo=0;
break;
end;
end;
if(igo==0)
break;
end;
continue;
end;
for k = 1 : ke;
y(kk+1) =(ex-feinx_1.*y(kk))./bb;
bb = bb + 1.0e0;
kk = fix(kk + 1);
end; k = fix(ke+1);
if( icase~=3 )
for i = 1 : m;
er = abs((y(i)-en(i))./y(i));
if( er>tol )
writef(lun,[ '\n ' , '\n ' ,' ERROR IN EG8CK COMPARISON TEST', '\n '  ' \n']);
ipass = 0;
igo=0;
break;
end;
end;
if(igo==0)
break;
end;
continue;
end;
bb = feinx_2 - 1.0e0;
for i = 1 : ie;
y(ii-1) =(ex-bb.*y(ii))./feinx_1;
bb = bb - 1.0e0;
ii = fix(ii - 1);
end; i = fix(ie+1);
for i = 1 : m;
er = abs((y(i)-en(i))./y(i));
if( er>tol )
writef(lun,[ '\n ' , '\n ' ,' ERROR IN EG8CK COMPARISON TEST', '\n '  ' \n']);
ipass = 0;
igo=0;
break;
end;
end;
if(igo==0)
break;
end;
end;
if(igo==0)
break;
end;
end;
if(igo==0)
break;
end;
end;
if(igo==0)
break;
end;
end;
fatal = false;
if( kprint>=3 )
writef(lun,[ '\n ' ,' TRIGGER 6 ERROR CONDITIONS' ' \n']);
end;
%format [/' ERROR IN EG8CK COMPARISON TEST'];
%format [' TRIGGER 6 ERROR CONDITIONS');
xx(1) = 1.0e0;
xx(2) = 1.0e0;
xx(3) = 1.0e0;
xx(4) = 1.0e0;
xx(5) = 0.01e0;
for i = 1 : 5;
xx(i) = -xx(i);
k = fix(xx(2));
n = fix(xx(3));
m = fix(xx(4));
[dumvar1,n,k,m,dumvar5,en,nz,ierr]=exint(xx(i),n,k,m,xx(5),en,nz,ierr);   dumvar1i=find((xx(i))~=(dumvar1));dumvar5i=find((xx(5))~=(dumvar5));   xx(i-1+dumvar1i)=dumvar1(dumvar1i); xx(5-1+dumvar5i)=dumvar5(dumvar5i); 
if( ierr~=1 )
ipass = 0;
fatal = true;
writef(lun,[' Error occurred with DO indexmlv I =','%2i' ' \n'], i);
%format (' Error occurred with DO indexmlv I =',i2);
end;
xx(i) = -xx(i);
end; i = fix(5+1);
feinx_1 = 0.0e0;
tol = 1.0e-2;
[feinx_1,dumvar2,dumvar3,dumvar4,tol,en,nz,ierr]=exint(feinx_1,1,1,1,tol,en,nz,ierr);
if( ierr~=1 )
ipass = 0;
fatal = true;
writef(lun,[' Error occurred with X = 0.0' ' \n']);
%format (' Error occurred with X = 0.0');
end;
if( fatal )
if( kprint>=2 )
writef(lun,[ '\n ' ,' AT LEAST ONE INCORRECT ARGUMENT TEST FAILED' ' \n']);
%format [' AT LEAST ONE INCORRECT ARGUMENT TEST FAILED');
end;
elseif( kprint>=3 ) ;
writef(lun,[ '\n ' ,' ALL INCORRECT ARGUMENT TESTS PASSED' ' \n']);
%format [' ALL INCORRECT ARGUMENT TESTS PASSED');
end;
if( ipass==1 && kprint>=2 )
writef(lun,[ '\n ' ,' EXINT AND GAUS8 PASSED ALL TESTS' ' \n']);
end;
%format [' EXINT AND GAUS8 PASSED ALL TESTS');
if( ipass==0 && kprint>=1 )
writef(lun,[ '\n ' ,' EXINT OR GAUS8 FAILED SOME TESTS' ' \n']);
end;
%format [' EXINT OR GAUS8 FAILED SOME TESTS');
return;
end %subroutine eg8ck

Contact us