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