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
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 ...
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL