Skip to content

Fix overwriting of LDSWORK in ?TRSYL3 (Reference-LAPACK PR 1206) #5730

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

Merged
martin-frbg merged 1 commit into from
Mar 31, 2026
+131 −62
Merged

Fix overwriting of LDSWORK in ?TRSYL3 (Reference-LAPACK PR 1206) #5730

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
48 changes: 31 additions & 17 deletions lapack-netlib/SRC/ctrsyl3.f
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,10 +1,23 @@
*> \brief \b CTRSYL3
*
* Definition:
* ===========
* Definition:
* ===========
*
* SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
* C, LDC, SCALE, SWORK, LDSWORK, INFO )
*
*> \par Purpose
* .. Scalar Arguments ..
* CHARACTER TRANA, TRANB
* INTEGER INFO, ISGN, LDA, LDB, LDC, LDSWORK, M, N
* REAL SCALE
* ..
* .. Array Arguments ..
* COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * )
* REAL SWORK( LDSWORK, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
Expand All @@ -22,8 +35,8 @@
*> This is the block version of the algorithm.
*> \endverbatim
*
* Arguments
* =========
* Arguments:
* ==========
*
*> \param[in] TRANA
*> \verbatim
Expand Down Expand Up @@ -135,7 +148,7 @@
*> A and B are unchanged).
*> \endverbatim
*
*> \ingroup complexSYcomputational
*> \ingroup trsyl3
*
* =====================================================================
* References:
Expand All @@ -151,8 +164,8 @@
* Angelika Schwarz, Umea University, Sweden.
*
* =====================================================================
SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
$ LDC, SCALE, SWORK, LDSWORK, INFO )
SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
$ C, LDC, SCALE, SWORK, LDSWORK, INFO )
IMPLICIT NONE
*
* .. Scalar Arguments ..
Expand Down Expand Up @@ -185,10 +198,12 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
LOGICAL LSAME
INTEGER ILAENV
REAL CLANGE, SLAMCH, SLARMM
EXTERNAL CLANGE, ILAENV, LSAME, SLAMCH, SLARMM
EXTERNAL CLANGE, ILAENV, LSAME, SLAMCH,
$ SLARMM
* ..
* .. External Subroutines ..
EXTERNAL CSSCAL, CGEMM, CLASCL, CTRSYL, XERBLA
EXTERNAL CSSCAL, CGEMM, CLASCL, CTRSYL,
$ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, AIMAG, EXPONENT, MAX, MIN, REAL
Expand All @@ -214,9 +229,8 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
INFO = 0
LQUERY = ( LDSWORK.EQ.-1 )
IF( LQUERY ) THEN
LDSWORK = 2
SWORK(1,1) = MAX( NBA, NBB )
SWORK(2,1) = 2 * NBB + NBA
SWORK(1,1) = REAL( MAX( NBA, NBB ) )
SWORK(2,1) = REAL( 2 * NBB + NBA )
END IF
*
* Test the input arguments
Expand Down Expand Up @@ -1068,8 +1082,8 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
* form (1/SCALE)*X if SCALE is REAL. Set SCALE to
* zero and give up.
*
SWORK(1,1) = MAX( NBA, NBB )
SWORK(2,1) = 2 * NBB + NBA
SWORK(1,1) = REAL( MAX( NBA, NBB ) )
SWORK(2,1) = REAL( 2 * NBB + NBA )
RETURN
END IF
*
Expand Down Expand Up @@ -1132,8 +1146,8 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
*
* Restore workspace dimensions
*
SWORK(1,1) = MAX( NBA, NBB )
SWORK(2,1) = 2 * NBB + NBA
SWORK(1,1) = REAL( MAX( NBA, NBB ) )
SWORK(2,1) = REAL( 2 * NBB + NBA )
*
RETURN
*
Expand Down
49 changes: 35 additions & 14 deletions lapack-netlib/SRC/dtrsyl3.f
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,10 +1,27 @@
*> \brief \b DTRSYL3
*
* Definition:
* ===========
*
*
*> \par Purpose
* Definition:
* ===========
*
* SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
* C,
* LDC, SCALE, IWORK, LIWORK, SWORK, LDSWORK,
* INFO )
*
* .. Scalar Arguments ..
* CHARACTER TRANA, TRANB
* INTEGER INFO, ISGN, LDA, LDB, LDC, M, N,
* LIWORK, LDSWORK
* DOUBLE PRECISION SCALE
* ..
* .. Array Arguments ..
* INTEGER IWORK( * )
* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
* SWORK( LDSWORK, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
Expand All @@ -27,8 +44,8 @@
*> This is the block version of the algorithm.
*> \endverbatim
*
* Arguments
* =========
* Arguments:
* ==========
*
*> \param[in] TRANA
*> \verbatim
Expand Down Expand Up @@ -161,6 +178,8 @@
*> A and B are unchanged).
*> \endverbatim
*
*> \ingroup trsyl3
*
* =====================================================================
* References:
* E. S. Quintana-Orti and R. A. Van De Geijn (2003). Formal derivation of
Expand All @@ -175,9 +194,9 @@
* Angelika Schwarz, Umea University, Sweden.
*
* =====================================================================
SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
$ LDC, SCALE, IWORK, LIWORK, SWORK, LDSWORK,
$ INFO )
SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
$ C, LDC, SCALE, IWORK, LIWORK, SWORK,
$ LDSWORK, INFO )
IMPLICIT NONE
*
* .. Scalar Arguments ..
Expand Down Expand Up @@ -209,10 +228,12 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
LOGICAL LSAME
INTEGER ILAENV
DOUBLE PRECISION DLANGE, DLAMCH, DLARMM
EXTERNAL DLANGE, DLAMCH, DLARMM, ILAENV, LSAME
EXTERNAL DLANGE, DLAMCH, DLARMM, ILAENV,
$ LSAME
* ..
* .. External Subroutines ..
EXTERNAL DGEMM, DLASCL, DSCAL, DTRSYL, XERBLA
EXTERNAL DGEMM, DLASCL, DSCAL, DTRSYL,
$ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, EXPONENT, MAX, MIN
Expand All @@ -239,7 +260,6 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
LQUERY = ( LIWORK.EQ.-1 .OR. LDSWORK.EQ.-1 )
IWORK( 1 ) = NBA + NBB + 2
IF( LQUERY ) THEN
LDSWORK = 2
SWORK( 1, 1 ) = MAX( NBA, NBB )
SWORK( 2, 1 ) = 2 * NBB + NBA
END IF
Expand Down Expand Up @@ -1220,7 +1240,8 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
*
SCALOC = MIN( BIGNUM / SCAL, ONE / BUF )
BUF = BUF * SCALOC
CALL DLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, IWORK(1) )
CALL DLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC,
$ IWORK(1) )
END IF
*
* Combine with buffer scaling factor. SCALE will be flushed if
Expand Down
60 changes: 40 additions & 20 deletions lapack-netlib/SRC/strsyl3.f
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,10 +1,26 @@
*> \brief \b STRSYL3
*
* Definition:
* ===========
*
*
*> \par Purpose
* Definition:
* ===========
*
* SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
* C, LDC, SCALE, IWORK, LIWORK, SWORK,
* LDSWORK, INFO )
*
* .. Scalar Arguments ..
* CHARACTER TRANA, TRANB
* INTEGER INFO, ISGN, LDA, LDB, LDC, M, N,
* LIWORK, LDSWORK
* REAL SCALE
* ..
* .. Array Arguments ..
* INTEGER IWORK( * )
* REAL A( LDA, * ), B( LDB, * ), C( LDC, * ),
* SWORK( LDSWORK, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
Expand All @@ -27,8 +43,8 @@
*> This is the block version of the algorithm.
*> \endverbatim
*
* Arguments
* =========
* Arguments:
* ==========
*
*> \param[in] TRANA
*> \verbatim
Expand Down Expand Up @@ -161,6 +177,8 @@
*> A and B are unchanged).
*> \endverbatim
*
*> \ingroup trsyl3
*
* =====================================================================
* References:
* E. S. Quintana-Orti and R. A. Van De Geijn (2003). Formal derivation of
Expand All @@ -175,9 +193,9 @@
* Angelika Schwarz, Umea University, Sweden.
*
* =====================================================================
SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
$ LDC, SCALE, IWORK, LIWORK, SWORK, LDSWORK,
$ INFO )
SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
$ C, LDC, SCALE, IWORK, LIWORK, SWORK,
$ LDSWORK, INFO )
IMPLICIT NONE
*
* .. Scalar Arguments ..
Expand Down Expand Up @@ -209,10 +227,12 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
LOGICAL LSAME
INTEGER ILAENV
REAL SLANGE, SLAMCH, SLARMM
EXTERNAL SLANGE, SLAMCH, SLARMM, ILAENV, LSAME
EXTERNAL SLANGE, SLAMCH, SLARMM, ILAENV,
$ LSAME
* ..
* .. External Subroutines ..
EXTERNAL SGEMM, SLASCL, SSCAL, STRSYL, XERBLA
EXTERNAL SGEMM, SLASCL, SSCAL, STRSYL,
$ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, EXPONENT, MAX, MIN, REAL
Expand All @@ -239,9 +259,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
LQUERY = ( LIWORK.EQ.-1 .OR. LDSWORK.EQ.-1 )
IWORK( 1 ) = NBA + NBB + 2
IF( LQUERY ) THEN
LDSWORK = 2
SWORK( 1, 1 ) = MAX( NBA, NBB )
SWORK( 2, 1 ) = 2 * NBB + NBA
SWORK( 1, 1 ) = REAL( MAX( NBA, NBB ) )
SWORK( 2, 1 ) = REAL( 2 * NBB + NBA )
END IF
*
* Test the input arguments
Expand Down Expand Up @@ -1171,8 +1190,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
* form (1/SCALE)*X if SCALE is REAL. Set SCALE to zero and give up.
*
IWORK(1) = NBA + NBB + 2
SWORK(1,1) = MAX( NBA, NBB )
SWORK(2,1) = 2 * NBB + NBA
SWORK(1,1) = REAL( MAX( NBA, NBB ) )
SWORK(2,1) = REAL( 2 * NBB + NBA )
RETURN
END IF
*
Expand Down Expand Up @@ -1223,7 +1242,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
*
SCALOC = MIN( BIGNUM / SCAL, ONE / BUF )
BUF = BUF * SCALOC
CALL SLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, IWORK(1) )
CALL SLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC,
$ IWORK(1) )
END IF
*
* Combine with buffer scaling factor. SCALE will be flushed if
Expand All @@ -1234,8 +1254,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
* Restore workspace dimensions
*
IWORK(1) = NBA + NBB + 2
SWORK(1,1) = MAX( NBA, NBB )
SWORK(2,1) = 2 * NBB + NBA
SWORK(1,1) = REAL( MAX( NBA, NBB ) )
SWORK(2,1) = REAL( 2 * NBB + NBA )
*
RETURN
*
Expand Down
Loading
Loading