function [lun,kprint,ipass]=qg8tst(lun,kprint,ipass);
persistent a ansmlv b cor err fatal ierr kontrl req tol ;
if isempty(ierr), ierr=0; end;
if isempty(kontrl), kontrl=0; end;
if isempty(a), a=0; end;
if isempty(ansmlv), ansmlv=0; end;
if isempty(b), b=0; end;
if isempty(cor), cor=0; end;
if isempty(err), err=0; end;
if isempty(req), req=0; end;
if isempty(tol), tol=0; end;
if isempty(fatal), fatal=false; end;
if( kprint>=2 )
writef(lun,['1', '\n ' ,' GAUS8 Quick Check' ' \n']);
end;
tol = sqrt(r1mach(4));
ipass = 1;
a = 1.0e0;
b = 4.0e0;
err = tol./100.0e0;
[dumvar1,a,b,err,ansmlv,ierr]=gaus8(@fqd1,a,b,err,ansmlv,ierr);
cor = 2.0e0;
if( abs(ansmlv-cor)<=tol && ierr==1 )
if( kprint>=3 )
writef(lun,[ '\n ' ,' Accuracy test of GAUS8 ','%s', '\n ' ,' A = ','%10.5f',' B = ','%10.5f', '\n ' ,' Computed result = ','%14.7f',' Exact result = ','%14.7f', '\n ' ,' Tolerance = ','%14.7f',' IERR = ','%2i', '\n ' ' \n'], 'PASSED' , a , b , ansmlv , cor ,err , ierr);
end;
else;
ipass = 0;
if( kprint>=2 )
writef(lun,[ '\n ' ,' Accuracy test of GAUS8 ','%s', '\n ' ,' A = ','%10.5f',' B = ','%10.5f', '\n ' ,' Computed result = ','%14.7f',' Exact result = ','%14.7f', '\n ' ,' Tolerance = ','%14.7f',' IERR = ','%2i', '\n ' ' \n'], 'FAILED' , a , b , ansmlv , cor ,err , ierr);
end;
end;
a = 0.0e0;
b = 4.0e0.*atan(1.0e0);
err = tol./100.0e0;
[dumvar1,a,b,err,ansmlv,ierr]=gaus8(@fqd2,a,b,err,ansmlv,ierr);
cor =(exp(b)-1.0e0)./101.0e0;
if( abs(ansmlv-cor)<=tol && ierr==1 )
if( kprint>=3 )
writef(lun,[ '\n ' ,' Accuracy test of GAUS8 ','%s', '\n ' ,' A = ','%10.5f',' B = ','%10.5f', '\n ' ,' Computed result = ','%14.7f',' Exact result = ','%14.7f', '\n ' ,' Tolerance = ','%14.7f',' IERR = ','%2i', '\n ' ' \n'], 'PASSED' , a , b , ansmlv , cor ,err , ierr);
end;
else;
ipass = 0;
if( kprint>=2 )
writef(lun,[ '\n ' ,' Accuracy test of GAUS8 ','%s', '\n ' ,' A = ','%10.5f',' B = ','%10.5f', '\n ' ,' Computed result = ','%14.7f',' Exact result = ','%14.7f', '\n ' ,' Tolerance = ','%14.7f',' IERR = ','%2i', '\n ' ' \n'], 'FAILED' , a , b , ansmlv , cor ,err , ierr);
end;
end;
[kontrl]=xgetf(kontrl);
if( kprint<=2 )
xsetf(0);
else;
xsetf(1);
end;
fatal = false;
if( kprint>=3 )
writef(lun,[ '\n ' ,' Test error returns', '\n ' ,' 2 error messages expected', '\n ' ' \n']);
end;
a = 0.0e0;
b = 1.0e0;
cor = 2.0e0;
err = 100.0e0.*r1mach(4);
req = err;
[dumvar1,a,b,err,ansmlv,ierr]=gaus8(@fqd1,a,b,err,ansmlv,ierr);
if( ierr==2 )
if( kprint>=3 )
writef(lun,[' Test of GAUS8 ','%s', '\n ' ,' REQ =','%10.2f',repmat(' ',1,5),'ANS =','%20.13f',repmat(' ',1,5),'IERR =','%2i',repmat(' ',1,5),' should be 2', '\n ' ,' ERR =','%10.2f',' CORRECT =','%20.13f', '\n ' ' \n'], 'PASSED' , req , ansmlv ,ierr , err , cor);
end;
else;
if( kprint>=2 )
writef(lun,[' Test of GAUS8 ','%s', '\n ' ,' REQ =','%10.2f',repmat(' ',1,5),'ANS =','%20.13f',repmat(' ',1,5),'IERR =','%2i',repmat(' ',1,5),' should be 2', '\n ' ,' ERR =','%10.2f',' CORRECT =','%20.13f', '\n ' ' \n'], 'PASSED' , req , ansmlv ,ierr , err , cor);
end;
ipass = 0;
fatal = true;
end;
a = 2.0e0;
b = a.*(1.0e0+r1mach(4));
cor = 0.0e0;
err = tol;
[dumvar1,a,b,err,ansmlv,ierr]=gaus8(@fqd1,a,b,err,ansmlv,ierr);
if( ierr==-1 && ansmlv==0.0e0 )
if( kprint>=3 )
writef(lun,[' Test of A and B nearly equal ','%s' ' \n'], 'PASSED');
end;
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
writef(lun,[' Test of A and B nearly equal ','%s' ' \n'], 'FAILED');
end;
end;
[kontrl]=xsetf(kontrl);
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>=3 )
writef(lun,[ '\n ' ,' GAUS8 PASSED ALL TESTS' ' \n']);
end;
if( ipass==0 && kprint>=2 )
writef(lun,[ '\n ' ,' GAUS8 FAILED SOME TESTS****' ' \n']);
end;
return;
%format ('1'/' GAUS8 Quick Check');
%format [' Accuracy test of GAUS8 ',a/' A = ',f10.5,' B = ',f10.5/' Computed result = ',e14.7,' Exact result = ',e14.7/' Tolerance = ',e14.7,' IERR = ',i2];
%format [' Test error returns'/' 2 error messages expected'];
%format (' Test of GAUS8 ',a/' REQ =',e10.2,5X,'ANS =',e20.13,5X,'IERR =',i2,5X,' should be 2'/' ERR =',e10.2,' CORRECT =',e20.13];
%format (' Test of A and B nearly equal ',a);
%format [,' GAUS8 PASSED ALL TESTS');
%format [,' GAUS8 FAILED SOME TESTS****');
end %subroutine qg8tst