gcc/testsuite/gfortran.dg/pr81723.f

   1 ! { dg-do compile }
   2 ! { dg-options "-O3 -fno-automatic -std=legacy" }
   3
   4       FUNCTION WWERF(Z)
   5
   6       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
   7       COMPLEX*16 WWERF
   8       COMPLEX*16 Z,ZH,R(37),S,T,V,W
   9
  10       PARAMETER (Z1 = 1, HF = Z1/2, Z10 = 10)
  11       PARAMETER (C1 = 74/Z10, C2 = 83/Z10, C3 = Z10/32, C4 = 16/Z10)
  12       PARAMETER (C = 1.12837 91670 95512 57D0, P = (2*C4)**33)
  13
  14       DOUBLE PRECISION GREAL,GIMAG,XARG,YARG
  15       COMPLEX*16 ZARG,GCONJG,GCMPLX
  16       GREAL( ZARG)=DREAL( ZARG)
  17       GIMAG( ZARG)=DIMAG( ZARG)
  18       GCONJG(ZARG)=DCONJG(ZARG)
  19       GCMPLX(XARG,YARG)=DCMPLX(XARG,YARG)
  20
  21       X=Z
  22       Y=GIMAG(Z)
  23       XA=ABS(X)
  24       YA=ABS(Y)
  25       IF(YA .LT. C1 .AND. XA .LT. C2) THEN
  26        ZH=GCMPLX(YA+C4,XA)
  27        R(37)=0
  28        DO 1 N = 36,1,-1
  29        T=ZH+N*GCONJG(R(N+1))
  30     1  R(N)=HF*T/(GREAL(T)**2+GIMAG(T)**2)
  31        XL=P
  32        S=0
  33        DO 2 N = 33,1,-1
  34        XL=C3*XL
  35     2  S=R(N)*(S+XL)
  36        V=C*S
  37       ELSE
  38        ZH=GCMPLX(YA,XA)
  39        R(1)=0
  40        DO 3 N = 9,1,-1
  41        T=ZH+N*GCONJG(R(1))
  42     3  R(1)=HF*T/(GREAL(T)**2+GIMAG(T)**2)
  43        V=C*R(1)
  44       END IF
  45       IF(YA .EQ. 0) V=GCMPLX(EXP(-XA**2),GIMAG(V))
  46       IF(Y .LT. 0) THEN
  47        V=2*EXP(-GCMPLX(XA,YA)**2)-V
  48        IF(X .GT. 0) V=GCONJG(V)
  49       ELSE
  50        IF(X .LT. 0) V=GCONJG(V)
  51       END IF
  52
  53       WWERF=V
  54
  55       RETURN
  56       END