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