LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zchkgt ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
double precision  THRESH,
logical  TSTERR,
complex*16, dimension( * )  A,
complex*16, dimension( * )  AF,
complex*16, dimension( * )  B,
complex*16, dimension( * )  X,
complex*16, dimension( * )  XACT,
complex*16, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

ZCHKGT

Purpose: 
 ZCHKGT tests ZGTTRF, -TRS, -RFS, and -CON
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 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.
[out]A
          A is COMPLEX*16 array, dimension (NMAX*4)
[out]AF
          AF is COMPLEX*16 array, dimension (NMAX*4)
[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)
[out]IWORK
          IWORK is INTEGER array, dimension (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.
Date
November 2011

Definition at line 149 of file zchkgt.f.

149 *
150 * -- LAPACK test routine (version 3.4.0) --
151 * -- LAPACK is a software package provided by Univ. of Tennessee, --
152 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
153 * November 2011
154 *
155 * .. Scalar Arguments ..
156  LOGICAL tsterr
157  INTEGER nn, nns, nout
158  DOUBLE PRECISION thresh
159 * ..
160 * .. Array Arguments ..
161  LOGICAL dotype( * )
162  INTEGER iwork( * ), nsval( * ), nval( * )
163  DOUBLE PRECISION rwork( * )
164  COMPLEX*16 a( * ), af( * ), b( * ), work( * ), x( * ),
165  $ xact( * )
166 * ..
167 *
168 * =====================================================================
169 *
170 * .. Parameters ..
171  DOUBLE PRECISION one, zero
172  parameter ( one = 1.0d+0, zero = 0.0d+0 )
173  INTEGER ntypes
174  parameter ( ntypes = 12 )
175  INTEGER ntests
176  parameter ( ntests = 7 )
177 * ..
178 * .. Local Scalars ..
179  LOGICAL trfcon, zerot
180  CHARACTER dist, norm, trans, type
181  CHARACTER*3 path
182  INTEGER i, imat, in, info, irhs, itran, ix, izero, j,
183  $ k, kl, koff, ku, lda, m, mode, n, nerrs, nfail,
184  $ nimat, nrhs, nrun
185  DOUBLE PRECISION ainvnm, anorm, cond, rcond, rcondc, rcondi,
186  $ rcondo
187 * ..
188 * .. Local Arrays ..
189  CHARACTER transs( 3 )
190  INTEGER iseed( 4 ), iseedy( 4 )
191  DOUBLE PRECISION result( ntests )
192  COMPLEX*16 z( 3 )
193 * ..
194 * .. External Functions ..
195  DOUBLE PRECISION dget06, dzasum, zlangt
196  EXTERNAL dget06, dzasum, zlangt
197 * ..
198 * .. External Subroutines ..
199  EXTERNAL alaerh, alahd, alasum, zcopy, zdscal, zerrge,
200  $ zget04, zgtcon, zgtrfs, zgtt01, zgtt02, zgtt05,
201  $ zgttrf, zgttrs, zlacpy, zlagtm, zlarnv, zlatb4,
202  $ zlatms
203 * ..
204 * .. Intrinsic Functions ..
205  INTRINSIC max
206 * ..
207 * .. Scalars in Common ..
208  LOGICAL lerr, ok
209  CHARACTER*32 srnamt
210  INTEGER infot, nunit
211 * ..
212 * .. Common blocks ..
213  COMMON / infoc / infot, nunit, ok, lerr
214  COMMON / srnamc / srnamt
215 * ..
216 * .. Data statements ..
217  DATA iseedy / 0, 0, 0, 1 / , transs / 'N', 'T',
218  $ 'C' /
219 * ..
220 * .. Executable Statements ..
221 *
222  path( 1: 1 ) = 'Zomplex precision'
223  path( 2: 3 ) = 'GT'
224  nrun = 0
225  nfail = 0
226  nerrs = 0
227  DO 10 i = 1, 4
228  iseed( i ) = iseedy( i )
229  10 CONTINUE
230 *
231 * Test the error exits
232 *
233  IF( tsterr )
234  $ CALL zerrge( path, nout )
235  infot = 0
236 *
237  DO 110 in = 1, nn
238 *
239 * Do for each value of N in NVAL.
240 *
241  n = nval( in )
242  m = max( n-1, 0 )
243  lda = max( 1, n )
244  nimat = ntypes
245  IF( n.LE.0 )
246  $ nimat = 1
247 *
248  DO 100 imat = 1, nimat
249 *
250 * Do the tests only if DOTYPE( IMAT ) is true.
251 *
252  IF( .NOT.dotype( imat ) )
253  $ GO TO 100
254 *
255 * Set up parameters with ZLATB4.
256 *
257  CALL zlatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
258  $ cond, dist )
259 *
260  zerot = imat.GE.8 .AND. imat.LE.10
261  IF( imat.LE.6 ) THEN
262 *
263 * Types 1-6: generate matrices of known condition number.
264 *
265  koff = max( 2-ku, 3-max( 1, n ) )
266  srnamt = 'ZLATMS'
267  CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode, cond,
268  $ anorm, kl, ku, 'Z', af( koff ), 3, work,
269  $ info )
270 *
271 * Check the error code from ZLATMS.
272 *
273  IF( info.NE.0 ) THEN
274  CALL alaerh( path, 'ZLATMS', info, 0, ' ', n, n, kl,
275  $ ku, -1, imat, nfail, nerrs, nout )
276  GO TO 100
277  END IF
278  izero = 0
279 *
280  IF( n.GT.1 ) THEN
281  CALL zcopy( n-1, af( 4 ), 3, a, 1 )
282  CALL zcopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
283  END IF
284  CALL zcopy( n, af( 2 ), 3, a( m+1 ), 1 )
285  ELSE
286 *
287 * Types 7-12: generate tridiagonal matrices with
288 * unknown condition numbers.
289 *
290  IF( .NOT.zerot .OR. .NOT.dotype( 7 ) ) THEN
291 *
292 * Generate a matrix with elements whose real and
293 * imaginary parts are from [-1,1].
294 *
295  CALL zlarnv( 2, iseed, n+2*m, a )
296  IF( anorm.NE.one )
297  $ CALL zdscal( n+2*m, anorm, a, 1 )
298  ELSE IF( izero.GT.0 ) THEN
299 *
300 * Reuse the last matrix by copying back the zeroed out
301 * elements.
302 *
303  IF( izero.EQ.1 ) THEN
304  a( n ) = z( 2 )
305  IF( n.GT.1 )
306  $ a( 1 ) = z( 3 )
307  ELSE IF( izero.EQ.n ) THEN
308  a( 3*n-2 ) = z( 1 )
309  a( 2*n-1 ) = z( 2 )
310  ELSE
311  a( 2*n-2+izero ) = z( 1 )
312  a( n-1+izero ) = z( 2 )
313  a( izero ) = z( 3 )
314  END IF
315  END IF
316 *
317 * If IMAT > 7, set one column of the matrix to 0.
318 *
319  IF( .NOT.zerot ) THEN
320  izero = 0
321  ELSE IF( imat.EQ.8 ) THEN
322  izero = 1
323  z( 2 ) = a( n )
324  a( n ) = zero
325  IF( n.GT.1 ) THEN
326  z( 3 ) = a( 1 )
327  a( 1 ) = zero
328  END IF
329  ELSE IF( imat.EQ.9 ) THEN
330  izero = n
331  z( 1 ) = a( 3*n-2 )
332  z( 2 ) = a( 2*n-1 )
333  a( 3*n-2 ) = zero
334  a( 2*n-1 ) = zero
335  ELSE
336  izero = ( n+1 ) / 2
337  DO 20 i = izero, n - 1
338  a( 2*n-2+i ) = zero
339  a( n-1+i ) = zero
340  a( i ) = zero
341  20 CONTINUE
342  a( 3*n-2 ) = zero
343  a( 2*n-1 ) = zero
344  END IF
345  END IF
346 *
347 *+ TEST 1
348 * Factor A as L*U and compute the ratio
349 * norm(L*U - A) / (n * norm(A) * EPS )
350 *
351  CALL zcopy( n+2*m, a, 1, af, 1 )
352  srnamt = 'ZGTTRF'
353  CALL zgttrf( n, af, af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
354  $ iwork, info )
355 *
356 * Check error code from ZGTTRF.
357 *
358  IF( info.NE.izero )
359  $ CALL alaerh( path, 'ZGTTRF', info, izero, ' ', n, n, 1,
360  $ 1, -1, imat, nfail, nerrs, nout )
361  trfcon = info.NE.0
362 *
363  CALL zgtt01( n, a, a( m+1 ), a( n+m+1 ), af, af( m+1 ),
364  $ af( n+m+1 ), af( n+2*m+1 ), iwork, work, lda,
365  $ rwork, result( 1 ) )
366 *
367 * Print the test ratio if it is .GE. THRESH.
368 *
369  IF( result( 1 ).GE.thresh ) THEN
370  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
371  $ CALL alahd( nout, path )
372  WRITE( nout, fmt = 9999 )n, imat, 1, result( 1 )
373  nfail = nfail + 1
374  END IF
375  nrun = nrun + 1
376 *
377  DO 50 itran = 1, 2
378  trans = transs( itran )
379  IF( itran.EQ.1 ) THEN
380  norm = 'O'
381  ELSE
382  norm = 'I'
383  END IF
384  anorm = zlangt( norm, n, a, a( m+1 ), a( n+m+1 ) )
385 *
386  IF( .NOT.trfcon ) THEN
387 *
388 * Use ZGTTRS to solve for one column at a time of
389 * inv(A), computing the maximum column sum as we go.
390 *
391  ainvnm = zero
392  DO 40 i = 1, n
393  DO 30 j = 1, n
394  x( j ) = zero
395  30 CONTINUE
396  x( i ) = one
397  CALL zgttrs( trans, n, 1, af, af( m+1 ),
398  $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
399  $ lda, info )
400  ainvnm = max( ainvnm, dzasum( n, x, 1 ) )
401  40 CONTINUE
402 *
403 * Compute RCONDC = 1 / (norm(A) * norm(inv(A))
404 *
405  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
406  rcondc = one
407  ELSE
408  rcondc = ( one / anorm ) / ainvnm
409  END IF
410  IF( itran.EQ.1 ) THEN
411  rcondo = rcondc
412  ELSE
413  rcondi = rcondc
414  END IF
415  ELSE
416  rcondc = zero
417  END IF
418 *
419 *+ TEST 7
420 * Estimate the reciprocal of the condition number of the
421 * matrix.
422 *
423  srnamt = 'ZGTCON'
424  CALL zgtcon( norm, n, af, af( m+1 ), af( n+m+1 ),
425  $ af( n+2*m+1 ), iwork, anorm, rcond, work,
426  $ info )
427 *
428 * Check error code from ZGTCON.
429 *
430  IF( info.NE.0 )
431  $ CALL alaerh( path, 'ZGTCON', info, 0, norm, n, n, -1,
432  $ -1, -1, imat, nfail, nerrs, nout )
433 *
434  result( 7 ) = dget06( rcond, rcondc )
435 *
436 * Print the test ratio if it is .GE. THRESH.
437 *
438  IF( result( 7 ).GE.thresh ) THEN
439  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
440  $ CALL alahd( nout, path )
441  WRITE( nout, fmt = 9997 )norm, n, imat, 7,
442  $ result( 7 )
443  nfail = nfail + 1
444  END IF
445  nrun = nrun + 1
446  50 CONTINUE
447 *
448 * Skip the remaining tests if the matrix is singular.
449 *
450  IF( trfcon )
451  $ GO TO 100
452 *
453  DO 90 irhs = 1, nns
454  nrhs = nsval( irhs )
455 *
456 * Generate NRHS random solution vectors.
457 *
458  ix = 1
459  DO 60 j = 1, nrhs
460  CALL zlarnv( 2, iseed, n, xact( ix ) )
461  ix = ix + lda
462  60 CONTINUE
463 *
464  DO 80 itran = 1, 3
465  trans = transs( itran )
466  IF( itran.EQ.1 ) THEN
467  rcondc = rcondo
468  ELSE
469  rcondc = rcondi
470  END IF
471 *
472 * Set the right hand side.
473 *
474  CALL zlagtm( trans, n, nrhs, one, a, a( m+1 ),
475  $ a( n+m+1 ), xact, lda, zero, b, lda )
476 *
477 *+ TEST 2
478 * Solve op(A) * X = B and compute the residual.
479 *
480  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
481  srnamt = 'ZGTTRS'
482  CALL zgttrs( trans, n, nrhs, af, af( m+1 ),
483  $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
484  $ lda, info )
485 *
486 * Check error code from ZGTTRS.
487 *
488  IF( info.NE.0 )
489  $ CALL alaerh( path, 'ZGTTRS', info, 0, trans, n, n,
490  $ -1, -1, nrhs, imat, nfail, nerrs,
491  $ nout )
492 *
493  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
494  CALL zgtt02( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
495  $ x, lda, work, lda, result( 2 ) )
496 *
497 *+ TEST 3
498 * Check solution from generated exact solution.
499 *
500  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
501  $ result( 3 ) )
502 *
503 *+ TESTS 4, 5, and 6
504 * Use iterative refinement to improve the solution.
505 *
506  srnamt = 'ZGTRFS'
507  CALL zgtrfs( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
508  $ af, af( m+1 ), af( n+m+1 ),
509  $ af( n+2*m+1 ), iwork, b, lda, x, lda,
510  $ rwork, rwork( nrhs+1 ), work,
511  $ rwork( 2*nrhs+1 ), info )
512 *
513 * Check error code from ZGTRFS.
514 *
515  IF( info.NE.0 )
516  $ CALL alaerh( path, 'ZGTRFS', info, 0, trans, n, n,
517  $ -1, -1, nrhs, imat, nfail, nerrs,
518  $ nout )
519 *
520  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
521  $ result( 4 ) )
522  CALL zgtt05( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
523  $ b, lda, x, lda, xact, lda, rwork,
524  $ rwork( nrhs+1 ), result( 5 ) )
525 *
526 * Print information about the tests that did not pass the
527 * threshold.
528 *
529  DO 70 k = 2, 6
530  IF( result( k ).GE.thresh ) THEN
531  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
532  $ CALL alahd( nout, path )
533  WRITE( nout, fmt = 9998 )trans, n, nrhs, imat,
534  $ k, result( k )
535  nfail = nfail + 1
536  END IF
537  70 CONTINUE
538  nrun = nrun + 5
539  80 CONTINUE
540  90 CONTINUE
541  100 CONTINUE
542  110 CONTINUE
543 *
544 * Print a summary of the results.
545 *
546  CALL alasum( path, nout, nfail, nrun, nerrs )
547 *
548  9999 FORMAT( 12x, 'N =', i5, ',', 10x, ' type ', i2, ', test(', i2,
549  $ ') = ', g12.5 )
550  9998 FORMAT( ' TRANS=''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
551  $ i2, ', test(', i2, ') = ', g12.5 )
552  9997 FORMAT( ' NORM =''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
553  $ ', test(', i2, ') = ', g12.5 )
554  RETURN
555 *
556 * End of ZCHKGT
557 *
zlagtm
subroutine zlagtm(TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, B, LDB)
ZLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix...
Definition: zlagtm.f:147
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
zgttrs
subroutine zgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
ZGTTRS
Definition: zgttrs.f:140
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
zlarnv
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: zlarnv.f:101
zget04
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
zcopy
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
zgtcon
subroutine zgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, INFO)
ZGTCON
Definition: zgtcon.f:143
zgtt05
subroutine zgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZGTT05
Definition: zgtt05.f:167
zlatb4
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
zerrge
subroutine zerrge(PATH, NUNIT)
ZERRGE
Definition: zerrge.f:57
dzasum
double precision function dzasum(N, ZX, INCX)
DZASUM
Definition: dzasum.f:54
zgtt01
subroutine zgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
ZGTT01
Definition: zgtt01.f:136
zgttrf
subroutine zgttrf(N, DL, D, DU, DU2, IPIV, INFO)
ZGTTRF
Definition: zgttrf.f:126
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
zlangt
double precision function zlangt(NORM, N, DL, D, DU)
ZLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlangt.f:108
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
zdscal
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:54
zgtt02
subroutine zgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
ZGTT02
Definition: zgtt02.f:126
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
zgtrfs
subroutine zgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGTRFS
Definition: zgtrfs.f:212

Here is the call graph for this function:

Here is the caller graph for this function: