Fcalva/OpenLibm
1
0
Fork 0
mirror of https://git.planet-casio.com/Lephenixnoir/OpenLibm.git synced 2025-01-01 06:23:39 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions
OpenLibm/slatec/r9aimp.f
Viral B. Shah c977aa998f Add Makefile.extras to build libopenlibm-extras. 
Replace amos with slatec
2012-12-31 16:37:05 -05:00

226 lines
10 KiB
Fortran
Raw Blame History

*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
Reference in a new issue View git blame Copy permalink