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