mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
109 lines
5.2 KiB
Fortran
109 lines
5.2 KiB
Fortran
*DECK D9ATN1
|
|
DOUBLE PRECISION FUNCTION D9ATN1 (X)
|
|
C***BEGIN PROLOGUE D9ATN1
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Evaluate DATAN(X) from first order relative accuracy so
|
|
C that DATAN(X) = X + X**3*D9ATN1(X).
|
|
C***LIBRARY SLATEC (FNLIB)
|
|
C***CATEGORY C4A
|
|
C***TYPE DOUBLE PRECISION (R9ATN1-S, D9ATN1-D)
|
|
C***KEYWORDS ARC TANGENT, ELEMENTARY FUNCTIONS, FIRST ORDER, FNLIB,
|
|
C TRIGONOMETRIC
|
|
C***AUTHOR Fullerton, W., (LANL)
|
|
C***DESCRIPTION
|
|
C
|
|
C Evaluate DATAN(X) from first order, that is, evaluate
|
|
C (DATAN(X)-X)/X**3 with relative error accuracy so that
|
|
C DATAN(X) = X + X**3*D9ATN1(X).
|
|
C
|
|
C Series for ATN1 on the interval 0. to 1.00000E+00
|
|
C with weighted error 3.39E-32
|
|
C log weighted error 31.47
|
|
C significant figures required 30.26
|
|
C decimal places required 32.27
|
|
C
|
|
C***REFERENCES (NONE)
|
|
C***ROUTINES CALLED D1MACH, DCSEVL, INITDS, XERMSG
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 780401 DATE WRITTEN
|
|
C 890531 Changed all specific intrinsics to generic. (WRB)
|
|
C 891115 Corrected third argument in reference to INITDS. (WRB)
|
|
C 891115 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 D9ATN1
|
|
DOUBLE PRECISION X, XBIG, XMAX, XSML, Y, ATN1CS(40), EPS,
|
|
1 DCSEVL, D1MACH
|
|
LOGICAL FIRST
|
|
SAVE ATN1CS, NTATN1, XSML, XBIG, XMAX, FIRST
|
|
DATA ATN1CS( 1) / -.3283997535 3552023569 0793992299 0 D-1 /
|
|
DATA ATN1CS( 2) / +.5833432343 1724124499 5166991490 7 D-1 /
|
|
DATA ATN1CS( 3) / -.7400369696 7196464638 0901155141 3 D-2 /
|
|
DATA ATN1CS( 4) / +.1009784199 3372880835 9035751163 9 D-2 /
|
|
DATA ATN1CS( 5) / -.1439787163 5652056214 7130369770 0 D-3 /
|
|
DATA ATN1CS( 6) / +.2114512648 9921075720 7211224343 9 D-4 /
|
|
DATA ATN1CS( 7) / -.3172321074 2546671674 0256499675 7 D-5 /
|
|
DATA ATN1CS( 8) / +.4836620365 4607108253 7785938480 0 D-6 /
|
|
DATA ATN1CS( 9) / -.7467746546 8141126704 3761432277 6 D-7 /
|
|
DATA ATN1CS( 10) / +.1164800896 8244298306 2099864134 2 D-7 /
|
|
DATA ATN1CS( 11) / -.1832088370 8472013926 9995624245 2 D-8 /
|
|
DATA ATN1CS( 12) / +.2901908277 9660633131 7535123045 5 D-9 /
|
|
DATA ATN1CS( 13) / -.4623885312 1063267383 5180572151 2 D-10 /
|
|
DATA ATN1CS( 14) / +.7405528668 7757369179 9219704828 6 D-11 /
|
|
DATA ATN1CS( 15) / -.1191354457 8451366823 7082037341 7 D-11 /
|
|
DATA ATN1CS( 16) / +.1924090144 3917725998 6785569251 8 D-12 /
|
|
DATA ATN1CS( 17) / -.3118271051 0761942722 5447615532 7 D-13 /
|
|
DATA ATN1CS( 18) / +.5069240036 5677317896 9452059303 2 D-14 /
|
|
DATA ATN1CS( 19) / -.8263694719 8028660538 1828440596 4 D-15 /
|
|
DATA ATN1CS( 20) / +.1350486709 8170794205 2650612302 9 D-15 /
|
|
DATA ATN1CS( 21) / -.2212023650 4817460458 4013782319 1 D-16 /
|
|
DATA ATN1CS( 22) / +.3630654747 3813567838 2904764770 9 D-17 /
|
|
DATA ATN1CS( 23) / -.5970345328 8471540524 5121585916 5 D-18 /
|
|
DATA ATN1CS( 24) / +.9834816050 0771331194 4832900573 8 D-19 /
|
|
DATA ATN1CS( 25) / -.1622655075 8550623361 4438760448 0 D-19 /
|
|
DATA ATN1CS( 26) / +.2681186176 9454367963 0132030122 6 D-20 /
|
|
DATA ATN1CS( 27) / -.4436309706 7852554796 3624368810 6 D-21 /
|
|
DATA ATN1CS( 28) / +.7349691897 6524969450 7246551040 0 D-22 /
|
|
DATA ATN1CS( 29) / -.1219077508 3500525882 8940137813 3 D-22 /
|
|
DATA ATN1CS( 30) / +.2024298836 8052154031 8454087679 9 D-23 /
|
|
DATA ATN1CS( 31) / -.3364871555 7973545799 2557636266 6 D-24 /
|
|
DATA ATN1CS( 32) / +.5598673968 3469887494 9293397333 3 D-25 /
|
|
DATA ATN1CS( 33) / -.9323939267 2723202296 2853205333 3 D-26 /
|
|
DATA ATN1CS( 34) / +.1554133116 9959702229 3480789333 3 D-26 /
|
|
DATA ATN1CS( 35) / -.2592569534 1797459227 5742719999 9 D-27 /
|
|
DATA ATN1CS( 36) / +.4328193466 2457346850 3790933333 3 D-28 /
|
|
DATA ATN1CS( 37) / -.7231013125 5954374711 9240533333 3 D-29 /
|
|
DATA ATN1CS( 38) / +.1208902859 8304947729 4216533333 3 D-29 /
|
|
DATA ATN1CS( 39) / -.2022404543 4498975793 1519999999 9 D-30 /
|
|
DATA ATN1CS( 40) / +.3385428713 0464938430 7370666666 6 D-31 /
|
|
DATA FIRST /.TRUE./
|
|
C***FIRST EXECUTABLE STATEMENT D9ATN1
|
|
IF (FIRST) THEN
|
|
EPS = D1MACH(3)
|
|
NTATN1 = INITDS (ATN1CS, 40, 0.1*REAL(EPS))
|
|
C
|
|
XSML = SQRT (0.1D0*EPS)
|
|
XBIG = 1.571D0/SQRT(EPS)
|
|
XMAX = 1.571D0/EPS
|
|
ENDIF
|
|
FIRST = .FALSE.
|
|
C
|
|
Y = ABS(X)
|
|
IF (Y.GT.1.0D0) GO TO 20
|
|
C
|
|
IF (Y.LE.XSML) D9ATN1 = -1.0D0/3.0D0
|
|
IF (Y.LE.XSML) RETURN
|
|
C
|
|
D9ATN1 = -0.25D0 + DCSEVL (2.D0*Y*Y-1.D0, ATN1CS, NTATN1)
|
|
RETURN
|
|
C
|
|
20 IF (Y .GT. XMAX) CALL XERMSG ('SLATEC', 'D9ATN1',
|
|
+ 'NO PRECISION IN ANSWER BECAUSE X IS TOO BIG', 2, 2)
|
|
IF (Y .GT. XBIG) CALL XERMSG ('SLATEC', 'D9ATN1',
|
|
+ 'ANSWER LT HALF PRECISION BECAUSE X IS TOO BIG', 1, 1)
|
|
C
|
|
D9ATN1 = (ATAN(X) - X) / X**3
|
|
RETURN
|
|
C
|
|
END
|