relibc_openlibm/slatec/r9aimp.f

*DECK R9AIMP
      SUBROUTINE R9AIMP (X, AMPL, THETA)
C***BEGIN PROLOGUE  R9AIMP
C***SUBSIDIARY
C***PURPOSE  Evaluate the Airy modulus and phase.
C***LIBRARY   SLATEC (FNLIB)
C***CATEGORY  C10D
C***TYPE      SINGLE PRECISION (R9AIMP-S, D9AIMP-D)
C***KEYWORDS  AIRY FUNCTION, FNLIB, MODULUS, PHASE, SPECIAL FUNCTIONS
C***AUTHOR  Fullerton, W., (LANL)
C***DESCRIPTION
C
C Evaluate the Airy modulus and phase for X .LE. -1.0
C
C Series for AM21       on the interval -1.25000D-01 to  0.
C                                        with weighted error   2.89E-17
C                                         log weighted error  16.54
C                               significant figures required  14.15
C                                    decimal places required  17.34
C
C Series for ATH1       on the interval -1.25000D-01 to  0.
C                                        with weighted error   2.53E-17
C                                         log weighted error  16.60
C                               significant figures required  15.15
C                                    decimal places required  17.38
C
C Series for AM22       on the interval -1.00000D+00 to -1.25000D-01
C                                        with weighted error   2.99E-17
C                                         log weighted error  16.52
C                               significant figures required  14.57
C                                    decimal places required  17.28
C
C Series for ATH2       on the interval -1.00000D+00 to -1.25000D-01
C                                        with weighted error   2.57E-17
C                                         log weighted error  16.59
C                               significant figures required  15.07
C                                    decimal places required  17.34
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  CSEVL, INITS, R1MACH, XERMSG
C***REVISION HISTORY  (YYMMDD)
C   770701  DATE WRITTEN
C   890206  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
C   900720  Routine changed from user-callable to subsidiary.  (WRB)
C***END PROLOGUE  R9AIMP
      DIMENSION AM21CS(40), ATH1CS(36), AM22CS(33), ATH2CS(32)
      LOGICAL FIRST
      SAVE AM21CS, ATH1CS, AM22CS, ATH2CS, PI4, NAM21,
     1 NATH1, NAM22, NATH2, XSML, FIRST
      DATA AM21CS( 1) /    .0065809191 761485E0 /
      DATA AM21CS( 2) /    .0023675984 685722E0 /
      DATA AM21CS( 3) /    .0001324741 670371E0 /
      DATA AM21CS( 4) /    .0000157600 904043E0 /
      DATA AM21CS( 5) /    .0000027529 702663E0 /
      DATA AM21CS( 6) /    .0000006102 679017E0 /
      DATA AM21CS( 7) /    .0000001595 088468E0 /
      DATA AM21CS( 8) /    .0000000471 033947E0 /
      DATA AM21CS( 9) /    .0000000152 933871E0 /
      DATA AM21CS(10) /    .0000000053 590722E0 /
      DATA AM21CS(11) /    .0000000020 000910E0 /
      DATA AM21CS(12) /    .0000000007 872292E0 /
      DATA AM21CS(13) /    .0000000003 243103E0 /
      DATA AM21CS(14) /    .0000000001 390106E0 /
      DATA AM21CS(15) /    .0000000000 617011E0 /
      DATA AM21CS(16) /    .0000000000 282491E0 /
      DATA AM21CS(17) /    .0000000000 132979E0 /
      DATA AM21CS(18) /    .0000000000 064188E0 /
      DATA AM21CS(19) /    .0000000000 031697E0 /
      DATA AM21CS(20) /    .0000000000 015981E0 /
      DATA AM21CS(21) /    .0000000000 008213E0 /
      DATA AM21CS(22) /    .0000000000 004296E0 /
      DATA AM21CS(23) /    .0000000000 002284E0 /
      DATA AM21CS(24) /    .0000000000 001232E0 /
      DATA AM21CS(25) /    .0000000000 000675E0 /
      DATA AM21CS(26) /    .0000000000 000374E0 /
      DATA AM21CS(27) /    .0000000000 000210E0 /
      DATA AM21CS(28) /    .0000000000 000119E0 /
      DATA AM21CS(29) /    .0000000000 000068E0 /
      DATA AM21CS(30) /    .0000000000 000039E0 /
      DATA AM21CS(31) /    .0000000000 000023E0 /
      DATA AM21CS(32) /    .0000000000 000013E0 /
      DATA AM21CS(33) /    .0000000000 000008E0 /
      DATA AM21CS(34) /    .0000000000 000005E0 /
      DATA AM21CS(35) /    .0000000000 000003E0 /
      DATA AM21CS(36) /    .0000000000 000001E0 /
      DATA AM21CS(37) /    .0000000000 000001E0 /
      DATA AM21CS(38) /    .0000000000 000000E0 /
      DATA AM21CS(39) /    .0000000000 000000E0 /
      DATA AM21CS(40) /    .0000000000 000000E0 /
      DATA ATH1CS( 1) /   -.0712583781 5669365E0 /
      DATA ATH1CS( 2) /   -.0059047197 9831451E0 /
      DATA ATH1CS( 3) /   -.0001211454 4069499E0 /
      DATA ATH1CS( 4) /   -.0000098860 8542270E0 /
      DATA ATH1CS( 5) /   -.0000013808 4097352E0 /
      DATA ATH1CS( 6) /   -.0000002614 2640172E0 /
      DATA ATH1CS( 7) /   -.0000000605 0432589E0 /
      DATA ATH1CS( 8) /   -.0000000161 8436223E0 /
      DATA ATH1CS( 9) /   -.0000000048 3464911E0 /
      DATA ATH1CS(10) /   -.0000000015 7655272E0 /
      DATA ATH1CS(11) /   -.0000000005 5231518E0 /
      DATA ATH1CS(12) /   -.0000000002 0545441E0 /
      DATA ATH1CS(13) /   -.0000000000 8043412E0 /
      DATA ATH1CS(14) /   -.0000000000 3291252E0 /
      DATA ATH1CS(15) /   -.0000000000 1399875E0 /
      DATA ATH1CS(16) /   -.0000000000 0616151E0 /
      DATA ATH1CS(17) /   -.0000000000 0279614E0 /
      DATA ATH1CS(18) /   -.0000000000 0130428E0 /
      DATA ATH1CS(19) /   -.0000000000 0062373E0 /
      DATA ATH1CS(20) /   -.0000000000 0030512E0 /
      DATA ATH1CS(21) /   -.0000000000 0015239E0 /
      DATA ATH1CS(22) /   -.0000000000 0007758E0 /
      DATA ATH1CS(23) /   -.0000000000 0004020E0 /
      DATA ATH1CS(24) /   -.0000000000 0002117E0 /
      DATA ATH1CS(25) /   -.0000000000 0001132E0 /
      DATA ATH1CS(26) /   -.0000000000 0000614E0 /
      DATA ATH1CS(27) /   -.0000000000 0000337E0 /
      DATA ATH1CS(28) /   -.0000000000 0000188E0 /
      DATA ATH1CS(29) /   -.0000000000 0000105E0 /
      DATA ATH1CS(30) /   -.0000000000 0000060E0 /
      DATA ATH1CS(31) /   -.0000000000 0000034E0 /
      DATA ATH1CS(32) /   -.0000000000 0000020E0 /
      DATA ATH1CS(33) /   -.0000000000 0000011E0 /
      DATA ATH1CS(34) /   -.0000000000 0000007E0 /
      DATA ATH1CS(35) /   -.0000000000 0000004E0 /
      DATA ATH1CS(36) /   -.0000000000 0000002E0 /
      DATA AM22CS( 1) /   -.0156284448 0625341E0 /
      DATA AM22CS( 2) /    .0077833644 5239681E0 /
      DATA AM22CS( 3) /    .0008670577 7047718E0 /
      DATA AM22CS( 4) /    .0001569662 7315611E0 /
      DATA AM22CS( 5) /    .0000356396 2571432E0 /
      DATA AM22CS( 6) /    .0000092459 8335425E0 /
      DATA AM22CS( 7) /    .0000026211 0161850E0 /
      DATA AM22CS( 8) /    .0000007918 8221651E0 /
      DATA AM22CS( 9) /    .0000002510 4152792E0 /
      DATA AM22CS(10) /    .0000000826 5223206E0 /
      DATA AM22CS(11) /    .0000000280 5711662E0 /
      DATA AM22CS(12) /    .0000000097 6821090E0 /
      DATA AM22CS(13) /    .0000000034 7407923E0 /
      DATA AM22CS(14) /    .0000000012 5828132E0 /
      DATA AM22CS(15) /    .0000000004 6298826E0 /
      DATA AM22CS(16) /    .0000000001 7272825E0 /
      DATA AM22CS(17) /    .0000000000 6523192E0 /
      DATA AM22CS(18) /    .0000000000 2490471E0 /
      DATA AM22CS(19) /    .0000000000 0960156E0 /
      DATA AM22CS(20) /    .0000000000 0373448E0 /
      DATA AM22CS(21) /    .0000000000 0146417E0 /
      DATA AM22CS(22) /    .0000000000 0057826E0 /
      DATA AM22CS(23) /    .0000000000 0022991E0 /
      DATA AM22CS(24) /    .0000000000 0009197E0 /
      DATA AM22CS(25) /    .0000000000 0003700E0 /
      DATA AM22CS(26) /    .0000000000 0001496E0 /
      DATA AM22CS(27) /    .0000000000 0000608E0 /
      DATA AM22CS(28) /    .0000000000 0000248E0 /
      DATA AM22CS(29) /    .0000000000 0000101E0 /
      DATA AM22CS(30) /    .0000000000 0000041E0 /
      DATA AM22CS(31) /    .0000000000 0000017E0 /
      DATA AM22CS(32) /    .0000000000 0000007E0 /
      DATA AM22CS(33) /    .0000000000 0000002E0 /
      DATA ATH2CS( 1) /    .0044052734 5871877E0 /
      DATA ATH2CS( 2) /   -.0304291945 2318455E0 /
      DATA ATH2CS( 3) /   -.0013856532 8377179E0 /
      DATA ATH2CS( 4) /   -.0001804443 9089549E0 /
      DATA ATH2CS( 5) /   -.0000338084 7108327E0 /
      DATA ATH2CS( 6) /   -.0000076781 8353522E0 /
      DATA ATH2CS( 7) /   -.0000019678 3944371E0 /
      DATA ATH2CS( 8) /   -.0000005483 7271158E0 /
      DATA ATH2CS( 9) /   -.0000001625 4615505E0 /
      DATA ATH2CS(10) /   -.0000000505 3049981E0 /
      DATA ATH2CS(11) /   -.0000000163 1580701E0 /
      DATA ATH2CS(12) /   -.0000000054 3420411E0 /
      DATA ATH2CS(13) /   -.0000000018 5739855E0 /
      DATA ATH2CS(14) /   -.0000000006 4895120E0 /
      DATA ATH2CS(15) /   -.0000000002 3105948E0 /
      DATA ATH2CS(16) /   -.0000000000 8363282E0 /
      DATA ATH2CS(17) /   -.0000000000 3071196E0 /
      DATA ATH2CS(18) /   -.0000000000 1142367E0 /
      DATA ATH2CS(19) /   -.0000000000 0429811E0 /
      DATA ATH2CS(20) /   -.0000000000 0163389E0 /
      DATA ATH2CS(21) /   -.0000000000 0062693E0 /
      DATA ATH2CS(22) /   -.0000000000 0024260E0 /
      DATA ATH2CS(23) /   -.0000000000 0009461E0 /
      DATA ATH2CS(24) /   -.0000000000 0003716E0 /
      DATA ATH2CS(25) /   -.0000000000 0001469E0 /
      DATA ATH2CS(26) /   -.0000000000 0000584E0 /
      DATA ATH2CS(27) /   -.0000000000 0000233E0 /
      DATA ATH2CS(28) /   -.0000000000 0000093E0 /
      DATA ATH2CS(29) /   -.0000000000 0000037E0 /
      DATA ATH2CS(30) /   -.0000000000 0000015E0 /
      DATA ATH2CS(31) /   -.0000000000 0000006E0 /
      DATA ATH2CS(32) /   -.0000000000 0000002E0 /
      DATA PI4 / 0.7853981633 9744831 E0 /
      DATA FIRST /.TRUE./
C***FIRST EXECUTABLE STATEMENT  R9AIMP
      IF (FIRST) THEN
         ETA = 0.1*R1MACH(3)
         NAM21 = INITS (AM21CS, 40, ETA)
         NATH1 = INITS (ATH1CS, 36, ETA)
         NAM22 = INITS (AM22CS, 33, ETA)
         NATH2 = INITS (ATH2CS, 32, ETA)
C
         XSML = -1.0/R1MACH(3)**0.3333
      ENDIF
      FIRST = .FALSE.
C
      IF (X.GE.(-2.0)) GO TO 20
      Z = 1.0
      IF (X.GT.XSML) Z = 16.0/X**3 + 1.0
      AMPL = 0.3125 + CSEVL(Z, AM21CS, NAM21)
      THETA = -0.625 + CSEVL (Z, ATH1CS, NATH1)
      GO TO 30
C
 20   IF (X .GT. (-1.0)) CALL XERMSG ('SLATEC', 'R9AIMP',
     +   'X MUST BE LE -1.0', 1, 2)
C
      Z = (16.0/X**3 + 9.0)/7.0
      AMPL = 0.3125 + CSEVL (Z, AM22CS, NAM22)
      THETA = -0.625 + CSEVL (Z, ATH2CS, NATH2)
C
 30   SQRTX = SQRT(-X)
      AMPL = SQRT (AMPL/SQRTX)
      THETA = PI4 - X*SQRTX * THETA
C
      RETURN
      END