Use unblocked code if insufficient workspace is provided

Author: angsch

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

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

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

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

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 )

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 )