1 SUBROUTINE ZCHKBK( 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 * ZCHKBK tests ZGEBAK, a routine for backward transformation of
15 * the computed right or left eigenvectors if the orginal matrix
16 * was preprocessed by balance subroutine ZGEBAL.
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 COMPLEX*16 CDUM
39 * ..
40 * .. Local Arrays ..
41 INTEGER LMAX( 2 )
42 DOUBLE PRECISION SCALE( LDE )
43 COMPLEX*16 E( LDE, LDE ), EIN( LDE, LDE )
44 * ..
45 * .. External Functions ..
46 DOUBLE PRECISION DLAMCH
47 EXTERNAL DLAMCH
48 * ..
49 * .. External Subroutines ..
50 EXTERNAL ZGEBAK
51 * ..
52 * .. Intrinsic Functions ..
53 INTRINSIC ABS, DBLE, DIMAG, MAX
54 * ..
55 * .. Statement Functions ..
56 DOUBLE PRECISION CABS1
57 * ..
58 * .. Statement Function definitions ..
59 CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
60 * ..
61 * .. Executable Statements ..
62 *
63 LMAX( 1 ) = 0
64 LMAX( 2 ) = 0
65 NINFO = 0
66 KNT = 0
67 RMAX = ZERO
68 EPS = DLAMCH( 'E' )
69 SAFMIN = DLAMCH( 'S' )
70 *
71 10 CONTINUE
72 *
73 READ( NIN, FMT = * )N, ILO, IHI
74 IF( N.EQ.0 )
75 $ GO TO 60
76 *
77 READ( NIN, FMT = * )( SCALE( I ), I = 1, N )
78 DO 20 I = 1, N
79 READ( NIN, FMT = * )( E( I, J ), J = 1, N )
80 20 CONTINUE
81 *
82 DO 30 I = 1, N
83 READ( NIN, FMT = * )( EIN( I, J ), J = 1, N )
84 30 CONTINUE
85 *
86 KNT = KNT + 1
87 CALL ZGEBAK( 'B', 'R', N, ILO, IHI, SCALE, N, E, LDE, INFO )
88 *
89 IF( INFO.NE.0 ) THEN
90 NINFO = NINFO + 1
91 LMAX( 1 ) = KNT
92 END IF
93 *
94 VMAX = ZERO
95 DO 50 I = 1, N
96 DO 40 J = 1, N
97 X = CABS1( E( I, J )-EIN( I, J ) ) / EPS
98 IF( CABS1( E( I, J ) ).GT.SAFMIN )
99 $ X = X / CABS1( E( I, J ) )
100 VMAX = MAX( VMAX, X )
101 40 CONTINUE
102 50 CONTINUE
103 *
104 IF( VMAX.GT.RMAX ) THEN
105 LMAX( 2 ) = KNT
106 RMAX = VMAX
107 END IF
108 *
109 GO TO 10
110 *
111 60 CONTINUE
112 *
113 WRITE( NOUT, FMT = 9999 )
114 9999 FORMAT( 1X, '.. test output of ZGEBAK .. ' )
115 *
116 WRITE( NOUT, FMT = 9998 )RMAX
117 9998 FORMAT( 1X, 'value of largest test error = ', D12.3 )
118 WRITE( NOUT, FMT = 9997 )LMAX( 1 )
119 9997 FORMAT( 1X, 'example number where info is not zero = ', I4 )
120 WRITE( NOUT, FMT = 9996 )LMAX( 2 )
121 9996 FORMAT( 1X, 'example number having largest error = ', I4 )
122 WRITE( NOUT, FMT = 9995 )NINFO
123 9995 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 )
124 WRITE( NOUT, FMT = 9994 )KNT
125 9994 FORMAT( 1X, 'total number of examples tested = ', I4 )
126 *
127 RETURN
128 *
129 * End of ZCHKBK
130 *
131 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 * ZCHKBK tests ZGEBAK, a routine for backward transformation of
15 * the computed right or left eigenvectors if the orginal matrix
16 * was preprocessed by balance subroutine ZGEBAL.
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 COMPLEX*16 CDUM
39 * ..
40 * .. Local Arrays ..
41 INTEGER LMAX( 2 )
42 DOUBLE PRECISION SCALE( LDE )
43 COMPLEX*16 E( LDE, LDE ), EIN( LDE, LDE )
44 * ..
45 * .. External Functions ..
46 DOUBLE PRECISION DLAMCH
47 EXTERNAL DLAMCH
48 * ..
49 * .. External Subroutines ..
50 EXTERNAL ZGEBAK
51 * ..
52 * .. Intrinsic Functions ..
53 INTRINSIC ABS, DBLE, DIMAG, MAX
54 * ..
55 * .. Statement Functions ..
56 DOUBLE PRECISION CABS1
57 * ..
58 * .. Statement Function definitions ..
59 CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
60 * ..
61 * .. Executable Statements ..
62 *
63 LMAX( 1 ) = 0
64 LMAX( 2 ) = 0
65 NINFO = 0
66 KNT = 0
67 RMAX = ZERO
68 EPS = DLAMCH( 'E' )
69 SAFMIN = DLAMCH( 'S' )
70 *
71 10 CONTINUE
72 *
73 READ( NIN, FMT = * )N, ILO, IHI
74 IF( N.EQ.0 )
75 $ GO TO 60
76 *
77 READ( NIN, FMT = * )( SCALE( I ), I = 1, N )
78 DO 20 I = 1, N
79 READ( NIN, FMT = * )( E( I, J ), J = 1, N )
80 20 CONTINUE
81 *
82 DO 30 I = 1, N
83 READ( NIN, FMT = * )( EIN( I, J ), J = 1, N )
84 30 CONTINUE
85 *
86 KNT = KNT + 1
87 CALL ZGEBAK( 'B', 'R', N, ILO, IHI, SCALE, N, E, LDE, INFO )
88 *
89 IF( INFO.NE.0 ) THEN
90 NINFO = NINFO + 1
91 LMAX( 1 ) = KNT
92 END IF
93 *
94 VMAX = ZERO
95 DO 50 I = 1, N
96 DO 40 J = 1, N
97 X = CABS1( E( I, J )-EIN( I, J ) ) / EPS
98 IF( CABS1( E( I, J ) ).GT.SAFMIN )
99 $ X = X / CABS1( E( I, J ) )
100 VMAX = MAX( VMAX, X )
101 40 CONTINUE
102 50 CONTINUE
103 *
104 IF( VMAX.GT.RMAX ) THEN
105 LMAX( 2 ) = KNT
106 RMAX = VMAX
107 END IF
108 *
109 GO TO 10
110 *
111 60 CONTINUE
112 *
113 WRITE( NOUT, FMT = 9999 )
114 9999 FORMAT( 1X, '.. test output of ZGEBAK .. ' )
115 *
116 WRITE( NOUT, FMT = 9998 )RMAX
117 9998 FORMAT( 1X, 'value of largest test error = ', D12.3 )
118 WRITE( NOUT, FMT = 9997 )LMAX( 1 )
119 9997 FORMAT( 1X, 'example number where info is not zero = ', I4 )
120 WRITE( NOUT, FMT = 9996 )LMAX( 2 )
121 9996 FORMAT( 1X, 'example number having largest error = ', I4 )
122 WRITE( NOUT, FMT = 9995 )NINFO
123 9995 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 )
124 WRITE( NOUT, FMT = 9994 )KNT
125 9994 FORMAT( 1X, 'total number of examples tested = ', I4 )
126 *
127 RETURN
128 *
129 * End of ZCHKBK
130 *
131 END