1
SUBROUTINE STRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
4
* $Id: strmm.f 19695 2010-10-29 16:51:02Z d3y133 $
3
* =========== DOCUMENTATION ===========
5
* Online html documentation available at
6
* http://www.netlib.org/lapack/explore-html/
11
* SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
13
* .. Scalar Arguments ..
16
* CHARACTER DIAG,SIDE,TRANSA,UPLO
18
* .. Array Arguments ..
19
* REAL A(LDA,*),B(LDB,*)
28
*> STRMM performs one of the matrix-matrix operations
30
*> B := alpha*op( A )*B, or B := alpha*B*op( A ),
32
*> where alpha is a scalar, B is an m by n matrix, A is a unit, or
33
*> non-unit, upper or lower triangular matrix and op( A ) is one of
35
*> op( A ) = A or op( A ) = A**T.
43
*> SIDE is CHARACTER*1
44
*> On entry, SIDE specifies whether op( A ) multiplies B from
45
*> the left or right as follows:
47
*> SIDE = 'L' or 'l' B := alpha*op( A )*B.
49
*> SIDE = 'R' or 'r' B := alpha*B*op( A ).
54
*> UPLO is CHARACTER*1
55
*> On entry, UPLO specifies whether the matrix A is an upper or
56
*> lower triangular matrix as follows:
58
*> UPLO = 'U' or 'u' A is an upper triangular matrix.
60
*> UPLO = 'L' or 'l' A is a lower triangular matrix.
65
*> TRANSA is CHARACTER*1
66
*> On entry, TRANSA specifies the form of op( A ) to be used in
67
*> the matrix multiplication as follows:
69
*> TRANSA = 'N' or 'n' op( A ) = A.
71
*> TRANSA = 'T' or 't' op( A ) = A**T.
73
*> TRANSA = 'C' or 'c' op( A ) = A**T.
78
*> DIAG is CHARACTER*1
79
*> On entry, DIAG specifies whether or not A is unit triangular
82
*> DIAG = 'U' or 'u' A is assumed to be unit triangular.
84
*> DIAG = 'N' or 'n' A is not assumed to be unit
91
*> On entry, M specifies the number of rows of B. M must be at
98
*> On entry, N specifies the number of columns of B. N must be
105
*> On entry, ALPHA specifies the scalar alpha. When alpha is
106
*> zero then A is not referenced and B need not be set before
112
*> A is REAL array of DIMENSION ( LDA, k ), where k is m
113
*> when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
114
*> Before entry with UPLO = 'U' or 'u', the leading k by k
115
*> upper triangular part of the array A must contain the upper
116
*> triangular matrix and the strictly lower triangular part of
117
*> A is not referenced.
118
*> Before entry with UPLO = 'L' or 'l', the leading k by k
119
*> lower triangular part of the array A must contain the lower
120
*> triangular matrix and the strictly upper triangular part of
121
*> A is not referenced.
122
*> Note that when DIAG = 'U' or 'u', the diagonal elements of
123
*> A are not referenced either, but are assumed to be unity.
129
*> On entry, LDA specifies the first dimension of A as declared
130
*> in the calling (sub) program. When SIDE = 'L' or 'l' then
131
*> LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
132
*> then LDA must be at least max( 1, n ).
137
*> B is REAL array of DIMENSION ( LDB, n ).
138
*> Before entry, the leading m by n part of the array B must
139
*> contain the matrix B, and on exit is overwritten by the
140
*> transformed matrix.
146
*> On entry, LDB specifies the first dimension of B as declared
147
*> in the calling (sub) program. LDB must be at least
154
*> \author Univ. of Tennessee
155
*> \author Univ. of California Berkeley
156
*> \author Univ. of Colorado Denver
159
*> \date November 2011
161
*> \ingroup single_blas_level3
163
*> \par Further Details:
164
* =====================
168
*> Level 3 Blas routine.
170
*> -- Written on 8-February-1989.
171
*> Jack Dongarra, Argonne National Laboratory.
172
*> Iain Duff, AERE Harwell.
173
*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
174
*> Sven Hammarling, Numerical Algorithms Group Ltd.
177
* =====================================================================
178
SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
180
* -- Reference BLAS level3 routine (version 3.4.0) --
181
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
182
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6
185
* .. Scalar Arguments ..
7
CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
188
CHARACTER DIAG,SIDE,TRANSA,UPLO
10
190
* .. Array Arguments ..
11
REAL A( LDA, * ), B( LDB, * )
191
REAL A(LDA,*),B(LDB,*)
17
* STRMM performs one of the matrix-matrix operations
19
* B := alpha*op( A )*B, or B := alpha*B*op( A ),
21
* where alpha is a scalar, B is an m by n matrix, A is a unit, or
22
* non-unit, upper or lower triangular matrix and op( A ) is one of
24
* op( A ) = A or op( A ) = A'.
30
* On entry, SIDE specifies whether op( A ) multiplies B from
31
* the left or right as follows:
33
* SIDE = 'L' or 'l' B := alpha*op( A )*B.
35
* SIDE = 'R' or 'r' B := alpha*B*op( A ).
40
* On entry, UPLO specifies whether the matrix A is an upper or
41
* lower triangular matrix as follows:
43
* UPLO = 'U' or 'u' A is an upper triangular matrix.
45
* UPLO = 'L' or 'l' A is a lower triangular matrix.
49
* TRANSA - CHARACTER*1.
50
* On entry, TRANSA specifies the form of op( A ) to be used in
51
* the matrix multiplication as follows:
53
* TRANSA = 'N' or 'n' op( A ) = A.
55
* TRANSA = 'T' or 't' op( A ) = A'.
57
* TRANSA = 'C' or 'c' op( A ) = A'.
62
* On entry, DIAG specifies whether or not A is unit triangular
65
* DIAG = 'U' or 'u' A is assumed to be unit triangular.
67
* DIAG = 'N' or 'n' A is not assumed to be unit
73
* On entry, M specifies the number of rows of B. M must be at
78
* On entry, N specifies the number of columns of B. N must be
83
* On entry, ALPHA specifies the scalar alpha. When alpha is
84
* zero then A is not referenced and B need not be set before
88
* A - REAL array of DIMENSION ( LDA, k ), where k is m
89
* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
90
* Before entry with UPLO = 'U' or 'u', the leading k by k
91
* upper triangular part of the array A must contain the upper
92
* triangular matrix and the strictly lower triangular part of
93
* A is not referenced.
94
* Before entry with UPLO = 'L' or 'l', the leading k by k
95
* lower triangular part of the array A must contain the lower
96
* triangular matrix and the strictly upper triangular part of
97
* A is not referenced.
98
* Note that when DIAG = 'U' or 'u', the diagonal elements of
99
* A are not referenced either, but are assumed to be unity.
103
* On entry, LDA specifies the first dimension of A as declared
104
* in the calling (sub) program. When SIDE = 'L' or 'l' then
105
* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
106
* then LDA must be at least max( 1, n ).
109
* B - REAL array of DIMENSION ( LDB, n ).
110
* Before entry, the leading m by n part of the array B must
111
* contain the matrix B, and on exit is overwritten by the
112
* transformed matrix.
115
* On entry, LDB specifies the first dimension of B as declared
116
* in the calling (sub) program. LDB must be at least
121
* Level 3 Blas routine.
123
* -- Written on 8-February-1989.
124
* Jack Dongarra, Argonne National Laboratory.
125
* Iain Duff, AERE Harwell.
126
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
127
* Sven Hammarling, Numerical Algorithms Group Ltd.
194
* =====================================================================
130
196
* .. External Functions ..
133
200
* .. External Subroutines ..
135
203
* .. Intrinsic Functions ..
137
206
* .. Local Scalars ..
138
LOGICAL LSIDE, NOUNIT, UPPER
139
INTEGER I, INFO, J, K, NROWA
208
INTEGER I,INFO,J,K,NROWA
209
LOGICAL LSIDE,NOUNIT,UPPER
141
211
* .. Parameters ..
143
PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
213
PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
145
* .. Executable Statements ..
147
216
* Test the input parameters.
149
LSIDE = LSAME( SIDE , 'L' )
218
LSIDE = LSAME(SIDE,'L')
155
NOUNIT = LSAME( DIAG , 'N' )
156
UPPER = LSAME( UPLO , 'U' )
224
NOUNIT = LSAME(DIAG,'N')
225
UPPER = LSAME(UPLO,'U')
159
IF( ( .NOT.LSIDE ).AND.
160
$ ( .NOT.LSAME( SIDE , 'R' ) ) )THEN
162
ELSE IF( ( .NOT.UPPER ).AND.
163
$ ( .NOT.LSAME( UPLO , 'L' ) ) )THEN
165
ELSE IF( ( .NOT.LSAME( TRANSA, 'N' ) ).AND.
166
$ ( .NOT.LSAME( TRANSA, 'T' ) ).AND.
167
$ ( .NOT.LSAME( TRANSA, 'C' ) ) )THEN
169
ELSE IF( ( .NOT.LSAME( DIAG , 'U' ) ).AND.
170
$ ( .NOT.LSAME( DIAG , 'N' ) ) )THEN
172
ELSE IF( M .LT.0 )THEN
174
ELSE IF( N .LT.0 )THEN
176
ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
178
ELSE IF( LDB.LT.MAX( 1, M ) )THEN
228
IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
230
ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
232
ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
233
+ (.NOT.LSAME(TRANSA,'T')) .AND.
234
+ (.NOT.LSAME(TRANSA,'C'))) THEN
236
ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
238
ELSE IF (M.LT.0) THEN
240
ELSE IF (N.LT.0) THEN
242
ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
244
ELSE IF (LDB.LT.MAX(1,M)) THEN
182
CALL XERBLA( 'STRMM ', INFO )
248
CALL XERBLA('STRMM ',INFO)
186
252
* Quick return if possible.
254
IF (M.EQ.0 .OR. N.EQ.0) RETURN
191
256
* And when alpha.eq.zero.
193
IF( ALPHA.EQ.ZERO )THEN
258
IF (ALPHA.EQ.ZERO) THEN
202
267
* Start the operations.
205
IF( LSAME( TRANSA, 'N' ) )THEN
270
IF (LSAME(TRANSA,'N')) THEN
207
272
* Form B := alpha*A*B.
212
IF( B( K, J ).NE.ZERO )THEN
213
TEMP = ALPHA*B( K, J )
215
B( I, J ) = B( I, J ) + TEMP*A( I, K )
218
$ TEMP = TEMP*A( K, K )
226
IF( B( K, J ).NE.ZERO )THEN
227
TEMP = ALPHA*B( K, J )
230
$ B( K, J ) = B( K, J )*A( K, K )
232
B( I, J ) = B( I, J ) + TEMP*A( I, K )
240
* Form B := alpha*B*A'.
247
$ TEMP = TEMP*A( I, I )
249
TEMP = TEMP + A( K, I )*B( K, J )
251
B( I, J ) = ALPHA*TEMP
259
$ TEMP = TEMP*A( I, I )
261
TEMP = TEMP + A( K, I )*B( K, J )
263
B( I, J ) = ALPHA*TEMP
277
IF (B(K,J).NE.ZERO) THEN
280
B(I,J) = B(I,J) + TEMP*A(I,K)
282
IF (NOUNIT) TEMP = TEMP*A(K,K)
290
IF (B(K,J).NE.ZERO) THEN
293
IF (NOUNIT) B(K,J) = B(K,J)*A(K,K)
295
B(I,J) = B(I,J) + TEMP*A(I,K)
303
* Form B := alpha*A**T*B.
309
IF (NOUNIT) TEMP = TEMP*A(I,I)
311
TEMP = TEMP + A(K,I)*B(K,J)
320
IF (NOUNIT) TEMP = TEMP*A(I,I)
322
TEMP = TEMP + A(K,I)*B(K,J)
269
IF( LSAME( TRANSA, 'N' ) )THEN
330
IF (LSAME(TRANSA,'N')) THEN
271
332
* Form B := alpha*B*A.
277
$ TEMP = TEMP*A( J, J )
279
B( I, J ) = TEMP*B( I, J )
282
IF( A( K, J ).NE.ZERO )THEN
283
TEMP = ALPHA*A( K, J )
285
B( I, J ) = B( I, J ) + TEMP*B( I, K )
294
$ TEMP = TEMP*A( J, J )
296
B( I, J ) = TEMP*B( I, J )
299
IF( A( K, J ).NE.ZERO )THEN
300
TEMP = ALPHA*A( K, J )
302
B( I, J ) = B( I, J ) + TEMP*B( I, K )
310
* Form B := alpha*B*A'.
315
IF( A( J, K ).NE.ZERO )THEN
316
TEMP = ALPHA*A( J, K )
318
B( I, J ) = B( I, J ) + TEMP*B( I, K )
324
$ TEMP = TEMP*A( K, K )
325
IF( TEMP.NE.ONE )THEN
327
B( I, K ) = TEMP*B( I, K )
334
IF( A( J, K ).NE.ZERO )THEN
335
TEMP = ALPHA*A( J, K )
337
B( I, J ) = B( I, J ) + TEMP*B( I, K )
343
$ TEMP = TEMP*A( K, K )
344
IF( TEMP.NE.ONE )THEN
346
B( I, K ) = TEMP*B( I, K )
337
IF (NOUNIT) TEMP = TEMP*A(J,J)
342
IF (A(K,J).NE.ZERO) THEN
345
B(I,J) = B(I,J) + TEMP*B(I,K)
353
IF (NOUNIT) TEMP = TEMP*A(J,J)
358
IF (A(K,J).NE.ZERO) THEN
361
B(I,J) = B(I,J) + TEMP*B(I,K)
369
* Form B := alpha*B*A**T.
374
IF (A(J,K).NE.ZERO) THEN
377
B(I,J) = B(I,J) + TEMP*B(I,K)
382
IF (NOUNIT) TEMP = TEMP*A(K,K)
383
IF (TEMP.NE.ONE) THEN
392
IF (A(J,K).NE.ZERO) THEN
395
B(I,J) = B(I,J) + TEMP*B(I,K)
400
IF (NOUNIT) TEMP = TEMP*A(K,K)
401
IF (TEMP.NE.ONE) THEN