3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
11 * SUBROUTINE ZDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
12 * A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
15 * .. Scalar Arguments ..
17 * INTEGER NMAX, NN, NOUT, NRHS
18 * DOUBLE PRECISION THRESH
20 * .. Array Arguments ..
22 * INTEGER IWORK( * ), NVAL( * )
23 * DOUBLE PRECISION RWORK( * )
24 * COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
25 * $ WORK( * ), X( * ), XACT( * )
34 *> ZDRVSY tests the driver routines ZSYSV, -SVX, and -SVXX.
36 *> Note that this file is used only when the XBLAS are available,
37 *> otherwise zdrvsy.f defines this subroutine.
45 *> DOTYPE is LOGICAL array, dimension (NTYPES)
46 *> The matrix types to be used for testing. Matrices of type j
47 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
48 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
54 *> The number of values of N contained in the vector NVAL.
59 *> NVAL is INTEGER array, dimension (NN)
60 *> The values of the matrix dimension N.
66 *> The number of right hand side vectors to be generated for
67 *> each linear system.
72 *> THRESH is DOUBLE PRECISION
73 *> The threshold value for the test ratios. A result is
74 *> included in the output file if RESULT >= THRESH. To have
75 *> every test ratio printed, use THRESH = 0.
81 *> Flag that indicates whether error exits are to be tested.
87 *> The maximum value permitted for N, used in dimensioning the
93 *> A is COMPLEX*16 array, dimension (NMAX*NMAX)
98 *> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
103 *> AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
108 *> B is COMPLEX*16 array, dimension (NMAX*NRHS)
113 *> X is COMPLEX*16 array, dimension (NMAX*NRHS)
118 *> XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
123 *> WORK is COMPLEX*16 array, dimension
124 *> (NMAX*max(2,NRHS))
129 *> RWORK is DOUBLE PRECISION array, dimension (2*NMAX+2*NRHS)
134 *> IWORK is INTEGER array, dimension (NMAX)
140 *> The unit number for output.
146 *> \author Univ. of Tennessee
147 *> \author Univ. of California Berkeley
148 *> \author Univ. of Colorado Denver
153 *> \ingroup complex16_lin
155 * =====================================================================
156 SUBROUTINE ZDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
157 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
160 * -- LAPACK test routine (version 3.4.1) --
161 * -- LAPACK is a software package provided by Univ. of Tennessee, --
162 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
165 * .. Scalar Arguments ..
167 INTEGER NMAX, NN, NOUT, NRHS
168 DOUBLE PRECISION THRESH
170 * .. Array Arguments ..
172 INTEGER IWORK( * ), NVAL( * )
173 DOUBLE PRECISION RWORK( * )
174 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
175 $ WORK( * ), X( * ), XACT( * )
178 * =====================================================================
181 DOUBLE PRECISION ONE, ZERO
182 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
183 INTEGER NTYPES, NTESTS
184 PARAMETER ( NTYPES = 11, NTESTS = 6 )
186 PARAMETER ( NFACT = 2 )
188 * .. Local Scalars ..
190 CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE
192 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
193 $ IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
194 $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT,
196 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCOND, RCONDC,
200 CHARACTER FACTS( NFACT ), UPLOS( 2 )
201 INTEGER ISEED( 4 ), ISEEDY( 4 )
202 DOUBLE PRECISION RESULT( NTESTS ), BERR( NRHS ),
203 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
205 * .. External Functions ..
206 DOUBLE PRECISION DGET06, ZLANSY
207 EXTERNAL DGET06, ZLANSY
209 * .. External Subroutines ..
210 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
211 $ ZLACPY, ZLARHS, ZLASET, ZLATB4, ZLATMS, ZLATSY,
212 $ ZPOT05, ZSYSV, ZSYSVX, ZSYT01, ZSYT02, ZSYTRF,
215 * .. Scalars in Common ..
220 * .. Common blocks ..
221 COMMON / INFOC / INFOT, NUNIT, OK, LERR
222 COMMON / SRNAMC / SRNAMT
224 * .. Intrinsic Functions ..
225 INTRINSIC DCMPLX, MAX, MIN
227 * .. Data statements ..
228 DATA ISEEDY / 1988, 1989, 1990, 1991 /
229 DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
231 * .. Executable Statements ..
233 * Initialize constants and the random number seed.
235 PATH( 1: 1 ) = 'Zomplex precision'
241 ISEED( I ) = ISEEDY( I )
243 LWORK = MAX( 2*NMAX, NMAX*NRHS )
245 * Test the error exits
248 $ CALL ZERRVX( PATH, NOUT )
251 * Set the block size and minimum block size for testing.
256 CALL XLAENV( 2, NBMIN )
258 * Do for each value of N in NVAL
268 DO 170 IMAT = 1, NIMAT
270 * Do the tests only if DOTYPE( IMAT ) is true.
272 IF( .NOT.DOTYPE( IMAT ) )
275 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
277 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
278 IF( ZEROT .AND. N.LT.IMAT-2 )
281 * Do first for UPLO = 'U', then for UPLO = 'L'
284 UPLO = UPLOS( IUPLO )
286 IF( IMAT.NE.NTYPES ) THEN
288 * Set up parameters with ZLATB4 and generate a test
289 * matrix with ZLATMS.
291 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
292 $ MODE, CNDNUM, DIST )
295 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
296 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
299 * Check error code from ZLATMS.
302 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N,
303 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
307 * For types 3-6, zero one or more rows and columns of
308 * the matrix to test that INFO is returned correctly.
313 ELSE IF( IMAT.EQ.4 ) THEN
321 * Set row and column IZERO to zero.
323 IF( IUPLO.EQ.1 ) THEN
324 IOFF = ( IZERO-1 )*LDA
325 DO 20 I = 1, IZERO - 1
335 DO 40 I = 1, IZERO - 1
345 IF( IUPLO.EQ.1 ) THEN
347 * Set the first IZERO rows to zero.
359 * Set the last IZERO rows to zero.
376 * IMAT = NTYPES: Use a special block diagonal matrix to
377 * test alternate code for the 2-by-2 blocks.
379 CALL ZLATSY( UPLO, N, A, LDA, ISEED )
382 DO 150 IFACT = 1, NFACT
384 * Do first for FACT = 'F', then for other values.
386 FACT = FACTS( IFACT )
388 * Compute the condition number for comparison with
389 * the value returned by ZSYSVX.
396 ELSE IF( IFACT.EQ.1 ) THEN
398 * Compute the 1-norm of A.
400 ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
402 * Factor the matrix A.
404 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
405 CALL ZSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK,
408 * Compute inv(A) and take its norm.
410 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
411 LWORK = (N+NB+1)*(NB+3)
412 CALL ZSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
414 AINVNM = ZLANSY( '1', UPLO, N, AINV, LDA, RWORK )
416 * Compute the 1-norm condition number of A.
418 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
421 RCONDC = ( ONE / ANORM ) / AINVNM
425 * Form an exact solution and set the right hand side.
428 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
429 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
435 IF( IFACT.EQ.2 ) THEN
436 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
437 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
439 * Factor the matrix and solve the system using ZSYSV.
442 CALL ZSYSV( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
443 $ LDA, WORK, LWORK, INFO )
445 * Adjust the expected value of INFO to account for
451 IF( IWORK( K ).LT.0 ) THEN
452 IF( IWORK( K ).NE.-K ) THEN
456 ELSE IF( IWORK( K ).NE.K ) THEN
462 * Check error code from ZSYSV .
465 CALL ALAERH( PATH, 'ZSYSV ', INFO, K, UPLO, N,
466 $ N, -1, -1, NRHS, IMAT, NFAIL,
469 ELSE IF( INFO.NE.0 ) THEN
473 * Reconstruct matrix from factors and compute
476 CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
477 $ AINV, LDA, RWORK, RESULT( 1 ) )
479 * Compute residual of the computed solution.
481 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
482 CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
483 $ LDA, RWORK, RESULT( 2 ) )
485 * Check solution from generated exact solution.
487 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
491 * Print information about the tests that did not pass
495 IF( RESULT( K ).GE.THRESH ) THEN
496 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
497 $ CALL ALADHD( NOUT, PATH )
498 WRITE( NOUT, FMT = 9999 )'ZSYSV ', UPLO, N,
499 $ IMAT, K, RESULT( K )
507 * --- Test ZSYSVX ---
510 $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ),
511 $ DCMPLX( ZERO ), AFAC, LDA )
512 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
513 $ DCMPLX( ZERO ), X, LDA )
515 * Solve the system and compute the condition number and
516 * error bounds using ZSYSVX.
519 CALL ZSYSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
520 $ IWORK, B, LDA, X, LDA, RCOND, RWORK,
521 $ RWORK( NRHS+1 ), WORK, LWORK,
522 $ RWORK( 2*NRHS+1 ), INFO )
524 * Adjust the expected value of INFO to account for
530 IF( IWORK( K ).LT.0 ) THEN
531 IF( IWORK( K ).NE.-K ) THEN
535 ELSE IF( IWORK( K ).NE.K ) THEN
541 * Check the error code from ZSYSVX.
544 CALL ALAERH( PATH, 'ZSYSVX', INFO, K, FACT // UPLO,
545 $ N, N, -1, -1, NRHS, IMAT, NFAIL,
551 IF( IFACT.GE.2 ) THEN
553 * Reconstruct matrix from factors and compute
556 CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
557 $ AINV, LDA, RWORK( 2*NRHS+1 ),
564 * Compute residual of the computed solution.
566 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
567 CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
568 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
570 * Check solution from generated exact solution.
572 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
575 * Check the error bounds from iterative refinement.
577 CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
578 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
584 * Compare RCOND from ZSYSVX with the computed value
587 RESULT( 6 ) = DGET06( RCOND, RCONDC )
589 * Print information about the tests that did not pass
593 IF( RESULT( K ).GE.THRESH ) THEN
594 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
595 $ CALL ALADHD( NOUT, PATH )
596 WRITE( NOUT, FMT = 9998 )'ZSYSVX', FACT, UPLO,
597 $ N, IMAT, K, RESULT( K )
603 * --- Test ZSYSVXX ---
605 * Restore the matrices A and B.
608 $ CALL ZLASET( UPLO, N, N, CMPLX( ZERO ),
609 $ CMPLX( ZERO ), AFAC, LDA )
610 CALL ZLASET( 'Full', N, NRHS, CMPLX( ZERO ),
611 $ CMPLX( ZERO ), X, LDA )
613 * Solve the system and compute the condition number
614 * and error bounds using ZSYSVXX.
619 CALL ZSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
620 $ LDA, IWORK, EQUED, WORK( N+1 ), B, LDA, X,
621 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
622 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
625 * Adjust the expected value of INFO to account for
631 IF( IWORK( K ).LT.0 ) THEN
632 IF( IWORK( K ).NE.-K ) THEN
636 ELSE IF( IWORK( K ).NE.K ) THEN
642 * Check the error code from ZSYSVXX.
644 IF( INFO.NE.K .AND. INFO.LE.N ) THEN
645 CALL ALAERH( PATH, 'ZSYSVXX', INFO, K,
646 $ FACT // UPLO, N, N, -1, -1, NRHS, IMAT, NFAIL,
652 IF( IFACT.GE.2 ) THEN
654 * Reconstruct matrix from factors and compute
657 CALL ZSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
658 $ AINV, LDA, RWORK(2*NRHS+1),
665 * Compute residual of the computed solution.
667 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
668 CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
669 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
672 * Check solution from generated exact solution.
674 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
677 * Check the error bounds from iterative refinement.
679 CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
680 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
686 * Compare RCOND from ZSYSVXX with the computed value
689 RESULT( 6 ) = DGET06( RCOND, RCONDC )
691 * Print information about the tests that did not pass
695 IF( RESULT( K ).GE.THRESH ) THEN
696 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
697 $ CALL ALADHD( NOUT, PATH )
698 WRITE( NOUT, FMT = 9998 )'ZSYSVXX',
699 $ FACT, UPLO, N, IMAT, K,
712 * Print a summary of the results.
714 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
717 * Test Error Bounds from ZSYSVXX
719 CALL ZEBCHVXX(THRESH, PATH)
721 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
722 $ ', test ', I2, ', ratio =', G12.5 )
723 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5,
724 $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 )