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 = ',