LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
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 *> \ingroup single_eig
51 *
52 * =====================================================================
53  SUBROUTINE schkbl( NIN, NOUT )
54 *
55 * -- LAPACK test routine --
56 * -- LAPACK is a software package provided by Univ. of Tennessee, --
57 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
58 *
59 * .. Scalar Arguments ..
60  INTEGER NIN, NOUT
61 * ..
62 *
63 * ======================================================================
64 *
65 * .. Parameters ..
66  INTEGER LDA
67  parameter( lda = 20 )
68  REAL ZERO
69  parameter( zero = 0.0e+0 )
70 * ..
71 * .. Local Scalars ..
72  INTEGER I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N,
73  $ NINFO
74  REAL ANORM, MEPS, RMAX, SFMIN, TEMP, VMAX
75 * ..
76 * .. Local Arrays ..
77  INTEGER LMAX( 3 )
78  REAL A( LDA, LDA ), AIN( LDA, LDA ), DUMMY( 1 ),
79  $ SCALE( LDA ), SCALIN( LDA )
80 * ..
81 * .. External Functions ..
82  REAL SLAMCH, SLANGE
83  EXTERNAL slamch, slange
84 * ..
85 * .. External Subroutines ..
86  EXTERNAL sgebal
87 * ..
88 * .. Intrinsic Functions ..
89  INTRINSIC abs, max
90 * ..
91 * .. Executable Statements ..
92 *
93  lmax( 1 ) = 0
94  lmax( 2 ) = 0
95  lmax( 3 ) = 0
96  ninfo = 0
97  knt = 0
98  rmax = zero
99  vmax = zero
100  sfmin = slamch( 'S' )
101  meps = slamch( 'E' )
102 *
103  10 CONTINUE
104 *
105  READ( nin, fmt = * )n
106  IF( n.EQ.0 )
107  $ GO TO 70
108  DO 20 i = 1, n
109  READ( nin, fmt = * )( a( i, j ), j = 1, n )
110  20 CONTINUE
111 *
112  READ( nin, fmt = * )iloin, ihiin
113  DO 30 i = 1, n
114  READ( nin, fmt = * )( ain( i, j ), j = 1, n )
115  30 CONTINUE
116  READ( nin, fmt = * )( scalin( i ), i = 1, n )
117 *
118  anorm = slange( 'M', n, n, a, lda, dummy )
119  knt = knt + 1
120 *
121  CALL sgebal( 'B', n, a, lda, ilo, ihi, scale, info )
122 *
123  IF( info.NE.0 ) THEN
124  ninfo = ninfo + 1
125  lmax( 1 ) = knt
126  END IF
127 *
128  IF( ilo.NE.iloin .OR. ihi.NE.ihiin ) THEN
129  ninfo = ninfo + 1
130  lmax( 2 ) = knt
131  END IF
132 *
133  DO 50 i = 1, n
134  DO 40 j = 1, n
135  temp = max( a( i, j ), ain( i, j ) )
136  temp = max( temp, sfmin )
137  vmax = max( vmax, abs( a( i, j )-ain( i, j ) ) / temp )
138  40 CONTINUE
139  50 CONTINUE
140 *
141  DO 60 i = 1, n
142  temp = max( scale( i ), scalin( i ) )
143  temp = max( temp, sfmin )
144  vmax = max( vmax, abs( scale( i )-scalin( i ) ) / temp )
145  60 CONTINUE
146 *
147 *
148  IF( vmax.GT.rmax ) THEN
149  lmax( 3 ) = knt
150  rmax = vmax
151  END IF
152 *
153  GO TO 10
154 *
155  70 CONTINUE
156 *
157  WRITE( nout, fmt = 9999 )
158  9999 FORMAT( 1x, '.. test output of SGEBAL .. ' )
159 *
160  WRITE( nout, fmt = 9998 )rmax
161  9998 FORMAT( 1x, 'value of largest test error = ', e12.3 )
162  WRITE( nout, fmt = 9997 )lmax( 1 )
163  9997 FORMAT( 1x, 'example number where info is not zero = ', i4 )
164  WRITE( nout, fmt = 9996 )lmax( 2 )
165  9996 FORMAT( 1x, 'example number where ILO or IHI wrong = ', i4 )
166  WRITE( nout, fmt = 9995 )lmax( 3 )
167  9995 FORMAT( 1x, 'example number having largest error = ', i4 )
168  WRITE( nout, fmt = 9994 )ninfo
169  9994 FORMAT( 1x, 'number of examples where info is not 0 = ', i4 )
170  WRITE( nout, fmt = 9993 )knt
171  9993 FORMAT( 1x, 'total number of examples tested = ', i4 )
172 *
173  RETURN
174 *
175 * End of SCHKBL
176 *
177  END
subroutine sgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
SGEBAL
Definition: sgebal.f:160
subroutine schkbl(NIN, NOUT)
SCHKBL
Definition: schkbl.f:54