gcc/testsuite/gfortran.dg/pr37243.f

   1 ! PR rtl-optimization/37243
   2 ! { dg-do run }
   3 ! { dg-add-options ieee }
   4 ! Check if register allocator handles IR flattening correctly.
   5       SUBROUTINE SCHMD(V,M,N,LDV)
   6       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
   7       LOGICAL GOPARR,DSKWRK,MASWRK
   8       DIMENSION V(LDV,N)
   9       COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(400)
  10       COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
  11       PARAMETER (ZERO=0.0D+00, ONE=1.0D+00, TOL=1.0D-10)
  12       IF (M .EQ. 0) GO TO 180
  13       DO 160 I = 1,M
  14       DUMI = ZERO
  15       DO 100 K = 1,N
  16   100 DUMI = DUMI+V(K,I)*V(K,I) ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
  17       DUMI = ONE/ SQRT(DUMI)
  18       DO 120 K = 1,N
  19   120 V(K,I) = V(K,I)*DUMI ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
  20       IF (I .EQ. M) GO TO 160
  21       I1 = I+1
  22       DO 140 J = I1,M
  23       DUM = -DDOT(N,V(1,J),1,V(1,I),1)
  24       CALL DAXPY(N,DUM,V(1,I),1,V(1,J),1)
  25   140 CONTINUE
  26   160 CONTINUE
  27       IF (M .EQ. N) RETURN
  28   180 CONTINUE
  29       I = M
  30       J = 0
  31   200 I0 = I
  32       I = I+1
  33       IF (I .GT. N) RETURN
  34   220 J = J+1
  35       IF (J .GT. N) GO TO 320
  36       DO 240 K = 1,N
  37   240 V(K,I) = ZERO ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
  38       CALL DAXPY(N,DUM,V(1,I),1,V(1,I),1)
  39   260 CONTINUE
  40       DUMI = ZERO
  41       DO 280 K = 1,N
  42   280 DUMI = DUMI+V(K,I)*V(K,I) ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
  43       IF ( ABS(DUMI) .LT. TOL) GO TO 220
  44       DO 300 K = 1,N
  45   300 V(K,I) = V(K,I)*DUMI ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
  46       GO TO 200
  47   320 END
  48       program main
  49       DOUBLE PRECISION V
  50       DIMENSION V(18, 18)
  51       common // v
  52
  53       call schmd(V, 1, 18, 18)
  54       end
  55
  56       subroutine DAXPY(N,D,V,M,W,L)
  57       INTEGER :: N, M, L
  58       DOUBLE PRECISION D, V(1,1), W(1,1)
  59       end
  60
  61       FUNCTION DDOT (N,V,M,W,L)
  62       INTEGER :: N, M, L
  63       DOUBLE PRECISION DDOT, V(1,1), W(1,1)
  64       DDOT = 1
  65       end