Skip to content

Commit ecca781

Browse files
committed
Closes #217
1 parent 7d90a67 commit ecca781

File tree

4 files changed

+58
-126
lines changed

4 files changed

+58
-126
lines changed

SRC/csyswapr.f

Lines changed: 13 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -58,15 +58,13 @@
5858
*> \param[in,out] A
5959
*> \verbatim
6060
*> A is COMPLEX array, dimension (LDA,N)
61-
*> On entry, the NB diagonal matrix D and the multipliers
62-
*> used to obtain the factor U or L as computed by CSYTRF.
63-
*>
64-
*> On exit, if INFO = 0, the (symmetric) inverse of the original
65-
*> matrix. If UPLO = 'U', the upper triangular part of the
66-
*> inverse is formed and the part of A below the diagonal is not
67-
*> referenced; if UPLO = 'L' the lower triangular part of the
68-
*> inverse is formed and the part of A above the diagonal is
69-
*> not referenced.
61+
*> On entry, the N-by-N matrix A. On exit, the permuted matrix
62+
*> where the rows I1 and I2 and columns I1 and I2 are interchanged.
63+
*> If UPLO = 'U', the interchanges are applied to the upper
64+
*> triangular part and the strictly lower triangular part of A is
65+
*> not referenced; if UPLO = 'L', the interchanges are applied to
66+
*> the lower triangular part and the part of A above the diagonal
67+
*> is not referenced.
7068
*> \endverbatim
7169
*>
7270
*> \param[in] LDA
@@ -116,7 +114,6 @@ SUBROUTINE CSYSWAPR( UPLO, N, A, LDA, I1, I2)
116114
* ..
117115
* .. Local Scalars ..
118116
LOGICAL UPPER
119-
INTEGER I
120117
COMPLEX TMP
121118
*
122119
* .. External Functions ..
@@ -143,19 +140,12 @@ SUBROUTINE CSYSWAPR( UPLO, N, A, LDA, I1, I2)
143140
A(I1,I1)=A(I2,I2)
144141
A(I2,I2)=TMP
145142
*
146-
DO I=1,I2-I1-1
147-
TMP=A(I1,I1+I)
148-
A(I1,I1+I)=A(I1+I,I2)
149-
A(I1+I,I2)=TMP
150-
END DO
143+
CALL CSWAP( I2-I1-1, A(I1,I1+1), LDA, A(I1+1,I2), 1 )
151144
*
152145
* third swap
153146
* - swap row I1 and I2 from I2+1 to N
154-
DO I=I2+1,N
155-
TMP=A(I1,I)
156-
A(I1,I)=A(I2,I)
157-
A(I2,I)=TMP
158-
END DO
147+
IF ( I2.LT.N )
148+
$ CALL CSWAP( N-I2, A(I1,I2+1), LDA, A(I2,I2+1), LDA )
159149
*
160150
ELSE
161151
*
@@ -171,19 +161,12 @@ SUBROUTINE CSYSWAPR( UPLO, N, A, LDA, I1, I2)
171161
A(I1,I1)=A(I2,I2)
172162
A(I2,I2)=TMP
173163
*
174-
DO I=1,I2-I1-1
175-
TMP=A(I1+I,I1)
176-
A(I1+I,I1)=A(I2,I1+I)
177-
A(I2,I1+I)=TMP
178-
END DO
164+
CALL CSWAP( I2-I1-1, A(I1+1,I1), 1, A(I2,I1+1), LDA )
179165
*
180166
* third swap
181167
* - swap col I1 and I2 from I2+1 to N
182-
DO I=I2+1,N
183-
TMP=A(I,I1)
184-
A(I,I1)=A(I,I2)
185-
A(I,I2)=TMP
186-
END DO
168+
IF ( I2.LT.N )
169+
$ CALL CSWAP( N-I2, A(I2+1,I1), 1, A(I2+1,I2), 1 )
187170
*
188171
ENDIF
189172
END SUBROUTINE CSYSWAPR

SRC/dsyswapr.f

Lines changed: 15 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -57,16 +57,14 @@
5757
*>
5858
*> \param[in,out] A
5959
*> \verbatim
60-
*> A is DOUBLE PRECISION array, dimension (LDA,N)
61-
*> On entry, the NB diagonal matrix D and the multipliers
62-
*> used to obtain the factor U or L as computed by DSYTRF.
63-
*>
64-
*> On exit, if INFO = 0, the (symmetric) inverse of the original
65-
*> matrix. If UPLO = 'U', the upper triangular part of the
66-
*> inverse is formed and the part of A below the diagonal is not
67-
*> referenced; if UPLO = 'L' the lower triangular part of the
68-
*> inverse is formed and the part of A above the diagonal is
69-
*> not referenced.
60+
*> A is DOUBLE PRECISION array, dimension (LDA,*)
61+
*> On entry, the N-by-N matrix A. On exit, the permuted matrix
62+
*> where the rows I1 and I2 and columns I1 and I2 are interchanged.
63+
*> If UPLO = 'U', the interchanges are applied to the upper
64+
*> triangular part and the strictly lower triangular part of A is
65+
*> not referenced; if UPLO = 'L', the interchanges are applied to
66+
*> the lower triangular part and the part of A above the diagonal
67+
*> is not referenced.
7068
*> \endverbatim
7169
*>
7270
*> \param[in] LDA
@@ -109,14 +107,13 @@ SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
109107
INTEGER I1, I2, LDA, N
110108
* ..
111109
* .. Array Arguments ..
112-
DOUBLE PRECISION A( LDA, N )
110+
DOUBLE PRECISION A( LDA, * )
113111
*
114112
* =====================================================================
115113
*
116114
* ..
117115
* .. Local Scalars ..
118116
LOGICAL UPPER
119-
INTEGER I
120117
DOUBLE PRECISION TMP
121118
*
122119
* .. External Functions ..
@@ -143,19 +140,12 @@ SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
143140
A(I1,I1)=A(I2,I2)
144141
A(I2,I2)=TMP
145142
*
146-
DO I=1,I2-I1-1
147-
TMP=A(I1,I1+I)
148-
A(I1,I1+I)=A(I1+I,I2)
149-
A(I1+I,I2)=TMP
150-
END DO
143+
CALL DSWAP( I2-I1-1, A(I1,I1+1), LDA, A(I1+1,I2), 1 )
151144
*
152145
* third swap
153146
* - swap row I1 and I2 from I2+1 to N
154-
DO I=I2+1,N
155-
TMP=A(I1,I)
156-
A(I1,I)=A(I2,I)
157-
A(I2,I)=TMP
158-
END DO
147+
IF ( I2.LT.N )
148+
$ CALL DSWAP( N-I2, A(I1,I2+1), LDA, A(I2,I2+1), LDA )
159149
*
160150
ELSE
161151
*
@@ -171,19 +161,12 @@ SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
171161
A(I1,I1)=A(I2,I2)
172162
A(I2,I2)=TMP
173163
*
174-
DO I=1,I2-I1-1
175-
TMP=A(I1+I,I1)
176-
A(I1+I,I1)=A(I2,I1+I)
177-
A(I2,I1+I)=TMP
178-
END DO
164+
CALL DSWAP( I2-I1-1, A(I1+1,I1), 1, A(I2,I1+1), LDA )
179165
*
180166
* third swap
181167
* - swap col I1 and I2 from I2+1 to N
182-
DO I=I2+1,N
183-
TMP=A(I,I1)
184-
A(I,I1)=A(I,I2)
185-
A(I,I2)=TMP
186-
END DO
168+
IF ( I2.LT.N )
169+
$ CALL DSWAP( N-I2, A(I2+1,I1), 1, A(I2+1,I2), 1 )
187170
*
188171
ENDIF
189172
END SUBROUTINE DSYSWAPR

SRC/ssyswapr.f

Lines changed: 15 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -57,16 +57,14 @@
5757
*>
5858
*> \param[in,out] A
5959
*> \verbatim
60-
*> A is REAL array, dimension (LDA,N)
61-
*> On entry, the NB diagonal matrix D and the multipliers
62-
*> used to obtain the factor U or L as computed by SSYTRF.
63-
*>
64-
*> On exit, if INFO = 0, the (symmetric) inverse of the original
65-
*> matrix. If UPLO = 'U', the upper triangular part of the
66-
*> inverse is formed and the part of A below the diagonal is not
67-
*> referenced; if UPLO = 'L' the lower triangular part of the
68-
*> inverse is formed and the part of A above the diagonal is
69-
*> not referenced.
60+
*> A is REAL array, dimension (LDA,*)
61+
*> On entry, the N-by-N matrix A. On exit, the permuted matrix
62+
*> where the rows I1 and I2 and columns I1 and I2 are interchanged.
63+
*> If UPLO = 'U', the interchanges are applied to the upper
64+
*> triangular part and the strictly lower triangular part of A is
65+
*> not referenced; if UPLO = 'L', the interchanges are applied to
66+
*> the lower triangular part and the part of A above the diagonal
67+
*> is not referenced.
7068
*> \endverbatim
7169
*>
7270
*> \param[in] LDA
@@ -109,14 +107,13 @@ SUBROUTINE SSYSWAPR( UPLO, N, A, LDA, I1, I2)
109107
INTEGER I1, I2, LDA, N
110108
* ..
111109
* .. Array Arguments ..
112-
REAL A( LDA, N )
110+
REAL A( LDA, * )
113111
*
114112
* =====================================================================
115113
*
116114
* ..
117115
* .. Local Scalars ..
118116
LOGICAL UPPER
119-
INTEGER I
120117
REAL TMP
121118
*
122119
* .. External Functions ..
@@ -143,19 +140,12 @@ SUBROUTINE SSYSWAPR( UPLO, N, A, LDA, I1, I2)
143140
A(I1,I1)=A(I2,I2)
144141
A(I2,I2)=TMP
145142
*
146-
DO I=1,I2-I1-1
147-
TMP=A(I1,I1+I)
148-
A(I1,I1+I)=A(I1+I,I2)
149-
A(I1+I,I2)=TMP
150-
END DO
143+
CALL SSWAP( I2-I1-1, A(I1,I1+1), LDA, A(I1+1,I2), 1 )
151144
*
152145
* third swap
153146
* - swap row I1 and I2 from I2+1 to N
154-
DO I=I2+1,N
155-
TMP=A(I1,I)
156-
A(I1,I)=A(I2,I)
157-
A(I2,I)=TMP
158-
END DO
147+
IF ( I2.LT.N )
148+
$ CALL SSWAP( N-I2, A(I1,I2+1), LDA, A(I2,I2+1), LDA )
159149
*
160150
ELSE
161151
*
@@ -171,19 +161,12 @@ SUBROUTINE SSYSWAPR( UPLO, N, A, LDA, I1, I2)
171161
A(I1,I1)=A(I2,I2)
172162
A(I2,I2)=TMP
173163
*
174-
DO I=1,I2-I1-1
175-
TMP=A(I1+I,I1)
176-
A(I1+I,I1)=A(I2,I1+I)
177-
A(I2,I1+I)=TMP
178-
END DO
164+
CALL SSWAP( I2-I1-1, A(I1+1,I1), 1, A(I2,I1+1), LDA )
179165
*
180166
* third swap
181167
* - swap col I1 and I2 from I2+1 to N
182-
DO I=I2+1,N
183-
TMP=A(I,I1)
184-
A(I,I1)=A(I,I2)
185-
A(I,I2)=TMP
186-
END DO
168+
IF ( I2.LT.N )
169+
$ CALL SSWAP( N-I2, A(I2+1,I1), 1, A(I2+1,I2), 1 )
187170
*
188171
ENDIF
189172
END SUBROUTINE SSYSWAPR

SRC/zsyswapr.f

Lines changed: 15 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -57,16 +57,14 @@
5757
*>
5858
*> \param[in,out] A
5959
*> \verbatim
60-
*> A is COMPLEX*16 array, dimension (LDA,N)
61-
*> On entry, the NB diagonal matrix D and the multipliers
62-
*> used to obtain the factor U or L as computed by ZSYTRF.
63-
*>
64-
*> On exit, if INFO = 0, the (symmetric) inverse of the original
65-
*> matrix. If UPLO = 'U', the upper triangular part of the
66-
*> inverse is formed and the part of A below the diagonal is not
67-
*> referenced; if UPLO = 'L' the lower triangular part of the
68-
*> inverse is formed and the part of A above the diagonal is
69-
*> not referenced.
60+
*> A is COMPLEX*16 array, dimension (LDA,*)
61+
*> On entry, the N-by-N matrix A. On exit, the permuted matrix
62+
*> where the rows I1 and I2 and columns I1 and I2 are interchanged.
63+
*> If UPLO = 'U', the interchanges are applied to the upper
64+
*> triangular part and the strictly lower triangular part of A is
65+
*> not referenced; if UPLO = 'L', the interchanges are applied to
66+
*> the lower triangular part and the part of A above the diagonal
67+
*> is not referenced.
7068
*> \endverbatim
7169
*>
7270
*> \param[in] LDA
@@ -109,14 +107,13 @@ SUBROUTINE ZSYSWAPR( UPLO, N, A, LDA, I1, I2)
109107
INTEGER I1, I2, LDA, N
110108
* ..
111109
* .. Array Arguments ..
112-
COMPLEX*16 A( LDA, N )
110+
COMPLEX*16 A( LDA, * )
113111
*
114112
* =====================================================================
115113
*
116114
* ..
117115
* .. Local Scalars ..
118116
LOGICAL UPPER
119-
INTEGER I
120117
COMPLEX*16 TMP
121118
*
122119
* .. External Functions ..
@@ -143,19 +140,12 @@ SUBROUTINE ZSYSWAPR( UPLO, N, A, LDA, I1, I2)
143140
A(I1,I1)=A(I2,I2)
144141
A(I2,I2)=TMP
145142
*
146-
DO I=1,I2-I1-1
147-
TMP=A(I1,I1+I)
148-
A(I1,I1+I)=A(I1+I,I2)
149-
A(I1+I,I2)=TMP
150-
END DO
143+
CALL ZSWAP( I2-I1-1, A(I1,I1+1), LDA, A(I1+1,I2), 1 )
151144
*
152145
* third swap
153146
* - swap row I1 and I2 from I2+1 to N
154-
DO I=I2+1,N
155-
TMP=A(I1,I)
156-
A(I1,I)=A(I2,I)
157-
A(I2,I)=TMP
158-
END DO
147+
IF ( I2.LT.N )
148+
$ CALL ZSWAP( N-I2, A(I1,I2+1), LDA, A(I2,I2+1), LDA )
159149
*
160150
ELSE
161151
*
@@ -171,19 +161,12 @@ SUBROUTINE ZSYSWAPR( UPLO, N, A, LDA, I1, I2)
171161
A(I1,I1)=A(I2,I2)
172162
A(I2,I2)=TMP
173163
*
174-
DO I=1,I2-I1-1
175-
TMP=A(I1+I,I1)
176-
A(I1+I,I1)=A(I2,I1+I)
177-
A(I2,I1+I)=TMP
178-
END DO
164+
CALL ZSWAP( I2-I1-1, A(I1+1,I1), 1, A(I2,I1+1), LDA )
179165
*
180166
* third swap
181167
* - swap col I1 and I2 from I2+1 to N
182-
DO I=I2+1,N
183-
TMP=A(I,I1)
184-
A(I,I1)=A(I,I2)
185-
A(I,I2)=TMP
186-
END DO
168+
IF ( I2.LT.N )
169+
$ CALL ZSWAP( N-I2, A(I2+1,I1), 1, A(I2+1,I2), 1 )
187170
*
188171
ENDIF
189172
END SUBROUTINE ZSYSWAPR

0 commit comments

Comments
 (0)