1 ! PR rtl
-optimization
/37243
3 ! { dg
-options
"-std=legacy" }
4 ! { dg
-add
-options ieee
}
5 ! Check
if register allocator handles IR flattening correctly
.
6 SUBROUTINE SCHMD
(V
,M
,N
,LDV
)
7 IMPLICIT DOUBLE PRECISION(A
-H
,O
-Z
)
8 LOGICAL GOPARR
,DSKWRK
,MASWRK
10 COMMON /IOFILE
/ IR
,IW
,IP
,IS
,IPK
,IDAF
,NAV
,IODA
(400)
11 COMMON /PAR
/ ME
,MASTER
,NPROC
,IBTYP
,IPTIM
,GOPARR
,DSKWRK
,MASWRK
12 PARAMETER (ZERO
=0.0D
+00, ONE
=1.0D
+00, TOL
=1.0D
-10)
13 IF (M
.EQ
. 0) GO TO 180
17 100 DUMI
= DUMI
+V
(K
,I
)*V
(K
,I
)
18 DUMI
= ONE
/ SQRT
(DUMI
)
20 120 V
(K
,I
) = V
(K
,I
)*DUMI
21 IF (I
.EQ
. M
) GO TO 160
24 DUM
= -DDOT
(N
,V
(1,J
),1,V
(1,I
),1)
25 CALL DAXPY
(N
,DUM
,V
(1,I
),1,V
(1,J
),1)
36 IF (J
.GT
. N
) GO TO 320
39 CALL DAXPY
(N
,DUM
,V
(1,I
),1,V
(1,I
),1)
43 280 DUMI
= DUMI
+V
(K
,I
)*V
(K
,I
)
44 IF ( ABS
(DUMI
) .LT
. TOL
) GO TO 220
46 300 V
(K
,I
) = V
(K
,I
)*DUMI
54 call schmd
(V
, 1, 18, 18)
57 subroutine DAXPY
(N
,D
,V
,M
,W
,L
)
59 DOUBLE PRECISION D
, V
(1,1), W
(1,1)
62 FUNCTION DDOT
(N
,V
,M
,W
,L
)
64 DOUBLE PRECISION DDOT
, V
(1,1), W
(1,1)