LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ ddrvgb()

subroutine ddrvgb ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NRHS,
double precision  THRESH,
logical  TSTERR,
double precision, dimension( * )  A,
integer  LA,
double precision, dimension( * )  AFB,
integer  LAFB,
double precision, dimension( * )  ASAV,
double precision, dimension( * )  B,
double precision, dimension( * )  BSAV,
double precision, dimension( * )  X,
double precision, dimension( * )  XACT,
double precision, dimension( * )  S,
double precision, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

DDRVGB

DDRVGBX

Purpose:
 DDRVGB tests the driver routines DGBSV and -SVX.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NRHS
          NRHS is INTEGER
          The number of right hand side vectors to be generated for
          each linear system.
[in]THRESH
          THRESH is DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[out]A
          A is DOUBLE PRECISION array, dimension (LA)
[in]LA
          LA is INTEGER
          The length of the array A.  LA >= (2*NMAX-1)*NMAX
          where NMAX is the largest entry in NVAL.
[out]AFB
          AFB is DOUBLE PRECISION array, dimension (LAFB)
[in]LAFB
          LAFB is INTEGER
          The length of the array AFB.  LAFB >= (3*NMAX-2)*NMAX
          where NMAX is the largest entry in NVAL.
[out]ASAV
          ASAV is DOUBLE PRECISION array, dimension (LA)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]BSAV
          BSAV is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]S
          S is DOUBLE PRECISION array, dimension (2*NMAX)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension
                      (NMAX*max(3,NRHS,NMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension
                      (NMAX+2*NRHS)
[out]IWORK
          IWORK is INTEGER array, dimension (2*NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Purpose:
 DDRVGB tests the driver routines DGBSV, -SVX, and -SVXX.

 Note that this file is used only when the XBLAS are available,
 otherwise ddrvgb.f defines this subroutine.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NRHS
          NRHS is INTEGER
          The number of right hand side vectors to be generated for
          each linear system.
[in]THRESH
          THRESH is DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[out]A
          A is DOUBLE PRECISION array, dimension (LA)
[in]LA
          LA is INTEGER
          The length of the array A.  LA >= (2*NMAX-1)*NMAX
          where NMAX is the largest entry in NVAL.
[out]AFB
          AFB is DOUBLE PRECISION array, dimension (LAFB)
[in]LAFB
          LAFB is INTEGER
          The length of the array AFB.  LAFB >= (3*NMAX-2)*NMAX
          where NMAX is the largest entry in NVAL.
[out]ASAV
          ASAV is DOUBLE PRECISION array, dimension (LA)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]BSAV
          BSAV is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]S
          S is DOUBLE PRECISION array, dimension (2*NMAX)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension
                      (NMAX*max(3,NRHS,NMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension
                      (max(2*NMAX,NMAX+2*NRHS))
[out]IWORK
          IWORK is INTEGER array, dimension (2*NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 169 of file ddrvgb.f.

172 *
173 * -- LAPACK test routine --
174 * -- LAPACK is a software package provided by Univ. of Tennessee, --
175 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
176 *
177 * .. Scalar Arguments ..
178  LOGICAL TSTERR
179  INTEGER LA, LAFB, NN, NOUT, NRHS
180  DOUBLE PRECISION THRESH
181 * ..
182 * .. Array Arguments ..
183  LOGICAL DOTYPE( * )
184  INTEGER IWORK( * ), NVAL( * )
185  DOUBLE PRECISION A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ),
186  $ RWORK( * ), S( * ), WORK( * ), X( * ),
187  $ XACT( * )
188 * ..
189 *
190 * =====================================================================
191 *
192 * .. Parameters ..
193  DOUBLE PRECISION ONE, ZERO
194  parameter( one = 1.0d+0, zero = 0.0d+0 )
195  INTEGER NTYPES
196  parameter( ntypes = 8 )
197  INTEGER NTESTS
198  parameter( ntests = 7 )
199  INTEGER NTRAN
200  parameter( ntran = 3 )
201 * ..
202 * .. Local Scalars ..
203  LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
204  CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE
205  CHARACTER*3 PATH
206  INTEGER I, I1, I2, IEQUED, IFACT, IKL, IKU, IMAT, IN,
207  $ INFO, IOFF, ITRAN, IZERO, J, K, K1, KL, KU,
208  $ LDA, LDAFB, LDB, MODE, N, NB, NBMIN, NERRS,
209  $ NFACT, NFAIL, NIMAT, NKL, NKU, NRUN, NT
210  DOUBLE PRECISION AINVNM, AMAX, ANORM, ANORMI, ANORMO, ANRMPV,
211  $ CNDNUM, COLCND, RCOND, RCONDC, RCONDI, RCONDO,
212  $ ROLDC, ROLDI, ROLDO, ROWCND, RPVGRW
213 * ..
214 * .. Local Arrays ..
215  CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
216  INTEGER ISEED( 4 ), ISEEDY( 4 )
217  DOUBLE PRECISION RESULT( NTESTS )
218 * ..
219 * .. External Functions ..
220  LOGICAL LSAME
221  DOUBLE PRECISION DGET06, DLAMCH, DLANGB, DLANGE, DLANTB
222  EXTERNAL lsame, dget06, dlamch, dlangb, dlange, dlantb
223 * ..
224 * .. External Subroutines ..
225  EXTERNAL aladhd, alaerh, alasvm, derrvx, dgbequ, dgbsv,
228  $ dlatms, xlaenv
229 * ..
230 * .. Intrinsic Functions ..
231  INTRINSIC abs, max, min
232 * ..
233 * .. Scalars in Common ..
234  LOGICAL LERR, OK
235  CHARACTER*32 SRNAMT
236  INTEGER INFOT, NUNIT
237 * ..
238 * .. Common blocks ..
239  COMMON / infoc / infot, nunit, ok, lerr
240  COMMON / srnamc / srnamt
241 * ..
242 * .. Data statements ..
243  DATA iseedy / 1988, 1989, 1990, 1991 /
244  DATA transs / 'N', 'T', 'C' /
245  DATA facts / 'F', 'N', 'E' /
246  DATA equeds / 'N', 'R', 'C', 'B' /
247 * ..
248 * .. Executable Statements ..
249 *
250 * Initialize constants and the random number seed.
251 *
252  path( 1: 1 ) = 'Double precision'
253  path( 2: 3 ) = 'GB'
254  nrun = 0
255  nfail = 0
256  nerrs = 0
257  DO 10 i = 1, 4
258  iseed( i ) = iseedy( i )
259  10 CONTINUE
260 *
261 * Test the error exits
262 *
263  IF( tsterr )
264  $ CALL derrvx( path, nout )
265  infot = 0
266 *
267 * Set the block size and minimum block size for testing.
268 *
269  nb = 1
270  nbmin = 2
271  CALL xlaenv( 1, nb )
272  CALL xlaenv( 2, nbmin )
273 *
274 * Do for each value of N in NVAL
275 *
276  DO 150 in = 1, nn
277  n = nval( in )
278  ldb = max( n, 1 )
279  xtype = 'N'
280 *
281 * Set limits on the number of loop iterations.
282 *
283  nkl = max( 1, min( n, 4 ) )
284  IF( n.EQ.0 )
285  $ nkl = 1
286  nku = nkl
287  nimat = ntypes
288  IF( n.LE.0 )
289  $ nimat = 1
290 *
291  DO 140 ikl = 1, nkl
292 *
293 * Do for KL = 0, N-1, (3N-1)/4, and (N+1)/4. This order makes
294 * it easier to skip redundant values for small values of N.
295 *
296  IF( ikl.EQ.1 ) THEN
297  kl = 0
298  ELSE IF( ikl.EQ.2 ) THEN
299  kl = max( n-1, 0 )
300  ELSE IF( ikl.EQ.3 ) THEN
301  kl = ( 3*n-1 ) / 4
302  ELSE IF( ikl.EQ.4 ) THEN
303  kl = ( n+1 ) / 4
304  END IF
305  DO 130 iku = 1, nku
306 *
307 * Do for KU = 0, N-1, (3N-1)/4, and (N+1)/4. This order
308 * makes it easier to skip redundant values for small
309 * values of N.
310 *
311  IF( iku.EQ.1 ) THEN
312  ku = 0
313  ELSE IF( iku.EQ.2 ) THEN
314  ku = max( n-1, 0 )
315  ELSE IF( iku.EQ.3 ) THEN
316  ku = ( 3*n-1 ) / 4
317  ELSE IF( iku.EQ.4 ) THEN
318  ku = ( n+1 ) / 4
319  END IF
320 *
321 * Check that A and AFB are big enough to generate this
322 * matrix.
323 *
324  lda = kl + ku + 1
325  ldafb = 2*kl + ku + 1
326  IF( lda*n.GT.la .OR. ldafb*n.GT.lafb ) THEN
327  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
328  $ CALL aladhd( nout, path )
329  IF( lda*n.GT.la ) THEN
330  WRITE( nout, fmt = 9999 )la, n, kl, ku,
331  $ n*( kl+ku+1 )
332  nerrs = nerrs + 1
333  END IF
334  IF( ldafb*n.GT.lafb ) THEN
335  WRITE( nout, fmt = 9998 )lafb, n, kl, ku,
336  $ n*( 2*kl+ku+1 )
337  nerrs = nerrs + 1
338  END IF
339  GO TO 130
340  END IF
341 *
342  DO 120 imat = 1, nimat
343 *
344 * Do the tests only if DOTYPE( IMAT ) is true.
345 *
346  IF( .NOT.dotype( imat ) )
347  $ GO TO 120
348 *
349 * Skip types 2, 3, or 4 if the matrix is too small.
350 *
351  zerot = imat.GE.2 .AND. imat.LE.4
352  IF( zerot .AND. n.LT.imat-1 )
353  $ GO TO 120
354 *
355 * Set up parameters with DLATB4 and generate a
356 * test matrix with DLATMS.
357 *
358  CALL dlatb4( path, imat, n, n, TYPE, KL, KU, ANORM,
359  $ MODE, CNDNUM, DIST )
360  rcondc = one / cndnum
361 *
362  srnamt = 'DLATMS'
363  CALL dlatms( n, n, dist, iseed, TYPE, RWORK, MODE,
364  $ CNDNUM, ANORM, KL, KU, 'Z', A, LDA, WORK,
365  $ INFO )
366 *
367 * Check the error code from DLATMS.
368 *
369  IF( info.NE.0 ) THEN
370  CALL alaerh( path, 'DLATMS', info, 0, ' ', n, n,
371  $ kl, ku, -1, imat, nfail, nerrs, nout )
372  GO TO 120
373  END IF
374 *
375 * For types 2, 3, and 4, zero one or more columns of
376 * the matrix to test that INFO is returned correctly.
377 *
378  izero = 0
379  IF( zerot ) THEN
380  IF( imat.EQ.2 ) THEN
381  izero = 1
382  ELSE IF( imat.EQ.3 ) THEN
383  izero = n
384  ELSE
385  izero = n / 2 + 1
386  END IF
387  ioff = ( izero-1 )*lda
388  IF( imat.LT.4 ) THEN
389  i1 = max( 1, ku+2-izero )
390  i2 = min( kl+ku+1, ku+1+( n-izero ) )
391  DO 20 i = i1, i2
392  a( ioff+i ) = zero
393  20 CONTINUE
394  ELSE
395  DO 40 j = izero, n
396  DO 30 i = max( 1, ku+2-j ),
397  $ min( kl+ku+1, ku+1+( n-j ) )
398  a( ioff+i ) = zero
399  30 CONTINUE
400  ioff = ioff + lda
401  40 CONTINUE
402  END IF
403  END IF
404 *
405 * Save a copy of the matrix A in ASAV.
406 *
407  CALL dlacpy( 'Full', kl+ku+1, n, a, lda, asav, lda )
408 *
409  DO 110 iequed = 1, 4
410  equed = equeds( iequed )
411  IF( iequed.EQ.1 ) THEN
412  nfact = 3
413  ELSE
414  nfact = 1
415  END IF
416 *
417  DO 100 ifact = 1, nfact
418  fact = facts( ifact )
419  prefac = lsame( fact, 'F' )
420  nofact = lsame( fact, 'N' )
421  equil = lsame( fact, 'E' )
422 *
423  IF( zerot ) THEN
424  IF( prefac )
425  $ GO TO 100
426  rcondo = zero
427  rcondi = zero
428 *
429  ELSE IF( .NOT.nofact ) THEN
430 *
431 * Compute the condition number for comparison
432 * with the value returned by DGESVX (FACT =
433 * 'N' reuses the condition number from the
434 * previous iteration with FACT = 'F').
435 *
436  CALL dlacpy( 'Full', kl+ku+1, n, asav, lda,
437  $ afb( kl+1 ), ldafb )
438  IF( equil .OR. iequed.GT.1 ) THEN
439 *
440 * Compute row and column scale factors to
441 * equilibrate the matrix A.
442 *
443  CALL dgbequ( n, n, kl, ku, afb( kl+1 ),
444  $ ldafb, s, s( n+1 ), rowcnd,
445  $ colcnd, amax, info )
446  IF( info.EQ.0 .AND. n.GT.0 ) THEN
447  IF( lsame( equed, 'R' ) ) THEN
448  rowcnd = zero
449  colcnd = one
450  ELSE IF( lsame( equed, 'C' ) ) THEN
451  rowcnd = one
452  colcnd = zero
453  ELSE IF( lsame( equed, 'B' ) ) THEN
454  rowcnd = zero
455  colcnd = zero
456  END IF
457 *
458 * Equilibrate the matrix.
459 *
460  CALL dlaqgb( n, n, kl, ku, afb( kl+1 ),
461  $ ldafb, s, s( n+1 ),
462  $ rowcnd, colcnd, amax,
463  $ equed )
464  END IF
465  END IF
466 *
467 * Save the condition number of the
468 * non-equilibrated system for use in DGET04.
469 *
470  IF( equil ) THEN
471  roldo = rcondo
472  roldi = rcondi
473  END IF
474 *
475 * Compute the 1-norm and infinity-norm of A.
476 *
477  anormo = dlangb( '1', n, kl, ku, afb( kl+1 ),
478  $ ldafb, rwork )
479  anormi = dlangb( 'I', n, kl, ku, afb( kl+1 ),
480  $ ldafb, rwork )
481 *
482 * Factor the matrix A.
483 *
484  CALL dgbtrf( n, n, kl, ku, afb, ldafb, iwork,
485  $ info )
486 *
487 * Form the inverse of A.
488 *
489  CALL dlaset( 'Full', n, n, zero, one, work,
490  $ ldb )
491  srnamt = 'DGBTRS'
492  CALL dgbtrs( 'No transpose', n, kl, ku, n,
493  $ afb, ldafb, iwork, work, ldb,
494  $ info )
495 *
496 * Compute the 1-norm condition number of A.
497 *
498  ainvnm = dlange( '1', n, n, work, ldb,
499  $ rwork )
500  IF( anormo.LE.zero .OR. ainvnm.LE.zero ) THEN
501  rcondo = one
502  ELSE
503  rcondo = ( one / anormo ) / ainvnm
504  END IF
505 *
506 * Compute the infinity-norm condition number
507 * of A.
508 *
509  ainvnm = dlange( 'I', n, n, work, ldb,
510  $ rwork )
511  IF( anormi.LE.zero .OR. ainvnm.LE.zero ) THEN
512  rcondi = one
513  ELSE
514  rcondi = ( one / anormi ) / ainvnm
515  END IF
516  END IF
517 *
518  DO 90 itran = 1, ntran
519 *
520 * Do for each value of TRANS.
521 *
522  trans = transs( itran )
523  IF( itran.EQ.1 ) THEN
524  rcondc = rcondo
525  ELSE
526  rcondc = rcondi
527  END IF
528 *
529 * Restore the matrix A.
530 *
531  CALL dlacpy( 'Full', kl+ku+1, n, asav, lda,
532  $ a, lda )
533 *
534 * Form an exact solution and set the right hand
535 * side.
536 *
537  srnamt = 'DLARHS'
538  CALL dlarhs( path, xtype, 'Full', trans, n,
539  $ n, kl, ku, nrhs, a, lda, xact,
540  $ ldb, b, ldb, iseed, info )
541  xtype = 'C'
542  CALL dlacpy( 'Full', n, nrhs, b, ldb, bsav,
543  $ ldb )
544 *
545  IF( nofact .AND. itran.EQ.1 ) THEN
546 *
547 * --- Test DGBSV ---
548 *
549 * Compute the LU factorization of the matrix
550 * and solve the system.
551 *
552  CALL dlacpy( 'Full', kl+ku+1, n, a, lda,
553  $ afb( kl+1 ), ldafb )
554  CALL dlacpy( 'Full', n, nrhs, b, ldb, x,
555  $ ldb )
556 *
557  srnamt = 'DGBSV '
558  CALL dgbsv( n, kl, ku, nrhs, afb, ldafb,
559  $ iwork, x, ldb, info )
560 *
561 * Check error code from DGBSV .
562 *
563  IF( info.NE.izero )
564  $ CALL alaerh( path, 'DGBSV ', info,
565  $ izero, ' ', n, n, kl, ku,
566  $ nrhs, imat, nfail, nerrs,
567  $ nout )
568 *
569 * Reconstruct matrix from factors and
570 * compute residual.
571 *
572  CALL dgbt01( n, n, kl, ku, a, lda, afb,
573  $ ldafb, iwork, work,
574  $ result( 1 ) )
575  nt = 1
576  IF( izero.EQ.0 ) THEN
577 *
578 * Compute residual of the computed
579 * solution.
580 *
581  CALL dlacpy( 'Full', n, nrhs, b, ldb,
582  $ work, ldb )
583  CALL dgbt02( 'No transpose', n, n, kl,
584  $ ku, nrhs, a, lda, x, ldb,
585  $ work, ldb, rwork,
586  $ result( 2 ) )
587 *
588 * Check solution from generated exact
589 * solution.
590 *
591  CALL dget04( n, nrhs, x, ldb, xact,
592  $ ldb, rcondc, result( 3 ) )
593  nt = 3
594  END IF
595 *
596 * Print information about the tests that did
597 * not pass the threshold.
598 *
599  DO 50 k = 1, nt
600  IF( result( k ).GE.thresh ) THEN
601  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
602  $ CALL aladhd( nout, path )
603  WRITE( nout, fmt = 9997 )'DGBSV ',
604  $ n, kl, ku, imat, k, result( k )
605  nfail = nfail + 1
606  END IF
607  50 CONTINUE
608  nrun = nrun + nt
609  END IF
610 *
611 * --- Test DGBSVX ---
612 *
613  IF( .NOT.prefac )
614  $ CALL dlaset( 'Full', 2*kl+ku+1, n, zero,
615  $ zero, afb, ldafb )
616  CALL dlaset( 'Full', n, nrhs, zero, zero, x,
617  $ ldb )
618  IF( iequed.GT.1 .AND. n.GT.0 ) THEN
619 *
620 * Equilibrate the matrix if FACT = 'F' and
621 * EQUED = 'R', 'C', or 'B'.
622 *
623  CALL dlaqgb( n, n, kl, ku, a, lda, s,
624  $ s( n+1 ), rowcnd, colcnd,
625  $ amax, equed )
626  END IF
627 *
628 * Solve the system and compute the condition
629 * number and error bounds using DGBSVX.
630 *
631  srnamt = 'DGBSVX'
632  CALL dgbsvx( fact, trans, n, kl, ku, nrhs, a,
633  $ lda, afb, ldafb, iwork, equed,
634  $ s, s( n+1 ), b, ldb, x, ldb,
635  $ rcond, rwork, rwork( nrhs+1 ),
636  $ work, iwork( n+1 ), info )
637 *
638 * Check the error code from DGBSVX.
639 *
640  IF( info.NE.izero )
641  $ CALL alaerh( path, 'DGBSVX', info, izero,
642  $ fact // trans, n, n, kl, ku,
643  $ nrhs, imat, nfail, nerrs,
644  $ nout )
645 *
646 * Compare WORK(1) from DGBSVX with the computed
647 * reciprocal pivot growth factor RPVGRW
648 *
649  IF( info.NE.0 .AND. info.LE.n) THEN
650  anrmpv = zero
651  DO 70 j = 1, info
652  DO 60 i = max( ku+2-j, 1 ),
653  $ min( n+ku+1-j, kl+ku+1 )
654  anrmpv = max( anrmpv,
655  $ abs( a( i+( j-1 )*lda ) ) )
656  60 CONTINUE
657  70 CONTINUE
658  rpvgrw = dlantb( 'M', 'U', 'N', info,
659  $ min( info-1, kl+ku ),
660  $ afb( max( 1, kl+ku+2-info ) ),
661  $ ldafb, work )
662  IF( rpvgrw.EQ.zero ) THEN
663  rpvgrw = one
664  ELSE
665  rpvgrw = anrmpv / rpvgrw
666  END IF
667  ELSE
668  rpvgrw = dlantb( 'M', 'U', 'N', n, kl+ku,
669  $ afb, ldafb, work )
670  IF( rpvgrw.EQ.zero ) THEN
671  rpvgrw = one
672  ELSE
673  rpvgrw = dlangb( 'M', n, kl, ku, a,
674  $ lda, work ) / rpvgrw
675  END IF
676  END IF
677  result( 7 ) = abs( rpvgrw-work( 1 ) ) /
678  $ max( work( 1 ), rpvgrw ) /
679  $ dlamch( 'E' )
680 *
681  IF( .NOT.prefac ) THEN
682 *
683 * Reconstruct matrix from factors and
684 * compute residual.
685 *
686  CALL dgbt01( n, n, kl, ku, a, lda, afb,
687  $ ldafb, iwork, work,
688  $ result( 1 ) )
689  k1 = 1
690  ELSE
691  k1 = 2
692  END IF
693 *
694  IF( info.EQ.0 ) THEN
695  trfcon = .false.
696 *
697 * Compute residual of the computed solution.
698 *
699  CALL dlacpy( 'Full', n, nrhs, bsav, ldb,
700  $ work, ldb )
701  CALL dgbt02( trans, n, n, kl, ku, nrhs,
702  $ asav, lda, x, ldb, work, ldb,
703  $ rwork( 2*nrhs+1 ),
704  $ result( 2 ) )
705 *
706 * Check solution from generated exact
707 * solution.
708 *
709  IF( nofact .OR. ( prefac .AND.
710  $ lsame( equed, 'N' ) ) ) THEN
711  CALL dget04( n, nrhs, x, ldb, xact,
712  $ ldb, rcondc, result( 3 ) )
713  ELSE
714  IF( itran.EQ.1 ) THEN
715  roldc = roldo
716  ELSE
717  roldc = roldi
718  END IF
719  CALL dget04( n, nrhs, x, ldb, xact,
720  $ ldb, roldc, result( 3 ) )
721  END IF
722 *
723 * Check the error bounds from iterative
724 * refinement.
725 *
726  CALL dgbt05( trans, n, kl, ku, nrhs, asav,
727  $ lda, b, ldb, x, ldb, xact,
728  $ ldb, rwork, rwork( nrhs+1 ),
729  $ result( 4 ) )
730  ELSE
731  trfcon = .true.
732  END IF
733 *
734 * Compare RCOND from DGBSVX with the computed
735 * value in RCONDC.
736 *
737  result( 6 ) = dget06( rcond, rcondc )
738 *
739 * Print information about the tests that did
740 * not pass the threshold.
741 *
742  IF( .NOT.trfcon ) THEN
743  DO 80 k = k1, ntests
744  IF( result( k ).GE.thresh ) THEN
745  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
746  $ CALL aladhd( nout, path )
747  IF( prefac ) THEN
748  WRITE( nout, fmt = 9995 )
749  $ 'DGBSVX', fact, trans, n, kl,
750  $ ku, equed, imat, k,
751  $ result( k )
752  ELSE
753  WRITE( nout, fmt = 9996 )
754  $ 'DGBSVX', fact, trans, n, kl,
755  $ ku, imat, k, result( k )
756  END IF
757  nfail = nfail + 1
758  END IF
759  80 CONTINUE
760  nrun = nrun + ntests - k1 + 1
761  ELSE
762  IF( result( 1 ).GE.thresh .AND. .NOT.
763  $ prefac ) THEN
764  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
765  $ CALL aladhd( nout, path )
766  IF( prefac ) THEN
767  WRITE( nout, fmt = 9995 )'DGBSVX',
768  $ fact, trans, n, kl, ku, equed,
769  $ imat, 1, result( 1 )
770  ELSE
771  WRITE( nout, fmt = 9996 )'DGBSVX',
772  $ fact, trans, n, kl, ku, imat, 1,
773  $ result( 1 )
774  END IF
775  nfail = nfail + 1
776  nrun = nrun + 1
777  END IF
778  IF( result( 6 ).GE.thresh ) THEN
779  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
780  $ CALL aladhd( nout, path )
781  IF( prefac ) THEN
782  WRITE( nout, fmt = 9995 )'DGBSVX',
783  $ fact, trans, n, kl, ku, equed,
784  $ imat, 6, result( 6 )
785  ELSE
786  WRITE( nout, fmt = 9996 )'DGBSVX',
787  $ fact, trans, n, kl, ku, imat, 6,
788  $ result( 6 )
789  END IF
790  nfail = nfail + 1
791  nrun = nrun + 1
792  END IF
793  IF( result( 7 ).GE.thresh ) THEN
794  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
795  $ CALL aladhd( nout, path )
796  IF( prefac ) THEN
797  WRITE( nout, fmt = 9995 )'DGBSVX',
798  $ fact, trans, n, kl, ku, equed,
799  $ imat, 7, result( 7 )
800  ELSE
801  WRITE( nout, fmt = 9996 )'DGBSVX',
802  $ fact, trans, n, kl, ku, imat, 7,
803  $ result( 7 )
804  END IF
805  nfail = nfail + 1
806  nrun = nrun + 1
807  END IF
808 *
809  END IF
810  90 CONTINUE
811  100 CONTINUE
812  110 CONTINUE
813  120 CONTINUE
814  130 CONTINUE
815  140 CONTINUE
816  150 CONTINUE
817 *
818 * Print a summary of the results.
819 *
820  CALL alasvm( path, nout, nfail, nrun, nerrs )
821 *
822  9999 FORMAT( ' *** In DDRVGB, LA=', i5, ' is too small for N=', i5,
823  $ ', KU=', i5, ', KL=', i5, / ' ==> Increase LA to at least ',
824  $ i5 )
825  9998 FORMAT( ' *** In DDRVGB, LAFB=', i5, ' is too small for N=', i5,
826  $ ', KU=', i5, ', KL=', i5, /
827  $ ' ==> Increase LAFB to at least ', i5 )
828  9997 FORMAT( 1x, a, ', N=', i5, ', KL=', i5, ', KU=', i5, ', type ',
829  $ i1, ', test(', i1, ')=', g12.5 )
830  9996 FORMAT( 1x, a, '( ''', a1, ''',''', a1, ''',', i5, ',', i5, ',',
831  $ i5, ',...), type ', i1, ', test(', i1, ')=', g12.5 )
832  9995 FORMAT( 1x, a, '( ''', a1, ''',''', a1, ''',', i5, ',', i5, ',',
833  $ i5, ',...), EQUED=''', a1, ''', type ', i1, ', test(', i1,
834  $ ')=', g12.5 )
835 *
836  RETURN
837 *
838 * End of DDRVGB
839 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:103
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:110
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:73
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:81
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:90
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:147
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
Definition: dlarhs.f:205
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
Definition: dget04.f:102
subroutine dgbt01(M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
DGBT01
Definition: dgbt01.f:126
subroutine dgbt05(TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DGBT05
Definition: dgbt05.f:176
subroutine dgbt02(TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGBT02
Definition: dgbt02.f:149
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
Definition: dlatb4.f:120
subroutine derrvx(PATH, NUNIT)
DERRVX
Definition: derrvx.f:55
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:55
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:321
subroutine dlaqgb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, EQUED)
DLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ.
Definition: dlaqgb.f:159
double precision function dlangb(NORM, N, KL, KU, AB, LDAB, WORK)
DLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlangb.f:124
subroutine dgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBTRS
Definition: dgbtrs.f:138
subroutine dgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTRF
Definition: dgbtrf.f:144
subroutine dgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
DGBEQU
Definition: dgbequ.f:153
subroutine dgbsvx(FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DGBSVX computes the solution to system of linear equations A * X = B for GB matrices
Definition: dgbsvx.f:369
subroutine dgbsv(N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver)
Definition: dgbsv.f:162
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:114
double precision function dlantb(NORM, UPLO, DIAG, N, K, AB, LDAB, WORK)
DLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition: dlantb.f:140
Here is the call graph for this function:
Here is the caller graph for this function: