1 ! { dg
-do compile
{ target i?
86-*-* x86_64
-*-* } }
2 ! { dg
-options
"-O2 -w" }
3 C fconc64.F, from CERNLIB (simplified)
5 FUNCTION DFCONC
(X
,TAU
,M
)
6 IMPLICIT DOUBLE PRECISION (A
-H
,O
-Z
)
7 COMPLEX*16 WGAMMA
,WLOGAM
8 COMPLEX*16 CGM
,CLG
,CRG
,I
,A
,B
,C
,TI
,R
,RR
,U
(0:3),V
(0:3),W
(19)
12 PARAMETER (NAME
= 'RFCONC/DFCONC')
13 DIMENSION T
(7),H
(9),S
(5),P
(11),D
(-1:6)
14 PARAMETER (PI
= 3.14159 26535 89793 24D
+0)
15 PARAMETER (RPI
= 1.77245 38509 05516 03D
+0)
17 PARAMETER (Z1
= 1, HF
= Z1
/2, TH
= 1+HF
, C1
= Z1
/10, C2
= Z1
/5)
18 PARAMETER (RPH
= 2/PI
, RPW
= 2/RPI
, TW
= 20, NMAX
= 200)
24 2 IF(LM1
) FC
=2*FC
/SQRT
(1-X1
)
28 3 IF(LM1
) FC
=SIGN
(HF
,1-X
)*(TAU**2
+HF**2
)*SQRT
(ABS
(X**2
-1))*FC
32 4 R1
=EXP
((TI
-HF
)*LOG
(X
+X
)+CLG
(1+TI
)-CLG
((TH
-FM
)+TI
))*
35 IF(LM1
) FC
=FC
/SQRT
(1-X1
)
38 IF(ABS
(R
-RR
) .LT
. EPS
) GO TO JP
, (1,2,3,4)
44 W
(1)=W
(1)*X1*
(A
+FN
)*(B
+FN
)/((C
+FN
)*(FN
+1))
45 IF(ABS
(R
-RR
) .LT
. EPS
) GO TO JP
, (1,2,3,4)
50 101 FORMAT('ILLEGAL ARGUMENT(S) X = ',D15
.8
,' TAU = ',D15
.8
,
52 102 FORMAT('CONVERGENCE PROBLEM FOR HYPERGEOMETRIC FUNCTION, X = ',