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