Subversion Repositories openrisc

! { dg-do compile { target i?86-*-* x86_64-*-* } }

! { dg-options "-O2 -w" }

C fconc64.F, from CERNLIB (simplified)

      FUNCTION DFCONC(X,TAU,M)

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)

      COMPLEX*16 WGAMMA,WLOGAM

      COMPLEX*16 CGM,CLG,CRG,I,A,B,C,TI,R,RR,U(0:3),V(0:3),W(19)

      LOGICAL LM0,LM1,LTA

      CHARACTER NAME*(*)

      CHARACTER*80 ERRTXT

      PARAMETER (NAME = 'RFCONC/DFCONC')

      DIMENSION T(7),H(9),S(5),P(11),D(-1:6)

      PARAMETER (PI  = 3.14159 26535 89793 24D+0)

      PARAMETER (RPI = 1.77245 38509 05516 03D+0)

      PARAMETER (I = (0,1))

      PARAMETER (Z1 = 1, HF = Z1/2, TH = 1+HF, C1 = Z1/10, C2 = Z1/5)

      PARAMETER (RPH = 2/PI, RPW = 2/RPI, TW = 20, NMAX = 200)

      DATA EPS /1D-14/

      ASSIGN 1 TO JP

      GO TO 20

    1 ASSIGN 2 TO JP

      GO TO 20

    2 IF(LM1) FC=2*FC/SQRT(1-X1)

      GO TO 99

   12 ASSIGN 3 TO JP

      GO TO 20

    3 IF(LM1) FC=SIGN(HF,1-X)*(TAU**2+HF**2)*SQRT(ABS(X**2-1))*FC

      GO TO 99

   13 ASSIGN 4 TO JP

      GO TO 20

    4 R1=EXP((TI-HF)*LOG(X+X)+CLG(1+TI)-CLG((TH-FM)+TI))*

     1        R*((HF-FM)+TI)/TI

      FC=RPW*R1

      IF(LM1) FC=FC/SQRT(1-X1)

      GO TO 99

   20 IF(LTA) THEN

       IF(ABS(R-RR) .LT. EPS) GO TO JP, (1,2,3,4)

      ELSE

       W(1)=X1*A*B/C

       R=1+W(1)

       DO 23 N = 1,NMAX

       RR=R

       W(1)=W(1)*X1*(A+FN)*(B+FN)/((C+FN)*(FN+1))

       IF(ABS(R-RR) .LT. EPS) GO TO JP, (1,2,3,4)

   23  CONTINUE

      END IF

   99 DFCONC=FC

      RETURN

  101 FORMAT('ILLEGAL ARGUMENT(S)  X = ',D15.8,' TAU = ',D15.8,

     1       ' M = ',I3)

  102 FORMAT('CONVERGENCE PROBLEM FOR HYPERGEOMETRIC FUNCTION, X = ',

     1        D15.8)

      END