LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
dchkgl.f
Go to the documentation of this file.
1 *> \brief \b DCHKGL
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 DCHKGL( NIN, NOUT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER NIN, NOUT
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> DCHKGL tests DGGBAL, a routine for balancing a matrix pair (A, B).
24 *> \endverbatim
25 *
26 * Arguments:
27 * ==========
28 *
29 *> \param[in] NIN
30 *> \verbatim
31 *> NIN is INTEGER
32 *> The logical unit number for input. NIN > 0.
33 *> \endverbatim
34 *>
35 *> \param[in] NOUT
36 *> \verbatim
37 *> NOUT is INTEGER
38 *> The logical unit number for output. NOUT > 0.
39 *> \endverbatim
40 *
41 * Authors:
42 * ========
43 *
44 *> \author Univ. of Tennessee
45 *> \author Univ. of California Berkeley
46 *> \author Univ. of Colorado Denver
47 *> \author NAG Ltd.
48 *
49 *> \date November 2011
50 *
51 *> \ingroup double_eig
52 *
53 * =====================================================================
54  SUBROUTINE dchkgl( NIN, NOUT )
55 *
56 * -- LAPACK test routine (version 3.4.0) --
57 * -- LAPACK is a software package provided by Univ. of Tennessee, --
58 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59 * November 2011
60 *
61 * .. Scalar Arguments ..
62  INTEGER nin, nout
63 * ..
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68  INTEGER lda, ldb, lwork
69  parameter( lda = 20, ldb = 20, lwork = 6*lda )
70  DOUBLE PRECISION zero
71  parameter( zero = 0.0d+0 )
72 * ..
73 * .. Local Scalars ..
74  INTEGER i, ihi, ihiin, ilo, iloin, info, j, knt, n,
75  $ ninfo
76  DOUBLE PRECISION anorm, bnorm, eps, rmax, vmax
77 * ..
78 * .. Local Arrays ..
79  INTEGER lmax( 5 )
80  DOUBLE PRECISION a( lda, lda ), ain( lda, lda ), b( ldb, ldb ),
81  $ bin( ldb, ldb ), lscale( lda ), lsclin( lda ),
82  $ rscale( lda ), rsclin( lda ), work( lwork )
83 * ..
84 * .. External Functions ..
85  DOUBLE PRECISION dlamch, dlange
86  EXTERNAL dlamch, dlange
87 * ..
88 * .. External Subroutines ..
89  EXTERNAL dggbal
90 * ..
91 * .. Intrinsic Functions ..
92  INTRINSIC abs, max
93 * ..
94 * .. Executable Statements ..
95 *
96  lmax( 1 ) = 0
97  lmax( 2 ) = 0
98  lmax( 3 ) = 0
99  ninfo = 0
100  knt = 0
101  rmax = zero
102 *
103  eps = dlamch( 'Precision' )
104 *
105  10 CONTINUE
106 *
107  READ( nin, fmt = * )n
108  IF( n.EQ.0 )
109  $ go to 90
110  DO 20 i = 1, n
111  READ( nin, fmt = * )( a( i, j ), j = 1, n )
112  20 CONTINUE
113 *
114  DO 30 i = 1, n
115  READ( nin, fmt = * )( b( i, j ), j = 1, n )
116  30 CONTINUE
117 *
118  READ( nin, fmt = * )iloin, ihiin
119  DO 40 i = 1, n
120  READ( nin, fmt = * )( ain( i, j ), j = 1, n )
121  40 CONTINUE
122  DO 50 i = 1, n
123  READ( nin, fmt = * )( bin( i, j ), j = 1, n )
124  50 CONTINUE
125 *
126  READ( nin, fmt = * )( lsclin( i ), i = 1, n )
127  READ( nin, fmt = * )( rsclin( i ), i = 1, n )
128 *
129  anorm = dlange( 'M', n, n, a, lda, work )
130  bnorm = dlange( 'M', n, n, b, ldb, work )
131 *
132  knt = knt + 1
133 *
134  CALL dggbal( 'B', n, a, lda, b, ldb, ilo, ihi, lscale, rscale,
135  $ work, info )
136 *
137  IF( info.NE.0 ) THEN
138  ninfo = ninfo + 1
139  lmax( 1 ) = knt
140  END IF
141 *
142  IF( ilo.NE.iloin .OR. ihi.NE.ihiin ) THEN
143  ninfo = ninfo + 1
144  lmax( 2 ) = knt
145  END IF
146 *
147  vmax = zero
148  DO 70 i = 1, n
149  DO 60 j = 1, n
150  vmax = max( vmax, abs( a( i, j )-ain( i, j ) ) )
151  vmax = max( vmax, abs( b( i, j )-bin( i, j ) ) )
152  60 CONTINUE
153  70 CONTINUE
154 *
155  DO 80 i = 1, n
156  vmax = max( vmax, abs( lscale( i )-lsclin( i ) ) )
157  vmax = max( vmax, abs( rscale( i )-rsclin( i ) ) )
158  80 CONTINUE
159 *
160  vmax = vmax / ( eps*max( anorm, bnorm ) )
161 *
162  IF( vmax.GT.rmax ) THEN
163  lmax( 3 ) = knt
164  rmax = vmax
165  END IF
166 *
167  go to 10
168 *
169  90 CONTINUE
170 *
171  WRITE( nout, fmt = 9999 )
172  9999 FORMAT( 1x, '.. test output of DGGBAL .. ' )
173 *
174  WRITE( nout, fmt = 9998 )rmax
175  9998 FORMAT( 1x, 'value of largest test error = ', d12.3 )
176  WRITE( nout, fmt = 9997 )lmax( 1 )
177  9997 FORMAT( 1x, 'example number where info is not zero = ', i4 )
178  WRITE( nout, fmt = 9996 )lmax( 2 )
179  9996 FORMAT( 1x, 'example number where ILO or IHI wrong = ', i4 )
180  WRITE( nout, fmt = 9995 )lmax( 3 )
181  9995 FORMAT( 1x, 'example number having largest error = ', i4 )
182  WRITE( nout, fmt = 9994 )ninfo
183  9994 FORMAT( 1x, 'number of examples where info is not 0 = ', i4 )
184  WRITE( nout, fmt = 9993 )knt
185  9993 FORMAT( 1x, 'total number of examples tested = ', i4 )
186 *
187  RETURN
188 *
189 * End of DCHKGL
190 *
191  END