Skip to content

Commit 960b60e

Browse files
langoulangou
authored
Merge pull request #570 from weslleyspereira/fix-bug-in-xCOMBSSQ
Revert "Merge pull request #290"
2 parents 9e647a9 + aaeeef2 commit 960b60e

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

50 files changed

+572
-1490
lines changed

‎SRC/CMakeLists.txt

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -155,7 +155,7 @@ set(SLASRC
155155
ssytrd_2stage.f ssytrd_sy2sb.f ssytrd_sb2st.F ssb2st_kernels.f
156156
ssyevd_2stage.f ssyev_2stage.f ssyevx_2stage.f ssyevr_2stage.f
157157
ssbev_2stage.f ssbevx_2stage.f ssbevd_2stage.f ssygv_2stage.f
158-
sgesvdq.f scombssq.f)
158+
sgesvdq.f)
159159

160160
set(DSLASRC spotrs.f sgetrs.f spotrf.f sgetrf.f)
161161

@@ -352,7 +352,7 @@ set(DLASRC
352352
dsytrd_2stage.f dsytrd_sy2sb.f dsytrd_sb2st.F dsb2st_kernels.f
353353
dsyevd_2stage.f dsyev_2stage.f dsyevx_2stage.f dsyevr_2stage.f
354354
dsbev_2stage.f dsbevx_2stage.f dsbevd_2stage.f dsygv_2stage.f
355-
dgesvdq.f dcombssq.f)
355+
dgesvdq.f)
356356

357357
set(DXLASRC dgesvxx.f dgerfsx.f dla_gerfsx_extended.f dla_geamv.f
358358
dla_gercond.f dla_gerpvgrw.f dsysvxx.f dsyrfsx.f

‎SRC/Makefile

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -191,7 +191,7 @@ SLASRC = \
191191
ssytrd_2stage.o ssytrd_sy2sb.o ssytrd_sb2st.o ssb2st_kernels.o \
192192
ssyevd_2stage.o ssyev_2stage.o ssyevx_2stage.o ssyevr_2stage.o \
193193
ssbev_2stage.o ssbevx_2stage.o ssbevd_2stage.o ssygv_2stage.o \
194-
sgesvdq.o scombssq.o
194+
sgesvdq.o
195195

196196
DSLASRC = spotrs.o sgetrs.o spotrf.o sgetrf.o
197197

@@ -394,7 +394,7 @@ DLASRC = \
394394
dsytrd_2stage.o dsytrd_sy2sb.o dsytrd_sb2st.o dsb2st_kernels.o \
395395
dsyevd_2stage.o dsyev_2stage.o dsyevx_2stage.o dsyevr_2stage.o \
396396
dsbev_2stage.o dsbevx_2stage.o dsbevd_2stage.o dsygv_2stage.o \
397-
dgesvdq.o dcombssq.o
397+
dgesvdq.o
398398

399399
ifdef USEXBLAS
400400
DXLASRC = dgesvxx.o dgerfsx.o dla_gerfsx_extended.o dla_geamv.o \

‎SRC/clangb.f

Lines changed: 6 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -127,7 +127,6 @@ REAL FUNCTION CLANGB( NORM, N, KL, KU, AB, LDAB,
127127
* -- LAPACK is a software package provided by Univ. of Tennessee, --
128128
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
129129
*
130-
IMPLICIT NONE
131130
* .. Scalar Arguments ..
132131
CHARACTER NORM
133132
INTEGER KL, KU, LDAB, N
@@ -145,17 +144,14 @@ REAL FUNCTION CLANGB( NORM, N, KL, KU, AB, LDAB,
145144
* ..
146145
* .. Local Scalars ..
147146
INTEGER I, J, K, L
148-
REAL SUM, VALUE, TEMP
149-
* ..
150-
* .. Local Arrays ..
151-
REAL SSQ( 2 ), COLSSQ( 2 )
147+
REAL SCALE, SUM, VALUE, TEMP
152148
* ..
153149
* .. External Functions ..
154150
LOGICAL LSAME, SISNAN
155151
EXTERNAL LSAME, SISNAN
156152
* ..
157153
* .. External Subroutines ..
158-
EXTERNAL CLASSQ, SCOMBSSQ
154+
EXTERNAL CLASSQ
159155
* ..
160156
* .. Intrinsic Functions ..
161157
INTRINSIC ABS, MAX, MIN, SQRT
@@ -208,22 +204,15 @@ REAL FUNCTION CLANGB( NORM, N, KL, KU, AB, LDAB,
208204
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
209205
*
210206
* Find normF(A).
211-
* SSQ(1) is scale
212-
* SSQ(2) is sum-of-squares
213-
* For better accuracy, sum each column separately.
214207
*
215-
SSQ( 1 ) = ZERO
216-
SSQ( 2 ) = ONE
208+
SCALE = ZERO
209+
SUM = ONE
217210
DO 90 J = 1, N
218211
L = MAX( 1, J-KU )
219212
K = KU + 1 - J + L
220-
COLSSQ( 1 ) = ZERO
221-
COLSSQ( 2 ) = ONE
222-
CALL CLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1,
223-
$ COLSSQ( 1 ), COLSSQ( 2 ) )
224-
CALL SCOMBSSQ( SSQ, COLSSQ )
213+
CALL CLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM )
225214
90 CONTINUE
226-
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
215+
VALUE = SCALE*SQRT( SUM )
227216
END IF
228217
*
229218
CLANGB = VALUE

‎SRC/clange.f

Lines changed: 6 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -117,7 +117,6 @@ REAL FUNCTION CLANGE( NORM, M, N, A, LDA, WORK )
117117
* -- LAPACK is a software package provided by Univ. of Tennessee, --
118118
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
119119
*
120-
IMPLICIT NONE
121120
* .. Scalar Arguments ..
122121
CHARACTER NORM
123122
INTEGER LDA, M, N
@@ -135,17 +134,14 @@ REAL FUNCTION CLANGE( NORM, M, N, A, LDA, WORK )
135134
* ..
136135
* .. Local Scalars ..
137136
INTEGER I, J
138-
REAL SUM, VALUE, TEMP
139-
* ..
140-
* .. Local Arrays ..
141-
REAL SSQ( 2 ), COLSSQ( 2 )
137+
REAL SCALE, SUM, VALUE, TEMP
142138
* ..
143139
* .. External Functions ..
144140
LOGICAL LSAME, SISNAN
145141
EXTERNAL LSAME, SISNAN
146142
* ..
147143
* .. External Subroutines ..
148-
EXTERNAL CLASSQ, SCOMBSSQ
144+
EXTERNAL CLASSQ
149145
* ..
150146
* .. Intrinsic Functions ..
151147
INTRINSIC ABS, MIN, SQRT
@@ -197,19 +193,13 @@ REAL FUNCTION CLANGE( NORM, M, N, A, LDA, WORK )
197193
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
198194
*
199195
* Find normF(A).
200-
* SSQ(1) is scale
201-
* SSQ(2) is sum-of-squares
202-
* For better accuracy, sum each column separately.
203196
*
204-
SSQ( 1 ) = ZERO
205-
SSQ( 2 ) = ONE
197+
SCALE = ZERO
198+
SUM = ONE
206199
DO 90 J = 1, N
207-
COLSSQ( 1 ) = ZERO
208-
COLSSQ( 2 ) = ONE
209-
CALL CLASSQ( M, A( 1, J ), 1, COLSSQ( 1 ), COLSSQ( 2 ) )
210-
CALL SCOMBSSQ( SSQ, COLSSQ )
200+
CALL CLASSQ( M, A( 1, J ), 1, SCALE, SUM )
211201
90 CONTINUE
212-
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
202+
VALUE = SCALE*SQRT( SUM )
213203
END IF
214204
*
215205
CLANGE = VALUE

‎SRC/clanhb.f

Lines changed: 13 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -134,7 +134,6 @@ REAL FUNCTION CLANHB( NORM, UPLO, N, K, AB, LDAB,
134134
* -- LAPACK is a software package provided by Univ. of Tennessee, --
135135
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
136136
*
137-
IMPLICIT NONE
138137
* .. Scalar Arguments ..
139138
CHARACTER NORM, UPLO
140139
INTEGER K, LDAB, N
@@ -152,17 +151,14 @@ REAL FUNCTION CLANHB( NORM, UPLO, N, K, AB, LDAB,
152151
* ..
153152
* .. Local Scalars ..
154153
INTEGER I, J, L
155-
REAL ABSA, SUM, VALUE
156-
* ..
157-
* .. Local Arrays ..
158-
REAL SSQ( 2 ), COLSSQ( 2 )
154+
REAL ABSA, SCALE, SUM, VALUE
159155
* ..
160156
* .. External Functions ..
161157
LOGICAL LSAME, SISNAN
162158
EXTERNAL LSAME, SISNAN
163159
* ..
164160
* .. External Subroutines ..
165-
EXTERNAL CLASSQ, SCOMBSSQ
161+
EXTERNAL CLASSQ
166162
* ..
167163
* .. Intrinsic Functions ..
168164
INTRINSIC ABS, MAX, MIN, REAL, SQRT
@@ -234,57 +230,39 @@ REAL FUNCTION CLANHB( NORM, UPLO, N, K, AB, LDAB,
234230
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
235231
*
236232
* Find normF(A).
237-
* SSQ(1) is scale
238-
* SSQ(2) is sum-of-squares
239-
* For better accuracy, sum each column separately.
240-
*
241-
SSQ( 1 ) = ZERO
242-
SSQ( 2 ) = ONE
243-
*
244-
* Sum off-diagonals
245233
*
234+
SCALE = ZERO
235+
SUM = ONE
246236
IF( K.GT.0 ) THEN
247237
IF( LSAME( UPLO, 'U' ) ) THEN
248238
DO 110 J = 2, N
249-
COLSSQ( 1 ) = ZERO
250-
COLSSQ( 2 ) = ONE
251239
CALL CLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ),
252-
$ 1, COLSSQ( 1 ), COLSSQ( 2 ) )
253-
CALL SCOMBSSQ( SSQ, COLSSQ )
240+
$ 1, SCALE, SUM )
254241
110 CONTINUE
255242
L = K + 1
256243
ELSE
257244
DO 120 J = 1, N - 1
258-
COLSSQ( 1 ) = ZERO
259-
COLSSQ( 2 ) = ONE
260-
CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1,
261-
$ COLSSQ( 1 ), COLSSQ( 2 ) )
262-
CALL SCOMBSSQ( SSQ, COLSSQ )
245+
CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
246+
$ SUM )
263247
120 CONTINUE
264248
L = 1
265249
END IF
266-
SSQ( 2 ) = 2*SSQ( 2 )
250+
SUM = 2*SUM
267251
ELSE
268252
L = 1
269253
END IF
270-
*
271-
* Sum diagonal
272-
*
273-
COLSSQ( 1 ) = ZERO
274-
COLSSQ( 2 ) = ONE
275254
DO 130 J = 1, N
276255
IF( REAL( AB( L, J ) ).NE.ZERO ) THEN
277256
ABSA = ABS( REAL( AB( L, J ) ) )
278-
IF( COLSSQ( 1 ).LT.ABSA ) THEN
279-
COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2
280-
COLSSQ( 1 ) = ABSA
257+
IF( SCALE.LT.ABSA ) THEN
258+
SUM = ONE + SUM*( SCALE / ABSA )**2
259+
SCALE = ABSA
281260
ELSE
282-
COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2
261+
SUM = SUM + ( ABSA / SCALE )**2
283262
END IF
284263
END IF
285264
130 CONTINUE
286-
CALL SCOMBSSQ( SSQ, COLSSQ )
287-
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
265+
VALUE = SCALE*SQRT( SUM )
288266
END IF
289267
*
290268
CLANHB = VALUE

‎SRC/clanhe.f

Lines changed: 12 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -126,7 +126,6 @@ REAL FUNCTION CLANHE( NORM, UPLO, N, A, LDA, WORK )
126126
* -- LAPACK is a software package provided by Univ. of Tennessee, --
127127
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
128128
*
129-
IMPLICIT NONE
130129
* .. Scalar Arguments ..
131130
CHARACTER NORM, UPLO
132131
INTEGER LDA, N
@@ -144,17 +143,14 @@ REAL FUNCTION CLANHE( NORM, UPLO, N, A, LDA, WORK )
144143
* ..
145144
* .. Local Scalars ..
146145
INTEGER I, J
147-
REAL ABSA, SUM, VALUE
148-
* ..
149-
* .. Local Arrays ..
150-
REAL SSQ( 2 ), COLSSQ( 2 )
146+
REAL ABSA, SCALE, SUM, VALUE
151147
* ..
152148
* .. External Functions ..
153149
LOGICAL LSAME, SISNAN
154150
EXTERNAL LSAME, SISNAN
155151
* ..
156152
* .. External Subroutines ..
157-
EXTERNAL CLASSQ, SCOMBSSQ
153+
EXTERNAL CLASSQ
158154
* ..
159155
* .. Intrinsic Functions ..
160156
INTRINSIC ABS, REAL, SQRT
@@ -224,48 +220,31 @@ REAL FUNCTION CLANHE( NORM, UPLO, N, A, LDA, WORK )
224220
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
225221
*
226222
* Find normF(A).
227-
* SSQ(1) is scale
228-
* SSQ(2) is sum-of-squares
229-
* For better accuracy, sum each column separately.
230-
*
231-
SSQ( 1 ) = ZERO
232-
SSQ( 2 ) = ONE
233-
*
234-
* Sum off-diagonals
235223
*
224+
SCALE = ZERO
225+
SUM = ONE
236226
IF( LSAME( UPLO, 'U' ) ) THEN
237227
DO 110 J = 2, N
238-
COLSSQ( 1 ) = ZERO
239-
COLSSQ( 2 ) = ONE
240-
CALL CLASSQ( J-1, A( 1, J ), 1,
241-
$ COLSSQ( 1 ), COLSSQ( 2 ) )
242-
CALL SCOMBSSQ( SSQ, COLSSQ )
228+
CALL CLASSQ( J-1, A( 1, J ), 1, SCALE, SUM )
243229
110 CONTINUE
244230
ELSE
245231
DO 120 J = 1, N - 1
246-
COLSSQ( 1 ) = ZERO
247-
COLSSQ( 2 ) = ONE
248-
CALL CLASSQ( N-J, A( J+1, J ), 1,
249-
$ COLSSQ( 1 ), COLSSQ( 2 ) )
250-
CALL SCOMBSSQ( SSQ, COLSSQ )
232+
CALL CLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM )
251233
120 CONTINUE
252234
END IF
253-
SSQ( 2 ) = 2*SSQ( 2 )
254-
*
255-
* Sum diagonal
256-
*
235+
SUM = 2*SUM
257236
DO 130 I = 1, N
258237
IF( REAL( A( I, I ) ).NE.ZERO ) THEN
259238
ABSA = ABS( REAL( A( I, I ) ) )
260-
IF( SSQ( 1 ).LT.ABSA ) THEN
261-
SSQ( 2 ) = ONE + SSQ( 2 )*( SSQ( 1 ) / ABSA )**2
262-
SSQ( 1 ) = ABSA
239+
IF( SCALE.LT.ABSA ) THEN
240+
SUM = ONE + SUM*( SCALE / ABSA )**2
241+
SCALE = ABSA
263242
ELSE
264-
SSQ( 2 ) = SSQ( 2 ) + ( ABSA / SSQ( 1 ) )**2
243+
SUM = SUM + ( ABSA / SCALE )**2
265244
END IF
266245
END IF
267246
130 CONTINUE
268-
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
247+
VALUE = SCALE*SQRT( SUM )
269248
END IF
270249
*
271250
CLANHE = VALUE

0 commit comments

Comments
 (0)