54
55
56
57
58
59
60 INTEGER NIN, NOUT
61
62
63
64
65
66 INTEGER LDA
67 parameter( lda = 20 )
68 DOUBLE PRECISION ZERO
69 parameter( zero = 0.0d+0 )
70
71
72 INTEGER I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N,
73 $ NINFO
74 DOUBLE PRECISION ANORM, MEPS, RMAX, SFMIN, TEMP, VMAX
75
76
77 INTEGER LMAX( 3 )
78 DOUBLE PRECISION A( LDA, LDA ), AIN( LDA, LDA ), DUMMY( 1 ),
79 $ SCALE( LDA ), SCALIN( LDA )
80
81
82 DOUBLE PRECISION DLAMCH, DLANGE
84
85
87
88
89 INTRINSIC abs, max
90
91
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
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 =
dlange(
'M', n, n, a, lda, dummy )
119 knt = knt + 1
120
121 CALL dgebal(
'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 DGEBAL .. ' )
159
160 WRITE( nout, fmt = 9998 )rmax
161 9998 FORMAT( 1x, 'value of largest test error = ', d12.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
176
subroutine dgebal(job, n, a, lda, ilo, ihi, scale, info)
DGEBAL
double precision function dlamch(cmach)
DLAMCH
double precision function dlange(norm, m, n, a, lda, work)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...