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 66