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

Definition at line 141 of file zdrvgt.f.

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