1 SUBROUTINE DCHKBK( NIN, NOUT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER NIN, NOUT
9 * ..
10 *
11 * Purpose
12 * =======
13 *
14 * DCHKBK tests DGEBAK, a routine for backward transformation of
15 * the computed right or left eigenvectors if the orginal matrix
16 * was preprocessed by balance subroutine DGEBAL.
17 *
18 * Arguments
19 * =========
20 *
21 * NIN (input) INTEGER
22 * The logical unit number for input. NIN > 0.
23 *
24 * NOUT (input) INTEGER
25 * The logical unit number for output. NOUT > 0.
26 *
27 * ======================================================================
28 *
29 * .. Parameters ..
30 INTEGER LDE
31 PARAMETER ( LDE = 20 )
32 DOUBLE PRECISION ZERO
33 PARAMETER ( ZERO = 0.0D0 )
34 * ..
35 * .. Local Scalars ..
36 INTEGER I, IHI, ILO, INFO, J, KNT, N, NINFO
37 DOUBLE PRECISION EPS, RMAX, SAFMIN, VMAX, X
38 * ..
39 * .. Local Arrays ..
40 INTEGER LMAX( 2 )
41 DOUBLE PRECISION E( LDE, LDE ), EIN( LDE, LDE ), SCALE( LDE )
42 * ..
43 * .. External Functions ..
44 DOUBLE PRECISION DLAMCH
45 EXTERNAL DLAMCH
46 * ..
47 * .. External Subroutines ..
48 EXTERNAL DGEBAK
49 * ..
50 * .. Intrinsic Functions ..
51 INTRINSIC ABS, MAX
52 * ..
53 * .. Executable Statements ..
54 *
55 LMAX( 1 ) = 0
56 LMAX( 2 ) = 0
57 NINFO = 0
58 KNT = 0
59 RMAX = ZERO
60 EPS = DLAMCH( 'E' )
61 SAFMIN = DLAMCH( 'S' )
62 *
63 10 CONTINUE
64 *
65 READ( NIN, FMT = * )N, ILO, IHI
66 IF( N.EQ.0 )
67 $ GO TO 60
68 *
69 READ( NIN, FMT = * )( SCALE( I ), I = 1, N )
70 DO 20 I = 1, N
71 READ( NIN, FMT = * )( E( I, J ), J = 1, N )
72 20 CONTINUE
73 *
74 DO 30 I = 1, N
75 READ( NIN, FMT = * )( EIN( I, J ), J = 1, N )
76 30 CONTINUE
77 *
78 KNT = KNT + 1
79 CALL DGEBAK( 'B', 'R', N, ILO, IHI, SCALE, N, E, LDE, INFO )
80 *
81 IF( INFO.NE.0 ) THEN
82 NINFO = NINFO + 1
83 LMAX( 1 ) = KNT
84 END IF
85 *
86 VMAX = ZERO
87 DO 50 I = 1, N
88 DO 40 J = 1, N
89 X = ABS( E( I, J )-EIN( I, J ) ) / EPS
90 IF( ABS( E( I, J ) ).GT.SAFMIN )
91 $ X = X / ABS( E( I, J ) )
92 VMAX = MAX( VMAX, X )
93 40 CONTINUE
94 50 CONTINUE
95 *
96 IF( VMAX.GT.RMAX ) THEN
97 LMAX( 2 ) = KNT
98 RMAX = VMAX
99 END IF
100 *
101 GO TO 10
102 *
103 60 CONTINUE
104 *
105 WRITE( NOUT, FMT = 9999 )
106 9999 FORMAT( 1X, '.. test output of DGEBAK .. ' )
107 *
108 WRITE( NOUT, FMT = 9998 )RMAX
109 9998 FORMAT( 1X, 'value of largest test error = ', D12.3 )
110 WRITE( NOUT, FMT = 9997 )LMAX( 1 )
111 9997 FORMAT( 1X, 'example number where info is not zero = ', I4 )
112 WRITE( NOUT, FMT = 9996 )LMAX( 2 )
113 9996 FORMAT( 1X, 'example number having largest error = ', I4 )
114 WRITE( NOUT, FMT = 9995 )NINFO
115 9995 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 )
116 WRITE( NOUT, FMT = 9994 )KNT
117 9994 FORMAT( 1X, 'total number of examples tested = ', I4 )
118 *
119 RETURN
120 *
121 * End of DCHKBK
122 *
123 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER NIN, NOUT
9 * ..
10 *
11 * Purpose
12 * =======
13 *
14 * DCHKBK tests DGEBAK, a routine for backward transformation of
15 * the computed right or left eigenvectors if the orginal matrix
16 * was preprocessed by balance subroutine DGEBAL.
17 *
18 * Arguments
19 * =========
20 *
21 * NIN (input) INTEGER
22 * The logical unit number for input. NIN > 0.
23 *
24 * NOUT (input) INTEGER
25 * The logical unit number for output. NOUT > 0.
26 *
27 * ======================================================================
28 *
29 * .. Parameters ..
30 INTEGER LDE
31 PARAMETER ( LDE = 20 )
32 DOUBLE PRECISION ZERO
33 PARAMETER ( ZERO = 0.0D0 )
34 * ..
35 * .. Local Scalars ..
36 INTEGER I, IHI, ILO, INFO, J, KNT, N, NINFO
37 DOUBLE PRECISION EPS, RMAX, SAFMIN, VMAX, X
38 * ..
39 * .. Local Arrays ..
40 INTEGER LMAX( 2 )
41 DOUBLE PRECISION E( LDE, LDE ), EIN( LDE, LDE ), SCALE( LDE )
42 * ..
43 * .. External Functions ..
44 DOUBLE PRECISION DLAMCH
45 EXTERNAL DLAMCH
46 * ..
47 * .. External Subroutines ..
48 EXTERNAL DGEBAK
49 * ..
50 * .. Intrinsic Functions ..
51 INTRINSIC ABS, MAX
52 * ..
53 * .. Executable Statements ..
54 *
55 LMAX( 1 ) = 0
56 LMAX( 2 ) = 0
57 NINFO = 0
58 KNT = 0
59 RMAX = ZERO
60 EPS = DLAMCH( 'E' )
61 SAFMIN = DLAMCH( 'S' )
62 *
63 10 CONTINUE
64 *
65 READ( NIN, FMT = * )N, ILO, IHI
66 IF( N.EQ.0 )
67 $ GO TO 60
68 *
69 READ( NIN, FMT = * )( SCALE( I ), I = 1, N )
70 DO 20 I = 1, N
71 READ( NIN, FMT = * )( E( I, J ), J = 1, N )
72 20 CONTINUE
73 *
74 DO 30 I = 1, N
75 READ( NIN, FMT = * )( EIN( I, J ), J = 1, N )
76 30 CONTINUE
77 *
78 KNT = KNT + 1
79 CALL DGEBAK( 'B', 'R', N, ILO, IHI, SCALE, N, E, LDE, INFO )
80 *
81 IF( INFO.NE.0 ) THEN
82 NINFO = NINFO + 1
83 LMAX( 1 ) = KNT
84 END IF
85 *
86 VMAX = ZERO
87 DO 50 I = 1, N
88 DO 40 J = 1, N
89 X = ABS( E( I, J )-EIN( I, J ) ) / EPS
90 IF( ABS( E( I, J ) ).GT.SAFMIN )
91 $ X = X / ABS( E( I, J ) )
92 VMAX = MAX( VMAX, X )
93 40 CONTINUE
94 50 CONTINUE
95 *
96 IF( VMAX.GT.RMAX ) THEN
97 LMAX( 2 ) = KNT
98 RMAX = VMAX
99 END IF
100 *
101 GO TO 10
102 *
103 60 CONTINUE
104 *
105 WRITE( NOUT, FMT = 9999 )
106 9999 FORMAT( 1X, '.. test output of DGEBAK .. ' )
107 *
108 WRITE( NOUT, FMT = 9998 )RMAX
109 9998 FORMAT( 1X, 'value of largest test error = ', D12.3 )
110 WRITE( NOUT, FMT = 9997 )LMAX( 1 )
111 9997 FORMAT( 1X, 'example number where info is not zero = ', I4 )
112 WRITE( NOUT, FMT = 9996 )LMAX( 2 )
113 9996 FORMAT( 1X, 'example number having largest error = ', I4 )
114 WRITE( NOUT, FMT = 9995 )NINFO
115 9995 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 )
116 WRITE( NOUT, FMT = 9994 )KNT
117 9994 FORMAT( 1X, 'total number of examples tested = ', I4 )
118 *
119 RETURN
120 *
121 * End of DCHKBK
122 *
123 END