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

function [lun,kprint,ipass]=qcdrj(lun,kprint,ipass);
persistent consj contrl dif ier ipass1 ipass2 ipass3 ipass4 kontrl trj ; 

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(consj), consj=0; end;
if isempty(trj), trj=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,[' DRJ - FORCE ERROR 1 TO OCCUR' ' \n']);
end;
%format (' DRJ - FORCE ERROR 1 TO OCCUR');
[trj ,dumvar2,dumvar3,dumvar4,dumvar5,ier]=drj(-1.0d0,-1.0d0,-1.0d0,-1.0d0,ier);
ier = fix(numxer(ier));
if( ier==1 )
ipass1 = 1;
else;
ipass1 = 0;
end;
xerclr;
if( kprint>=3 )
writef(lun,[' DRJ - FORCE ERROR 2 TO OCCUR' ' \n']);
end;
%format (' DRJ - FORCE ERROR 2 TO OCCUR');
[trj ,dumvar2,dumvar3,dumvar4,dumvar5,ier]=drj(d1mach(1),d1mach(1),d1mach(1),d1mach(1),ier);
ier = fix(numxer(ier));
if( ier==2 )
ipass2 = 1;
else;
ipass2 = 0;
end;
xerclr;
if( kprint>=3 )
writef(lun,[' DRJ - FORCE ERROR 3 TO OCCUR' ' \n']);
end;
%format (' DRJ - FORCE ERROR 3 TO OCCUR');
[trj ,dumvar2,dumvar3,dumvar4,dumvar5,ier]=drj(d1mach(2),d1mach(2),d1mach(2),d1mach(2),ier);
ier = fix(numxer(ier));
if( ier==3 )
ipass3 = 1;
else;
ipass3 = 0;
end;
xerclr;
consj = 0.14297579667156753833233879421985774801d0;
[trj ,dumvar2,dumvar3,dumvar4,dumvar5,ier]=drj(2.0d0,3.0d0,4.0d0,5.0d0,ier);
xerclr;
dif = trj - consj;
if((abs(dif./consj)<1000.0d0.*d1mach(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,[' DRJ - FAILED' ' \n']);
end;
elseif( ipass==1 ) ;
writef(lun,[' DRJ - PASSED' ' \n']);
%format (' DRJ - PASSED');
else;
writef(lun,[' DRJ - FAILED' ' \n']);
if( ipass4==0 )
writef(lun,[' CORRECT ANSWER =',repmat('%20.14f',1,1), '\n ' ,'COMPUTED ANSWER =','%20.14f', '\n ' ,'     DIFFERENCE =','%20.14f' ' \n'], consj , trj , dif);
end;
%format (' CORRECT ANSWER =',1PD20.14/'COMPUTED ANSWER =',d20.14/'     DIFFERENCE =',d20.14);
end;
[contrl]=xsetf(contrl);
%format (' DRJ - FAILED');
end %subroutine qcdrj