5 * Revision 1.1.1.1 1996/04/01 15:02:11 mclareni
10 #if defined(CERNLIB_DOUBLE)
11 FUNCTION DELI2(X,AKP,A,B,MODE)
13 #include "gen/imp64.inc"
16 PARAMETER(NAME='RELI2/DELI2')
18 #if !defined(CERNLIB_DOUBLE)
19 FUNCTION RELI2(X,AKP,A,B,MODE)
22 PARAMETER(NAME='RELI2')
25 C Translation of Algol procedure el2(x,kc,a,b) in
26 C R. BULIRSCH Numerical Calculation of Elliptic Integrals and
27 C Elliptic Functions, Numer. Math. 7 (1965) 78-90,
28 C extended for (k sub c)**2 < 0 (MODE = -1)
31 PARAMETER (PI = 3.14159 26535 89793 24D0)
32 PARAMETER (Z1 = 1, Z10 = 10, HF = Z1/2)
33 PARAMETER (CA = Z10**(-ID/2), CB = Z10**(-(ID+2)))
37 IF(X .EQ. 0 .OR. AKP .EQ. 0) THEN
38 #if defined(CERNLIB_DOUBLE)
39 H=B*DASINH(X)+(A-B)*X/SQRT(1+X**2)
41 #if !defined(CERNLIB_DOUBLE)
42 H=B*ASINH(X)+(A-B)*X/SQRT(1+X**2)
50 ELSEIF(MODE .EQ. -1) THEN
60 WRITE(ERRTXT,101) X,AKP
61 CALL MTLPRT(NAME,'C346.1',ERRTXT)
66 WRITE(ERRTXT,102) MODE
67 CALL MTLPRT(NAME,'C346.2',ERRTXT)
72 PP=SQRT((1+BKP**2*C)/D)
95 IF(Y .EQ. 0) Y=SQRT(E)*CB
96 IF(ABS(G-YKP) .GT. CA*G) THEN
103 E=(ATAN(XM/Y)+PI*L)*AA/XM
107 #if defined(CERNLIB_DOUBLE)
110 #if !defined(CERNLIB_DOUBLE)
114 101 FORMAT('X = ',1P,D15.8,' AKP = ',D15.8,' ILLEGAL',
115 1 '[(AKP * X)**2 >= 1]')
116 102 FORMAT('MODE = ',I5,' ILLEGAL')