*> CPB 8 List types on next line if 0 < NTYPES < 8
*> CPT 12 List types on next line if 0 < NTYPES < 12
*> CHE 10 List types on next line if 0 < NTYPES < 10
+*> CHR 10 List types on next line if 0 < NTYPES < 10
*> CHP 10 List types on next line if 0 < NTYPES < 10
*> CSY 11 List types on next line if 0 < NTYPES < 11
*> CSR 11 List types on next line if 0 < NTYPES < 11
* ..
* .. External Subroutines ..
EXTERNAL ALAREQ, CCHKEQ, CCHKGB, CCHKGE, CCHKGT, CCHKHE,
- $ CCHKHP, CCHKLQ, CCHKPB, CCHKPO, CCHKPS, CCHKPP,
- $ CCHKPT, CCHKQ3, CCHKQL, CCHKQP, CCHKQR, CCHKRQ,
- $ CCHKSP, CCHKSY, CCHKSY_ROOK, CCHKTB, CCHKTP,
- $ CCHKTR, CCHKTZ, CDRVGB, CDRVGE, CDRVGT, CDRVHE,
- $ CDRVHP, CDRVLS, CDRVPB, CDRVPO, CDRVPP, CDRVPT,
- $ CDRVSP, CDRVSY, CDRVSY_ROOK, ILAVER, CCHKQRT,
- $ CCHKQRTP
+ $ CCHKHE_ROOK, CCHKHP, CCHKLQ, CCHKPB, CCHKPO,
+ $ CCHKPS, CCHKPP, CCHKPT, CCHKQ3, CCHKQL, CCHKQP,
+ $ CCHKQR, CCHKRQ, CCHKSP, CCHKSY, CCHKSY_ROOK,
+ $ CCHKTB, CCHKTP, CCHKTR, CCHKTZ, CDRVGB, CDRVGE,
+ $ CDRVGT, CDRVHE, CDRVHE_ROOK, CDRVHP, CDRVLS,
+ $ CDRVPB, CDRVPO, CDRVPP, CDRVPT, CDRVSP, CDRVSY,
+ $ CDRVSY_ROOK, ILAVER, CCHKQRT, CCHKQRTP
+
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
*
ELSE IF( LSAMEN( 2, C2, 'HE' ) ) THEN
*
-* HE: Hermitian indefinite matrices
+* HE: Hermitian indefinite matrices,
+* with partial (Bunch-Kaufman) pivoting algorithm
*
NTYPES = 10
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
ELSE
WRITE( NOUT, FMT = 9988 )PATH
END IF
+*
+ ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+*
+* HR: Hermitian indefinite matrices,
+* with "rook" (bounded Bunch-Kaufman) pivoting algorithm
+*
+ NTYPES = 10
+ CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+ IF( TSTCHK ) THEN
+ CALL CCHKHE_ROOK(DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+ $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
+ $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9989 )PATH
+ END IF
+*
+ IF( TSTDRV ) THEN
+ CALL CDRVHE_ROOK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+ $ RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9988 )PATH
+ END IF
*
ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
*
-* HP: Hermitian indefinite packed matrices
+* HP: Hermitian indefinite packed matrices,
+* with partial (Bunch-Kaufman) pivoting algorithm
*
NTYPES = 10
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
*
ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
*
-* SR: symmetric indefinite matrices with Rook pivoting,
-* with rook (bounded Bunch-Kaufman) pivoting algorithm
+* SR: symmetric indefinite matrices,
+* with "rook" (bounded Bunch-Kaufman) pivoting algorithm
*
NTYPES = 11
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
* ..
* .. Local Arrays ..
CHARACTER UPLOS( 2 )
- INTEGER ISEED( 4 ), ISEEDY( 4 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 ), IDUMMY( 1 )
REAL RESULT( NTESTS )
- COMPLEX BLOCK( 2, 2 ), CDUMMY( 1 )
+ COMPLEX CDUMMY( 1 )
* ..
* .. External Functions ..
REAL CLANGE, CLANHE, SGET06
IF( IWORK( K ).GT.ZERO ) THEN
*
* Get max absolute value from elements
-* in column k in in U
+* in column k in U
*
STEMP = CLANGE( 'M', K-1, 1,
$ AFAC( ( K-1 )*LDA+1 ), LDA, RWORK )
*
CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) )*
$ ( ( ONE + ALPHA ) / ( ONE - ALPHA ) )
+ CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
*
IF( IUPLO.EQ.1 ) THEN
*
* Get the two eigenvalues of a 2-by-2 block,
* store them in WORK array
*
- BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
- BLOCK( 2, 1 ) = AFAC( ( K-2 )*LDA+K )
- BLOCK( 1, 2 ) = BLOCK( 2, 1 )
- BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
+ CALL CHEEVX( 'N', 'A', UPLO, 2,
+ $ AINV( ( K-2 )*LDA+K-1 ), LDA,STEMP,
+ $ STEMP, ITEMP, ITEMP, ZERO, ITEMP,
+ $ RWORK, CDUMMY, 1, WORK, 16,
+ $ RWORK( 3 ), IWORK( N+1 ), IDUMMY,
+ $ INFO )
*
- CALL CHEEVX( 'N', 'N', 'N', 'N', 2, BLOCK,
- $ 2, WORK, CDUMMY, 1, CDUMMY, 1,
- $ ITEMP, ITEMP2, RWORK, STEMP,
- $ RWORK( 3 ), RWORK( 5 ), WORK( 3 ),
- $ 4, RWORK( 7 ), INFO )
-*
- LAM_MAX = MAX( ABS( WORK( 1 ) ),
- $ ABS( WORK( 2 ) ) )
- LAM_MIN = MIN( ABS( WORK( 1 ) ),
- $ ABS( WORK( 2 ) ) )
+ LAM_MAX = MAX( ABS( RWORK( 1 ) ),
+ $ ABS( RWORK( 2 ) ) )
+ LAM_MIN = MIN( ABS( RWORK( 1 ) ),
+ $ ABS( RWORK( 2 ) ) )
*
STEMP = LAM_MAX / LAM_MIN
*
* Get the two eigenvalues of a 2-by-2 block,
* store them in WORK array
*
- BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K )
- BLOCK( 2, 1 ) = AFAC( ( K-1 )*LDA+K+1 )
- BLOCK( 1, 2 ) = BLOCK( 2, 1 )
- BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 )
-*
- CALL CHEEVX( 'N', 'N', 'N', 'N', 2, BLOCK,
- $ 2, WORK, CDUMMY, 1, CDUMMY, 1,
- $ ITEMP, ITEMP2, RWORK, STEMP,
- $ RWORK( 3 ), RWORK( 5 ), WORK( 3 ),
- $ 4, RWORK( 7 ), INFO )
+ CALL CHEEVX( 'N', 'A', UPLO, 2,
+ $ AINV( ( K-1 )*LDA+K ), LDA, STEMP,
+ $ STEMP, ITEMP, ITEMP, ZERO, ITEMP,
+ $ RWORK, CDUMMY, 1, WORK, 16,
+ $ RWORK( 3 ), IWORK( N+1 ), IDUMMY,
+ $ INFO )
*
- LAM_MAX = MAX( ABS( WORK( 1 ) ),
- $ ABS( WORK( 2 ) ) )
- LAM_MIN = MIN( ABS( WORK( 1 ) ),
- $ ABS( WORK( 2 ) ) )
+ LAM_MAX = MAX( ABS( RWORK( 1 ) ),
+ $ ABS( RWORK( 2 ) ) )
+ LAM_MIN = MIN( ABS( RWORK( 1 ) ),
+ $ ABS( RWORK( 2 ) ) )
*
STEMP = LAM_MAX / LAM_MIN
*
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 )
+ $ I2, ', test ', I2, ', ratio =', G12.5 )
9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
- $ ', test(', I2, ') =', G12.5 )
+ $ ', test ', I2, ', ratio =', G12.5 )
RETURN
*
* End of CCHKHE_ROOK
*
* Factor the matrix A.
*
-
CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
CALL CHETRF_ROOK( UPLO, N, AFAC, LDA, IWORK, WORK,
$ LWORK, INFO )
*
* =========== DOCUMENTATION ===========
*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE CERRHE( PATH, NUNIT )
-*
+*
* .. Scalar Arguments ..
* CHARACTER*3 PATH
* INTEGER NUNIT
* ..
-*
+*
*
*> \par Purpose:
* =============
* Authors:
* ========
*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
*
*> \date November 2011
*
EXTERNAL LSAMEN
* ..
* .. External Subroutines ..
- EXTERNAL ALAESM, CHECON, CHERFS, CHETF2, CHETRF, CHETRI,
- $ CHETRI2, CHETRS, CHKXER, CHPCON, CHPRFS,
- $ CHPTRF, CHPTRI, CHPTRS
+ EXTERNAL ALAESM, CHECON, CHECON_ROOK, CHERFS, CHETF2,
+ $ CHETF2_ROOK, CHETRF, CHETRF_ROOK, CHETRI,
+ $ CHETRI_ROOK, CHETRI2, CHETRS, CHETRS_ROOK,
+ $ CHKXER, CHPCON, CHPRFS, CHPTRF, CHPTRI, CHPTRS
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
ANRM = 1.0
OK = .TRUE.
*
-* Test error exits of the routines that use the diagonal pivoting
-* factorization of a Hermitian indefinite matrix.
+* Test error exits of the routines that use factorization
+* of a Hermitian indefinite matrix with patrial
+* (Bunch-Kaufman) diagonal pivoting method.
*
IF( LSAMEN( 2, C2, 'HE' ) ) THEN
*
CALL CHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
*
+* Test error exits of the routines that use factorization
+* of a Hermitian indefinite matrix with "rook"
+* (bounded Bunch-Kaufman) diagonal pivoting method.
+*
+ ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+*
+* CHETRF_ROOK
+*
+ SRNAMT = 'CHETRF_ROOK'
+ INFOT = 1
+ CALL CHETRF_ROOK( '/', 0, A, 1, IP, W, 1, INFO )
+ CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CHETRF_ROOK( 'U', -1, A, 1, IP, W, 1, INFO )
+ CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL CHETRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
+ CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK )
+*
+* CHETF2_ROOK
+*
+ SRNAMT = 'CHETF2_ROOK'
+ INFOT = 1
+ CALL CHETF2_ROOK( '/', 0, A, 1, IP, INFO )
+ CALL CHKXER( 'CHETF2_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CHETF2_ROOK( 'U', -1, A, 1, IP, INFO )
+ CALL CHKXER( 'CHETF2_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL CHETF2_ROOK( 'U', 2, A, 1, IP, INFO )
+ CALL CHKXER( 'CHETF2_ROOK', INFOT, NOUT, LERR, OK )
+*
+* CHETRI_ROOK
+*
+ SRNAMT = 'CHETRI_ROOK'
+ INFOT = 1
+ CALL CHETRI_ROOK( '/', 0, A, 1, IP, W, INFO )
+ CALL CHKXER( 'CHETRI_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CHETRI_ROOK( 'U', -1, A, 1, IP, W, INFO )
+ CALL CHKXER( 'CHETRI_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL CHETRI_ROOK( 'U', 2, A, 1, IP, W, INFO )
+ CALL CHKXER( 'CHETRI_ROOK', INFOT, NOUT, LERR, OK )
+*
+* CHETRS_ROOK
+*
+ SRNAMT = 'CHETRS_ROOK'
+ INFOT = 1
+ CALL CHETRS_ROOK( '/', 0, 0, A, 1, IP, B, 1, INFO )
+ CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CHETRS_ROOK( 'U', -1, 0, A, 1, IP, B, 1, INFO )
+ CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL CHETRS_ROOK( 'U', 0, -1, A, 1, IP, B, 1, INFO )
+ CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL CHETRS_ROOK( 'U', 2, 1, A, 1, IP, B, 2, INFO )
+ CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 8
+ CALL CHETRS_ROOK( 'U', 2, 1, A, 2, IP, B, 1, INFO )
+ CALL CHKXER( 'CHETRS_ROOK', INFOT, NOUT, LERR, OK )
+*
+* CHECON_ROOK
+*
+ SRNAMT = 'CHECON_ROOK'
+ INFOT = 1
+ CALL CHECON_ROOK( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
+ CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CHECON_ROOK( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
+ CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL CHECON_ROOK( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
+ CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 6
+ CALL CHECON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
+ CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK )
+*
* Test error exits of the routines that use the diagonal pivoting
* factorization of a Hermitian indefinite packed matrix.
*
*
* =========== DOCUMENTATION ===========
*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE CERRVX( PATH, NUNIT )
-*
+*
* .. Scalar Arguments ..
* CHARACTER*3 PATH
* INTEGER NUNIT
* ..
-*
+*
*
*> \par Purpose:
* =============
* Authors:
* ========
*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
*
*> \date April 2012
*
* ..
* .. External Subroutines ..
EXTERNAL CGBSV, CGBSVX, CGESV, CGESVX, CGTSV, CGTSVX,
- $ CHESV, CHESVX, CHKXER, CHPSV, CHPSVX, CPBSV,
- $ CPBSVX, CPOSV, CPOSVX, CPPSV, CPPSVX, CPTSV,
- $ CPTSVX, CSPSV, CSPSVX, CSYSV, CSYSV_ROOK,
- $ CSYSVX
+ $ CHESV, CHESV_ROOK, CHESVX, CHKXER, CHPSV,
+ $ CHPSVX, CPBSV, CPBSVX, CPOSV, CPOSVX, CPPSV,
+ $ CPPSVX, CPTSV, CPTSVX, CSPSV, CSPSVX, CSYSV,
+ $ CSYSV_ROOK, CSYSVX
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
CALL CHESVX( 'N', 'U', 2, 0, A, 2, AF, 2, IP, B, 2, X, 2,
$ RCOND, R1, R2, W, 3, RW, INFO )
CALL CHKXER( 'CHESVX', INFOT, NOUT, LERR, OK )
+*
+ ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+*
+* CHESV_ROOK
+*
+ SRNAMT = 'CHESV_ROOK'
+ INFOT = 1
+ CALL CHESV_ROOK( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
+ CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CHESV_ROOK( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
+ CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL CHESV_ROOK( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
+ CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 8
+ CALL CHESV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
+ CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
*
ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
*
*> ZPB 8 List types on next line if 0 < NTYPES < 8
*> ZPT 12 List types on next line if 0 < NTYPES < 12
*> ZHE 10 List types on next line if 0 < NTYPES < 10
+*> ZHR 10 List types on next line if 0 < NTYPES < 10
*> ZHP 10 List types on next line if 0 < NTYPES < 10
*> ZSY 11 List types on next line if 0 < NTYPES < 11
*> ZSR 11 List types on next line if 0 < NTYPES < 11
* ..
* .. External Subroutines ..
EXTERNAL ALAREQ, ZCHKEQ, ZCHKGB, ZCHKGE, ZCHKGT, ZCHKHE,
- $ ZCHKHP, ZCHKLQ, ZCHKPB, ZCHKPO, ZCHKPS, ZCHKPP,
- $ ZCHKPT, ZCHKQ3, ZCHKQL, ZCHKQP, ZCHKQR, ZCHKRQ,
- $ ZCHKSP, ZCHKSY, ZCHKSY_ROOK, ZCHKTB, ZCHKTP,
- $ ZCHKTR, ZCHKTZ, ZDRVGB, ZDRVGE, ZDRVGT, ZDRVHE,
- $ ZDRVHP, ZDRVLS, ZDRVPB, ZDRVPO, ZDRVPP, ZDRVPT,
- $ ZDRVSP, ZDRVSY, ZDRVSY_ROOK, ILAVER, ZCHKQRT,
- $ ZCHKQRTP
+ $ ZCHKHE_ROOK, ZCHKHP, ZCHKLQ, ZCHKPB, ZCHKPO,
+ $ ZCHKPS, ZCHKPP, ZCHKPT, ZCHKQ3, ZCHKQL, ZCHKQP,
+ $ ZCHKQR, ZCHKRQ, ZCHKSP, ZCHKSY, ZCHKSY_ROOK,
+ $ ZCHKTB, ZCHKTP, ZCHKTR, ZCHKTZ, ZDRVGB, ZDRVGE,
+ $ ZDRVGT, ZDRVHE, ZDRVHE_ROOK, ZDRVHP, ZDRVLS,
+ $ ZDRVPB, ZDRVPO, ZDRVPP, ZDRVPT, ZDRVSP, ZDRVSY,
+ $ ZDRVSY_ROOK, ILAVER, ZCHKQRT, ZCHKQRTP
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
ELSE
WRITE( NOUT, FMT = 9988 )PATH
END IF
+*
+ ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+*
+* HR: Hermitian indefinite matrices,
+* with "rook" (bounded Bunch-Kaufman) pivoting algorithm
+*
+ NTYPES = 10
+ CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+ IF( TSTCHK ) THEN
+ CALL ZCHKHE_ROOK(DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+ $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
+ $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9989 )PATH
+ END IF
+*
+ IF( TSTDRV ) THEN
+ CALL ZDRVHE_ROOK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+ $ RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9988 )PATH
+ END IF
*
ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
*
*
ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
*
-* SR: symmetric indefinite matrices with Rook pivoting,
-* with rook (bounded Bunch-Kaufman) pivoting algorithm
+* SR: symmetric indefinite matrices,
+* with "rook" (bounded Bunch-Kaufman) pivoting algorithm
*
NTYPES = 11
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
*>
*> \param[out] A
*> \verbatim
-*> A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> A is CCOMPLEX*16 array, dimension (NMAX*NMAX)
*> \endverbatim
*>
*> \param[out] AFAC
*>
*> \param[out] B
*> \verbatim
-*> B is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> B is CCOMPLEX*16 array, dimension (NMAX*NSMAX)
*> where NSMAX is the largest entry in NSVAL.
*> \endverbatim
*>
*>
*> \param[out] RWORK
*> \verbatim
-*> RWORK is DOUBLE PRECISION array, dimension (max(NMAX,2*NSMAX))
+*> RWORK is DOUBLE PRECISION array, dimension (max(NMAX,2*NSMAX)
*> \endverbatim
*>
*> \param[out] IWORK
* ..
* .. Local Arrays ..
CHARACTER UPLOS( 2 )
- INTEGER ISEED( 4 ), ISEEDY( 4 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 ), IDUMMY( 1 )
DOUBLE PRECISION RESULT( NTESTS )
- COMPLEX*16 BLOCK( 2, 2 ), CDUMMY( 1 )
+ COMPLEX*16 CDUMMY( 1 )
* ..
* .. External Functions ..
DOUBLE PRECISION ZLANGE, ZLANHE, DGET06
IF( IWORK( K ).GT.ZERO ) THEN
*
* Get max absolute value from elements
-* in column k in in U
+* in column k in U
*
DTEMP = ZLANGE( 'M', K-1, 1,
$ AFAC( ( K-1 )*LDA+1 ), LDA, RWORK )
*
CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) )*
$ ( ( ONE + ALPHA ) / ( ONE - ALPHA ) )
+ CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
*
IF( IUPLO.EQ.1 ) THEN
*
* Get the two eigenvalues of a 2-by-2 block,
* store them in WORK array
*
- BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
- BLOCK( 2, 1 ) = AFAC( ( K-2 )*LDA+K )
- BLOCK( 1, 2 ) = BLOCK( 2, 1 )
- BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
+ CALL ZHEEVX( 'N', 'A', UPLO, 2,
+ $ AINV( ( K-2 )*LDA+K-1 ), LDA,DTEMP,
+ $ DTEMP, ITEMP, ITEMP, ZERO, ITEMP,
+ $ RWORK, CDUMMY, 1, WORK, 16,
+ $ RWORK( 3 ), IWORK( N+1 ), IDUMMY,
+ $ INFO )
*
- CALL ZHEEVX( 'N', 'N', 'N', 'N', 2, BLOCK,
- $ 2, WORK, CDUMMY, 1, CDUMMY, 1,
- $ ITEMP, ITEMP2, RWORK, DTEMP,
- $ RWORK( 3 ), RWORK( 5 ), WORK( 3 ),
- $ 4, RWORK( 7 ), INFO )
-*
- LAM_MAX = MAX( ABS( WORK( 1 ) ),
- $ ABS( WORK( 2 ) ) )
- LAM_MIN = MIN( ABS( WORK( 1 ) ),
- $ ABS( WORK( 2 ) ) )
+ LAM_MAX = MAX( ABS( RWORK( 1 ) ),
+ $ ABS( RWORK( 2 ) ) )
+ LAM_MIN = MIN( ABS( RWORK( 1 ) ),
+ $ ABS( RWORK( 2 ) ) )
*
DTEMP = LAM_MAX / LAM_MIN
*
* Get the two eigenvalues of a 2-by-2 block,
* store them in WORK array
*
- BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K )
- BLOCK( 2, 1 ) = AFAC( ( K-1 )*LDA+K+1 )
- BLOCK( 1, 2 ) = BLOCK( 2, 1 )
- BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 )
-*
- CALL ZHEEVX( 'N', 'N', 'N', 'N', 2, BLOCK,
- $ 2, WORK, CDUMMY, 1, CDUMMY, 1,
- $ ITEMP, ITEMP2, RWORK, DTEMP,
- $ RWORK( 3 ), RWORK( 5 ), WORK( 3 ),
- $ 4, RWORK( 7 ), INFO )
+ CALL ZHEEVX( 'N', 'A', UPLO, 2,
+ $ AINV( ( K-1 )*LDA+K ), LDA, DTEMP,
+ $ DTEMP, ITEMP, ITEMP, ZERO, ITEMP,
+ $ RWORK, CDUMMY, 1, WORK, 16,
+ $ RWORK( 3 ), IWORK( N+1 ), IDUMMY,
+ $ INFO )
*
- LAM_MAX = MAX( ABS( WORK( 1 ) ),
- $ ABS( WORK( 2 ) ) )
- LAM_MIN = MIN( ABS( WORK( 1 ) ),
- $ ABS( WORK( 2 ) ) )
+ LAM_MAX = MAX( ABS( RWORK( 1 ) ),
+ $ ABS( RWORK( 2 ) ) )
+ LAM_MIN = MIN( ABS( RWORK( 1 ) ),
+ $ ABS( RWORK( 2 ) ) )
*
DTEMP = LAM_MAX / LAM_MIN
*
DO 220 IRHS = 1, NNS
NRHS = NSVAL( IRHS )
*
+* Begin loop over NRHS values
+*
+*
*+ TEST 5 ( Using TRS_ROOK)
* Solve and compute residual for A * X = B.
*
$ UPLO, N, N, -1, -1, -1, IMAT,
$ NFAIL, NERRS, NOUT )
*
-* Compute the test ratio to compare to values of RCOND
+* Compute the test ratio to compare values of RCOND
*
RESULT( 7 ) = DGET06( RCOND, RCONDC )
*
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 )
+ $ I2, ', test ', I2, ', ratio =', G12.5 )
9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
- $ ', test(', I2, ') =', G12.5 )
+ $ ', test ', I2, ', ratio =', G12.5 )
RETURN
*
* End of ZCHKHE_ROOK
EXTERNAL ZLANHE
* ..
* .. External Subroutines ..
- EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, CERRVX,
+ EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX,
$ ZGET04, ZLACPY, ZLARHS, ZLATB4, ZLATMS,
$ ZHESV_ROOK, ZHET01_ROOK, ZPOT02,
$ ZHETRF_ROOK, ZHETRI_ROOK
* Test the error exits
*
IF( TSTERR )
- $ CALL CERRVX( PATH, NOUT )
+ $ CALL ZERRVX( PATH, NOUT )
INFOT = 0
*
* Set the block size and minimum block size for which the block
*
* =========== DOCUMENTATION ===========
*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE ZERRHE( PATH, NUNIT )
-*
+*
* .. Scalar Arguments ..
* CHARACTER*3 PATH
* INTEGER NUNIT
* ..
-*
+*
*
*> \par Purpose:
* =============
* Authors:
* ========
*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
*
*> \date November 2011
*
EXTERNAL LSAMEN
* ..
* .. External Subroutines ..
- EXTERNAL ALAESM, CHKXER, ZHECON, ZHERFS, ZHETF2, ZHETRF,
- $ ZHETRI, ZHETRI2, ZHETRS, ZHPCON, ZHPRFS,
- $ ZHPTRF, ZHPTRI, ZHPTRS
+ EXTERNAL ALAESM, CHKXER, ZHECON, ZHECON_ROOK, ZHERFS,
+ $ ZHETF2, ZHETF2_ROOK, ZHETRF, ZHETRF_ROOK,
+ $ ZHETRI, ZHETRI_ROOK, ZHETRI2, ZHETRS,
+ $ ZHETRS_ROOK, ZHPCON, ZHPRFS, ZHPTRF, ZHPTRI,
+ $ ZHPTRS
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
ANRM = 1.0D0
OK = .TRUE.
*
-* Test error exits of the routines that use the diagonal pivoting
-* factorization of a Hermitian indefinite matrix.
+* Test error exits of the routines that use factorization
+* of a Hermitian indefinite matrix with patrial
+* (Bunch-Kaufman) diagonal pivoting method.
*
IF( LSAMEN( 2, C2, 'HE' ) ) THEN
*
CALL ZHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
*
+* Test error exits of the routines that use factorization
+* of a Hermitian indefinite matrix with "rook"
+* (bounded Bunch-Kaufman) diagonal pivoting method.
+*
+ ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+*
+* ZHETRF_ROOK
+*
+ SRNAMT = 'ZHETRF_ROOK'
+ INFOT = 1
+ CALL ZHETRF_ROOK( '/', 0, A, 1, IP, W, 1, INFO )
+ CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL ZHETRF_ROOK( 'U', -1, A, 1, IP, W, 1, INFO )
+ CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL ZHETRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
+ CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
+*
+* ZHETF2_ROOK
+*
+ SRNAMT = 'ZHETF2_ROOK'
+ INFOT = 1
+ CALL ZHETF2_ROOK( '/', 0, A, 1, IP, INFO )
+ CALL CHKXER( 'ZHETF2_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL ZHETF2_ROOK( 'U', -1, A, 1, IP, INFO )
+ CALL CHKXER( 'ZHETF2_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL ZHETF2_ROOK( 'U', 2, A, 1, IP, INFO )
+ CALL CHKXER( 'ZHETF2_ROOK', INFOT, NOUT, LERR, OK )
+*
+* ZHETRI_ROOK
+*
+ SRNAMT = 'ZHETRI_ROOK'
+ INFOT = 1
+ CALL ZHETRI_ROOK( '/', 0, A, 1, IP, W, INFO )
+ CALL CHKXER( 'ZHETRI_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL ZHETRI_ROOK( 'U', -1, A, 1, IP, W, INFO )
+ CALL CHKXER( 'ZHETRI_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL ZHETRI_ROOK( 'U', 2, A, 1, IP, W, INFO )
+ CALL CHKXER( 'ZHETRI_ROOK', INFOT, NOUT, LERR, OK )
+*
+* ZHETRS_ROOK
+*
+ SRNAMT = 'ZHETRS_ROOK'
+ INFOT = 1
+ CALL ZHETRS_ROOK( '/', 0, 0, A, 1, IP, B, 1, INFO )
+ CALL CHKXER( 'ZHETRS_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL ZHETRS_ROOK( 'U', -1, 0, A, 1, IP, B, 1, INFO )
+ CALL CHKXER( 'ZHETRS_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL ZHETRS_ROOK( 'U', 0, -1, A, 1, IP, B, 1, INFO )
+ CALL CHKXER( 'ZHETRS_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL ZHETRS_ROOK( 'U', 2, 1, A, 1, IP, B, 2, INFO )
+ CALL CHKXER( 'ZHETRS_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 8
+ CALL ZHETRS_ROOK( 'U', 2, 1, A, 2, IP, B, 1, INFO )
+ CALL CHKXER( 'ZHETRS_ROOK', INFOT, NOUT, LERR, OK )
+*
+* ZHECON_ROOK
+*
+ SRNAMT = 'ZHECON_ROOK'
+ INFOT = 1
+ CALL ZHECON_ROOK( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
+ CALL CHKXER( 'ZHECON_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL ZHECON_ROOK( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
+ CALL CHKXER( 'ZHECON_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL ZHECON_ROOK( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
+ CALL CHKXER( 'ZHECON_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 6
+ CALL ZHECON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
+ CALL CHKXER( 'ZHECON_ROOK', INFOT, NOUT, LERR, OK )
+*
* Test error exits of the routines that use the diagonal pivoting
* factorization of a Hermitian indefinite packed matrix.
*
*
* =========== DOCUMENTATION ===========
*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
* ..
* .. External Subroutines ..
EXTERNAL CHKXER, ZGBSV, ZGBSVX, ZGESV, ZGESVX, ZGTSV,
- $ ZGTSVX, ZHESV, ZHESVX, ZHPSV, ZHPSVX, ZPBSV,
- $ ZPBSVX, ZPOSV, ZPOSVX, ZPPSV, ZPPSVX, ZPTSV,
- $ ZPTSVX, ZSPSV, ZSPSVX, ZSYSV, ZSYSV_ROOK,
- $ ZSYSVX
+ $ ZGTSVX, ZHESV, ZHESV_ROOK, ZHESVX, ZHPSV,
+ $ ZHPSVX, ZPBSV, ZPBSVX, ZPOSV, ZPOSVX, ZPPSV,
+ $ ZPPSVX, ZPTSV, ZPTSVX, ZSPSV, ZSPSVX, ZSYSV,
+ $ ZSYSV_ROOK, ZSYSVX
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
CALL ZHESVX( 'N', 'U', 2, 0, A, 2, AF, 2, IP, B, 2, X, 2,
$ RCOND, R1, R2, W, 3, RW, INFO )
CALL CHKXER( 'ZHESVX', INFOT, NOUT, LERR, OK )
+*
+ ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+*
+* ZHESV_ROOK
+*
+ SRNAMT = 'ZHESV_ROOK'
+ INFOT = 1
+ CALL ZHESV_ROOK( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
+ CALL CHKXER( 'ZHESV_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL ZHESV_ROOK( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
+ CALL CHKXER( 'ZHESV_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL ZHESV_ROOK( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
+ CALL CHKXER( 'ZHESV_ROOK', INFOT, NOUT, LERR, OK )
+ INFOT = 8
+ CALL ZHESV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
+ CALL CHKXER( 'ZHESV_ROOK', INFOT, NOUT, LERR, OK )
*
ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
*
CPB 8 List types on next line if 0 < NTYPES < 8
CPT 12 List types on next line if 0 < NTYPES < 12
CHE 10 List types on next line if 0 < NTYPES < 10
+CHR 10 List types on next line if 0 < NTYPES < 10
CHP 10 List types on next line if 0 < NTYPES < 10
CSY 11 List types on next line if 0 < NTYPES < 11
CSR 11 List types on next line if 0 < NTYPES < 11
ZPB 8 List types on next line if 0 < NTYPES < 8
ZPT 12 List types on next line if 0 < NTYPES < 12
ZHE 10 List types on next line if 0 < NTYPES < 10
+ZHR 10 List types on next line if 0 < NTYPES < 10
ZHP 10 List types on next line if 0 < NTYPES < 10
ZSY 11 List types on next line if 0 < NTYPES < 11
ZSR 11 List types on next line if 0 < NTYPES < 11