1 SUBROUTINE SDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA,
2 $ AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK,
3 $ RWORK, IWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.2.2) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * April 2009
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER LA, LAFB, NN, NOUT, NRHS
12 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NVAL( * )
17 REAL A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ),
18 $ RWORK( * ), S( * ), WORK( * ), X( * ),
19 $ XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * SDRVGB tests the driver routines SGBSV, -SVX, and -SVXX.
26 *
27 * Note that this file is used only when the XBLAS are available,
28 * otherwise sdrvgb.f defines this subroutine.
29 *
30 * Arguments
31 * =========
32 *
33 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
34 * The matrix types to be used for testing. Matrices of type j
35 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
36 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
37 *
38 * NN (input) INTEGER
39 * The number of values of N contained in the vector NVAL.
40 *
41 * NVAL (input) INTEGER array, dimension (NN)
42 * The values of the matrix column dimension N.
43 *
44 * NRHS (input) INTEGER
45 * The number of right hand side vectors to be generated for
46 * each linear system.
47 *
48 * THRESH (input) REAL
49 * The threshold value for the test ratios. A result is
50 * included in the output file if RESULT >= THRESH. To have
51 * every test ratio printed, use THRESH = 0.
52 *
53 * TSTERR (input) LOGICAL
54 * Flag that indicates whether error exits are to be tested.
55 *
56 * A (workspace) REAL array, dimension (LA)
57 *
58 * LA (input) INTEGER
59 * The length of the array A. LA >= (2*NMAX-1)*NMAX
60 * where NMAX is the largest entry in NVAL.
61 *
62 * AFB (workspace) REAL array, dimension (LAFB)
63 *
64 * LAFB (input) INTEGER
65 * The length of the array AFB. LAFB >= (3*NMAX-2)*NMAX
66 * where NMAX is the largest entry in NVAL.
67 *
68 * ASAV (workspace) REAL array, dimension (LA)
69 *
70 * B (workspace) REAL array, dimension (NMAX*NRHS)
71 *
72 * BSAV (workspace) REAL array, dimension (NMAX*NRHS)
73 *
74 * X (workspace) REAL array, dimension (NMAX*NRHS)
75 *
76 * XACT (workspace) REAL array, dimension (NMAX*NRHS)
77 *
78 * S (workspace) REAL array, dimension (2*NMAX)
79 *
80 * WORK (workspace) REAL array, dimension
81 * (NMAX*max(3,NRHS,NMAX))
82 *
83 * RWORK (workspace) REAL array, dimension
84 * (max(NMAX,2*NRHS))
85 *
86 * IWORK (workspace) INTEGER array, dimension (2*NMAX)
87 *
88 * NOUT (input) INTEGER
89 * The unit number for output.
90 *
91 * =====================================================================
92 *
93 * .. Parameters ..
94 REAL ONE, ZERO
95 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
96 INTEGER NTYPES
97 PARAMETER ( NTYPES = 8 )
98 INTEGER NTESTS
99 PARAMETER ( NTESTS = 7 )
100 INTEGER NTRAN
101 PARAMETER ( NTRAN = 3 )
102 * ..
103 * .. Local Scalars ..
104 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
105 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE
106 CHARACTER*3 PATH
107 INTEGER I, I1, I2, IEQUED, IFACT, IKL, IKU, IMAT, IN,
108 $ INFO, IOFF, ITRAN, IZERO, J, K, K1, KL, KU,
109 $ LDA, LDAFB, LDB, MODE, N, NB, NBMIN, NERRS,
110 $ NFACT, NFAIL, NIMAT, NKL, NKU, NRUN, NT,
111 $ N_ERR_BNDS
112 REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, ANRMPV,
113 $ CNDNUM, COLCND, RCOND, RCONDC, RCONDI, RCONDO,
114 $ ROLDC, ROLDI, ROLDO, ROWCND, RPVGRW,
115 $ RPVGRW_SVXX
116 * ..
117 * .. Local Arrays ..
118 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
119 INTEGER ISEED( 4 ), ISEEDY( 4 )
120 REAL RESULT( NTESTS ), BERR( NRHS ),
121 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
122 * ..
123 * .. External Functions ..
124 LOGICAL LSAME
125 REAL SGET06, SLAMCH, SLANGB, SLANGE, SLANTB,
126 $ SLA_GBRPVGRW
127 EXTERNAL LSAME, SGET06, SLAMCH, SLANGB, SLANGE, SLANTB,
128 $ SLA_GBRPVGRW
129 * ..
130 * .. External Subroutines ..
131 EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGBEQU, SGBSV,
132 $ SGBSVX, SGBT01, SGBT02, SGBT05, SGBTRF, SGBTRS,
133 $ SGET04, SLACPY, SLAQGB, SLARHS, SLASET, SLATB4,
134 $ SLATMS, XLAENV, SGBSVXX
135 * ..
136 * .. Intrinsic Functions ..
137 INTRINSIC ABS, MAX, MIN
138 * ..
139 * .. Scalars in Common ..
140 LOGICAL LERR, OK
141 CHARACTER*32 SRNAMT
142 INTEGER INFOT, NUNIT
143 * ..
144 * .. Common blocks ..
145 COMMON / INFOC / INFOT, NUNIT, OK, LERR
146 COMMON / SRNAMC / SRNAMT
147 * ..
148 * .. Data statements ..
149 DATA ISEEDY / 1988, 1989, 1990, 1991 /
150 DATA TRANSS / 'N', 'T', 'C' /
151 DATA FACTS / 'F', 'N', 'E' /
152 DATA EQUEDS / 'N', 'R', 'C', 'B' /
153 * ..
154 * .. Executable Statements ..
155 *
156 * Initialize constants and the random number seed.
157 *
158 PATH( 1: 1 ) = 'Single precision'
159 PATH( 2: 3 ) = 'GB'
160 NRUN = 0
161 NFAIL = 0
162 NERRS = 0
163 DO 10 I = 1, 4
164 ISEED( I ) = ISEEDY( I )
165 10 CONTINUE
166 *
167 * Test the error exits
168 *
169 IF( TSTERR )
170 $ CALL SERRVX( PATH, NOUT )
171 INFOT = 0
172 *
173 * Set the block size and minimum block size for testing.
174 *
175 NB = 1
176 NBMIN = 2
177 CALL XLAENV( 1, NB )
178 CALL XLAENV( 2, NBMIN )
179 *
180 * Do for each value of N in NVAL
181 *
182 DO 150 IN = 1, NN
183 N = NVAL( IN )
184 LDB = MAX( N, 1 )
185 XTYPE = 'N'
186 *
187 * Set limits on the number of loop iterations.
188 *
189 NKL = MAX( 1, MIN( N, 4 ) )
190 IF( N.EQ.0 )
191 $ NKL = 1
192 NKU = NKL
193 NIMAT = NTYPES
194 IF( N.LE.0 )
195 $ NIMAT = 1
196 *
197 DO 140 IKL = 1, NKL
198 *
199 * Do for KL = 0, N-1, (3N-1)/4, and (N+1)/4. This order makes
200 * it easier to skip redundant values for small values of N.
201 *
202 IF( IKL.EQ.1 ) THEN
203 KL = 0
204 ELSE IF( IKL.EQ.2 ) THEN
205 KL = MAX( N-1, 0 )
206 ELSE IF( IKL.EQ.3 ) THEN
207 KL = ( 3*N-1 ) / 4
208 ELSE IF( IKL.EQ.4 ) THEN
209 KL = ( N+1 ) / 4
210 END IF
211 DO 130 IKU = 1, NKU
212 *
213 * Do for KU = 0, N-1, (3N-1)/4, and (N+1)/4. This order
214 * makes it easier to skip redundant values for small
215 * values of N.
216 *
217 IF( IKU.EQ.1 ) THEN
218 KU = 0
219 ELSE IF( IKU.EQ.2 ) THEN
220 KU = MAX( N-1, 0 )
221 ELSE IF( IKU.EQ.3 ) THEN
222 KU = ( 3*N-1 ) / 4
223 ELSE IF( IKU.EQ.4 ) THEN
224 KU = ( N+1 ) / 4
225 END IF
226 *
227 * Check that A and AFB are big enough to generate this
228 * matrix.
229 *
230 LDA = KL + KU + 1
231 LDAFB = 2*KL + KU + 1
232 IF( LDA*N.GT.LA .OR. LDAFB*N.GT.LAFB ) THEN
233 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
234 $ CALL ALADHD( NOUT, PATH )
235 IF( LDA*N.GT.LA ) THEN
236 WRITE( NOUT, FMT = 9999 )LA, N, KL, KU,
237 $ N*( KL+KU+1 )
238 NERRS = NERRS + 1
239 END IF
240 IF( LDAFB*N.GT.LAFB ) THEN
241 WRITE( NOUT, FMT = 9998 )LAFB, N, KL, KU,
242 $ N*( 2*KL+KU+1 )
243 NERRS = NERRS + 1
244 END IF
245 GO TO 130
246 END IF
247 *
248 DO 120 IMAT = 1, NIMAT
249 *
250 * Do the tests only if DOTYPE( IMAT ) is true.
251 *
252 IF( .NOT.DOTYPE( IMAT ) )
253 $ GO TO 120
254 *
255 * Skip types 2, 3, or 4 if the matrix is too small.
256 *
257 ZEROT = IMAT.GE.2 .AND. IMAT.LE.4
258 IF( ZEROT .AND. N.LT.IMAT-1 )
259 $ GO TO 120
260 *
261 * Set up parameters with SLATB4 and generate a
262 * test matrix with SLATMS.
263 *
264 CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
265 $ MODE, CNDNUM, DIST )
266 RCONDC = ONE / CNDNUM
267 *
268 SRNAMT = 'SLATMS'
269 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
270 $ CNDNUM, ANORM, KL, KU, 'Z', A, LDA, WORK,
271 $ INFO )
272 *
273 * Check the error code from SLATMS.
274 *
275 IF( INFO.NE.0 ) THEN
276 CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', N, N,
277 $ KL, KU, -1, IMAT, NFAIL, NERRS, NOUT )
278 GO TO 120
279 END IF
280 *
281 * For types 2, 3, and 4, zero one or more columns of
282 * the matrix to test that INFO is returned correctly.
283 *
284 IZERO = 0
285 IF( ZEROT ) THEN
286 IF( IMAT.EQ.2 ) THEN
287 IZERO = 1
288 ELSE IF( IMAT.EQ.3 ) THEN
289 IZERO = N
290 ELSE
291 IZERO = N / 2 + 1
292 END IF
293 IOFF = ( IZERO-1 )*LDA
294 IF( IMAT.LT.4 ) THEN
295 I1 = MAX( 1, KU+2-IZERO )
296 I2 = MIN( KL+KU+1, KU+1+( N-IZERO ) )
297 DO 20 I = I1, I2
298 A( IOFF+I ) = ZERO
299 20 CONTINUE
300 ELSE
301 DO 40 J = IZERO, N
302 DO 30 I = MAX( 1, KU+2-J ),
303 $ MIN( KL+KU+1, KU+1+( N-J ) )
304 A( IOFF+I ) = ZERO
305 30 CONTINUE
306 IOFF = IOFF + LDA
307 40 CONTINUE
308 END IF
309 END IF
310 *
311 * Save a copy of the matrix A in ASAV.
312 *
313 CALL SLACPY( 'Full', KL+KU+1, N, A, LDA, ASAV, LDA )
314 *
315 DO 110 IEQUED = 1, 4
316 EQUED = EQUEDS( IEQUED )
317 IF( IEQUED.EQ.1 ) THEN
318 NFACT = 3
319 ELSE
320 NFACT = 1
321 END IF
322 *
323 DO 100 IFACT = 1, NFACT
324 FACT = FACTS( IFACT )
325 PREFAC = LSAME( FACT, 'F' )
326 NOFACT = LSAME( FACT, 'N' )
327 EQUIL = LSAME( FACT, 'E' )
328 *
329 IF( ZEROT ) THEN
330 IF( PREFAC )
331 $ GO TO 100
332 RCONDO = ZERO
333 RCONDI = ZERO
334 *
335 ELSE IF( .NOT.NOFACT ) THEN
336 *
337 * Compute the condition number for comparison
338 * with the value returned by SGESVX (FACT =
339 * 'N' reuses the condition number from the
340 * previous iteration with FACT = 'F').
341 *
342 CALL SLACPY( 'Full', KL+KU+1, N, ASAV, LDA,
343 $ AFB( KL+1 ), LDAFB )
344 IF( EQUIL .OR. IEQUED.GT.1 ) THEN
345 *
346 * Compute row and column scale factors to
347 * equilibrate the matrix A.
348 *
349 CALL SGBEQU( N, N, KL, KU, AFB( KL+1 ),
350 $ LDAFB, S, S( N+1 ), ROWCND,
351 $ COLCND, AMAX, INFO )
352 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
353 IF( LSAME( EQUED, 'R' ) ) THEN
354 ROWCND = ZERO
355 COLCND = ONE
356 ELSE IF( LSAME( EQUED, 'C' ) ) THEN
357 ROWCND = ONE
358 COLCND = ZERO
359 ELSE IF( LSAME( EQUED, 'B' ) ) THEN
360 ROWCND = ZERO
361 COLCND = ZERO
362 END IF
363 *
364 * Equilibrate the matrix.
365 *
366 CALL SLAQGB( N, N, KL, KU, AFB( KL+1 ),
367 $ LDAFB, S, S( N+1 ),
368 $ ROWCND, COLCND, AMAX,
369 $ EQUED )
370 END IF
371 END IF
372 *
373 * Save the condition number of the
374 * non-equilibrated system for use in SGET04.
375 *
376 IF( EQUIL ) THEN
377 ROLDO = RCONDO
378 ROLDI = RCONDI
379 END IF
380 *
381 * Compute the 1-norm and infinity-norm of A.
382 *
383 ANORMO = SLANGB( '1', N, KL, KU, AFB( KL+1 ),
384 $ LDAFB, RWORK )
385 ANORMI = SLANGB( 'I', N, KL, KU, AFB( KL+1 ),
386 $ LDAFB, RWORK )
387 *
388 * Factor the matrix A.
389 *
390 CALL SGBTRF( N, N, KL, KU, AFB, LDAFB, IWORK,
391 $ INFO )
392 *
393 * Form the inverse of A.
394 *
395 CALL SLASET( 'Full', N, N, ZERO, ONE, WORK,
396 $ LDB )
397 SRNAMT = 'SGBTRS'
398 CALL SGBTRS( 'No transpose', N, KL, KU, N,
399 $ AFB, LDAFB, IWORK, WORK, LDB,
400 $ INFO )
401 *
402 * Compute the 1-norm condition number of A.
403 *
404 AINVNM = SLANGE( '1', N, N, WORK, LDB,
405 $ RWORK )
406 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
407 RCONDO = ONE
408 ELSE
409 RCONDO = ( ONE / ANORMO ) / AINVNM
410 END IF
411 *
412 * Compute the infinity-norm condition number
413 * of A.
414 *
415 AINVNM = SLANGE( 'I', N, N, WORK, LDB,
416 $ RWORK )
417 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
418 RCONDI = ONE
419 ELSE
420 RCONDI = ( ONE / ANORMI ) / AINVNM
421 END IF
422 END IF
423 *
424 DO 90 ITRAN = 1, NTRAN
425 *
426 * Do for each value of TRANS.
427 *
428 TRANS = TRANSS( ITRAN )
429 IF( ITRAN.EQ.1 ) THEN
430 RCONDC = RCONDO
431 ELSE
432 RCONDC = RCONDI
433 END IF
434 *
435 * Restore the matrix A.
436 *
437 CALL SLACPY( 'Full', KL+KU+1, N, ASAV, LDA,
438 $ A, LDA )
439 *
440 * Form an exact solution and set the right hand
441 * side.
442 *
443 SRNAMT = 'SLARHS'
444 CALL SLARHS( PATH, XTYPE, 'Full', TRANS, N,
445 $ N, KL, KU, NRHS, A, LDA, XACT,
446 $ LDB, B, LDB, ISEED, INFO )
447 XTYPE = 'C'
448 CALL SLACPY( 'Full', N, NRHS, B, LDB, BSAV,
449 $ LDB )
450 *
451 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
452 *
453 * --- Test SGBSV ---
454 *
455 * Compute the LU factorization of the matrix
456 * and solve the system.
457 *
458 CALL SLACPY( 'Full', KL+KU+1, N, A, LDA,
459 $ AFB( KL+1 ), LDAFB )
460 CALL SLACPY( 'Full', N, NRHS, B, LDB, X,
461 $ LDB )
462 *
463 SRNAMT = 'SGBSV '
464 CALL SGBSV( N, KL, KU, NRHS, AFB, LDAFB,
465 $ IWORK, X, LDB, INFO )
466 *
467 * Check error code from SGBSV .
468 *
469 IF( INFO.NE.IZERO )
470 $ CALL ALAERH( PATH, 'SGBSV ', INFO,
471 $ IZERO, ' ', N, N, KL, KU,
472 $ NRHS, IMAT, NFAIL, NERRS,
473 $ NOUT )
474 *
475 * Reconstruct matrix from factors and
476 * compute residual.
477 *
478 CALL SGBT01( N, N, KL, KU, A, LDA, AFB,
479 $ LDAFB, IWORK, WORK,
480 $ RESULT( 1 ) )
481 NT = 1
482 IF( IZERO.EQ.0 ) THEN
483 *
484 * Compute residual of the computed
485 * solution.
486 *
487 CALL SLACPY( 'Full', N, NRHS, B, LDB,
488 $ WORK, LDB )
489 CALL SGBT02( 'No transpose', N, N, KL,
490 $ KU, NRHS, A, LDA, X, LDB,
491 $ WORK, LDB, RESULT( 2 ) )
492 *
493 * Check solution from generated exact
494 * solution.
495 *
496 CALL SGET04( N, NRHS, X, LDB, XACT,
497 $ LDB, RCONDC, RESULT( 3 ) )
498 NT = 3
499 END IF
500 *
501 * Print information about the tests that did
502 * not pass the threshold.
503 *
504 DO 50 K = 1, NT
505 IF( RESULT( K ).GE.THRESH ) THEN
506 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
507 $ CALL ALADHD( NOUT, PATH )
508 WRITE( NOUT, FMT = 9997 )'SGBSV ',
509 $ N, KL, KU, IMAT, K, RESULT( K )
510 NFAIL = NFAIL + 1
511 END IF
512 50 CONTINUE
513 NRUN = NRUN + NT
514 END IF
515 *
516 * --- Test SGBSVX ---
517 *
518 IF( .NOT.PREFAC )
519 $ CALL SLASET( 'Full', 2*KL+KU+1, N, ZERO,
520 $ ZERO, AFB, LDAFB )
521 CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X,
522 $ LDB )
523 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
524 *
525 * Equilibrate the matrix if FACT = 'F' and
526 * EQUED = 'R', 'C', or 'B'.
527 *
528 CALL SLAQGB( N, N, KL, KU, A, LDA, S,
529 $ S( N+1 ), ROWCND, COLCND,
530 $ AMAX, EQUED )
531 END IF
532 *
533 * Solve the system and compute the condition
534 * number and error bounds using SGBSVX.
535 *
536 SRNAMT = 'SGBSVX'
537 CALL SGBSVX( FACT, TRANS, N, KL, KU, NRHS, A,
538 $ LDA, AFB, LDAFB, IWORK, EQUED,
539 $ S, S( N+1 ), B, LDB, X, LDB,
540 $ RCOND, RWORK, RWORK( NRHS+1 ),
541 $ WORK, IWORK( N+1 ), INFO )
542 *
543 * Check the error code from SGBSVX.
544 *
545 IF( INFO.NE.IZERO )
546 $ CALL ALAERH( PATH, 'SGBSVX', INFO, IZERO,
547 $ FACT // TRANS, N, N, KL, KU,
548 $ NRHS, IMAT, NFAIL, NERRS,
549 $ NOUT )
550 *
551 * Compare WORK(1) from SGBSVX with the computed
552 * reciprocal pivot growth factor RPVGRW
553 *
554 IF( INFO.NE.0 ) THEN
555 ANRMPV = ZERO
556 DO 70 J = 1, INFO
557 DO 60 I = MAX( KU+2-J, 1 ),
558 $ MIN( N+KU+1-J, KL+KU+1 )
559 ANRMPV = MAX( ANRMPV,
560 $ ABS( A( I+( J-1 )*LDA ) ) )
561 60 CONTINUE
562 70 CONTINUE
563 RPVGRW = SLANTB( 'M', 'U', 'N', INFO,
564 $ MIN( INFO-1, KL+KU ),
565 $ AFB( MAX( 1, KL+KU+2-INFO ) ),
566 $ LDAFB, WORK )
567 IF( RPVGRW.EQ.ZERO ) THEN
568 RPVGRW = ONE
569 ELSE
570 RPVGRW = ANRMPV / RPVGRW
571 END IF
572 ELSE
573 RPVGRW = SLANTB( 'M', 'U', 'N', N, KL+KU,
574 $ AFB, LDAFB, WORK )
575 IF( RPVGRW.EQ.ZERO ) THEN
576 RPVGRW = ONE
577 ELSE
578 RPVGRW = SLANGB( 'M', N, KL, KU, A,
579 $ LDA, WORK ) / RPVGRW
580 END IF
581 END IF
582 RESULT( 7 ) = ABS( RPVGRW-WORK( 1 ) ) /
583 $ MAX( WORK( 1 ), RPVGRW ) /
584 $ SLAMCH( 'E' )
585 *
586 IF( .NOT.PREFAC ) THEN
587 *
588 * Reconstruct matrix from factors and
589 * compute residual.
590 *
591 CALL SGBT01( N, N, KL, KU, A, LDA, AFB,
592 $ LDAFB, IWORK, WORK,
593 $ RESULT( 1 ) )
594 K1 = 1
595 ELSE
596 K1 = 2
597 END IF
598 *
599 IF( INFO.EQ.0 ) THEN
600 TRFCON = .FALSE.
601 *
602 * Compute residual of the computed solution.
603 *
604 CALL SLACPY( 'Full', N, NRHS, BSAV, LDB,
605 $ WORK, LDB )
606 CALL SGBT02( TRANS, N, N, KL, KU, NRHS,
607 $ ASAV, LDA, X, LDB, WORK, LDB,
608 $ RESULT( 2 ) )
609 *
610 * Check solution from generated exact
611 * solution.
612 *
613 IF( NOFACT .OR. ( PREFAC .AND.
614 $ LSAME( EQUED, 'N' ) ) ) THEN
615 CALL SGET04( N, NRHS, X, LDB, XACT,
616 $ LDB, RCONDC, RESULT( 3 ) )
617 ELSE
618 IF( ITRAN.EQ.1 ) THEN
619 ROLDC = ROLDO
620 ELSE
621 ROLDC = ROLDI
622 END IF
623 CALL SGET04( N, NRHS, X, LDB, XACT,
624 $ LDB, ROLDC, RESULT( 3 ) )
625 END IF
626 *
627 * Check the error bounds from iterative
628 * refinement.
629 *
630 CALL SGBT05( TRANS, N, KL, KU, NRHS, ASAV,
631 $ LDA, B, LDB, X, LDB, XACT,
632 $ LDB, RWORK, RWORK( NRHS+1 ),
633 $ RESULT( 4 ) )
634 ELSE
635 TRFCON = .TRUE.
636 END IF
637 *
638 * Compare RCOND from SGBSVX with the computed
639 * value in RCONDC.
640 *
641 RESULT( 6 ) = SGET06( RCOND, RCONDC )
642 *
643 * Print information about the tests that did
644 * not pass the threshold.
645 *
646 IF( .NOT.TRFCON ) THEN
647 DO 80 K = K1, NTESTS
648 IF( RESULT( K ).GE.THRESH ) THEN
649 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
650 $ CALL ALADHD( NOUT, PATH )
651 IF( PREFAC ) THEN
652 WRITE( NOUT, FMT = 9995 )
653 $ 'SGBSVX', FACT, TRANS, N, KL,
654 $ KU, EQUED, IMAT, K,
655 $ RESULT( K )
656 ELSE
657 WRITE( NOUT, FMT = 9996 )
658 $ 'SGBSVX', FACT, TRANS, N, KL,
659 $ KU, IMAT, K, RESULT( K )
660 END IF
661 NFAIL = NFAIL + 1
662 END IF
663 80 CONTINUE
664 NRUN = NRUN + 7 - K1
665 ELSE
666 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.
667 $ PREFAC ) THEN
668 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
669 $ CALL ALADHD( NOUT, PATH )
670 IF( PREFAC ) THEN
671 WRITE( NOUT, FMT = 9995 )'SGBSVX',
672 $ FACT, TRANS, N, KL, KU, EQUED,
673 $ IMAT, 1, RESULT( 1 )
674 ELSE
675 WRITE( NOUT, FMT = 9996 )'SGBSVX',
676 $ FACT, TRANS, N, KL, KU, IMAT, 1,
677 $ RESULT( 1 )
678 END IF
679 NFAIL = NFAIL + 1
680 NRUN = NRUN + 1
681 END IF
682 IF( RESULT( 6 ).GE.THRESH ) THEN
683 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
684 $ CALL ALADHD( NOUT, PATH )
685 IF( PREFAC ) THEN
686 WRITE( NOUT, FMT = 9995 )'SGBSVX',
687 $ FACT, TRANS, N, KL, KU, EQUED,
688 $ IMAT, 6, RESULT( 6 )
689 ELSE
690 WRITE( NOUT, FMT = 9996 )'SGBSVX',
691 $ FACT, TRANS, N, KL, KU, IMAT, 6,
692 $ RESULT( 6 )
693 END IF
694 NFAIL = NFAIL + 1
695 NRUN = NRUN + 1
696 END IF
697 IF( RESULT( 7 ).GE.THRESH ) THEN
698 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
699 $ CALL ALADHD( NOUT, PATH )
700 IF( PREFAC ) THEN
701 WRITE( NOUT, FMT = 9995 )'SGBSVX',
702 $ FACT, TRANS, N, KL, KU, EQUED,
703 $ IMAT, 7, RESULT( 7 )
704 ELSE
705 WRITE( NOUT, FMT = 9996 )'SGBSVX',
706 $ FACT, TRANS, N, KL, KU, IMAT, 7,
707 $ RESULT( 7 )
708 END IF
709 NFAIL = NFAIL + 1
710 NRUN = NRUN + 1
711 END IF
712 *
713 END IF
714 *
715 * --- Test SGBSVXX ---
716 *
717 * Restore the matrices A and B.
718 *
719 CALL SLACPY( 'Full', KL+KU+1, N, ASAV, LDA, A,
720 $ LDA )
721 CALL SLACPY( 'Full', N, NRHS, BSAV, LDB, B, LDB )
722
723 IF( .NOT.PREFAC )
724 $ CALL SLASET( 'Full', 2*KL+KU+1, N, ZERO, ZERO,
725 $ AFB, LDAFB )
726 CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDB )
727 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
728 *
729 * Equilibrate the matrix if FACT = 'F' and
730 * EQUED = 'R', 'C', or 'B'.
731 *
732 CALL SLAQGB( N, N, KL, KU, A, LDA, S,
733 $ S( N+1 ), ROWCND, COLCND, AMAX, EQUED )
734 END IF
735 *
736 * Solve the system and compute the condition number
737 * and error bounds using SGBSVXX.
738 *
739 SRNAMT = 'SGBSVXX'
740 N_ERR_BNDS = 3
741 CALL SGBSVXX( FACT, TRANS, N, KL, KU, NRHS, A, LDA,
742 $ AFB, LDAFB, IWORK, EQUED, S, S( N+1 ), B, LDB,
743 $ X, LDB, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
744 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
745 $ IWORK( N+1 ), INFO )
746
747 * Check the error code from SGBSVXX.
748 *
749 IF( INFO.EQ.N+1 ) GOTO 90
750 IF( INFO.NE.IZERO ) THEN
751 CALL ALAERH( PATH, 'SGBSVXX', INFO, IZERO,
752 $ FACT // TRANS, N, N, -1, -1, NRHS,
753 $ IMAT, NFAIL, NERRS, NOUT )
754 GOTO 90
755 END IF
756 *
757 * Compare rpvgrw_svxx from SGBSVXX with the computed
758 * reciprocal pivot growth factor RPVGRW
759 *
760
761 IF ( INFO .GT. 0 .AND. INFO .LT. N+1 ) THEN
762 RPVGRW = SLA_GBRPVGRW(N, KL, KU, INFO, A, LDA,
763 $ AFB, LDAFB )
764 ELSE
765 RPVGRW = SLA_GBRPVGRW(N, KL, KU, N, A, LDA,
766 $ AFB, LDAFB )
767 ENDIF
768
769 RESULT( 7 ) = ABS( RPVGRW-rpvgrw_svxx ) /
770 $ MAX( rpvgrw_svxx, RPVGRW ) /
771 $ SLAMCH( 'E' )
772 *
773 IF( .NOT.PREFAC ) THEN
774 *
775 * Reconstruct matrix from factors and compute
776 * residual.
777 *
778 CALL SGBT01( N, N, KL, KU, A, LDA, AFB, LDAFB,
779 $ IWORK, WORK,
780 $ RESULT( 1 ) )
781 K1 = 1
782 ELSE
783 K1 = 2
784 END IF
785 *
786 IF( INFO.EQ.0 ) THEN
787 TRFCON = .FALSE.
788 *
789 * Compute residual of the computed solution.
790 *
791 CALL SLACPY( 'Full', N, NRHS, BSAV, LDB, WORK,
792 $ LDB )
793 CALL SGBT02( TRANS, N, N, KL, KU, NRHS, ASAV,
794 $ LDA, X, LDB, WORK, LDB,
795 $ RESULT( 2 ) )
796 *
797 * Check solution from generated exact solution.
798 *
799 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
800 $ 'N' ) ) ) THEN
801 CALL SGET04( N, NRHS, X, LDB, XACT, LDB,
802 $ RCONDC, RESULT( 3 ) )
803 ELSE
804 IF( ITRAN.EQ.1 ) THEN
805 ROLDC = ROLDO
806 ELSE
807 ROLDC = ROLDI
808 END IF
809 CALL SGET04( N, NRHS, X, LDB, XACT, LDB,
810 $ ROLDC, RESULT( 3 ) )
811 END IF
812 ELSE
813 TRFCON = .TRUE.
814 END IF
815 *
816 * Compare RCOND from SGBSVXX with the computed value
817 * in RCONDC.
818 *
819 RESULT( 6 ) = SGET06( RCOND, RCONDC )
820 *
821 * Print information about the tests that did not pass
822 * the threshold.
823 *
824 IF( .NOT.TRFCON ) THEN
825 DO 45 K = K1, NTESTS
826 IF( RESULT( K ).GE.THRESH ) THEN
827 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
828 $ CALL ALADHD( NOUT, PATH )
829 IF( PREFAC ) THEN
830 WRITE( NOUT, FMT = 9995 )'SGBSVXX',
831 $ FACT, TRANS, N, KL, KU, EQUED,
832 $ IMAT, K, RESULT( K )
833 ELSE
834 WRITE( NOUT, FMT = 9996 )'SGBSVXX',
835 $ FACT, TRANS, N, KL, KU, IMAT, K,
836 $ RESULT( K )
837 END IF
838 NFAIL = NFAIL + 1
839 END IF
840 45 CONTINUE
841 NRUN = NRUN + 7 - K1
842 ELSE
843 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
844 $ THEN
845 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
846 $ CALL ALADHD( NOUT, PATH )
847 IF( PREFAC ) THEN
848 WRITE( NOUT, FMT = 9995 )'SGBSVXX', FACT,
849 $ TRANS, N, KL, KU, EQUED, IMAT, 1,
850 $ RESULT( 1 )
851 ELSE
852 WRITE( NOUT, FMT = 9996 )'SGBSVXX', FACT,
853 $ TRANS, N, KL, KU, IMAT, 1,
854 $ RESULT( 1 )
855 END IF
856 NFAIL = NFAIL + 1
857 NRUN = NRUN + 1
858 END IF
859 IF( RESULT( 6 ).GE.THRESH ) THEN
860 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
861 $ CALL ALADHD( NOUT, PATH )
862 IF( PREFAC ) THEN
863 WRITE( NOUT, FMT = 9995 )'SGBSVXX', FACT,
864 $ TRANS, N, KL, KU, EQUED, IMAT, 6,
865 $ RESULT( 6 )
866 ELSE
867 WRITE( NOUT, FMT = 9996 )'SGBSVXX', FACT,
868 $ TRANS, N, KL, KU, IMAT, 6,
869 $ RESULT( 6 )
870 END IF
871 NFAIL = NFAIL + 1
872 NRUN = NRUN + 1
873 END IF
874 IF( RESULT( 7 ).GE.THRESH ) THEN
875 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
876 $ CALL ALADHD( NOUT, PATH )
877 IF( PREFAC ) THEN
878 WRITE( NOUT, FMT = 9995 )'SGBSVXX', FACT,
879 $ TRANS, N, KL, KU, EQUED, IMAT, 7,
880 $ RESULT( 7 )
881 ELSE
882 WRITE( NOUT, FMT = 9996 )'SGBSVXX', FACT,
883 $ TRANS, N, KL, KU, IMAT, 7,
884 $ RESULT( 7 )
885 END IF
886 NFAIL = NFAIL + 1
887 NRUN = NRUN + 1
888 END IF
889
890 END IF
891 *
892 90 CONTINUE
893 100 CONTINUE
894 110 CONTINUE
895 120 CONTINUE
896 130 CONTINUE
897 140 CONTINUE
898 150 CONTINUE
899 *
900 * Print a summary of the results.
901 *
902 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
903 *
904
905 * Test Error Bounds from SGBSVXX
906
907 CALL SEBCHVXX(THRESH, PATH)
908
909 9999 FORMAT( ' *** In SDRVGB, LA=', I5, ' is too small for N=', I5,
910 $ ', KU=', I5, ', KL=', I5, / ' ==> Increase LA to at least ',
911 $ I5 )
912 9998 FORMAT( ' *** In SDRVGB, LAFB=', I5, ' is too small for N=', I5,
913 $ ', KU=', I5, ', KL=', I5, /
914 $ ' ==> Increase LAFB to at least ', I5 )
915 9997 FORMAT( 1X, A, ', N=', I5, ', KL=', I5, ', KU=', I5, ', type ',
916 $ I1, ', test(', I1, ')=', G12.5 )
917 9996 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
918 $ I5, ',...), type ', I1, ', test(', I1, ')=', G12.5 )
919 9995 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
920 $ I5, ',...), EQUED=''', A1, ''', type ', I1, ', test(', I1,
921 $ ')=', G12.5 )
922 *
923 RETURN
924 *
925 * End of SDRVGB
926 *
927 END
2 $ AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK,
3 $ RWORK, IWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.2.2) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * April 2009
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER LA, LAFB, NN, NOUT, NRHS
12 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NVAL( * )
17 REAL A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ),
18 $ RWORK( * ), S( * ), WORK( * ), X( * ),
19 $ XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * SDRVGB tests the driver routines SGBSV, -SVX, and -SVXX.
26 *
27 * Note that this file is used only when the XBLAS are available,
28 * otherwise sdrvgb.f defines this subroutine.
29 *
30 * Arguments
31 * =========
32 *
33 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
34 * The matrix types to be used for testing. Matrices of type j
35 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
36 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
37 *
38 * NN (input) INTEGER
39 * The number of values of N contained in the vector NVAL.
40 *
41 * NVAL (input) INTEGER array, dimension (NN)
42 * The values of the matrix column dimension N.
43 *
44 * NRHS (input) INTEGER
45 * The number of right hand side vectors to be generated for
46 * each linear system.
47 *
48 * THRESH (input) REAL
49 * The threshold value for the test ratios. A result is
50 * included in the output file if RESULT >= THRESH. To have
51 * every test ratio printed, use THRESH = 0.
52 *
53 * TSTERR (input) LOGICAL
54 * Flag that indicates whether error exits are to be tested.
55 *
56 * A (workspace) REAL array, dimension (LA)
57 *
58 * LA (input) INTEGER
59 * The length of the array A. LA >= (2*NMAX-1)*NMAX
60 * where NMAX is the largest entry in NVAL.
61 *
62 * AFB (workspace) REAL array, dimension (LAFB)
63 *
64 * LAFB (input) INTEGER
65 * The length of the array AFB. LAFB >= (3*NMAX-2)*NMAX
66 * where NMAX is the largest entry in NVAL.
67 *
68 * ASAV (workspace) REAL array, dimension (LA)
69 *
70 * B (workspace) REAL array, dimension (NMAX*NRHS)
71 *
72 * BSAV (workspace) REAL array, dimension (NMAX*NRHS)
73 *
74 * X (workspace) REAL array, dimension (NMAX*NRHS)
75 *
76 * XACT (workspace) REAL array, dimension (NMAX*NRHS)
77 *
78 * S (workspace) REAL array, dimension (2*NMAX)
79 *
80 * WORK (workspace) REAL array, dimension
81 * (NMAX*max(3,NRHS,NMAX))
82 *
83 * RWORK (workspace) REAL array, dimension
84 * (max(NMAX,2*NRHS))
85 *
86 * IWORK (workspace) INTEGER array, dimension (2*NMAX)
87 *
88 * NOUT (input) INTEGER
89 * The unit number for output.
90 *
91 * =====================================================================
92 *
93 * .. Parameters ..
94 REAL ONE, ZERO
95 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
96 INTEGER NTYPES
97 PARAMETER ( NTYPES = 8 )
98 INTEGER NTESTS
99 PARAMETER ( NTESTS = 7 )
100 INTEGER NTRAN
101 PARAMETER ( NTRAN = 3 )
102 * ..
103 * .. Local Scalars ..
104 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
105 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE
106 CHARACTER*3 PATH
107 INTEGER I, I1, I2, IEQUED, IFACT, IKL, IKU, IMAT, IN,
108 $ INFO, IOFF, ITRAN, IZERO, J, K, K1, KL, KU,
109 $ LDA, LDAFB, LDB, MODE, N, NB, NBMIN, NERRS,
110 $ NFACT, NFAIL, NIMAT, NKL, NKU, NRUN, NT,
111 $ N_ERR_BNDS
112 REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, ANRMPV,
113 $ CNDNUM, COLCND, RCOND, RCONDC, RCONDI, RCONDO,
114 $ ROLDC, ROLDI, ROLDO, ROWCND, RPVGRW,
115 $ RPVGRW_SVXX
116 * ..
117 * .. Local Arrays ..
118 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
119 INTEGER ISEED( 4 ), ISEEDY( 4 )
120 REAL RESULT( NTESTS ), BERR( NRHS ),
121 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
122 * ..
123 * .. External Functions ..
124 LOGICAL LSAME
125 REAL SGET06, SLAMCH, SLANGB, SLANGE, SLANTB,
126 $ SLA_GBRPVGRW
127 EXTERNAL LSAME, SGET06, SLAMCH, SLANGB, SLANGE, SLANTB,
128 $ SLA_GBRPVGRW
129 * ..
130 * .. External Subroutines ..
131 EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGBEQU, SGBSV,
132 $ SGBSVX, SGBT01, SGBT02, SGBT05, SGBTRF, SGBTRS,
133 $ SGET04, SLACPY, SLAQGB, SLARHS, SLASET, SLATB4,
134 $ SLATMS, XLAENV, SGBSVXX
135 * ..
136 * .. Intrinsic Functions ..
137 INTRINSIC ABS, MAX, MIN
138 * ..
139 * .. Scalars in Common ..
140 LOGICAL LERR, OK
141 CHARACTER*32 SRNAMT
142 INTEGER INFOT, NUNIT
143 * ..
144 * .. Common blocks ..
145 COMMON / INFOC / INFOT, NUNIT, OK, LERR
146 COMMON / SRNAMC / SRNAMT
147 * ..
148 * .. Data statements ..
149 DATA ISEEDY / 1988, 1989, 1990, 1991 /
150 DATA TRANSS / 'N', 'T', 'C' /
151 DATA FACTS / 'F', 'N', 'E' /
152 DATA EQUEDS / 'N', 'R', 'C', 'B' /
153 * ..
154 * .. Executable Statements ..
155 *
156 * Initialize constants and the random number seed.
157 *
158 PATH( 1: 1 ) = 'Single precision'
159 PATH( 2: 3 ) = 'GB'
160 NRUN = 0
161 NFAIL = 0
162 NERRS = 0
163 DO 10 I = 1, 4
164 ISEED( I ) = ISEEDY( I )
165 10 CONTINUE
166 *
167 * Test the error exits
168 *
169 IF( TSTERR )
170 $ CALL SERRVX( PATH, NOUT )
171 INFOT = 0
172 *
173 * Set the block size and minimum block size for testing.
174 *
175 NB = 1
176 NBMIN = 2
177 CALL XLAENV( 1, NB )
178 CALL XLAENV( 2, NBMIN )
179 *
180 * Do for each value of N in NVAL
181 *
182 DO 150 IN = 1, NN
183 N = NVAL( IN )
184 LDB = MAX( N, 1 )
185 XTYPE = 'N'
186 *
187 * Set limits on the number of loop iterations.
188 *
189 NKL = MAX( 1, MIN( N, 4 ) )
190 IF( N.EQ.0 )
191 $ NKL = 1
192 NKU = NKL
193 NIMAT = NTYPES
194 IF( N.LE.0 )
195 $ NIMAT = 1
196 *
197 DO 140 IKL = 1, NKL
198 *
199 * Do for KL = 0, N-1, (3N-1)/4, and (N+1)/4. This order makes
200 * it easier to skip redundant values for small values of N.
201 *
202 IF( IKL.EQ.1 ) THEN
203 KL = 0
204 ELSE IF( IKL.EQ.2 ) THEN
205 KL = MAX( N-1, 0 )
206 ELSE IF( IKL.EQ.3 ) THEN
207 KL = ( 3*N-1 ) / 4
208 ELSE IF( IKL.EQ.4 ) THEN
209 KL = ( N+1 ) / 4
210 END IF
211 DO 130 IKU = 1, NKU
212 *
213 * Do for KU = 0, N-1, (3N-1)/4, and (N+1)/4. This order
214 * makes it easier to skip redundant values for small
215 * values of N.
216 *
217 IF( IKU.EQ.1 ) THEN
218 KU = 0
219 ELSE IF( IKU.EQ.2 ) THEN
220 KU = MAX( N-1, 0 )
221 ELSE IF( IKU.EQ.3 ) THEN
222 KU = ( 3*N-1 ) / 4
223 ELSE IF( IKU.EQ.4 ) THEN
224 KU = ( N+1 ) / 4
225 END IF
226 *
227 * Check that A and AFB are big enough to generate this
228 * matrix.
229 *
230 LDA = KL + KU + 1
231 LDAFB = 2*KL + KU + 1
232 IF( LDA*N.GT.LA .OR. LDAFB*N.GT.LAFB ) THEN
233 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
234 $ CALL ALADHD( NOUT, PATH )
235 IF( LDA*N.GT.LA ) THEN
236 WRITE( NOUT, FMT = 9999 )LA, N, KL, KU,
237 $ N*( KL+KU+1 )
238 NERRS = NERRS + 1
239 END IF
240 IF( LDAFB*N.GT.LAFB ) THEN
241 WRITE( NOUT, FMT = 9998 )LAFB, N, KL, KU,
242 $ N*( 2*KL+KU+1 )
243 NERRS = NERRS + 1
244 END IF
245 GO TO 130
246 END IF
247 *
248 DO 120 IMAT = 1, NIMAT
249 *
250 * Do the tests only if DOTYPE( IMAT ) is true.
251 *
252 IF( .NOT.DOTYPE( IMAT ) )
253 $ GO TO 120
254 *
255 * Skip types 2, 3, or 4 if the matrix is too small.
256 *
257 ZEROT = IMAT.GE.2 .AND. IMAT.LE.4
258 IF( ZEROT .AND. N.LT.IMAT-1 )
259 $ GO TO 120
260 *
261 * Set up parameters with SLATB4 and generate a
262 * test matrix with SLATMS.
263 *
264 CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
265 $ MODE, CNDNUM, DIST )
266 RCONDC = ONE / CNDNUM
267 *
268 SRNAMT = 'SLATMS'
269 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
270 $ CNDNUM, ANORM, KL, KU, 'Z', A, LDA, WORK,
271 $ INFO )
272 *
273 * Check the error code from SLATMS.
274 *
275 IF( INFO.NE.0 ) THEN
276 CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', N, N,
277 $ KL, KU, -1, IMAT, NFAIL, NERRS, NOUT )
278 GO TO 120
279 END IF
280 *
281 * For types 2, 3, and 4, zero one or more columns of
282 * the matrix to test that INFO is returned correctly.
283 *
284 IZERO = 0
285 IF( ZEROT ) THEN
286 IF( IMAT.EQ.2 ) THEN
287 IZERO = 1
288 ELSE IF( IMAT.EQ.3 ) THEN
289 IZERO = N
290 ELSE
291 IZERO = N / 2 + 1
292 END IF
293 IOFF = ( IZERO-1 )*LDA
294 IF( IMAT.LT.4 ) THEN
295 I1 = MAX( 1, KU+2-IZERO )
296 I2 = MIN( KL+KU+1, KU+1+( N-IZERO ) )
297 DO 20 I = I1, I2
298 A( IOFF+I ) = ZERO
299 20 CONTINUE
300 ELSE
301 DO 40 J = IZERO, N
302 DO 30 I = MAX( 1, KU+2-J ),
303 $ MIN( KL+KU+1, KU+1+( N-J ) )
304 A( IOFF+I ) = ZERO
305 30 CONTINUE
306 IOFF = IOFF + LDA
307 40 CONTINUE
308 END IF
309 END IF
310 *
311 * Save a copy of the matrix A in ASAV.
312 *
313 CALL SLACPY( 'Full', KL+KU+1, N, A, LDA, ASAV, LDA )
314 *
315 DO 110 IEQUED = 1, 4
316 EQUED = EQUEDS( IEQUED )
317 IF( IEQUED.EQ.1 ) THEN
318 NFACT = 3
319 ELSE
320 NFACT = 1
321 END IF
322 *
323 DO 100 IFACT = 1, NFACT
324 FACT = FACTS( IFACT )
325 PREFAC = LSAME( FACT, 'F' )
326 NOFACT = LSAME( FACT, 'N' )
327 EQUIL = LSAME( FACT, 'E' )
328 *
329 IF( ZEROT ) THEN
330 IF( PREFAC )
331 $ GO TO 100
332 RCONDO = ZERO
333 RCONDI = ZERO
334 *
335 ELSE IF( .NOT.NOFACT ) THEN
336 *
337 * Compute the condition number for comparison
338 * with the value returned by SGESVX (FACT =
339 * 'N' reuses the condition number from the
340 * previous iteration with FACT = 'F').
341 *
342 CALL SLACPY( 'Full', KL+KU+1, N, ASAV, LDA,
343 $ AFB( KL+1 ), LDAFB )
344 IF( EQUIL .OR. IEQUED.GT.1 ) THEN
345 *
346 * Compute row and column scale factors to
347 * equilibrate the matrix A.
348 *
349 CALL SGBEQU( N, N, KL, KU, AFB( KL+1 ),
350 $ LDAFB, S, S( N+1 ), ROWCND,
351 $ COLCND, AMAX, INFO )
352 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
353 IF( LSAME( EQUED, 'R' ) ) THEN
354 ROWCND = ZERO
355 COLCND = ONE
356 ELSE IF( LSAME( EQUED, 'C' ) ) THEN
357 ROWCND = ONE
358 COLCND = ZERO
359 ELSE IF( LSAME( EQUED, 'B' ) ) THEN
360 ROWCND = ZERO
361 COLCND = ZERO
362 END IF
363 *
364 * Equilibrate the matrix.
365 *
366 CALL SLAQGB( N, N, KL, KU, AFB( KL+1 ),
367 $ LDAFB, S, S( N+1 ),
368 $ ROWCND, COLCND, AMAX,
369 $ EQUED )
370 END IF
371 END IF
372 *
373 * Save the condition number of the
374 * non-equilibrated system for use in SGET04.
375 *
376 IF( EQUIL ) THEN
377 ROLDO = RCONDO
378 ROLDI = RCONDI
379 END IF
380 *
381 * Compute the 1-norm and infinity-norm of A.
382 *
383 ANORMO = SLANGB( '1', N, KL, KU, AFB( KL+1 ),
384 $ LDAFB, RWORK )
385 ANORMI = SLANGB( 'I', N, KL, KU, AFB( KL+1 ),
386 $ LDAFB, RWORK )
387 *
388 * Factor the matrix A.
389 *
390 CALL SGBTRF( N, N, KL, KU, AFB, LDAFB, IWORK,
391 $ INFO )
392 *
393 * Form the inverse of A.
394 *
395 CALL SLASET( 'Full', N, N, ZERO, ONE, WORK,
396 $ LDB )
397 SRNAMT = 'SGBTRS'
398 CALL SGBTRS( 'No transpose', N, KL, KU, N,
399 $ AFB, LDAFB, IWORK, WORK, LDB,
400 $ INFO )
401 *
402 * Compute the 1-norm condition number of A.
403 *
404 AINVNM = SLANGE( '1', N, N, WORK, LDB,
405 $ RWORK )
406 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
407 RCONDO = ONE
408 ELSE
409 RCONDO = ( ONE / ANORMO ) / AINVNM
410 END IF
411 *
412 * Compute the infinity-norm condition number
413 * of A.
414 *
415 AINVNM = SLANGE( 'I', N, N, WORK, LDB,
416 $ RWORK )
417 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
418 RCONDI = ONE
419 ELSE
420 RCONDI = ( ONE / ANORMI ) / AINVNM
421 END IF
422 END IF
423 *
424 DO 90 ITRAN = 1, NTRAN
425 *
426 * Do for each value of TRANS.
427 *
428 TRANS = TRANSS( ITRAN )
429 IF( ITRAN.EQ.1 ) THEN
430 RCONDC = RCONDO
431 ELSE
432 RCONDC = RCONDI
433 END IF
434 *
435 * Restore the matrix A.
436 *
437 CALL SLACPY( 'Full', KL+KU+1, N, ASAV, LDA,
438 $ A, LDA )
439 *
440 * Form an exact solution and set the right hand
441 * side.
442 *
443 SRNAMT = 'SLARHS'
444 CALL SLARHS( PATH, XTYPE, 'Full', TRANS, N,
445 $ N, KL, KU, NRHS, A, LDA, XACT,
446 $ LDB, B, LDB, ISEED, INFO )
447 XTYPE = 'C'
448 CALL SLACPY( 'Full', N, NRHS, B, LDB, BSAV,
449 $ LDB )
450 *
451 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
452 *
453 * --- Test SGBSV ---
454 *
455 * Compute the LU factorization of the matrix
456 * and solve the system.
457 *
458 CALL SLACPY( 'Full', KL+KU+1, N, A, LDA,
459 $ AFB( KL+1 ), LDAFB )
460 CALL SLACPY( 'Full', N, NRHS, B, LDB, X,
461 $ LDB )
462 *
463 SRNAMT = 'SGBSV '
464 CALL SGBSV( N, KL, KU, NRHS, AFB, LDAFB,
465 $ IWORK, X, LDB, INFO )
466 *
467 * Check error code from SGBSV .
468 *
469 IF( INFO.NE.IZERO )
470 $ CALL ALAERH( PATH, 'SGBSV ', INFO,
471 $ IZERO, ' ', N, N, KL, KU,
472 $ NRHS, IMAT, NFAIL, NERRS,
473 $ NOUT )
474 *
475 * Reconstruct matrix from factors and
476 * compute residual.
477 *
478 CALL SGBT01( N, N, KL, KU, A, LDA, AFB,
479 $ LDAFB, IWORK, WORK,
480 $ RESULT( 1 ) )
481 NT = 1
482 IF( IZERO.EQ.0 ) THEN
483 *
484 * Compute residual of the computed
485 * solution.
486 *
487 CALL SLACPY( 'Full', N, NRHS, B, LDB,
488 $ WORK, LDB )
489 CALL SGBT02( 'No transpose', N, N, KL,
490 $ KU, NRHS, A, LDA, X, LDB,
491 $ WORK, LDB, RESULT( 2 ) )
492 *
493 * Check solution from generated exact
494 * solution.
495 *
496 CALL SGET04( N, NRHS, X, LDB, XACT,
497 $ LDB, RCONDC, RESULT( 3 ) )
498 NT = 3
499 END IF
500 *
501 * Print information about the tests that did
502 * not pass the threshold.
503 *
504 DO 50 K = 1, NT
505 IF( RESULT( K ).GE.THRESH ) THEN
506 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
507 $ CALL ALADHD( NOUT, PATH )
508 WRITE( NOUT, FMT = 9997 )'SGBSV ',
509 $ N, KL, KU, IMAT, K, RESULT( K )
510 NFAIL = NFAIL + 1
511 END IF
512 50 CONTINUE
513 NRUN = NRUN + NT
514 END IF
515 *
516 * --- Test SGBSVX ---
517 *
518 IF( .NOT.PREFAC )
519 $ CALL SLASET( 'Full', 2*KL+KU+1, N, ZERO,
520 $ ZERO, AFB, LDAFB )
521 CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X,
522 $ LDB )
523 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
524 *
525 * Equilibrate the matrix if FACT = 'F' and
526 * EQUED = 'R', 'C', or 'B'.
527 *
528 CALL SLAQGB( N, N, KL, KU, A, LDA, S,
529 $ S( N+1 ), ROWCND, COLCND,
530 $ AMAX, EQUED )
531 END IF
532 *
533 * Solve the system and compute the condition
534 * number and error bounds using SGBSVX.
535 *
536 SRNAMT = 'SGBSVX'
537 CALL SGBSVX( FACT, TRANS, N, KL, KU, NRHS, A,
538 $ LDA, AFB, LDAFB, IWORK, EQUED,
539 $ S, S( N+1 ), B, LDB, X, LDB,
540 $ RCOND, RWORK, RWORK( NRHS+1 ),
541 $ WORK, IWORK( N+1 ), INFO )
542 *
543 * Check the error code from SGBSVX.
544 *
545 IF( INFO.NE.IZERO )
546 $ CALL ALAERH( PATH, 'SGBSVX', INFO, IZERO,
547 $ FACT // TRANS, N, N, KL, KU,
548 $ NRHS, IMAT, NFAIL, NERRS,
549 $ NOUT )
550 *
551 * Compare WORK(1) from SGBSVX with the computed
552 * reciprocal pivot growth factor RPVGRW
553 *
554 IF( INFO.NE.0 ) THEN
555 ANRMPV = ZERO
556 DO 70 J = 1, INFO
557 DO 60 I = MAX( KU+2-J, 1 ),
558 $ MIN( N+KU+1-J, KL+KU+1 )
559 ANRMPV = MAX( ANRMPV,
560 $ ABS( A( I+( J-1 )*LDA ) ) )
561 60 CONTINUE
562 70 CONTINUE
563 RPVGRW = SLANTB( 'M', 'U', 'N', INFO,
564 $ MIN( INFO-1, KL+KU ),
565 $ AFB( MAX( 1, KL+KU+2-INFO ) ),
566 $ LDAFB, WORK )
567 IF( RPVGRW.EQ.ZERO ) THEN
568 RPVGRW = ONE
569 ELSE
570 RPVGRW = ANRMPV / RPVGRW
571 END IF
572 ELSE
573 RPVGRW = SLANTB( 'M', 'U', 'N', N, KL+KU,
574 $ AFB, LDAFB, WORK )
575 IF( RPVGRW.EQ.ZERO ) THEN
576 RPVGRW = ONE
577 ELSE
578 RPVGRW = SLANGB( 'M', N, KL, KU, A,
579 $ LDA, WORK ) / RPVGRW
580 END IF
581 END IF
582 RESULT( 7 ) = ABS( RPVGRW-WORK( 1 ) ) /
583 $ MAX( WORK( 1 ), RPVGRW ) /
584 $ SLAMCH( 'E' )
585 *
586 IF( .NOT.PREFAC ) THEN
587 *
588 * Reconstruct matrix from factors and
589 * compute residual.
590 *
591 CALL SGBT01( N, N, KL, KU, A, LDA, AFB,
592 $ LDAFB, IWORK, WORK,
593 $ RESULT( 1 ) )
594 K1 = 1
595 ELSE
596 K1 = 2
597 END IF
598 *
599 IF( INFO.EQ.0 ) THEN
600 TRFCON = .FALSE.
601 *
602 * Compute residual of the computed solution.
603 *
604 CALL SLACPY( 'Full', N, NRHS, BSAV, LDB,
605 $ WORK, LDB )
606 CALL SGBT02( TRANS, N, N, KL, KU, NRHS,
607 $ ASAV, LDA, X, LDB, WORK, LDB,
608 $ RESULT( 2 ) )
609 *
610 * Check solution from generated exact
611 * solution.
612 *
613 IF( NOFACT .OR. ( PREFAC .AND.
614 $ LSAME( EQUED, 'N' ) ) ) THEN
615 CALL SGET04( N, NRHS, X, LDB, XACT,
616 $ LDB, RCONDC, RESULT( 3 ) )
617 ELSE
618 IF( ITRAN.EQ.1 ) THEN
619 ROLDC = ROLDO
620 ELSE
621 ROLDC = ROLDI
622 END IF
623 CALL SGET04( N, NRHS, X, LDB, XACT,
624 $ LDB, ROLDC, RESULT( 3 ) )
625 END IF
626 *
627 * Check the error bounds from iterative
628 * refinement.
629 *
630 CALL SGBT05( TRANS, N, KL, KU, NRHS, ASAV,
631 $ LDA, B, LDB, X, LDB, XACT,
632 $ LDB, RWORK, RWORK( NRHS+1 ),
633 $ RESULT( 4 ) )
634 ELSE
635 TRFCON = .TRUE.
636 END IF
637 *
638 * Compare RCOND from SGBSVX with the computed
639 * value in RCONDC.
640 *
641 RESULT( 6 ) = SGET06( RCOND, RCONDC )
642 *
643 * Print information about the tests that did
644 * not pass the threshold.
645 *
646 IF( .NOT.TRFCON ) THEN
647 DO 80 K = K1, NTESTS
648 IF( RESULT( K ).GE.THRESH ) THEN
649 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
650 $ CALL ALADHD( NOUT, PATH )
651 IF( PREFAC ) THEN
652 WRITE( NOUT, FMT = 9995 )
653 $ 'SGBSVX', FACT, TRANS, N, KL,
654 $ KU, EQUED, IMAT, K,
655 $ RESULT( K )
656 ELSE
657 WRITE( NOUT, FMT = 9996 )
658 $ 'SGBSVX', FACT, TRANS, N, KL,
659 $ KU, IMAT, K, RESULT( K )
660 END IF
661 NFAIL = NFAIL + 1
662 END IF
663 80 CONTINUE
664 NRUN = NRUN + 7 - K1
665 ELSE
666 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.
667 $ PREFAC ) THEN
668 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
669 $ CALL ALADHD( NOUT, PATH )
670 IF( PREFAC ) THEN
671 WRITE( NOUT, FMT = 9995 )'SGBSVX',
672 $ FACT, TRANS, N, KL, KU, EQUED,
673 $ IMAT, 1, RESULT( 1 )
674 ELSE
675 WRITE( NOUT, FMT = 9996 )'SGBSVX',
676 $ FACT, TRANS, N, KL, KU, IMAT, 1,
677 $ RESULT( 1 )
678 END IF
679 NFAIL = NFAIL + 1
680 NRUN = NRUN + 1
681 END IF
682 IF( RESULT( 6 ).GE.THRESH ) THEN
683 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
684 $ CALL ALADHD( NOUT, PATH )
685 IF( PREFAC ) THEN
686 WRITE( NOUT, FMT = 9995 )'SGBSVX',
687 $ FACT, TRANS, N, KL, KU, EQUED,
688 $ IMAT, 6, RESULT( 6 )
689 ELSE
690 WRITE( NOUT, FMT = 9996 )'SGBSVX',
691 $ FACT, TRANS, N, KL, KU, IMAT, 6,
692 $ RESULT( 6 )
693 END IF
694 NFAIL = NFAIL + 1
695 NRUN = NRUN + 1
696 END IF
697 IF( RESULT( 7 ).GE.THRESH ) THEN
698 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
699 $ CALL ALADHD( NOUT, PATH )
700 IF( PREFAC ) THEN
701 WRITE( NOUT, FMT = 9995 )'SGBSVX',
702 $ FACT, TRANS, N, KL, KU, EQUED,
703 $ IMAT, 7, RESULT( 7 )
704 ELSE
705 WRITE( NOUT, FMT = 9996 )'SGBSVX',
706 $ FACT, TRANS, N, KL, KU, IMAT, 7,
707 $ RESULT( 7 )
708 END IF
709 NFAIL = NFAIL + 1
710 NRUN = NRUN + 1
711 END IF
712 *
713 END IF
714 *
715 * --- Test SGBSVXX ---
716 *
717 * Restore the matrices A and B.
718 *
719 CALL SLACPY( 'Full', KL+KU+1, N, ASAV, LDA, A,
720 $ LDA )
721 CALL SLACPY( 'Full', N, NRHS, BSAV, LDB, B, LDB )
722
723 IF( .NOT.PREFAC )
724 $ CALL SLASET( 'Full', 2*KL+KU+1, N, ZERO, ZERO,
725 $ AFB, LDAFB )
726 CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDB )
727 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
728 *
729 * Equilibrate the matrix if FACT = 'F' and
730 * EQUED = 'R', 'C', or 'B'.
731 *
732 CALL SLAQGB( N, N, KL, KU, A, LDA, S,
733 $ S( N+1 ), ROWCND, COLCND, AMAX, EQUED )
734 END IF
735 *
736 * Solve the system and compute the condition number
737 * and error bounds using SGBSVXX.
738 *
739 SRNAMT = 'SGBSVXX'
740 N_ERR_BNDS = 3
741 CALL SGBSVXX( FACT, TRANS, N, KL, KU, NRHS, A, LDA,
742 $ AFB, LDAFB, IWORK, EQUED, S, S( N+1 ), B, LDB,
743 $ X, LDB, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
744 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
745 $ IWORK( N+1 ), INFO )
746
747 * Check the error code from SGBSVXX.
748 *
749 IF( INFO.EQ.N+1 ) GOTO 90
750 IF( INFO.NE.IZERO ) THEN
751 CALL ALAERH( PATH, 'SGBSVXX', INFO, IZERO,
752 $ FACT // TRANS, N, N, -1, -1, NRHS,
753 $ IMAT, NFAIL, NERRS, NOUT )
754 GOTO 90
755 END IF
756 *
757 * Compare rpvgrw_svxx from SGBSVXX with the computed
758 * reciprocal pivot growth factor RPVGRW
759 *
760
761 IF ( INFO .GT. 0 .AND. INFO .LT. N+1 ) THEN
762 RPVGRW = SLA_GBRPVGRW(N, KL, KU, INFO, A, LDA,
763 $ AFB, LDAFB )
764 ELSE
765 RPVGRW = SLA_GBRPVGRW(N, KL, KU, N, A, LDA,
766 $ AFB, LDAFB )
767 ENDIF
768
769 RESULT( 7 ) = ABS( RPVGRW-rpvgrw_svxx ) /
770 $ MAX( rpvgrw_svxx, RPVGRW ) /
771 $ SLAMCH( 'E' )
772 *
773 IF( .NOT.PREFAC ) THEN
774 *
775 * Reconstruct matrix from factors and compute
776 * residual.
777 *
778 CALL SGBT01( N, N, KL, KU, A, LDA, AFB, LDAFB,
779 $ IWORK, WORK,
780 $ RESULT( 1 ) )
781 K1 = 1
782 ELSE
783 K1 = 2
784 END IF
785 *
786 IF( INFO.EQ.0 ) THEN
787 TRFCON = .FALSE.
788 *
789 * Compute residual of the computed solution.
790 *
791 CALL SLACPY( 'Full', N, NRHS, BSAV, LDB, WORK,
792 $ LDB )
793 CALL SGBT02( TRANS, N, N, KL, KU, NRHS, ASAV,
794 $ LDA, X, LDB, WORK, LDB,
795 $ RESULT( 2 ) )
796 *
797 * Check solution from generated exact solution.
798 *
799 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
800 $ 'N' ) ) ) THEN
801 CALL SGET04( N, NRHS, X, LDB, XACT, LDB,
802 $ RCONDC, RESULT( 3 ) )
803 ELSE
804 IF( ITRAN.EQ.1 ) THEN
805 ROLDC = ROLDO
806 ELSE
807 ROLDC = ROLDI
808 END IF
809 CALL SGET04( N, NRHS, X, LDB, XACT, LDB,
810 $ ROLDC, RESULT( 3 ) )
811 END IF
812 ELSE
813 TRFCON = .TRUE.
814 END IF
815 *
816 * Compare RCOND from SGBSVXX with the computed value
817 * in RCONDC.
818 *
819 RESULT( 6 ) = SGET06( RCOND, RCONDC )
820 *
821 * Print information about the tests that did not pass
822 * the threshold.
823 *
824 IF( .NOT.TRFCON ) THEN
825 DO 45 K = K1, NTESTS
826 IF( RESULT( K ).GE.THRESH ) THEN
827 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
828 $ CALL ALADHD( NOUT, PATH )
829 IF( PREFAC ) THEN
830 WRITE( NOUT, FMT = 9995 )'SGBSVXX',
831 $ FACT, TRANS, N, KL, KU, EQUED,
832 $ IMAT, K, RESULT( K )
833 ELSE
834 WRITE( NOUT, FMT = 9996 )'SGBSVXX',
835 $ FACT, TRANS, N, KL, KU, IMAT, K,
836 $ RESULT( K )
837 END IF
838 NFAIL = NFAIL + 1
839 END IF
840 45 CONTINUE
841 NRUN = NRUN + 7 - K1
842 ELSE
843 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
844 $ THEN
845 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
846 $ CALL ALADHD( NOUT, PATH )
847 IF( PREFAC ) THEN
848 WRITE( NOUT, FMT = 9995 )'SGBSVXX', FACT,
849 $ TRANS, N, KL, KU, EQUED, IMAT, 1,
850 $ RESULT( 1 )
851 ELSE
852 WRITE( NOUT, FMT = 9996 )'SGBSVXX', FACT,
853 $ TRANS, N, KL, KU, IMAT, 1,
854 $ RESULT( 1 )
855 END IF
856 NFAIL = NFAIL + 1
857 NRUN = NRUN + 1
858 END IF
859 IF( RESULT( 6 ).GE.THRESH ) THEN
860 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
861 $ CALL ALADHD( NOUT, PATH )
862 IF( PREFAC ) THEN
863 WRITE( NOUT, FMT = 9995 )'SGBSVXX', FACT,
864 $ TRANS, N, KL, KU, EQUED, IMAT, 6,
865 $ RESULT( 6 )
866 ELSE
867 WRITE( NOUT, FMT = 9996 )'SGBSVXX', FACT,
868 $ TRANS, N, KL, KU, IMAT, 6,
869 $ RESULT( 6 )
870 END IF
871 NFAIL = NFAIL + 1
872 NRUN = NRUN + 1
873 END IF
874 IF( RESULT( 7 ).GE.THRESH ) THEN
875 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
876 $ CALL ALADHD( NOUT, PATH )
877 IF( PREFAC ) THEN
878 WRITE( NOUT, FMT = 9995 )'SGBSVXX', FACT,
879 $ TRANS, N, KL, KU, EQUED, IMAT, 7,
880 $ RESULT( 7 )
881 ELSE
882 WRITE( NOUT, FMT = 9996 )'SGBSVXX', FACT,
883 $ TRANS, N, KL, KU, IMAT, 7,
884 $ RESULT( 7 )
885 END IF
886 NFAIL = NFAIL + 1
887 NRUN = NRUN + 1
888 END IF
889
890 END IF
891 *
892 90 CONTINUE
893 100 CONTINUE
894 110 CONTINUE
895 120 CONTINUE
896 130 CONTINUE
897 140 CONTINUE
898 150 CONTINUE
899 *
900 * Print a summary of the results.
901 *
902 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
903 *
904
905 * Test Error Bounds from SGBSVXX
906
907 CALL SEBCHVXX(THRESH, PATH)
908
909 9999 FORMAT( ' *** In SDRVGB, LA=', I5, ' is too small for N=', I5,
910 $ ', KU=', I5, ', KL=', I5, / ' ==> Increase LA to at least ',
911 $ I5 )
912 9998 FORMAT( ' *** In SDRVGB, LAFB=', I5, ' is too small for N=', I5,
913 $ ', KU=', I5, ', KL=', I5, /
914 $ ' ==> Increase LAFB to at least ', I5 )
915 9997 FORMAT( 1X, A, ', N=', I5, ', KL=', I5, ', KU=', I5, ', type ',
916 $ I1, ', test(', I1, ')=', G12.5 )
917 9996 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
918 $ I5, ',...), type ', I1, ', test(', I1, ')=', G12.5 )
919 9995 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
920 $ I5, ',...), EQUED=''', A1, ''', type ', I1, ', test(', I1,
921 $ ')=', G12.5 )
922 *
923 RETURN
924 *
925 * End of SDRVGB
926 *
927 END