Skip to content

Commit 3381a0e

Browse files
langoulangou
authored
Merge pull request #685 from angsch/fixes
Fixes
2 parents 79bfdd4 + c8a5cf5 commit 3381a0e

File tree

10 files changed

+93
-159
lines changed

10 files changed

+93
-159
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

‎TESTING/EIG/dchkec.f

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -92,14 +92,14 @@ SUBROUTINE DCHKEC( THRESH, TSTERR, NIN, NOUT )
9292
INTEGER KLAEXC, KLALN2, KLANV2, KLAQTR, KLASY2, KTREXC,
9393
$ KTRSEN, KTRSNA, KTRSYL, LLAEXC, LLALN2, LLANV2,
9494
$ LLAQTR, LLASY2, LTREXC, LTRSYL, NLANV2, NLAQTR,
95-
$ NLASY2, NTESTS, NTRSYL, KTGEXC, NTGEXC, LTGEXC
95+
$ NLASY2, NTESTS, NTRSYL, KTGEXC, LTGEXC
9696
DOUBLE PRECISION EPS, RLAEXC, RLALN2, RLANV2, RLAQTR, RLASY2,
9797
$ RTREXC, RTRSYL, SFMIN, RTGEXC
9898
* ..
9999
* .. Local Arrays ..
100100
INTEGER LTRSEN( 3 ), LTRSNA( 3 ), NLAEXC( 2 ),
101-
$ NLALN2( 2 ), NTREXC( 3 ), NTRSEN( 3 ),
102-
$ NTRSNA( 3 )
101+
$ NLALN2( 2 ), NTGEXC( 2 ), NTREXC( 3 ),
102+
$ NTRSEN( 3 ), NTRSNA( 3 )
103103
DOUBLE PRECISION RTRSEN( 3 ), RTRSNA( 3 )
104104
* ..
105105
* .. External Subroutines ..
@@ -227,7 +227,7 @@ SUBROUTINE DCHKEC( THRESH, TSTERR, NIN, NOUT )
227227
9987 FORMAT( ' Routines pass computational tests if test ratio is les',
228228
$ 's than', F8.2, / / )
229229
9986 FORMAT( ' Error in DTGEXC: RMAX =', D12.3, / ' LMAX = ', I8, ' N',
230-
$ 'INFO=', I8, ' KNT=', I8 )
230+
$ 'INFO=', 2I8, ' KNT=', I8 )
231231
*
232232
* End of DCHKEC
233233
*

‎TESTING/EIG/dget31.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@
6565
*>
6666
*> \param[out] NINFO
6767
*> \verbatim
68-
*> NINFO is INTEGER array, dimension (3)
68+
*> NINFO is INTEGER array, dimension (2)
6969
*> NINFO(1) = number of examples with INFO less than 0
7070
*> NINFO(2) = number of examples with INFO greater than 0
7171
*> \endverbatim

0 commit comments

Comments
 (0)