1 SUBROUTINE ZDRVAB( DOTYPE, NM, MVAL, NNS,
2 $ NSVAL, THRESH, NMAX, A, AFAC, B,
3 $ X, WORK, RWORK, SWORK, IWORK, NOUT )
4 IMPLICIT NONE
5 *
6 * -- LAPACK test routine (version 3.1) --
7 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
8 * June 2010
9 *
10 * .. Scalar Arguments ..
11 INTEGER NM, NMAX, NNS, NOUT
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER MVAL( * ), NSVAL( * ), IWORK( * )
17 DOUBLE PRECISION RWORK( * )
18 COMPLEX SWORK( * )
19 COMPLEX*16 A( * ), AFAC( * ), B( * ),
20 $ WORK( * ), X( * )
21 * ..
22 *
23 * Purpose
24 * =======
25 *
26 * ZDRVAB tests ZCGESV
27 *
28 * Arguments
29 * =========
30 *
31 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
32 * The matrix types to be used for testing. Matrices of type j
33 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
34 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
35 *
36 * NM (input) INTEGER
37 * The number of values of M contained in the vector MVAL.
38 *
39 * MVAL (input) INTEGER array, dimension (NM)
40 * The values of the matrix row dimension M.
41 *
42 * NNS (input) INTEGER
43 * The number of values of NRHS contained in the vector NSVAL.
44 *
45 * NSVAL (input) INTEGER array, dimension (NNS)
46 * The values of the number of right hand sides NRHS.
47 *
48 * THRESH (input) DOUBLE PRECISION
49 * The threshold value for the test ratios. A result is
50 * included in the output file if RESULT >= THRESH. To have
51 * every test ratio printed, use THRESH = 0.
52 *
53 * NMAX (input) INTEGER
54 * The maximum value permitted for M or N, used in dimensioning
55 * the work arrays.
56 *
57 * A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
58 *
59 * AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
60 *
61 * B (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
62 * where NSMAX is the largest entry in NSVAL.
63 *
64 * X (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
65 *
66 * WORK (workspace) COMPLEX*16 array, dimension
67 * (NMAX*max(3,NSMAX*2))
68 *
69 * RWORK (workspace) DOUBLE PRECISION array, dimension
70 * NMAX
71 *
72 * SWORK (workspace) COMPLEX array, dimension
73 * (NMAX*(NSMAX+NMAX))
74 *
75 * IWORK (workspace) INTEGER array, dimension
76 * NMAX
77 *
78 * NOUT (input) INTEGER
79 * The unit number for output.
80 *
81 * =====================================================================
82 *
83 * .. Parameters ..
84 DOUBLE PRECISION ONE, ZERO
85 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
86 INTEGER NTYPES
87 PARAMETER ( NTYPES = 11 )
88 INTEGER NTESTS
89 PARAMETER ( NTESTS = 1 )
90 * ..
91 * .. Local Scalars ..
92 LOGICAL ZEROT
93 CHARACTER DIST, TRANS, TYPE, XTYPE
94 CHARACTER*3 PATH
95 INTEGER I, IM, IMAT, INFO, IOFF, IRHS,
96 $ IZERO, KL, KU, LDA, M, MODE, N,
97 $ NERRS, NFAIL, NIMAT, NRHS, NRUN
98 DOUBLE PRECISION ANORM, CNDNUM
99 * ..
100 * .. Local Arrays ..
101 INTEGER ISEED( 4 ), ISEEDY( 4 )
102 DOUBLE PRECISION RESULT( NTESTS )
103 * ..
104 * .. Local Variables ..
105 INTEGER ITER, KASE
106 * ..
107 * .. External Subroutines ..
108 EXTERNAL ALAERH, ALAHD, ZGET08, ZLACPY, ZLARHS, ZLASET,
109 $ ZLATB4, ZLATMS
110 * ..
111 * .. Intrinsic Functions ..
112 INTRINSIC DCMPLX, DBLE, MAX, MIN, SQRT
113 * ..
114 * .. Scalars in Common ..
115 LOGICAL LERR, OK
116 CHARACTER*32 SRNAMT
117 INTEGER INFOT, NUNIT
118 * ..
119 * .. Common blocks ..
120 COMMON / INFOC / INFOT, NUNIT, OK, LERR
121 COMMON / SRNAMC / SRNAMT
122 * ..
123 * .. Data statements ..
124 DATA ISEEDY / 2006, 2007, 2008, 2009 /
125 * ..
126 * .. Executable Statements ..
127 *
128 * Initialize constants and the random number seed.
129 *
130 KASE = 0
131 PATH( 1: 1 ) = 'Zomplex precision'
132 PATH( 2: 3 ) = 'GE'
133 NRUN = 0
134 NFAIL = 0
135 NERRS = 0
136 DO 10 I = 1, 4
137 ISEED( I ) = ISEEDY( I )
138 10 CONTINUE
139 *
140 INFOT = 0
141 *
142 * Do for each value of M in MVAL
143 *
144 DO 120 IM = 1, NM
145 M = MVAL( IM )
146 LDA = MAX( 1, M )
147 *
148 N = M
149 NIMAT = NTYPES
150 IF( M.LE.0 .OR. N.LE.0 )
151 $ NIMAT = 1
152 *
153 DO 100 IMAT = 1, NIMAT
154 *
155 * Do the tests only if DOTYPE( IMAT ) is true.
156 *
157 IF( .NOT.DOTYPE( IMAT ) )
158 $ GO TO 100
159 *
160 * Skip types 5, 6, or 7 if the matrix size is too small.
161 *
162 ZEROT = IMAT.GE.5 .AND. IMAT.LE.7
163 IF( ZEROT .AND. N.LT.IMAT-4 )
164 $ GO TO 100
165 *
166 * Set up parameters with ZLATB4 and generate a test matrix
167 * with ZLATMS.
168 *
169 CALL ZLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
170 $ CNDNUM, DIST )
171 *
172 SRNAMT = 'ZLATMS'
173 CALL ZLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE,
174 $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
175 $ WORK, INFO )
176 *
177 * Check error code from ZLATMS.
178 *
179 IF( INFO.NE.0 ) THEN
180 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', M, N, -1,
181 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
182 GO TO 100
183 END IF
184 *
185 * For types 5-7, zero one or more columns of the matrix to
186 * test that INFO is returned correctly.
187 *
188 IF( ZEROT ) THEN
189 IF( IMAT.EQ.5 ) THEN
190 IZERO = 1
191 ELSE IF( IMAT.EQ.6 ) THEN
192 IZERO = MIN( M, N )
193 ELSE
194 IZERO = MIN( M, N ) / 2 + 1
195 END IF
196 IOFF = ( IZERO-1 )*LDA
197 IF( IMAT.LT.7 ) THEN
198 DO 20 I = 1, M
199 A( IOFF+I ) = ZERO
200 20 CONTINUE
201 ELSE
202 CALL ZLASET( 'Full', M, N-IZERO+1, DCMPLX(ZERO),
203 $ DCMPLX(ZERO), A( IOFF+1 ), LDA )
204 END IF
205 ELSE
206 IZERO = 0
207 END IF
208 *
209 DO 60 IRHS = 1, NNS
210 NRHS = NSVAL( IRHS )
211 XTYPE = 'N'
212 TRANS = 'N'
213 *
214 SRNAMT = 'ZLARHS'
215 CALL ZLARHS( PATH, XTYPE, ' ', TRANS, N, N, KL,
216 $ KU, NRHS, A, LDA, X, LDA, B,
217 $ LDA, ISEED, INFO )
218 *
219 SRNAMT = 'ZCGESV'
220 *
221 KASE = KASE + 1
222 *
223 CALL ZLACPY( 'Full', M, N, A, LDA, AFAC, LDA )
224 *
225 CALL ZCGESV( N, NRHS, A, LDA, IWORK, B, LDA, X, LDA,
226 $ WORK, SWORK, RWORK, ITER, INFO)
227 *
228 IF (ITER.LT.0) THEN
229 CALL ZLACPY( 'Full', M, N, AFAC, LDA, A, LDA )
230 ENDIF
231 *
232 * Check error code from ZCGESV. This should be the same as
233 * the one of DGETRF.
234 *
235 IF( INFO.NE.IZERO ) THEN
236 *
237 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
238 $ CALL ALAHD( NOUT, PATH )
239 NERRS = NERRS + 1
240 *
241 IF( INFO.NE.IZERO .AND. IZERO.NE.0 ) THEN
242 WRITE( NOUT, FMT = 9988 )'ZCGESV',INFO,
243 $ IZERO,M,IMAT
244 ELSE
245 WRITE( NOUT, FMT = 9975 )'ZCGESV',INFO,
246 $ M, IMAT
247 END IF
248 END IF
249 *
250 * Skip the remaining test if the matrix is singular.
251 *
252 IF( INFO.NE.0 )
253 $ GO TO 100
254 *
255 * Check the quality of the solution
256 *
257 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
258 *
259 CALL ZGET08( TRANS, N, N, NRHS, A, LDA, X, LDA, WORK,
260 $ LDA, RWORK, RESULT( 1 ) )
261 *
262 * Check if the test passes the tesing.
263 * Print information about the tests that did not
264 * pass the testing.
265 *
266 * If iterative refinement has been used and claimed to
267 * be successful (ITER>0), we want
268 * NORMI(B - A*X)/(NORMI(A)*NORMI(X)*EPS*SRQT(N)) < 1
269 *
270 * If double precision has been used (ITER<0), we want
271 * NORMI(B - A*X)/(NORMI(A)*NORMI(X)*EPS) < THRES
272 * (Cf. the linear solver testing routines)
273 *
274 IF ((THRESH.LE.0.0E+00)
275 $ .OR.((ITER.GE.0).AND.(N.GT.0)
276 $ .AND.(RESULT(1).GE.SQRT(DBLE(N))))
277 $ .OR.((ITER.LT.0).AND.(RESULT(1).GE.THRESH))) THEN
278 *
279 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
280 WRITE( NOUT, FMT = 8999 )'DGE'
281 WRITE( NOUT, FMT = '( '' Matrix types:'' )' )
282 WRITE( NOUT, FMT = 8979 )
283 WRITE( NOUT, FMT = '( '' Test ratios:'' )' )
284 WRITE( NOUT, FMT = 8960 )1
285 WRITE( NOUT, FMT = '( '' Messages:'' )' )
286 END IF
287 *
288 WRITE( NOUT, FMT = 9998 )TRANS, N, NRHS,
289 $ IMAT, 1, RESULT( 1 )
290 NFAIL = NFAIL + 1
291 END IF
292 NRUN = NRUN + 1
293 60 CONTINUE
294 100 CONTINUE
295 120 CONTINUE
296 *
297 * Print a summary of the results.
298 *
299 IF( NFAIL.GT.0 ) THEN
300 WRITE( NOUT, FMT = 9996 )'ZCGESV', NFAIL, NRUN
301 ELSE
302 WRITE( NOUT, FMT = 9995 )'ZCGESV', NRUN
303 END IF
304 IF( NERRS.GT.0 ) THEN
305 WRITE( NOUT, FMT = 9994 )NERRS
306 END IF
307 *
308 9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
309 $ I2, ', test(', I2, ') =', G12.5 )
310 9996 FORMAT( 1X, A6, ': ', I6, ' out of ', I6,
311 $ ' tests failed to pass the threshold' )
312 9995 FORMAT( /1X, 'All tests for ', A6,
313 $ ' routines passed the threshold (', I6, ' tests run)' )
314 9994 FORMAT( 6X, I6, ' error messages recorded' )
315 *
316 * SUBNAM, INFO, INFOE, M, IMAT
317 *
318 9988 FORMAT( ' *** ', A6, ' returned with INFO =', I5, ' instead of ',
319 $ I5, / ' ==> M =', I5, ', type ',
320 $ I2 )
321 *
322 * SUBNAM, INFO, M, IMAT
323 *
324 9975 FORMAT( ' *** Error code from ', A6, '=', I5, ' for M=', I5,
325 $ ', type ', I2 )
326 8999 FORMAT( / 1X, A3, ': General dense matrices' )
327 8979 FORMAT( 4X, '1. Diagonal', 24X, '7. Last n/2 columns zero', / 4X,
328 $ '2. Upper triangular', 16X,
329 $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4X,
330 $ '3. Lower triangular', 16X, '9. Random, CNDNUM = 0.1/EPS',
331 $ / 4X, '4. Random, CNDNUM = 2', 13X,
332 $ '10. Scaled near underflow', / 4X, '5. First column zero',
333 $ 14X, '11. Scaled near overflow', / 4X,
334 $ '6. Last column zero' )
335 8960 FORMAT( 3X, I2, ': norm_1( B - A * X ) / ',
336 $ '( norm_1(A) * norm_1(X) * EPS * SQRT(N) ) > 1 if ITERREF',
337 $ / 4x, 'or norm_1( B - A * X ) / ',
338 $ '( norm_1(A) * norm_1(X) * EPS ) > THRES if DGETRF' )
339 RETURN
340 *
341 * End of ZDRVAB
342 *
343 END
2 $ NSVAL, THRESH, NMAX, A, AFAC, B,
3 $ X, WORK, RWORK, SWORK, IWORK, NOUT )
4 IMPLICIT NONE
5 *
6 * -- LAPACK test routine (version 3.1) --
7 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
8 * June 2010
9 *
10 * .. Scalar Arguments ..
11 INTEGER NM, NMAX, NNS, NOUT
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER MVAL( * ), NSVAL( * ), IWORK( * )
17 DOUBLE PRECISION RWORK( * )
18 COMPLEX SWORK( * )
19 COMPLEX*16 A( * ), AFAC( * ), B( * ),
20 $ WORK( * ), X( * )
21 * ..
22 *
23 * Purpose
24 * =======
25 *
26 * ZDRVAB tests ZCGESV
27 *
28 * Arguments
29 * =========
30 *
31 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
32 * The matrix types to be used for testing. Matrices of type j
33 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
34 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
35 *
36 * NM (input) INTEGER
37 * The number of values of M contained in the vector MVAL.
38 *
39 * MVAL (input) INTEGER array, dimension (NM)
40 * The values of the matrix row dimension M.
41 *
42 * NNS (input) INTEGER
43 * The number of values of NRHS contained in the vector NSVAL.
44 *
45 * NSVAL (input) INTEGER array, dimension (NNS)
46 * The values of the number of right hand sides NRHS.
47 *
48 * THRESH (input) DOUBLE PRECISION
49 * The threshold value for the test ratios. A result is
50 * included in the output file if RESULT >= THRESH. To have
51 * every test ratio printed, use THRESH = 0.
52 *
53 * NMAX (input) INTEGER
54 * The maximum value permitted for M or N, used in dimensioning
55 * the work arrays.
56 *
57 * A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
58 *
59 * AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
60 *
61 * B (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
62 * where NSMAX is the largest entry in NSVAL.
63 *
64 * X (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
65 *
66 * WORK (workspace) COMPLEX*16 array, dimension
67 * (NMAX*max(3,NSMAX*2))
68 *
69 * RWORK (workspace) DOUBLE PRECISION array, dimension
70 * NMAX
71 *
72 * SWORK (workspace) COMPLEX array, dimension
73 * (NMAX*(NSMAX+NMAX))
74 *
75 * IWORK (workspace) INTEGER array, dimension
76 * NMAX
77 *
78 * NOUT (input) INTEGER
79 * The unit number for output.
80 *
81 * =====================================================================
82 *
83 * .. Parameters ..
84 DOUBLE PRECISION ONE, ZERO
85 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
86 INTEGER NTYPES
87 PARAMETER ( NTYPES = 11 )
88 INTEGER NTESTS
89 PARAMETER ( NTESTS = 1 )
90 * ..
91 * .. Local Scalars ..
92 LOGICAL ZEROT
93 CHARACTER DIST, TRANS, TYPE, XTYPE
94 CHARACTER*3 PATH
95 INTEGER I, IM, IMAT, INFO, IOFF, IRHS,
96 $ IZERO, KL, KU, LDA, M, MODE, N,
97 $ NERRS, NFAIL, NIMAT, NRHS, NRUN
98 DOUBLE PRECISION ANORM, CNDNUM
99 * ..
100 * .. Local Arrays ..
101 INTEGER ISEED( 4 ), ISEEDY( 4 )
102 DOUBLE PRECISION RESULT( NTESTS )
103 * ..
104 * .. Local Variables ..
105 INTEGER ITER, KASE
106 * ..
107 * .. External Subroutines ..
108 EXTERNAL ALAERH, ALAHD, ZGET08, ZLACPY, ZLARHS, ZLASET,
109 $ ZLATB4, ZLATMS
110 * ..
111 * .. Intrinsic Functions ..
112 INTRINSIC DCMPLX, DBLE, MAX, MIN, SQRT
113 * ..
114 * .. Scalars in Common ..
115 LOGICAL LERR, OK
116 CHARACTER*32 SRNAMT
117 INTEGER INFOT, NUNIT
118 * ..
119 * .. Common blocks ..
120 COMMON / INFOC / INFOT, NUNIT, OK, LERR
121 COMMON / SRNAMC / SRNAMT
122 * ..
123 * .. Data statements ..
124 DATA ISEEDY / 2006, 2007, 2008, 2009 /
125 * ..
126 * .. Executable Statements ..
127 *
128 * Initialize constants and the random number seed.
129 *
130 KASE = 0
131 PATH( 1: 1 ) = 'Zomplex precision'
132 PATH( 2: 3 ) = 'GE'
133 NRUN = 0
134 NFAIL = 0
135 NERRS = 0
136 DO 10 I = 1, 4
137 ISEED( I ) = ISEEDY( I )
138 10 CONTINUE
139 *
140 INFOT = 0
141 *
142 * Do for each value of M in MVAL
143 *
144 DO 120 IM = 1, NM
145 M = MVAL( IM )
146 LDA = MAX( 1, M )
147 *
148 N = M
149 NIMAT = NTYPES
150 IF( M.LE.0 .OR. N.LE.0 )
151 $ NIMAT = 1
152 *
153 DO 100 IMAT = 1, NIMAT
154 *
155 * Do the tests only if DOTYPE( IMAT ) is true.
156 *
157 IF( .NOT.DOTYPE( IMAT ) )
158 $ GO TO 100
159 *
160 * Skip types 5, 6, or 7 if the matrix size is too small.
161 *
162 ZEROT = IMAT.GE.5 .AND. IMAT.LE.7
163 IF( ZEROT .AND. N.LT.IMAT-4 )
164 $ GO TO 100
165 *
166 * Set up parameters with ZLATB4 and generate a test matrix
167 * with ZLATMS.
168 *
169 CALL ZLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
170 $ CNDNUM, DIST )
171 *
172 SRNAMT = 'ZLATMS'
173 CALL ZLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE,
174 $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
175 $ WORK, INFO )
176 *
177 * Check error code from ZLATMS.
178 *
179 IF( INFO.NE.0 ) THEN
180 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', M, N, -1,
181 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
182 GO TO 100
183 END IF
184 *
185 * For types 5-7, zero one or more columns of the matrix to
186 * test that INFO is returned correctly.
187 *
188 IF( ZEROT ) THEN
189 IF( IMAT.EQ.5 ) THEN
190 IZERO = 1
191 ELSE IF( IMAT.EQ.6 ) THEN
192 IZERO = MIN( M, N )
193 ELSE
194 IZERO = MIN( M, N ) / 2 + 1
195 END IF
196 IOFF = ( IZERO-1 )*LDA
197 IF( IMAT.LT.7 ) THEN
198 DO 20 I = 1, M
199 A( IOFF+I ) = ZERO
200 20 CONTINUE
201 ELSE
202 CALL ZLASET( 'Full', M, N-IZERO+1, DCMPLX(ZERO),
203 $ DCMPLX(ZERO), A( IOFF+1 ), LDA )
204 END IF
205 ELSE
206 IZERO = 0
207 END IF
208 *
209 DO 60 IRHS = 1, NNS
210 NRHS = NSVAL( IRHS )
211 XTYPE = 'N'
212 TRANS = 'N'
213 *
214 SRNAMT = 'ZLARHS'
215 CALL ZLARHS( PATH, XTYPE, ' ', TRANS, N, N, KL,
216 $ KU, NRHS, A, LDA, X, LDA, B,
217 $ LDA, ISEED, INFO )
218 *
219 SRNAMT = 'ZCGESV'
220 *
221 KASE = KASE + 1
222 *
223 CALL ZLACPY( 'Full', M, N, A, LDA, AFAC, LDA )
224 *
225 CALL ZCGESV( N, NRHS, A, LDA, IWORK, B, LDA, X, LDA,
226 $ WORK, SWORK, RWORK, ITER, INFO)
227 *
228 IF (ITER.LT.0) THEN
229 CALL ZLACPY( 'Full', M, N, AFAC, LDA, A, LDA )
230 ENDIF
231 *
232 * Check error code from ZCGESV. This should be the same as
233 * the one of DGETRF.
234 *
235 IF( INFO.NE.IZERO ) THEN
236 *
237 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
238 $ CALL ALAHD( NOUT, PATH )
239 NERRS = NERRS + 1
240 *
241 IF( INFO.NE.IZERO .AND. IZERO.NE.0 ) THEN
242 WRITE( NOUT, FMT = 9988 )'ZCGESV',INFO,
243 $ IZERO,M,IMAT
244 ELSE
245 WRITE( NOUT, FMT = 9975 )'ZCGESV',INFO,
246 $ M, IMAT
247 END IF
248 END IF
249 *
250 * Skip the remaining test if the matrix is singular.
251 *
252 IF( INFO.NE.0 )
253 $ GO TO 100
254 *
255 * Check the quality of the solution
256 *
257 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
258 *
259 CALL ZGET08( TRANS, N, N, NRHS, A, LDA, X, LDA, WORK,
260 $ LDA, RWORK, RESULT( 1 ) )
261 *
262 * Check if the test passes the tesing.
263 * Print information about the tests that did not
264 * pass the testing.
265 *
266 * If iterative refinement has been used and claimed to
267 * be successful (ITER>0), we want
268 * NORMI(B - A*X)/(NORMI(A)*NORMI(X)*EPS*SRQT(N)) < 1
269 *
270 * If double precision has been used (ITER<0), we want
271 * NORMI(B - A*X)/(NORMI(A)*NORMI(X)*EPS) < THRES
272 * (Cf. the linear solver testing routines)
273 *
274 IF ((THRESH.LE.0.0E+00)
275 $ .OR.((ITER.GE.0).AND.(N.GT.0)
276 $ .AND.(RESULT(1).GE.SQRT(DBLE(N))))
277 $ .OR.((ITER.LT.0).AND.(RESULT(1).GE.THRESH))) THEN
278 *
279 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
280 WRITE( NOUT, FMT = 8999 )'DGE'
281 WRITE( NOUT, FMT = '( '' Matrix types:'' )' )
282 WRITE( NOUT, FMT = 8979 )
283 WRITE( NOUT, FMT = '( '' Test ratios:'' )' )
284 WRITE( NOUT, FMT = 8960 )1
285 WRITE( NOUT, FMT = '( '' Messages:'' )' )
286 END IF
287 *
288 WRITE( NOUT, FMT = 9998 )TRANS, N, NRHS,
289 $ IMAT, 1, RESULT( 1 )
290 NFAIL = NFAIL + 1
291 END IF
292 NRUN = NRUN + 1
293 60 CONTINUE
294 100 CONTINUE
295 120 CONTINUE
296 *
297 * Print a summary of the results.
298 *
299 IF( NFAIL.GT.0 ) THEN
300 WRITE( NOUT, FMT = 9996 )'ZCGESV', NFAIL, NRUN
301 ELSE
302 WRITE( NOUT, FMT = 9995 )'ZCGESV', NRUN
303 END IF
304 IF( NERRS.GT.0 ) THEN
305 WRITE( NOUT, FMT = 9994 )NERRS
306 END IF
307 *
308 9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
309 $ I2, ', test(', I2, ') =', G12.5 )
310 9996 FORMAT( 1X, A6, ': ', I6, ' out of ', I6,
311 $ ' tests failed to pass the threshold' )
312 9995 FORMAT( /1X, 'All tests for ', A6,
313 $ ' routines passed the threshold (', I6, ' tests run)' )
314 9994 FORMAT( 6X, I6, ' error messages recorded' )
315 *
316 * SUBNAM, INFO, INFOE, M, IMAT
317 *
318 9988 FORMAT( ' *** ', A6, ' returned with INFO =', I5, ' instead of ',
319 $ I5, / ' ==> M =', I5, ', type ',
320 $ I2 )
321 *
322 * SUBNAM, INFO, M, IMAT
323 *
324 9975 FORMAT( ' *** Error code from ', A6, '=', I5, ' for M=', I5,
325 $ ', type ', I2 )
326 8999 FORMAT( / 1X, A3, ': General dense matrices' )
327 8979 FORMAT( 4X, '1. Diagonal', 24X, '7. Last n/2 columns zero', / 4X,
328 $ '2. Upper triangular', 16X,
329 $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4X,
330 $ '3. Lower triangular', 16X, '9. Random, CNDNUM = 0.1/EPS',
331 $ / 4X, '4. Random, CNDNUM = 2', 13X,
332 $ '10. Scaled near underflow', / 4X, '5. First column zero',
333 $ 14X, '11. Scaled near overflow', / 4X,
334 $ '6. Last column zero' )
335 8960 FORMAT( 3X, I2, ': norm_1( B - A * X ) / ',
336 $ '( norm_1(A) * norm_1(X) * EPS * SQRT(N) ) > 1 if ITERREF',
337 $ / 4x, 'or norm_1( B - A * X ) / ',
338 $ '( norm_1(A) * norm_1(X) * EPS ) > THRES if DGETRF' )
339 RETURN
340 *
341 * End of ZDRVAB
342 *
343 END