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