Merge pull request Reference-LAPACK#685 from angsch/fixes

Fixes
chrwarm · Aug 3, 2022 · 3381a0e · 3381a0e
2 parents 79bfdd4 + c8a5cf5
commit 3381a0e
Show file tree

Hide file tree

Showing 10 changed files with 93 additions and 159 deletions.
diff --git a/SRC/csyswapr.f b/SRC/csyswapr.f
@@ -58,15 +58,13 @@
 *> \param[in,out] A
 *> \verbatim
 *>          A is COMPLEX array, dimension (LDA,N)
-*>          On entry, the NB diagonal matrix D and the multipliers
-*>          used to obtain the factor U or L as computed by CSYTRF.
-*>
-*>          On exit, if INFO = 0, the (symmetric) inverse of the original
-*>          matrix.  If UPLO = 'U', the upper triangular part of the
-*>          inverse is formed and the part of A below the diagonal is not
-*>          referenced; if UPLO = 'L' the lower triangular part of the
-*>          inverse is formed and the part of A above the diagonal is
-*>          not referenced.
+*>          On entry, the N-by-N matrix A. On exit, the permuted matrix
+*>          where the rows I1 and I2 and columns I1 and I2 are interchanged.
+*>          If UPLO = 'U', the interchanges are applied to the upper
+*>          triangular part and the strictly lower triangular part of A is
+*>          not referenced; if UPLO = 'L', the interchanges are applied to
+*>          the lower triangular part and the part of A above the diagonal
+*>          is not referenced.
 *> \endverbatim
 *>
 *> \param[in] LDA
@@ -116,7 +114,6 @@ SUBROUTINE CSYSWAPR( UPLO, N, A, LDA, I1, I2)
 *     ..
 *     .. Local Scalars ..
       LOGICAL            UPPER
-      INTEGER            I
       COMPLEX            TMP
 *
 *     .. External Functions ..
@@ -143,19 +140,12 @@ SUBROUTINE CSYSWAPR( UPLO, N, A, LDA, I1, I2)
          A(I1,I1)=A(I2,I2)
          A(I2,I2)=TMP
 *
-         DO I=1,I2-I1-1
-            TMP=A(I1,I1+I)
-            A(I1,I1+I)=A(I1+I,I2)
-            A(I1+I,I2)=TMP
-         END DO
+         CALL CSWAP( I2-I1-1, A(I1,I1+1), LDA, A(I1+1,I2), 1 )
 *
 *          third swap
 *          - swap row I1 and I2 from I2+1 to N
-         DO I=I2+1,N
-            TMP=A(I1,I)
-            A(I1,I)=A(I2,I)
-            A(I2,I)=TMP
-         END DO
+         IF ( I2.LT.N )
+     $      CALL CSWAP( N-I2, A(I1,I2+1), LDA, A(I2,I2+1), LDA )
 *
         ELSE
 *
@@ -171,19 +161,12 @@ SUBROUTINE CSYSWAPR( UPLO, N, A, LDA, I1, I2)
           A(I1,I1)=A(I2,I2)
           A(I2,I2)=TMP
 *
-          DO I=1,I2-I1-1
-             TMP=A(I1+I,I1)
-             A(I1+I,I1)=A(I2,I1+I)
-             A(I2,I1+I)=TMP
-          END DO
+          CALL CSWAP( I2-I1-1, A(I1+1,I1), 1, A(I2,I1+1), LDA )
 *
 *         third swap
 *          - swap col I1 and I2 from I2+1 to N
-          DO I=I2+1,N
-             TMP=A(I,I1)
-             A(I,I1)=A(I,I2)
-             A(I,I2)=TMP
-          END DO
+          IF ( I2.LT.N )
+     $        CALL CSWAP( N-I2, A(I2+1,I1), 1, A(I2+1,I2), 1 )
 *
       ENDIF
       END SUBROUTINE CSYSWAPR

diff --git a/SRC/dsyswapr.f b/SRC/dsyswapr.f
@@ -57,16 +57,14 @@
 *>
 *> \param[in,out] A
 *> \verbatim
-*>          A is DOUBLE PRECISION array, dimension (LDA,N)
-*>          On entry, the NB diagonal matrix D and the multipliers
-*>          used to obtain the factor U or L as computed by DSYTRF.
-*>
-*>          On exit, if INFO = 0, the (symmetric) inverse of the original
-*>          matrix.  If UPLO = 'U', the upper triangular part of the
-*>          inverse is formed and the part of A below the diagonal is not
-*>          referenced; if UPLO = 'L' the lower triangular part of the
-*>          inverse is formed and the part of A above the diagonal is
-*>          not referenced.
+*>          A is DOUBLE PRECISION array, dimension (LDA,*)
+*>          On entry, the N-by-N matrix A. On exit, the permuted matrix
+*>          where the rows I1 and I2 and columns I1 and I2 are interchanged.
+*>          If UPLO = 'U', the interchanges are applied to the upper
+*>          triangular part and the strictly lower triangular part of A is
+*>          not referenced; if UPLO = 'L', the interchanges are applied to
+*>          the lower triangular part and the part of A above the diagonal
+*>          is not referenced.
 *> \endverbatim
 *>
 *> \param[in] LDA
@@ -109,14 +107,13 @@ SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
       INTEGER          I1, I2, LDA, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION A( LDA, N )
+      DOUBLE PRECISION A( LDA, * )
 *
 *  =====================================================================
 *
 *     ..
 *     .. Local Scalars ..
       LOGICAL            UPPER
-      INTEGER            I
       DOUBLE PRECISION   TMP
 *
 *     .. External Functions ..
@@ -143,19 +140,12 @@ SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
          A(I1,I1)=A(I2,I2)
          A(I2,I2)=TMP
 *
-         DO I=1,I2-I1-1
-            TMP=A(I1,I1+I)
-            A(I1,I1+I)=A(I1+I,I2)
-            A(I1+I,I2)=TMP
-         END DO
+         CALL DSWAP( I2-I1-1, A(I1,I1+1), LDA, A(I1+1,I2), 1 )
 *
 *          third swap
 *          - swap row I1 and I2 from I2+1 to N
-         DO I=I2+1,N
-            TMP=A(I1,I)
-            A(I1,I)=A(I2,I)
-            A(I2,I)=TMP
-         END DO
+         IF ( I2.LT.N )
+     $      CALL DSWAP( N-I2, A(I1,I2+1), LDA, A(I2,I2+1), LDA )
 *
         ELSE
 *
@@ -171,19 +161,12 @@ SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
           A(I1,I1)=A(I2,I2)
           A(I2,I2)=TMP
 *
-          DO I=1,I2-I1-1
-             TMP=A(I1+I,I1)
-             A(I1+I,I1)=A(I2,I1+I)
-             A(I2,I1+I)=TMP
-          END DO
+          CALL DSWAP( I2-I1-1, A(I1+1,I1), 1, A(I2,I1+1), LDA )
 *
 *         third swap
 *          - swap col I1 and I2 from I2+1 to N
-          DO I=I2+1,N
-             TMP=A(I,I1)
-             A(I,I1)=A(I,I2)
-             A(I,I2)=TMP
-          END DO
+         IF ( I2.LT.N )
+     $      CALL DSWAP( N-I2, A(I2+1,I1), 1, A(I2+1,I2), 1 )
 *
       ENDIF
       END SUBROUTINE DSYSWAPR

diff --git a/SRC/ssyswapr.f b/SRC/ssyswapr.f
@@ -57,16 +57,14 @@
 *>
 *> \param[in,out] A
 *> \verbatim
-*>          A is REAL array, dimension (LDA,N)
-*>          On entry, the NB diagonal matrix D and the multipliers
-*>          used to obtain the factor U or L as computed by SSYTRF.
-*>
-*>          On exit, if INFO = 0, the (symmetric) inverse of the original
-*>          matrix.  If UPLO = 'U', the upper triangular part of the
-*>          inverse is formed and the part of A below the diagonal is not
-*>          referenced; if UPLO = 'L' the lower triangular part of the
-*>          inverse is formed and the part of A above the diagonal is
-*>          not referenced.
+*>          A is REAL array, dimension (LDA,*)
+*>          On entry, the N-by-N matrix A. On exit, the permuted matrix
+*>          where the rows I1 and I2 and columns I1 and I2 are interchanged.
+*>          If UPLO = 'U', the interchanges are applied to the upper
+*>          triangular part and the strictly lower triangular part of A is
+*>          not referenced; if UPLO = 'L', the interchanges are applied to
+*>          the lower triangular part and the part of A above the diagonal
+*>          is not referenced.
 *> \endverbatim
 *>
 *> \param[in] LDA
@@ -109,14 +107,13 @@ SUBROUTINE SSYSWAPR( UPLO, N, A, LDA, I1, I2)
       INTEGER          I1, I2, LDA, N
 *     ..
 *     .. Array Arguments ..
-      REAL             A( LDA, N )
+      REAL             A( LDA, * )
 *
 *  =====================================================================
 *
 *     ..
 *     .. Local Scalars ..
       LOGICAL            UPPER
-      INTEGER            I
       REAL               TMP
 *
 *     .. External Functions ..
@@ -143,19 +140,12 @@ SUBROUTINE SSYSWAPR( UPLO, N, A, LDA, I1, I2)
          A(I1,I1)=A(I2,I2)
          A(I2,I2)=TMP
 *
-         DO I=1,I2-I1-1
-            TMP=A(I1,I1+I)
-            A(I1,I1+I)=A(I1+I,I2)
-            A(I1+I,I2)=TMP
-         END DO
+         CALL SSWAP( I2-I1-1, A(I1,I1+1), LDA, A(I1+1,I2), 1 )
 *
 *          third swap
 *          - swap row I1 and I2 from I2+1 to N
-         DO I=I2+1,N
-            TMP=A(I1,I)
-            A(I1,I)=A(I2,I)
-            A(I2,I)=TMP
-         END DO
+         IF ( I2.LT.N )
+     $      CALL SSWAP( N-I2, A(I1,I2+1), LDA, A(I2,I2+1), LDA )
 *
         ELSE
 *
@@ -171,19 +161,12 @@ SUBROUTINE SSYSWAPR( UPLO, N, A, LDA, I1, I2)
           A(I1,I1)=A(I2,I2)
           A(I2,I2)=TMP
 *
-          DO I=1,I2-I1-1
-             TMP=A(I1+I,I1)
-             A(I1+I,I1)=A(I2,I1+I)
-             A(I2,I1+I)=TMP
-          END DO
+          CALL SSWAP( I2-I1-1, A(I1+1,I1), 1, A(I2,I1+1), LDA )
 *
 *         third swap
 *          - swap col I1 and I2 from I2+1 to N
-          DO I=I2+1,N
-             TMP=A(I,I1)
-             A(I,I1)=A(I,I2)
-             A(I,I2)=TMP
-          END DO
+         IF ( I2.LT.N )
+     $      CALL SSWAP( N-I2, A(I2+1,I1), 1, A(I2+1,I2), 1 )
 *
       ENDIF
       END SUBROUTINE SSYSWAPR

diff --git a/SRC/zsyswapr.f b/SRC/zsyswapr.f
@@ -57,16 +57,14 @@
 *>
 *> \param[in,out] A
 *> \verbatim
-*>          A is COMPLEX*16 array, dimension (LDA,N)
-*>          On entry, the NB diagonal matrix D and the multipliers
-*>          used to obtain the factor U or L as computed by ZSYTRF.
-*>
-*>          On exit, if INFO = 0, the (symmetric) inverse of the original
-*>          matrix.  If UPLO = 'U', the upper triangular part of the
-*>          inverse is formed and the part of A below the diagonal is not
-*>          referenced; if UPLO = 'L' the lower triangular part of the
-*>          inverse is formed and the part of A above the diagonal is
-*>          not referenced.
+*>          A is COMPLEX*16 array, dimension (LDA,*)
+*>          On entry, the N-by-N matrix A. On exit, the permuted matrix
+*>          where the rows I1 and I2 and columns I1 and I2 are interchanged.
+*>          If UPLO = 'U', the interchanges are applied to the upper
+*>          triangular part and the strictly lower triangular part of A is
+*>          not referenced; if UPLO = 'L', the interchanges are applied to
+*>          the lower triangular part and the part of A above the diagonal
+*>          is not referenced.
 *> \endverbatim
 *>
 *> \param[in] LDA
@@ -109,14 +107,13 @@ SUBROUTINE ZSYSWAPR( UPLO, N, A, LDA, I1, I2)
       INTEGER          I1, I2, LDA, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16       A( LDA, N )
+      COMPLEX*16       A( LDA, * )
 *
 *  =====================================================================
 *
 *     ..
 *     .. Local Scalars ..
       LOGICAL            UPPER
-      INTEGER            I
       COMPLEX*16         TMP
 *
 *     .. External Functions ..
@@ -143,19 +140,12 @@ SUBROUTINE ZSYSWAPR( UPLO, N, A, LDA, I1, I2)
          A(I1,I1)=A(I2,I2)
          A(I2,I2)=TMP
 *
-         DO I=1,I2-I1-1
-            TMP=A(I1,I1+I)
-            A(I1,I1+I)=A(I1+I,I2)
-            A(I1+I,I2)=TMP
-         END DO
+         CALL ZSWAP( I2-I1-1, A(I1,I1+1), LDA, A(I1+1,I2), 1 )
 *
 *          third swap
 *          - swap row I1 and I2 from I2+1 to N
-         DO I=I2+1,N
-            TMP=A(I1,I)
-            A(I1,I)=A(I2,I)
-            A(I2,I)=TMP
-         END DO
+         IF ( I2.LT.N )
+     $      CALL ZSWAP( N-I2, A(I1,I2+1), LDA, A(I2,I2+1), LDA )
 *
         ELSE
 *
@@ -171,19 +161,12 @@ SUBROUTINE ZSYSWAPR( UPLO, N, A, LDA, I1, I2)
           A(I1,I1)=A(I2,I2)
           A(I2,I2)=TMP
 *
-          DO I=1,I2-I1-1
-             TMP=A(I1+I,I1)
-             A(I1+I,I1)=A(I2,I1+I)
-             A(I2,I1+I)=TMP
-          END DO
+          CALL ZSWAP( I2-I1-1, A(I1+1,I1), 1, A(I2,I1+1), LDA )
 *
 *         third swap
 *          - swap col I1 and I2 from I2+1 to N
-          DO I=I2+1,N
-             TMP=A(I,I1)
-             A(I,I1)=A(I,I2)
-             A(I,I2)=TMP
-          END DO
+         IF ( I2.LT.N )
+     $      CALL ZSWAP( N-I2, A(I2+1,I1), 1, A(I2+1,I2), 1 )
 *
       ENDIF
       END SUBROUTINE ZSYSWAPR

diff --git a/TESTING/EIG/dchkec.f b/TESTING/EIG/dchkec.f
@@ -92,14 +92,14 @@ SUBROUTINE DCHKEC( THRESH, TSTERR, NIN, NOUT )
       INTEGER            KLAEXC, KLALN2, KLANV2, KLAQTR, KLASY2, KTREXC,
      $                   KTRSEN, KTRSNA, KTRSYL, LLAEXC, LLALN2, LLANV2,
      $                   LLAQTR, LLASY2, LTREXC, LTRSYL, NLANV2, NLAQTR,
-     $                   NLASY2, NTESTS, NTRSYL, KTGEXC, NTGEXC, LTGEXC
+     $                   NLASY2, NTESTS, NTRSYL, KTGEXC, LTGEXC
       DOUBLE PRECISION   EPS, RLAEXC, RLALN2, RLANV2, RLAQTR, RLASY2,
      $                   RTREXC, RTRSYL, SFMIN, RTGEXC
 *     ..
 *     .. Local Arrays ..
       INTEGER            LTRSEN( 3 ), LTRSNA( 3 ), NLAEXC( 2 ),
-     $                   NLALN2( 2 ), NTREXC( 3 ), NTRSEN( 3 ),
-     $                   NTRSNA( 3 )
+     $                   NLALN2( 2 ), NTGEXC( 2 ), NTREXC( 3 ),
+     $                   NTRSEN( 3 ), NTRSNA( 3 )
       DOUBLE PRECISION   RTRSEN( 3 ), RTRSNA( 3 )
 *     ..
 *     .. External Subroutines ..
@@ -227,7 +227,7 @@ SUBROUTINE DCHKEC( THRESH, TSTERR, NIN, NOUT )
  9987 FORMAT( ' Routines pass computational tests if test ratio is les',
      $      's than', F8.2, / / )
  9986 FORMAT( ' Error in DTGEXC: RMAX =', D12.3, / ' LMAX = ', I8, ' N',
-     $      'INFO=', I8, ' KNT=', I8 )
+     $      'INFO=', 2I8, ' KNT=', I8 )
 *
 *     End of DCHKEC
 *

diff --git a/TESTING/EIG/dget31.f b/TESTING/EIG/dget31.f
@@ -65,7 +65,7 @@
 *>
 *> \param[out] NINFO
 *> \verbatim
-*>          NINFO is INTEGER array, dimension (3)
+*>          NINFO is INTEGER array, dimension (2)
 *>          NINFO(1) = number of examples with INFO less than 0
 *>          NINFO(2) = number of examples with INFO greater than 0
 *> \endverbatim