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, sqrt 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