Closes Reference-LAPACK#217

chrwarm · Aug 3, 2022 · ecca781 · ecca781
1 parent 7d90a67
commit ecca781
Show file tree

Hide file tree

Showing 4 changed files with 58 additions and 126 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