Skip to content

Commit 1c1263e

Browse files
angschangsch
committed
Use unblocked code if insufficient workspace is provided
1 parent 8f44109 commit 1c1263e

File tree

6 files changed

+26
-24
lines changed

6 files changed

+26
-24
lines changed

‎SRC/ctrsyl3.f

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -184,14 +184,14 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
184184
* .. External Functions ..
185185
LOGICAL LSAME
186186
INTEGER ILAENV
187-
REAL SLAMCH, SLARMM, CLANGE
188-
EXTERNAL SLAMCH, SLARMM, ILAENV, LSAME, CLANGE
187+
REAL CLANGE, SLAMCH, SLARMM
188+
EXTERNAL CLANGE, ILAENV, LSAME, SLAMCH, SLARMM
189189
* ..
190190
* .. External Subroutines ..
191-
EXTERNAL XERBLA, CSSCAL, CGEMM, CLASCL, CTRSYL
191+
EXTERNAL CSSCAL, CGEMM, CLASCL, CTRSYL, XERBLA
192192
* ..
193193
* .. Intrinsic Functions ..
194-
INTRINSIC ABS, EXPONENT, REAL, AIMAG, MAX, MIN
194+
INTRINSIC ABS, AIMAG, EXPONENT, MAX, MIN, REAL
195195
* ..
196196
* .. Executable Statements ..
197197
*
@@ -237,8 +237,6 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
237237
INFO = -9
238238
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
239239
INFO = -11
240-
ELSE IF( .NOT.LQUERY .AND. LDSWORK.LT.MAX( NBA, NBB ) ) THEN
241-
INFO = -16
242240
END IF
243241
IF( INFO.NE.0 ) THEN
244242
CALL XERBLA( 'CTRSYL3', -INFO )
@@ -249,12 +247,14 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
249247
*
250248
* Quick return if possible
251249
*
250+
SCALE = ONE
252251
IF( M.EQ.0 .OR. N.EQ.0 )
253252
$ RETURN
254253
*
255-
* Use unblocked code for small problems
254+
* Use unblocked code for small problems or if insufficient
255+
* workspace is provided
256256
*
257-
IF( NBA.EQ.1 .OR. NBB.EQ.1 ) THEN
257+
IF( MIN( NBA, NBB ).EQ.1 .OR. LDSWORK.LT.MAX( NBA, NBB ) ) THEN
258258
CALL CTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
259259
$ C, LDC, SCALE, INFO )
260260
RETURN

‎SRC/dtrsyl3.f

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -215,7 +215,7 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
215215
EXTERNAL DGEMM, DLASCL, DSCAL, DTRSYL, XERBLA
216216
* ..
217217
* .. Intrinsic Functions ..
218-
INTRINSIC ABS, EXPONENT, DBLE, MAX, MIN
218+
INTRINSIC ABS, DBLE, EXPONENT, MAX, MIN
219219
* ..
220220
* .. Executable Statements ..
221221
*
@@ -264,10 +264,6 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
264264
INFO = -9
265265
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
266266
INFO = -11
267-
ELSE IF( .NOT.LQUERY .AND. LIWORK.LT.IWORK(1) ) THEN
268-
INFO = -14
269-
ELSE IF( .NOT.LQUERY .AND. LDSWORK.LT.MAX( NBA, NBB ) ) THEN
270-
INFO = -16
271267
END IF
272268
IF( INFO.NE.0 ) THEN
273269
CALL XERBLA( 'DTRSYL3', -INFO )
@@ -278,12 +274,15 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
278274
*
279275
* Quick return if possible
280276
*
277+
SCALE = ONE
281278
IF( M.EQ.0 .OR. N.EQ.0 )
282279
$ RETURN
283280
*
284-
* Use unblocked code for small problems
281+
* Use unblocked code for small problems or if insufficient
282+
* workspaces are provided
285283
*
286-
IF( NBA.EQ.1 .OR. NBB.EQ.1 ) THEN
284+
IF( MIN( NBA, NBB ).EQ.1 .OR. LDSWORK.LT.MAX( NBA, NBB ) .OR.
285+
$ LIWORK.LT.IWORK(1) ) THEN
287286
CALL DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
288287
$ C, LDC, SCALE, INFO )
289288
RETURN

‎SRC/strsyl3.f

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -278,12 +278,15 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
278278
*
279279
* Quick return if possible
280280
*
281+
SCALE = ONE
281282
IF( M.EQ.0 .OR. N.EQ.0 )
282283
$ RETURN
283284
*
284-
* Use unblocked code for small problems
285+
* Use unblocked code for small problems or if insufficient
286+
* workspaces are provided
285287
*
286-
IF( NBA.EQ.1 .OR. NBB.EQ.1 ) THEN
288+
IF( MIN( NBA, NBB ).EQ.1 .OR. LDSWORK.LT.MAX( NBA, NBB ) .OR.
289+
$ LIWORK.LT.IWORK(1) ) THEN
287290
CALL STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
288291
$ C, LDC, SCALE, INFO )
289292
RETURN

‎SRC/ztrsyl3.f

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -192,7 +192,7 @@ SUBROUTINE ZTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
192192
EXTERNAL XERBLA, ZDSCAL, ZGEMM, ZLASCL, ZTRSYL
193193
* ..
194194
* .. Intrinsic Functions ..
195-
INTRINSIC ABS, EXPONENT, DBLE, DIMAG, MAX, MIN
195+
INTRINSIC ABS, DBLE, DIMAG, EXPONENT, MAX, MIN
196196
* ..
197197
* .. Executable Statements ..
198198
*
@@ -238,8 +238,6 @@ SUBROUTINE ZTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
238238
INFO = -9
239239
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
240240
INFO = -11
241-
ELSE IF( .NOT.LQUERY .AND. LDSWORK.LT.MAX( NBA, NBB ) ) THEN
242-
INFO = -16
243241
END IF
244242
IF( INFO.NE.0 ) THEN
245243
CALL XERBLA( 'ZTRSYL3', -INFO )
@@ -250,12 +248,14 @@ SUBROUTINE ZTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
250248
*
251249
* Quick return if possible
252250
*
251+
SCALE = ONE
253252
IF( M.EQ.0 .OR. N.EQ.0 )
254253
$ RETURN
255254
*
256-
* Use unblocked code for small problems
255+
* Use unblocked code for small problems or if insufficient
256+
* workspace is provided
257257
*
258-
IF( NBA.EQ.1 .OR. NBB.EQ.1 ) THEN
258+
IF( MIN( NBA, NBB ).EQ.1 .OR. LDSWORK.LT.MAX( NBA, NBB ) ) THEN
259259
CALL ZTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
260260
$ C, LDC, SCALE, INFO )
261261
RETURN

‎TESTING/EIG/csyl01.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -122,7 +122,7 @@ SUBROUTINE CSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
122122
* .. Local Arrays ..
123123
COMPLEX A( MAXM, MAXM ), B( MAXN, MAXN ),
124124
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
125-
$ WA( MAXM ), WB( MAXN ), X( MAXM, MAXN ),
125+
$ X( MAXM, MAXN ),
126126
$ DUML( MAXM ), DUMR( MAXN ),
127127
$ D( MIN( MAXM, MAXN ) )
128128
REAL SWORK( LDSWORK, 54 ), DUM( MAXN ), VM( 2 )

‎TESTING/EIG/zsyl01.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -122,7 +122,7 @@ SUBROUTINE ZSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
122122
* .. Local Arrays ..
123123
COMPLEX*16 A( MAXM, MAXM ), B( MAXN, MAXN ),
124124
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
125-
$ WA( MAXM ), WB( MAXN ), X( MAXM, MAXN ),
125+
$ X( MAXM, MAXN ),
126126
$ DUML( MAXM ), DUMR( MAXN ),
127127
$ D( MIN( MAXM, MAXN ) )
128128
DOUBLE PRECISION SWORK( LDSWORK, 103 ), DUM( MAXN ), VM( 2 )

0 commit comments

Comments
 (0)