LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
cchkgl.f
Go to the documentation of this file.
1 *> \brief \b CCHKGL
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 CCHKGL( NIN, NOUT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER NIN, NOUT
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> CCHKGL tests CGGBAL, 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 complex_eig
52 *
53 * =====================================================================
54  SUBROUTINE cchkgl( 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  REAL ZERO
71  parameter ( zero = 0.0e+0 )
72 * ..
73 * .. Local Scalars ..
74  INTEGER I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N,
75  $ ninfo
76  REAL ANORM, BNORM, EPS, RMAX, VMAX
77 * ..
78 * .. Local Arrays ..
79  INTEGER LMAX( 3 )
80  REAL LSCALE( lda ), LSCLIN( lda ), RSCALE( lda ),
81  $ rsclin( lda ), work( lwork )
82  COMPLEX A( lda, lda ), AIN( lda, lda ), B( ldb, ldb ),
83  $ bin( ldb, ldb )
84 * ..
85 * .. External Functions ..
86  REAL CLANGE, SLAMCH
87  EXTERNAL clange, slamch
88 * ..
89 * .. External Subroutines ..
90  EXTERNAL cggbal
91 * ..
92 * .. Intrinsic Functions ..
93  INTRINSIC abs, max
94 * ..
95 * .. Executable Statements ..
96 *
97  lmax( 1 ) = 0
98  lmax( 2 ) = 0
99  lmax( 3 ) = 0
100  ninfo = 0
101  knt = 0
102  rmax = zero
103 *
104  eps = slamch( 'Precision' )
105 *
106  10 CONTINUE
107 *
108  READ( nin, fmt = * )n
109  IF( n.EQ.0 )
110  $ GO TO 90
111  DO 20 i = 1, n
112  READ( nin, fmt = * )( a( i, j ), j = 1, n )
113  20 CONTINUE
114 *
115  DO 30 i = 1, n
116  READ( nin, fmt = * )( b( i, j ), j = 1, n )
117  30 CONTINUE
118 *
119  READ( nin, fmt = * )iloin, ihiin
120  DO 40 i = 1, n
121  READ( nin, fmt = * )( ain( i, j ), j = 1, n )
122  40 CONTINUE
123  DO 50 i = 1, n
124  READ( nin, fmt = * )( bin( i, j ), j = 1, n )
125  50 CONTINUE
126 *
127  READ( nin, fmt = * )( lsclin( i ), i = 1, n )
128  READ( nin, fmt = * )( rsclin( i ), i = 1, n )
129 *
130  anorm = clange( 'M', n, n, a, lda, work )
131  bnorm = clange( 'M', n, n, b, ldb, work )
132 *
133  knt = knt + 1
134 *
135  CALL cggbal( 'B', n, a, lda, b, ldb, ilo, ihi, lscale, rscale,
136  $ work, info )
137 *
138  IF( info.NE.0 ) THEN
139  ninfo = ninfo + 1
140  lmax( 1 ) = knt
141  END IF
142 *
143  IF( ilo.NE.iloin .OR. ihi.NE.ihiin ) THEN
144  ninfo = ninfo + 1
145  lmax( 2 ) = knt
146  END IF
147 *
148  vmax = zero
149  DO 70 i = 1, n
150  DO 60 j = 1, n
151  vmax = max( vmax, abs( a( i, j )-ain( i, j ) ) )
152  vmax = max( vmax, abs( b( i, j )-bin( i, j ) ) )
153  60 CONTINUE
154  70 CONTINUE
155 *
156  DO 80 i = 1, n
157  vmax = max( vmax, abs( lscale( i )-lsclin( i ) ) )
158  vmax = max( vmax, abs( rscale( i )-rsclin( i ) ) )
159  80 CONTINUE
160 *
161  vmax = vmax / ( eps*max( anorm, bnorm ) )
162 *
163  IF( vmax.GT.rmax ) THEN
164  lmax( 3 ) = knt
165  rmax = vmax
166  END IF
167 *
168  GO TO 10
169 *
170  90 CONTINUE
171 *
172  WRITE( nout, fmt = 9999 )
173  9999 FORMAT( ' .. test output of CGGBAL .. ' )
174 *
175  WRITE( nout, fmt = 9998 )rmax
176  9998 FORMAT( ' ratio of largest test error = ', e12.3 )
177  WRITE( nout, fmt = 9997 )lmax( 1 )
178  9997 FORMAT( ' example number where info is not zero = ', i4 )
179  WRITE( nout, fmt = 9996 )lmax( 2 )
180  9996 FORMAT( ' example number where ILO or IHI is wrong = ', i4 )
181  WRITE( nout, fmt = 9995 )lmax( 3 )
182  9995 FORMAT( ' example number having largest error = ', i4 )
183  WRITE( nout, fmt = 9994 )ninfo
184  9994 FORMAT( ' number of examples where info is not 0 = ', i4 )
185  WRITE( nout, fmt = 9993 )knt
186  9993 FORMAT( ' total number of examples tested = ', i4 )
187 *
188  RETURN
189 *
190 * End of CCHKGL
191 *
192  END
subroutine cggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
CGGBAL
Definition: cggbal.f:179
subroutine cchkgl(NIN, NOUT)
CCHKGL
Definition: cchkgl.f:55