Modified test files for 'rook' pivoting LAPACK routines: LIN/cchkaa.f LIN/cchkhe_rook...
authorigor175 <igor175@8a072113-8704-0410-8d35-dd094bca7971>
Tue, 9 Jul 2013 04:42:19 +0000 (04:42 +0000)
committerigor175 <igor175@8a072113-8704-0410-8d35-dd094bca7971>
Tue, 9 Jul 2013 04:42:19 +0000 (04:42 +0000)
12 files changed:
TESTING/LIN/cchkaa.f
TESTING/LIN/cchkhe_rook.f
TESTING/LIN/cdrvhe_rook.f
TESTING/LIN/cerrhe.f
TESTING/LIN/cerrvx.f
TESTING/LIN/zchkaa.f
TESTING/LIN/zchkhe_rook.f
TESTING/LIN/zdrvhe_rook.f
TESTING/LIN/zerrhe.f
TESTING/LIN/zerrvx.f
TESTING/ctest.in
TESTING/ztest.in

index 09a6defb1c921d6803296da1ec515712df42b488..4d20dde263c5aa782a1e0c4636a4b76724160e26 100644 (file)
@@ -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
 *     ..
 *     .. 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 )
index 0077b8823d03192e2e44d51b445dfa97318b2730..9c58e965bcdcf01691bc915c4be4a0cfa4134970 100644 (file)
 *     ..
 *     .. 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
index 4107c62ca239f89f76311e4351ba801cfddcc235..2e1c4c47d9a9094a6536cf6f85a96aabdbe5ea1d 100644 (file)
 *
 *                    Factor the matrix A.
 *
-
                      CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
                      CALL CHETRF_ROOK( UPLO, N, AFAC, LDA, IWORK, WORK,
      $                                 LWORK, INFO )
index 03a285a1c70755a6f5cdc79600cabc7303e9dfe1..3bc10dfbde0ddfa21e17d69bd2757ea7cc6552f8 100644 (file)
@@ -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:
 *  =============
 *  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.
 *
index 64ad768bbe2ee342a8429802cc7912f927a1d902..8ebec7f7e6a2805baf8172fb388c4bc5f4a22e92 100644 (file)
@@ -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:
 *  =============
 *  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
 *
index 4e97a396fd70a4ceb4721952d4aef86e7ca897da..5ec582ee0b733166809a1d91a0d0c5815f1bdfb5 100644 (file)
@@ -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
 *     ..
 *     .. 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 )
index 983c5b4b99de1f1e15bc4555ed4215ea584a24fe..82571c0feafbd9337ae21f8f980018354c37f32d 100644 (file)
 *>
 *> \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
index 702b259cdc7f7992b51c16a5c61ba3745eb1dcc8..d5eb04aacad546e5ef4332a11808d275507ddd96 100644 (file)
       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
index 4d88e73884e36232427332ebef694a5dacd936a6..7da82b228b9d7b7aee4aab67a03aae5abbd76049 100644 (file)
@@ -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:
 *  =============
 *  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.
 *
index dd55c6c35a12efaf5a12a7f46fe3832e631436ad..3b151a5b1052ec622c9084be5a6a5a407d10e405 100644 (file)
@@ -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:
 *  ===========
 *     ..
 *     .. 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
 *
index 3c3f8535bcc7bd125304f6cde02a0fdf8838a3b0..e46549310ea6df07070ed6da559bfbfcd16092ca 100644 (file)
@@ -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
index 49ea19cbfa8a27a6434898b15ae66e8b99726d4c..10603510184cb3e01c658ec9a3831033fa704cd2 100644 (file)
@@ -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