LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
schkbl.f
Go to the documentation of this file.
1 *> \brief \b SCHKBL
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 SCHKBL( NIN, NOUT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER NIN, NOUT
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> SCHKBL tests SGEBAL, a routine for balancing a general real
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 single_eig
53 *
54 * =====================================================================
55  SUBROUTINE schkbl( 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 * ..
79 * .. Local Arrays ..
80  INTEGER lmax( 3 )
81  REAL a( lda, lda ), ain( lda, lda ), dummy( 1 ),
82  $ scale( lda ), scalin( lda )
83 * ..
84 * .. External Functions ..
85  REAL slamch, slange
86  EXTERNAL slamch, slange
87 * ..
88 * .. External Subroutines ..
89  EXTERNAL sgebal
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  vmax = zero
103  sfmin = slamch( 'S' )
104  meps = slamch( 'E' )
105 *
106  10 continue
107 *
108  READ( nin, fmt = * )n
109  IF( n.EQ.0 )
110  $ go to 70
111  DO 20 i = 1, n
112  READ( nin, fmt = * )( a( i, j ), j = 1, n )
113  20 continue
114 *
115  READ( nin, fmt = * )iloin, ihiin
116  DO 30 i = 1, n
117  READ( nin, fmt = * )( ain( i, j ), j = 1, n )
118  30 continue
119  READ( nin, fmt = * )( scalin( i ), i = 1, n )
120 *
121  anorm = slange( 'M', n, n, a, lda, dummy )
122  knt = knt + 1
123 *
124  CALL sgebal( 'B', n, a, lda, ilo, ihi, scale, info )
125 *
126  IF( info.NE.0 ) THEN
127  ninfo = ninfo + 1
128  lmax( 1 ) = knt
129  END IF
130 *
131  IF( ilo.NE.iloin .OR. ihi.NE.ihiin ) THEN
132  ninfo = ninfo + 1
133  lmax( 2 ) = knt
134  END IF
135 *
136  DO 50 i = 1, n
137  DO 40 j = 1, n
138  temp = max( a( i, j ), ain( i, j ) )
139  temp = max( temp, sfmin )
140  vmax = max( vmax, abs( a( i, j )-ain( i, j ) ) / temp )
141  40 continue
142  50 continue
143 *
144  DO 60 i = 1, n
145  temp = max( scale( i ), scalin( i ) )
146  temp = max( temp, sfmin )
147  vmax = max( vmax, abs( scale( i )-scalin( i ) ) / temp )
148  60 continue
149 *
150 *
151  IF( vmax.GT.rmax ) THEN
152  lmax( 3 ) = knt
153  rmax = vmax
154  END IF
155 *
156  go to 10
157 *
158  70 continue
159 *
160  WRITE( nout, fmt = 9999 )
161  9999 format( 1x, '.. test output of SGEBAL .. ' )
162 *
163  WRITE( nout, fmt = 9998 )rmax
164  9998 format( 1x, 'value of largest test error = ', e12.3 )
165  WRITE( nout, fmt = 9997 )lmax( 1 )
166  9997 format( 1x, 'example number where info is not zero = ', i4 )
167  WRITE( nout, fmt = 9996 )lmax( 2 )
168  9996 format( 1x, 'example number where ILO or IHI wrong = ', i4 )
169  WRITE( nout, fmt = 9995 )lmax( 3 )
170  9995 format( 1x, 'example number having largest error = ', i4 )
171  WRITE( nout, fmt = 9994 )ninfo
172  9994 format( 1x, 'number of examples where info is not 0 = ', i4 )
173  WRITE( nout, fmt = 9993 )knt
174  9993 format( 1x, 'total number of examples tested = ', i4 )
175 *
176  return
177 *
178 * End of SCHKBL
179 *
180  END