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

function [lun,kprint,ipass]=qcpsi(lun,kprint,ipass);
persistent er euler firstCall i ierr iflg ix kode m n nm nn nz psi1 psi2 r1m4 s tol x ; if isempty(firstCall),firstCall=1;end; 

if isempty(i), i=0; end;
if isempty(ierr), ierr=0; end;
if isempty(iflg), iflg=0; end;
if isempty(ix), ix=0; end;
if isempty(kode), kode=0; end;
if isempty(m), m=0; end;
if isempty(n), n=0; end;
if isempty(nm), nm=0; end;
if isempty(nn), nn=0; end;
if isempty(nz), nz=0; end;
if isempty(er), er=0; end;
if isempty(euler), euler=0; end;
if isempty(psi1), psi1=zeros(1,3); end;
if isempty(psi2), psi2=zeros(1,20); end;
if isempty(r1m4), r1m4=0; end;
if isempty(s), s=0; end;
if isempty(tol), tol=0; end;
if isempty(x), x=0; end;
if firstCall,   euler=[0.5772156649015328606e0];  end;
firstCall=0;
[r1m4 ]=r1mach(4);
tol = 1000.0e0.*max(r1m4,1.0e-18);
if( kprint>=3 )
writef(lun,['1', '\n ' , '\n ' ,' QUICK CHECK DIAGNOSTICS FOR PSIFN', '\n ' , '\n '  ' \n']);
end;
%format ('1'//' QUICK CHECK DIAGNOSTICS FOR PSIFN'/];
iflg = 0;
n = 0;
for kode = 1 : 2;
for m = 1 : 2;
s = -euler +(m-1).*(-2.0e0.*log(2.0e0));
x = 1.0e0 -(m-1).*0.5e0;
for i = 1 : 20;
[x,n,kode,dumvar4,psi2,nz,ierr]=psifn(x,n,kode,1,psi2,nz,ierr);
psi1(1) = -s +(kode-1).*log(x);
er = abs((psi1(1)-psi2(1))./psi1(1));
if( er>tol )
if( iflg==0 )
if( kprint>=2 )
writef(lun,[repmat(' ',1,8),'X',repmat(' ',1,13),'PSI1',repmat(' ',1,11),'PSI2',repmat(' ',1,9),'REL ERR',repmat(' ',1,5),'KODE',repmat(' ',1,3),'N' ' \n']);
end;
end;
iflg = fix(iflg + 1);
if( kprint>=2 )
writef(lun,[repmat('%15.6f',1,4),repmat('%5i',1,2) ' \n'], x , psi1(1) , psi2(i) ,er , kode , n);
end;
if( iflg>200 )
if( kprint>=2 )
writef(lun,[ '\n ' , '\n ' ,' PROCESSING OF MAIN LOOPS TERMINATED BECAUSE THE NUM','BER OF DIAGNOSTIC PRINTS EXCEEDS 200', '\n ' , '\n '  ' \n']);
end;
%format [/' PROCESSING OF MAIN LOOPS TERMINATED BECAUSE THE NUM','BER OF DIAGNOSTIC PRINTS EXCEEDS 200'/];
ipass = 0;
if( iflg==0 )
ipass = 1;
end;
return;
end;
end;
s = s + 1.0e0./x;
x = x + 1.0e0;
end; i = fix(20+1);
end; m = fix(2+1);
end; kode = fix(2+1);
kode = 1;
x = tol./10000.0e0;
n = 1;
[x,n,kode,dumvar4,psi2,nz,ierr]=psifn(x,n,kode,1,psi2,nz,ierr);
psi1(1) = x.^(-n-1);
er = abs((psi1(1)-psi2(1))./psi1(1));
if( er>tol )
if( iflg==0 )
if( kprint>=2 )
writef(lun,[repmat(' ',1,8),'X',repmat(' ',1,13),'PSI1',repmat(' ',1,11),'PSI2',repmat(' ',1,9),'REL ERR',repmat(' ',1,5),'KODE',repmat(' ',1,3),'N' ' \n']);
end;
end;
iflg = fix(iflg + 1);
if( kprint>=2 )
writef(lun,[repmat('%15.6f',1,4),repmat('%5i',1,2) ' \n'], x , psi1(1) , psi2(1) , er ,kode , n);
end;
end;
for kode = 1 : 2;
for m = 1 : 5;
for n = 1 : 5: 16 ;
nn = fix(n - 1);
x = 0.1e0;
for ix = 1 : 2: 25 ;
x = x + 1.0e0;
[x,nn,kode,m,psi2,nz,ierr]=psifn(x,nn,kode,m,psi2,nz,ierr);
for i = 1 : m;
nm = fix(nn + i - 1);
[x,nm,kode,dumvar4,psi1,nz,ierr]=psifn(x,nm,kode,1,psi1,nz,ierr);
er = abs((psi2(i)-psi1(1))./psi1(1));
if( er>=tol)
if( iflg==0 )
if( kprint>=2 )
writef(lun,[repmat(' ',1,8),'X',repmat(' ',1,13),'PSI1',repmat(' ',1,11),'PSI2',repmat(' ',1,9),'REL ERR',repmat(' ',1,5),'KODE',repmat(' ',1,3),'N' ' \n']);
end;
end;
iflg = fix(iflg + 1);
if( kprint>=2 )
writef(lun,[repmat('%15.6f',1,4),repmat('%5i',1,2) ' \n'], x , psi1(1) , psi2(i) ,er , kode , nm);
end;
end;
end; i = fix(m+1);
end; ix = fix(25 +1);
end; n = fix(16 +1);
end; m = fix(5+1);
end; kode = fix(2+1);
if( iflg==0 && kprint>=3 )
writef(lun,[ '\n ' , '\n ' ,' QUICK CHECKS OK', '\n ' , '\n '  ' \n']);
%format [/' QUICK CHECKS OK'/];
end;
ipass = 0;
if( iflg==0 )
ipass = 1;
end;
return;
%format (8X,'X',13X,'PSI1',11X,'PSI2',9X,'REL ERR',5X,'KODE',3X,'N');
%format(4e15.6,2i5);
end %subroutine qcpsi