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