Skip to content

Commit 6e88a11

Browse files
langoulangou
authored
Merge pull request #1251 from martin-frbg/issue1183
Optimize looping over the lower triangular in fat matrix cases of LACPY/LANTR/LASCL
2 parents 54b6620 + 968119f commit 6e88a11

12 files changed

Lines changed: 36 additions & 36 deletions

File tree

‎SRC/clacpy.f‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -134,7 +134,7 @@ SUBROUTINE CLACPY( UPLO, M, N, A, LDA, B, LDB )
134134
20 CONTINUE
135135
*
136136
ELSE IF( LSAME( UPLO, 'L' ) ) THEN
137-
DO 40 J = 1, N
137+
DO 40 J = 1, MIN( M, N )
138138
DO 30 I = J, M
139139
B( I, J ) = A( I, J )
140140
30 CONTINUE

‎SRC/clantr.f‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -193,7 +193,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
193193
10 CONTINUE
194194
20 CONTINUE
195195
ELSE
196-
DO 40 J = 1, N
196+
DO 40 J = 1, MIN( M, N )
197197
DO 30 I = J + 1, M
198198
SUM = ABS( A( I, J ) )
199199
IF( VALUE .LT. SUM .OR.
@@ -212,7 +212,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
212212
50 CONTINUE
213213
60 CONTINUE
214214
ELSE
215-
DO 80 J = 1, N
215+
DO 80 J = 1, MIN( M, N )
216216
DO 70 I = J, M
217217
SUM = ABS( A( I, J ) )
218218
IF( VALUE .LT. SUM .OR.
@@ -243,7 +243,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
243243
IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
244244
110 CONTINUE
245245
ELSE
246-
DO 140 J = 1, N
246+
DO 140 J = 1, MIN( M, N )
247247
IF( UDIAG ) THEN
248248
SUM = ONE
249249
DO 120 I = J + 1, M
@@ -290,7 +290,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
290290
DO 220 I = N + 1, M
291291
WORK( I ) = ZERO
292292
220 CONTINUE
293-
DO 240 J = 1, N
293+
DO 240 J = 1, MIN( M, N )
294294
DO 230 I = J + 1, M
295295
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
296296
230 CONTINUE
@@ -299,7 +299,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
299299
DO 250 I = 1, M
300300
WORK( I ) = ZERO
301301
250 CONTINUE
302-
DO 270 J = 1, N
302+
DO 270 J = 1, MIN( M, N )
303303
DO 260 I = J, M
304304
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
305305
260 CONTINUE
@@ -336,14 +336,14 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
336336
IF( LSAME( DIAG, 'U' ) ) THEN
337337
SCALE = ONE
338338
SUM = REAL( MIN( M, N ) )
339-
DO 310 J = 1, N
339+
DO 310 J = 1, MIN( M, N )
340340
CALL CLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
341341
$ SUM )
342342
310 CONTINUE
343343
ELSE
344344
SCALE = ZERO
345345
SUM = ONE
346-
DO 320 J = 1, N
346+
DO 320 J = 1, MIN( M, N )
347347
CALL CLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
348348
320 CONTINUE
349349
END IF

‎SRC/clascl.f‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -291,7 +291,7 @@ SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA,
291291
*
292292
* Lower triangular matrix
293293
*
294-
DO 50 J = 1, N
294+
DO 50 J = 1, MIN( M, N )
295295
DO 40 I = J, M
296296
A( I, J ) = A( I, J )*MUL
297297
40 CONTINUE

‎SRC/dlacpy.f‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -133,7 +133,7 @@ SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
133133
10 CONTINUE
134134
20 CONTINUE
135135
ELSE IF( LSAME( UPLO, 'L' ) ) THEN
136-
DO 40 J = 1, N
136+
DO 40 J = 1, MIN( M, N )
137137
DO 30 I = J, M
138138
B( I, J ) = A( I, J )
139139
30 CONTINUE

‎SRC/dlantr.f‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -191,7 +191,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
191191
10 CONTINUE
192192
20 CONTINUE
193193
ELSE
194-
DO 40 J = 1, N
194+
DO 40 J = 1, MIN( M, N )
195195
DO 30 I = J + 1, M
196196
SUM = ABS( A( I, J ) )
197197
IF( VALUE .LT. SUM .OR.
@@ -210,7 +210,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
210210
50 CONTINUE
211211
60 CONTINUE
212212
ELSE
213-
DO 80 J = 1, N
213+
DO 80 J = 1, MIN( M, N )
214214
DO 70 I = J, M
215215
SUM = ABS( A( I, J ) )
216216
IF( VALUE .LT. SUM .OR.
@@ -241,7 +241,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
241241
IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
242242
110 CONTINUE
243243
ELSE
244-
DO 140 J = 1, N
244+
DO 140 J = 1, MIN( M, N )
245245
IF( UDIAG ) THEN
246246
SUM = ONE
247247
DO 120 I = J + 1, M
@@ -288,7 +288,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
288288
DO 220 I = N + 1, M
289289
WORK( I ) = ZERO
290290
220 CONTINUE
291-
DO 240 J = 1, N
291+
DO 240 J = 1, MIN (M, N )
292292
DO 230 I = J + 1, M
293293
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
294294
230 CONTINUE
@@ -297,7 +297,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
297297
DO 250 I = 1, M
298298
WORK( I ) = ZERO
299299
250 CONTINUE
300-
DO 270 J = 1, N
300+
DO 270 J = 1, MIN( M, N )
301301
DO 260 I = J, M
302302
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
303303
260 CONTINUE
@@ -334,14 +334,14 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
334334
IF( LSAME( DIAG, 'U' ) ) THEN
335335
SCALE = ONE
336336
SUM = MIN( M, N )
337-
DO 310 J = 1, N
337+
DO 310 J = 1, MIN( M, N )
338338
CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
339339
$ SUM )
340340
310 CONTINUE
341341
ELSE
342342
SCALE = ZERO
343343
SUM = ONE
344-
DO 320 J = 1, N
344+
DO 320 J = 1, MIN( M, N )
345345
CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
346346
320 CONTINUE
347347
END IF

‎SRC/dlascl.f‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -291,7 +291,7 @@ SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA,
291291
*
292292
* Lower triangular matrix
293293
*
294-
DO 50 J = 1, N
294+
DO 50 J = 1, MIN( M, N )
295295
DO 40 I = J, M
296296
A( I, J ) = A( I, J )*MUL
297297
40 CONTINUE

‎SRC/slacpy.f‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -133,7 +133,7 @@ SUBROUTINE SLACPY( UPLO, M, N, A, LDA, B, LDB )
133133
10 CONTINUE
134134
20 CONTINUE
135135
ELSE IF( LSAME( UPLO, 'L' ) ) THEN
136-
DO 40 J = 1, N
136+
DO 40 J = 1, MIN( M, N )
137137
DO 30 I = J, M
138138
B( I, J ) = A( I, J )
139139
30 CONTINUE

‎SRC/slantr.f‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -191,7 +191,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
191191
10 CONTINUE
192192
20 CONTINUE
193193
ELSE
194-
DO 40 J = 1, N
194+
DO 40 J = 1, MIN( M, N )
195195
DO 30 I = J + 1, M
196196
SUM = ABS( A( I, J ) )
197197
IF( VALUE .LT. SUM .OR.
@@ -210,7 +210,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
210210
50 CONTINUE
211211
60 CONTINUE
212212
ELSE
213-
DO 80 J = 1, N
213+
DO 80 J = 1, MIN( M, N )
214214
DO 70 I = J, M
215215
SUM = ABS( A( I, J ) )
216216
IF( VALUE .LT. SUM .OR.
@@ -241,7 +241,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
241241
IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
242242
110 CONTINUE
243243
ELSE
244-
DO 140 J = 1, N
244+
DO 140 J = 1, MIN( M, N )
245245
IF( UDIAG ) THEN
246246
SUM = ONE
247247
DO 120 I = J + 1, M
@@ -288,7 +288,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
288288
DO 220 I = N + 1, M
289289
WORK( I ) = ZERO
290290
220 CONTINUE
291-
DO 240 J = 1, N
291+
DO 240 J = 1, MIN( M, N )
292292
DO 230 I = J + 1, M
293293
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
294294
230 CONTINUE
@@ -297,7 +297,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
297297
DO 250 I = 1, M
298298
WORK( I ) = ZERO
299299
250 CONTINUE
300-
DO 270 J = 1, N
300+
DO 270 J = 1, MIN( M, N )
301301
DO 260 I = J, M
302302
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
303303
260 CONTINUE
@@ -334,14 +334,14 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
334334
IF( LSAME( DIAG, 'U' ) ) THEN
335335
SCALE = ONE
336336
SUM = REAL( MIN( M, N ) )
337-
DO 310 J = 1, N
337+
DO 310 J = 1, MIN ( M, N )
338338
CALL SLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
339339
$ SUM )
340340
310 CONTINUE
341341
ELSE
342342
SCALE = ZERO
343343
SUM = ONE
344-
DO 320 J = 1, N
344+
DO 320 J = 1, MIN( M, N )
345345
CALL SLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
346346
320 CONTINUE
347347
END IF

‎SRC/slascl.f‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -291,7 +291,7 @@ SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA,
291291
*
292292
* Lower triangular matrix
293293
*
294-
DO 50 J = 1, N
294+
DO 50 J = 1, MIN( M, N )
295295
DO 40 I = J, M
296296
A( I, J ) = A( I, J )*MUL
297297
40 CONTINUE

‎SRC/zlacpy.f‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -134,7 +134,7 @@ SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB )
134134
20 CONTINUE
135135
*
136136
ELSE IF( LSAME( UPLO, 'L' ) ) THEN
137-
DO 40 J = 1, N
137+
DO 40 J = 1, MIN( M, N )
138138
DO 30 I = J, M
139139
B( I, J ) = A( I, J )
140140
30 CONTINUE

0 commit comments

Comments
 (0)