Skip to content

Optimize looping over the lower triangular in fat matrix cases of LACPY/LANTR/LASCL #1251

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
martin-frbg wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Optimize looping over the lower triangular in fat matrix cases of LACPY/LANTR/LASCL #1251

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion SRC/clacpy.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -134,7 +134,7 @@ SUBROUTINE CLACPY( UPLO, M, N, A, LDA, B, LDB )
20 CONTINUE
*
ELSE IF( LSAME( UPLO, 'L' ) ) THEN
DO 40 J = 1, N
DO 40 J = 1, MIN( M, N )
DO 30 I = J, M
B( I, J ) = A( I, J )
30 CONTINUE
Expand Down
14 changes: 7 additions & 7 deletions SRC/clantr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -193,7 +193,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
10 CONTINUE
20 CONTINUE
ELSE
DO 40 J = 1, N
DO 40 J = 1, MIN( M, N )
DO 30 I = J + 1, M
SUM = ABS( A( I, J ) )
IF( VALUE .LT. SUM .OR.
Expand All @@ -212,7 +212,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
50 CONTINUE
60 CONTINUE
ELSE
DO 80 J = 1, N
DO 80 J = 1, MIN( M, N )
DO 70 I = J, M
SUM = ABS( A( I, J ) )
IF( VALUE .LT. SUM .OR.
Expand Down Expand Up @@ -243,7 +243,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
110 CONTINUE
ELSE
DO 140 J = 1, N
DO 140 J = 1, MIN( M, N )
IF( UDIAG ) THEN
SUM = ONE
DO 120 I = J + 1, M
Expand Down Expand Up @@ -290,7 +290,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
DO 220 I = N + 1, M
WORK( I ) = ZERO
220 CONTINUE
DO 240 J = 1, N
DO 240 J = 1, MIN( M, N )
DO 230 I = J + 1, M
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
230 CONTINUE
Expand All @@ -299,7 +299,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
DO 250 I = 1, M
WORK( I ) = ZERO
250 CONTINUE
DO 270 J = 1, N
DO 270 J = 1, MIN( M, N )
DO 260 I = J, M
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
260 CONTINUE
Expand Down Expand Up @@ -336,14 +336,14 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A,
IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE
SUM = REAL( MIN( M, N ) )
DO 310 J = 1, N
DO 310 J = 1, MIN( M, N )
CALL CLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
$ SUM )
310 CONTINUE
ELSE
SCALE = ZERO
SUM = ONE
DO 320 J = 1, N
DO 320 J = 1, MIN( M, N )
CALL CLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
320 CONTINUE
END IF
Expand Down
2 changes: 1 addition & 1 deletion SRC/clascl.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -291,7 +291,7 @@ SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA,
*
* Lower triangular matrix
*
DO 50 J = 1, N
DO 50 J = 1, MIN( M, N )
DO 40 I = J, M
A( I, J ) = A( I, J )*MUL
40 CONTINUE
Expand Down
2 changes: 1 addition & 1 deletion SRC/dlacpy.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -133,7 +133,7 @@ SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
10 CONTINUE
20 CONTINUE
ELSE IF( LSAME( UPLO, 'L' ) ) THEN
DO 40 J = 1, N
DO 40 J = 1, MIN( M, N )
DO 30 I = J, M
B( I, J ) = A( I, J )
30 CONTINUE
Expand Down
14 changes: 7 additions & 7 deletions SRC/dlantr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -191,7 +191,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
10 CONTINUE
20 CONTINUE
ELSE
DO 40 J = 1, N
DO 40 J = 1, MIN( M, N )
DO 30 I = J + 1, M
SUM = ABS( A( I, J ) )
IF( VALUE .LT. SUM .OR.
Expand All @@ -210,7 +210,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
50 CONTINUE
60 CONTINUE
ELSE
DO 80 J = 1, N
DO 80 J = 1, MIN( M, N )
DO 70 I = J, M
SUM = ABS( A( I, J ) )
IF( VALUE .LT. SUM .OR.
Expand Down Expand Up @@ -241,7 +241,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
110 CONTINUE
ELSE
DO 140 J = 1, N
DO 140 J = 1, MIN( M, N )
IF( UDIAG ) THEN
SUM = ONE
DO 120 I = J + 1, M
Expand Down Expand Up @@ -288,7 +288,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
DO 220 I = N + 1, M
WORK( I ) = ZERO
220 CONTINUE
DO 240 J = 1, N
DO 240 J = 1, MIN (M, N )
DO 230 I = J + 1, M
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
230 CONTINUE
Expand All @@ -297,7 +297,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
DO 250 I = 1, M
WORK( I ) = ZERO
250 CONTINUE
DO 270 J = 1, N
DO 270 J = 1, MIN( M, N )
DO 260 I = J, M
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
260 CONTINUE
Expand Down Expand Up @@ -334,14 +334,14 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A,
IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE
SUM = MIN( M, N )
DO 310 J = 1, N
DO 310 J = 1, MIN( M, N )
CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
$ SUM )
310 CONTINUE
ELSE
SCALE = ZERO
SUM = ONE
DO 320 J = 1, N
DO 320 J = 1, MIN( M, N )
CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
320 CONTINUE
END IF
Expand Down
2 changes: 1 addition & 1 deletion SRC/dlascl.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -291,7 +291,7 @@ SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA,
*
* Lower triangular matrix
*
DO 50 J = 1, N
DO 50 J = 1, MIN( M, N )
DO 40 I = J, M
A( I, J ) = A( I, J )*MUL
40 CONTINUE
Expand Down
2 changes: 1 addition & 1 deletion SRC/slacpy.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -133,7 +133,7 @@ SUBROUTINE SLACPY( UPLO, M, N, A, LDA, B, LDB )
10 CONTINUE
20 CONTINUE
ELSE IF( LSAME( UPLO, 'L' ) ) THEN
DO 40 J = 1, N
DO 40 J = 1, MIN( M, N )
DO 30 I = J, M
B( I, J ) = A( I, J )
30 CONTINUE
Expand Down
14 changes: 7 additions & 7 deletions SRC/slantr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -191,7 +191,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
10 CONTINUE
20 CONTINUE
ELSE
DO 40 J = 1, N
DO 40 J = 1, MIN( M, N )
DO 30 I = J + 1, M
SUM = ABS( A( I, J ) )
IF( VALUE .LT. SUM .OR.
Expand All @@ -210,7 +210,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
50 CONTINUE
60 CONTINUE
ELSE
DO 80 J = 1, N
DO 80 J = 1, MIN( M, N )
DO 70 I = J, M
SUM = ABS( A( I, J ) )
IF( VALUE .LT. SUM .OR.
Expand Down Expand Up @@ -241,7 +241,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
110 CONTINUE
ELSE
DO 140 J = 1, N
DO 140 J = 1, MIN( M, N )
IF( UDIAG ) THEN
SUM = ONE
DO 120 I = J + 1, M
Expand Down Expand Up @@ -288,7 +288,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
DO 220 I = N + 1, M
WORK( I ) = ZERO
220 CONTINUE
DO 240 J = 1, N
DO 240 J = 1, MIN( M, N )
DO 230 I = J + 1, M
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
230 CONTINUE
Expand All @@ -297,7 +297,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
DO 250 I = 1, M
WORK( I ) = ZERO
250 CONTINUE
DO 270 J = 1, N
DO 270 J = 1, MIN( M, N )
DO 260 I = J, M
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
260 CONTINUE
Expand Down Expand Up @@ -334,14 +334,14 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A,
IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE
SUM = REAL( MIN( M, N ) )
DO 310 J = 1, N
DO 310 J = 1, MIN ( M, N )
CALL SLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
$ SUM )
310 CONTINUE
ELSE
SCALE = ZERO
SUM = ONE
DO 320 J = 1, N
DO 320 J = 1, MIN( M, N )
CALL SLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
320 CONTINUE
END IF
Expand Down
2 changes: 1 addition & 1 deletion SRC/slascl.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -291,7 +291,7 @@ SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA,
*
* Lower triangular matrix
*
DO 50 J = 1, N
DO 50 J = 1, MIN( M, N )
DO 40 I = J, M
A( I, J ) = A( I, J )*MUL
40 CONTINUE
Expand Down
2 changes: 1 addition & 1 deletion SRC/zlacpy.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -134,7 +134,7 @@ SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB )
20 CONTINUE
*
ELSE IF( LSAME( UPLO, 'L' ) ) THEN
DO 40 J = 1, N
DO 40 J = 1, MIN( M, N )
DO 30 I = J, M
B( I, J ) = A( I, J )
30 CONTINUE
Expand Down
14 changes: 7 additions & 7 deletions SRC/zlantr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -193,7 +193,7 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A,
10 CONTINUE
20 CONTINUE
ELSE
DO 40 J = 1, N
DO 40 J = 1, MIN( M, N )
DO 30 I = J + 1, M
SUM = ABS( A( I, J ) )
IF( VALUE .LT. SUM .OR.
Expand All @@ -212,7 +212,7 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A,
50 CONTINUE
60 CONTINUE
ELSE
DO 80 J = 1, N
DO 80 J = 1, MIN( M, N )
DO 70 I = J, M
SUM = ABS( A( I, J ) )
IF( VALUE .LT. SUM .OR.
Expand Down Expand Up @@ -243,7 +243,7 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A,
IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
110 CONTINUE
ELSE
DO 140 J = 1, N
DO 140 J = 1, MIN( M, N )
IF( UDIAG ) THEN
SUM = ONE
DO 120 I = J + 1, M
Expand Down Expand Up @@ -290,7 +290,7 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A,
DO 220 I = N + 1, M
WORK( I ) = ZERO
220 CONTINUE
DO 240 J = 1, N
DO 240 J = 1, MIN( M, N )
DO 230 I = J + 1, M
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
230 CONTINUE
Expand All @@ -299,7 +299,7 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A,
DO 250 I = 1, M
WORK( I ) = ZERO
250 CONTINUE
DO 270 J = 1, N
DO 270 J = 1, MIN( M, N )
DO 260 I = J, M
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
260 CONTINUE
Expand Down Expand Up @@ -336,14 +336,14 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A,
IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE
SUM = MIN( M, N )
DO 310 J = 1, N
DO 310 J = 1, MIN( M, N )
CALL ZLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
$ SUM )
310 CONTINUE
ELSE
SCALE = ZERO
SUM = ONE
DO 320 J = 1, N
DO 320 J = 1, MIN( M, N )
CALL ZLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
320 CONTINUE
END IF
Expand Down
2 changes: 1 addition & 1 deletion SRC/zlascl.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -291,7 +291,7 @@ SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA,
*
* Lower triangular matrix
*
DO 50 J = 1, N
DO 50 J = 1, MIN( M, N )
DO 40 I = J, M
A( I, J ) = A( I, J )*MUL
40 CONTINUE
Expand Down
Loading