--- /dev/null
+*> \brief \b CCHKSY_AA
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+* THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
+* XACT, WORK, RWORK, IWORK, NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NNB, NNS, NOUT
+* REAL THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+* COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ RWORK( * ), WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CCHKSY_AA tests CSYTRF_AA, -TRS_AA.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> 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.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*> NNB is INTEGER
+*> The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*> NBVAL is INTEGER array, dimension (NBVAL)
+*> The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*> NNS is INTEGER
+*> The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*> NSVAL is INTEGER array, dimension (NNS)
+*> The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is REAL
+*> 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.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is REAL array, dimension (NMAX*NSMAX)
+*> where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is REAL array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is REAL array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is REAL array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is REAL array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+* @generated from LIN/dchksy_aa.f, fortran d -> c, Wed Nov 16 21:34:18 2016
+*
+*> \ingroup complex_lin
+*
+* =====================================================================
+ SUBROUTINE CCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+ $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
+ $ X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2016
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NN, NNB, NNS, NMAX, NOUT
+ REAL THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+ REAL RWORK( * )
+ COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+ COMPLEX CZERO
+ PARAMETER ( CZERO = 0.0E+0 )
+ INTEGER NTYPES
+ PARAMETER ( NTYPES = 10 )
+ INTEGER NTESTS
+ PARAMETER ( NTESTS = 9 )
+* ..
+* .. Local Scalars ..
+ LOGICAL TRFCON, ZEROT
+ CHARACTER DIST, TYPE, UPLO, XTYPE
+ CHARACTER*3 PATH, MATPATH
+ INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+ $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
+ $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
+ REAL ANORM, CNDNUM, RCONDC
+* ..
+* .. Local Arrays ..
+ CHARACTER UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ REAL RESULT( NTESTS )
+* ..
+* .. External Functions ..
+ REAL DGET06, CLANSY
+ EXTERNAL DGET06, CLANSY
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALAERH, ALAHD, ALASUM, CERRSY, CGET04, CLACPY,
+ $ CLARHS, CLATB4, CLATMS, CSYT02, DSYT03, DSYT05,
+ $ DSYCON, CSYRFS, CSYT01_AA, CSYTRF_AA,
+ $ DSYTRI2, CSYTRS_AA, XLAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Complex precision'
+ PATH( 2: 3 ) = 'SA'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Complex precision'
+ MATPATH( 2: 3 ) = 'SY'
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL CERRSY( PATH, NOUT )
+ INFOT = 0
+*
+* Set the minimum block size for which the block routine should
+* be used, which will be later returned by ILAENV
+*
+ CALL XLAENV( 2, 2 )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ IF( N .GT. NMAX ) THEN
+ NFAIL = NFAIL + 1
+ WRITE(NOUT, 9995) 'M ', N, NMAX
+ GO TO 180
+ END IF
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ IZERO = 0
+*
+* Do for each value of matrix type IMAT
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+*
+* Set up parameters with CLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
+ $ ANORM, MODE, CNDNUM, DIST )
+*
+* Generate a matrix with CLATMS.
+*
+ SRNAMT = 'CLATMS'
+ CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+ $ INFO )
+*
+* Check error code from CLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
+ $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+* Skip all tests for this generated matrix
+*
+ GO TO 160
+ END IF
+*
+* For matrix types 3-6, zero one or more rows and
+* columns of the matrix to test that INFO is returned
+* correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = CZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = CZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = CZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the last IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = CZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+* Do for each value of NB in NBVAL
+*
+ DO 150 INB = 1, NNB
+*
+* Set the optimal blocksize, which will be later
+* returned by ILAENV.
+*
+ NB = NBVAL( INB )
+ CALL XLAENV( 1, NB )
+*
+* Copy the test matrix A into matrix AFAC which
+* will be factorized in place. This is needed to
+* preserve the test matrix A for subsequent tests.
+*
+ CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+* Compute the L*D*L**T or U*D*U**T factorization of the
+* matrix. IWORK stores details of the interchanges and
+* the block structure of D. AINV is a work array for
+* block factorization, LWORK is the length of AINV.
+*
+ SRNAMT = 'CSYTRF_AA'
+ LWORK = N*NB + N
+ CALL CSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
+ $ LWORK, INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from CSYTRF and handle error.
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'CSYTRF_AA', INFO, K, UPLO,
+ $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
+ $ NOUT )
+ END IF
+*
+* Set the condition estimate flag if the INFO is not 0.
+*
+ IF( INFO.NE.0 ) THEN
+ TRFCON = .TRUE.
+ ELSE
+ TRFCON = .FALSE.
+ END IF
+*
+*+ TEST 1
+* Reconstruct matrix from factors and compute residual.
+*
+ CALL CSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
+ $ AINV, LDA, RWORK, RESULT( 1 ) )
+ NT = 1
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+ $ RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+*
+* Do only the condition estimate if INFO is not 0.
+*
+ IF( TRFCON ) THEN
+ RCONDC = ZERO
+ GO TO 140
+ END IF
+*
+* Do for each value of NRHS in NSVAL.
+*
+ DO 130 IRHS = 1, NNS
+ NRHS = NSVAL( IRHS )
+*
+*+ TEST 3 ( Using TRS)
+* Solve and compute residual for A * X = B.
+*
+* Choose a set of NRHS random solution vectors
+* stored in XACT and set up the right hand side B
+*
+ SRNAMT = 'CLARHS'
+ CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+ $ KL, KU, NRHS, A, LDA, XACT, LDA,
+ $ B, LDA, ISEED, INFO )
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+ SRNAMT = 'CSYTRS_AA'
+ LWORK = 3*N-2
+ CALL CSYTRS_AA( UPLO, N, NRHS, AFAC, LDA,
+ $ IWORK, X, LDA, WORK, LWORK,
+ $ INFO )
+*
+* Check error code from CSYTRS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'CSYTRS_AA', INFO, 0,
+ $ UPLO, N, N, -1, -1, NRHS, IMAT,
+ $ NFAIL, NERRS, NOUT )
+ END IF
+*
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+*
+* Compute the residual for the solution
+*
+ CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+ $ LDA, RWORK, RESULT( 2 ) )
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ NRUN = NRUN + 1
+*
+* End do for each value of NRHS in NSVAL.
+*
+ 130 CONTINUE
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+ $ I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+ $ I2, ', test(', I2, ') =', G12.5 )
+ 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
+ $ I6 )
+ RETURN
+*
+* End of CCHKSY_AA
+*
+ END
--- /dev/null
+*> \brief \b CDRVSY_AA
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
+* A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+* NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NOUT, NRHS
+* REAL THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NVAL( * )
+* REAL RWORK( * )
+* COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CDRVSY_AA tests the driver routine CSYSV_AA.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> 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.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand side vectors to be generated for
+*> each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is REAL
+*> 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.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is REAL array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is REAL array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+* @generated from LIN/ddrvsy_aa.f, fortran d -> c, Thu Nov 17 12:14:51 2016
+*
+*> \ingroup complex_lin
+*
+* =====================================================================
+ SUBROUTINE CDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+ $ RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2016
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NMAX, NN, NOUT, NRHS
+ REAL THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NVAL( * )
+ REAL RWORK( * )
+ COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+ COMPLEX CZERO
+ PARAMETER ( CZERO = 0.0E+0 )
+ INTEGER NTYPES, NTESTS
+ PARAMETER ( NTYPES = 10, NTESTS = 3 )
+ INTEGER NFACT
+ PARAMETER ( NFACT = 2 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
+ CHARACTER*3 MATPATH, PATH
+ INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+ $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+ $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+ REAL ANORM, CNDNUM, RCONDC
+* ..
+* .. Local Arrays ..
+ CHARACTER FACTS( NFACT ), UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ REAL RESULT( NTESTS )
+* ..
+* .. External Functions ..
+ REAL DGET06, CLANSY
+ EXTERNAL DGET06, CLANSY
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALADHD, ALAERH, ALASVM, DERRVX, CGET04, CLACPY,
+ $ CLARHS, CLASET, CLATB4, CLATMS, CSYT02, DSYT05,
+ $ CSYSV_AA, CSYT01_AA, CSYTRF_AA, XLAENV
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Complex precision'
+ PATH( 2: 3 ) = 'SA'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Complex precision'
+ MATPATH( 2: 3 ) = 'SY'
+*
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+ LWORK = MAX( 2*NMAX, NMAX*NRHS )
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL CERRVX( PATH, NOUT )
+ INFOT = 0
+*
+* Set the block size and minimum block size for testing.
+*
+ NB = 1
+ NBMIN = 2
+ CALL XLAENV( 1, NB )
+ CALL XLAENV( 2, NBMIN )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Set up parameters with CLATB4 and generate a test matrix
+* with CLATMS.
+*
+ CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+ $ MODE, CNDNUM, DIST )
+*
+ SRNAMT = 'CLATMS'
+ CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+ $ INFO )
+*
+* Check error code from CLATMS.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
+ $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
+ GO TO 160
+ END IF
+*
+* For types 3-6, zero one or more rows and columns of the
+* matrix to test that INFO is returned correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = CZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = CZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IOFF = 0
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = CZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the last IZERO rows and columns to zero.
+*
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = CZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+ DO 150 IFACT = 1, NFACT
+*
+* Do first for FACT = 'F', then for other values.
+*
+ FACT = FACTS( IFACT )
+*
+* Compute the condition number for comparison with
+* the value returned by CSYSVX.
+*
+ IF( ZEROT ) THEN
+ IF( IFACT.EQ.1 )
+ $ GO TO 150
+ RCONDC = ZERO
+*
+ ELSE IF( IFACT.EQ.1 ) THEN
+*
+* Compute the 1-norm of A.
+*
+ ANORM = CLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+* Factor the matrix A.
+*
+c CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+c CALL CSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK,
+c $ LWORK, INFO )
+*
+* Compute inv(A) and take its norm.
+*
+c CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+c LWORK = (N+NB+1)*(NB+3)
+c SRNAMT = 'DSYTRI2'
+c CALL DSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
+c $ LWORK, INFO )
+c AINVNM = CLANSY( '1', UPLO, N, AINV, LDA, RWORK )
+*
+* Compute the 1-norm condition number of A.
+*
+c IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
+c RCONDC = ONE
+c ELSE
+c RCONDC = ( ONE / ANORM ) / AINVNM
+c END IF
+ END IF
+*
+* Form an exact solution and set the right hand side.
+*
+ SRNAMT = 'CLARHS'
+ CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+ $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+ $ INFO )
+ XTYPE = 'C'
+*
+* --- Test CSYSV_AA ---
+*
+ IF( IFACT.EQ.2 ) THEN
+ CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+* Factor the matrix and solve the system using CSYSV_AA.
+*
+ SRNAMT = 'CSYSV_AA'
+ CALL CSYSV_AA( UPLO, N, NRHS, AFAC, LDA, IWORK,
+ $ X, LDA, WORK, LWORK, INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from CSYSV_AA .
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'CSYSV_AA ', INFO, K,
+ $ UPLO, N, N, -1, -1, NRHS,
+ $ IMAT, NFAIL, NERRS, NOUT )
+ GO TO 120
+ ELSE IF( INFO.NE.0 ) THEN
+ GO TO 120
+ END IF
+*
+* Reconstruct matrix from factors and compute
+* residual.
+*
+ CALL CSYT01_AA( UPLO, N, A, LDA, AFAC, LDA,
+ $ IWORK, AINV, LDA, RWORK,
+ $ RESULT( 1 ) )
+*
+* Compute residual of the computed solution.
+*
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+ $ LDA, RWORK, RESULT( 2 ) )
+*
+* Check solution from generated exact solution.
+*
+ CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+ $ RESULT( 3 ) )
+ NT = 3
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALADHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )'CSYSV_AA ',
+ $ UPLO, N, IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+ 120 CONTINUE
+ END IF
+*
+ 150 CONTINUE
+*
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+ $ ', test ', I2, ', ratio =', G12.5 )
+ RETURN
+*
+* End of CDRVSY_AA
+*
+ END
--- /dev/null
+*> \brief \b CSYT01
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC,
+* RWORK, RESID )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER LDA, LDAFAC, LDC, N
+* REAL RESID
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * )
+* REAL RWORK( * )
+* COMPLEX A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CSYT01 reconstructs a hermitian indefinite matrix A from its
+*> block L*D*L' or U*D*U' factorization and computes the residual
+*> norm( C - A ) / ( N * norm(A) * EPS ),
+*> where C is the reconstructed matrix and EPS is the machine epsilon.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the upper or lower triangular part of the
+*> hermitian matrix A is stored:
+*> = 'U': Upper triangular
+*> = 'L': Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of rows and columns of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is REAL array, dimension (LDA,N)
+*> The original hermitian matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N)
+*> \endverbatim
+*>
+*> \param[in] AFAC
+*> \verbatim
+*> AFAC is REAL array, dimension (LDAFAC,N)
+*> The factored form of the matrix A. AFAC contains the block
+*> diagonal matrix D and the multipliers used to obtain the
+*> factor L or U from the block L*D*L' or U*D*U' factorization
+*> as computed by CSYTRF.
+*> \endverbatim
+*>
+*> \param[in] LDAFAC
+*> \verbatim
+*> LDAFAC is INTEGER
+*> The leading dimension of the array AFAC. LDAFAC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> The pivot indices from CSYTRF.
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*> C is REAL array, dimension (LDC,N)
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*> LDC is INTEGER
+*> The leading dimension of the array C. LDC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is REAL array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] RESID
+*> \verbatim
+*> RESID is REAL
+*> If UPLO = 'L', norm(L*D*L' - A) / ( N * norm(A) * EPS )
+*> If UPLO = 'U', norm(U*D*U' - A) / ( N * norm(A) * EPS )
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+* @generated from LIN/dsyt01_aa.f, fortran d -> c, Thu Nov 17 13:01:50 2016
+*
+*> \ingroup complex_lin
+*
+* =====================================================================
+ SUBROUTINE CSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
+ $ LDC, RWORK, RESID )
+*
+* -- LAPACK test routine (version 3.5.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2016
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER LDA, LDAFAC, LDC, N
+ REAL RESID
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * )
+ COMPLEX A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * )
+ REAL RWORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+ COMPLEX CZERO, CONE
+ PARAMETER ( CZERO = 0.0E+0, CONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+ REAL ANORM, EPS
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ REAL SLAMCH, CLANSY
+ EXTERNAL LSAME, SLAMCH, CLANSY
+* ..
+* .. External Subroutines ..
+ EXTERNAL CLASET, CLAVSY
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE
+* ..
+* .. Executable Statements ..
+*
+* Quick exit if N = 0.
+*
+ IF( N.LE.0 ) THEN
+ RESID = ZERO
+ RETURN
+ END IF
+*
+* Determine EPS and the norm of A.
+*
+ EPS = SLAMCH( 'Epsilon' )
+ ANORM = CLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+* Initialize C to the tridiagonal matrix T.
+*
+ CALL CLASET( 'Full', N, N, CZERO, CZERO, C, LDC )
+ CALL CLACPY( 'F', 1, N, AFAC( 1, 1 ), LDAFAC+1, C( 1, 1 ), LDC+1 )
+ IF( N.GT.1 ) THEN
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ CALL CLACPY( 'F', 1, N-1, AFAC( 1, 2 ), LDAFAC+1, C( 1, 2 ),
+ $ LDC+1 )
+ CALL CLACPY( 'F', 1, N-1, AFAC( 1, 2 ), LDAFAC+1, C( 2, 1 ),
+ $ LDC+1 )
+ ELSE
+ CALL CLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 1, 2 ),
+ $ LDC+1 )
+ CALL CLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 2, 1 ),
+ $ LDC+1 )
+ ENDIF
+ ENDIF
+*
+* Call CTRMM to form the product U' * D (or L * D ).
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ CALL CTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N,
+ $ CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC )
+ ELSE
+ CALL CTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
+ $ CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
+ END IF
+*
+* Call CTRMM again to multiply by U (or L ).
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ CALL CTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
+ $ CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
+ ELSE
+ CALL CTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1,
+ $ CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC )
+ END IF
+*
+* Apply hermitian pivots
+*
+ DO J = N, 1, -1
+ I = IPIV( J )
+ IF( I.NE.J )
+ $ CALL CSWAP( N, C( J, 1 ), LDC, C( I, 1 ), LDC )
+ END DO
+ DO J = N, 1, -1
+ I = IPIV( J )
+ IF( I.NE.J )
+ $ CALL CSWAP( N, C( 1, J ), 1, C( 1, I ), 1 )
+ END DO
+*
+*
+* Compute the difference C - A .
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ DO J = 1, N
+ DO I = 1, J
+ C( I, J ) = C( I, J ) - A( I, J )
+ END DO
+ END DO
+ ELSE
+ DO J = 1, N
+ DO I = J, N
+ C( I, J ) = C( I, J ) - A( I, J )
+ END DO
+ END DO
+ END IF
+*
+* Compute norm( C - A ) / ( N * norm(A) * EPS )
+*
+ RESID = CLANSY( '1', UPLO, N, C, LDC, RWORK )
+*
+ IF( ANORM.LE.ZERO ) THEN
+ IF( RESID.NE.ZERO )
+ $ RESID = ONE / EPS
+ ELSE
+ RESID = ( ( RESID / DBLE( N ) ) / ANORM ) / EPS
+ END IF
+*
+ RETURN
+*
+* End of CSYT01
+*
+ END
--- /dev/null
+*> \brief \b ZCHKSY_AA
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+* THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
+* XACT, WORK, RWORK, IWORK, NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NNB, NNS, NOUT
+* COMPLEX*16 THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+* COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ RWORK( * ), WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZCHKSY_AA tests ZSYTRF_AA, -TRS_AA.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> 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.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*> NNB is INTEGER
+*> The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*> NBVAL is INTEGER array, dimension (NBVAL)
+*> The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*> NNS is INTEGER
+*> The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*> NSVAL is INTEGER array, dimension (NNS)
+*> The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is COMPLEX*16
+*> 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.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is COMPLEX*16 array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+* @generated from LIN/dchksy_aa.f, fortran d -> z, Wed Nov 16 21:34:18 2016
+*
+*> \ingroup complex16_lin
+*
+* =====================================================================
+ SUBROUTINE ZCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+ $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
+ $ X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2016
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NN, NNB, NNS, NMAX, NOUT
+ DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+ DOUBLE PRECISION RWORK( * )
+ COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+ COMPLEX*16 CZERO
+ PARAMETER ( CZERO = 0.0E+0 )
+ INTEGER NTYPES
+ PARAMETER ( NTYPES = 10 )
+ INTEGER NTESTS
+ PARAMETER ( NTESTS = 9 )
+* ..
+* .. Local Scalars ..
+ LOGICAL TRFCON, ZEROT
+ CHARACTER DIST, TYPE, UPLO, XTYPE
+ CHARACTER*3 PATH, MATPATH
+ INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+ $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
+ $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
+ DOUBLE PRECISION ANORM, CNDNUM, RCONDC
+* ..
+* .. Local Arrays ..
+ CHARACTER UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ DOUBLE PRECISION RESULT( NTESTS )
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DGET06, ZLANSY
+ EXTERNAL DGET06, ZLANSY
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALAERH, ALAHD, ALASUM, ZERRSY, ZGET04, ZLACPY,
+ $ ZLARHS, ZLATB4, ZLATMS, ZSYT02, DSYT03, DSYT05,
+ $ DSYCON, ZSYRFS, ZSYT01_AA, ZSYTRF_AA,
+ $ DSYTRI2, ZSYTRS_AA, XLAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Zomplex precision'
+ PATH( 2: 3 ) = 'SA'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Zomplex precision'
+ MATPATH( 2: 3 ) = 'SY'
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL ZERRSY( PATH, NOUT )
+ INFOT = 0
+*
+* Set the minimum block size for which the block routine should
+* be used, which will be later returned by ILAENV
+*
+ CALL XLAENV( 2, 2 )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ IF( N .GT. NMAX ) THEN
+ NFAIL = NFAIL + 1
+ WRITE(NOUT, 9995) 'M ', N, NMAX
+ GO TO 180
+ END IF
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ IZERO = 0
+*
+* Do for each value of matrix type IMAT
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+*
+* Set up parameters with ZLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
+ $ ANORM, MODE, CNDNUM, DIST )
+*
+* Generate a matrix with ZLATMS.
+*
+ SRNAMT = 'ZLATMS'
+ CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+ $ INFO )
+*
+* Check error code from ZLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
+ $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+* Skip all tests for this generated matrix
+*
+ GO TO 160
+ END IF
+*
+* For matrix types 3-6, zero one or more rows and
+* columns of the matrix to test that INFO is returned
+* correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = CZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = CZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = CZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the last IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = CZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+* Do for each value of NB in NBVAL
+*
+ DO 150 INB = 1, NNB
+*
+* Set the optimal blocksize, which will be later
+* returned by ILAENV.
+*
+ NB = NBVAL( INB )
+ CALL XLAENV( 1, NB )
+*
+* Copy the test matrix A into matrix AFAC which
+* will be factorized in place. This is needed to
+* preserve the test matrix A for subsequent tests.
+*
+ CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+* Compute the L*D*L**T or U*D*U**T factorization of the
+* matrix. IWORK stores details of the interchanges and
+* the block structure of D. AINV is a work array for
+* block factorization, LWORK is the length of AINV.
+*
+ SRNAMT = 'ZSYTRF_AA'
+ LWORK = N*NB + N
+ CALL ZSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
+ $ LWORK, INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from ZSYTRF and handle error.
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'ZSYTRF_AA', INFO, K, UPLO,
+ $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
+ $ NOUT )
+ END IF
+*
+* Set the condition estimate flag if the INFO is not 0.
+*
+ IF( INFO.NE.0 ) THEN
+ TRFCON = .TRUE.
+ ELSE
+ TRFCON = .FALSE.
+ END IF
+*
+*+ TEST 1
+* Reconstruct matrix from factors and compute residual.
+*
+ CALL ZSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
+ $ AINV, LDA, RWORK, RESULT( 1 ) )
+ NT = 1
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+ $ RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+*
+* Do only the condition estimate if INFO is not 0.
+*
+ IF( TRFCON ) THEN
+ RCONDC = ZERO
+ GO TO 140
+ END IF
+*
+* Do for each value of NRHS in NSVAL.
+*
+ DO 130 IRHS = 1, NNS
+ NRHS = NSVAL( IRHS )
+*
+*+ TEST 3 ( Using TRS)
+* Solve and compute residual for A * X = B.
+*
+* Choose a set of NRHS random solution vectors
+* stored in XACT and set up the right hand side B
+*
+ SRNAMT = 'ZLARHS'
+ CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+ $ KL, KU, NRHS, A, LDA, XACT, LDA,
+ $ B, LDA, ISEED, INFO )
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+ SRNAMT = 'ZSYTRS_AA'
+ LWORK = 3*N-2
+ CALL ZSYTRS_AA( UPLO, N, NRHS, AFAC, LDA,
+ $ IWORK, X, LDA, WORK, LWORK,
+ $ INFO )
+*
+* Check error code from ZSYTRS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'ZSYTRS_AA', INFO, 0,
+ $ UPLO, N, N, -1, -1, NRHS, IMAT,
+ $ NFAIL, NERRS, NOUT )
+ END IF
+*
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+*
+* Compute the residual for the solution
+*
+ CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+ $ LDA, RWORK, RESULT( 2 ) )
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ NRUN = NRUN + 1
+*
+* End do for each value of NRHS in NSVAL.
+*
+ 130 CONTINUE
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+ $ I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+ $ I2, ', test(', I2, ') =', G12.5 )
+ 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
+ $ I6 )
+ RETURN
+*
+* End of ZCHKSY_AA
+*
+ END
--- /dev/null
+*> \brief \b ZDRVSY_AA
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
+* A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+* NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NOUT, NRHS
+* DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NVAL( * )
+* DOUBLE PRECISION RWORK( * )
+* COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZDRVSY_AA tests the driver routine ZSYSV_AA.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> 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.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand side vectors to be generated for
+*> each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is COMPLEX*16
+*> 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.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is COMPLEX*16 array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+* @generated from LIN/ddrvsy_aa.f, fortran d -> z, Thu Nov 17 12:14:51 2016
+*
+*> \ingroup complex16_lin
+*
+* =====================================================================
+ SUBROUTINE ZDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+ $ RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2016
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NMAX, NN, NOUT, NRHS
+ DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NVAL( * )
+ DOUBLE PRECISION RWORK( * )
+ COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+ COMPLEX*16 CZERO
+ PARAMETER ( CZERO = 0.0E+0 )
+ INTEGER NTYPES, NTESTS
+ PARAMETER ( NTYPES = 10, NTESTS = 3 )
+ INTEGER NFACT
+ PARAMETER ( NFACT = 2 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
+ CHARACTER*3 MATPATH, PATH
+ INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+ $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+ $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+ DOUBLE PRECISION ANORM, CNDNUM, RCONDC
+* ..
+* .. Local Arrays ..
+ CHARACTER FACTS( NFACT ), UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ DOUBLE PRECISION RESULT( NTESTS )
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DGET06, ZLANSY
+ EXTERNAL DGET06, ZLANSY
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALADHD, ALAERH, ALASVM, DERRVX, ZGET04, ZLACPY,
+ $ ZLARHS, ZLASET, ZLATB4, ZLATMS, ZSYT02, DSYT05,
+ $ ZSYSV_AA, ZSYT01_AA, ZSYTRF_AA, XLAENV
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Zomplex precision'
+ PATH( 2: 3 ) = 'SA'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Zomplex precision'
+ MATPATH( 2: 3 ) = 'SY'
+*
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+ LWORK = MAX( 2*NMAX, NMAX*NRHS )
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL ZERRVX( PATH, NOUT )
+ INFOT = 0
+*
+* Set the block size and minimum block size for testing.
+*
+ NB = 1
+ NBMIN = 2
+ CALL XLAENV( 1, NB )
+ CALL XLAENV( 2, NBMIN )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Set up parameters with ZLATB4 and generate a test matrix
+* with ZLATMS.
+*
+ CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+ $ MODE, CNDNUM, DIST )
+*
+ SRNAMT = 'ZLATMS'
+ CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+ $ INFO )
+*
+* Check error code from ZLATMS.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
+ $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
+ GO TO 160
+ END IF
+*
+* For types 3-6, zero one or more rows and columns of the
+* matrix to test that INFO is returned correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = CZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = CZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IOFF = 0
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = CZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the last IZERO rows and columns to zero.
+*
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = CZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+ DO 150 IFACT = 1, NFACT
+*
+* Do first for FACT = 'F', then for other values.
+*
+ FACT = FACTS( IFACT )
+*
+* Compute the condition number for comparison with
+* the value returned by ZSYSVX.
+*
+ IF( ZEROT ) THEN
+ IF( IFACT.EQ.1 )
+ $ GO TO 150
+ RCONDC = ZERO
+*
+ ELSE IF( IFACT.EQ.1 ) THEN
+*
+* Compute the 1-norm of A.
+*
+ ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+* Factor the matrix A.
+*
+c CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+c CALL ZSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK,
+c $ LWORK, INFO )
+*
+* Compute inv(A) and take its norm.
+*
+c CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+c LWORK = (N+NB+1)*(NB+3)
+c SRNAMT = 'DSYTRI2'
+c CALL DSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
+c $ LWORK, INFO )
+c AINVNM = ZLANSY( '1', UPLO, N, AINV, LDA, RWORK )
+*
+* Compute the 1-norm condition number of A.
+*
+c IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
+c RCONDC = ONE
+c ELSE
+c RCONDC = ( ONE / ANORM ) / AINVNM
+c END IF
+ END IF
+*
+* Form an exact solution and set the right hand side.
+*
+ SRNAMT = 'ZLARHS'
+ CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+ $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+ $ INFO )
+ XTYPE = 'C'
+*
+* --- Test ZSYSV_AA ---
+*
+ IF( IFACT.EQ.2 ) THEN
+ CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+* Factor the matrix and solve the system using ZSYSV_AA.
+*
+ SRNAMT = 'ZSYSV_AA'
+ CALL ZSYSV_AA( UPLO, N, NRHS, AFAC, LDA, IWORK,
+ $ X, LDA, WORK, LWORK, INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from ZSYSV_AA .
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'ZSYSV_AA ', INFO, K,
+ $ UPLO, N, N, -1, -1, NRHS,
+ $ IMAT, NFAIL, NERRS, NOUT )
+ GO TO 120
+ ELSE IF( INFO.NE.0 ) THEN
+ GO TO 120
+ END IF
+*
+* Reconstruct matrix from factors and compute
+* residual.
+*
+ CALL ZSYT01_AA( UPLO, N, A, LDA, AFAC, LDA,
+ $ IWORK, AINV, LDA, RWORK,
+ $ RESULT( 1 ) )
+*
+* Compute residual of the computed solution.
+*
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+ $ LDA, RWORK, RESULT( 2 ) )
+*
+* Check solution from generated exact solution.
+*
+ CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+ $ RESULT( 3 ) )
+ NT = 3
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALADHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )'ZSYSV_AA ',
+ $ UPLO, N, IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+ 120 CONTINUE
+ END IF
+*
+ 150 CONTINUE
+*
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+ $ ', test ', I2, ', ratio =', G12.5 )
+ RETURN
+*
+* End of ZDRVSY_AA
+*
+ END
--- /dev/null
+*> \brief \b ZSYT01
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC,
+* RWORK, RESID )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER LDA, LDAFAC, LDC, N
+* DOUBLE PRECISION RESID
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * )
+* DOUBLE PRECISION RWORK( * )
+* COMPLEX*16 A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZSYT01 reconstructs a hermitian indefinite matrix A from its
+*> block L*D*L' or U*D*U' factorization and computes the residual
+*> norm( C - A ) / ( N * norm(A) * EPS ),
+*> where C is the reconstructed matrix and EPS is the machine epsilon.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the upper or lower triangular part of the
+*> hermitian matrix A is stored:
+*> = 'U': Upper triangular
+*> = 'L': Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of rows and columns of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> The original hermitian matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N)
+*> \endverbatim
+*>
+*> \param[in] AFAC
+*> \verbatim
+*> AFAC is COMPLEX*16 array, dimension (LDAFAC,N)
+*> The factored form of the matrix A. AFAC contains the block
+*> diagonal matrix D and the multipliers used to obtain the
+*> factor L or U from the block L*D*L' or U*D*U' factorization
+*> as computed by ZSYTRF.
+*> \endverbatim
+*>
+*> \param[in] LDAFAC
+*> \verbatim
+*> LDAFAC is INTEGER
+*> The leading dimension of the array AFAC. LDAFAC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> The pivot indices from ZSYTRF.
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*> C is COMPLEX*16 array, dimension (LDC,N)
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*> LDC is INTEGER
+*> The leading dimension of the array C. LDC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is COMPLEX*16 array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] RESID
+*> \verbatim
+*> RESID is COMPLEX*16
+*> If UPLO = 'L', norm(L*D*L' - A) / ( N * norm(A) * EPS )
+*> If UPLO = 'U', norm(U*D*U' - A) / ( N * norm(A) * EPS )
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+* @generated from LIN/dsyt01_aa.f, fortran d -> z, Thu Nov 17 13:01:50 2016
+*
+*> \ingroup complex16_lin
+*
+* =====================================================================
+ SUBROUTINE ZSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
+ $ LDC, RWORK, RESID )
+*
+* -- LAPACK test routine (version 3.5.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2016
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER LDA, LDAFAC, LDC, N
+ DOUBLE PRECISION RESID
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * )
+ COMPLEX*16 A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * )
+ DOUBLE PRECISION RWORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+ COMPLEX*16 CZERO, CONE
+ PARAMETER ( CZERO = 0.0E+0, CONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+ DOUBLE PRECISION ANORM, EPS
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ DOUBLE PRECISION DLAMCH, ZLANSY
+ EXTERNAL LSAME, DLAMCH, ZLANSY
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZLASET, ZLAVSY
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE
+* ..
+* .. Executable Statements ..
+*
+* Quick exit if N = 0.
+*
+ IF( N.LE.0 ) THEN
+ RESID = ZERO
+ RETURN
+ END IF
+*
+* Determine EPS and the norm of A.
+*
+ EPS = DLAMCH( 'Epsilon' )
+ ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+* Initialize C to the tridiagonal matrix T.
+*
+ CALL ZLASET( 'Full', N, N, CZERO, CZERO, C, LDC )
+ CALL ZLACPY( 'F', 1, N, AFAC( 1, 1 ), LDAFAC+1, C( 1, 1 ), LDC+1 )
+ IF( N.GT.1 ) THEN
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ CALL ZLACPY( 'F', 1, N-1, AFAC( 1, 2 ), LDAFAC+1, C( 1, 2 ),
+ $ LDC+1 )
+ CALL ZLACPY( 'F', 1, N-1, AFAC( 1, 2 ), LDAFAC+1, C( 2, 1 ),
+ $ LDC+1 )
+ ELSE
+ CALL ZLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 1, 2 ),
+ $ LDC+1 )
+ CALL ZLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 2, 1 ),
+ $ LDC+1 )
+ ENDIF
+ ENDIF
+*
+* Call ZTRMM to form the product U' * D (or L * D ).
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ CALL ZTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N,
+ $ CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC )
+ ELSE
+ CALL ZTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
+ $ CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
+ END IF
+*
+* Call ZTRMM again to multiply by U (or L ).
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ CALL ZTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
+ $ CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
+ ELSE
+ CALL ZTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1,
+ $ CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC )
+ END IF
+*
+* Apply hermitian pivots
+*
+ DO J = N, 1, -1
+ I = IPIV( J )
+ IF( I.NE.J )
+ $ CALL ZSWAP( N, C( J, 1 ), LDC, C( I, 1 ), LDC )
+ END DO
+ DO J = N, 1, -1
+ I = IPIV( J )
+ IF( I.NE.J )
+ $ CALL ZSWAP( N, C( 1, J ), 1, C( 1, I ), 1 )
+ END DO
+*
+*
+* Compute the difference C - A .
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ DO J = 1, N
+ DO I = 1, J
+ C( I, J ) = C( I, J ) - A( I, J )
+ END DO
+ END DO
+ ELSE
+ DO J = 1, N
+ DO I = J, N
+ C( I, J ) = C( I, J ) - A( I, J )
+ END DO
+ END DO
+ END IF
+*
+* Compute norm( C - A ) / ( N * norm(A) * EPS )
+*
+ RESID = ZLANSY( '1', UPLO, N, C, LDC, RWORK )
+*
+ IF( ANORM.LE.ZERO ) THEN
+ IF( RESID.NE.ZERO )
+ $ RESID = ONE / EPS
+ ELSE
+ RESID = ( ( RESID / DBLE( N ) ) / ANORM ) / EPS
+ END IF
+*
+ RETURN
+*
+* End of ZSYT01
+*
+ END
projects / platform / upstream / lapack.git / commitdiff