1 SUBROUTINE ZDRVGB( 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.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER LA, LAFB, NN, NOUT, NRHS
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NVAL( * )
17 DOUBLE PRECISION RWORK( * ), S( * )
18 COMPLEX*16 A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ),
19 $ WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * ZDRVGB tests the driver routines ZGBSV and -SVX.
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 column dimension N.
40 *
41 * NRHS (input) INTEGER
42 * The number of right hand side vectors to be generated for
43 * each linear system.
44 *
45 * THRESH (input) DOUBLE PRECISION
46 * The threshold value for the test ratios. A result is
47 * included in the output file if RESULT >= THRESH. To have
48 * every test ratio printed, use THRESH = 0.
49 *
50 * TSTERR (input) LOGICAL
51 * Flag that indicates whether error exits are to be tested.
52 *
53 * A (workspace) COMPLEX*16 array, dimension (LA)
54 *
55 * LA (input) INTEGER
56 * The length of the array A. LA >= (2*NMAX-1)*NMAX
57 * where NMAX is the largest entry in NVAL.
58 *
59 * AFB (workspace) COMPLEX*16 array, dimension (LAFB)
60 *
61 * LAFB (input) INTEGER
62 * The length of the array AFB. LAFB >= (3*NMAX-2)*NMAX
63 * where NMAX is the largest entry in NVAL.
64 *
65 * ASAV (workspace) COMPLEX*16 array, dimension (LA)
66 *
67 * B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
68 *
69 * BSAV (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
70 *
71 * X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
72 *
73 * XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
74 *
75 * S (workspace) DOUBLE PRECISION array, dimension (2*NMAX)
76 *
77 * WORK (workspace) COMPLEX*16 array, dimension
78 * (NMAX*max(3,NRHS,NMAX))
79 *
80 * RWORK (workspace) DOUBLE PRECISION array, dimension
81 * (max(NMAX,2*NRHS))
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 DOUBLE PRECISION ONE, ZERO
92 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
93 INTEGER NTYPES
94 PARAMETER ( NTYPES = 8 )
95 INTEGER NTESTS
96 PARAMETER ( NTESTS = 7 )
97 INTEGER NTRAN
98 PARAMETER ( NTRAN = 3 )
99 * ..
100 * .. Local Scalars ..
101 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
102 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE
103 CHARACTER*3 PATH
104 INTEGER I, I1, I2, IEQUED, IFACT, IKL, IKU, IMAT, IN,
105 $ INFO, IOFF, ITRAN, IZERO, J, K, K1, KL, KU,
106 $ LDA, LDAFB, LDB, MODE, N, NB, NBMIN, NERRS,
107 $ NFACT, NFAIL, NIMAT, NKL, NKU, NRUN, NT
108 DOUBLE PRECISION AINVNM, AMAX, ANORM, ANORMI, ANORMO, ANRMPV,
109 $ CNDNUM, COLCND, RCOND, RCONDC, RCONDI, RCONDO,
110 $ ROLDC, ROLDI, ROLDO, ROWCND, RPVGRW
111 * ..
112 * .. Local Arrays ..
113 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
114 INTEGER ISEED( 4 ), ISEEDY( 4 )
115 DOUBLE PRECISION RDUM( 1 ), RESULT( NTESTS )
116 * ..
117 * .. External Functions ..
118 LOGICAL LSAME
119 DOUBLE PRECISION DGET06, DLAMCH, ZLANGB, ZLANGE, ZLANTB
120 EXTERNAL LSAME, DGET06, DLAMCH, ZLANGB, ZLANGE, ZLANTB
121 * ..
122 * .. External Subroutines ..
123 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGBEQU,
124 $ ZGBSV, ZGBSVX, ZGBT01, ZGBT02, ZGBT05, ZGBTRF,
125 $ ZGBTRS, ZGET04, ZLACPY, ZLAQGB, ZLARHS, ZLASET,
126 $ ZLATB4, ZLATMS
127 * ..
128 * .. Intrinsic Functions ..
129 INTRINSIC ABS, DCMPLX, MAX, MIN
130 * ..
131 * .. Scalars in Common ..
132 LOGICAL LERR, OK
133 CHARACTER*32 SRNAMT
134 INTEGER INFOT, NUNIT
135 * ..
136 * .. Common blocks ..
137 COMMON / INFOC / INFOT, NUNIT, OK, LERR
138 COMMON / SRNAMC / SRNAMT
139 * ..
140 * .. Data statements ..
141 DATA ISEEDY / 1988, 1989, 1990, 1991 /
142 DATA TRANSS / 'N', 'T', 'C' /
143 DATA FACTS / 'F', 'N', 'E' /
144 DATA EQUEDS / 'N', 'R', 'C', 'B' /
145 * ..
146 * .. Executable Statements ..
147 *
148 * Initialize constants and the random number seed.
149 *
150 PATH( 1: 1 ) = 'Zomplex precision'
151 PATH( 2: 3 ) = 'GB'
152 NRUN = 0
153 NFAIL = 0
154 NERRS = 0
155 DO 10 I = 1, 4
156 ISEED( I ) = ISEEDY( I )
157 10 CONTINUE
158 *
159 * Test the error exits
160 *
161 IF( TSTERR )
162 $ CALL ZERRVX( PATH, NOUT )
163 INFOT = 0
164 *
165 * Set the block size and minimum block size for testing.
166 *
167 NB = 1
168 NBMIN = 2
169 CALL XLAENV( 1, NB )
170 CALL XLAENV( 2, NBMIN )
171 *
172 * Do for each value of N in NVAL
173 *
174 DO 150 IN = 1, NN
175 N = NVAL( IN )
176 LDB = MAX( N, 1 )
177 XTYPE = 'N'
178 *
179 * Set limits on the number of loop iterations.
180 *
181 NKL = MAX( 1, MIN( N, 4 ) )
182 IF( N.EQ.0 )
183 $ NKL = 1
184 NKU = NKL
185 NIMAT = NTYPES
186 IF( N.LE.0 )
187 $ NIMAT = 1
188 *
189 DO 140 IKL = 1, NKL
190 *
191 * Do for KL = 0, N-1, (3N-1)/4, and (N+1)/4. This order makes
192 * it easier to skip redundant values for small values of N.
193 *
194 IF( IKL.EQ.1 ) THEN
195 KL = 0
196 ELSE IF( IKL.EQ.2 ) THEN
197 KL = MAX( N-1, 0 )
198 ELSE IF( IKL.EQ.3 ) THEN
199 KL = ( 3*N-1 ) / 4
200 ELSE IF( IKL.EQ.4 ) THEN
201 KL = ( N+1 ) / 4
202 END IF
203 DO 130 IKU = 1, NKU
204 *
205 * Do for KU = 0, N-1, (3N-1)/4, and (N+1)/4. This order
206 * makes it easier to skip redundant values for small
207 * values of N.
208 *
209 IF( IKU.EQ.1 ) THEN
210 KU = 0
211 ELSE IF( IKU.EQ.2 ) THEN
212 KU = MAX( N-1, 0 )
213 ELSE IF( IKU.EQ.3 ) THEN
214 KU = ( 3*N-1 ) / 4
215 ELSE IF( IKU.EQ.4 ) THEN
216 KU = ( N+1 ) / 4
217 END IF
218 *
219 * Check that A and AFB are big enough to generate this
220 * matrix.
221 *
222 LDA = KL + KU + 1
223 LDAFB = 2*KL + KU + 1
224 IF( LDA*N.GT.LA .OR. LDAFB*N.GT.LAFB ) THEN
225 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
226 $ CALL ALADHD( NOUT, PATH )
227 IF( LDA*N.GT.LA ) THEN
228 WRITE( NOUT, FMT = 9999 )LA, N, KL, KU,
229 $ N*( KL+KU+1 )
230 NERRS = NERRS + 1
231 END IF
232 IF( LDAFB*N.GT.LAFB ) THEN
233 WRITE( NOUT, FMT = 9998 )LAFB, N, KL, KU,
234 $ N*( 2*KL+KU+1 )
235 NERRS = NERRS + 1
236 END IF
237 GO TO 130
238 END IF
239 *
240 DO 120 IMAT = 1, NIMAT
241 *
242 * Do the tests only if DOTYPE( IMAT ) is true.
243 *
244 IF( .NOT.DOTYPE( IMAT ) )
245 $ GO TO 120
246 *
247 * Skip types 2, 3, or 4 if the matrix is too small.
248 *
249 ZEROT = IMAT.GE.2 .AND. IMAT.LE.4
250 IF( ZEROT .AND. N.LT.IMAT-1 )
251 $ GO TO 120
252 *
253 * Set up parameters with ZLATB4 and generate a
254 * test matrix with ZLATMS.
255 *
256 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
257 $ MODE, CNDNUM, DIST )
258 RCONDC = ONE / CNDNUM
259 *
260 SRNAMT = 'ZLATMS'
261 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
262 $ CNDNUM, ANORM, KL, KU, 'Z', A, LDA, WORK,
263 $ INFO )
264 *
265 * Check the error code from ZLATMS.
266 *
267 IF( INFO.NE.0 ) THEN
268 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N,
269 $ KL, KU, -1, IMAT, NFAIL, NERRS, NOUT )
270 GO TO 120
271 END IF
272 *
273 * For types 2, 3, and 4, zero one or more columns of
274 * the matrix to test that INFO is returned correctly.
275 *
276 IZERO = 0
277 IF( ZEROT ) THEN
278 IF( IMAT.EQ.2 ) THEN
279 IZERO = 1
280 ELSE IF( IMAT.EQ.3 ) THEN
281 IZERO = N
282 ELSE
283 IZERO = N / 2 + 1
284 END IF
285 IOFF = ( IZERO-1 )*LDA
286 IF( IMAT.LT.4 ) THEN
287 I1 = MAX( 1, KU+2-IZERO )
288 I2 = MIN( KL+KU+1, KU+1+( N-IZERO ) )
289 DO 20 I = I1, I2
290 A( IOFF+I ) = ZERO
291 20 CONTINUE
292 ELSE
293 DO 40 J = IZERO, N
294 DO 30 I = MAX( 1, KU+2-J ),
295 $ MIN( KL+KU+1, KU+1+( N-J ) )
296 A( IOFF+I ) = ZERO
297 30 CONTINUE
298 IOFF = IOFF + LDA
299 40 CONTINUE
300 END IF
301 END IF
302 *
303 * Save a copy of the matrix A in ASAV.
304 *
305 CALL ZLACPY( 'Full', KL+KU+1, N, A, LDA, ASAV, LDA )
306 *
307 DO 110 IEQUED = 1, 4
308 EQUED = EQUEDS( IEQUED )
309 IF( IEQUED.EQ.1 ) THEN
310 NFACT = 3
311 ELSE
312 NFACT = 1
313 END IF
314 *
315 DO 100 IFACT = 1, NFACT
316 FACT = FACTS( IFACT )
317 PREFAC = LSAME( FACT, 'F' )
318 NOFACT = LSAME( FACT, 'N' )
319 EQUIL = LSAME( FACT, 'E' )
320 *
321 IF( ZEROT ) THEN
322 IF( PREFAC )
323 $ GO TO 100
324 RCONDO = ZERO
325 RCONDI = ZERO
326 *
327 ELSE IF( .NOT.NOFACT ) THEN
328 *
329 * Compute the condition number for comparison
330 * with the value returned by DGESVX (FACT =
331 * 'N' reuses the condition number from the
332 * previous iteration with FACT = 'F').
333 *
334 CALL ZLACPY( 'Full', KL+KU+1, N, ASAV, LDA,
335 $ AFB( KL+1 ), LDAFB )
336 IF( EQUIL .OR. IEQUED.GT.1 ) THEN
337 *
338 * Compute row and column scale factors to
339 * equilibrate the matrix A.
340 *
341 CALL ZGBEQU( N, N, KL, KU, AFB( KL+1 ),
342 $ LDAFB, S, S( N+1 ), ROWCND,
343 $ COLCND, AMAX, INFO )
344 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
345 IF( LSAME( EQUED, 'R' ) ) THEN
346 ROWCND = ZERO
347 COLCND = ONE
348 ELSE IF( LSAME( EQUED, 'C' ) ) THEN
349 ROWCND = ONE
350 COLCND = ZERO
351 ELSE IF( LSAME( EQUED, 'B' ) ) THEN
352 ROWCND = ZERO
353 COLCND = ZERO
354 END IF
355 *
356 * Equilibrate the matrix.
357 *
358 CALL ZLAQGB( N, N, KL, KU, AFB( KL+1 ),
359 $ LDAFB, S, S( N+1 ),
360 $ ROWCND, COLCND, AMAX,
361 $ EQUED )
362 END IF
363 END IF
364 *
365 * Save the condition number of the
366 * non-equilibrated system for use in ZGET04.
367 *
368 IF( EQUIL ) THEN
369 ROLDO = RCONDO
370 ROLDI = RCONDI
371 END IF
372 *
373 * Compute the 1-norm and infinity-norm of A.
374 *
375 ANORMO = ZLANGB( '1', N, KL, KU, AFB( KL+1 ),
376 $ LDAFB, RWORK )
377 ANORMI = ZLANGB( 'I', N, KL, KU, AFB( KL+1 ),
378 $ LDAFB, RWORK )
379 *
380 * Factor the matrix A.
381 *
382 CALL ZGBTRF( N, N, KL, KU, AFB, LDAFB, IWORK,
383 $ INFO )
384 *
385 * Form the inverse of A.
386 *
387 CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ),
388 $ DCMPLX( ONE ), WORK, LDB )
389 SRNAMT = 'ZGBTRS'
390 CALL ZGBTRS( 'No transpose', N, KL, KU, N,
391 $ AFB, LDAFB, IWORK, WORK, LDB,
392 $ INFO )
393 *
394 * Compute the 1-norm condition number of A.
395 *
396 AINVNM = ZLANGE( '1', N, N, WORK, LDB,
397 $ RWORK )
398 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
399 RCONDO = ONE
400 ELSE
401 RCONDO = ( ONE / ANORMO ) / AINVNM
402 END IF
403 *
404 * Compute the infinity-norm condition number
405 * of A.
406 *
407 AINVNM = ZLANGE( 'I', N, N, WORK, LDB,
408 $ RWORK )
409 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
410 RCONDI = ONE
411 ELSE
412 RCONDI = ( ONE / ANORMI ) / AINVNM
413 END IF
414 END IF
415 *
416 DO 90 ITRAN = 1, NTRAN
417 *
418 * Do for each value of TRANS.
419 *
420 TRANS = TRANSS( ITRAN )
421 IF( ITRAN.EQ.1 ) THEN
422 RCONDC = RCONDO
423 ELSE
424 RCONDC = RCONDI
425 END IF
426 *
427 * Restore the matrix A.
428 *
429 CALL ZLACPY( 'Full', KL+KU+1, N, ASAV, LDA,
430 $ A, LDA )
431 *
432 * Form an exact solution and set the right hand
433 * side.
434 *
435 SRNAMT = 'ZLARHS'
436 CALL ZLARHS( PATH, XTYPE, 'Full', TRANS, N,
437 $ N, KL, KU, NRHS, A, LDA, XACT,
438 $ LDB, B, LDB, ISEED, INFO )
439 XTYPE = 'C'
440 CALL ZLACPY( 'Full', N, NRHS, B, LDB, BSAV,
441 $ LDB )
442 *
443 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
444 *
445 * --- Test ZGBSV ---
446 *
447 * Compute the LU factorization of the matrix
448 * and solve the system.
449 *
450 CALL ZLACPY( 'Full', KL+KU+1, N, A, LDA,
451 $ AFB( KL+1 ), LDAFB )
452 CALL ZLACPY( 'Full', N, NRHS, B, LDB, X,
453 $ LDB )
454 *
455 SRNAMT = 'ZGBSV '
456 CALL ZGBSV( N, KL, KU, NRHS, AFB, LDAFB,
457 $ IWORK, X, LDB, INFO )
458 *
459 * Check error code from ZGBSV .
460 *
461 IF( INFO.NE.IZERO )
462 $ CALL ALAERH( PATH, 'ZGBSV ', INFO,
463 $ IZERO, ' ', N, N, KL, KU,
464 $ NRHS, IMAT, NFAIL, NERRS,
465 $ NOUT )
466 *
467 * Reconstruct matrix from factors and
468 * compute residual.
469 *
470 CALL ZGBT01( N, N, KL, KU, A, LDA, AFB,
471 $ LDAFB, IWORK, WORK,
472 $ RESULT( 1 ) )
473 NT = 1
474 IF( IZERO.EQ.0 ) THEN
475 *
476 * Compute residual of the computed
477 * solution.
478 *
479 CALL ZLACPY( 'Full', N, NRHS, B, LDB,
480 $ WORK, LDB )
481 CALL ZGBT02( 'No transpose', N, N, KL,
482 $ KU, NRHS, A, LDA, X, LDB,
483 $ WORK, LDB, RESULT( 2 ) )
484 *
485 * Check solution from generated exact
486 * solution.
487 *
488 CALL ZGET04( N, NRHS, X, LDB, XACT,
489 $ LDB, RCONDC, RESULT( 3 ) )
490 NT = 3
491 END IF
492 *
493 * Print information about the tests that did
494 * not pass the threshold.
495 *
496 DO 50 K = 1, NT
497 IF( RESULT( K ).GE.THRESH ) THEN
498 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
499 $ CALL ALADHD( NOUT, PATH )
500 WRITE( NOUT, FMT = 9997 )'ZGBSV ',
501 $ N, KL, KU, IMAT, K, RESULT( K )
502 NFAIL = NFAIL + 1
503 END IF
504 50 CONTINUE
505 NRUN = NRUN + NT
506 END IF
507 *
508 * --- Test ZGBSVX ---
509 *
510 IF( .NOT.PREFAC )
511 $ CALL ZLASET( 'Full', 2*KL+KU+1, N,
512 $ DCMPLX( ZERO ),
513 $ DCMPLX( ZERO ), AFB, LDAFB )
514 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
515 $ DCMPLX( ZERO ), X, LDB )
516 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
517 *
518 * Equilibrate the matrix if FACT = 'F' and
519 * EQUED = 'R', 'C', or 'B'.
520 *
521 CALL ZLAQGB( N, N, KL, KU, A, LDA, S,
522 $ S( N+1 ), ROWCND, COLCND,
523 $ AMAX, EQUED )
524 END IF
525 *
526 * Solve the system and compute the condition
527 * number and error bounds using ZGBSVX.
528 *
529 SRNAMT = 'ZGBSVX'
530 CALL ZGBSVX( FACT, TRANS, N, KL, KU, NRHS, A,
531 $ LDA, AFB, LDAFB, IWORK, EQUED,
532 $ S, S( LDB+1 ), B, LDB, X, LDB,
533 $ RCOND, RWORK, RWORK( NRHS+1 ),
534 $ WORK, RWORK( 2*NRHS+1 ), INFO )
535 *
536 * Check the error code from ZGBSVX.
537 *
538 IF( INFO.NE.IZERO )
539 $ CALL ALAERH( PATH, 'ZGBSVX', INFO, IZERO,
540 $ FACT // TRANS, N, N, KL, KU,
541 $ NRHS, IMAT, NFAIL, NERRS,
542 $ NOUT )
543 * Compare RWORK(2*NRHS+1) from ZGBSVX with the
544 * computed reciprocal pivot growth RPVGRW
545 *
546 IF( INFO.NE.0 ) THEN
547 ANRMPV = ZERO
548 DO 70 J = 1, INFO
549 DO 60 I = MAX( KU+2-J, 1 ),
550 $ MIN( N+KU+1-J, KL+KU+1 )
551 ANRMPV = MAX( ANRMPV,
552 $ ABS( A( I+( J-1 )*LDA ) ) )
553 60 CONTINUE
554 70 CONTINUE
555 RPVGRW = ZLANTB( 'M', 'U', 'N', INFO,
556 $ MIN( INFO-1, KL+KU ),
557 $ AFB( MAX( 1, KL+KU+2-INFO ) ),
558 $ LDAFB, RDUM )
559 IF( RPVGRW.EQ.ZERO ) THEN
560 RPVGRW = ONE
561 ELSE
562 RPVGRW = ANRMPV / RPVGRW
563 END IF
564 ELSE
565 RPVGRW = ZLANTB( 'M', 'U', 'N', N, KL+KU,
566 $ AFB, LDAFB, RDUM )
567 IF( RPVGRW.EQ.ZERO ) THEN
568 RPVGRW = ONE
569 ELSE
570 RPVGRW = ZLANGB( 'M', N, KL, KU, A,
571 $ LDA, RDUM ) / RPVGRW
572 END IF
573 END IF
574 RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) )
575 $ / MAX( RWORK( 2*NRHS+1 ),
576 $ RPVGRW ) / DLAMCH( 'E' )
577 *
578 IF( .NOT.PREFAC ) THEN
579 *
580 * Reconstruct matrix from factors and
581 * compute residual.
582 *
583 CALL ZGBT01( N, N, KL, KU, A, LDA, AFB,
584 $ LDAFB, IWORK, WORK,
585 $ RESULT( 1 ) )
586 K1 = 1
587 ELSE
588 K1 = 2
589 END IF
590 *
591 IF( INFO.EQ.0 ) THEN
592 TRFCON = .FALSE.
593 *
594 * Compute residual of the computed solution.
595 *
596 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDB,
597 $ WORK, LDB )
598 CALL ZGBT02( TRANS, N, N, KL, KU, NRHS,
599 $ ASAV, LDA, X, LDB, WORK, LDB,
600 $ RESULT( 2 ) )
601 *
602 * Check solution from generated exact
603 * solution.
604 *
605 IF( NOFACT .OR. ( PREFAC .AND.
606 $ LSAME( EQUED, 'N' ) ) ) THEN
607 CALL ZGET04( N, NRHS, X, LDB, XACT,
608 $ LDB, RCONDC, RESULT( 3 ) )
609 ELSE
610 IF( ITRAN.EQ.1 ) THEN
611 ROLDC = ROLDO
612 ELSE
613 ROLDC = ROLDI
614 END IF
615 CALL ZGET04( N, NRHS, X, LDB, XACT,
616 $ LDB, ROLDC, RESULT( 3 ) )
617 END IF
618 *
619 * Check the error bounds from iterative
620 * refinement.
621 *
622 CALL ZGBT05( TRANS, N, KL, KU, NRHS, ASAV,
623 $ LDA, BSAV, LDB, X, LDB, XACT,
624 $ LDB, RWORK, RWORK( NRHS+1 ),
625 $ RESULT( 4 ) )
626 ELSE
627 TRFCON = .TRUE.
628 END IF
629 *
630 * Compare RCOND from ZGBSVX with the computed
631 * value in RCONDC.
632 *
633 RESULT( 6 ) = DGET06( RCOND, RCONDC )
634 *
635 * Print information about the tests that did
636 * not pass the threshold.
637 *
638 IF( .NOT.TRFCON ) THEN
639 DO 80 K = K1, NTESTS
640 IF( RESULT( K ).GE.THRESH ) THEN
641 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
642 $ CALL ALADHD( NOUT, PATH )
643 IF( PREFAC ) THEN
644 WRITE( NOUT, FMT = 9995 )
645 $ 'ZGBSVX', FACT, TRANS, N, KL,
646 $ KU, EQUED, IMAT, K,
647 $ RESULT( K )
648 ELSE
649 WRITE( NOUT, FMT = 9996 )
650 $ 'ZGBSVX', FACT, TRANS, N, KL,
651 $ KU, IMAT, K, RESULT( K )
652 END IF
653 NFAIL = NFAIL + 1
654 END IF
655 80 CONTINUE
656 NRUN = NRUN + 7 - K1
657 ELSE
658 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.
659 $ PREFAC ) THEN
660 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
661 $ CALL ALADHD( NOUT, PATH )
662 IF( PREFAC ) THEN
663 WRITE( NOUT, FMT = 9995 )'ZGBSVX',
664 $ FACT, TRANS, N, KL, KU, EQUED,
665 $ IMAT, 1, RESULT( 1 )
666 ELSE
667 WRITE( NOUT, FMT = 9996 )'ZGBSVX',
668 $ FACT, TRANS, N, KL, KU, IMAT, 1,
669 $ RESULT( 1 )
670 END IF
671 NFAIL = NFAIL + 1
672 NRUN = NRUN + 1
673 END IF
674 IF( RESULT( 6 ).GE.THRESH ) THEN
675 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
676 $ CALL ALADHD( NOUT, PATH )
677 IF( PREFAC ) THEN
678 WRITE( NOUT, FMT = 9995 )'ZGBSVX',
679 $ FACT, TRANS, N, KL, KU, EQUED,
680 $ IMAT, 6, RESULT( 6 )
681 ELSE
682 WRITE( NOUT, FMT = 9996 )'ZGBSVX',
683 $ FACT, TRANS, N, KL, KU, IMAT, 6,
684 $ RESULT( 6 )
685 END IF
686 NFAIL = NFAIL + 1
687 NRUN = NRUN + 1
688 END IF
689 IF( RESULT( 7 ).GE.THRESH ) THEN
690 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
691 $ CALL ALADHD( NOUT, PATH )
692 IF( PREFAC ) THEN
693 WRITE( NOUT, FMT = 9995 )'ZGBSVX',
694 $ FACT, TRANS, N, KL, KU, EQUED,
695 $ IMAT, 7, RESULT( 7 )
696 ELSE
697 WRITE( NOUT, FMT = 9996 )'ZGBSVX',
698 $ FACT, TRANS, N, KL, KU, IMAT, 7,
699 $ RESULT( 7 )
700 END IF
701 NFAIL = NFAIL + 1
702 NRUN = NRUN + 1
703 END IF
704 END IF
705 90 CONTINUE
706 100 CONTINUE
707 110 CONTINUE
708 120 CONTINUE
709 130 CONTINUE
710 140 CONTINUE
711 150 CONTINUE
712 *
713 * Print a summary of the results.
714 *
715 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
716 *
717 9999 FORMAT( ' *** In ZDRVGB, LA=', I5, ' is too small for N=', I5,
718 $ ', KU=', I5, ', KL=', I5, / ' ==> Increase LA to at least ',
719 $ I5 )
720 9998 FORMAT( ' *** In ZDRVGB, LAFB=', I5, ' is too small for N=', I5,
721 $ ', KU=', I5, ', KL=', I5, /
722 $ ' ==> Increase LAFB to at least ', I5 )
723 9997 FORMAT( 1X, A, ', N=', I5, ', KL=', I5, ', KU=', I5, ', type ',
724 $ I1, ', test(', I1, ')=', G12.5 )
725 9996 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
726 $ I5, ',...), type ', I1, ', test(', I1, ')=', G12.5 )
727 9995 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
728 $ I5, ',...), EQUED=''', A1, ''', type ', I1, ', test(', I1,
729 $ ')=', G12.5 )
730 *
731 RETURN
732 *
733 * End of ZDRVGB
734 *
735 END
2 $ AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK,
3 $ 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 LA, LAFB, NN, NOUT, NRHS
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NVAL( * )
17 DOUBLE PRECISION RWORK( * ), S( * )
18 COMPLEX*16 A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ),
19 $ WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * ZDRVGB tests the driver routines ZGBSV and -SVX.
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 column dimension N.
40 *
41 * NRHS (input) INTEGER
42 * The number of right hand side vectors to be generated for
43 * each linear system.
44 *
45 * THRESH (input) DOUBLE PRECISION
46 * The threshold value for the test ratios. A result is
47 * included in the output file if RESULT >= THRESH. To have
48 * every test ratio printed, use THRESH = 0.
49 *
50 * TSTERR (input) LOGICAL
51 * Flag that indicates whether error exits are to be tested.
52 *
53 * A (workspace) COMPLEX*16 array, dimension (LA)
54 *
55 * LA (input) INTEGER
56 * The length of the array A. LA >= (2*NMAX-1)*NMAX
57 * where NMAX is the largest entry in NVAL.
58 *
59 * AFB (workspace) COMPLEX*16 array, dimension (LAFB)
60 *
61 * LAFB (input) INTEGER
62 * The length of the array AFB. LAFB >= (3*NMAX-2)*NMAX
63 * where NMAX is the largest entry in NVAL.
64 *
65 * ASAV (workspace) COMPLEX*16 array, dimension (LA)
66 *
67 * B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
68 *
69 * BSAV (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
70 *
71 * X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
72 *
73 * XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
74 *
75 * S (workspace) DOUBLE PRECISION array, dimension (2*NMAX)
76 *
77 * WORK (workspace) COMPLEX*16 array, dimension
78 * (NMAX*max(3,NRHS,NMAX))
79 *
80 * RWORK (workspace) DOUBLE PRECISION array, dimension
81 * (max(NMAX,2*NRHS))
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 DOUBLE PRECISION ONE, ZERO
92 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
93 INTEGER NTYPES
94 PARAMETER ( NTYPES = 8 )
95 INTEGER NTESTS
96 PARAMETER ( NTESTS = 7 )
97 INTEGER NTRAN
98 PARAMETER ( NTRAN = 3 )
99 * ..
100 * .. Local Scalars ..
101 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
102 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE
103 CHARACTER*3 PATH
104 INTEGER I, I1, I2, IEQUED, IFACT, IKL, IKU, IMAT, IN,
105 $ INFO, IOFF, ITRAN, IZERO, J, K, K1, KL, KU,
106 $ LDA, LDAFB, LDB, MODE, N, NB, NBMIN, NERRS,
107 $ NFACT, NFAIL, NIMAT, NKL, NKU, NRUN, NT
108 DOUBLE PRECISION AINVNM, AMAX, ANORM, ANORMI, ANORMO, ANRMPV,
109 $ CNDNUM, COLCND, RCOND, RCONDC, RCONDI, RCONDO,
110 $ ROLDC, ROLDI, ROLDO, ROWCND, RPVGRW
111 * ..
112 * .. Local Arrays ..
113 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
114 INTEGER ISEED( 4 ), ISEEDY( 4 )
115 DOUBLE PRECISION RDUM( 1 ), RESULT( NTESTS )
116 * ..
117 * .. External Functions ..
118 LOGICAL LSAME
119 DOUBLE PRECISION DGET06, DLAMCH, ZLANGB, ZLANGE, ZLANTB
120 EXTERNAL LSAME, DGET06, DLAMCH, ZLANGB, ZLANGE, ZLANTB
121 * ..
122 * .. External Subroutines ..
123 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGBEQU,
124 $ ZGBSV, ZGBSVX, ZGBT01, ZGBT02, ZGBT05, ZGBTRF,
125 $ ZGBTRS, ZGET04, ZLACPY, ZLAQGB, ZLARHS, ZLASET,
126 $ ZLATB4, ZLATMS
127 * ..
128 * .. Intrinsic Functions ..
129 INTRINSIC ABS, DCMPLX, MAX, MIN
130 * ..
131 * .. Scalars in Common ..
132 LOGICAL LERR, OK
133 CHARACTER*32 SRNAMT
134 INTEGER INFOT, NUNIT
135 * ..
136 * .. Common blocks ..
137 COMMON / INFOC / INFOT, NUNIT, OK, LERR
138 COMMON / SRNAMC / SRNAMT
139 * ..
140 * .. Data statements ..
141 DATA ISEEDY / 1988, 1989, 1990, 1991 /
142 DATA TRANSS / 'N', 'T', 'C' /
143 DATA FACTS / 'F', 'N', 'E' /
144 DATA EQUEDS / 'N', 'R', 'C', 'B' /
145 * ..
146 * .. Executable Statements ..
147 *
148 * Initialize constants and the random number seed.
149 *
150 PATH( 1: 1 ) = 'Zomplex precision'
151 PATH( 2: 3 ) = 'GB'
152 NRUN = 0
153 NFAIL = 0
154 NERRS = 0
155 DO 10 I = 1, 4
156 ISEED( I ) = ISEEDY( I )
157 10 CONTINUE
158 *
159 * Test the error exits
160 *
161 IF( TSTERR )
162 $ CALL ZERRVX( PATH, NOUT )
163 INFOT = 0
164 *
165 * Set the block size and minimum block size for testing.
166 *
167 NB = 1
168 NBMIN = 2
169 CALL XLAENV( 1, NB )
170 CALL XLAENV( 2, NBMIN )
171 *
172 * Do for each value of N in NVAL
173 *
174 DO 150 IN = 1, NN
175 N = NVAL( IN )
176 LDB = MAX( N, 1 )
177 XTYPE = 'N'
178 *
179 * Set limits on the number of loop iterations.
180 *
181 NKL = MAX( 1, MIN( N, 4 ) )
182 IF( N.EQ.0 )
183 $ NKL = 1
184 NKU = NKL
185 NIMAT = NTYPES
186 IF( N.LE.0 )
187 $ NIMAT = 1
188 *
189 DO 140 IKL = 1, NKL
190 *
191 * Do for KL = 0, N-1, (3N-1)/4, and (N+1)/4. This order makes
192 * it easier to skip redundant values for small values of N.
193 *
194 IF( IKL.EQ.1 ) THEN
195 KL = 0
196 ELSE IF( IKL.EQ.2 ) THEN
197 KL = MAX( N-1, 0 )
198 ELSE IF( IKL.EQ.3 ) THEN
199 KL = ( 3*N-1 ) / 4
200 ELSE IF( IKL.EQ.4 ) THEN
201 KL = ( N+1 ) / 4
202 END IF
203 DO 130 IKU = 1, NKU
204 *
205 * Do for KU = 0, N-1, (3N-1)/4, and (N+1)/4. This order
206 * makes it easier to skip redundant values for small
207 * values of N.
208 *
209 IF( IKU.EQ.1 ) THEN
210 KU = 0
211 ELSE IF( IKU.EQ.2 ) THEN
212 KU = MAX( N-1, 0 )
213 ELSE IF( IKU.EQ.3 ) THEN
214 KU = ( 3*N-1 ) / 4
215 ELSE IF( IKU.EQ.4 ) THEN
216 KU = ( N+1 ) / 4
217 END IF
218 *
219 * Check that A and AFB are big enough to generate this
220 * matrix.
221 *
222 LDA = KL + KU + 1
223 LDAFB = 2*KL + KU + 1
224 IF( LDA*N.GT.LA .OR. LDAFB*N.GT.LAFB ) THEN
225 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
226 $ CALL ALADHD( NOUT, PATH )
227 IF( LDA*N.GT.LA ) THEN
228 WRITE( NOUT, FMT = 9999 )LA, N, KL, KU,
229 $ N*( KL+KU+1 )
230 NERRS = NERRS + 1
231 END IF
232 IF( LDAFB*N.GT.LAFB ) THEN
233 WRITE( NOUT, FMT = 9998 )LAFB, N, KL, KU,
234 $ N*( 2*KL+KU+1 )
235 NERRS = NERRS + 1
236 END IF
237 GO TO 130
238 END IF
239 *
240 DO 120 IMAT = 1, NIMAT
241 *
242 * Do the tests only if DOTYPE( IMAT ) is true.
243 *
244 IF( .NOT.DOTYPE( IMAT ) )
245 $ GO TO 120
246 *
247 * Skip types 2, 3, or 4 if the matrix is too small.
248 *
249 ZEROT = IMAT.GE.2 .AND. IMAT.LE.4
250 IF( ZEROT .AND. N.LT.IMAT-1 )
251 $ GO TO 120
252 *
253 * Set up parameters with ZLATB4 and generate a
254 * test matrix with ZLATMS.
255 *
256 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
257 $ MODE, CNDNUM, DIST )
258 RCONDC = ONE / CNDNUM
259 *
260 SRNAMT = 'ZLATMS'
261 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
262 $ CNDNUM, ANORM, KL, KU, 'Z', A, LDA, WORK,
263 $ INFO )
264 *
265 * Check the error code from ZLATMS.
266 *
267 IF( INFO.NE.0 ) THEN
268 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N,
269 $ KL, KU, -1, IMAT, NFAIL, NERRS, NOUT )
270 GO TO 120
271 END IF
272 *
273 * For types 2, 3, and 4, zero one or more columns of
274 * the matrix to test that INFO is returned correctly.
275 *
276 IZERO = 0
277 IF( ZEROT ) THEN
278 IF( IMAT.EQ.2 ) THEN
279 IZERO = 1
280 ELSE IF( IMAT.EQ.3 ) THEN
281 IZERO = N
282 ELSE
283 IZERO = N / 2 + 1
284 END IF
285 IOFF = ( IZERO-1 )*LDA
286 IF( IMAT.LT.4 ) THEN
287 I1 = MAX( 1, KU+2-IZERO )
288 I2 = MIN( KL+KU+1, KU+1+( N-IZERO ) )
289 DO 20 I = I1, I2
290 A( IOFF+I ) = ZERO
291 20 CONTINUE
292 ELSE
293 DO 40 J = IZERO, N
294 DO 30 I = MAX( 1, KU+2-J ),
295 $ MIN( KL+KU+1, KU+1+( N-J ) )
296 A( IOFF+I ) = ZERO
297 30 CONTINUE
298 IOFF = IOFF + LDA
299 40 CONTINUE
300 END IF
301 END IF
302 *
303 * Save a copy of the matrix A in ASAV.
304 *
305 CALL ZLACPY( 'Full', KL+KU+1, N, A, LDA, ASAV, LDA )
306 *
307 DO 110 IEQUED = 1, 4
308 EQUED = EQUEDS( IEQUED )
309 IF( IEQUED.EQ.1 ) THEN
310 NFACT = 3
311 ELSE
312 NFACT = 1
313 END IF
314 *
315 DO 100 IFACT = 1, NFACT
316 FACT = FACTS( IFACT )
317 PREFAC = LSAME( FACT, 'F' )
318 NOFACT = LSAME( FACT, 'N' )
319 EQUIL = LSAME( FACT, 'E' )
320 *
321 IF( ZEROT ) THEN
322 IF( PREFAC )
323 $ GO TO 100
324 RCONDO = ZERO
325 RCONDI = ZERO
326 *
327 ELSE IF( .NOT.NOFACT ) THEN
328 *
329 * Compute the condition number for comparison
330 * with the value returned by DGESVX (FACT =
331 * 'N' reuses the condition number from the
332 * previous iteration with FACT = 'F').
333 *
334 CALL ZLACPY( 'Full', KL+KU+1, N, ASAV, LDA,
335 $ AFB( KL+1 ), LDAFB )
336 IF( EQUIL .OR. IEQUED.GT.1 ) THEN
337 *
338 * Compute row and column scale factors to
339 * equilibrate the matrix A.
340 *
341 CALL ZGBEQU( N, N, KL, KU, AFB( KL+1 ),
342 $ LDAFB, S, S( N+1 ), ROWCND,
343 $ COLCND, AMAX, INFO )
344 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
345 IF( LSAME( EQUED, 'R' ) ) THEN
346 ROWCND = ZERO
347 COLCND = ONE
348 ELSE IF( LSAME( EQUED, 'C' ) ) THEN
349 ROWCND = ONE
350 COLCND = ZERO
351 ELSE IF( LSAME( EQUED, 'B' ) ) THEN
352 ROWCND = ZERO
353 COLCND = ZERO
354 END IF
355 *
356 * Equilibrate the matrix.
357 *
358 CALL ZLAQGB( N, N, KL, KU, AFB( KL+1 ),
359 $ LDAFB, S, S( N+1 ),
360 $ ROWCND, COLCND, AMAX,
361 $ EQUED )
362 END IF
363 END IF
364 *
365 * Save the condition number of the
366 * non-equilibrated system for use in ZGET04.
367 *
368 IF( EQUIL ) THEN
369 ROLDO = RCONDO
370 ROLDI = RCONDI
371 END IF
372 *
373 * Compute the 1-norm and infinity-norm of A.
374 *
375 ANORMO = ZLANGB( '1', N, KL, KU, AFB( KL+1 ),
376 $ LDAFB, RWORK )
377 ANORMI = ZLANGB( 'I', N, KL, KU, AFB( KL+1 ),
378 $ LDAFB, RWORK )
379 *
380 * Factor the matrix A.
381 *
382 CALL ZGBTRF( N, N, KL, KU, AFB, LDAFB, IWORK,
383 $ INFO )
384 *
385 * Form the inverse of A.
386 *
387 CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ),
388 $ DCMPLX( ONE ), WORK, LDB )
389 SRNAMT = 'ZGBTRS'
390 CALL ZGBTRS( 'No transpose', N, KL, KU, N,
391 $ AFB, LDAFB, IWORK, WORK, LDB,
392 $ INFO )
393 *
394 * Compute the 1-norm condition number of A.
395 *
396 AINVNM = ZLANGE( '1', N, N, WORK, LDB,
397 $ RWORK )
398 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
399 RCONDO = ONE
400 ELSE
401 RCONDO = ( ONE / ANORMO ) / AINVNM
402 END IF
403 *
404 * Compute the infinity-norm condition number
405 * of A.
406 *
407 AINVNM = ZLANGE( 'I', N, N, WORK, LDB,
408 $ RWORK )
409 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
410 RCONDI = ONE
411 ELSE
412 RCONDI = ( ONE / ANORMI ) / AINVNM
413 END IF
414 END IF
415 *
416 DO 90 ITRAN = 1, NTRAN
417 *
418 * Do for each value of TRANS.
419 *
420 TRANS = TRANSS( ITRAN )
421 IF( ITRAN.EQ.1 ) THEN
422 RCONDC = RCONDO
423 ELSE
424 RCONDC = RCONDI
425 END IF
426 *
427 * Restore the matrix A.
428 *
429 CALL ZLACPY( 'Full', KL+KU+1, N, ASAV, LDA,
430 $ A, LDA )
431 *
432 * Form an exact solution and set the right hand
433 * side.
434 *
435 SRNAMT = 'ZLARHS'
436 CALL ZLARHS( PATH, XTYPE, 'Full', TRANS, N,
437 $ N, KL, KU, NRHS, A, LDA, XACT,
438 $ LDB, B, LDB, ISEED, INFO )
439 XTYPE = 'C'
440 CALL ZLACPY( 'Full', N, NRHS, B, LDB, BSAV,
441 $ LDB )
442 *
443 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
444 *
445 * --- Test ZGBSV ---
446 *
447 * Compute the LU factorization of the matrix
448 * and solve the system.
449 *
450 CALL ZLACPY( 'Full', KL+KU+1, N, A, LDA,
451 $ AFB( KL+1 ), LDAFB )
452 CALL ZLACPY( 'Full', N, NRHS, B, LDB, X,
453 $ LDB )
454 *
455 SRNAMT = 'ZGBSV '
456 CALL ZGBSV( N, KL, KU, NRHS, AFB, LDAFB,
457 $ IWORK, X, LDB, INFO )
458 *
459 * Check error code from ZGBSV .
460 *
461 IF( INFO.NE.IZERO )
462 $ CALL ALAERH( PATH, 'ZGBSV ', INFO,
463 $ IZERO, ' ', N, N, KL, KU,
464 $ NRHS, IMAT, NFAIL, NERRS,
465 $ NOUT )
466 *
467 * Reconstruct matrix from factors and
468 * compute residual.
469 *
470 CALL ZGBT01( N, N, KL, KU, A, LDA, AFB,
471 $ LDAFB, IWORK, WORK,
472 $ RESULT( 1 ) )
473 NT = 1
474 IF( IZERO.EQ.0 ) THEN
475 *
476 * Compute residual of the computed
477 * solution.
478 *
479 CALL ZLACPY( 'Full', N, NRHS, B, LDB,
480 $ WORK, LDB )
481 CALL ZGBT02( 'No transpose', N, N, KL,
482 $ KU, NRHS, A, LDA, X, LDB,
483 $ WORK, LDB, RESULT( 2 ) )
484 *
485 * Check solution from generated exact
486 * solution.
487 *
488 CALL ZGET04( N, NRHS, X, LDB, XACT,
489 $ LDB, RCONDC, RESULT( 3 ) )
490 NT = 3
491 END IF
492 *
493 * Print information about the tests that did
494 * not pass the threshold.
495 *
496 DO 50 K = 1, NT
497 IF( RESULT( K ).GE.THRESH ) THEN
498 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
499 $ CALL ALADHD( NOUT, PATH )
500 WRITE( NOUT, FMT = 9997 )'ZGBSV ',
501 $ N, KL, KU, IMAT, K, RESULT( K )
502 NFAIL = NFAIL + 1
503 END IF
504 50 CONTINUE
505 NRUN = NRUN + NT
506 END IF
507 *
508 * --- Test ZGBSVX ---
509 *
510 IF( .NOT.PREFAC )
511 $ CALL ZLASET( 'Full', 2*KL+KU+1, N,
512 $ DCMPLX( ZERO ),
513 $ DCMPLX( ZERO ), AFB, LDAFB )
514 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
515 $ DCMPLX( ZERO ), X, LDB )
516 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
517 *
518 * Equilibrate the matrix if FACT = 'F' and
519 * EQUED = 'R', 'C', or 'B'.
520 *
521 CALL ZLAQGB( N, N, KL, KU, A, LDA, S,
522 $ S( N+1 ), ROWCND, COLCND,
523 $ AMAX, EQUED )
524 END IF
525 *
526 * Solve the system and compute the condition
527 * number and error bounds using ZGBSVX.
528 *
529 SRNAMT = 'ZGBSVX'
530 CALL ZGBSVX( FACT, TRANS, N, KL, KU, NRHS, A,
531 $ LDA, AFB, LDAFB, IWORK, EQUED,
532 $ S, S( LDB+1 ), B, LDB, X, LDB,
533 $ RCOND, RWORK, RWORK( NRHS+1 ),
534 $ WORK, RWORK( 2*NRHS+1 ), INFO )
535 *
536 * Check the error code from ZGBSVX.
537 *
538 IF( INFO.NE.IZERO )
539 $ CALL ALAERH( PATH, 'ZGBSVX', INFO, IZERO,
540 $ FACT // TRANS, N, N, KL, KU,
541 $ NRHS, IMAT, NFAIL, NERRS,
542 $ NOUT )
543 * Compare RWORK(2*NRHS+1) from ZGBSVX with the
544 * computed reciprocal pivot growth RPVGRW
545 *
546 IF( INFO.NE.0 ) THEN
547 ANRMPV = ZERO
548 DO 70 J = 1, INFO
549 DO 60 I = MAX( KU+2-J, 1 ),
550 $ MIN( N+KU+1-J, KL+KU+1 )
551 ANRMPV = MAX( ANRMPV,
552 $ ABS( A( I+( J-1 )*LDA ) ) )
553 60 CONTINUE
554 70 CONTINUE
555 RPVGRW = ZLANTB( 'M', 'U', 'N', INFO,
556 $ MIN( INFO-1, KL+KU ),
557 $ AFB( MAX( 1, KL+KU+2-INFO ) ),
558 $ LDAFB, RDUM )
559 IF( RPVGRW.EQ.ZERO ) THEN
560 RPVGRW = ONE
561 ELSE
562 RPVGRW = ANRMPV / RPVGRW
563 END IF
564 ELSE
565 RPVGRW = ZLANTB( 'M', 'U', 'N', N, KL+KU,
566 $ AFB, LDAFB, RDUM )
567 IF( RPVGRW.EQ.ZERO ) THEN
568 RPVGRW = ONE
569 ELSE
570 RPVGRW = ZLANGB( 'M', N, KL, KU, A,
571 $ LDA, RDUM ) / RPVGRW
572 END IF
573 END IF
574 RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) )
575 $ / MAX( RWORK( 2*NRHS+1 ),
576 $ RPVGRW ) / DLAMCH( 'E' )
577 *
578 IF( .NOT.PREFAC ) THEN
579 *
580 * Reconstruct matrix from factors and
581 * compute residual.
582 *
583 CALL ZGBT01( N, N, KL, KU, A, LDA, AFB,
584 $ LDAFB, IWORK, WORK,
585 $ RESULT( 1 ) )
586 K1 = 1
587 ELSE
588 K1 = 2
589 END IF
590 *
591 IF( INFO.EQ.0 ) THEN
592 TRFCON = .FALSE.
593 *
594 * Compute residual of the computed solution.
595 *
596 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDB,
597 $ WORK, LDB )
598 CALL ZGBT02( TRANS, N, N, KL, KU, NRHS,
599 $ ASAV, LDA, X, LDB, WORK, LDB,
600 $ RESULT( 2 ) )
601 *
602 * Check solution from generated exact
603 * solution.
604 *
605 IF( NOFACT .OR. ( PREFAC .AND.
606 $ LSAME( EQUED, 'N' ) ) ) THEN
607 CALL ZGET04( N, NRHS, X, LDB, XACT,
608 $ LDB, RCONDC, RESULT( 3 ) )
609 ELSE
610 IF( ITRAN.EQ.1 ) THEN
611 ROLDC = ROLDO
612 ELSE
613 ROLDC = ROLDI
614 END IF
615 CALL ZGET04( N, NRHS, X, LDB, XACT,
616 $ LDB, ROLDC, RESULT( 3 ) )
617 END IF
618 *
619 * Check the error bounds from iterative
620 * refinement.
621 *
622 CALL ZGBT05( TRANS, N, KL, KU, NRHS, ASAV,
623 $ LDA, BSAV, LDB, X, LDB, XACT,
624 $ LDB, RWORK, RWORK( NRHS+1 ),
625 $ RESULT( 4 ) )
626 ELSE
627 TRFCON = .TRUE.
628 END IF
629 *
630 * Compare RCOND from ZGBSVX with the computed
631 * value in RCONDC.
632 *
633 RESULT( 6 ) = DGET06( RCOND, RCONDC )
634 *
635 * Print information about the tests that did
636 * not pass the threshold.
637 *
638 IF( .NOT.TRFCON ) THEN
639 DO 80 K = K1, NTESTS
640 IF( RESULT( K ).GE.THRESH ) THEN
641 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
642 $ CALL ALADHD( NOUT, PATH )
643 IF( PREFAC ) THEN
644 WRITE( NOUT, FMT = 9995 )
645 $ 'ZGBSVX', FACT, TRANS, N, KL,
646 $ KU, EQUED, IMAT, K,
647 $ RESULT( K )
648 ELSE
649 WRITE( NOUT, FMT = 9996 )
650 $ 'ZGBSVX', FACT, TRANS, N, KL,
651 $ KU, IMAT, K, RESULT( K )
652 END IF
653 NFAIL = NFAIL + 1
654 END IF
655 80 CONTINUE
656 NRUN = NRUN + 7 - K1
657 ELSE
658 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.
659 $ PREFAC ) THEN
660 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
661 $ CALL ALADHD( NOUT, PATH )
662 IF( PREFAC ) THEN
663 WRITE( NOUT, FMT = 9995 )'ZGBSVX',
664 $ FACT, TRANS, N, KL, KU, EQUED,
665 $ IMAT, 1, RESULT( 1 )
666 ELSE
667 WRITE( NOUT, FMT = 9996 )'ZGBSVX',
668 $ FACT, TRANS, N, KL, KU, IMAT, 1,
669 $ RESULT( 1 )
670 END IF
671 NFAIL = NFAIL + 1
672 NRUN = NRUN + 1
673 END IF
674 IF( RESULT( 6 ).GE.THRESH ) THEN
675 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
676 $ CALL ALADHD( NOUT, PATH )
677 IF( PREFAC ) THEN
678 WRITE( NOUT, FMT = 9995 )'ZGBSVX',
679 $ FACT, TRANS, N, KL, KU, EQUED,
680 $ IMAT, 6, RESULT( 6 )
681 ELSE
682 WRITE( NOUT, FMT = 9996 )'ZGBSVX',
683 $ FACT, TRANS, N, KL, KU, IMAT, 6,
684 $ RESULT( 6 )
685 END IF
686 NFAIL = NFAIL + 1
687 NRUN = NRUN + 1
688 END IF
689 IF( RESULT( 7 ).GE.THRESH ) THEN
690 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
691 $ CALL ALADHD( NOUT, PATH )
692 IF( PREFAC ) THEN
693 WRITE( NOUT, FMT = 9995 )'ZGBSVX',
694 $ FACT, TRANS, N, KL, KU, EQUED,
695 $ IMAT, 7, RESULT( 7 )
696 ELSE
697 WRITE( NOUT, FMT = 9996 )'ZGBSVX',
698 $ FACT, TRANS, N, KL, KU, IMAT, 7,
699 $ RESULT( 7 )
700 END IF
701 NFAIL = NFAIL + 1
702 NRUN = NRUN + 1
703 END IF
704 END IF
705 90 CONTINUE
706 100 CONTINUE
707 110 CONTINUE
708 120 CONTINUE
709 130 CONTINUE
710 140 CONTINUE
711 150 CONTINUE
712 *
713 * Print a summary of the results.
714 *
715 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
716 *
717 9999 FORMAT( ' *** In ZDRVGB, LA=', I5, ' is too small for N=', I5,
718 $ ', KU=', I5, ', KL=', I5, / ' ==> Increase LA to at least ',
719 $ I5 )
720 9998 FORMAT( ' *** In ZDRVGB, LAFB=', I5, ' is too small for N=', I5,
721 $ ', KU=', I5, ', KL=', I5, /
722 $ ' ==> Increase LAFB to at least ', I5 )
723 9997 FORMAT( 1X, A, ', N=', I5, ', KL=', I5, ', KU=', I5, ', type ',
724 $ I1, ', test(', I1, ')=', G12.5 )
725 9996 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
726 $ I5, ',...), type ', I1, ', test(', I1, ')=', G12.5 )
727 9995 FORMAT( 1X, A, '( ''', A1, ''',''', A1, ''',', I5, ',', I5, ',',
728 $ I5, ',...), EQUED=''', A1, ''', type ', I1, ', test(', I1,
729 $ ')=', G12.5 )
730 *
731 RETURN
732 *
733 * End of ZDRVGB
734 *
735 END