1 SUBROUTINE DTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, 2 $ B, LDB ) 3* .. SCALAR ARGUMENTS .. 4 CHARACTER*1 SIDE, UPLO, TRANSA, DIAG 5 INTEGER M, N, LDA, LDB 6 DOUBLE PRECISION ALPHA 7* .. ARRAY ARGUMENTS .. 8 DOUBLE PRECISION A( LDA, * ), B( LDB, * ) 9* .. 10* 11* PURPOSE 12* ======= 13* 14* DTRMM PERFORMS ONE OF THE MATRIX-MATRIX OPERATIONS 15* 16* B := ALPHA*OP( A )*B, OR B := ALPHA*B*OP( A ), 17* 18* WHERE ALPHA IS A SCALAR, B IS AN M BY N MATRIX, A IS A UNIT, OR 19* NON-UNIT, UPPER OR LOWER TRIANGULAR MATRIX AND OP( A ) IS ONE OF 20* 21* OP( A ) = A OR OP( A ) = A'. 22* 23* PARAMETERS 24* ========== 25* 26* SIDE - CHARACTER*1. 27* ON ENTRY, SIDE SPECIFIES WHETHER OP( A ) MULTIPLIES B FROM 28* THE LEFT OR RIGHT AS FOLLOWS: 29* 30* SIDE = 'L' OR 'L' B := ALPHA*OP( A )*B. 31* 32* SIDE = 'R' OR 'R' B := ALPHA*B*OP( A ). 33* 34* UNCHANGED ON EXIT. 35* 36* UPLO - CHARACTER*1. 37* ON ENTRY, UPLO SPECIFIES WHETHER THE MATRIX A IS AN UPPER OR 38* LOWER TRIANGULAR MATRIX AS FOLLOWS: 39* 40* UPLO = 'U' OR 'U' A IS AN UPPER TRIANGULAR MATRIX. 41* 42* UPLO = 'L' OR 'L' A IS A LOWER TRIANGULAR MATRIX. 43* 44* UNCHANGED ON EXIT. 45* 46* TRANSA - CHARACTER*1. 47* ON ENTRY, TRANSA SPECIFIES THE FORM OF OP( A ) TO BE USED IN 48* THE MATRIX MULTIPLICATION AS FOLLOWS: 49* 50* TRANSA = 'N' OR 'N' OP( A ) = A. 51* 52* TRANSA = 'T' OR 'T' OP( A ) = A'. 53* 54* TRANSA = 'C' OR 'C' OP( A ) = A'. 55* 56* UNCHANGED ON EXIT. 57* 58* DIAG - CHARACTER*1. 59* ON ENTRY, DIAG SPECIFIES WHETHER OR NOT A IS UNIT TRIANGULAR 60* AS FOLLOWS: 61* 62* DIAG = 'U' OR 'U' A IS ASSUMED TO BE UNIT TRIANGULAR. 63* 64* DIAG = 'N' OR 'N' A IS NOT ASSUMED TO BE UNIT 65* TRIANGULAR. 66* 67* UNCHANGED ON EXIT. 68* 69* M - INTEGER. 70* ON ENTRY, M SPECIFIES THE NUMBER OF ROWS OF B. M MUST BE AT 71* LEAST ZERO. 72* UNCHANGED ON EXIT. 73* 74* N - INTEGER. 75* ON ENTRY, N SPECIFIES THE NUMBER OF COLUMNS OF B. N MUST BE 76* AT LEAST ZERO. 77* UNCHANGED ON EXIT. 78* 79* ALPHA - DOUBLE PRECISION. 80* ON ENTRY, ALPHA SPECIFIES THE SCALAR ALPHA. WHEN ALPHA IS 81* ZERO THEN A IS NOT REFERENCED AND B NEED NOT BE SET BEFORE 82* ENTRY. 83* UNCHANGED ON EXIT. 84* 85* A - DOUBLE PRECISION ARRAY OF DIMENSION ( LDA, K ), WHERE K IS M 86* WHEN SIDE = 'L' OR 'L' AND IS N WHEN SIDE = 'R' OR 'R'. 87* BEFORE ENTRY WITH UPLO = 'U' OR 'U', THE LEADING K BY K 88* UPPER TRIANGULAR PART OF THE ARRAY A MUST CONTAIN THE UPPER 89* TRIANGULAR MATRIX AND THE STRICTLY LOWER TRIANGULAR PART OF 90* A IS NOT REFERENCED. 91* BEFORE ENTRY WITH UPLO = 'L' OR 'L', THE LEADING K BY K 92* LOWER TRIANGULAR PART OF THE ARRAY A MUST CONTAIN THE LOWER 93* TRIANGULAR MATRIX AND THE STRICTLY UPPER TRIANGULAR PART OF 94* A IS NOT REFERENCED. 95* NOTE THAT WHEN DIAG = 'U' OR 'U', THE DIAGONAL ELEMENTS OF 96* A ARE NOT REFERENCED EITHER, BUT ARE ASSUMED TO BE UNITY. 97* UNCHANGED ON EXIT. 98* 99* LDA - INTEGER. 100* ON ENTRY, LDA SPECIFIES THE FIRST DIMENSION OF A AS DECLARED 101* IN THE CALLING (SUB) PROGRAM. WHEN SIDE = 'L' OR 'L' THEN 102* LDA MUST BE AT LEAST MAX( 1, M ), WHEN SIDE = 'R' OR 'R' 103* THEN LDA MUST BE AT LEAST MAX( 1, N ). 104* UNCHANGED ON EXIT. 105* 106* B - DOUBLE PRECISION ARRAY OF DIMENSION ( LDB, N ). 107* BEFORE ENTRY, THE LEADING M BY N PART OF THE ARRAY B MUST 108* CONTAIN THE MATRIX B, AND ON EXIT IS OVERWRITTEN BY THE 109* TRANSFORMED MATRIX. 110* 111* LDB - INTEGER. 112* ON ENTRY, LDB SPECIFIES THE FIRST DIMENSION OF B AS DECLARED 113* IN THE CALLING (SUB) PROGRAM. LDB MUST BE AT LEAST 114* MAX( 1, M ). 115* UNCHANGED ON EXIT. 116* 117* 118* LEVEL 3 BLAS ROUTINE. 119* 120* -- WRITTEN ON 8-FEBRUARY-1989. 121* JACK DONGARRA, ARGONNE NATIONAL LABORATORY. 122* IAIN DUFF, AERE HARWELL. 123* JEREMY DU CROZ, NUMERICAL ALGORITHMS GROUP LTD. 124* SVEN HAMMARLING, NUMERICAL ALGORITHMS GROUP LTD. 125* 126* 127* .. EXTERNAL FUNCTIONS .. 128 LOGICAL LSAME 129 EXTERNAL LSAME 130* .. EXTERNAL SUBROUTINES .. 131 EXTERNAL XERBLA 132* .. INTRINSIC FUNCTIONS .. 133 INTRINSIC MAX 134* .. LOCAL SCALARS .. 135 LOGICAL LSIDE, NOUNIT, UPPER 136 INTEGER I, INFO, J, K, NROWA 137 DOUBLE PRECISION TEMP 138* .. PARAMETERS .. 139 DOUBLE PRECISION ONE , ZERO 140 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 141* .. 142* .. EXECUTABLE STATEMENTS .. 143* 144* TEST THE INPUT PARAMETERS. 145* 146 LSIDE = LSAME( SIDE , 'L' ) 147 IF( LSIDE )THEN 148 NROWA = M 149 ELSE 150 NROWA = N 151 END IF 152 NOUNIT = LSAME( DIAG , 'N' ) 153 UPPER = LSAME( UPLO , 'U' ) 154* 155 INFO = 0 156 IF( ( .NOT.LSIDE ).AND. 157 $ ( .NOT.LSAME( SIDE , 'R' ) ) )THEN 158 INFO = 1 159 ELSE IF( ( .NOT.UPPER ).AND. 160 $ ( .NOT.LSAME( UPLO , 'L' ) ) )THEN 161 INFO = 2 162 ELSE IF( ( .NOT.LSAME( TRANSA, 'N' ) ).AND. 163 $ ( .NOT.LSAME( TRANSA, 'T' ) ).AND. 164 $ ( .NOT.LSAME( TRANSA, 'C' ) ) )THEN 165 INFO = 3 166 ELSE IF( ( .NOT.LSAME( DIAG , 'U' ) ).AND. 167 $ ( .NOT.LSAME( DIAG , 'N' ) ) )THEN 168 INFO = 4 169 ELSE IF( M .LT.0 )THEN 170 INFO = 5 171 ELSE IF( N .LT.0 )THEN 172 INFO = 6 173 ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN 174 INFO = 9 175 ELSE IF( LDB.LT.MAX( 1, M ) )THEN 176 INFO = 11 177 END IF 178 IF( INFO.NE.0 )THEN 179 CALL XERBLA( 'DTRMM ', INFO ) 180 RETURN 181 END IF 182* 183* QUICK RETURN IF POSSIBLE. 184* 185 IF( N.EQ.0 ) 186 $ RETURN 187* 188* AND WHEN ALPHA.EQ.ZERO. 189* 190 IF( ALPHA.EQ.ZERO )THEN 191 DO 20, J = 1, N 192 DO 10, I = 1, M 193 B( I, J ) = ZERO 194 10 CONTINUE 195 20 CONTINUE 196 RETURN 197 END IF 198* 199* START THE OPERATIONS. 200* 201 IF( LSIDE )THEN 202 IF( LSAME( TRANSA, 'N' ) )THEN 203* 204* FORM B := ALPHA*A*B. 205* 206 IF( UPPER )THEN 207 DO 50, J = 1, N 208 DO 40, K = 1, M 209 IF( B( K, J ).NE.ZERO )THEN 210 TEMP = ALPHA*B( K, J ) 211 DO 30, I = 1, K - 1 212 B( I, J ) = B( I, J ) + TEMP*A( I, K ) 213 30 CONTINUE 214 IF( NOUNIT ) 215 $ TEMP = TEMP*A( K, K ) 216 B( K, J ) = TEMP 217 END IF 218 40 CONTINUE 219 50 CONTINUE 220 ELSE 221 DO 80, J = 1, N 222 DO 70 K = M, 1, -1 223 IF( B( K, J ).NE.ZERO )THEN 224 TEMP = ALPHA*B( K, J ) 225 B( K, J ) = TEMP 226 IF( NOUNIT ) 227 $ B( K, J ) = B( K, J )*A( K, K ) 228 DO 60, I = K + 1, M 229 B( I, J ) = B( I, J ) + TEMP*A( I, K ) 230 60 CONTINUE 231 END IF 232 70 CONTINUE 233 80 CONTINUE 234 END IF 235 ELSE 236* 237* FORM B := ALPHA*B*A'. 238* 239 IF( UPPER )THEN 240 DO 110, J = 1, N 241 DO 100, I = M, 1, -1 242 TEMP = B( I, J ) 243 IF( NOUNIT ) 244 $ TEMP = TEMP*A( I, I ) 245 DO 90, K = 1, I - 1 246 TEMP = TEMP + A( K, I )*B( K, J ) 247 90 CONTINUE 248 B( I, J ) = ALPHA*TEMP 249 100 CONTINUE 250 110 CONTINUE 251 ELSE 252 DO 140, J = 1, N 253 DO 130, I = 1, M 254 TEMP = B( I, J ) 255 IF( NOUNIT ) 256 $ TEMP = TEMP*A( I, I ) 257 DO 120, K = I + 1, M 258 TEMP = TEMP + A( K, I )*B( K, J ) 259 120 CONTINUE 260 B( I, J ) = ALPHA*TEMP 261 130 CONTINUE 262 140 CONTINUE 263 END IF 264 END IF 265 ELSE 266 IF( LSAME( TRANSA, 'N' ) )THEN 267* 268* FORM B := ALPHA*B*A. 269* 270 IF( UPPER )THEN 271 DO 180, J = N, 1, -1 272 TEMP = ALPHA 273 IF( NOUNIT ) 274 $ TEMP = TEMP*A( J, J ) 275 DO 150, I = 1, M 276 B( I, J ) = TEMP*B( I, J ) 277 150 CONTINUE 278 DO 170, K = 1, J - 1 279 IF( A( K, J ).NE.ZERO )THEN 280 TEMP = ALPHA*A( K, J ) 281 DO 160, I = 1, M 282 B( I, J ) = B( I, J ) + TEMP*B( I, K ) 283 160 CONTINUE 284 END IF 285 170 CONTINUE 286 180 CONTINUE 287 ELSE 288 DO 220, J = 1, N 289 TEMP = ALPHA 290 IF( NOUNIT ) 291 $ TEMP = TEMP*A( J, J ) 292 DO 190, I = 1, M 293 B( I, J ) = TEMP*B( I, J ) 294 190 CONTINUE 295 DO 210, K = J + 1, N 296 IF( A( K, J ).NE.ZERO )THEN 297 TEMP = ALPHA*A( K, J ) 298 DO 200, I = 1, M 299 B( I, J ) = B( I, J ) + TEMP*B( I, K ) 300 200 CONTINUE 301 END IF 302 210 CONTINUE 303 220 CONTINUE 304 END IF 305 ELSE 306* 307* FORM B := ALPHA*B*A'. 308* 309 IF( UPPER )THEN 310 DO 260, K = 1, N 311 DO 240, J = 1, K - 1 312 IF( A( J, K ).NE.ZERO )THEN 313 TEMP = ALPHA*A( J, K ) 314 DO 230, I = 1, M 315 B( I, J ) = B( I, J ) + TEMP*B( I, K ) 316 230 CONTINUE 317 END IF 318 240 CONTINUE 319 TEMP = ALPHA 320 IF( NOUNIT ) 321 $ TEMP = TEMP*A( K, K ) 322 IF( TEMP.NE.ONE )THEN 323 DO 250, I = 1, M 324 B( I, K ) = TEMP*B( I, K ) 325 250 CONTINUE 326 END IF 327 260 CONTINUE 328 ELSE 329 DO 300, K = N, 1, -1 330 DO 280, J = K + 1, N 331 IF( A( J, K ).NE.ZERO )THEN 332 TEMP = ALPHA*A( J, K ) 333 DO 270, I = 1, M 334 B( I, J ) = B( I, J ) + TEMP*B( I, K ) 335 270 CONTINUE 336 END IF 337 280 CONTINUE 338 TEMP = ALPHA 339 IF( NOUNIT ) 340 $ TEMP = TEMP*A( K, K ) 341 IF( TEMP.NE.ONE )THEN 342 DO 290, I = 1, M 343 B( I, K ) = TEMP*B( I, K ) 344 290 CONTINUE 345 END IF 346 300 CONTINUE 347 END IF 348 END IF 349 END IF 350* 351 RETURN 352* 353* END OF DTRMM . 354* 355 END 356