LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zchktb ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
double precision  THRESH,
logical  TSTERR,
integer  NMAX,
complex*16, dimension( * )  AB,
complex*16, dimension( * )  AINV,
complex*16, dimension( * )  B,
complex*16, dimension( * )  X,
complex*16, dimension( * )  XACT,
complex*16, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer  NOUT 
)

ZCHKTB

Purpose: 
 ZCHKTB tests ZTBTRS, -RFS, and -CON, and ZLATBS.
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]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[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.
[in]NMAX
          NMAX is INTEGER
          The leading dimension of the work arrays.
          NMAX >= the maximum value of N in NVAL.
[out]AB
          AB is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension
                      (max(NMAX,2*NSMAX))
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 151 of file zchktb.f.

151 *
152 * -- LAPACK test routine (version 3.4.0) --
153 * -- LAPACK is a software package provided by Univ. of Tennessee, --
154 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
155 * November 2011
156 *
157 * .. Scalar Arguments ..
158  LOGICAL tsterr
159  INTEGER nmax, nn, nns, nout
160  DOUBLE PRECISION thresh
161 * ..
162 * .. Array Arguments ..
163  LOGICAL dotype( * )
164  INTEGER nsval( * ), nval( * )
165  DOUBLE PRECISION rwork( * )
166  COMPLEX*16 ab( * ), ainv( * ), b( * ), work( * ), x( * ),
167  $ xact( * )
168 * ..
169 *
170 * =====================================================================
171 *
172 * .. Parameters ..
173  INTEGER ntype1, ntypes
174  parameter ( ntype1 = 9, ntypes = 17 )
175  INTEGER ntests
176  parameter ( ntests = 8 )
177  INTEGER ntran
178  parameter ( ntran = 3 )
179  DOUBLE PRECISION one, zero
180  parameter ( one = 1.0d+0, zero = 0.0d+0 )
181 * ..
182 * .. Local Scalars ..
183  CHARACTER diag, norm, trans, uplo, xtype
184  CHARACTER*3 path
185  INTEGER i, idiag, ik, imat, in, info, irhs, itran,
186  $ iuplo, j, k, kd, lda, ldab, n, nerrs, nfail,
187  $ nimat, nimat2, nk, nrhs, nrun
188  DOUBLE PRECISION ainvnm, anorm, rcond, rcondc, rcondi, rcondo,
189  $ scale
190 * ..
191 * .. Local Arrays ..
192  CHARACTER transs( ntran ), uplos( 2 )
193  INTEGER iseed( 4 ), iseedy( 4 )
194  DOUBLE PRECISION result( ntests )
195 * ..
196 * .. External Functions ..
197  LOGICAL lsame
198  DOUBLE PRECISION zlantb, zlantr
199  EXTERNAL lsame, zlantb, zlantr
200 * ..
201 * .. External Subroutines ..
202  EXTERNAL alaerh, alahd, alasum, zcopy, zerrtr, zget04,
203  $ zlacpy, zlarhs, zlaset, zlatbs, zlattb, ztbcon,
204  $ ztbrfs, ztbsv, ztbt02, ztbt03, ztbt05, ztbt06,
205  $ ztbtrs
206 * ..
207 * .. Scalars in Common ..
208  LOGICAL lerr, ok
209  CHARACTER*32 srnamt
210  INTEGER infot, iounit
211 * ..
212 * .. Common blocks ..
213  COMMON / infoc / infot, iounit, ok, lerr
214  COMMON / srnamc / srnamt
215 * ..
216 * .. Intrinsic Functions ..
217  INTRINSIC dcmplx, max, min
218 * ..
219 * .. Data statements ..
220  DATA iseedy / 1988, 1989, 1990, 1991 /
221  DATA uplos / 'U', 'L' / , transs / 'N', 'T', 'C' /
222 * ..
223 * .. Executable Statements ..
224 *
225 * Initialize constants and the random number seed.
226 *
227  path( 1: 1 ) = 'Zomplex precision'
228  path( 2: 3 ) = 'TB'
229  nrun = 0
230  nfail = 0
231  nerrs = 0
232  DO 10 i = 1, 4
233  iseed( i ) = iseedy( i )
234  10 CONTINUE
235 *
236 * Test the error exits
237 *
238  IF( tsterr )
239  $ CALL zerrtr( path, nout )
240  infot = 0
241 *
242  DO 140 in = 1, nn
243 *
244 * Do for each value of N in NVAL
245 *
246  n = nval( in )
247  lda = max( 1, n )
248  xtype = 'N'
249  nimat = ntype1
250  nimat2 = ntypes
251  IF( n.LE.0 ) THEN
252  nimat = 1
253  nimat2 = ntype1 + 1
254  END IF
255 *
256  nk = min( n+1, 4 )
257  DO 130 ik = 1, nk
258 *
259 * Do for KD = 0, N, (3N-1)/4, and (N+1)/4. This order makes
260 * it easier to skip redundant values for small values of N.
261 *
262  IF( ik.EQ.1 ) THEN
263  kd = 0
264  ELSE IF( ik.EQ.2 ) THEN
265  kd = max( n, 0 )
266  ELSE IF( ik.EQ.3 ) THEN
267  kd = ( 3*n-1 ) / 4
268  ELSE IF( ik.EQ.4 ) THEN
269  kd = ( n+1 ) / 4
270  END IF
271  ldab = kd + 1
272 *
273  DO 90 imat = 1, nimat
274 *
275 * Do the tests only if DOTYPE( IMAT ) is true.
276 *
277  IF( .NOT.dotype( imat ) )
278  $ GO TO 90
279 *
280  DO 80 iuplo = 1, 2
281 *
282 * Do first for UPLO = 'U', then for UPLO = 'L'
283 *
284  uplo = uplos( iuplo )
285 *
286 * Call ZLATTB to generate a triangular test matrix.
287 *
288  srnamt = 'ZLATTB'
289  CALL zlattb( imat, uplo, 'No transpose', diag, iseed,
290  $ n, kd, ab, ldab, x, work, rwork, info )
291 *
292 * Set IDIAG = 1 for non-unit matrices, 2 for unit.
293 *
294  IF( lsame( diag, 'N' ) ) THEN
295  idiag = 1
296  ELSE
297  idiag = 2
298  END IF
299 *
300 * Form the inverse of A so we can get a good estimate
301 * of RCONDC = 1/(norm(A) * norm(inv(A))).
302 *
303  CALL zlaset( 'Full', n, n, dcmplx( zero ),
304  $ dcmplx( one ), ainv, lda )
305  IF( lsame( uplo, 'U' ) ) THEN
306  DO 20 j = 1, n
307  CALL ztbsv( uplo, 'No transpose', diag, j, kd,
308  $ ab, ldab, ainv( ( j-1 )*lda+1 ), 1 )
309  20 CONTINUE
310  ELSE
311  DO 30 j = 1, n
312  CALL ztbsv( uplo, 'No transpose', diag, n-j+1,
313  $ kd, ab( ( j-1 )*ldab+1 ), ldab,
314  $ ainv( ( j-1 )*lda+j ), 1 )
315  30 CONTINUE
316  END IF
317 *
318 * Compute the 1-norm condition number of A.
319 *
320  anorm = zlantb( '1', uplo, diag, n, kd, ab, ldab,
321  $ rwork )
322  ainvnm = zlantr( '1', uplo, diag, n, n, ainv, lda,
323  $ rwork )
324  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
325  rcondo = one
326  ELSE
327  rcondo = ( one / anorm ) / ainvnm
328  END IF
329 *
330 * Compute the infinity-norm condition number of A.
331 *
332  anorm = zlantb( 'I', uplo, diag, n, kd, ab, ldab,
333  $ rwork )
334  ainvnm = zlantr( 'I', uplo, diag, n, n, ainv, lda,
335  $ rwork )
336  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
337  rcondi = one
338  ELSE
339  rcondi = ( one / anorm ) / ainvnm
340  END IF
341 *
342  DO 60 irhs = 1, nns
343  nrhs = nsval( irhs )
344  xtype = 'N'
345 *
346  DO 50 itran = 1, ntran
347 *
348 * Do for op(A) = A, A**T, or A**H.
349 *
350  trans = transs( itran )
351  IF( itran.EQ.1 ) THEN
352  norm = 'O'
353  rcondc = rcondo
354  ELSE
355  norm = 'I'
356  rcondc = rcondi
357  END IF
358 *
359 *+ TEST 1
360 * Solve and compute residual for op(A)*x = b.
361 *
362  srnamt = 'ZLARHS'
363  CALL zlarhs( path, xtype, uplo, trans, n, n, kd,
364  $ idiag, nrhs, ab, ldab, xact, lda,
365  $ b, lda, iseed, info )
366  xtype = 'C'
367  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
368 *
369  srnamt = 'ZTBTRS'
370  CALL ztbtrs( uplo, trans, diag, n, kd, nrhs, ab,
371  $ ldab, x, lda, info )
372 *
373 * Check error code from ZTBTRS.
374 *
375  IF( info.NE.0 )
376  $ CALL alaerh( path, 'ZTBTRS', info, 0,
377  $ uplo // trans // diag, n, n, kd,
378  $ kd, nrhs, imat, nfail, nerrs,
379  $ nout )
380 *
381  CALL ztbt02( uplo, trans, diag, n, kd, nrhs, ab,
382  $ ldab, x, lda, b, lda, work, rwork,
383  $ result( 1 ) )
384 *
385 *+ TEST 2
386 * Check solution from generated exact solution.
387 *
388  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
389  $ result( 2 ) )
390 *
391 *+ TESTS 3, 4, and 5
392 * Use iterative refinement to improve the solution
393 * and compute error bounds.
394 *
395  srnamt = 'ZTBRFS'
396  CALL ztbrfs( uplo, trans, diag, n, kd, nrhs, ab,
397  $ ldab, b, lda, x, lda, rwork,
398  $ rwork( nrhs+1 ), work,
399  $ rwork( 2*nrhs+1 ), info )
400 *
401 * Check error code from ZTBRFS.
402 *
403  IF( info.NE.0 )
404  $ CALL alaerh( path, 'ZTBRFS', info, 0,
405  $ uplo // trans // diag, n, n, kd,
406  $ kd, nrhs, imat, nfail, nerrs,
407  $ nout )
408 *
409  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
410  $ result( 3 ) )
411  CALL ztbt05( uplo, trans, diag, n, kd, nrhs, ab,
412  $ ldab, b, lda, x, lda, xact, lda,
413  $ rwork, rwork( nrhs+1 ),
414  $ result( 4 ) )
415 *
416 * Print information about the tests that did not
417 * pass the threshold.
418 *
419  DO 40 k = 1, 5
420  IF( result( k ).GE.thresh ) THEN
421  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
422  $ CALL alahd( nout, path )
423  WRITE( nout, fmt = 9999 )uplo, trans,
424  $ diag, n, kd, nrhs, imat, k, result( k )
425  nfail = nfail + 1
426  END IF
427  40 CONTINUE
428  nrun = nrun + 5
429  50 CONTINUE
430  60 CONTINUE
431 *
432 *+ TEST 6
433 * Get an estimate of RCOND = 1/CNDNUM.
434 *
435  DO 70 itran = 1, 2
436  IF( itran.EQ.1 ) THEN
437  norm = 'O'
438  rcondc = rcondo
439  ELSE
440  norm = 'I'
441  rcondc = rcondi
442  END IF
443  srnamt = 'ZTBCON'
444  CALL ztbcon( norm, uplo, diag, n, kd, ab, ldab,
445  $ rcond, work, rwork, info )
446 *
447 * Check error code from ZTBCON.
448 *
449  IF( info.NE.0 )
450  $ CALL alaerh( path, 'ZTBCON', info, 0,
451  $ norm // uplo // diag, n, n, kd, kd,
452  $ -1, imat, nfail, nerrs, nout )
453 *
454  CALL ztbt06( rcond, rcondc, uplo, diag, n, kd, ab,
455  $ ldab, rwork, result( 6 ) )
456 *
457 * Print the test ratio if it is .GE. THRESH.
458 *
459  IF( result( 6 ).GE.thresh ) THEN
460  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
461  $ CALL alahd( nout, path )
462  WRITE( nout, fmt = 9998 ) 'ZTBCON', norm, uplo,
463  $ diag, n, kd, imat, 6, result( 6 )
464  nfail = nfail + 1
465  END IF
466  nrun = nrun + 1
467  70 CONTINUE
468  80 CONTINUE
469  90 CONTINUE
470 *
471 * Use pathological test matrices to test ZLATBS.
472 *
473  DO 120 imat = ntype1 + 1, nimat2
474 *
475 * Do the tests only if DOTYPE( IMAT ) is true.
476 *
477  IF( .NOT.dotype( imat ) )
478  $ GO TO 120
479 *
480  DO 110 iuplo = 1, 2
481 *
482 * Do first for UPLO = 'U', then for UPLO = 'L'
483 *
484  uplo = uplos( iuplo )
485  DO 100 itran = 1, ntran
486 *
487 * Do for op(A) = A, A**T, and A**H.
488 *
489  trans = transs( itran )
490 *
491 * Call ZLATTB to generate a triangular test matrix.
492 *
493  srnamt = 'ZLATTB'
494  CALL zlattb( imat, uplo, trans, diag, iseed, n, kd,
495  $ ab, ldab, x, work, rwork, info )
496 *
497 *+ TEST 7
498 * Solve the system op(A)*x = b
499 *
500  srnamt = 'ZLATBS'
501  CALL zcopy( n, x, 1, b, 1 )
502  CALL zlatbs( uplo, trans, diag, 'N', n, kd, ab,
503  $ ldab, b, scale, rwork, info )
504 *
505 * Check error code from ZLATBS.
506 *
507  IF( info.NE.0 )
508  $ CALL alaerh( path, 'ZLATBS', info, 0,
509  $ uplo // trans // diag // 'N', n, n,
510  $ kd, kd, -1, imat, nfail, nerrs,
511  $ nout )
512 *
513  CALL ztbt03( uplo, trans, diag, n, kd, 1, ab, ldab,
514  $ scale, rwork, one, b, lda, x, lda,
515  $ work, result( 7 ) )
516 *
517 *+ TEST 8
518 * Solve op(A)*x = b again with NORMIN = 'Y'.
519 *
520  CALL zcopy( n, x, 1, b, 1 )
521  CALL zlatbs( uplo, trans, diag, 'Y', n, kd, ab,
522  $ ldab, b, scale, rwork, info )
523 *
524 * Check error code from ZLATBS.
525 *
526  IF( info.NE.0 )
527  $ CALL alaerh( path, 'ZLATBS', info, 0,
528  $ uplo // trans // diag // 'Y', n, n,
529  $ kd, kd, -1, imat, nfail, nerrs,
530  $ nout )
531 *
532  CALL ztbt03( uplo, trans, diag, n, kd, 1, ab, ldab,
533  $ scale, rwork, one, b, lda, x, lda,
534  $ work, result( 8 ) )
535 *
536 * Print information about the tests that did not pass
537 * the threshold.
538 *
539  IF( result( 7 ).GE.thresh ) THEN
540  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
541  $ CALL alahd( nout, path )
542  WRITE( nout, fmt = 9997 )'ZLATBS', uplo, trans,
543  $ diag, 'N', n, kd, imat, 7, result( 7 )
544  nfail = nfail + 1
545  END IF
546  IF( result( 8 ).GE.thresh ) THEN
547  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
548  $ CALL alahd( nout, path )
549  WRITE( nout, fmt = 9997 )'ZLATBS', uplo, trans,
550  $ diag, 'Y', n, kd, imat, 8, result( 8 )
551  nfail = nfail + 1
552  END IF
553  nrun = nrun + 2
554  100 CONTINUE
555  110 CONTINUE
556  120 CONTINUE
557  130 CONTINUE
558  140 CONTINUE
559 *
560 * Print a summary of the results.
561 *
562  CALL alasum( path, nout, nfail, nrun, nerrs )
563 *
564  9999 FORMAT( ' UPLO=''', a1, ''', TRANS=''', a1, ''',
565  $ DIAG=''', a1, ''', N=', i5, ', KD=', i5, ', NRHS=', i5,
566  $ ', type ', i2, ', test(', i2, ')=', g12.5 )
567  9998 FORMAT( 1x, a, '( ''', a1, ''', ''', a1, ''', ''', a1, ''',',
568  $ i5, ',', i5, ', ... ), type ', i2, ', test(', i2, ')=',
569  $ g12.5 )
570  9997 FORMAT( 1x, a, '( ''', a1, ''', ''', a1, ''', ''', a1, ''', ''',
571  $ a1, ''',', i5, ',', i5, ', ... ), type ', i2, ', test(',
572  $ i1, ')=', g12.5 )
573  RETURN
574 *
575 * End of ZCHKTB
576 *
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
zerrtr
subroutine zerrtr(PATH, NUNIT)
ZERRTR
Definition: zerrtr.f:56
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
zlacpy
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
ztbt02
subroutine ztbt02(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X, LDX, B, LDB, WORK, RWORK, RESID)
ZTBT02
Definition: ztbt02.f:163
zget04
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
ztbcon
subroutine ztbcon(NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, RWORK, INFO)
ZTBCON
Definition: ztbcon.f:145
zcopy
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
zlantr
double precision function zlantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
ZLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix.
Definition: zlantr.f:144
ztbt05
subroutine ztbt05(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZTBT05
Definition: ztbt05.f:191
zlarhs
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
zlaset
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
zlantb
double precision function zlantb(NORM, UPLO, DIAG, N, K, AB, LDAB, WORK)
ZLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix.
Definition: zlantb.f:143
zlatbs
subroutine zlatbs(UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, SCALE, CNORM, INFO)
ZLATBS solves a triangular banded system of equations.
Definition: zlatbs.f:245
zlattb
subroutine zlattb(IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, LDAB, B, WORK, RWORK, INFO)
ZLATTB
Definition: zlattb.f:143
ztbt06
subroutine ztbt06(RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, RWORK, RAT)
ZTBT06
Definition: ztbt06.f:128
ztbsv
subroutine ztbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
ZTBSV
Definition: ztbsv.f:191
ztbt03
subroutine ztbt03(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
ZTBT03
Definition: ztbt03.f:179
ztbrfs
subroutine ztbrfs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZTBRFS
Definition: ztbrfs.f:190
ztbtrs
subroutine ztbtrs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
ZTBTRS
Definition: ztbtrs.f:148
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75

Here is the call graph for this function:

Here is the caller graph for this function: