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