diff --git a/SRC/ctrsyl3.f b/SRC/ctrsyl3.f index b7a7355885..586dc0207f 100644 --- a/SRC/ctrsyl3.f +++ b/SRC/ctrsyl3.f @@ -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 .. * @@ -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 ) @@ -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 diff --git a/SRC/dtrsyl3.f b/SRC/dtrsyl3.f index dd5f2f48f5..c44ec38087 100644 --- a/SRC/dtrsyl3.f +++ b/SRC/dtrsyl3.f @@ -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 .. * @@ -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 ) @@ -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 diff --git a/SRC/strsyl3.f b/SRC/strsyl3.f index 8f9766837a..28762c2ed1 100644 --- a/SRC/strsyl3.f +++ b/SRC/strsyl3.f @@ -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 diff --git a/SRC/ztrsyl3.f b/SRC/ztrsyl3.f index c344e5303a..b5a058da4e 100644 --- a/SRC/ztrsyl3.f +++ b/SRC/ztrsyl3.f @@ -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 .. * @@ -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 ) @@ -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 diff --git a/TESTING/EIG/csyl01.f b/TESTING/EIG/csyl01.f index a3395428c0..e21f1a7a03 100644 --- a/TESTING/EIG/csyl01.f +++ b/TESTING/EIG/csyl01.f @@ -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 ) diff --git a/TESTING/EIG/zsyl01.f b/TESTING/EIG/zsyl01.f index 03a32f8fc8..1e8619a34c 100644 --- a/TESTING/EIG/zsyl01.f +++ b/TESTING/EIG/zsyl01.f @@ -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 )