gcc/testsuite/gfortran.dg/pr37243.f

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