LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

## ◆ zchkgt()

 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.```
Date
December 2016

Definition at line 149 of file zchkgt.f.

149 *
150 * -- LAPACK test routine (version 3.7.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 * December 2016
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,
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 *
subroutine zgttrf(N, DL, D, DU, DU2, IPIV, INFO)
ZGTTRF
Definition: zgttrf.f:126
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
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
subroutine zgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
ZGTT01
Definition: zgtt01.f:136
double precision function dzasum(N, ZX, INCX)
DZASUM
Definition: dzasum.f:74
subroutine zerrge(PATH, NUNIT)
ZERRGE
Definition: zerrge.f:57
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:83
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
subroutine zgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, INFO)
ZGTCON
Definition: zgtcon.f:143
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
subroutine zgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
ZGTT02
Definition: zgtt02.f:126
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:80
subroutine zgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZGTT05
Definition: zgtt05.f:167
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
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
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
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: zlarnv.f:101
subroutine zgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
ZGTTRS
Definition: zgttrs.f:140
Here is the call graph for this function:
Here is the caller graph for this function: