Code covered by the BSD License  

Highlights from
slatec

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

[lun,kprint,ipass]=qcrc(lun,kprint,ipass);
function [lun,kprint,ipass]=qcrc(lun,kprint,ipass);
persistent contrl dif ier ipass1 ipass2 ipass3 ipass4 kontrl pi trc ; 

if isempty(contrl), contrl=0; end;
if isempty(kontrl), kontrl=0; end;
if isempty(ier), ier=0; end;
if isempty(ipass1), ipass1=0; end;
if isempty(ipass2), ipass2=0; end;
if isempty(ipass3), ipass3=0; end;
if isempty(ipass4), ipass4=0; end;
if isempty(pi), pi=0; end;
if isempty(trc), trc=0; end;
if isempty(dif), dif=0; end;
xerclr;
[contrl]=xgetf(contrl);
if( kprint>=3 )
kontrl = +1;
else;
kontrl = 0;
end;
[kontrl]=xsetf(kontrl);
if( kprint>=3 )
writef(lun,[' RC - FORCE ERROR 1 TO OCCUR' ' \n']);
end;
%format (' RC - FORCE ERROR 1 TO OCCUR');
[trc ,dumvar2,dumvar3,ier]=rc(-1.0e0,-1.0e0,ier);
ier = fix(numxer(ier));
if( ier==1 )
ipass1 = 1;
else;
ipass1 = 0;
end;
xerclr;
if( kprint>=3 )
writef(lun,[' RC - FORCE ERROR 2 TO OCCUR' ' \n']);
end;
%format (' RC - FORCE ERROR 2 TO OCCUR');
[trc ,dumvar2,dumvar3,ier]=rc(r1mach(1),r1mach(1),ier);
ier = fix(numxer(ier));
if( ier==2 )
ipass2 = 1;
else;
ipass2 = 0;
end;
xerclr;
if( kprint>=3 )
writef(lun,[' RC - FORCE ERROR 3 TO OCCUR' ' \n']);
end;
%format (' RC - FORCE ERROR 3 TO OCCUR');
[trc ,dumvar2,dumvar3,ier]=rc(r1mach(2),r1mach(2),ier);
ier = fix(numxer(ier));
if( ier==3 )
ipass3 = 1;
else;
ipass3 = 0;
end;
xerclr;
pi = 3.1415926535897932e0;
[trc ,dumvar2,dumvar3,ier]=rc(0.0e0,0.25e0,ier);
xerclr;
dif = trc - pi;
if((abs(dif./pi)<1000.0e0.*r1mach(4)) &&(ier==0) )
ipass4 = 1;
else;
ipass4 = 0;
end;
ipass = fix(min([ipass1,ipass2,ipass3,ipass4]));
if( kprint<=0 )
elseif( kprint==1 ) ;
if( ipass~=1 )
writef(lun,[' RC - FAILED' ' \n']);
end;
elseif( ipass==1 ) ;
writef(lun,[' RC - PASSED' ' \n']);
%format (' RC - PASSED');
else;
writef(lun,[' RC - FAILED' ' \n']);
if( ipass4==0 )
writef(lun,[' CORRECT ANSWER =',repmat('%14.6f',1,1), '\n ' ,'COMPUTED ANSWER =','%14.6f', '\n ' ,'     DIFFERENCE =','%14.6f' ' \n'], pi , trc , dif);
end;
%format (' CORRECT ANSWER =',1PE14.6/'COMPUTED ANSWER =',e14.6/'     DIFFERENCE =',e14.6);
end;
[contrl]=xsetf(contrl);
%format (' RC - FAILED');
end %subroutine qcrc

Contact us