1 SUBROUTINE ZCHKPO( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
2 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
3 $ XACT, WORK, RWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER NMAX, NN, NNB, NNS, NOUT
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER NBVAL( * ), NSVAL( * ), NVAL( * )
17 DOUBLE PRECISION RWORK( * )
18 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
19 $ WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * ZCHKPO tests ZPOTRF, -TRI, -TRS, -RFS, and -CON
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 * NN (input) INTEGER
36 * The number of values of N contained in the vector NVAL.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix dimension N.
40 *
41 * NNB (input) INTEGER
42 * The number of values of NB contained in the vector NBVAL.
43 *
44 * NBVAL (input) INTEGER array, dimension (NBVAL)
45 * The values of the blocksize NB.
46 *
47 * NNS (input) INTEGER
48 * The number of values of NRHS contained in the vector NSVAL.
49 *
50 * NSVAL (input) INTEGER array, dimension (NNS)
51 * The values of the number of right hand sides NRHS.
52 *
53 * THRESH (input) DOUBLE PRECISION
54 * The threshold value for the test ratios. A result is
55 * included in the output file if RESULT >= THRESH. To have
56 * every test ratio printed, use THRESH = 0.
57 *
58 * TSTERR (input) LOGICAL
59 * Flag that indicates whether error exits are to be tested.
60 *
61 * NMAX (input) INTEGER
62 * The maximum value permitted for N, used in dimensioning the
63 * work arrays.
64 *
65 * A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
66 *
67 * AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
68 *
69 * AINV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
70 *
71 * B (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
72 * where NSMAX is the largest entry in NSVAL.
73 *
74 * X (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
75 *
76 * XACT (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
77 *
78 * WORK (workspace) COMPLEX*16 array, dimension
79 * (NMAX*max(3,NSMAX))
80 *
81 * RWORK (workspace) DOUBLE PRECISION array, dimension
82 * (NMAX+2*NSMAX)
83 *
84 * NOUT (input) INTEGER
85 * The unit number for output.
86 *
87 * =====================================================================
88 *
89 * .. Parameters ..
90 COMPLEX*16 CZERO
91 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) )
92 INTEGER NTYPES
93 PARAMETER ( NTYPES = 9 )
94 INTEGER NTESTS
95 PARAMETER ( NTESTS = 8 )
96 * ..
97 * .. Local Scalars ..
98 LOGICAL ZEROT
99 CHARACTER DIST, TYPE, UPLO, XTYPE
100 CHARACTER*3 PATH
101 INTEGER I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO,
102 $ IZERO, K, KL, KU, LDA, MODE, N, NB, NERRS,
103 $ NFAIL, NIMAT, NRHS, NRUN
104 DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC
105 * ..
106 * .. Local Arrays ..
107 CHARACTER UPLOS( 2 )
108 INTEGER ISEED( 4 ), ISEEDY( 4 )
109 DOUBLE PRECISION RESULT( NTESTS )
110 * ..
111 * .. External Functions ..
112 DOUBLE PRECISION DGET06, ZLANHE
113 EXTERNAL DGET06, ZLANHE
114 * ..
115 * .. External Subroutines ..
116 EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRPO, ZGET04,
117 $ ZLACPY, ZLAIPD, ZLARHS, ZLATB4, ZLATMS, ZPOCON,
118 $ ZPORFS, ZPOT01, ZPOT02, ZPOT03, ZPOT05, ZPOTRF,
119 $ ZPOTRI, ZPOTRS
120 * ..
121 * .. Scalars in Common ..
122 LOGICAL LERR, OK
123 CHARACTER*32 SRNAMT
124 INTEGER INFOT, NUNIT
125 * ..
126 * .. Common blocks ..
127 COMMON / INFOC / INFOT, NUNIT, OK, LERR
128 COMMON / SRNAMC / SRNAMT
129 * ..
130 * .. Intrinsic Functions ..
131 INTRINSIC MAX
132 * ..
133 * .. Data statements ..
134 DATA ISEEDY / 1988, 1989, 1990, 1991 /
135 DATA UPLOS / 'U', 'L' /
136 * ..
137 * .. Executable Statements ..
138 *
139 * Initialize constants and the random number seed.
140 *
141 PATH( 1: 1 ) = 'Zomplex precision'
142 PATH( 2: 3 ) = 'PO'
143 NRUN = 0
144 NFAIL = 0
145 NERRS = 0
146 DO 10 I = 1, 4
147 ISEED( I ) = ISEEDY( I )
148 10 CONTINUE
149 *
150 * Test the error exits
151 *
152 IF( TSTERR )
153 $ CALL ZERRPO( PATH, NOUT )
154 INFOT = 0
155 *
156 * Do for each value of N in NVAL
157 *
158 DO 120 IN = 1, NN
159 N = NVAL( IN )
160 LDA = MAX( N, 1 )
161 XTYPE = 'N'
162 NIMAT = NTYPES
163 IF( N.LE.0 )
164 $ NIMAT = 1
165 *
166 IZERO = 0
167 DO 110 IMAT = 1, NIMAT
168 *
169 * Do the tests only if DOTYPE( IMAT ) is true.
170 *
171 IF( .NOT.DOTYPE( IMAT ) )
172 $ GO TO 110
173 *
174 * Skip types 3, 4, or 5 if the matrix size is too small.
175 *
176 ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
177 IF( ZEROT .AND. N.LT.IMAT-2 )
178 $ GO TO 110
179 *
180 * Do first for UPLO = 'U', then for UPLO = 'L'
181 *
182 DO 100 IUPLO = 1, 2
183 UPLO = UPLOS( IUPLO )
184 *
185 * Set up parameters with ZLATB4 and generate a test matrix
186 * with ZLATMS.
187 *
188 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
189 $ CNDNUM, DIST )
190 *
191 SRNAMT = 'ZLATMS'
192 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
193 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
194 $ INFO )
195 *
196 * Check error code from ZLATMS.
197 *
198 IF( INFO.NE.0 ) THEN
199 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
200 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
201 GO TO 100
202 END IF
203 *
204 * For types 3-5, zero one row and column of the matrix to
205 * test that INFO is returned correctly.
206 *
207 IF( ZEROT ) THEN
208 IF( IMAT.EQ.3 ) THEN
209 IZERO = 1
210 ELSE IF( IMAT.EQ.4 ) THEN
211 IZERO = N
212 ELSE
213 IZERO = N / 2 + 1
214 END IF
215 IOFF = ( IZERO-1 )*LDA
216 *
217 * Set row and column IZERO of A to 0.
218 *
219 IF( IUPLO.EQ.1 ) THEN
220 DO 20 I = 1, IZERO - 1
221 A( IOFF+I ) = CZERO
222 20 CONTINUE
223 IOFF = IOFF + IZERO
224 DO 30 I = IZERO, N
225 A( IOFF ) = CZERO
226 IOFF = IOFF + LDA
227 30 CONTINUE
228 ELSE
229 IOFF = IZERO
230 DO 40 I = 1, IZERO - 1
231 A( IOFF ) = CZERO
232 IOFF = IOFF + LDA
233 40 CONTINUE
234 IOFF = IOFF - IZERO
235 DO 50 I = IZERO, N
236 A( IOFF+I ) = CZERO
237 50 CONTINUE
238 END IF
239 ELSE
240 IZERO = 0
241 END IF
242 *
243 * Set the imaginary part of the diagonals.
244 *
245 CALL ZLAIPD( N, A, LDA+1, 0 )
246 *
247 * Do for each value of NB in NBVAL
248 *
249 DO 90 INB = 1, NNB
250 NB = NBVAL( INB )
251 CALL XLAENV( 1, NB )
252 *
253 * Compute the L*L' or U'*U factorization of the matrix.
254 *
255 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
256 SRNAMT = 'ZPOTRF'
257 CALL ZPOTRF( UPLO, N, AFAC, LDA, INFO )
258 *
259 * Check error code from ZPOTRF.
260 *
261 IF( INFO.NE.IZERO ) THEN
262 CALL ALAERH( PATH, 'ZPOTRF', INFO, IZERO, UPLO, N,
263 $ N, -1, -1, NB, IMAT, NFAIL, NERRS,
264 $ NOUT )
265 GO TO 90
266 END IF
267 *
268 * Skip the tests if INFO is not 0.
269 *
270 IF( INFO.NE.0 )
271 $ GO TO 90
272 *
273 *+ TEST 1
274 * Reconstruct matrix from factors and compute residual.
275 *
276 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
277 CALL ZPOT01( UPLO, N, A, LDA, AINV, LDA, RWORK,
278 $ RESULT( 1 ) )
279 *
280 *+ TEST 2
281 * Form the inverse and compute the residual.
282 *
283 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
284 SRNAMT = 'ZPOTRI'
285 CALL ZPOTRI( UPLO, N, AINV, LDA, INFO )
286 *
287 * Check error code from ZPOTRI.
288 *
289 IF( INFO.NE.0 )
290 $ CALL ALAERH( PATH, 'ZPOTRI', INFO, 0, UPLO, N, N,
291 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
292 *
293 CALL ZPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
294 $ RWORK, RCONDC, RESULT( 2 ) )
295 *
296 * Print information about the tests that did not pass
297 * the threshold.
298 *
299 DO 60 K = 1, 2
300 IF( RESULT( K ).GE.THRESH ) THEN
301 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
302 $ CALL ALAHD( NOUT, PATH )
303 WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
304 $ RESULT( K )
305 NFAIL = NFAIL + 1
306 END IF
307 60 CONTINUE
308 NRUN = NRUN + 2
309 *
310 * Skip the rest of the tests unless this is the first
311 * blocksize.
312 *
313 IF( INB.NE.1 )
314 $ GO TO 90
315 *
316 DO 80 IRHS = 1, NNS
317 NRHS = NSVAL( IRHS )
318 *
319 *+ TEST 3
320 * Solve and compute residual for A * X = B .
321 *
322 SRNAMT = 'ZLARHS'
323 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
324 $ NRHS, A, LDA, XACT, LDA, B, LDA,
325 $ ISEED, INFO )
326 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
327 *
328 SRNAMT = 'ZPOTRS'
329 CALL ZPOTRS( UPLO, N, NRHS, AFAC, LDA, X, LDA,
330 $ INFO )
331 *
332 * Check error code from ZPOTRS.
333 *
334 IF( INFO.NE.0 )
335 $ CALL ALAERH( PATH, 'ZPOTRS', INFO, 0, UPLO, N,
336 $ N, -1, -1, NRHS, IMAT, NFAIL,
337 $ NERRS, NOUT )
338 *
339 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
340 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
341 $ LDA, RWORK, RESULT( 3 ) )
342 *
343 *+ TEST 4
344 * Check solution from generated exact solution.
345 *
346 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
347 $ RESULT( 4 ) )
348 *
349 *+ TESTS 5, 6, and 7
350 * Use iterative refinement to improve the solution.
351 *
352 SRNAMT = 'ZPORFS'
353 CALL ZPORFS( UPLO, N, NRHS, A, LDA, AFAC, LDA, B,
354 $ LDA, X, LDA, RWORK, RWORK( NRHS+1 ),
355 $ WORK, RWORK( 2*NRHS+1 ), INFO )
356 *
357 * Check error code from ZPORFS.
358 *
359 IF( INFO.NE.0 )
360 $ CALL ALAERH( PATH, 'ZPORFS', INFO, 0, UPLO, N,
361 $ N, -1, -1, NRHS, IMAT, NFAIL,
362 $ NERRS, NOUT )
363 *
364 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
365 $ RESULT( 5 ) )
366 CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
367 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
368 $ RESULT( 6 ) )
369 *
370 * Print information about the tests that did not pass
371 * the threshold.
372 *
373 DO 70 K = 3, 7
374 IF( RESULT( K ).GE.THRESH ) THEN
375 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
376 $ CALL ALAHD( NOUT, PATH )
377 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
378 $ IMAT, K, RESULT( K )
379 NFAIL = NFAIL + 1
380 END IF
381 70 CONTINUE
382 NRUN = NRUN + 5
383 80 CONTINUE
384 *
385 *+ TEST 8
386 * Get an estimate of RCOND = 1/CNDNUM.
387 *
388 ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
389 SRNAMT = 'ZPOCON'
390 CALL ZPOCON( UPLO, N, AFAC, LDA, ANORM, RCOND, WORK,
391 $ RWORK, INFO )
392 *
393 * Check error code from ZPOCON.
394 *
395 IF( INFO.NE.0 )
396 $ CALL ALAERH( PATH, 'ZPOCON', INFO, 0, UPLO, N, N,
397 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
398 *
399 RESULT( 8 ) = DGET06( RCOND, RCONDC )
400 *
401 * Print the test ratio if it is .GE. THRESH.
402 *
403 IF( RESULT( 8 ).GE.THRESH ) THEN
404 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
405 $ CALL ALAHD( NOUT, PATH )
406 WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 8,
407 $ RESULT( 8 )
408 NFAIL = NFAIL + 1
409 END IF
410 NRUN = NRUN + 1
411 90 CONTINUE
412 100 CONTINUE
413 110 CONTINUE
414 120 CONTINUE
415 *
416 * Print a summary of the results.
417 *
418 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
419 *
420 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
421 $ I2, ', test ', I2, ', ratio =', G12.5 )
422 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
423 $ I2, ', test(', I2, ') =', G12.5 )
424 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
425 $ ', test(', I2, ') =', G12.5 )
426 RETURN
427 *
428 * End of ZCHKPO
429 *
430 END
2 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
3 $ XACT, WORK, RWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER NMAX, NN, NNB, NNS, NOUT
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER NBVAL( * ), NSVAL( * ), NVAL( * )
17 DOUBLE PRECISION RWORK( * )
18 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
19 $ WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * ZCHKPO tests ZPOTRF, -TRI, -TRS, -RFS, and -CON
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 * NN (input) INTEGER
36 * The number of values of N contained in the vector NVAL.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix dimension N.
40 *
41 * NNB (input) INTEGER
42 * The number of values of NB contained in the vector NBVAL.
43 *
44 * NBVAL (input) INTEGER array, dimension (NBVAL)
45 * The values of the blocksize NB.
46 *
47 * NNS (input) INTEGER
48 * The number of values of NRHS contained in the vector NSVAL.
49 *
50 * NSVAL (input) INTEGER array, dimension (NNS)
51 * The values of the number of right hand sides NRHS.
52 *
53 * THRESH (input) DOUBLE PRECISION
54 * The threshold value for the test ratios. A result is
55 * included in the output file if RESULT >= THRESH. To have
56 * every test ratio printed, use THRESH = 0.
57 *
58 * TSTERR (input) LOGICAL
59 * Flag that indicates whether error exits are to be tested.
60 *
61 * NMAX (input) INTEGER
62 * The maximum value permitted for N, used in dimensioning the
63 * work arrays.
64 *
65 * A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
66 *
67 * AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
68 *
69 * AINV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
70 *
71 * B (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
72 * where NSMAX is the largest entry in NSVAL.
73 *
74 * X (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
75 *
76 * XACT (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX)
77 *
78 * WORK (workspace) COMPLEX*16 array, dimension
79 * (NMAX*max(3,NSMAX))
80 *
81 * RWORK (workspace) DOUBLE PRECISION array, dimension
82 * (NMAX+2*NSMAX)
83 *
84 * NOUT (input) INTEGER
85 * The unit number for output.
86 *
87 * =====================================================================
88 *
89 * .. Parameters ..
90 COMPLEX*16 CZERO
91 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) )
92 INTEGER NTYPES
93 PARAMETER ( NTYPES = 9 )
94 INTEGER NTESTS
95 PARAMETER ( NTESTS = 8 )
96 * ..
97 * .. Local Scalars ..
98 LOGICAL ZEROT
99 CHARACTER DIST, TYPE, UPLO, XTYPE
100 CHARACTER*3 PATH
101 INTEGER I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO,
102 $ IZERO, K, KL, KU, LDA, MODE, N, NB, NERRS,
103 $ NFAIL, NIMAT, NRHS, NRUN
104 DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC
105 * ..
106 * .. Local Arrays ..
107 CHARACTER UPLOS( 2 )
108 INTEGER ISEED( 4 ), ISEEDY( 4 )
109 DOUBLE PRECISION RESULT( NTESTS )
110 * ..
111 * .. External Functions ..
112 DOUBLE PRECISION DGET06, ZLANHE
113 EXTERNAL DGET06, ZLANHE
114 * ..
115 * .. External Subroutines ..
116 EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRPO, ZGET04,
117 $ ZLACPY, ZLAIPD, ZLARHS, ZLATB4, ZLATMS, ZPOCON,
118 $ ZPORFS, ZPOT01, ZPOT02, ZPOT03, ZPOT05, ZPOTRF,
119 $ ZPOTRI, ZPOTRS
120 * ..
121 * .. Scalars in Common ..
122 LOGICAL LERR, OK
123 CHARACTER*32 SRNAMT
124 INTEGER INFOT, NUNIT
125 * ..
126 * .. Common blocks ..
127 COMMON / INFOC / INFOT, NUNIT, OK, LERR
128 COMMON / SRNAMC / SRNAMT
129 * ..
130 * .. Intrinsic Functions ..
131 INTRINSIC MAX
132 * ..
133 * .. Data statements ..
134 DATA ISEEDY / 1988, 1989, 1990, 1991 /
135 DATA UPLOS / 'U', 'L' /
136 * ..
137 * .. Executable Statements ..
138 *
139 * Initialize constants and the random number seed.
140 *
141 PATH( 1: 1 ) = 'Zomplex precision'
142 PATH( 2: 3 ) = 'PO'
143 NRUN = 0
144 NFAIL = 0
145 NERRS = 0
146 DO 10 I = 1, 4
147 ISEED( I ) = ISEEDY( I )
148 10 CONTINUE
149 *
150 * Test the error exits
151 *
152 IF( TSTERR )
153 $ CALL ZERRPO( PATH, NOUT )
154 INFOT = 0
155 *
156 * Do for each value of N in NVAL
157 *
158 DO 120 IN = 1, NN
159 N = NVAL( IN )
160 LDA = MAX( N, 1 )
161 XTYPE = 'N'
162 NIMAT = NTYPES
163 IF( N.LE.0 )
164 $ NIMAT = 1
165 *
166 IZERO = 0
167 DO 110 IMAT = 1, NIMAT
168 *
169 * Do the tests only if DOTYPE( IMAT ) is true.
170 *
171 IF( .NOT.DOTYPE( IMAT ) )
172 $ GO TO 110
173 *
174 * Skip types 3, 4, or 5 if the matrix size is too small.
175 *
176 ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
177 IF( ZEROT .AND. N.LT.IMAT-2 )
178 $ GO TO 110
179 *
180 * Do first for UPLO = 'U', then for UPLO = 'L'
181 *
182 DO 100 IUPLO = 1, 2
183 UPLO = UPLOS( IUPLO )
184 *
185 * Set up parameters with ZLATB4 and generate a test matrix
186 * with ZLATMS.
187 *
188 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
189 $ CNDNUM, DIST )
190 *
191 SRNAMT = 'ZLATMS'
192 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
193 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
194 $ INFO )
195 *
196 * Check error code from ZLATMS.
197 *
198 IF( INFO.NE.0 ) THEN
199 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
200 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
201 GO TO 100
202 END IF
203 *
204 * For types 3-5, zero one row and column of the matrix to
205 * test that INFO is returned correctly.
206 *
207 IF( ZEROT ) THEN
208 IF( IMAT.EQ.3 ) THEN
209 IZERO = 1
210 ELSE IF( IMAT.EQ.4 ) THEN
211 IZERO = N
212 ELSE
213 IZERO = N / 2 + 1
214 END IF
215 IOFF = ( IZERO-1 )*LDA
216 *
217 * Set row and column IZERO of A to 0.
218 *
219 IF( IUPLO.EQ.1 ) THEN
220 DO 20 I = 1, IZERO - 1
221 A( IOFF+I ) = CZERO
222 20 CONTINUE
223 IOFF = IOFF + IZERO
224 DO 30 I = IZERO, N
225 A( IOFF ) = CZERO
226 IOFF = IOFF + LDA
227 30 CONTINUE
228 ELSE
229 IOFF = IZERO
230 DO 40 I = 1, IZERO - 1
231 A( IOFF ) = CZERO
232 IOFF = IOFF + LDA
233 40 CONTINUE
234 IOFF = IOFF - IZERO
235 DO 50 I = IZERO, N
236 A( IOFF+I ) = CZERO
237 50 CONTINUE
238 END IF
239 ELSE
240 IZERO = 0
241 END IF
242 *
243 * Set the imaginary part of the diagonals.
244 *
245 CALL ZLAIPD( N, A, LDA+1, 0 )
246 *
247 * Do for each value of NB in NBVAL
248 *
249 DO 90 INB = 1, NNB
250 NB = NBVAL( INB )
251 CALL XLAENV( 1, NB )
252 *
253 * Compute the L*L' or U'*U factorization of the matrix.
254 *
255 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
256 SRNAMT = 'ZPOTRF'
257 CALL ZPOTRF( UPLO, N, AFAC, LDA, INFO )
258 *
259 * Check error code from ZPOTRF.
260 *
261 IF( INFO.NE.IZERO ) THEN
262 CALL ALAERH( PATH, 'ZPOTRF', INFO, IZERO, UPLO, N,
263 $ N, -1, -1, NB, IMAT, NFAIL, NERRS,
264 $ NOUT )
265 GO TO 90
266 END IF
267 *
268 * Skip the tests if INFO is not 0.
269 *
270 IF( INFO.NE.0 )
271 $ GO TO 90
272 *
273 *+ TEST 1
274 * Reconstruct matrix from factors and compute residual.
275 *
276 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
277 CALL ZPOT01( UPLO, N, A, LDA, AINV, LDA, RWORK,
278 $ RESULT( 1 ) )
279 *
280 *+ TEST 2
281 * Form the inverse and compute the residual.
282 *
283 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
284 SRNAMT = 'ZPOTRI'
285 CALL ZPOTRI( UPLO, N, AINV, LDA, INFO )
286 *
287 * Check error code from ZPOTRI.
288 *
289 IF( INFO.NE.0 )
290 $ CALL ALAERH( PATH, 'ZPOTRI', INFO, 0, UPLO, N, N,
291 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
292 *
293 CALL ZPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
294 $ RWORK, RCONDC, RESULT( 2 ) )
295 *
296 * Print information about the tests that did not pass
297 * the threshold.
298 *
299 DO 60 K = 1, 2
300 IF( RESULT( K ).GE.THRESH ) THEN
301 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
302 $ CALL ALAHD( NOUT, PATH )
303 WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
304 $ RESULT( K )
305 NFAIL = NFAIL + 1
306 END IF
307 60 CONTINUE
308 NRUN = NRUN + 2
309 *
310 * Skip the rest of the tests unless this is the first
311 * blocksize.
312 *
313 IF( INB.NE.1 )
314 $ GO TO 90
315 *
316 DO 80 IRHS = 1, NNS
317 NRHS = NSVAL( IRHS )
318 *
319 *+ TEST 3
320 * Solve and compute residual for A * X = B .
321 *
322 SRNAMT = 'ZLARHS'
323 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
324 $ NRHS, A, LDA, XACT, LDA, B, LDA,
325 $ ISEED, INFO )
326 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
327 *
328 SRNAMT = 'ZPOTRS'
329 CALL ZPOTRS( UPLO, N, NRHS, AFAC, LDA, X, LDA,
330 $ INFO )
331 *
332 * Check error code from ZPOTRS.
333 *
334 IF( INFO.NE.0 )
335 $ CALL ALAERH( PATH, 'ZPOTRS', INFO, 0, UPLO, N,
336 $ N, -1, -1, NRHS, IMAT, NFAIL,
337 $ NERRS, NOUT )
338 *
339 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
340 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
341 $ LDA, RWORK, RESULT( 3 ) )
342 *
343 *+ TEST 4
344 * Check solution from generated exact solution.
345 *
346 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
347 $ RESULT( 4 ) )
348 *
349 *+ TESTS 5, 6, and 7
350 * Use iterative refinement to improve the solution.
351 *
352 SRNAMT = 'ZPORFS'
353 CALL ZPORFS( UPLO, N, NRHS, A, LDA, AFAC, LDA, B,
354 $ LDA, X, LDA, RWORK, RWORK( NRHS+1 ),
355 $ WORK, RWORK( 2*NRHS+1 ), INFO )
356 *
357 * Check error code from ZPORFS.
358 *
359 IF( INFO.NE.0 )
360 $ CALL ALAERH( PATH, 'ZPORFS', INFO, 0, UPLO, N,
361 $ N, -1, -1, NRHS, IMAT, NFAIL,
362 $ NERRS, NOUT )
363 *
364 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
365 $ RESULT( 5 ) )
366 CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
367 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
368 $ RESULT( 6 ) )
369 *
370 * Print information about the tests that did not pass
371 * the threshold.
372 *
373 DO 70 K = 3, 7
374 IF( RESULT( K ).GE.THRESH ) THEN
375 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
376 $ CALL ALAHD( NOUT, PATH )
377 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
378 $ IMAT, K, RESULT( K )
379 NFAIL = NFAIL + 1
380 END IF
381 70 CONTINUE
382 NRUN = NRUN + 5
383 80 CONTINUE
384 *
385 *+ TEST 8
386 * Get an estimate of RCOND = 1/CNDNUM.
387 *
388 ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
389 SRNAMT = 'ZPOCON'
390 CALL ZPOCON( UPLO, N, AFAC, LDA, ANORM, RCOND, WORK,
391 $ RWORK, INFO )
392 *
393 * Check error code from ZPOCON.
394 *
395 IF( INFO.NE.0 )
396 $ CALL ALAERH( PATH, 'ZPOCON', INFO, 0, UPLO, N, N,
397 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
398 *
399 RESULT( 8 ) = DGET06( RCOND, RCONDC )
400 *
401 * Print the test ratio if it is .GE. THRESH.
402 *
403 IF( RESULT( 8 ).GE.THRESH ) THEN
404 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
405 $ CALL ALAHD( NOUT, PATH )
406 WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 8,
407 $ RESULT( 8 )
408 NFAIL = NFAIL + 1
409 END IF
410 NRUN = NRUN + 1
411 90 CONTINUE
412 100 CONTINUE
413 110 CONTINUE
414 120 CONTINUE
415 *
416 * Print a summary of the results.
417 *
418 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
419 *
420 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
421 $ I2, ', test ', I2, ', ratio =', G12.5 )
422 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
423 $ I2, ', test(', I2, ') =', G12.5 )
424 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
425 $ ', test(', I2, ') =', G12.5 )
426 RETURN
427 *
428 * End of ZCHKPO
429 *
430 END