LAPACK  3.9.0
LAPACK: Linear Algebra PACKage
dchkgb.f
Go to the documentation of this file.
1 *> \brief \b DCHKGB
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 DCHKGB( 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 A( * ), AFAC( * ), B( * ), RWORK( * ),
25 * $ WORK( * ), X( * ), XACT( * )
26 * ..
27 *
28 *
29 *> \par Purpose:
30 * =============
31 *>
32 *> \verbatim
33 *>
34 *> DCHKGB tests DGBTRF, -TRS, -RFS, and -CON
35 *> \endverbatim
36 *
37 * Arguments:
38 * ==========
39 *
40 *> \param[in] DOTYPE
41 *> \verbatim
42 *> DOTYPE is LOGICAL array, dimension (NTYPES)
43 *> The matrix types to be used for testing. Matrices of type j
44 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
45 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
46 *> \endverbatim
47 *>
48 *> \param[in] NM
49 *> \verbatim
50 *> NM is INTEGER
51 *> The number of values of M contained in the vector MVAL.
52 *> \endverbatim
53 *>
54 *> \param[in] MVAL
55 *> \verbatim
56 *> MVAL is INTEGER array, dimension (NM)
57 *> The values of the matrix row dimension M.
58 *> \endverbatim
59 *>
60 *> \param[in] NN
61 *> \verbatim
62 *> NN is INTEGER
63 *> The number of values of N contained in the vector NVAL.
64 *> \endverbatim
65 *>
66 *> \param[in] NVAL
67 *> \verbatim
68 *> NVAL is INTEGER array, dimension (NN)
69 *> The values of the matrix column dimension N.
70 *> \endverbatim
71 *>
72 *> \param[in] NNB
73 *> \verbatim
74 *> NNB is INTEGER
75 *> The number of values of NB contained in the vector NBVAL.
76 *> \endverbatim
77 *>
78 *> \param[in] NBVAL
79 *> \verbatim
80 *> NBVAL is INTEGER array, dimension (NNB)
81 *> The values of the blocksize NB.
82 *> \endverbatim
83 *>
84 *> \param[in] NNS
85 *> \verbatim
86 *> NNS is INTEGER
87 *> The number of values of NRHS contained in the vector NSVAL.
88 *> \endverbatim
89 *>
90 *> \param[in] NSVAL
91 *> \verbatim
92 *> NSVAL is INTEGER array, dimension (NNS)
93 *> The values of the number of right hand sides NRHS.
94 *> \endverbatim
95 *>
96 *> \param[in] THRESH
97 *> \verbatim
98 *> THRESH is DOUBLE PRECISION
99 *> The threshold value for the test ratios. A result is
100 *> included in the output file if RESULT >= THRESH. To have
101 *> every test ratio printed, use THRESH = 0.
102 *> \endverbatim
103 *>
104 *> \param[in] TSTERR
105 *> \verbatim
106 *> TSTERR is LOGICAL
107 *> Flag that indicates whether error exits are to be tested.
108 *> \endverbatim
109 *>
110 *> \param[out] A
111 *> \verbatim
112 *> A is DOUBLE PRECISION array, dimension (LA)
113 *> \endverbatim
114 *>
115 *> \param[in] LA
116 *> \verbatim
117 *> LA is INTEGER
118 *> The length of the array A. LA >= (KLMAX+KUMAX+1)*NMAX
119 *> where KLMAX is the largest entry in the local array KLVAL,
120 *> KUMAX is the largest entry in the local array KUVAL and
121 *> NMAX is the largest entry in the input array NVAL.
122 *> \endverbatim
123 *>
124 *> \param[out] AFAC
125 *> \verbatim
126 *> AFAC is DOUBLE PRECISION array, dimension (LAFAC)
127 *> \endverbatim
128 *>
129 *> \param[in] LAFAC
130 *> \verbatim
131 *> LAFAC is INTEGER
132 *> The length of the array AFAC. LAFAC >= (2*KLMAX+KUMAX+1)*NMAX
133 *> where KLMAX is the largest entry in the local array KLVAL,
134 *> KUMAX is the largest entry in the local array KUVAL and
135 *> NMAX is the largest entry in the input array NVAL.
136 *> \endverbatim
137 *>
138 *> \param[out] B
139 *> \verbatim
140 *> B is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
141 *> where NSMAX is the largest entry in NSVAL.
142 *> \endverbatim
143 *>
144 *> \param[out] X
145 *> \verbatim
146 *> X is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
147 *> \endverbatim
148 *>
149 *> \param[out] XACT
150 *> \verbatim
151 *> XACT is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
152 *> \endverbatim
153 *>
154 *> \param[out] WORK
155 *> \verbatim
156 *> WORK is DOUBLE PRECISION 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 (2*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 December 2016
186 *
187 *> \ingroup double_lin
188 *
189 * =====================================================================
190  SUBROUTINE dchkgb( 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.7.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 * December 2016
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 A( * ), AFAC( * ), B( * ), RWORK( * ),
209  $ WORK( * ), X( * ), XACT( * )
210 * ..
211 *
212 * =====================================================================
213 *
214 * .. Parameters ..
215  DOUBLE PRECISION ONE, ZERO
216  PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
217  INTEGER NTYPES, NTESTS
218  parameter( ntypes = 8, ntests = 7 )
219  INTEGER NBW, NTRAN
220  parameter( nbw = 4, ntran = 3 )
221 * ..
222 * .. Local Scalars ..
223  LOGICAL TRFCON, ZEROT
224  CHARACTER DIST, NORM, TRANS, TYPE, XTYPE
225  CHARACTER*3 PATH
226  INTEGER I, I1, I2, IKL, IKU, IM, IMAT, IN, INB, INFO,
227  $ ioff, irhs, itran, izero, j, k, kl, koff, ku,
228  $ lda, ldafac, ldb, m, mode, n, nb, nerrs, nfail,
229  $ nimat, nkl, nku, nrhs, nrun
230  DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND,
231  $ RCONDC, RCONDI, RCONDO
232 * ..
233 * .. Local Arrays ..
234  CHARACTER TRANSS( NTRAN )
235  INTEGER ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ),
236  $ kuval( nbw )
237  DOUBLE PRECISION RESULT( NTESTS )
238 * ..
239 * .. External Functions ..
240  DOUBLE PRECISION DGET06, DLANGB, DLANGE
241  EXTERNAL DGET06, DLANGB, DLANGE
242 * ..
243 * .. External Subroutines ..
244  EXTERNAL alaerh, alahd, alasum, dcopy, derrge, dgbcon,
245  $ dgbrfs, dgbt01, dgbt02, dgbt05, dgbtrf, dgbtrs,
246  $ dget04, dlacpy, dlarhs, dlaset, dlatb4, dlatms,
247  $ xlaenv
248 * ..
249 * .. Intrinsic Functions ..
250  INTRINSIC max, min
251 * ..
252 * .. Scalars in Common ..
253  LOGICAL LERR, OK
254  CHARACTER*32 SRNAMT
255  INTEGER INFOT, NUNIT
256 * ..
257 * .. Common blocks ..
258  COMMON / infoc / infot, nunit, ok, lerr
259  COMMON / srnamc / srnamt
260 * ..
261 * .. Data statements ..
262  DATA iseedy / 1988, 1989, 1990, 1991 / ,
263  $ transs / 'N', 'T', 'C' /
264 * ..
265 * .. Executable Statements ..
266 *
267 * Initialize constants and the random number seed.
268 *
269  path( 1: 1 ) = 'Double precision'
270  path( 2: 3 ) = 'GB'
271  nrun = 0
272  nfail = 0
273  nerrs = 0
274  DO 10 i = 1, 4
275  iseed( i ) = iseedy( i )
276  10 CONTINUE
277 *
278 * Test the error exits
279 *
280  IF( tsterr )
281  $ CALL derrge( path, nout )
282  infot = 0
283  CALL xlaenv( 2, 2 )
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 DLATB4 and generate a
384 * test matrix with DLATMS.
385 *
386  CALL dlatb4( 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 = 'DLATMS'
394  CALL dlatms( 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 DLATMS.
399 *
400  IF( info.NE.0 ) THEN
401  CALL alaerh( path, 'DLATMS', 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 dcopy( 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 dcopy( 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 = DLANGB( 'O', N, KL, KU, A, LDA, RWORK )
454 * ANORMI = DLANGB( '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 dlacpy( 'Full', kl+ku+1, n, a, lda,
466  $ afac( kl+1 ), ldafac )
467  srnamt = 'DGBTRF'
468  CALL dgbtrf( m, n, kl, ku, afac, ldafac, iwork,
469  $ info )
470 *
471 * Check error code from DGBTRF.
472 *
473  IF( info.NE.izero )
474  $ CALL alaerh( path, 'DGBTRF', 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 dgbt01( 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 = dlangb( 'O', n, kl, ku, a, lda, rwork )
505  anormi = dlangb( '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 dlaset( 'Full', n, n, zero, one, work,
514  $ ldb )
515  srnamt = 'DGBTRS'
516  CALL dgbtrs( '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 = dlange( '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 = dlange( '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 = 'DLARHS'
572  CALL dlarhs( path, xtype, ' ', trans, n,
573  $ n, kl, ku, nrhs, a, lda,
574  $ xact, ldb, b, ldb, iseed,
575  $ info )
576  xtype = 'C'
577  CALL dlacpy( 'Full', n, nrhs, b, ldb, x,
578  $ ldb )
579 *
580  srnamt = 'DGBTRS'
581  CALL dgbtrs( trans, n, kl, ku, nrhs, afac,
582  $ ldafac, iwork, x, ldb, info )
583 *
584 * Check error code from DGBTRS.
585 *
586  IF( info.NE.0 )
587  $ CALL alaerh( path, 'DGBTRS', info, 0,
588  $ trans, n, n, kl, ku, -1,
589  $ imat, nfail, nerrs, nout )
590 *
591  CALL dlacpy( 'Full', n, nrhs, b, ldb,
592  $ work, ldb )
593  CALL dgbt02( 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 dget04( 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 = 'DGBRFS'
609  CALL dgbrfs( trans, n, kl, ku, nrhs, a,
610  $ lda, afac, ldafac, iwork, b,
611  $ ldb, x, ldb, rwork,
612  $ rwork( nrhs+1 ), work,
613  $ iwork( n+1 ), info )
614 *
615 * Check error code from DGBRFS.
616 *
617  IF( info.NE.0 )
618  $ CALL alaerh( path, 'DGBRFS', info, 0,
619  $ trans, n, n, kl, ku, nrhs,
620  $ imat, nfail, nerrs, nout )
621 *
622  CALL dget04( n, nrhs, x, ldb, xact, ldb,
623  $ rcondc, result( 4 ) )
624  CALL dgbt05( trans, n, kl, ku, nrhs, a,
625  $ lda, b, ldb, x, ldb, xact,
626  $ ldb, rwork, rwork( nrhs+1 ),
627  $ result( 5 ) )
628  DO 60 k = 2, 6
629  IF( result( k ).GE.thresh ) THEN
630  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
631  $ CALL alahd( nout, path )
632  WRITE( nout, fmt = 9996 )trans, n,
633  $ kl, ku, nrhs, imat, k,
634  $ result( k )
635  nfail = nfail + 1
636  END IF
637  60 CONTINUE
638  nrun = nrun + 5
639  70 CONTINUE
640  80 CONTINUE
641 *
642 *+ TEST 7:
643 * Get an estimate of RCOND = 1/CNDNUM.
644 *
645  90 CONTINUE
646  DO 100 itran = 1, 2
647  IF( itran.EQ.1 ) THEN
648  anorm = anormo
649  rcondc = rcondo
650  norm = 'O'
651  ELSE
652  anorm = anormi
653  rcondc = rcondi
654  norm = 'I'
655  END IF
656  srnamt = 'DGBCON'
657  CALL dgbcon( norm, n, kl, ku, afac, ldafac,
658  $ iwork, anorm, rcond, work,
659  $ iwork( n+1 ), info )
660 *
661 * Check error code from DGBCON.
662 *
663  IF( info.NE.0 )
664  $ CALL alaerh( path, 'DGBCON', info, 0,
665  $ norm, n, n, kl, ku, -1, imat,
666  $ nfail, nerrs, nout )
667 *
668  result( 7 ) = dget06( rcond, rcondc )
669 *
670 * Print information about the tests that did
671 * not pass the threshold.
672 *
673  IF( result( 7 ).GE.thresh ) THEN
674  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
675  $ CALL alahd( nout, path )
676  WRITE( nout, fmt = 9995 )norm, n, kl, ku,
677  $ imat, 7, result( 7 )
678  nfail = nfail + 1
679  END IF
680  nrun = nrun + 1
681  100 CONTINUE
682 *
683  110 CONTINUE
684  120 CONTINUE
685  130 CONTINUE
686  140 CONTINUE
687  150 CONTINUE
688  160 CONTINUE
689 *
690 * Print a summary of the results.
691 *
692  CALL alasum( path, nout, nfail, nrun, nerrs )
693 *
694  9999 FORMAT( ' *** In DCHKGB, LA=', i5, ' is too small for M=', i5,
695  $ ', N=', i5, ', KL=', i4, ', KU=', i4,
696  $ / ' ==> Increase LA to at least ', i5 )
697  9998 FORMAT( ' *** In DCHKGB, LAFAC=', i5, ' is too small for M=', i5,
698  $ ', N=', i5, ', KL=', i4, ', KU=', i4,
699  $ / ' ==> Increase LAFAC to at least ', i5 )
700  9997 FORMAT( ' M =', i5, ', N =', i5, ', KL=', i5, ', KU=', i5,
701  $ ', NB =', i4, ', type ', i1, ', test(', i1, ')=', g12.5 )
702  9996 FORMAT( ' TRANS=''', a1, ''', N=', i5, ', KL=', i5, ', KU=', i5,
703  $ ', NRHS=', i3, ', type ', i1, ', test(', i1, ')=', g12.5 )
704  9995 FORMAT( ' NORM =''', a1, ''', N=', i5, ', KL=', i5, ', KU=', i5,
705  $ ',', 10x, ' type ', i1, ', test(', i1, ')=', g12.5 )
706 *
707  RETURN
708 *
709 * End of DCHKGB
710 *
711  END
dlatms
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
dchkgb
subroutine dchkgb(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B, X, XACT, WORK, RWORK, IWORK, NOUT)
DCHKGB
Definition: dchkgb.f:193
dgbtrf
subroutine dgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTRF
Definition: dgbtrf.f:146
dgbt05
subroutine dgbt05(TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DGBT05
Definition: dgbt05.f:178
derrge
subroutine derrge(PATH, NUNIT)
DERRGE
Definition: derrge.f:57
dgbtrs
subroutine dgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBTRS
Definition: dgbtrs.f:140
dgbt01
subroutine dgbt01(M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
DGBT01
Definition: dgbt01.f:128
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:109
dgbrfs
subroutine dgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGBRFS
Definition: dgbrfs.f:207
dlarhs
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
Definition: dlarhs.f:206
dcopy
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
Definition: dcopy.f:84
dlatb4
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
Definition: dlatb4.f:122
dget04
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
Definition: dget04.f:104
dgbt02
subroutine dgbt02(TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
DGBT02
Definition: dgbt02.f:141
dgbcon
subroutine dgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGBCON
Definition: dgbcon.f:148
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
dlaset
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: dlaset.f:112
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
dlacpy
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105