Skip to content

Commit

Permalink
Use unblocked code if insufficient workspace is provided
Browse files Browse the repository at this point in the history
  • Loading branch information
angsch committed Aug 21, 2022
1 parent 638597f commit f933da7
Show file tree
Hide file tree
Showing 6 changed files with 26 additions and 24 deletions.
16 changes: 8 additions & 8 deletions SRC/ctrsyl3.f
Original file line number Diff line number Diff line change
Expand Up @@ -184,14 +184,14 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
* .. External Functions ..
LOGICAL LSAME
INTEGER ILAENV
REAL SLAMCH, SLARMM, CLANGE
EXTERNAL SLAMCH, SLARMM, ILAENV, LSAME, CLANGE
REAL CLANGE, SLAMCH, SLARMM
EXTERNAL CLANGE, ILAENV, LSAME, SLAMCH, SLARMM
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, CSSCAL, CGEMM, CLASCL, CTRSYL
EXTERNAL CSSCAL, CGEMM, CLASCL, CTRSYL, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, EXPONENT, REAL, AIMAG, MAX, MIN
INTRINSIC ABS, AIMAG, EXPONENT, MAX, MIN, REAL
* ..
* .. Executable Statements ..
*
Expand Down Expand Up @@ -237,8 +237,6 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -11
ELSE IF( .NOT.LQUERY .AND. LDSWORK.LT.MAX( NBA, NBB ) ) THEN
INFO = -16
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CTRSYL3', -INFO )
Expand All @@ -249,12 +247,14 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
*
* Quick return if possible
*
SCALE = ONE
IF( M.EQ.0 .OR. N.EQ.0 )
$ RETURN
*
* Use unblocked code for small problems
* Use unblocked code for small problems or if insufficient
* workspace is provided
*
IF( NBA.EQ.1 .OR. NBB.EQ.1 ) THEN
IF( MIN( NBA, NBB ).EQ.1 .OR. LDSWORK.LT.MAX( NBA, NBB ) ) THEN
CALL CTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
$ C, LDC, SCALE, INFO )
RETURN
Expand Down
13 changes: 6 additions & 7 deletions SRC/dtrsyl3.f
Original file line number Diff line number Diff line change
Expand Up @@ -215,7 +215,7 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
EXTERNAL DGEMM, DLASCL, DSCAL, DTRSYL, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, EXPONENT, DBLE, MAX, MIN
INTRINSIC ABS, DBLE, EXPONENT, MAX, MIN
* ..
* .. Executable Statements ..
*
Expand Down Expand Up @@ -264,10 +264,6 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -11
ELSE IF( .NOT.LQUERY .AND. LIWORK.LT.IWORK(1) ) THEN
INFO = -14
ELSE IF( .NOT.LQUERY .AND. LDSWORK.LT.MAX( NBA, NBB ) ) THEN
INFO = -16
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DTRSYL3', -INFO )
Expand All @@ -278,12 +274,15 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
*
* Quick return if possible
*
SCALE = ONE
IF( M.EQ.0 .OR. N.EQ.0 )
$ RETURN
*
* Use unblocked code for small problems
* Use unblocked code for small problems or if insufficient
* workspaces are provided
*
IF( NBA.EQ.1 .OR. NBB.EQ.1 ) THEN
IF( MIN( NBA, NBB ).EQ.1 .OR. LDSWORK.LT.MAX( NBA, NBB ) .OR.
$ LIWORK.LT.IWORK(1) ) THEN
CALL DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
$ C, LDC, SCALE, INFO )
RETURN
Expand Down
7 changes: 5 additions & 2 deletions SRC/strsyl3.f
Original file line number Diff line number Diff line change
Expand Up @@ -278,12 +278,15 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
*
* Quick return if possible
*
SCALE = ONE
IF( M.EQ.0 .OR. N.EQ.0 )
$ RETURN
*
* Use unblocked code for small problems
* Use unblocked code for small problems or if insufficient
* workspaces are provided
*
IF( NBA.EQ.1 .OR. NBB.EQ.1 ) THEN
IF( MIN( NBA, NBB ).EQ.1 .OR. LDSWORK.LT.MAX( NBA, NBB ) .OR.
$ LIWORK.LT.IWORK(1) ) THEN
CALL STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
$ C, LDC, SCALE, INFO )
RETURN
Expand Down
10 changes: 5 additions & 5 deletions SRC/ztrsyl3.f
Original file line number Diff line number Diff line change
Expand Up @@ -192,7 +192,7 @@ SUBROUTINE ZTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
EXTERNAL XERBLA, ZDSCAL, ZGEMM, ZLASCL, ZTRSYL
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, EXPONENT, DBLE, DIMAG, MAX, MIN
INTRINSIC ABS, DBLE, DIMAG, EXPONENT, MAX, MIN
* ..
* .. Executable Statements ..
*
Expand Down Expand Up @@ -238,8 +238,6 @@ SUBROUTINE ZTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
INFO = -11
ELSE IF( .NOT.LQUERY .AND. LDSWORK.LT.MAX( NBA, NBB ) ) THEN
INFO = -16
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZTRSYL3', -INFO )
Expand All @@ -250,12 +248,14 @@ SUBROUTINE ZTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
*
* Quick return if possible
*
SCALE = ONE
IF( M.EQ.0 .OR. N.EQ.0 )
$ RETURN
*
* Use unblocked code for small problems
* Use unblocked code for small problems or if insufficient
* workspace is provided
*
IF( NBA.EQ.1 .OR. NBB.EQ.1 ) THEN
IF( MIN( NBA, NBB ).EQ.1 .OR. LDSWORK.LT.MAX( NBA, NBB ) ) THEN
CALL ZTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
$ C, LDC, SCALE, INFO )
RETURN
Expand Down
2 changes: 1 addition & 1 deletion TESTING/EIG/csyl01.f
Original file line number Diff line number Diff line change
Expand Up @@ -122,7 +122,7 @@ SUBROUTINE CSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
* .. Local Arrays ..
COMPLEX A( MAXM, MAXM ), B( MAXN, MAXN ),
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
$ WA( MAXM ), WB( MAXN ), X( MAXM, MAXN ),
$ X( MAXM, MAXN ),
$ DUML( MAXM ), DUMR( MAXN ),
$ D( MIN( MAXM, MAXN ) )
REAL SWORK( LDSWORK, 54 ), DUM( MAXN ), VM( 2 )
Expand Down
2 changes: 1 addition & 1 deletion TESTING/EIG/zsyl01.f
Original file line number Diff line number Diff line change
Expand Up @@ -122,7 +122,7 @@ SUBROUTINE ZSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
* .. Local Arrays ..
COMPLEX*16 A( MAXM, MAXM ), B( MAXN, MAXN ),
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
$ WA( MAXM ), WB( MAXN ), X( MAXM, MAXN ),
$ X( MAXM, MAXN ),
$ DUML( MAXM ), DUMR( MAXN ),
$ D( MIN( MAXM, MAXN ) )
DOUBLE PRECISION SWORK( LDSWORK, 103 ), DUM( MAXN ), VM( 2 )
Expand Down

0 comments on commit f933da7

Please sign in to comment.