![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b STRMM 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) 00012 * 00013 * .. Scalar Arguments .. 00014 * REAL ALPHA 00015 * INTEGER LDA,LDB,M,N 00016 * CHARACTER DIAG,SIDE,TRANSA,UPLO 00017 * .. 00018 * .. Array Arguments .. 00019 * REAL A(LDA,*),B(LDB,*) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> STRMM performs one of the matrix-matrix operations 00029 *> 00030 *> B := alpha*op( A )*B, or B := alpha*B*op( A ), 00031 *> 00032 *> where alpha is a scalar, B is an m by n matrix, A is a unit, or 00033 *> non-unit, upper or lower triangular matrix and op( A ) is one of 00034 *> 00035 *> op( A ) = A or op( A ) = A**T. 00036 *> \endverbatim 00037 * 00038 * Arguments: 00039 * ========== 00040 * 00041 *> \param[in] SIDE 00042 *> \verbatim 00043 *> SIDE is CHARACTER*1 00044 *> On entry, SIDE specifies whether op( A ) multiplies B from 00045 *> the left or right as follows: 00046 *> 00047 *> SIDE = 'L' or 'l' B := alpha*op( A )*B. 00048 *> 00049 *> SIDE = 'R' or 'r' B := alpha*B*op( A ). 00050 *> \endverbatim 00051 *> 00052 *> \param[in] UPLO 00053 *> \verbatim 00054 *> UPLO is CHARACTER*1 00055 *> On entry, UPLO specifies whether the matrix A is an upper or 00056 *> lower triangular matrix as follows: 00057 *> 00058 *> UPLO = 'U' or 'u' A is an upper triangular matrix. 00059 *> 00060 *> UPLO = 'L' or 'l' A is a lower triangular matrix. 00061 *> \endverbatim 00062 *> 00063 *> \param[in] TRANSA 00064 *> \verbatim 00065 *> TRANSA is CHARACTER*1 00066 *> On entry, TRANSA specifies the form of op( A ) to be used in 00067 *> the matrix multiplication as follows: 00068 *> 00069 *> TRANSA = 'N' or 'n' op( A ) = A. 00070 *> 00071 *> TRANSA = 'T' or 't' op( A ) = A**T. 00072 *> 00073 *> TRANSA = 'C' or 'c' op( A ) = A**T. 00074 *> \endverbatim 00075 *> 00076 *> \param[in] DIAG 00077 *> \verbatim 00078 *> DIAG is CHARACTER*1 00079 *> On entry, DIAG specifies whether or not A is unit triangular 00080 *> as follows: 00081 *> 00082 *> DIAG = 'U' or 'u' A is assumed to be unit triangular. 00083 *> 00084 *> DIAG = 'N' or 'n' A is not assumed to be unit 00085 *> triangular. 00086 *> \endverbatim 00087 *> 00088 *> \param[in] M 00089 *> \verbatim 00090 *> M is INTEGER 00091 *> On entry, M specifies the number of rows of B. M must be at 00092 *> least zero. 00093 *> \endverbatim 00094 *> 00095 *> \param[in] N 00096 *> \verbatim 00097 *> N is INTEGER 00098 *> On entry, N specifies the number of columns of B. N must be 00099 *> at least zero. 00100 *> \endverbatim 00101 *> 00102 *> \param[in] ALPHA 00103 *> \verbatim 00104 *> ALPHA is REAL 00105 *> On entry, ALPHA specifies the scalar alpha. When alpha is 00106 *> zero then A is not referenced and B need not be set before 00107 *> entry. 00108 *> \endverbatim 00109 *> 00110 *> \param[in] A 00111 *> \verbatim 00112 *> A is REAL array of DIMENSION ( LDA, k ), where k is m 00113 *> when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. 00114 *> Before entry with UPLO = 'U' or 'u', the leading k by k 00115 *> upper triangular part of the array A must contain the upper 00116 *> triangular matrix and the strictly lower triangular part of 00117 *> A is not referenced. 00118 *> Before entry with UPLO = 'L' or 'l', the leading k by k 00119 *> lower triangular part of the array A must contain the lower 00120 *> triangular matrix and the strictly upper triangular part of 00121 *> A is not referenced. 00122 *> Note that when DIAG = 'U' or 'u', the diagonal elements of 00123 *> A are not referenced either, but are assumed to be unity. 00124 *> \endverbatim 00125 *> 00126 *> \param[in] LDA 00127 *> \verbatim 00128 *> LDA is INTEGER 00129 *> On entry, LDA specifies the first dimension of A as declared 00130 *> in the calling (sub) program. When SIDE = 'L' or 'l' then 00131 *> LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' 00132 *> then LDA must be at least max( 1, n ). 00133 *> \endverbatim 00134 *> 00135 *> \param[in,out] B 00136 *> \verbatim 00137 *> B is REAL array of DIMENSION ( LDB, n ). 00138 *> Before entry, the leading m by n part of the array B must 00139 *> contain the matrix B, and on exit is overwritten by the 00140 *> transformed matrix. 00141 *> \endverbatim 00142 *> 00143 *> \param[in] LDB 00144 *> \verbatim 00145 *> LDB is INTEGER 00146 *> On entry, LDB specifies the first dimension of B as declared 00147 *> in the calling (sub) program. LDB must be at least 00148 *> max( 1, m ). 00149 *> \endverbatim 00150 * 00151 * Authors: 00152 * ======== 00153 * 00154 *> \author Univ. of Tennessee 00155 *> \author Univ. of California Berkeley 00156 *> \author Univ. of Colorado Denver 00157 *> \author NAG Ltd. 00158 * 00159 *> \date November 2011 00160 * 00161 *> \ingroup single_blas_level3 00162 * 00163 *> \par Further Details: 00164 * ===================== 00165 *> 00166 *> \verbatim 00167 *> 00168 *> Level 3 Blas routine. 00169 *> 00170 *> -- Written on 8-February-1989. 00171 *> Jack Dongarra, Argonne National Laboratory. 00172 *> Iain Duff, AERE Harwell. 00173 *> Jeremy Du Croz, Numerical Algorithms Group Ltd. 00174 *> Sven Hammarling, Numerical Algorithms Group Ltd. 00175 *> \endverbatim 00176 *> 00177 * ===================================================================== 00178 SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) 00179 * 00180 * -- Reference BLAS level3 routine (version 3.4.0) -- 00181 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 00182 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00183 * November 2011 00184 * 00185 * .. Scalar Arguments .. 00186 REAL ALPHA 00187 INTEGER LDA,LDB,M,N 00188 CHARACTER DIAG,SIDE,TRANSA,UPLO 00189 * .. 00190 * .. Array Arguments .. 00191 REAL A(LDA,*),B(LDB,*) 00192 * .. 00193 * 00194 * ===================================================================== 00195 * 00196 * .. External Functions .. 00197 LOGICAL LSAME 00198 EXTERNAL LSAME 00199 * .. 00200 * .. External Subroutines .. 00201 EXTERNAL XERBLA 00202 * .. 00203 * .. Intrinsic Functions .. 00204 INTRINSIC MAX 00205 * .. 00206 * .. Local Scalars .. 00207 REAL TEMP 00208 INTEGER I,INFO,J,K,NROWA 00209 LOGICAL LSIDE,NOUNIT,UPPER 00210 * .. 00211 * .. Parameters .. 00212 REAL ONE,ZERO 00213 PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) 00214 * .. 00215 * 00216 * Test the input parameters. 00217 * 00218 LSIDE = LSAME(SIDE,'L') 00219 IF (LSIDE) THEN 00220 NROWA = M 00221 ELSE 00222 NROWA = N 00223 END IF 00224 NOUNIT = LSAME(DIAG,'N') 00225 UPPER = LSAME(UPLO,'U') 00226 * 00227 INFO = 0 00228 IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN 00229 INFO = 1 00230 ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN 00231 INFO = 2 00232 ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND. 00233 + (.NOT.LSAME(TRANSA,'T')) .AND. 00234 + (.NOT.LSAME(TRANSA,'C'))) THEN 00235 INFO = 3 00236 ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN 00237 INFO = 4 00238 ELSE IF (M.LT.0) THEN 00239 INFO = 5 00240 ELSE IF (N.LT.0) THEN 00241 INFO = 6 00242 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN 00243 INFO = 9 00244 ELSE IF (LDB.LT.MAX(1,M)) THEN 00245 INFO = 11 00246 END IF 00247 IF (INFO.NE.0) THEN 00248 CALL XERBLA('STRMM ',INFO) 00249 RETURN 00250 END IF 00251 * 00252 * Quick return if possible. 00253 * 00254 IF (M.EQ.0 .OR. N.EQ.0) RETURN 00255 * 00256 * And when alpha.eq.zero. 00257 * 00258 IF (ALPHA.EQ.ZERO) THEN 00259 DO 20 J = 1,N 00260 DO 10 I = 1,M 00261 B(I,J) = ZERO 00262 10 CONTINUE 00263 20 CONTINUE 00264 RETURN 00265 END IF 00266 * 00267 * Start the operations. 00268 * 00269 IF (LSIDE) THEN 00270 IF (LSAME(TRANSA,'N')) THEN 00271 * 00272 * Form B := alpha*A*B. 00273 * 00274 IF (UPPER) THEN 00275 DO 50 J = 1,N 00276 DO 40 K = 1,M 00277 IF (B(K,J).NE.ZERO) THEN 00278 TEMP = ALPHA*B(K,J) 00279 DO 30 I = 1,K - 1 00280 B(I,J) = B(I,J) + TEMP*A(I,K) 00281 30 CONTINUE 00282 IF (NOUNIT) TEMP = TEMP*A(K,K) 00283 B(K,J) = TEMP 00284 END IF 00285 40 CONTINUE 00286 50 CONTINUE 00287 ELSE 00288 DO 80 J = 1,N 00289 DO 70 K = M,1,-1 00290 IF (B(K,J).NE.ZERO) THEN 00291 TEMP = ALPHA*B(K,J) 00292 B(K,J) = TEMP 00293 IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) 00294 DO 60 I = K + 1,M 00295 B(I,J) = B(I,J) + TEMP*A(I,K) 00296 60 CONTINUE 00297 END IF 00298 70 CONTINUE 00299 80 CONTINUE 00300 END IF 00301 ELSE 00302 * 00303 * Form B := alpha*A**T*B. 00304 * 00305 IF (UPPER) THEN 00306 DO 110 J = 1,N 00307 DO 100 I = M,1,-1 00308 TEMP = B(I,J) 00309 IF (NOUNIT) TEMP = TEMP*A(I,I) 00310 DO 90 K = 1,I - 1 00311 TEMP = TEMP + A(K,I)*B(K,J) 00312 90 CONTINUE 00313 B(I,J) = ALPHA*TEMP 00314 100 CONTINUE 00315 110 CONTINUE 00316 ELSE 00317 DO 140 J = 1,N 00318 DO 130 I = 1,M 00319 TEMP = B(I,J) 00320 IF (NOUNIT) TEMP = TEMP*A(I,I) 00321 DO 120 K = I + 1,M 00322 TEMP = TEMP + A(K,I)*B(K,J) 00323 120 CONTINUE 00324 B(I,J) = ALPHA*TEMP 00325 130 CONTINUE 00326 140 CONTINUE 00327 END IF 00328 END IF 00329 ELSE 00330 IF (LSAME(TRANSA,'N')) THEN 00331 * 00332 * Form B := alpha*B*A. 00333 * 00334 IF (UPPER) THEN 00335 DO 180 J = N,1,-1 00336 TEMP = ALPHA 00337 IF (NOUNIT) TEMP = TEMP*A(J,J) 00338 DO 150 I = 1,M 00339 B(I,J) = TEMP*B(I,J) 00340 150 CONTINUE 00341 DO 170 K = 1,J - 1 00342 IF (A(K,J).NE.ZERO) THEN 00343 TEMP = ALPHA*A(K,J) 00344 DO 160 I = 1,M 00345 B(I,J) = B(I,J) + TEMP*B(I,K) 00346 160 CONTINUE 00347 END IF 00348 170 CONTINUE 00349 180 CONTINUE 00350 ELSE 00351 DO 220 J = 1,N 00352 TEMP = ALPHA 00353 IF (NOUNIT) TEMP = TEMP*A(J,J) 00354 DO 190 I = 1,M 00355 B(I,J) = TEMP*B(I,J) 00356 190 CONTINUE 00357 DO 210 K = J + 1,N 00358 IF (A(K,J).NE.ZERO) THEN 00359 TEMP = ALPHA*A(K,J) 00360 DO 200 I = 1,M 00361 B(I,J) = B(I,J) + TEMP*B(I,K) 00362 200 CONTINUE 00363 END IF 00364 210 CONTINUE 00365 220 CONTINUE 00366 END IF 00367 ELSE 00368 * 00369 * Form B := alpha*B*A**T. 00370 * 00371 IF (UPPER) THEN 00372 DO 260 K = 1,N 00373 DO 240 J = 1,K - 1 00374 IF (A(J,K).NE.ZERO) THEN 00375 TEMP = ALPHA*A(J,K) 00376 DO 230 I = 1,M 00377 B(I,J) = B(I,J) + TEMP*B(I,K) 00378 230 CONTINUE 00379 END IF 00380 240 CONTINUE 00381 TEMP = ALPHA 00382 IF (NOUNIT) TEMP = TEMP*A(K,K) 00383 IF (TEMP.NE.ONE) THEN 00384 DO 250 I = 1,M 00385 B(I,K) = TEMP*B(I,K) 00386 250 CONTINUE 00387 END IF 00388 260 CONTINUE 00389 ELSE 00390 DO 300 K = N,1,-1 00391 DO 280 J = K + 1,N 00392 IF (A(J,K).NE.ZERO) THEN 00393 TEMP = ALPHA*A(J,K) 00394 DO 270 I = 1,M 00395 B(I,J) = B(I,J) + TEMP*B(I,K) 00396 270 CONTINUE 00397 END IF 00398 280 CONTINUE 00399 TEMP = ALPHA 00400 IF (NOUNIT) TEMP = TEMP*A(K,K) 00401 IF (TEMP.NE.ONE) THEN 00402 DO 290 I = 1,M 00403 B(I,K) = TEMP*B(I,K) 00404 290 CONTINUE 00405 END IF 00406 300 CONTINUE 00407 END IF 00408 END IF 00409 END IF 00410 * 00411 RETURN 00412 * 00413 * End of STRMM . 00414 * 00415 END