diff options
author | igor175 <igor175@8a072113-8704-0410-8d35-dd094bca7971> | 2013-07-09 04:42:19 +0000 |
---|---|---|
committer | igor175 <igor175@8a072113-8704-0410-8d35-dd094bca7971> | 2013-07-09 04:42:19 +0000 |
commit | ac63399686c538bfcc1089c1e61f5045761a5b08 (patch) | |
tree | 649ceb4ac1d5116da807b6a4279f53f16a6ec89f /TESTING | |
parent | c1c4e803095c580c41af88ad525600df3037da9e (diff) | |
download | lapack-ac63399686c538bfcc1089c1e61f5045761a5b08.tar.gz lapack-ac63399686c538bfcc1089c1e61f5045761a5b08.tar.bz2 lapack-ac63399686c538bfcc1089c1e61f5045761a5b08.zip |
Modified test files for 'rook' pivoting LAPACK routines: LIN/cchkaa.f LIN/cchkhe_rook.f LIN/cdrvhe_rook.f LIN/cerrhe.f LIN/cerrvx.f LIN/zchkaa.f LIN/zchkhe_rook.f LIN/zdrvhe_rook.f LIN/zerrhe.f LIN/zerrvx.f ctest.in ztest.in
Diffstat (limited to 'TESTING')
-rw-r--r-- | TESTING/LIN/cchkaa.f | 52 | ||||
-rw-r--r-- | TESTING/LIN/cchkhe_rook.f | 59 | ||||
-rw-r--r-- | TESTING/LIN/cdrvhe_rook.f | 1 | ||||
-rw-r--r-- | TESTING/LIN/cerrhe.f | 108 | ||||
-rw-r--r-- | TESTING/LIN/cerrvx.f | 42 | ||||
-rw-r--r-- | TESTING/LIN/zchkaa.f | 45 | ||||
-rw-r--r-- | TESTING/LIN/zchkhe_rook.f | 70 | ||||
-rw-r--r-- | TESTING/LIN/zdrvhe_rook.f | 4 | ||||
-rw-r--r-- | TESTING/LIN/zerrhe.f | 109 | ||||
-rw-r--r-- | TESTING/LIN/zerrvx.f | 30 | ||||
-rw-r--r-- | TESTING/ctest.in | 1 | ||||
-rw-r--r-- | TESTING/ztest.in | 1 |
12 files changed, 385 insertions, 137 deletions
diff --git a/TESTING/LIN/cchkaa.f b/TESTING/LIN/cchkaa.f index 09a6defb..4d20dde2 100644 --- a/TESTING/LIN/cchkaa.f +++ b/TESTING/LIN/cchkaa.f @@ -50,6 +50,7 @@ *> 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 @@ -158,13 +159,14 @@ * .. * .. 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 @@ -615,7 +617,8 @@ * 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 ) @@ -638,9 +641,36 @@ 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 ) @@ -691,8 +721,8 @@ * 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 ) diff --git a/TESTING/LIN/cchkhe_rook.f b/TESTING/LIN/cchkhe_rook.f index 0077b882..9c58e965 100644 --- a/TESTING/LIN/cchkhe_rook.f +++ b/TESTING/LIN/cchkhe_rook.f @@ -219,9 +219,9 @@ * .. * .. 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 @@ -540,7 +540,7 @@ 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 ) @@ -614,6 +614,7 @@ * 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 * @@ -629,21 +630,17 @@ * 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 * @@ -675,21 +672,17 @@ * 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 * @@ -841,9 +834,9 @@ 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 diff --git a/TESTING/LIN/cdrvhe_rook.f b/TESTING/LIN/cdrvhe_rook.f index 4107c62c..2e1c4c47 100644 --- a/TESTING/LIN/cdrvhe_rook.f +++ b/TESTING/LIN/cdrvhe_rook.f @@ -402,7 +402,6 @@ * * Factor the matrix A. * - CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) CALL CHETRF_ROOK( UPLO, N, AFAC, LDA, IWORK, WORK, $ LWORK, INFO ) diff --git a/TESTING/LIN/cerrhe.f b/TESTING/LIN/cerrhe.f index 03a285a1..3bc10dfb 100644 --- a/TESTING/LIN/cerrhe.f +++ b/TESTING/LIN/cerrhe.f @@ -2,19 +2,19 @@ * * =========== 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: * ============= @@ -43,10 +43,10 @@ * 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 * @@ -88,9 +88,10 @@ 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 @@ -127,8 +128,9 @@ 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 * @@ -251,6 +253,86 @@ 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. * diff --git a/TESTING/LIN/cerrvx.f b/TESTING/LIN/cerrvx.f index 64ad768b..8ebec7f7 100644 --- a/TESTING/LIN/cerrvx.f +++ b/TESTING/LIN/cerrvx.f @@ -2,19 +2,19 @@ * * =========== 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: * ============= @@ -43,10 +43,10 @@ * 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 * @@ -90,10 +90,10 @@ * .. * .. 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 @@ -632,6 +632,24 @@ $ 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 * * CHPSV diff --git a/TESTING/LIN/zchkaa.f b/TESTING/LIN/zchkaa.f index 4e97a396..5ec582ee 100644 --- a/TESTING/LIN/zchkaa.f +++ b/TESTING/LIN/zchkaa.f @@ -50,6 +50,7 @@ *> 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 @@ -158,13 +159,13 @@ * .. * .. 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 @@ -638,6 +639,32 @@ 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 * * HP: Hermitian indefinite packed matrices @@ -691,8 +718,8 @@ * 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 ) diff --git a/TESTING/LIN/zchkhe_rook.f b/TESTING/LIN/zchkhe_rook.f index 983c5b4b..82571c0f 100644 --- a/TESTING/LIN/zchkhe_rook.f +++ b/TESTING/LIN/zchkhe_rook.f @@ -105,7 +105,7 @@ *> *> \param[out] A *> \verbatim -*> A is COMPLEX*16 array, dimension (NMAX*NMAX) +*> A is CCOMPLEX*16 array, dimension (NMAX*NMAX) *> \endverbatim *> *> \param[out] AFAC @@ -120,7 +120,7 @@ *> *> \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 *> @@ -141,7 +141,7 @@ *> *> \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 @@ -219,9 +219,9 @@ * .. * .. 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 @@ -540,7 +540,7 @@ 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 ) @@ -614,6 +614,7 @@ * 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 * @@ -629,21 +630,17 @@ * 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 * @@ -675,21 +672,17 @@ * 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 * @@ -740,6 +733,9 @@ 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. * @@ -810,7 +806,7 @@ $ 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 ) * @@ -838,9 +834,9 @@ 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 diff --git a/TESTING/LIN/zdrvhe_rook.f b/TESTING/LIN/zdrvhe_rook.f index 702b259c..d5eb04aa 100644 --- a/TESTING/LIN/zdrvhe_rook.f +++ b/TESTING/LIN/zdrvhe_rook.f @@ -201,7 +201,7 @@ 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 @@ -247,7 +247,7 @@ * 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 diff --git a/TESTING/LIN/zerrhe.f b/TESTING/LIN/zerrhe.f index 4d88e738..7da82b22 100644 --- a/TESTING/LIN/zerrhe.f +++ b/TESTING/LIN/zerrhe.f @@ -2,19 +2,19 @@ * * =========== 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: * ============= @@ -43,10 +43,10 @@ * 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 * @@ -88,9 +88,11 @@ 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 @@ -129,8 +131,9 @@ 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 * @@ -253,6 +256,86 @@ 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. * diff --git a/TESTING/LIN/zerrvx.f b/TESTING/LIN/zerrvx.f index dd55c6c3..3b151a5b 100644 --- a/TESTING/LIN/zerrvx.f +++ b/TESTING/LIN/zerrvx.f @@ -2,8 +2,8 @@ * * =========== 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: * =========== @@ -90,10 +90,10 @@ * .. * .. 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 @@ -634,6 +634,24 @@ $ 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 * * ZHPSV diff --git a/TESTING/ctest.in b/TESTING/ctest.in index 3c3f8535..e4654931 100644 --- a/TESTING/ctest.in +++ b/TESTING/ctest.in @@ -23,6 +23,7 @@ CPP 9 List types on next line if 0 < NTYPES < 9 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 diff --git a/TESTING/ztest.in b/TESTING/ztest.in index 49ea19cb..10603510 100644 --- a/TESTING/ztest.in +++ b/TESTING/ztest.in @@ -23,6 +23,7 @@ ZPP 9 List types on next line if 0 < NTYPES < 9 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 |