LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dchkbk.f
Go to the documentation of this file.
1*> \brief \b DCHKBK
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE DCHKBK( NIN, NOUT )
12*
13* .. Scalar Arguments ..
14* INTEGER NIN, NOUT
15* ..
16*
17*
18*> \par Purpose:
19* =============
20*>
21*> \verbatim
22*>
23*> DCHKBK tests DGEBAK, a routine for backward transformation of
24*> the computed right or left eigenvectors if the original matrix
25*> was preprocessed by balance subroutine DGEBAL.
26*> \endverbatim
27*
28* Arguments:
29* ==========
30*
31*> \param[in] NIN
32*> \verbatim
33*> NIN is INTEGER
34*> The logical unit number for input. NIN > 0.
35*> \endverbatim
36*>
37*> \param[in] NOUT
38*> \verbatim
39*> NOUT is INTEGER
40*> The logical unit number for output. NOUT > 0.
41*> \endverbatim
42*
43* Authors:
44* ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \ingroup double_eig
52*
53* =====================================================================
54 SUBROUTINE dchkbk( NIN, NOUT )
55*
56* -- LAPACK test routine --
57* -- LAPACK is a software package provided by Univ. of Tennessee, --
58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60* .. Scalar Arguments ..
61 INTEGER NIN, NOUT
62* ..
63*
64* ======================================================================
65*
66* .. Parameters ..
67 INTEGER LDE
68 parameter( lde = 20 )
69 DOUBLE PRECISION ZERO
70 parameter( zero = 0.0d0 )
71* ..
72* .. Local Scalars ..
73 INTEGER I, IHI, ILO, INFO, J, KNT, N, NINFO
74 DOUBLE PRECISION EPS, RMAX, SAFMIN, VMAX, X
75* ..
76* .. Local Arrays ..
77 INTEGER LMAX( 2 )
78 DOUBLE PRECISION E( LDE, LDE ), EIN( LDE, LDE ), SCALE( LDE )
79* ..
80* .. External Functions ..
81 DOUBLE PRECISION DLAMCH
82 EXTERNAL dlamch
83* ..
84* .. External Subroutines ..
85 EXTERNAL dgebak
86* ..
87* .. Intrinsic Functions ..
88 INTRINSIC abs, max
89* ..
90* .. Executable Statements ..
91*
92 lmax( 1 ) = 0
93 lmax( 2 ) = 0
94 ninfo = 0
95 knt = 0
96 rmax = zero
97 eps = dlamch( 'E' )
98 safmin = dlamch( 'S' )
99*
100 10 CONTINUE
101*
102 READ( nin, fmt = * )n, ilo, ihi
103 IF( n.EQ.0 )
104 $ GO TO 60
105*
106 READ( nin, fmt = * )( scale( i ), i = 1, n )
107 DO 20 i = 1, n
108 READ( nin, fmt = * )( e( i, j ), j = 1, n )
109 20 CONTINUE
110*
111 DO 30 i = 1, n
112 READ( nin, fmt = * )( ein( i, j ), j = 1, n )
113 30 CONTINUE
114*
115 knt = knt + 1
116 CALL dgebak( 'B', 'R', n, ilo, ihi, scale, n, e, lde, info )
117*
118 IF( info.NE.0 ) THEN
119 ninfo = ninfo + 1
120 lmax( 1 ) = knt
121 END IF
122*
123 vmax = zero
124 DO 50 i = 1, n
125 DO 40 j = 1, n
126 x = abs( e( i, j )-ein( i, j ) ) / eps
127 IF( abs( e( i, j ) ).GT.safmin )
128 $ x = x / abs( e( i, j ) )
129 vmax = max( vmax, x )
130 40 CONTINUE
131 50 CONTINUE
132*
133 IF( vmax.GT.rmax ) THEN
134 lmax( 2 ) = knt
135 rmax = vmax
136 END IF
137*
138 GO TO 10
139*
140 60 CONTINUE
141*
142 WRITE( nout, fmt = 9999 )
143 9999 FORMAT( 1x, '.. test output of DGEBAK .. ' )
144*
145 WRITE( nout, fmt = 9998 )rmax
146 9998 FORMAT( 1x, 'value of largest test error = ', d12.3 )
147 WRITE( nout, fmt = 9997 )lmax( 1 )
148 9997 FORMAT( 1x, 'example number where info is not zero = ', i4 )
149 WRITE( nout, fmt = 9996 )lmax( 2 )
150 9996 FORMAT( 1x, 'example number having largest error = ', i4 )
151 WRITE( nout, fmt = 9995 )ninfo
152 9995 FORMAT( 1x, 'number of examples where info is not 0 = ', i4 )
153 WRITE( nout, fmt = 9994 )knt
154 9994 FORMAT( 1x, 'total number of examples tested = ', i4 )
155*
156 RETURN
157*
158* End of DCHKBK
159*
160 END
subroutine dchkbk(nin, nout)
DCHKBK
Definition dchkbk.f:55
subroutine dgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
DGEBAK
Definition dgebak.f:130