Fixed BUG number 123, that is testing of 'rook' routines, specifically TEST 4 for...
authorigor175 <igor175@8a072113-8704-0410-8d35-dd094bca7971>
Tue, 11 Aug 2015 22:27:27 +0000 (22:27 +0000)
committerigor175 <igor175@8a072113-8704-0410-8d35-dd094bca7971>
Tue, 11 Aug 2015 22:27:27 +0000 (22:27 +0000)
TESTING/LIN/cchkhe_rook.f
TESTING/LIN/cchksy_rook.f
TESTING/LIN/dchksy_rook.f
TESTING/LIN/schksy_rook.f
TESTING/LIN/zchkhe_rook.f
TESTING/LIN/zchksy_rook.f

index 7d7ab8e98b3eb97078a85084bbc2b6b0c00974ac..a58b590a296b44d65767241d2a314c1103661593 100644 (file)
       CHARACTER          UPLOS( 2 )
       INTEGER            ISEED( 4 ), ISEEDY( 4 ), IDUMMY( 1 )
       REAL               RESULT( NTESTS )
-      COMPLEX            CDUMMY( 1 )
+      COMPLEX            BLOCK( 2, 2 ), CDUMMY( 1 )
 *     ..
 *     .. External Functions ..
       REAL               CLANGE, CLANHE, SGET06
       EXTERNAL           CLANGE, CLANHE, SGET06
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ALAERH, ALAHD, ALASUM, CERRHE, CHEEVX, CGET04,
+      EXTERNAL           ALAERH, ALAHD, ALASUM, CERRHE, CGESVD, CGET04,
      $                   CLACPY, CLARHS, CLATB4, CLATMS, CPOT02,
      $                   CPOT03, CHECON_ROOK, CHET01_ROOK, CHETRF_ROOK,
      $                   CHETRI_ROOK, CHETRS_ROOK, XLAENV
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
+      INTRINSIC          MAX, MIN, SQRT
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
 *
 *
 *+    TEST 4
-*                 Compute largest 2-Norm of 2-by-2 diag blocks
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
 *
                   RESULT( 4 ) = ZERO
                   STEMP = ZERO
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
-*                       store them in WORK array
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
 *
-                        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 )
+                        BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
+                        BLOCK( 1, 2 ) = AFAC( (K-1)*LDA+K-1 )
+                        BLOCK( 2, 1 ) = BLOCK( 1, 2 )
+                        BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
 *
-                        LAM_MAX = MAX( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
+                        CALL CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               CDUMMY, 1, CDUMMY, 1,
+     $                               WORK, 6, RWORK( 3 ), INFO )
+*
+*
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         STEMP = LAM_MAX / LAM_MIN
 *
 *                       STEMP should be bounded by CONST
 *
-                        STEMP = ABS( STEMP ) - CONST + THRESH
+                        STEMP = STEMP - CONST + THRESH
                         IF( STEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = STEMP
                         K = K - 1
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
-*                       store them in WORK array
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK 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', '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 )
+                        CALL CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               CDUMMY, 1, CDUMMY, 1,
+     $                               WORK, 6, RWORK(3), INFO )
 *
-                        LAM_MAX = MAX( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         STEMP = LAM_MAX / LAM_MIN
 *
 *                       STEMP should be bounded by CONST
 *
-                        STEMP = ABS( STEMP ) - CONST + THRESH
+                        STEMP = STEMP - CONST + THRESH
                         IF( STEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = STEMP
                         K = K + 1
index cafd4d936bdf9013574cfbd64c8db616d5984e46..9b77efae656501235318994214eb512cbeb63592 100644 (file)
       EXTERNAL           CLANGE, CLANSY, SGET06
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ALAERH, ALAHD, ALASUM, CERRSY, CGEEVX, CGET04,
+      EXTERNAL           ALAERH, ALAHD, ALASUM, CERRSY, CGESVD, CGET04,
      $                   CLACPY, CLARHS, CLATB4, CLATMS, CLATSY, CSYT02,
      $                   CSYT03, CSYCON_ROOK, CSYT01_ROOK, CSYTRF_ROOK,
      $                   CSYTRI_ROOK, CSYTRS_ROOK, XLAENV
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
+      INTRINSIC          MAX, MIN, SQRT
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
 *
 *
 *+    TEST 4
-*                 Compute largest 2-Norm of 2-by-2 diag blocks
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
 *
                   RESULT( 4 ) = ZERO
                   STEMP = ZERO
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
-*                       store them in WORK array
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK 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( 1, 2 ) = AFAC( (K-1)*LDA+K-1 )
+                        BLOCK( 2, 1 ) = BLOCK( 1, 2 )
                         BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
 *
-                        CALL CGEEVX( '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 CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               CDUMMY, 1, CDUMMY, 1,
+     $                               WORK, 6, RWORK( 3 ), INFO )
+*
 *
-                        LAM_MAX = MAX( ABS( WORK( 1 ) ),
-     $                            ABS( WORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( WORK( 1 ) ),
-     $                            ABS( WORK( 2 ) ) )
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         STEMP = LAM_MAX / LAM_MIN
 *
 *                       STEMP should be bounded by CONST
 *
-                        STEMP = ABS( STEMP ) - CONST + THRESH
+                        STEMP = STEMP - CONST + THRESH
                         IF( STEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = STEMP
                         K = K - 1
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
-*                       store them in WORK array
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK 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 CGEEVX( '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 CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               CDUMMY, 1, CDUMMY, 1,
+     $                               WORK, 6, RWORK(3), INFO )
 *
-                        LAM_MAX = MAX( ABS( WORK( 1 ) ),
-     $                            ABS( WORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( WORK( 1 ) ),
-     $                            ABS( WORK( 2 ) ) )
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         STEMP = LAM_MAX / LAM_MIN
 *
 *                       STEMP should be bounded by CONST
 *
-                        STEMP = ABS( STEMP ) - CONST + THRESH
+                        STEMP = STEMP - CONST + THRESH
                         IF( STEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = STEMP
                         K = K + 1
index e7cea27f752f5b10c055681b67682bbaeaff1b87..4e3ec5bfd55ed4d0bb23d4385978ee26c4bc8935 100644 (file)
 *     .. Local Arrays ..
       CHARACTER          UPLOS( 2 )
       INTEGER            IDUMMY( 1 ), ISEED( 4 ), ISEEDY( 4 )
-      DOUBLE PRECISION   DDUMMY( 1 ), RESULT( NTESTS )
+      DOUBLE PRECISION   BLOCK( 2, 2 ), DDUMMY( 1 ), RESULT( NTESTS )
 *     ..
 *     .. External Functions ..
       DOUBLE PRECISION   DGET06, DLANGE, DLANSY
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           ALAERH, ALAHD, ALASUM, DERRSY, DGET04, DLACPY,
-     $                   DLARHS, DLATB4, DLATMS, DPOT02, DPOT03, DSYEVX,
+     $                   DLARHS, DLATB4, DLATMS, DPOT02, DPOT03, DGESVD,
      $                   DSYCON_ROOK, DSYT01_ROOK, DSYTRF_ROOK,
      $                   DSYTRI_ROOK, DSYTRS_ROOK, XLAENV
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
+      INTRINSIC          MAX, MIN, SQRT
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
 *
 *
 *+    TEST 4
-*                 Compute largest 2-Norm of 2-by-2 diag blocks
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
 *
                   RESULT( 4 ) = ZERO
                   DTEMP = ZERO
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
 *                       store them in RWORK array
 *
-                        CALL DSYEVX( 'N', 'A', UPLO, 2,
-     $                              AINV( ( K-2 )*LDA+K-1 ), LDA, DTEMP,
-     $                              DTEMP, ITEMP, ITEMP, ZERO, ITEMP,
-     $                              RWORK, DDUMMY, 1, WORK, 16,
-     $                              IWORK( N+1 ), IDUMMY, INFO )
+                        BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
+                        BLOCK( 1, 2 ) = AFAC( (K-1)*LDA+K-1 )
+                        BLOCK( 2, 1 ) = BLOCK( 1, 2 )
+                        BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
 *
-                        LAM_MAX = MAX( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
+                        CALL DGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               DDUMMY, 1, DDUMMY, 1,
+     $                               WORK, 10, INFO )
+*
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         DTEMP = LAM_MAX / LAM_MIN
 *
 *                       DTEMP should be bounded by CONST
 *
-                        DTEMP = ABS( DTEMP ) - CONST + THRESH
+                        DTEMP = DTEMP - CONST + THRESH
                         IF( DTEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = DTEMP
                         K = K - 1
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
 *                       store them in RWORK array
 *
-                        CALL DSYEVX( 'N', 'A', UPLO, 2,
-     $                              AINV( ( K-1 )*LDA+K ), LDA, DTEMP,
-     $                              DTEMP, ITEMP, ITEMP, ZERO, ITEMP,
-     $                              RWORK, DDUMMY, 1, WORK, 16,
-     $                              IWORK( N+1 ), IDUMMY, INFO )
+                        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 DGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               DDUMMY, 1, DDUMMY, 1,
+     $                               WORK, 10, INFO )
+*
 *
-                        LAM_MAX = MAX( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         DTEMP = LAM_MAX / LAM_MIN
 *
 *                       DTEMP should be bounded by CONST
 *
-                        DTEMP = ABS( DTEMP ) - CONST + THRESH
+                        DTEMP = DTEMP - CONST + THRESH
                         IF( DTEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = DTEMP
                         K = K + 1
index 23a84cd1c60b91dbad9864abb34f2d467dffc362..38cb63bb88b4b14d096e3bc209b1340b6d328c5c 100644 (file)
 *     .. Local Arrays ..
       CHARACTER          UPLOS( 2 )
       INTEGER            IDUMMY( 1 ), ISEED( 4 ), ISEEDY( 4 )
-      REAL               RESULT( NTESTS ), SDUMMY( 1 )
+      REAL               BLOCK( 2, 2 ), RESULT( NTESTS ), SDUMMY( 1 )
 *     ..
 *     .. External Functions ..
       REAL               SGET06, SLANGE, SLANSY
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           ALAERH, ALAHD, ALASUM, SERRSY, SGET04, SLACPY,
-     $                   SLARHS, SLATB4, SLATMS, SPOT02, SPOT03, SSYEVX,
+     $                   SLARHS, SLATB4, SLATMS, SPOT02, SPOT03, SGESVD,
      $                   SSYCON_ROOK, SSYT01_ROOK, SSYTRF_ROOK,
      $                   SSYTRI_ROOK, SSYTRS_ROOK, XLAENV
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
+      INTRINSIC          MAX, MIN, SQRT
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
 *
 *
 *+    TEST 4
-*                 Compute largest 2-Norm of 2-by-2 diag blocks
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
 *
                   RESULT( 4 ) = ZERO
                   STEMP = ZERO
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
 *                       store them in RWORK array
 *
-                        CALL SSYEVX( 'N', 'A', UPLO, 2,
-     $                              AINV( ( K-2 )*LDA+K-1 ), LDA, STEMP,
-     $                              STEMP, ITEMP, ITEMP, ZERO, ITEMP,
-     $                              RWORK, SDUMMY, 1, WORK, 16,
-     $                              IWORK( N+1 ), IDUMMY, INFO )
+                        BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
+                        BLOCK( 1, 2 ) = AFAC( (K-1)*LDA+K-1 )
+                        BLOCK( 2, 1 ) = BLOCK( 1, 2 )
+                        BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
 *
-                        LAM_MAX = MAX( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
+                        CALL SGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               SDUMMY, 1, SDUMMY, 1,
+     $                               WORK, 10, INFO )
+*
+*
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         STEMP = LAM_MAX / LAM_MIN
 *
 *                       STEMP should be bounded by CONST
 *
-                        STEMP = ABS( STEMP ) - CONST + THRESH
+                        STEMP = STEMP - CONST + THRESH
                         IF( STEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = STEMP
                         K = K - 1
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
 *                       store them in RWORK array
 *
-                        CALL SSYEVX( 'N', 'A', UPLO, 2,
-     $                              AINV( ( K-1 )*LDA+K ), LDA, STEMP,
-     $                              STEMP, ITEMP, ITEMP, ZERO, ITEMP,
-     $                              RWORK, SDUMMY, 1, WORK, 16,
-     $                              IWORK( N+1 ), IDUMMY, INFO )
+                        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 SGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               SDUMMY, 1, SDUMMY, 1,
+     $                               WORK, 10, INFO )
+*
 *
-                        LAM_MAX = MAX( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         STEMP = LAM_MAX / LAM_MIN
 *
 *                       STEMP should be bounded by CONST
 *
-                        STEMP = ABS( STEMP ) - CONST + THRESH
+                        STEMP = STEMP - CONST + THRESH
                         IF( STEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = STEMP
                         K = K + 1
index 0ec8def28fe0521d5fd795dc5bd47a24a1dc4b0d..decebb9bd7d0db9b7d8f8706364d8bfef44e0d15 100644 (file)
       CHARACTER          UPLOS( 2 )
       INTEGER            ISEED( 4 ), ISEEDY( 4 ), IDUMMY( 1 )
       DOUBLE PRECISION   RESULT( NTESTS )
-      COMPLEX*16         CDUMMY( 1 )
+      COMPLEX*16         BLOCK( 2, 2 ), ZDUMMY( 1 )
 *     ..
 *     .. External Functions ..
       DOUBLE PRECISION   ZLANGE, ZLANHE, DGET06
       EXTERNAL           ZLANGE, ZLANHE, DGET06
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ALAERH, ALAHD, ALASUM, ZERRHE, ZHEEVX, ZGET04,
+      EXTERNAL           ALAERH, ALAHD, ALASUM, ZERRHE, ZGESVD, ZGET04,
      $                   ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZPOT02,
      $                   ZPOT03, ZHECON_ROOK, ZHET01_ROOK, ZHETRF_ROOK,
      $                   ZHETRI_ROOK, ZHETRS_ROOK, XLAENV
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
+      INTRINSIC          MAX, MIN, SQRT
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
 *
 *
 *+    TEST 4
-*                 Compute largest 2-Norm of 2-by-2 diag blocks
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
 *
                   RESULT( 4 ) = ZERO
                   DTEMP = ZERO
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
-*                       store them in WORK array
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
 *
-                        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 )
+                        BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
+                        BLOCK( 1, 2 ) = AFAC( (K-1)*LDA+K-1 )
+                        BLOCK( 2, 1 ) = BLOCK( 1, 2 )
+                        BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
 *
-                        LAM_MAX = MAX( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
+                        CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               ZDUMMY, 1, ZDUMMY, 1,
+     $                               WORK, 6, RWORK( 3 ), INFO )
+*
+*
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         DTEMP = LAM_MAX / LAM_MIN
 *
 *                       DTEMP should be bounded by CONST
 *
-                        DTEMP = ABS( DTEMP ) - CONST + THRESH
+                        DTEMP = DTEMP - CONST + THRESH
                         IF( DTEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = DTEMP
                         K = K - 1
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
-*                       store them in WORK array
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK 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', '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 )
+                        CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               ZDUMMY, 1, ZDUMMY, 1,
+     $                               WORK, 6, RWORK(3), INFO )
 *
-                        LAM_MAX = MAX( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( RWORK( 1 ) ),
-     $                            ABS( RWORK( 2 ) ) )
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         DTEMP = LAM_MAX / LAM_MIN
 *
 *                       DTEMP should be bounded by CONST
 *
-                        DTEMP = ABS( DTEMP ) - CONST + THRESH
+                        DTEMP = DTEMP - CONST + THRESH
                         IF( DTEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = DTEMP
                         K = K + 1
index 3b93b6fe6b69d2d2bcb1dde21de61dba0bef49bc..5eb83ebfa4fdb127f4a64b26e1de0609e3e85867 100644 (file)
       EXTERNAL           DGET06, ZLANGE, ZLANSY
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ALAERH, ALAHD, ALASUM, ZERRSY, ZGEEVX, ZGET04,
+      EXTERNAL           ALAERH, ALAHD, ALASUM, ZERRSY, ZGESVD, ZGET04,
      $                   ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZLATSY,ZSYT02,
      $                   ZSYT03, ZSYCON_ROOK, ZSYT01_ROOK, ZSYTRF_ROOK,
      $                   ZSYTRI_ROOK, ZSYTRS_ROOK, XLAENV
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
+      INTRINSIC          MAX, MIN, SQRT
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
 *
 *
 *+    TEST 4
-*                 Compute largest 2-Norm of 2-by-2 diag blocks
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
 *
                   RESULT( 4 ) = ZERO
                   DTEMP = ZERO
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
-*                       store them in WORK array
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK 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( 1, 2 ) = AFAC( (K-1)*LDA+K-1 )
+                        BLOCK( 2, 1 ) = BLOCK( 1, 2 )
                         BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
 *
-                        CALL ZGEEVX( 'N', 'N', 'N', 'N', 2, BLOCK,
-     $                               2, WORK, ZDUMMY, 1, ZDUMMY, 1,
-     $                               ITEMP, ITEMP2, RWORK, DTEMP,
-     $                               RWORK( 3 ), RWORK( 5 ), WORK( 3 ),
-     $                               4, RWORK( 7 ), INFO )
+                        CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               ZDUMMY, 1, ZDUMMY, 1,
+     $                               WORK, 6, RWORK( 3 ), INFO )
+*
 *
-                        LAM_MAX = MAX( ABS( WORK( 1 ) ),
-     $                            ABS( WORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( WORK( 1 ) ),
-     $                            ABS( WORK( 2 ) ) )
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         DTEMP = LAM_MAX / LAM_MIN
 *
 *                       DTEMP should be bounded by CONST
 *
-                        DTEMP = ABS( DTEMP ) - CONST + THRESH
+                        DTEMP = DTEMP - CONST + THRESH
                         IF( DTEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = DTEMP
                         K = K - 1
 *
                      IF( IWORK( K ).LT.ZERO ) THEN
 *
-*                       Get the two eigenvalues of a 2-by-2 block,
-*                       store them in WORK array
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK 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 ZGEEVX( 'N', 'N', 'N', 'N', 2, BLOCK,
-     $                               2, WORK, ZDUMMY, 1, ZDUMMY, 1,
-     $                               ITEMP, ITEMP2, RWORK, DTEMP,
-     $                               RWORK( 3 ), RWORK( 5 ), WORK( 3 ),
-     $                               4, RWORK( 7 ), INFO )
+                        CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               ZDUMMY, 1, ZDUMMY, 1,
+     $                               WORK, 6, RWORK(3), INFO )
 *
-                        LAM_MAX = MAX( ABS( WORK( 1 ) ),
-     $                            ABS( WORK( 2 ) ) )
-                        LAM_MIN = MIN( ABS( WORK( 1 ) ),
-     $                            ABS( WORK( 2 ) ) )
+                        LAM_MAX = RWORK( 1 )
+                        LAM_MIN = RWORK( 2 )
 *
                         DTEMP = LAM_MAX / LAM_MIN
 *
 *                       DTEMP should be bounded by CONST
 *
-                        DTEMP = ABS( DTEMP ) - CONST + THRESH
+                        DTEMP = DTEMP - CONST + THRESH
                         IF( DTEMP.GT.RESULT( 4 ) )
      $                     RESULT( 4 ) = DTEMP
                         K = K + 1