1*> \brief \b SCHKGL
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 SCHKGL( NIN, NOUT )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            NIN, NOUT
15*       ..
16*
17*
18*> \par Purpose:
19*  =============
20*>
21*> \verbatim
22*>
23*> SCHKGL tests SGGBAL, 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 single_eig
50*
51*  =====================================================================
52      SUBROUTINE SCHKGL( 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      REAL               ZERO
68      PARAMETER          ( ZERO = 0.0E+0 )
69*     ..
70*     .. Local Scalars ..
71      INTEGER            I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N,
72     $                   NINFO
73      REAL               ANORM, BNORM, EPS, RMAX, VMAX
74*     ..
75*     .. Local Arrays ..
76      INTEGER            LMAX( 5 )
77      REAL               A( LDA, LDA ), AIN( LDA, LDA ), B( LDB, LDB ),
78     $                   BIN( LDB, LDB ), LSCALE( LDA ), LSCLIN( LDA ),
79     $                   RSCALE( LDA ), RSCLIN( LDA ), WORK( LWORK )
80*     ..
81*     .. External Functions ..
82      REAL               SLAMCH, SLANGE
83      EXTERNAL           SLAMCH, SLANGE
84*     ..
85*     .. External Subroutines ..
86      EXTERNAL           SGGBAL
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*
100      EPS = SLAMCH( 'Precision' )
101*
102   10 CONTINUE
103*
104      READ( NIN, FMT = * )N
105      IF( N.EQ.0 )
106     $   GO TO 90
107      DO 20 I = 1, N
108         READ( NIN, FMT = * )( A( I, J ), J = 1, N )
109   20 CONTINUE
110*
111      DO 30 I = 1, N
112         READ( NIN, FMT = * )( B( I, J ), J = 1, N )
113   30 CONTINUE
114*
115      READ( NIN, FMT = * )ILOIN, IHIIN
116      DO 40 I = 1, N
117         READ( NIN, FMT = * )( AIN( I, J ), J = 1, N )
118   40 CONTINUE
119      DO 50 I = 1, N
120         READ( NIN, FMT = * )( BIN( I, J ), J = 1, N )
121   50 CONTINUE
122*
123      READ( NIN, FMT = * )( LSCLIN( I ), I = 1, N )
124      READ( NIN, FMT = * )( RSCLIN( I ), I = 1, N )
125*
126      ANORM = SLANGE( 'M', N, N, A, LDA, WORK )
127      BNORM = SLANGE( 'M', N, N, B, LDB, WORK )
128*
129      KNT = KNT + 1
130*
131      CALL SGGBAL( 'B', N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE,
132     $             WORK, INFO )
133*
134      IF( INFO.NE.0 ) THEN
135         NINFO = NINFO + 1
136         LMAX( 1 ) = KNT
137      END IF
138*
139      IF( ILO.NE.ILOIN .OR. IHI.NE.IHIIN ) THEN
140         NINFO = NINFO + 1
141         LMAX( 2 ) = KNT
142      END IF
143*
144      VMAX = ZERO
145      DO 70 I = 1, N
146         DO 60 J = 1, N
147            VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) )
148            VMAX = MAX( VMAX, ABS( B( I, J )-BIN( I, J ) ) )
149   60    CONTINUE
150   70 CONTINUE
151*
152      DO 80 I = 1, N
153         VMAX = MAX( VMAX, ABS( LSCALE( I )-LSCLIN( I ) ) )
154         VMAX = MAX( VMAX, ABS( RSCALE( I )-RSCLIN( I ) ) )
155   80 CONTINUE
156*
157      VMAX = VMAX / ( EPS*MAX( ANORM, BNORM ) )
158*
159      IF( VMAX.GT.RMAX ) THEN
160         LMAX( 3 ) = KNT
161         RMAX = VMAX
162      END IF
163*
164      GO TO 10
165*
166   90 CONTINUE
167*
168      WRITE( NOUT, FMT = 9999 )
169 9999 FORMAT( 1X, '.. test output of SGGBAL .. ' )
170*
171      WRITE( NOUT, FMT = 9998 )RMAX
172 9998 FORMAT( 1X, 'value of largest test error            = ', E12.3 )
173      WRITE( NOUT, FMT = 9997 )LMAX( 1 )
174 9997 FORMAT( 1X, 'example number where info is not zero  = ', I4 )
175      WRITE( NOUT, FMT = 9996 )LMAX( 2 )
176 9996 FORMAT( 1X, 'example number where ILO or IHI wrong  = ', I4 )
177      WRITE( NOUT, FMT = 9995 )LMAX( 3 )
178 9995 FORMAT( 1X, 'example number having largest error    = ', I4 )
179      WRITE( NOUT, FMT = 9994 )NINFO
180 9994 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 )
181      WRITE( NOUT, FMT = 9993 )KNT
182 9993 FORMAT( 1X, 'total number of examples tested        = ', I4 )
183*
184      RETURN
185*
186*     End of SCHKGL
187*
188      END
189