LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine schkgl ( integer  NIN,
integer  NOUT 
)

SCHKGL

Purpose:
 SCHKGL tests SGGBAL, a routine for balancing a matrix pair (A, B).
Parameters
[in]NIN
          NIN is INTEGER
          The logical unit number for input.  NIN > 0.
[in]NOUT
          NOUT is INTEGER
          The logical unit number for output.  NOUT > 0.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 55 of file schkgl.f.

55 *
56 * -- LAPACK test routine (version 3.4.0) --
57 * -- LAPACK is a software package provided by Univ. of Tennessee, --
58 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59 * November 2011
60 *
61 * .. Scalar Arguments ..
62  INTEGER nin, nout
63 * ..
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68  INTEGER lda, ldb, lwork
69  parameter ( lda = 20, ldb = 20, lwork = 6*lda )
70  REAL zero
71  parameter ( zero = 0.0e+0 )
72 * ..
73 * .. Local Scalars ..
74  INTEGER i, ihi, ihiin, ilo, iloin, info, j, knt, n,
75  $ ninfo
76  REAL anorm, bnorm, eps, rmax, vmax
77 * ..
78 * .. Local Arrays ..
79  INTEGER lmax( 5 )
80  REAL a( lda, lda ), ain( lda, lda ), b( ldb, ldb ),
81  $ bin( ldb, ldb ), lscale( lda ), lsclin( lda ),
82  $ rscale( lda ), rsclin( lda ), work( lwork )
83 * ..
84 * .. External Functions ..
85  REAL slamch, slange
86  EXTERNAL slamch, slange
87 * ..
88 * .. External Subroutines ..
89  EXTERNAL sggbal
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 *
103  eps = slamch( 'Precision' )
104 *
105  10 CONTINUE
106 *
107  READ( nin, fmt = * )n
108  IF( n.EQ.0 )
109  $ GO TO 90
110  DO 20 i = 1, n
111  READ( nin, fmt = * )( a( i, j ), j = 1, n )
112  20 CONTINUE
113 *
114  DO 30 i = 1, n
115  READ( nin, fmt = * )( b( i, j ), j = 1, n )
116  30 CONTINUE
117 *
118  READ( nin, fmt = * )iloin, ihiin
119  DO 40 i = 1, n
120  READ( nin, fmt = * )( ain( i, j ), j = 1, n )
121  40 CONTINUE
122  DO 50 i = 1, n
123  READ( nin, fmt = * )( bin( i, j ), j = 1, n )
124  50 CONTINUE
125 *
126  READ( nin, fmt = * )( lsclin( i ), i = 1, n )
127  READ( nin, fmt = * )( rsclin( i ), i = 1, n )
128 *
129  anorm = slange( 'M', n, n, a, lda, work )
130  bnorm = slange( 'M', n, n, b, ldb, work )
131 *
132  knt = knt + 1
133 *
134  CALL sggbal( 'B', n, a, lda, b, ldb, ilo, ihi, lscale, rscale,
135  $ work, info )
136 *
137  IF( info.NE.0 ) THEN
138  ninfo = ninfo + 1
139  lmax( 1 ) = knt
140  END IF
141 *
142  IF( ilo.NE.iloin .OR. ihi.NE.ihiin ) THEN
143  ninfo = ninfo + 1
144  lmax( 2 ) = knt
145  END IF
146 *
147  vmax = zero
148  DO 70 i = 1, n
149  DO 60 j = 1, n
150  vmax = max( vmax, abs( a( i, j )-ain( i, j ) ) )
151  vmax = max( vmax, abs( b( i, j )-bin( i, j ) ) )
152  60 CONTINUE
153  70 CONTINUE
154 *
155  DO 80 i = 1, n
156  vmax = max( vmax, abs( lscale( i )-lsclin( i ) ) )
157  vmax = max( vmax, abs( rscale( i )-rsclin( i ) ) )
158  80 CONTINUE
159 *
160  vmax = vmax / ( eps*max( anorm, bnorm ) )
161 *
162  IF( vmax.GT.rmax ) THEN
163  lmax( 3 ) = knt
164  rmax = vmax
165  END IF
166 *
167  GO TO 10
168 *
169  90 CONTINUE
170 *
171  WRITE( nout, fmt = 9999 )
172  9999 FORMAT( 1x, '.. test output of SGGBAL .. ' )
173 *
174  WRITE( nout, fmt = 9998 )rmax
175  9998 FORMAT( 1x, 'value of largest test error = ', e12.3 )
176  WRITE( nout, fmt = 9997 )lmax( 1 )
177  9997 FORMAT( 1x, 'example number where info is not zero = ', i4 )
178  WRITE( nout, fmt = 9996 )lmax( 2 )
179  9996 FORMAT( 1x, 'example number where ILO or IHI wrong = ', i4 )
180  WRITE( nout, fmt = 9995 )lmax( 3 )
181  9995 FORMAT( 1x, 'example number having largest error = ', i4 )
182  WRITE( nout, fmt = 9994 )ninfo
183  9994 FORMAT( 1x, 'number of examples where info is not 0 = ', i4 )
184  WRITE( nout, fmt = 9993 )knt
185  9993 FORMAT( 1x, 'total number of examples tested = ', i4 )
186 *
187  RETURN
188 *
189 * End of SCHKGL
190 *
subroutine sggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
SGGBAL
Definition: sggbal.f:179
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69

Here is the call graph for this function:

Here is the caller graph for this function: