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