LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

◆ zdrvsy()

 subroutine zdrvsy ( logical, dimension( * ) DOTYPE, integer NN, integer, dimension( * ) NVAL, integer NRHS, double precision THRESH, logical TSTERR, integer NMAX, complex*16, dimension( * ) A, complex*16, dimension( * ) AFAC, 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, dimension( * ) IWORK, integer NOUT )

ZDRVSY

ZDRVSYX

Purpose:
` ZDRVSY tests the driver routines ZSYSV 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 side vectors to be generated for each linear system.``` [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 maximum value permitted for N, used in dimensioning the work arrays.``` [out] A ` A is COMPLEX*16 array, dimension (NMAX*NMAX)` [out] AFAC ` AFAC 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*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(2,NRHS))` [out] RWORK ` RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)` [out] IWORK ` IWORK is INTEGER array, dimension (NMAX)` [in] NOUT ``` NOUT is INTEGER The unit number for output.```
Date
November 2013
Purpose:
``` ZDRVSY tests the driver routines ZSYSV, -SVX, and -SVXX.

Note that this file is used only when the XBLAS are available,
otherwise zdrvsy.f defines this subroutine.```
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 side vectors to be generated for each linear system.``` [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 maximum value permitted for N, used in dimensioning the work arrays.``` [out] A ` A is COMPLEX*16 array, dimension (NMAX*NMAX)` [out] AFAC ` AFAC 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*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(2,NRHS))``` [out] RWORK ` RWORK is DOUBLE PRECISION array, dimension (2*NMAX+2*NRHS)` [out] IWORK ` IWORK is INTEGER array, dimension (NMAX)` [in] NOUT ``` NOUT is INTEGER The unit number for output.```
Date
April 2012

Definition at line 155 of file zdrvsy.f.

155 *
156 * -- LAPACK test routine (version 3.5.0) --
157 * -- LAPACK is a software package provided by Univ. of Tennessee, --
158 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
159 * November 2013
160 *
161 * .. Scalar Arguments ..
162  LOGICAL tsterr
163  INTEGER nmax, nn, nout, nrhs
164  DOUBLE PRECISION thresh
165 * ..
166 * .. Array Arguments ..
167  LOGICAL dotype( * )
168  INTEGER iwork( * ), nval( * )
169  DOUBLE PRECISION rwork( * )
170  COMPLEX*16 a( * ), afac( * ), ainv( * ), b( * ),
171  \$ work( * ), x( * ), xact( * )
172 * ..
173 *
174 * =====================================================================
175 *
176 * .. Parameters ..
177  DOUBLE PRECISION one, zero
178  parameter( one = 1.0d+0, zero = 0.0d+0 )
179  INTEGER ntypes, ntests
180  parameter( ntypes = 11, ntests = 6 )
181  INTEGER nfact
182  parameter( nfact = 2 )
183 * ..
184 * .. Local Scalars ..
185  LOGICAL zerot
186  CHARACTER dist, fact, TYPE, uplo, xtype
187  CHARACTER*3 path
188  INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
189  \$ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
190  \$ nb, nbmin, nerrs, nfail, nimat, nrun, nt
191  DOUBLE PRECISION ainvnm, anorm, cndnum, rcond, rcondc
192 * ..
193 * .. Local Arrays ..
194  CHARACTER facts( nfact ), uplos( 2 )
195  INTEGER iseed( 4 ), iseedy( 4 )
196  DOUBLE PRECISION result( ntests )
197 * ..
198 * .. External Functions ..
199  DOUBLE PRECISION dget06, zlansy
200  EXTERNAL dget06, zlansy
201 * ..
202 * .. External Subroutines ..
203  EXTERNAL aladhd, alaerh, alasvm, xlaenv, zerrvx, zget04,
206  \$ zsytri2
207 * ..
208 * .. Scalars in Common ..
209  LOGICAL lerr, ok
210  CHARACTER*32 srnamt
211  INTEGER infot, nunit
212 * ..
213 * .. Common blocks ..
214  COMMON / infoc / infot, nunit, ok, lerr
215  COMMON / srnamc / srnamt
216 * ..
217 * .. Intrinsic Functions ..
218  INTRINSIC dcmplx, max, min
219 * ..
220 * .. Data statements ..
221  DATA iseedy / 1988, 1989, 1990, 1991 /
222  DATA uplos / 'U', 'L' / , facts / 'F', 'N' /
223 * ..
224 * .. Executable Statements ..
225 *
226 * Initialize constants and the random number seed.
227 *
228  path( 1: 1 ) = 'Zomplex precision'
229  path( 2: 3 ) = 'SY'
230  nrun = 0
231  nfail = 0
232  nerrs = 0
233  DO 10 i = 1, 4
234  iseed( i ) = iseedy( i )
235  10 CONTINUE
236  lwork = max( 2*nmax, nmax*nrhs )
237 *
238 * Test the error exits
239 *
240  IF( tsterr )
241  \$ CALL zerrvx( path, nout )
242  infot = 0
243 *
244 * Set the block size and minimum block size for testing.
245 *
246  nb = 1
247  nbmin = 2
248  CALL xlaenv( 1, nb )
249  CALL xlaenv( 2, nbmin )
250 *
251 * Do for each value of N in NVAL
252 *
253  DO 180 in = 1, nn
254  n = nval( in )
255  lda = max( n, 1 )
256  xtype = 'N'
257  nimat = ntypes
258  IF( n.LE.0 )
259  \$ nimat = 1
260 *
261  DO 170 imat = 1, nimat
262 *
263 * Do the tests only if DOTYPE( IMAT ) is true.
264 *
265  IF( .NOT.dotype( imat ) )
266  \$ GO TO 170
267 *
268 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
269 *
270  zerot = imat.GE.3 .AND. imat.LE.6
271  IF( zerot .AND. n.LT.imat-2 )
272  \$ GO TO 170
273 *
274 * Do first for UPLO = 'U', then for UPLO = 'L'
275 *
276  DO 160 iuplo = 1, 2
277  uplo = uplos( iuplo )
278 *
279  IF( imat.NE.ntypes ) THEN
280 *
281 * Set up parameters with ZLATB4 and generate a test
282 * matrix with ZLATMS.
283 *
284  CALL zlatb4( path, imat, n, n, TYPE, kl, ku, anorm,
285  \$ mode, cndnum, dist )
286 *
287  srnamt = 'ZLATMS'
288  CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode,
289  \$ cndnum, anorm, kl, ku, uplo, a, lda,
290  \$ work, info )
291 *
292 * Check error code from ZLATMS.
293 *
294  IF( info.NE.0 ) THEN
295  CALL alaerh( path, 'ZLATMS', info, 0, uplo, n, n,
296  \$ -1, -1, -1, imat, nfail, nerrs, nout )
297  GO TO 160
298  END IF
299 *
300 * For types 3-6, zero one or more rows and columns of
301 * the matrix to test that INFO is returned correctly.
302 *
303  IF( zerot ) THEN
304  IF( imat.EQ.3 ) THEN
305  izero = 1
306  ELSE IF( imat.EQ.4 ) THEN
307  izero = n
308  ELSE
309  izero = n / 2 + 1
310  END IF
311 *
312  IF( imat.LT.6 ) THEN
313 *
314 * Set row and column IZERO to zero.
315 *
316  IF( iuplo.EQ.1 ) THEN
317  ioff = ( izero-1 )*lda
318  DO 20 i = 1, izero - 1
319  a( ioff+i ) = zero
320  20 CONTINUE
321  ioff = ioff + izero
322  DO 30 i = izero, n
323  a( ioff ) = zero
324  ioff = ioff + lda
325  30 CONTINUE
326  ELSE
327  ioff = izero
328  DO 40 i = 1, izero - 1
329  a( ioff ) = zero
330  ioff = ioff + lda
331  40 CONTINUE
332  ioff = ioff - izero
333  DO 50 i = izero, n
334  a( ioff+i ) = zero
335  50 CONTINUE
336  END IF
337  ELSE
338  IF( iuplo.EQ.1 ) THEN
339 *
340 * Set the first IZERO rows to zero.
341 *
342  ioff = 0
343  DO 70 j = 1, n
344  i2 = min( j, izero )
345  DO 60 i = 1, i2
346  a( ioff+i ) = zero
347  60 CONTINUE
348  ioff = ioff + lda
349  70 CONTINUE
350  ELSE
351 *
352 * Set the last IZERO rows to zero.
353 *
354  ioff = 0
355  DO 90 j = 1, n
356  i1 = max( j, izero )
357  DO 80 i = i1, n
358  a( ioff+i ) = zero
359  80 CONTINUE
360  ioff = ioff + lda
361  90 CONTINUE
362  END IF
363  END IF
364  ELSE
365  izero = 0
366  END IF
367  ELSE
368 *
369 * IMAT = NTYPES: Use a special block diagonal matrix to
370 * test alternate code for the 2-by-2 blocks.
371 *
372  CALL zlatsy( uplo, n, a, lda, iseed )
373  END IF
374 *
375  DO 150 ifact = 1, nfact
376 *
377 * Do first for FACT = 'F', then for other values.
378 *
379  fact = facts( ifact )
380 *
381 * Compute the condition number for comparison with
382 * the value returned by ZSYSVX.
383 *
384  IF( zerot ) THEN
385  IF( ifact.EQ.1 )
386  \$ GO TO 150
387  rcondc = zero
388 *
389  ELSE IF( ifact.EQ.1 ) THEN
390 *
391 * Compute the 1-norm of A.
392 *
393  anorm = zlansy( '1', uplo, n, a, lda, rwork )
394 *
395 * Factor the matrix A.
396 *
397  CALL zlacpy( uplo, n, n, a, lda, afac, lda )
398  CALL zsytrf( uplo, n, afac, lda, iwork, work,
399  \$ lwork, info )
400 *
401 * Compute inv(A) and take its norm.
402 *
403  CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
404  lwork = (n+nb+1)*(nb+3)
405  CALL zsytri2( uplo, n, ainv, lda, iwork, work,
406  \$ lwork, info )
407  ainvnm = zlansy( '1', uplo, n, ainv, lda, rwork )
408 *
409 * Compute the 1-norm condition number of A.
410 *
411  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
412  rcondc = one
413  ELSE
414  rcondc = ( one / anorm ) / ainvnm
415  END IF
416  END IF
417 *
418 * Form an exact solution and set the right hand side.
419 *
420  srnamt = 'ZLARHS'
421  CALL zlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
422  \$ nrhs, a, lda, xact, lda, b, lda, iseed,
423  \$ info )
424  xtype = 'C'
425 *
426 * --- Test ZSYSV ---
427 *
428  IF( ifact.EQ.2 ) THEN
429  CALL zlacpy( uplo, n, n, a, lda, afac, lda )
430  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
431 *
432 * Factor the matrix and solve the system using ZSYSV.
433 *
434  srnamt = 'ZSYSV '
435  CALL zsysv( uplo, n, nrhs, afac, lda, iwork, x,
436  \$ lda, work, lwork, info )
437 *
438 * Adjust the expected value of INFO to account for
439 * pivoting.
440 *
441  k = izero
442  IF( k.GT.0 ) THEN
443  100 CONTINUE
444  IF( iwork( k ).LT.0 ) THEN
445  IF( iwork( k ).NE.-k ) THEN
446  k = -iwork( k )
447  GO TO 100
448  END IF
449  ELSE IF( iwork( k ).NE.k ) THEN
450  k = iwork( k )
451  GO TO 100
452  END IF
453  END IF
454 *
455 * Check error code from ZSYSV .
456 *
457  IF( info.NE.k ) THEN
458  CALL alaerh( path, 'ZSYSV ', info, k, uplo, n,
459  \$ n, -1, -1, nrhs, imat, nfail,
460  \$ nerrs, nout )
461  GO TO 120
462  ELSE IF( info.NE.0 ) THEN
463  GO TO 120
464  END IF
465 *
466 * Reconstruct matrix from factors and compute
467 * residual.
468 *
469  CALL zsyt01( uplo, n, a, lda, afac, lda, iwork,
470  \$ ainv, lda, rwork, result( 1 ) )
471 *
472 * Compute residual of the computed solution.
473 *
474  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
475  CALL zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
476  \$ lda, rwork, result( 2 ) )
477 *
478 * Check solution from generated exact solution.
479 *
480  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
481  \$ result( 3 ) )
482  nt = 3
483 *
484 * Print information about the tests that did not pass
485 * the threshold.
486 *
487  DO 110 k = 1, nt
488  IF( result( k ).GE.thresh ) THEN
489  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
490  \$ CALL aladhd( nout, path )
491  WRITE( nout, fmt = 9999 )'ZSYSV ', uplo, n,
492  \$ imat, k, result( k )
493  nfail = nfail + 1
494  END IF
495  110 CONTINUE
496  nrun = nrun + nt
497  120 CONTINUE
498  END IF
499 *
500 * --- Test ZSYSVX ---
501 *
502  IF( ifact.EQ.2 )
503  \$ CALL zlaset( uplo, n, n, dcmplx( zero ),
504  \$ dcmplx( zero ), afac, lda )
505  CALL zlaset( 'Full', n, nrhs, dcmplx( zero ),
506  \$ dcmplx( zero ), x, lda )
507 *
508 * Solve the system and compute the condition number and
509 * error bounds using ZSYSVX.
510 *
511  srnamt = 'ZSYSVX'
512  CALL zsysvx( fact, uplo, n, nrhs, a, lda, afac, lda,
513  \$ iwork, b, lda, x, lda, rcond, rwork,
514  \$ rwork( nrhs+1 ), work, lwork,
515  \$ rwork( 2*nrhs+1 ), info )
516 *
517 * Adjust the expected value of INFO to account for
518 * pivoting.
519 *
520  k = izero
521  IF( k.GT.0 ) THEN
522  130 CONTINUE
523  IF( iwork( k ).LT.0 ) THEN
524  IF( iwork( k ).NE.-k ) THEN
525  k = -iwork( k )
526  GO TO 130
527  END IF
528  ELSE IF( iwork( k ).NE.k ) THEN
529  k = iwork( k )
530  GO TO 130
531  END IF
532  END IF
533 *
534 * Check the error code from ZSYSVX.
535 *
536  IF( info.NE.k ) THEN
537  CALL alaerh( path, 'ZSYSVX', info, k, fact // uplo,
538  \$ n, n, -1, -1, nrhs, imat, nfail,
539  \$ nerrs, nout )
540  GO TO 150
541  END IF
542 *
543  IF( info.EQ.0 ) THEN
544  IF( ifact.GE.2 ) THEN
545 *
546 * Reconstruct matrix from factors and compute
547 * residual.
548 *
549  CALL zsyt01( uplo, n, a, lda, afac, lda, iwork,
550  \$ ainv, lda, rwork( 2*nrhs+1 ),
551  \$ result( 1 ) )
552  k1 = 1
553  ELSE
554  k1 = 2
555  END IF
556 *
557 * Compute residual of the computed solution.
558 *
559  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
560  CALL zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
561  \$ lda, rwork( 2*nrhs+1 ), result( 2 ) )
562 *
563 * Check solution from generated exact solution.
564 *
565  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
566  \$ result( 3 ) )
567 *
568 * Check the error bounds from iterative refinement.
569 *
570  CALL zpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
571  \$ xact, lda, rwork, rwork( nrhs+1 ),
572  \$ result( 4 ) )
573  ELSE
574  k1 = 6
575  END IF
576 *
577 * Compare RCOND from ZSYSVX with the computed value
578 * in RCONDC.
579 *
580  result( 6 ) = dget06( rcond, rcondc )
581 *
582 * Print information about the tests that did not pass
583 * the threshold.
584 *
585  DO 140 k = k1, 6
586  IF( result( k ).GE.thresh ) THEN
587  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
588  \$ CALL aladhd( nout, path )
589  WRITE( nout, fmt = 9998 )'ZSYSVX', fact, uplo,
590  \$ n, imat, k, result( k )
591  nfail = nfail + 1
592  END IF
593  140 CONTINUE
594  nrun = nrun + 7 - k1
595 *
596  150 CONTINUE
597 *
598  160 CONTINUE
599  170 CONTINUE
600  180 CONTINUE
601 *
602 * Print a summary of the results.
603 *
604  CALL alasvm( path, nout, nfail, nrun, nerrs )
605 *
606  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
607  \$ ', test ', i2, ', ratio =', g12.5 )
608  9998 FORMAT( 1x, a, ', FACT=''', a1, ''', UPLO=''', a1, ''', N =', i5,
609  \$ ', type ', i2, ', test ', i2, ', ratio =', g12.5 )
610  RETURN
611 *
612 * End of ZDRVSY
613 *
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine zsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01
Definition: zsyt01.f:127
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 zsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRI2
Definition: zsytri2.f:129
subroutine zsysv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZSYSV computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: zsysv.f:173
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zsyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZSYT02
Definition: zsyt02.f:129
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine zsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF
Definition: zsytrf.f:184
subroutine zlatsy(UPLO, N, X, LDX, ISEED)
ZLATSY
Definition: zlatsy.f:91
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
Definition: zpot05.f:167
double precision function zlansy(NORM, UPLO, N, A, LDA, WORK)
ZLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex symmetric matrix.
Definition: zlansy.f:125
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
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
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
subroutine zerrvx(PATH, NUNIT)
ZERRVX
Definition: zerrvx.f:57
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
subroutine zsysvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
ZSYSVX computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: zsysvx.f:287
Here is the call graph for this function:
Here is the caller graph for this function: