r9admp.f 11.3 KB
subroutine r9admp (x, ampl, phi)
c july 1980 edition.  w. fullerton, bell labs.  revised nov 1983.
c
c evaluate the derivative of the airy function modulus and
c phase for x .le. -1.0.
c
      dimension an22cs(33), an21cs(24), an20cs(16), aph2cs(32),
     1  aph1cs(22), aph0cs(15)
      external csevl, inits, r1mach
c
c series for an22 on the interval -1.00000e+00 to -1.25000e-01
c                                        with weighted error   3.30e-17
c                                         log weighted error  16.48
c                               significant figures required  14.95
c                                    decimal places required  17.24
c
      data an22cs(  1) /     0.0537418629 629794329 e0/
      data an22cs(  2) /    -0.0126661435 859883193 e0/
      data an22cs(  3) /    -0.0011924334 106593007 e0/
      data an22cs(  4) /    -0.0002032327 627275655 e0/
      data an22cs(  5) /    -0.0000446468 963075164 e0/
      data an22cs(  6) /    -0.0000113359 036053123 e0/
      data an22cs(  7) /    -0.0000031641 352378546 e0/
      data an22cs(  8) /    -0.0000009446 708886149 e0/
      data an22cs(  9) /    -0.0000002966 562236472 e0/
      data an22cs( 10) /    -0.0000000969 118892024 e0/
      data an22cs( 11) /    -0.0000000326 822538653 e0/
      data an22cs( 12) /    -0.0000000113 144618964 e0/
      data an22cs( 13) /    -0.0000000040 042691002 e0/
      data an22cs( 14) /    -0.0000000014 440333684 e0/
      data an22cs( 15) /    -0.0000000005 292853746 e0/
      data an22cs( 16) /    -0.0000000001 967763374 e0/
      data an22cs( 17) /    -0.0000000000 740800096 e0/
      data an22cs( 18) /    -0.0000000000 282016314 e0/
      data an22cs( 19) /    -0.0000000000 108440066 e0/
      data an22cs( 20) /    -0.0000000000 042074801 e0/
      data an22cs( 21) /    -0.0000000000 016459150 e0/
      data an22cs( 22) /    -0.0000000000 006486827 e0/
      data an22cs( 23) /    -0.0000000000 002574095 e0/
      data an22cs( 24) /    -0.0000000000 001027889 e0/
      data an22cs( 25) /    -0.0000000000 000412846 e0/
      data an22cs( 26) /    -0.0000000000 000166711 e0/
      data an22cs( 27) /    -0.0000000000 000067657 e0/
      data an22cs( 28) /    -0.0000000000 000027585 e0/
      data an22cs( 29) /    -0.0000000000 000011296 e0/
      data an22cs( 30) /    -0.0000000000 000004645 e0/
      data an22cs( 31) /    -0.0000000000 000001917 e0/
      data an22cs( 32) /    -0.0000000000 000000794 e0/
      data an22cs( 33) /    -0.0000000000 000000330 e0/
c
c series for an21 on the interval -1.25000e-01 to -1.56250e-02
c                                        with weighted error   3.43e-17
c                                         log weighted error  16.47
c                               significant figures required  14.48
c                                    decimal places required  17.16
c
      data an21cs(  1) /     0.0198313155 263169394 e0/
      data an21cs(  2) /    -0.0029376249 067087533 e0/
      data an21cs(  3) /    -0.0001136260 695958196 e0/
      data an21cs(  4) /    -0.0000100554 451087156 e0/
      data an21cs(  5) /    -0.0000013048 787116563 e0/
      data an21cs(  6) /    -0.0000002123 881993151 e0/
      data an21cs(  7) /    -0.0000000402 270833384 e0/
      data an21cs(  8) /    -0.0000000084 996745953 e0/
      data an21cs(  9) /    -0.0000000019 514839426 e0/
      data an21cs( 10) /    -0.0000000004 783865344 e0/
      data an21cs( 11) /    -0.0000000001 236733992 e0/
      data an21cs( 12) /    -0.0000000000 334137486 e0/
      data an21cs( 13) /    -0.0000000000 093702824 e0/
      data an21cs( 14) /    -0.0000000000 027130128 e0/
      data an21cs( 15) /    -0.0000000000 008075954 e0/
      data an21cs( 16) /    -0.0000000000 002463214 e0/
      data an21cs( 17) /    -0.0000000000 000767656 e0/
      data an21cs( 18) /    -0.0000000000 000243883 e0/
      data an21cs( 19) /    -0.0000000000 000078831 e0/
      data an21cs( 20) /    -0.0000000000 000025882 e0/
      data an21cs( 21) /    -0.0000000000 000008619 e0/
      data an21cs( 22) /    -0.0000000000 000002908 e0/
      data an21cs( 23) /    -0.0000000000 000000993 e0/
      data an21cs( 24) /    -0.0000000000 000000343 e0/
c
c series for an20 on the interval -1.56250e-02 to  0.00000e+00
c                                        with weighted error   4.41e-17
c                                         log weighted error  16.36
c                               significant figures required  14.16
c                                    decimal places required  16.96
c
      data an20cs(  1) /     0.0126732217 145738027 e0/
      data an20cs(  2) /    -0.0005212847 072615621 e0/
      data an20cs(  3) /    -0.0000052672 111140370 e0/
      data an20cs(  4) /    -0.0000001628 202185026 e0/
      data an20cs(  5) /    -0.0000000090 991442687 e0/
      data an20cs(  6) /    -0.0000000007 438647126 e0/
      data an20cs(  7) /    -0.0000000000 795494752 e0/
      data an20cs(  8) /    -0.0000000000 104050944 e0/
      data an20cs(  9) /    -0.0000000000 015932426 e0/
      data an20cs( 10) /    -0.0000000000 002770648 e0/
      data an20cs( 11) /    -0.0000000000 000535343 e0/
      data an20cs( 12) /    -0.0000000000 000113062 e0/
      data an20cs( 13) /    -0.0000000000 000025772 e0/
      data an20cs( 14) /    -0.0000000000 000006278 e0/
      data an20cs( 15) /    -0.0000000000 000001621 e0/
      data an20cs( 16) /    -0.0000000000 000000441 e0/
c
c series for aph2 on the interval -1.00000e+00 to -1.25000e-01
c                                        with weighted error   2.94e-17
c                                         log weighted error  16.53
c                               significant figures required  15.58
c                                    decimal places required  17.28
c
      data aph2cs(  1) /    -0.2057088719 781465107 e0/
      data aph2cs(  2) /     0.0422196961 357771922 e0/
      data aph2cs(  3) /     0.0020482560 511207275 e0/
      data aph2cs(  4) /     0.0002607800 735165006 e0/
      data aph2cs(  5) /     0.0000474824 268004729 e0/
      data aph2cs(  6) /     0.0000105102 756431612 e0/
      data aph2cs(  7) /     0.0000026353 534014668 e0/
      data aph2cs(  8) /     0.0000007208 824863499 e0/
      data aph2cs(  9) /     0.0000002103 236664473 e0/
      data aph2cs( 10) /     0.0000000644 975634555 e0/
      data aph2cs( 11) /     0.0000000205 802377264 e0/
      data aph2cs( 12) /     0.0000000067 836273921 e0/
      data aph2cs( 13) /     0.0000000022 974015284 e0/
      data aph2cs( 14) /     0.0000000007 961306765 e0/
      data aph2cs( 15) /     0.0000000002 813860610 e0/
      data aph2cs( 16) /     0.0000000001 011749057 e0/
      data aph2cs( 17) /     0.0000000000 369306738 e0/
      data aph2cs( 18) /     0.0000000000 136615066 e0/
      data aph2cs( 19) /     0.0000000000 051142751 e0/
      data aph2cs( 20) /     0.0000000000 019351689 e0/
      data aph2cs( 21) /     0.0000000000 007393607 e0/
      data aph2cs( 22) /     0.0000000000 002849792 e0/
      data aph2cs( 23) /     0.0000000000 001107281 e0/
      data aph2cs( 24) /     0.0000000000 000433412 e0/
      data aph2cs( 25) /     0.0000000000 000170801 e0/
      data aph2cs( 26) /     0.0000000000 000067733 e0/
      data aph2cs( 27) /     0.0000000000 000027017 e0/
      data aph2cs( 28) /     0.0000000000 000010835 e0/
      data aph2cs( 29) /     0.0000000000 000004367 e0/
      data aph2cs( 30) /     0.0000000000 000001769 e0/
      data aph2cs( 31) /     0.0000000000 000000719 e0/
      data aph2cs( 32) /     0.0000000000 000000294 e0/
c
c series for aph1 on the interval -1.25000e-01 to -1.56250e-02
c                                        with weighted error   6.38e-17
c                                         log weighted error  16.20
c                               significant figures required  14.91
c                                    decimal places required  16.87
c
      data aph1cs(  1) /    -0.1024172908 077571694 e0/
      data aph1cs(  2) /     0.0071697275 146591248 e0/
      data aph1cs(  3) /     0.0001209959 363122329 e0/
      data aph1cs(  4) /     0.0000073361 512841220 e0/
      data aph1cs(  5) /     0.0000007535 382954272 e0/
      data aph1cs(  6) /     0.0000001041 478171741 e0/
      data aph1cs(  7) /     0.0000000174 358728519 e0/
      data aph1cs(  8) /     0.0000000033 399795033 e0/
      data aph1cs(  9) /     0.0000000007 073075174 e0/
      data aph1cs( 10) /     0.0000000001 619187515 e0/
      data aph1cs( 11) /     0.0000000000 394539982 e0/
      data aph1cs( 12) /     0.0000000000 101192282 e0/
      data aph1cs( 13) /     0.0000000000 027092778 e0/
      data aph1cs( 14) /     0.0000000000 007523806 e0/
      data aph1cs( 15) /     0.0000000000 002156369 e0/
      data aph1cs( 16) /     0.0000000000 000635283 e0/
      data aph1cs( 17) /     0.0000000000 000191757 e0/
      data aph1cs( 18) /     0.0000000000 000059143 e0/
      data aph1cs( 19) /     0.0000000000 000018597 e0/
      data aph1cs( 20) /     0.0000000000 000005950 e0/
      data aph1cs( 21) /     0.0000000000 000001934 e0/
      data aph1cs( 22) /     0.0000000000 000000638 e0/
c
c series for aph0 on the interval -1.56250e-02 to  0.00000e+00
c                                        with weighted error   2.29e-17
c                                         log weighted error  16.64
c                               significant figures required  15.27
c                                    decimal places required  17.23
c
      data aph0cs(  1) /    -0.0855849241 130933257 e0/
      data aph0cs(  2) /     0.0011214378 867065261 e0/
      data aph0cs(  3) /     0.0000042721 029353664 e0/
      data aph0cs(  4) /     0.0000000817 607381483 e0/
      data aph0cs(  5) /     0.0000000033 907645000 e0/
      data aph0cs(  6) /     0.0000000002 253264423 e0/
      data aph0cs(  7) /     0.0000000000 206284209 e0/
      data aph0cs(  8) /     0.0000000000 023858763 e0/
      data aph0cs(  9) /     0.0000000000 003301618 e0/
      data aph0cs( 10) /     0.0000000000 000527010 e0/
      data aph0cs( 11) /     0.0000000000 000094555 e0/
      data aph0cs( 12) /     0.0000000000 000018709 e0/
      data aph0cs( 13) /     0.0000000000 000004024 e0/
      data aph0cs( 14) /     0.0000000000 000000930 e0/
      data aph0cs( 15) /     0.0000000000 000000229 e0/
c
      data pi34 / 2.3561944 901923449e0 /
c     data pi34 / 2.3561944 9019234492 8846982537 4596271631 3d0  /
      data nan20, nan21, nan22, naph0, naph1, naph2 / 6*0 /
      data xsml / 0.0 /
c
      if (nan20.ne.0) go to 10
      eta = 0.1*r1mach(3)
      nan20 = inits (an20cs, 16, eta)
      nan21 = inits (an21cs, 24, eta)
      nan22 = inits (an22cs, 33, eta)
      naph0 = inits (aph0cs, 15, eta)
      naph1 = inits (aph1cs, 22, eta)
      naph2 = inits (aph2cs, 32, eta)
c
      xsml = -(128.0/r1mach(3))**0.3333
c
 10   if (x.ge.(-4.0)) go to 20
      z = 1.0
      if (x.gt.xsml) z = 128.0/x**3 + 1.0
      ampl = 0.3125 + csevl (z, an20cs, nan20)
      phi = -0.625 + csevl (z, aph0cs, naph0)
      go to 40
c
 20   if (x.ge.(-2.0)) go to 30
      z = (128.0/x**3 + 9.0) / 7.0
      ampl = 0.3125 + csevl (z, an21cs, nan21)
      phi = -0.625 + csevl (z, aph1cs, naph1)
      go to 40
c
 30   if (x.gt.(-1.0)) call seteru (
     1  25hr9admp  x must be le -1.0, 25, 1, 2)
c
      z = (16.0/x**3 + 9.0) / 7.0
      ampl = 0.3125 + csevl (z, an22cs, nan22)
      phi = -0.625 + csevl (z, aph2cs, naph2)
c
 40   sqrtx = sqrt (-x)
      ampl = sqrt (ampl*sqrtx)
      phi = pi34 - x*sqrtx*phi
c
      return
      end