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
178