function [lun,kprint,ipass]=fcnqx2(lun,kprint,ipass);
persistent c1 c2 deg dnu1 dzero fmt fmtf fmti i ic1 ic2 id ierr ierror igo igo1 ip ipn iq ir irad isig isum ix11 ix12 ix13 ix21 ix22 ix23 mu mu1 mu2 n nbits ndec nerr nradpl nu nu1 nudiff p pn q r theta x11 x12 x13 x21 x22 x23 ;
if isempty(i), i=0; end;
if isempty(ic1), ic1=zeros(1,10); end;
if isempty(ic2), ic2=zeros(1,10); end;
if isempty(id), id=0; end;
if isempty(ierr), ierr=0; end;
if isempty(ierror), ierror=0; end;
if isempty(ip), ip=zeros(1,10); end;
if isempty(ipn), ipn=zeros(1,10); end;
if isempty(iq), iq=zeros(1,10); end;
if isempty(ir), ir=zeros(1,10); end;
if isempty(irad), irad=0; end;
if isempty(isig), isig=0; end;
if isempty(isum), isum=0; end;
if isempty(ix11), ix11=0; end;
if isempty(ix12), ix12=0; end;
if isempty(ix13), ix13=0; end;
if isempty(ix21), ix21=0; end;
if isempty(ix22), ix22=0; end;
if isempty(ix23), ix23=0; end;
if isempty(igo), igo=0; end;
if isempty(igo1), igo1=0; end;
if isempty(mu), mu=0; end;
if isempty(mu1), mu1=0; end;
if isempty(mu2), mu2=0; end;
if isempty(n), n=0; end;
if isempty(nbits), nbits=0; end;
if isempty(ndec), ndec=0; end;
if isempty(nerr), nerr=0; end;
if isempty(nradpl), nradpl=0; end;
if isempty(nu1), nu1=0; end;
if isempty(nudiff), nudiff=0; end;
if isempty(fmt), fmt=repmat(' ',1,34); end;
if isempty(fmtf), fmtf=repmat(' ',1,34); end;
if isempty(fmti), fmti=repmat(' ',1,34); end;
if isempty(p), p=zeros(1,10); end;
if isempty(q), q=zeros(1,10); end;
if isempty(r), r=zeros(1,10); end;
if isempty(c1), c1=zeros(1,10); end;
if isempty(c2), c2=zeros(1,10); end;
if isempty(pn), pn=zeros(1,10); end;
if isempty(deg), deg=0; end;
if isempty(theta), theta=0; end;
if isempty(dnu1), dnu1=0; end;
if isempty(dzero), dzero=0; end;
if isempty(x11), x11=0; end;
if isempty(x12), x12=0; end;
if isempty(x13), x13=0; end;
if isempty(x21), x21=0; end;
if isempty(x22), x22=0; end;
if isempty(x23), x23=0; end;
if isempty(nu), nu=0; end;
if( kprint>=2 )
writef(lun,[' ** TEST doubleprecision LEGENDRE FUNCTION ROUTINES',' IN FCNPAK ** ', '\n ' ' \n']);
end;
%format (' ** TEST doubleprecision LEGENDRE FUNCTION ROUTINES',' IN FCNPAK ** ',];
ipass = 1;
irad = 0;
nradpl = 0;
dzero = 0.0d0;
nbits = 0;
[irad,nradpl,dzero,nbits,ierror]=dxset(irad,nradpl,dzero,nbits,ierror);
if( ierror~=0 )
ipass = 0;
end;
ierr = 0;
dnu1 = 2000.4d0;
if( i1mach(16).*log10(real(i1mach(10)))<150. )
dnu1 = 100.4d0;
end;
if( kprint>2 )
if( i1mach(16)<500 )
writef(lun,[' ON COMPUTERS WITH MAXIMUM EXPONENT LESS THAN 500, SMALL', '\n ' ,' TEST VALUES FOR NU, MU ARE USED. IF LARGER THAN OR EQUAL 500,', '\n ' ,' LARGER VALUES ARE USED. THIS COMPUTER USES THE SMALLER VALUES.' ' \n']);
end;
%format (' ON COMPUTERS WITH MAXIMUM EXPONENT LESS THAN 500, SMALL'/' TEST VALUES FOR NU, MU ARE USED. IF LARGER THAN OR EQUAL 500,'/' LARGER VALUES ARE USED. THIS COMPUTER USES THE SMALLER VALUES.');
if( i1mach(16)>=500 )
writef(lun,[' ON COMPUTERS WITH MAXIMUM EXPONENT LESS THAN 500, SMALL', '\n ' ,' TEST VALUES FOR NU, MU ARE USED. IF LARGER THAN OR EQUAL 500,', '\n ' ,' LARGER VALUES ARE USED. THIS COMPUTER USES THE LARGER VALUES.' ' \n']);
end;
%format (' ON COMPUTERS WITH MAXIMUM EXPONENT LESS THAN 500, SMALL'/' TEST VALUES FOR NU, MU ARE USED. IF LARGER THAN OR EQUAL 500,'/' LARGER VALUES ARE USED. THIS COMPUTER USES THE LARGER VALUES.');
end;
nudiff = 5;
mu1 = fix(dnu1);
mu2 = fix(mu1);
deg = 0.1d0;
theta = deg.*4.0d0.*atan(1.0d0)./180.0d0;
isum = 0;
ndec =fix((i1mach(14)-1).*log10(real(i1mach(10))));
fmt([1:20]) = '(1X, 6X, 4H (,E50.';
fmt([21:min(length(fmt),22)])=sprintf(['%2i'], ndec);
fmt([23:34]) = ',1H,,I8,1H))';
fmtf([1:20]) = '(1X,F6.1,4H (,E50.';
fmtf([21:min(length(fmtf),22)])=sprintf(['%2i'], ndec);
fmtf([23:34]) = ',1H,,I8,1H))';
fmti([1:20]) = '(1X, I6, 4H (,E50.';
fmti([21:min(length(fmti),22)])=sprintf(['%2i'], ndec);
fmti([23:34]) = ',1H,,I8,1H))';
if( kprint>2 )
writef(lun,[ '\n ' ,' TEST 1, FIXED MU = ','%4i',' AND THETA = ','%3.1f',' DEGREES, RECURRENCE IN NU,', '\n ' ,' CASORATIS SHOULD = 1.0' ' \n'], mu1 , deg);
end;
%format [' TEST 1, FIXED MU = ',i4,' AND THETA = ',f3.1,' DEGREES, RECURRENCE IN NU,'/' CASORATIS SHOULD = 1.0');
[dnu1,nudiff,mu1,mu2,theta,dumvar6,p,ip,ierror]=dxlegf(dnu1,nudiff,mu1,mu2,theta,1,p,ip,ierror);
isum = fix(isum + ierror);
[dnu1,nudiff,mu1,mu2,theta,dumvar6,q,iq,ierror]=dxlegf(dnu1,nudiff,mu1,mu2,theta,2,q,iq,ierror);
isum = fix(isum + ierror);
[dnu1,nudiff,mu1,mu2,theta,dumvar6,r,ir,ierror]=dxlegf(dnu1,nudiff,mu1,mu2,theta,3,r,ir,ierror);
isum = fix(isum + ierror);
[dnu1,nudiff,mu1,mu2,theta,p,q,r,ip,iq,ir,c1,ic1,c2,ic2,ierror]=dxcsrt(dnu1,nudiff,mu1,mu2,theta,p,q,r,ip,iq,ir,c1,ic1,c2,ic2,ierror);
isum = fix(isum + ierror);
for i = 1 : 6;
[p(i),ip(i),ierror]=dxcon(p(i),ip(i),ierror);
isum = fix(isum + ierror);
[q(i),iq(i),ierror]=dxcon(q(i),iq(i),ierror);
isum = fix(isum + ierror);
[r(i),ir(i),ierror]=dxcon(r(i),ir(i),ierror);
isum = fix(isum + ierror);
end; i = fix(6+1);
x11 = p(1);
ix11 = fix(ip(1));
x12 = r(1);
ix12 = fix(ir(1));
x13 = q(1);
ix13 = fix(iq(1));
if( kprint>2 )
writef(lun,['%s'], ' NU CASORATI 1');
nu = dnu1;
for i = 1 : 5;
disp({ nu , c1(i) , ic1(i)});
nu = nu + 1.;
end; i = fix(5+1);
writef(lun,['%s'], ' NU CASORATI 2');
nu = dnu1;
for i = 1 : 5;
disp({ nu , c2(i) , ic2(i)});
nu = nu + 1.;
end; i = fix(5+1);
end;
igo=1;
igo1=1;
for i = 1 : 5;
if( abs(1.0d0-c1(i))>=10.0d0.^(6-ndec) )
igo=0;
break;
end;
if( abs(1.0d0-c2(i))>=10.0d0.^(6-ndec) )
igo=0;
break;
end;
end;
if(igo==1)
if( isum==0 )
if( kprint>=2 )
writef(lun,[' TEST 1 (doubleprecision) PASSED ' ' \n']);
end;
%format (' TEST 1 (doubleprecision) PASSED ');
igo1=0;
end;
end;
if(igo1==1)
if( kprint>=1 )
writef(lun,[' TEST 1 (doubleprecision) FAILED ' ' \n']);
end;
%format (' TEST 1 (doubleprecision) FAILED ');
ierr = fix(ierr + 1);
ipass = 0;
end;
nudiff = 0;
mu1 = fix(mu2 - 5);
isum = 0;
if( kprint>2 )
writef(lun,[ '\n ' ,' TEST 2, FIXED NU = ','%6.1f',' AND THETA = ','%3.1f',' DEGREES, RECURRENCE IN MU,', '\n ' ,' CASORATIS SHOULD = 1.0' ' \n'], dnu1 , deg);
end;
%format [' TEST 2, FIXED NU = ',f6.1,' AND THETA = ',f3.1,' DEGREES, RECURRENCE IN MU,'/' CASORATIS SHOULD = 1.0');
[dnu1,nudiff,mu1,mu2,theta,dumvar6,p,ip,ierror]=dxlegf(dnu1,nudiff,mu1,mu2,theta,1,p,ip,ierror);
isum = fix(isum + ierror);
[dnu1,nudiff,mu1,mu2,theta,dumvar6,q,iq,ierror]=dxlegf(dnu1,nudiff,mu1,mu2,theta,2,q,iq,ierror);
isum = fix(isum + ierror);
[dnu1,nudiff,mu1,mu2,theta,dumvar6,r,ir,ierror]=dxlegf(dnu1,nudiff,mu1,mu2,theta,3,r,ir,ierror);
isum = fix(isum + ierror);
[dnu1,nudiff,mu1,mu2,theta,p,q,r,ip,iq,ir,c1,ic1,c2,ic2,ierror]=dxcsrt(dnu1,nudiff,mu1,mu2,theta,p,q,r,ip,iq,ir,c1,ic1,c2,ic2,ierror);
isum = fix(isum + ierror);
for i = 1 : 6;
[p(i),ip(i),ierror]=dxcon(p(i),ip(i),ierror);
isum = fix(isum + ierror);
[q(i),iq(i),ierror]=dxcon(q(i),iq(i),ierror);
isum = fix(isum + ierror);
[r(i),ir(i),ierror]=dxcon(r(i),ir(i),ierror);
isum = fix(isum + ierror);
end; i = fix(6+1);
x21 = p(6);
ix21 = fix(ip(6));
x22 = r(6);
ix22 = fix(ir(6));
x23 = q(6);
ix23 = fix(iq(6));
if( kprint>2 )
writef(lun,['%s'], ' MU CASORATI 3');
mu = fix(mu1);
for i = 1 : 5;
disp({ mu , c1(i) , ic1(i)});
mu = fix(mu + 1);
end; i = fix(5+1);
writef(lun,['%s'], ' MU CASORATI 4');
mu = fix(mu1);
for i = 1 : 5;
disp({ mu , c2(i) , ic2(i)});
mu = fix(mu + 1);
end; i = fix(5+1);
end;
igo=1;
igo1=1;
for i = 1 : 5;
if( abs(1.0d0-c1(i))>=10.0d0.^(6-ndec) || abs(1.0d0-c2(i))>=10.0d0.^(6-ndec) || isum~=0 )
igo=0;
break;
end;
end;
if(igo==1)
if( kprint>=2 )
writef(lun,[' TEST 2 (doubleprecision) PASSED ' ' \n']);
end;
%format (' TEST 2 (doubleprecision) PASSED ');
igo1=0;
end;
if(igo1==1)
if( kprint>=1 )
writef(lun,[' TEST 2 (doubleprecision) FAILED ' ' \n']);
end;
%format (' TEST 2 (doubleprecision) FAILED ');
ierr = fix(ierr + 1);
ipass = 0;
end;
if( kprint>2 )
writef(lun,[ '\n ' ,' TEST 3, COMPARISON OF VALUES FROM TEST 1 AND TEST 2',' WITH THETA = ','%3.1f',' DEGREES,', '\n ' ,' MU = ','%4i',' AND NU = ','%6.1f' ' \n'], deg , mu2 , dnu1);
%format [' TEST 3, COMPARISON OF VALUES FROM TEST 1 AND TEST 2',' WITH THETA = ',f3.1,' DEGREES,'/' MU = ',i4,' AND NU = ',f6.1);
writef(lun,['%s'], ' P(-MU,NU)');
disp({ x11 , ix11});
disp({ x21 , ix21});
writef(lun,['%s'], ' P(MU,NU)');
disp({ x12 , ix12});
disp({ x22 , ix22});
writef(lun,['%s'], ' Q(MU,NU)');
disp({ x13 , ix13});
disp({ x23 , ix23});
end;
if( abs((x11-x21)./x11)<10.0d0.^(6-ndec) && abs((x12-x22)./x12)<10.0d0.^(6-ndec) && abs((x13-x23)./x13)<10.0d0.^(6-ndec) && ix11==ix21 && ix12==ix22 && ix13==ix23 )
if( kprint>=2 )
writef(lun,[' TEST 3 (doubleprecision) PASSED ' ' \n']);
end;
%format (' TEST 3 (doubleprecision) PASSED ');
else;
if( kprint>=1 )
writef(lun,[' TEST 3 (doubleprecision) FAILED ' ' \n']);
end;
%format (' TEST 3 (doubleprecision) FAILED ');
ierr = fix(ierr + 1);
ipass = 0;
end;
isum = 0;
dnu1 = 100.0d0;
nudiff = 0;
mu1 = 10;
mu2 = 10;
if( kprint>2 )
writef(lun,[ '\n ' ,' TEST 4, COMPARISON OF VALUES FROM DXLEGF AND DXNRMP',' WITH THETA = ','%3.1f',' DEGREES,', '\n ' ,' MU = ','%4i',' AND NU = ','%6.1f' ' \n'], deg , mu1 , dnu1);
end;
%format [' TEST 4, COMPARISON OF VALUES FROM DXLEGF AND DXNRMP',' WITH THETA = ',f3.1,' DEGREES,'/' MU = ',i4,' AND NU = ',f6.1);
[dnu1,nudiff,mu1,mu2,theta,dumvar6,pn,ipn,ierror]=dxlegf(dnu1,nudiff,mu1,mu2,theta,4,pn,ipn,ierror);
isum = fix(isum + ierror);
x11 = pn(1);
ix11 = fix(ipn(1));
nu1 = 100;
[nu1,mu1,mu2,theta,dumvar5,pn,ipn,isig,ierror]=dxnrmp(nu1,mu1,mu2,theta,2,pn,ipn,isig,ierror);
isum = fix(isum + ierror);
x21 = pn(1);
ix21 = fix(ipn(1));
if( kprint>2 )
writef(lun,['%s'], ' NORMALIZED P');
disp({ x11 , ix11});
disp({ x21 , ix21});
end;
if( abs((x11-x21)./x11)<10.0d0.^(6-ndec) && ix11==ix21 && isum==0 )
if( kprint>=2 )
writef(lun,[' TEST 4 (doubleprecision) PASSED ' ' \n']);
end;
%format (' TEST 4 (doubleprecision) PASSED ');
else;
if( kprint>=1 )
writef(lun,[' TEST 4 (doubleprecision) FAILED ' ' \n']);
end;
%format (' TEST 4 (doubleprecision) FAILED ');
ierr = fix(ierr + 1);
ipass = 0;
end;
xsetf(-1);
if( kprint<=2 )
xsetf(0);
end;
if( kprint>2 )
writef(lun,[ '\n ' ,' TEST 5, TEST OF ERROR HANDLING. 3 ERROR MESSAGES',' SHOULD BE PRINTED.' ' \n']);
end;
%format [' TEST 5, TEST OF ERROR HANDLING. 3 ERROR MESSAGES',' SHOULD BE PRINTED.');
nudiff = 0;
mu2 = fix(mu1);
id = 5;
xerclr;
[dnu1,nudiff,mu1,mu2,theta,id,p,ip,ierror]=dxlegf(dnu1,nudiff,mu1,mu2,theta,id,p,ip,ierror);
[n ,nerr]=numxer(nerr);
igo=1;
if( n==ierror )
mu2 = fix(mu1 + 5);
nudiff = 5;
xerclr;
[dnu1,nudiff,mu1,mu2,theta,dumvar6,p,ip,ierror]=dxlegf(dnu1,nudiff,mu1,mu2,theta,1,p,ip,ierror);
[n ,nerr]=numxer(nerr);
if( n==ierror )
nudiff = 0;
theta = 2.0d0;
xerclr;
[dnu1,nudiff,mu1,mu2,theta,dumvar6,p,ip,ierror]=dxlegf(dnu1,nudiff,mu1,mu2,theta,1,p,ip,ierror);
[n ,nerr]=numxer(nerr);
if( n==ierror )
if( kprint>=2 )
writef(lun,[' TEST 5 (doubleprecision) PASSED ' ' \n']);
end;
%format (' TEST 5 (doubleprecision) PASSED ');
igo=0;
end;
end;
end;
if(igo==1)
if( kprint>=1 )
writef(lun,[' TEST 5 (doubleprecision) FAILED ' ' \n']);
end;
%format (' TEST 5 (doubleprecision) FAILED ');
ierr = fix(ierr + 1);
ipass = 0;
end;
if( ierr~=0 )
if( kprint>=2 )
writef(lun,[ '\n ' ,' TESTS COMPLETED, NUMBER OF TESTS FAILED = ','%2i' ' \n'], ierr);
end;
%format [' TESTS COMPLETED, NUMBER OF TESTS FAILED = ',i2);
end;
end %subroutine fcnqx2
