*DECK CFNCK SUBROUTINE CFNCK (LUN, KPRINT, IPASS) C***BEGIN PROLOGUE CFNCK C***PURPOSE Quick check for the complex Fullerton special functions. C***LIBRARY SLATEC C***KEYWORDS QUICK CHECK C***AUTHOR Boland, W. Robert, (LANL) C Chow, Jeff, (LANL) C Rivera, Shawn, (LANL) C***DESCRIPTION C C This subroutine does a quick check for the complex C routines in the Fullerton special function library. C C Parameter list- C C LUN input integer value to designate the external C device unit for message output C KPRINT input integer value to specify amount of C printing to be done by quick check C IPASS output value indicating whether tests passed or C failed C C***ROUTINES CALLED C0LGMC, CACOS, CACOSH, CASIN, CASINH, CATAN, C CATAN2, CATANH, CBETA, CCBRT, CCOSH, CCOT, CEXPRL, C CGAMMA, CGAMR, CLBETA, CLNGAM, CLNREL, CLOG10, C CPSI, CSINH, CTAN, CTANH, R1MACH C***REVISION HISTORY (YYMMDD) C 800901 DATE WRITTEN C 891115 REVISION DATE from Version 3.2 C 891120 Checks of remainder of FNLIB routines added and code C reorganized. (WRB) C 900330 Prologue converted to Version 4.0 format. (BAB) C 900727 Added EXTERNAL statement. (WRB) C***END PROLOGUE CFNCK INTEGER I,LUN,KPRINT,IPASS REAL SQRT2,SQRT3,PI,R1MACH, + ERRMAX,ERRTOL,ABSERR,RELERR COMPLEX C(48),W(48),C1,CI, + C0LGMC,CACOS,CACOSH,CASIN,CASINH,CATAN,CATAN2,CATANH, + CBETA,CCBRT,CCOSH,CCOT,CEXPRL,CGAMMA,CGAMR,CLBETA,CLNGAM, + CLNREL,CLOG10,CPSI,CSINH,CTAN,CTANH EXTERNAL CCOT, CGAMMA C C Constants to be used C DATA C1 /(1.E0,0.E0)/,CI /(0.E0,1.E0)/ DATA SQRT2 /.1414213562 3730950488E1/ DATA SQRT3 /.1732050807 5688772935E1/ DATA PI /3.1415926535 8979323846E0/ C C Complex values through different calculations are stored in C(*) C DATA C( 1) /( .121699028117870E 1, .326091563038355E 0)/ DATA C( 2) /( .866025403784438E 0, .500000000000000E 0)/ DATA C( 3) /( .520802437952465E 0,-.196048071390002E 1)/ DATA C( 4) /( .599865470357589E 0, .113287925945897E 1)/ DATA C( 5) /( .970930856437313E 0,-.113287925945897E 1)/ DATA C( 6) /( .104999388884240E 1, .196048071389998E 1)/ DATA C( 7) /( .313314753080534E-1, .541264220944095E-1)/ DATA C( 8) /(-.785398163397449E 0, .658478948462413E 0)/ DATA C( 9) /(-.785398163397449E 0,-.658478948462413E 0)/ DATA C(10) /( .785398163397449E 0,-.658478948462413E 0)/ DATA C(11) /( .313314753080534E-1, .541264220944095E-1)/ DATA C(12) /(-.313314753080534E-1, .541264220944095E-1)/ DATA C(13) /( .183048772171245E 1, .000000000000000E 0)/ DATA C(14) /(-.757236713834364E-1,-.961745759068982E 0)/ DATA C(15) /(-.813630257280238E-1, .103336966511721E 1)/ DATA C(16) /( .546302489843789E 0, .000000000000000E 0)/ DATA C(17) /( .150514997831990E 0,-.341094088460459E 0)/ DATA C(18) /( .301029995663980E 0, .227396058973639E 0)/ DATA C(19) /( .000000000000000E 0, .636619772367581E 0)/ DATA C(20) /( .137802461354738E 1, .909330673631480E 0)/ DATA C(21) /( .303123109082158E-1,-.244978663126864E 0)/ DATA C(22) /( .693147180559947E 0, .523598775598298E 0)/ DATA C(23) /(-.152857091948100E 1, .114371774040242E 1)/ DATA C(24) /( .144363547517882E 1, .157079632679490E 1)/ DATA C(25) /(-.100000000000000E 1, .000000000000000E 0)/ DATA C(26) /( .181878614736412E 1, .586225017697977E 0)/ DATA C(27) /( .402359478108525E 0, .101722196789785E 1)/ DATA C(28) /( .549306144334055E 0,-.157079632679490E 1)/ DATA C(29) /( .000000000000000E 0,-.117520119364380E 1)/ DATA C(30) /(-.642148124715515E 0,-.106860742138277E 1)/ DATA C(31) /( .397515306849130E 0, .104467701612914E 1)/ DATA C(32) /(-.117520119364380E 1, .000000000000000E 0)/ DATA C(33) /(-.116673625724091E 1,-.243458201185722E 0)/ DATA C(34) /( .761594155955766E 0, .000000000000000E 0)/ DATA C(35) /( .365427607174532E-1,-.612881308922810E-1)/ DATA C(36) /( .896860330225849E-2, .244804656578857E-1)/ DATA C(37) /( .177245385090552E 1, .000000000000000E 0)/ DATA C(38) /( .300694617260656E 0,-.424967879433124E 0)/ DATA C(39) /( .110951302025214E 1,-.156806064476794E 1)/ DATA C(40) /( .183074439659052E 1, .569607641036682E 0)/ DATA C(41) /(-.340863758923258E 1, .142127515954291E 1)/ DATA C(42) /(-.156059525546301E 1, .152533527872833E 1)/ DATA C(43) /(-.211272372936533E 0,-.765528316537801E 0)/ DATA C(44) /( .380273164249058E-1,-.286343074460341E 0)/ DATA C(45) /(-.268079774264798E 1, .130151697855085E 1)/ DATA C(46) /(-.164841998888369E 1, .785398163397448E 0)/ DATA C(47) /(-.196351002602143E 1, .000000000000000E 0)/ DATA C(48) /( .161278484461574E 1, .147079632679497E 1)/ C***FIRST EXECUTABLE STATEMENT CFNCK C C Compute functional values C C Exercise routines in Category C2. C W( 1) = CCBRT(SQRT2*(1.E0+CI)) W( 2) = CCBRT(CI) C C Exercise routines in Category C4A. C W( 3) = CACOS(PI+SQRT3*CI) W( 4) = CACOS(SQRT2-.25E0*PI*CI) W( 5) = CASIN(SQRT2-.25E0*PI*CI) W( 6) = CASIN(PI+SQRT3*CI) W( 7) = CATAN(.3125E-1+.541265877365273E-1*CI) W( 8) = CATAN(-.5E0+.866025403784438E0*CI) W( 9) = CATAN2(-.5E0-.866025403784438E0*CI,C1) W(10) = CATAN2(.5E0-.866025403784438E0*CI,C1) W(11) = CATAN2(.3125E-1+.541265877365273E-1*CI,C1) W(12) = CATAN2(-.3125E-1+.541265877365273E-1*CI,C1) W(13) = CCOT(.5E0+0.E0*CI) W(14) = CCOT(-1.E0+.5E0*PI*CI) W(15) = CTAN(-1.E0+.5E0*PI*CI) W(16) = CTAN(.5E0+0.E0*CI) C C Exercise routines in Category C4B. C W(17) = CLOG10(1.E0-CI) W(18) = CLOG10(SQRT3+CI) W(19) = CEXPRL(PI*CI) W(20) = CEXPRL(1.E0+CI) W(21) = CLNREL(-.25E0*CI) W(22) = CLNREL(SQRT3-1.E0+CI) C C Exercise routines in Category C4C. C W(23) = CACOSH(1.E0-2.E0*CI) W(24) = CACOSH(2.E0*CI) W(25) = CASINH(-.117520119364380E1+0.E0*CI) W(26) = CASINH(2.5E0+1.75E0*CI) W(27) = CATANH(1.E0+1.E0*CI) W(28) = CATANH(2.E0+0.E0*CI) W(29) = CCOSH(1.E0-.5E0*PI*CI) W(30) = CCOSH(-1.E0+2.E0*CI) W(31) = CSINH(1.E0-1.E0/PI+CI) W(32) = CSINH(1.E0+PI*CI) W(33) = CTANH(-1.E0+2.E0*CI) W(34) = CTANH(1.E0+PI*CI) C C Exercise routines in Category C7A. C W(35) = C0LGMC(.5E0+.5E0*CI) W(36) = C0LGMC(1.E0-1.E0*CI) W(37) = CGAMMA(.5E0+0.E0*CI) W(38) = CGAMMA(.5E0+CI) W(39) = CGAMR(.5E0-CI) W(40) = CGAMR(1.E0+CI) W(41) = CLNGAM(1.1E0+3.2E0*CI) W(42) = CLNGAM(1.9E0+2.4E0*CI) C C Exercise routines in Category C7B. C W(43) = CBETA(1.E0+CI,1.E0+CI) W(44) = CBETA(2.E0-CI,.5E0+CI) W(45) = CLBETA(2.E0+CI,1.E0-2.E0*CI) W(46) = CLBETA(1.E0-CI,2.E0+CI) C C Exercise routines in Category C7C. C W(47) = CPSI(.5E0+0.E0*CI) W(48) = CPSI(1.E0+5.E0*CI) C C Check for possible errors C ERRMAX = R1MACH(4) ERRTOL = SQRT(ERRMAX) DO 10 I = 1,48 ABSERR = ABS(C(I)-W(I)) RELERR = ABSERR/ABS(C(I)) ERRMAX = MAX(RELERR,ERRMAX) IF (RELERR.GT.ERRTOL .AND. KPRINT.GE.2) + WRITE (LUN,620) I,RELERR,ABSERR 10 CONTINUE IPASS = 0 IF (ERRMAX.LE.ERRTOL) IPASS = 1 IF (IPASS.NE.0 .AND. KPRINT.GE.2) WRITE (LUN,610) RETURN 610 FORMAT (' Complex Fullerton special function routines o.k.') 620 FORMAT (' For I = ', I3, ' test fails with RELERR = ', + E38.30, ' and ABSERR = ', E38.30) END