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, 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, 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*> \ingroup double_blas_level3 160* 161*> \par Further Details: 162* ===================== 163*> 164*> \verbatim 165*> 166*> Level 3 Blas routine. 167*> 168*> -- Written on 8-February-1989. 169*> Jack Dongarra, Argonne National Laboratory. 170*> Iain Duff, AERE Harwell. 171*> Jeremy Du Croz, Numerical Algorithms Group Ltd. 172*> Sven Hammarling, Numerical Algorithms Group Ltd. 173*> \endverbatim 174*> 175* ===================================================================== 176 SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) 177* 178* -- Reference BLAS level3 routine -- 179* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 180* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 181* 182* .. Scalar Arguments .. 183 DOUBLE PRECISION ALPHA 184 INTEGER LDA,LDB,M,N 185 CHARACTER DIAG,SIDE,TRANSA,UPLO 186* .. 187* .. Array Arguments .. 188 DOUBLE PRECISION A(LDA,*),B(LDB,*) 189* .. 190* 191* ===================================================================== 192* 193* .. External Functions .. 194 LOGICAL LSAME 195 EXTERNAL LSAME 196* .. 197* .. External Subroutines .. 198 EXTERNAL XERBLA 199* .. 200* .. Intrinsic Functions .. 201 INTRINSIC MAX 202* .. 203* .. Local Scalars .. 204 DOUBLE PRECISION TEMP 205 INTEGER I,INFO,J,K,NROWA 206 LOGICAL LSIDE,NOUNIT,UPPER 207* .. 208* .. Parameters .. 209 DOUBLE PRECISION ONE,ZERO 210 PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) 211* .. 212* 213* Test the input parameters. 214* 215 LSIDE = LSAME(SIDE,'L') 216 IF (LSIDE) THEN 217 NROWA = M 218 ELSE 219 NROWA = N 220 END IF 221 NOUNIT = LSAME(DIAG,'N') 222 UPPER = LSAME(UPLO,'U') 223* 224 INFO = 0 225 IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN 226 INFO = 1 227 ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN 228 INFO = 2 229 ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND. 230 + (.NOT.LSAME(TRANSA,'T')) .AND. 231 + (.NOT.LSAME(TRANSA,'C'))) THEN 232 INFO = 3 233 ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN 234 INFO = 4 235 ELSE IF (M.LT.0) THEN 236 INFO = 5 237 ELSE IF (N.LT.0) THEN 238 INFO = 6 239 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN 240 INFO = 9 241 ELSE IF (LDB.LT.MAX(1,M)) THEN 242 INFO = 11 243 END IF 244 IF (INFO.NE.0) THEN 245 CALL XERBLA('DTRMM ',INFO) 246 RETURN 247 END IF 248* 249* Quick return if possible. 250* 251 IF (M.EQ.0 .OR. N.EQ.0) RETURN 252* 253* And when alpha.eq.zero. 254* 255 IF (ALPHA.EQ.ZERO) THEN 256 DO 20 J = 1,N 257 DO 10 I = 1,M 258 B(I,J) = ZERO 259 10 CONTINUE 260 20 CONTINUE 261 RETURN 262 END IF 263* 264* Start the operations. 265* 266 IF (LSIDE) THEN 267 IF (LSAME(TRANSA,'N')) THEN 268* 269* Form B := alpha*A*B. 270* 271 IF (UPPER) THEN 272 DO 50 J = 1,N 273 DO 40 K = 1,M 274 IF (B(K,J).NE.ZERO) THEN 275 TEMP = ALPHA*B(K,J) 276 DO 30 I = 1,K - 1 277 B(I,J) = B(I,J) + TEMP*A(I,K) 278 30 CONTINUE 279 IF (NOUNIT) TEMP = TEMP*A(K,K) 280 B(K,J) = TEMP 281 END IF 282 40 CONTINUE 283 50 CONTINUE 284 ELSE 285 DO 80 J = 1,N 286 DO 70 K = M,1,-1 287 IF (B(K,J).NE.ZERO) THEN 288 TEMP = ALPHA*B(K,J) 289 B(K,J) = TEMP 290 IF (NOUNIT) B(K,J) = B(K,J)*A(K,K) 291 DO 60 I = K + 1,M 292 B(I,J) = B(I,J) + TEMP*A(I,K) 293 60 CONTINUE 294 END IF 295 70 CONTINUE 296 80 CONTINUE 297 END IF 298 ELSE 299* 300* Form B := alpha*A**T*B. 301* 302 IF (UPPER) THEN 303 DO 110 J = 1,N 304 DO 100 I = M,1,-1 305 TEMP = B(I,J) 306 IF (NOUNIT) TEMP = TEMP*A(I,I) 307 DO 90 K = 1,I - 1 308 TEMP = TEMP + A(K,I)*B(K,J) 309 90 CONTINUE 310 B(I,J) = ALPHA*TEMP 311 100 CONTINUE 312 110 CONTINUE 313 ELSE 314 DO 140 J = 1,N 315 DO 130 I = 1,M 316 TEMP = B(I,J) 317 IF (NOUNIT) TEMP = TEMP*A(I,I) 318 DO 120 K = I + 1,M 319 TEMP = TEMP + A(K,I)*B(K,J) 320 120 CONTINUE 321 B(I,J) = ALPHA*TEMP 322 130 CONTINUE 323 140 CONTINUE 324 END IF 325 END IF 326 ELSE 327 IF (LSAME(TRANSA,'N')) THEN 328* 329* Form B := alpha*B*A. 330* 331 IF (UPPER) THEN 332 DO 180 J = N,1,-1 333 TEMP = ALPHA 334 IF (NOUNIT) TEMP = TEMP*A(J,J) 335 DO 150 I = 1,M 336 B(I,J) = TEMP*B(I,J) 337 150 CONTINUE 338 DO 170 K = 1,J - 1 339 IF (A(K,J).NE.ZERO) THEN 340 TEMP = ALPHA*A(K,J) 341 DO 160 I = 1,M 342 B(I,J) = B(I,J) + TEMP*B(I,K) 343 160 CONTINUE 344 END IF 345 170 CONTINUE 346 180 CONTINUE 347 ELSE 348 DO 220 J = 1,N 349 TEMP = ALPHA 350 IF (NOUNIT) TEMP = TEMP*A(J,J) 351 DO 190 I = 1,M 352 B(I,J) = TEMP*B(I,J) 353 190 CONTINUE 354 DO 210 K = J + 1,N 355 IF (A(K,J).NE.ZERO) THEN 356 TEMP = ALPHA*A(K,J) 357 DO 200 I = 1,M 358 B(I,J) = B(I,J) + TEMP*B(I,K) 359 200 CONTINUE 360 END IF 361 210 CONTINUE 362 220 CONTINUE 363 END IF 364 ELSE 365* 366* Form B := alpha*B*A**T. 367* 368 IF (UPPER) THEN 369 DO 260 K = 1,N 370 DO 240 J = 1,K - 1 371 IF (A(J,K).NE.ZERO) THEN 372 TEMP = ALPHA*A(J,K) 373 DO 230 I = 1,M 374 B(I,J) = B(I,J) + TEMP*B(I,K) 375 230 CONTINUE 376 END IF 377 240 CONTINUE 378 TEMP = ALPHA 379 IF (NOUNIT) TEMP = TEMP*A(K,K) 380 IF (TEMP.NE.ONE) THEN 381 DO 250 I = 1,M 382 B(I,K) = TEMP*B(I,K) 383 250 CONTINUE 384 END IF 385 260 CONTINUE 386 ELSE 387 DO 300 K = N,1,-1 388 DO 280 J = K + 1,N 389 IF (A(J,K).NE.ZERO) THEN 390 TEMP = ALPHA*A(J,K) 391 DO 270 I = 1,M 392 B(I,J) = B(I,J) + TEMP*B(I,K) 393 270 CONTINUE 394 END IF 395 280 CONTINUE 396 TEMP = ALPHA 397 IF (NOUNIT) TEMP = TEMP*A(K,K) 398 IF (TEMP.NE.ONE) THEN 399 DO 290 I = 1,M 400 B(I,K) = TEMP*B(I,K) 401 290 CONTINUE 402 END IF 403 300 CONTINUE 404 END IF 405 END IF 406 END IF 407* 408 RETURN 409* 410* End of DTRMM 411* 412 END 413