LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ zdrvgt()

subroutine zdrvgt ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NRHS,
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 
)

ZDRVGT

Purpose:
 ZDRVGT tests ZGTSV 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 dimension N.
[in]NRHS
          NRHS is INTEGER
          The number of right hand sides, NRHS >= 0.
[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*NRHS)
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]WORK
          WORK is COMPLEX*16 array, dimension
                      (NMAX*max(3,NRHS))
[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.

Definition at line 137 of file zdrvgt.f.

139 *
140 * -- LAPACK test routine --
141 * -- LAPACK is a software package provided by Univ. of Tennessee, --
142 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
143 *
144 * .. Scalar Arguments ..
145  LOGICAL TSTERR
146  INTEGER NN, NOUT, NRHS
147  DOUBLE PRECISION THRESH
148 * ..
149 * .. Array Arguments ..
150  LOGICAL DOTYPE( * )
151  INTEGER IWORK( * ), NVAL( * )
152  DOUBLE PRECISION RWORK( * )
153  COMPLEX*16 A( * ), AF( * ), B( * ), WORK( * ), X( * ),
154  $ XACT( * )
155 * ..
156 *
157 * =====================================================================
158 *
159 * .. Parameters ..
160  DOUBLE PRECISION ONE, ZERO
161  parameter( one = 1.0d+0, zero = 0.0d+0 )
162  INTEGER NTYPES
163  parameter( ntypes = 12 )
164  INTEGER NTESTS
165  parameter( ntests = 6 )
166 * ..
167 * .. Local Scalars ..
168  LOGICAL TRFCON, ZEROT
169  CHARACTER DIST, FACT, TRANS, TYPE
170  CHARACTER*3 PATH
171  INTEGER I, IFACT, IMAT, IN, INFO, ITRAN, IX, IZERO, J,
172  $ K, K1, KL, KOFF, KU, LDA, M, MODE, N, NERRS,
173  $ NFAIL, NIMAT, NRUN, NT
174  DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, COND, RCOND,
175  $ RCONDC, RCONDI, RCONDO
176 * ..
177 * .. Local Arrays ..
178  CHARACTER TRANSS( 3 )
179  INTEGER ISEED( 4 ), ISEEDY( 4 )
180  DOUBLE PRECISION RESULT( NTESTS ), Z( 3 )
181 * ..
182 * .. External Functions ..
183  DOUBLE PRECISION DGET06, DZASUM, ZLANGT
184  EXTERNAL dget06, dzasum, zlangt
185 * ..
186 * .. External Subroutines ..
187  EXTERNAL aladhd, alaerh, alasvm, zcopy, zdscal, zerrvx,
190  $ zlatb4, zlatms
191 * ..
192 * .. Intrinsic Functions ..
193  INTRINSIC dcmplx, max
194 * ..
195 * .. Scalars in Common ..
196  LOGICAL LERR, OK
197  CHARACTER*32 SRNAMT
198  INTEGER INFOT, NUNIT
199 * ..
200 * .. Common blocks ..
201  COMMON / infoc / infot, nunit, ok, lerr
202  COMMON / srnamc / srnamt
203 * ..
204 * .. Data statements ..
205  DATA iseedy / 0, 0, 0, 1 / , transs / 'N', 'T',
206  $ 'C' /
207 * ..
208 * .. Executable Statements ..
209 *
210  path( 1: 1 ) = 'Zomplex precision'
211  path( 2: 3 ) = 'GT'
212  nrun = 0
213  nfail = 0
214  nerrs = 0
215  DO 10 i = 1, 4
216  iseed( i ) = iseedy( i )
217  10 CONTINUE
218 *
219 * Test the error exits
220 *
221  IF( tsterr )
222  $ CALL zerrvx( path, nout )
223  infot = 0
224 *
225  DO 140 in = 1, nn
226 *
227 * Do for each value of N in NVAL.
228 *
229  n = nval( in )
230  m = max( n-1, 0 )
231  lda = max( 1, n )
232  nimat = ntypes
233  IF( n.LE.0 )
234  $ nimat = 1
235 *
236  DO 130 imat = 1, nimat
237 *
238 * Do the tests only if DOTYPE( IMAT ) is true.
239 *
240  IF( .NOT.dotype( imat ) )
241  $ GO TO 130
242 *
243 * Set up parameters with ZLATB4.
244 *
245  CALL zlatb4( path, imat, n, n, TYPE, KL, KU, ANORM, MODE,
246  $ COND, DIST )
247 *
248  zerot = imat.GE.8 .AND. imat.LE.10
249  IF( imat.LE.6 ) THEN
250 *
251 * Types 1-6: generate matrices of known condition number.
252 *
253  koff = max( 2-ku, 3-max( 1, n ) )
254  srnamt = 'ZLATMS'
255  CALL zlatms( n, n, dist, iseed, TYPE, RWORK, MODE, COND,
256  $ ANORM, KL, KU, 'Z', AF( KOFF ), 3, WORK,
257  $ INFO )
258 *
259 * Check the error code from ZLATMS.
260 *
261  IF( info.NE.0 ) THEN
262  CALL alaerh( path, 'ZLATMS', info, 0, ' ', n, n, kl,
263  $ ku, -1, imat, nfail, nerrs, nout )
264  GO TO 130
265  END IF
266  izero = 0
267 *
268  IF( n.GT.1 ) THEN
269  CALL zcopy( n-1, af( 4 ), 3, a, 1 )
270  CALL zcopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
271  END IF
272  CALL zcopy( n, af( 2 ), 3, a( m+1 ), 1 )
273  ELSE
274 *
275 * Types 7-12: generate tridiagonal matrices with
276 * unknown condition numbers.
277 *
278  IF( .NOT.zerot .OR. .NOT.dotype( 7 ) ) THEN
279 *
280 * Generate a matrix with elements from [-1,1].
281 *
282  CALL zlarnv( 2, iseed, n+2*m, a )
283  IF( anorm.NE.one )
284  $ CALL zdscal( n+2*m, anorm, a, 1 )
285  ELSE IF( izero.GT.0 ) THEN
286 *
287 * Reuse the last matrix by copying back the zeroed out
288 * elements.
289 *
290  IF( izero.EQ.1 ) THEN
291  a( n ) = z( 2 )
292  IF( n.GT.1 )
293  $ a( 1 ) = z( 3 )
294  ELSE IF( izero.EQ.n ) THEN
295  a( 3*n-2 ) = z( 1 )
296  a( 2*n-1 ) = z( 2 )
297  ELSE
298  a( 2*n-2+izero ) = z( 1 )
299  a( n-1+izero ) = z( 2 )
300  a( izero ) = z( 3 )
301  END IF
302  END IF
303 *
304 * If IMAT > 7, set one column of the matrix to 0.
305 *
306  IF( .NOT.zerot ) THEN
307  izero = 0
308  ELSE IF( imat.EQ.8 ) THEN
309  izero = 1
310  z( 2 ) = a( n )
311  a( n ) = zero
312  IF( n.GT.1 ) THEN
313  z( 3 ) = a( 1 )
314  a( 1 ) = zero
315  END IF
316  ELSE IF( imat.EQ.9 ) THEN
317  izero = n
318  z( 1 ) = a( 3*n-2 )
319  z( 2 ) = a( 2*n-1 )
320  a( 3*n-2 ) = zero
321  a( 2*n-1 ) = zero
322  ELSE
323  izero = ( n+1 ) / 2
324  DO 20 i = izero, n - 1
325  a( 2*n-2+i ) = zero
326  a( n-1+i ) = zero
327  a( i ) = zero
328  20 CONTINUE
329  a( 3*n-2 ) = zero
330  a( 2*n-1 ) = zero
331  END IF
332  END IF
333 *
334  DO 120 ifact = 1, 2
335  IF( ifact.EQ.1 ) THEN
336  fact = 'F'
337  ELSE
338  fact = 'N'
339  END IF
340 *
341 * Compute the condition number for comparison with
342 * the value returned by ZGTSVX.
343 *
344  IF( zerot ) THEN
345  IF( ifact.EQ.1 )
346  $ GO TO 120
347  rcondo = zero
348  rcondi = zero
349 *
350  ELSE IF( ifact.EQ.1 ) THEN
351  CALL zcopy( n+2*m, a, 1, af, 1 )
352 *
353 * Compute the 1-norm and infinity-norm of A.
354 *
355  anormo = zlangt( '1', n, a, a( m+1 ), a( n+m+1 ) )
356  anormi = zlangt( 'I', n, a, a( m+1 ), a( n+m+1 ) )
357 *
358 * Factor the matrix A.
359 *
360  CALL zgttrf( n, af, af( m+1 ), af( n+m+1 ),
361  $ af( n+2*m+1 ), iwork, info )
362 *
363 * Use ZGTTRS to solve for one column at a time of
364 * inv(A), computing the maximum column sum as we go.
365 *
366  ainvnm = zero
367  DO 40 i = 1, n
368  DO 30 j = 1, n
369  x( j ) = zero
370  30 CONTINUE
371  x( i ) = one
372  CALL zgttrs( 'No transpose', n, 1, af, af( m+1 ),
373  $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
374  $ lda, info )
375  ainvnm = max( ainvnm, dzasum( n, x, 1 ) )
376  40 CONTINUE
377 *
378 * Compute the 1-norm condition number of A.
379 *
380  IF( anormo.LE.zero .OR. ainvnm.LE.zero ) THEN
381  rcondo = one
382  ELSE
383  rcondo = ( one / anormo ) / ainvnm
384  END IF
385 *
386 * Use ZGTTRS to solve for one column at a time of
387 * inv(A'), computing the maximum column sum as we go.
388 *
389  ainvnm = zero
390  DO 60 i = 1, n
391  DO 50 j = 1, n
392  x( j ) = zero
393  50 CONTINUE
394  x( i ) = one
395  CALL zgttrs( 'Conjugate transpose', n, 1, af,
396  $ af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
397  $ iwork, x, lda, info )
398  ainvnm = max( ainvnm, dzasum( n, x, 1 ) )
399  60 CONTINUE
400 *
401 * Compute the infinity-norm condition number of A.
402 *
403  IF( anormi.LE.zero .OR. ainvnm.LE.zero ) THEN
404  rcondi = one
405  ELSE
406  rcondi = ( one / anormi ) / ainvnm
407  END IF
408  END IF
409 *
410  DO 110 itran = 1, 3
411  trans = transs( itran )
412  IF( itran.EQ.1 ) THEN
413  rcondc = rcondo
414  ELSE
415  rcondc = rcondi
416  END IF
417 *
418 * Generate NRHS random solution vectors.
419 *
420  ix = 1
421  DO 70 j = 1, nrhs
422  CALL zlarnv( 2, iseed, n, xact( ix ) )
423  ix = ix + lda
424  70 CONTINUE
425 *
426 * Set the right hand side.
427 *
428  CALL zlagtm( trans, n, nrhs, one, a, a( m+1 ),
429  $ a( n+m+1 ), xact, lda, zero, b, lda )
430 *
431  IF( ifact.EQ.2 .AND. itran.EQ.1 ) THEN
432 *
433 * --- Test ZGTSV ---
434 *
435 * Solve the system using Gaussian elimination with
436 * partial pivoting.
437 *
438  CALL zcopy( n+2*m, a, 1, af, 1 )
439  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
440 *
441  srnamt = 'ZGTSV '
442  CALL zgtsv( n, nrhs, af, af( m+1 ), af( n+m+1 ), x,
443  $ lda, info )
444 *
445 * Check error code from ZGTSV .
446 *
447  IF( info.NE.izero )
448  $ CALL alaerh( path, 'ZGTSV ', info, izero, ' ',
449  $ n, n, 1, 1, nrhs, imat, nfail,
450  $ nerrs, nout )
451  nt = 1
452  IF( izero.EQ.0 ) THEN
453 *
454 * Check residual of computed solution.
455 *
456  CALL zlacpy( 'Full', n, nrhs, b, lda, work,
457  $ lda )
458  CALL zgtt02( trans, n, nrhs, a, a( m+1 ),
459  $ a( n+m+1 ), x, lda, work, lda,
460  $ result( 2 ) )
461 *
462 * Check solution from generated exact solution.
463 *
464  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
465  $ result( 3 ) )
466  nt = 3
467  END IF
468 *
469 * Print information about the tests that did not pass
470 * the threshold.
471 *
472  DO 80 k = 2, nt
473  IF( result( k ).GE.thresh ) THEN
474  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
475  $ CALL aladhd( nout, path )
476  WRITE( nout, fmt = 9999 )'ZGTSV ', n, imat,
477  $ k, result( k )
478  nfail = nfail + 1
479  END IF
480  80 CONTINUE
481  nrun = nrun + nt - 1
482  END IF
483 *
484 * --- Test ZGTSVX ---
485 *
486  IF( ifact.GT.1 ) THEN
487 *
488 * Initialize AF to zero.
489 *
490  DO 90 i = 1, 3*n - 2
491  af( i ) = zero
492  90 CONTINUE
493  END IF
494  CALL zlaset( 'Full', n, nrhs, dcmplx( zero ),
495  $ dcmplx( zero ), x, lda )
496 *
497 * Solve the system and compute the condition number and
498 * error bounds using ZGTSVX.
499 *
500  srnamt = 'ZGTSVX'
501  CALL zgtsvx( fact, trans, n, nrhs, a, a( m+1 ),
502  $ a( n+m+1 ), af, af( m+1 ), af( n+m+1 ),
503  $ af( n+2*m+1 ), iwork, b, lda, x, lda,
504  $ rcond, rwork, rwork( nrhs+1 ), work,
505  $ rwork( 2*nrhs+1 ), info )
506 *
507 * Check the error code from ZGTSVX.
508 *
509  IF( info.NE.izero )
510  $ CALL alaerh( path, 'ZGTSVX', info, izero,
511  $ fact // trans, n, n, 1, 1, nrhs, imat,
512  $ nfail, nerrs, nout )
513 *
514  IF( ifact.GE.2 ) THEN
515 *
516 * Reconstruct matrix from factors and compute
517 * residual.
518 *
519  CALL zgtt01( n, a, a( m+1 ), a( n+m+1 ), af,
520  $ af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
521  $ iwork, work, lda, rwork, result( 1 ) )
522  k1 = 1
523  ELSE
524  k1 = 2
525  END IF
526 *
527  IF( info.EQ.0 ) THEN
528  trfcon = .false.
529 *
530 * Check residual of computed solution.
531 *
532  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
533  CALL zgtt02( trans, n, nrhs, a, a( m+1 ),
534  $ a( n+m+1 ), x, lda, work, lda,
535  $ result( 2 ) )
536 *
537 * Check solution from generated exact solution.
538 *
539  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
540  $ result( 3 ) )
541 *
542 * Check the error bounds from iterative refinement.
543 *
544  CALL zgtt05( trans, n, nrhs, a, a( m+1 ),
545  $ a( n+m+1 ), b, lda, x, lda, xact, lda,
546  $ rwork, rwork( nrhs+1 ), result( 4 ) )
547  nt = 5
548  END IF
549 *
550 * Print information about the tests that did not pass
551 * the threshold.
552 *
553  DO 100 k = k1, nt
554  IF( result( k ).GE.thresh ) THEN
555  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
556  $ CALL aladhd( nout, path )
557  WRITE( nout, fmt = 9998 )'ZGTSVX', fact, trans,
558  $ n, imat, k, result( k )
559  nfail = nfail + 1
560  END IF
561  100 CONTINUE
562 *
563 * Check the reciprocal of the condition number.
564 *
565  result( 6 ) = dget06( rcond, rcondc )
566  IF( result( 6 ).GE.thresh ) THEN
567  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
568  $ CALL aladhd( nout, path )
569  WRITE( nout, fmt = 9998 )'ZGTSVX', fact, trans, n,
570  $ imat, k, result( k )
571  nfail = nfail + 1
572  END IF
573  nrun = nrun + nt - k1 + 2
574 *
575  110 CONTINUE
576  120 CONTINUE
577  130 CONTINUE
578  140 CONTINUE
579 *
580 * Print a summary of the results.
581 *
582  CALL alasvm( path, nout, nfail, nrun, nerrs )
583 *
584  9999 FORMAT( 1x, a, ', N =', i5, ', type ', i2, ', test ', i2,
585  $ ', ratio = ', g12.5 )
586  9998 FORMAT( 1x, a, ', FACT=''', a1, ''', TRANS=''', a1, ''', N =',
587  $ i5, ', type ', i2, ', test ', i2, ', ratio = ', g12.5 )
588  RETURN
589 *
590 * End of ZDRVGT
591 *
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:73
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 zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:78
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:81
subroutine zgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
ZGTT02
Definition: zgtt02.f:124
subroutine zerrvx(PATH, NUNIT)
ZERRVX
Definition: zerrvx.f:55
subroutine zgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZGTT05
Definition: zgtt05.f:165
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:102
subroutine zgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
ZGTT01
Definition: zgtt01.f:134
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:121
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:332
subroutine zgttrf(N, DL, D, DU, DU2, IPIV, INFO)
ZGTTRF
Definition: zgttrf.f:124
subroutine zgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
ZGTTRS
Definition: zgttrs.f:138
subroutine zgtsvx(FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZGTSVX computes the solution to system of linear equations A * X = B for GT matrices
Definition: zgtsvx.f:294
subroutine zgtsv(N, NRHS, DL, D, DU, B, LDB, INFO)
ZGTSV computes the solution to system of linear equations A * X = B for GT matrices
Definition: zgtsv.f:124
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:103
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: zlarnv.f:99
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:106
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:106
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:145
double precision function dzasum(N, ZX, INCX)
DZASUM
Definition: dzasum.f:72
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:55
Here is the call graph for this function:
Here is the caller graph for this function: