PR rtl-optimization/82913
[official-gcc.git] / gcc / testsuite / gfortran.fortran-torture / compile / pr39937.f
blob5ead135d8070fff67c135aaac7883792442ff197
1 SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
2 $ LDVR, MM, M, WORK, INFO )
3 DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
4 $ WORK( * )
5 DOUBLE PRECISION X( 2, 2 )
6 CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
7 $ ZERO, X, 2, SCALE, XNORM, IERR )
8 CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
9 DO 90 J = KI - 2, 1, -1
10 IF( J.GT.JNXT )
11 $ GO TO 90
12 JNXT = J - 1
13 IF( J.GT.1 ) THEN
14 IF( T( J, J-1 ).NE.ZERO ) THEN
15 IF( WORK( J ).GT.BIGNUM / XNORM ) THEN
16 X( 1, 1 ) = X( 1, 1 ) / XNORM
17 END IF
18 END IF
19 CALL DLALN2( .FALSE., 2, 2, SMIN, ONE,
20 $ T( J-1, J-1 ), LDT, ONE, ONE,
21 $ XNORM, IERR )
22 CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
23 $ WORK( 1+N ), 1 )
24 CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1,
25 $ WORK( 1+N2 ), 1 )
26 END IF
27 90 CONTINUE
28 END