Skip to content

Commit 429d23f

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #5730 from martin-frbg/lapack1206
Fix overwriting of LDSWORK in ?TRSYL3 (Reference-LAPACK PR 1206)
2 parents 3f2338b + 6e89813 commit 429d23f

4 files changed

Lines changed: 131 additions & 62 deletions

File tree

‎lapack-netlib/SRC/ctrsyl3.f‎

Lines changed: 31 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,23 @@
11
*> \brief \b CTRSYL3
22
*
3-
* Definition:
4-
* ===========
3+
* Definition:
4+
* ===========
55
*
6+
* SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
7+
* C, LDC, SCALE, SWORK, LDSWORK, INFO )
68
*
7-
*> \par Purpose
9+
* .. Scalar Arguments ..
10+
* CHARACTER TRANA, TRANB
11+
* INTEGER INFO, ISGN, LDA, LDB, LDC, LDSWORK, M, N
12+
* REAL SCALE
13+
* ..
14+
* .. Array Arguments ..
15+
* COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * )
16+
* REAL SWORK( LDSWORK, * )
17+
* ..
18+
*
19+
*
20+
*> \par Purpose:
821
* =============
922
*>
1023
*> \verbatim
@@ -22,8 +35,8 @@
2235
*> This is the block version of the algorithm.
2336
*> \endverbatim
2437
*
25-
* Arguments
26-
* =========
38+
* Arguments:
39+
* ==========
2740
*
2841
*> \param[in] TRANA
2942
*> \verbatim
@@ -135,7 +148,7 @@
135148
*> A and B are unchanged).
136149
*> \endverbatim
137150
*
138-
*> \ingroup complexSYcomputational
151+
*> \ingroup trsyl3
139152
*
140153
* =====================================================================
141154
* References:
@@ -151,8 +164,8 @@
151164
* Angelika Schwarz, Umea University, Sweden.
152165
*
153166
* =====================================================================
154-
SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
155-
$ LDC, SCALE, SWORK, LDSWORK, INFO )
167+
SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
168+
$ C, LDC, SCALE, SWORK, LDSWORK, INFO )
156169
IMPLICIT NONE
157170
*
158171
* .. Scalar Arguments ..
@@ -185,10 +198,12 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
185198
LOGICAL LSAME
186199
INTEGER ILAENV
187200
REAL CLANGE, SLAMCH, SLARMM
188-
EXTERNAL CLANGE, ILAENV, LSAME, SLAMCH, SLARMM
201+
EXTERNAL CLANGE, ILAENV, LSAME, SLAMCH,
202+
$ SLARMM
189203
* ..
190204
* .. External Subroutines ..
191-
EXTERNAL CSSCAL, CGEMM, CLASCL, CTRSYL, XERBLA
205+
EXTERNAL CSSCAL, CGEMM, CLASCL, CTRSYL,
206+
$ XERBLA
192207
* ..
193208
* .. Intrinsic Functions ..
194209
INTRINSIC ABS, AIMAG, EXPONENT, MAX, MIN, REAL
@@ -214,9 +229,8 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
214229
INFO = 0
215230
LQUERY = ( LDSWORK.EQ.-1 )
216231
IF( LQUERY ) THEN
217-
LDSWORK = 2
218-
SWORK(1,1) = MAX( NBA, NBB )
219-
SWORK(2,1) = 2 * NBB + NBA
232+
SWORK(1,1) = REAL( MAX( NBA, NBB ) )
233+
SWORK(2,1) = REAL( 2 * NBB + NBA )
220234
END IF
221235
*
222236
* Test the input arguments
@@ -1068,8 +1082,8 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
10681082
* form (1/SCALE)*X if SCALE is REAL. Set SCALE to
10691083
* zero and give up.
10701084
*
1071-
SWORK(1,1) = MAX( NBA, NBB )
1072-
SWORK(2,1) = 2 * NBB + NBA
1085+
SWORK(1,1) = REAL( MAX( NBA, NBB ) )
1086+
SWORK(2,1) = REAL( 2 * NBB + NBA )
10731087
RETURN
10741088
END IF
10751089
*
@@ -1132,8 +1146,8 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
11321146
*
11331147
* Restore workspace dimensions
11341148
*
1135-
SWORK(1,1) = MAX( NBA, NBB )
1136-
SWORK(2,1) = 2 * NBB + NBA
1149+
SWORK(1,1) = REAL( MAX( NBA, NBB ) )
1150+
SWORK(2,1) = REAL( 2 * NBB + NBA )
11371151
*
11381152
RETURN
11391153
*

‎lapack-netlib/SRC/dtrsyl3.f‎

Lines changed: 35 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,27 @@
11
*> \brief \b DTRSYL3
22
*
3-
* Definition:
4-
* ===========
5-
*
6-
*
7-
*> \par Purpose
3+
* Definition:
4+
* ===========
5+
*
6+
* SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
7+
* C,
8+
* LDC, SCALE, IWORK, LIWORK, SWORK, LDSWORK,
9+
* INFO )
10+
*
11+
* .. Scalar Arguments ..
12+
* CHARACTER TRANA, TRANB
13+
* INTEGER INFO, ISGN, LDA, LDB, LDC, M, N,
14+
* LIWORK, LDSWORK
15+
* DOUBLE PRECISION SCALE
16+
* ..
17+
* .. Array Arguments ..
18+
* INTEGER IWORK( * )
19+
* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
20+
* SWORK( LDSWORK, * )
21+
* ..
22+
*
23+
*
24+
*> \par Purpose:
825
* =============
926
*>
1027
*> \verbatim
@@ -27,8 +44,8 @@
2744
*> This is the block version of the algorithm.
2845
*> \endverbatim
2946
*
30-
* Arguments
31-
* =========
47+
* Arguments:
48+
* ==========
3249
*
3350
*> \param[in] TRANA
3451
*> \verbatim
@@ -161,6 +178,8 @@
161178
*> A and B are unchanged).
162179
*> \endverbatim
163180
*
181+
*> \ingroup trsyl3
182+
*
164183
* =====================================================================
165184
* References:
166185
* E. S. Quintana-Orti and R. A. Van De Geijn (2003). Formal derivation of
@@ -175,9 +194,9 @@
175194
* Angelika Schwarz, Umea University, Sweden.
176195
*
177196
* =====================================================================
178-
SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
179-
$ LDC, SCALE, IWORK, LIWORK, SWORK, LDSWORK,
180-
$ INFO )
197+
SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
198+
$ C, LDC, SCALE, IWORK, LIWORK, SWORK,
199+
$ LDSWORK, INFO )
181200
IMPLICIT NONE
182201
*
183202
* .. Scalar Arguments ..
@@ -209,10 +228,12 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
209228
LOGICAL LSAME
210229
INTEGER ILAENV
211230
DOUBLE PRECISION DLANGE, DLAMCH, DLARMM
212-
EXTERNAL DLANGE, DLAMCH, DLARMM, ILAENV, LSAME
231+
EXTERNAL DLANGE, DLAMCH, DLARMM, ILAENV,
232+
$ LSAME
213233
* ..
214234
* .. External Subroutines ..
215-
EXTERNAL DGEMM, DLASCL, DSCAL, DTRSYL, XERBLA
235+
EXTERNAL DGEMM, DLASCL, DSCAL, DTRSYL,
236+
$ XERBLA
216237
* ..
217238
* .. Intrinsic Functions ..
218239
INTRINSIC ABS, DBLE, EXPONENT, MAX, MIN
@@ -239,7 +260,6 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
239260
LQUERY = ( LIWORK.EQ.-1 .OR. LDSWORK.EQ.-1 )
240261
IWORK( 1 ) = NBA + NBB + 2
241262
IF( LQUERY ) THEN
242-
LDSWORK = 2
243263
SWORK( 1, 1 ) = MAX( NBA, NBB )
244264
SWORK( 2, 1 ) = 2 * NBB + NBA
245265
END IF
@@ -1220,7 +1240,8 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
12201240
*
12211241
SCALOC = MIN( BIGNUM / SCAL, ONE / BUF )
12221242
BUF = BUF * SCALOC
1223-
CALL DLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, IWORK(1) )
1243+
CALL DLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC,
1244+
$ IWORK(1) )
12241245
END IF
12251246
*
12261247
* Combine with buffer scaling factor. SCALE will be flushed if

‎lapack-netlib/SRC/strsyl3.f‎

Lines changed: 40 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,26 @@
11
*> \brief \b STRSYL3
22
*
3-
* Definition:
4-
* ===========
5-
*
6-
*
7-
*> \par Purpose
3+
* Definition:
4+
* ===========
5+
*
6+
* SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
7+
* C, LDC, SCALE, IWORK, LIWORK, SWORK,
8+
* LDSWORK, INFO )
9+
*
10+
* .. Scalar Arguments ..
11+
* CHARACTER TRANA, TRANB
12+
* INTEGER INFO, ISGN, LDA, LDB, LDC, M, N,
13+
* LIWORK, LDSWORK
14+
* REAL SCALE
15+
* ..
16+
* .. Array Arguments ..
17+
* INTEGER IWORK( * )
18+
* REAL A( LDA, * ), B( LDB, * ), C( LDC, * ),
19+
* SWORK( LDSWORK, * )
20+
* ..
21+
*
22+
*
23+
*> \par Purpose:
824
* =============
925
*>
1026
*> \verbatim
@@ -27,8 +43,8 @@
2743
*> This is the block version of the algorithm.
2844
*> \endverbatim
2945
*
30-
* Arguments
31-
* =========
46+
* Arguments:
47+
* ==========
3248
*
3349
*> \param[in] TRANA
3450
*> \verbatim
@@ -161,6 +177,8 @@
161177
*> A and B are unchanged).
162178
*> \endverbatim
163179
*
180+
*> \ingroup trsyl3
181+
*
164182
* =====================================================================
165183
* References:
166184
* E. S. Quintana-Orti and R. A. Van De Geijn (2003). Formal derivation of
@@ -175,9 +193,9 @@
175193
* Angelika Schwarz, Umea University, Sweden.
176194
*
177195
* =====================================================================
178-
SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
179-
$ LDC, SCALE, IWORK, LIWORK, SWORK, LDSWORK,
180-
$ INFO )
196+
SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB,
197+
$ C, LDC, SCALE, IWORK, LIWORK, SWORK,
198+
$ LDSWORK, INFO )
181199
IMPLICIT NONE
182200
*
183201
* .. Scalar Arguments ..
@@ -209,10 +227,12 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
209227
LOGICAL LSAME
210228
INTEGER ILAENV
211229
REAL SLANGE, SLAMCH, SLARMM
212-
EXTERNAL SLANGE, SLAMCH, SLARMM, ILAENV, LSAME
230+
EXTERNAL SLANGE, SLAMCH, SLARMM, ILAENV,
231+
$ LSAME
213232
* ..
214233
* .. External Subroutines ..
215-
EXTERNAL SGEMM, SLASCL, SSCAL, STRSYL, XERBLA
234+
EXTERNAL SGEMM, SLASCL, SSCAL, STRSYL,
235+
$ XERBLA
216236
* ..
217237
* .. Intrinsic Functions ..
218238
INTRINSIC ABS, EXPONENT, MAX, MIN, REAL
@@ -239,9 +259,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
239259
LQUERY = ( LIWORK.EQ.-1 .OR. LDSWORK.EQ.-1 )
240260
IWORK( 1 ) = NBA + NBB + 2
241261
IF( LQUERY ) THEN
242-
LDSWORK = 2
243-
SWORK( 1, 1 ) = MAX( NBA, NBB )
244-
SWORK( 2, 1 ) = 2 * NBB + NBA
262+
SWORK( 1, 1 ) = REAL( MAX( NBA, NBB ) )
263+
SWORK( 2, 1 ) = REAL( 2 * NBB + NBA )
245264
END IF
246265
*
247266
* Test the input arguments
@@ -1171,8 +1190,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
11711190
* form (1/SCALE)*X if SCALE is REAL. Set SCALE to zero and give up.
11721191
*
11731192
IWORK(1) = NBA + NBB + 2
1174-
SWORK(1,1) = MAX( NBA, NBB )
1175-
SWORK(2,1) = 2 * NBB + NBA
1193+
SWORK(1,1) = REAL( MAX( NBA, NBB ) )
1194+
SWORK(2,1) = REAL( 2 * NBB + NBA )
11761195
RETURN
11771196
END IF
11781197
*
@@ -1223,7 +1242,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
12231242
*
12241243
SCALOC = MIN( BIGNUM / SCAL, ONE / BUF )
12251244
BUF = BUF * SCALOC
1226-
CALL SLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, IWORK(1) )
1245+
CALL SLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC,
1246+
$ IWORK(1) )
12271247
END IF
12281248
*
12291249
* Combine with buffer scaling factor. SCALE will be flushed if
@@ -1234,8 +1254,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
12341254
* Restore workspace dimensions
12351255
*
12361256
IWORK(1) = NBA + NBB + 2
1237-
SWORK(1,1) = MAX( NBA, NBB )
1238-
SWORK(2,1) = 2 * NBB + NBA
1257+
SWORK(1,1) = REAL( MAX( NBA, NBB ) )
1258+
SWORK(2,1) = REAL( 2 * NBB + NBA )
12391259
*
12401260
RETURN
12411261
*

0 commit comments

Comments
 (0)