1*> \brief \b DTRMM 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) 12* 13* .. Scalar Arguments .. 14* DOUBLE PRECISION ALPHA 15* INTEGER LDA,LDB,M,N 16* CHARACTER DIAG,SIDE,TRANSA,UPLO 17* .. 18* .. Array Arguments .. 19* DOUBLE PRECISION A(LDA,*),B(LDB,*) 20* .. 21* 22* 23*> \par Purpose: 24* ============= 25*> 26*> \verbatim 27*> 28*> DTRMM performs one of the matrix-matrix operations 29*> 30*> B := alpha*op( A )*B, or B := alpha*B*op( A ), 31*> 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 34*> 35*> op( A ) = A or op( A ) = A**T. 36*> \endverbatim 37* 38* Arguments: 39* ========== 40* 41*> \param[in] SIDE 42*> \verbatim 43*> SIDE is CHARACTER*1 44*> On entry, SIDE specifies whether op( A ) multiplies B from 45*> the left or right as follows: 46*> 47*> SIDE = 'L' or 'l' B := alpha*op( A )*B. 48*> 49*> SIDE = 'R' or 'r' B := alpha*B*op( A ). 50*> \endverbatim 51*> 52*> \param[in] UPLO 53*> \verbatim 54*> UPLO is CHARACTER*1 55*> On entry, UPLO specifies whether the matrix A is an upper or 56*> lower triangular matrix as follows: 57*> 58*> UPLO = 'U' or 'u' A is an upper triangular matrix. 59*> 60*> UPLO = 'L' or 'l' A is a lower triangular matrix. 61*> \endverbatim 62*> 63*> \param[in] TRANSA 64*> \verbatim 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: 68*> 69*> TRANSA = 'N' or 'n' op( A ) = A. 70*> 71*> TRANSA = 'T' or 't' op( A ) = A**T. 72*> 73*> TRANSA = 'C' or 'c' op( A ) = A**T. 74*> \endverbatim 75*> 76*> \param[in] DIAG 77*> \verbatim 78*> DIAG is CHARACTER*1 79*> On entry, DIAG specifies whether or not A is unit triangular 80*> as follows: 81*> 82*> DIAG = 'U' or 'u' A is assumed to be unit triangular. 83*> 84*> DIAG = 'N' or 'n' A is not assumed to be unit 85*> triangular. 86*> \endverbatim 87*> 88*> \param[in] M 89*> \verbatim 90*> M is INTEGER 91*> On entry, M specifies the number of rows of B. M must be at 92*> least zero. 93*> \endverbatim 94*> 95*> \param[in] N 96*> \verbatim 97*> N is INTEGER 98*> On entry, N specifies the number of columns of B. N must be 99*> at least zero. 100*> \endverbatim 101*> 102*> \param[in] ALPHA 103*> \verbatim 104*> ALPHA is DOUBLE PRECISION. 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 107*> entry. 108*> \endverbatim 109*> 110*> \param[in] A 111*> \verbatim 112*> A is DOUBLE PRECISION 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. 124*> \endverbatim 125*> 126*> \param[in] LDA 127*> \verbatim 128*> LDA is INTEGER 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 ). 133*> \endverbatim 134*> 135*> \param[in,out] B 136*> \verbatim 137*> B is DOUBLE PRECISION 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. 141*> \endverbatim 142*> 143*> \param[in] LDB 144*> \verbatim 145*> LDB is INTEGER 146*> On entry, LDB specifies the first dimension of B as declared 147*> in the calling (sub) program. LDB must be at least 148*> max( 1, m ). 149*> \endverbatim 150* 151* Authors: 152* ======== 153* 154*> \author Univ. of Tennessee 155*> \author Univ. of California Berkeley 156*> \author Univ. of Colorado Denver 157*> \author NAG Ltd. 158* 159*> \date November 2011 160* 161*> \ingroup double_blas_level3 162* 163*> \par Further Details: 164* ===================== 165*> 166*> \verbatim 167*> 168*> Level 3 Blas routine. 169*> 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. 175*> \endverbatim 176*> 177* ===================================================================== 178 SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) 179* 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..-- 183* November 2011 184* 185* .. Scalar Arguments .. 186 DOUBLE PRECISION ALPHA 187 INTEGER LDA,LDB,M,N 188 CHARACTER DIAG,SIDE,TRANSA,UPLO 189* .. 190* .. Array Arguments .. 191 DOUBLE PRECISION A(LDA,*),B(LDB,*) 192* .. 193* 194* ===================================================================== 195* 196* .. External Functions .. 197 LOGICAL LSAME 198 EXTERNAL LSAME 199* .. 200* .. External Subroutines .. 201 EXTERNAL XERBLA 202* .. 203* .. Intrinsic Functions .. 204 INTRINSIC MAX 205* .. 206* .. Local Scalars .. 207 DOUBLE PRECISION TEMP 208 INTEGER I,INFO,J,K,NROWA 209 LOGICAL LSIDE,NOUNIT,UPPER 210* .. 211* .. Parameters .. 212 DOUBLE PRECISION ONE,ZERO 213 PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) 214* .. 215* 216* Test the input parameters. 217* 218 LSIDE = LSAME(SIDE,'L') 219 IF (LSIDE) THEN 220 NROWA = M 221 ELSE 222 NROWA = N 223 END IF 224 NOUNIT = LSAME(DIAG,'N') 225 UPPER = LSAME(UPLO,'U') 226* 227 INFO = 0 228 IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN 229 INFO = 1 230 ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN 231 INFO = 2 232 ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND. 233 + (.NOT.LSAME(TRANSA,'T')) .AND. 234 + (.NOT.LSAME(TRANSA,'C'))) THEN 235 INFO = 3 236 ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN 237 INFO = 4 238 ELSE IF (M.LT.0) THEN 239 INFO = 5 240 ELSE IF (N.LT.0) THEN 241 INFO = 6 242 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN 243 INFO = 9 244 ELSE IF (LDB.LT.MAX(1,M)) THEN 245 INFO = 11 246 END IF 247 IF (INFO.NE.0) THEN 248 CALL XERBLA('DTRMM ',INFO) 249 RETURN 250 END IF 251* 252* Quick return if possible. 253* 254 IF (M.EQ.0 .OR. N.EQ.0) RETURN 255* 256* And when alpha.eq.zero. 257* 258 IF (ALPHA.EQ.ZERO) THEN 259 DO 20 J = 1,N 260 DO 10 I = 1,M 261 B(I,J) = ZERO 262 10 CONTINUE 263 20 CONTINUE 264 RETURN 265 END IF 266* 267* Start the operations. 268* 269 IF (LSIDE) THEN 270 IF (LSAME(TRANSA,'N')) THEN 271* 272* Form B := alpha*A*B. 273* 274 IF (UPPER) THEN 275 DO 50 J = 1,N 276 DO 40 K = 1,M 277 IF (B(K,J).NE.ZERO) THEN 278 TEMP = ALPHA*B(K,J) 279 DO 30 I = 1,K - 1 280 B(I,J) = B(I,J) + TEMP*A(I,K) 281 30 CONTINUE 282 IF (NOUNIT) TEMP = TEMP*A(K,K) 283 B(K,J) = TEMP 284 END IF 285 40 CONTINUE 286 50 CONTINUE 287 ELSE 288 DO 80 J = 1,N 289 DO 70 K = M,1,-1 290 IF (B(K,J).NE.ZERO) THEN 291 TEMP = ALPHA*B(K,J) 292 B(K,J) = TEMP 293 IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) 294 DO 60 I = K + 1,M 295 B(I,J) = B(I,J) + TEMP*A(I,K) 296 60 CONTINUE 297 END IF 298 70 CONTINUE 299 80 CONTINUE 300 END IF 301 ELSE 302* 303* Form B := alpha*A**T*B. 304* 305 IF (UPPER) THEN 306 DO 110 J = 1,N 307 DO 100 I = M,1,-1 308 TEMP = B(I,J) 309 IF (NOUNIT) TEMP = TEMP*A(I,I) 310 DO 90 K = 1,I - 1 311 TEMP = TEMP + A(K,I)*B(K,J) 312 90 CONTINUE 313 B(I,J) = ALPHA*TEMP 314 100 CONTINUE 315 110 CONTINUE 316 ELSE 317 DO 140 J = 1,N 318 DO 130 I = 1,M 319 TEMP = B(I,J) 320 IF (NOUNIT) TEMP = TEMP*A(I,I) 321 DO 120 K = I + 1,M 322 TEMP = TEMP + A(K,I)*B(K,J) 323 120 CONTINUE 324 B(I,J) = ALPHA*TEMP 325 130 CONTINUE 326 140 CONTINUE 327 END IF 328 END IF 329 ELSE 330 IF (LSAME(TRANSA,'N')) THEN 331* 332* Form B := alpha*B*A. 333* 334 IF (UPPER) THEN 335 DO 180 J = N,1,-1 336 TEMP = ALPHA 337 IF (NOUNIT) TEMP = TEMP*A(J,J) 338 DO 150 I = 1,M 339 B(I,J) = TEMP*B(I,J) 340 150 CONTINUE 341 DO 170 K = 1,J - 1 342 IF (A(K,J).NE.ZERO) THEN 343 TEMP = ALPHA*A(K,J) 344 DO 160 I = 1,M 345 B(I,J) = B(I,J) + TEMP*B(I,K) 346 160 CONTINUE 347 END IF 348 170 CONTINUE 349 180 CONTINUE 350 ELSE 351 DO 220 J = 1,N 352 TEMP = ALPHA 353 IF (NOUNIT) TEMP = TEMP*A(J,J) 354 DO 190 I = 1,M 355 B(I,J) = TEMP*B(I,J) 356 190 CONTINUE 357 DO 210 K = J + 1,N 358 IF (A(K,J).NE.ZERO) THEN 359 TEMP = ALPHA*A(K,J) 360 DO 200 I = 1,M 361 B(I,J) = B(I,J) + TEMP*B(I,K) 362 200 CONTINUE 363 END IF 364 210 CONTINUE 365 220 CONTINUE 366 END IF 367 ELSE 368* 369* Form B := alpha*B*A**T. 370* 371 IF (UPPER) THEN 372 DO 260 K = 1,N 373 DO 240 J = 1,K - 1 374 IF (A(J,K).NE.ZERO) THEN 375 TEMP = ALPHA*A(J,K) 376 DO 230 I = 1,M 377 B(I,J) = B(I,J) + TEMP*B(I,K) 378 230 CONTINUE 379 END IF 380 240 CONTINUE 381 TEMP = ALPHA 382 IF (NOUNIT) TEMP = TEMP*A(K,K) 383 IF (TEMP.NE.ONE) THEN 384 DO 250 I = 1,M 385 B(I,K) = TEMP*B(I,K) 386 250 CONTINUE 387 END IF 388 260 CONTINUE 389 ELSE 390 DO 300 K = N,1,-1 391 DO 280 J = K + 1,N 392 IF (A(J,K).NE.ZERO) THEN 393 TEMP = ALPHA*A(J,K) 394 DO 270 I = 1,M 395 B(I,J) = B(I,J) + TEMP*B(I,K) 396 270 CONTINUE 397 END IF 398 280 CONTINUE 399 TEMP = ALPHA 400 IF (NOUNIT) TEMP = TEMP*A(K,K) 401 IF (TEMP.NE.ONE) THEN 402 DO 290 I = 1,M 403 B(I,K) = TEMP*B(I,K) 404 290 CONTINUE 405 END IF 406 300 CONTINUE 407 END IF 408 END IF 409 END IF 410* 411 RETURN 412* 413* End of DTRMM . 414* 415 END 416