1*> \brief \b ZTRSM 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 ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) 12* 13* .. Scalar Arguments .. 14* COMPLEX*16 ALPHA 15* INTEGER LDA,LDB,M,N 16* CHARACTER DIAG,SIDE,TRANSA,UPLO 17* .. 18* .. Array Arguments .. 19* COMPLEX*16 A(LDA,*),B(LDB,*) 20* .. 21* 22* 23*> \par Purpose: 24* ============= 25*> 26*> \verbatim 27*> 28*> ZTRSM solves one of the matrix equations 29*> 30*> op( A )*X = alpha*B, or X*op( A ) = alpha*B, 31*> 32*> where alpha is a scalar, X and B are m by n matrices, 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 or op( A ) = A**H. 36*> 37*> The matrix X is overwritten on B. 38*> \endverbatim 39* 40* Arguments: 41* ========== 42* 43*> \param[in] SIDE 44*> \verbatim 45*> SIDE is CHARACTER*1 46*> On entry, SIDE specifies whether op( A ) appears on the left 47*> or right of X as follows: 48*> 49*> SIDE = 'L' or 'l' op( A )*X = alpha*B. 50*> 51*> SIDE = 'R' or 'r' X*op( A ) = alpha*B. 52*> \endverbatim 53*> 54*> \param[in] UPLO 55*> \verbatim 56*> UPLO is CHARACTER*1 57*> On entry, UPLO specifies whether the matrix A is an upper or 58*> lower triangular matrix as follows: 59*> 60*> UPLO = 'U' or 'u' A is an upper triangular matrix. 61*> 62*> UPLO = 'L' or 'l' A is a lower triangular matrix. 63*> \endverbatim 64*> 65*> \param[in] TRANSA 66*> \verbatim 67*> TRANSA is CHARACTER*1 68*> On entry, TRANSA specifies the form of op( A ) to be used in 69*> the matrix multiplication as follows: 70*> 71*> TRANSA = 'N' or 'n' op( A ) = A. 72*> 73*> TRANSA = 'T' or 't' op( A ) = A**T. 74*> 75*> TRANSA = 'C' or 'c' op( A ) = A**H. 76*> \endverbatim 77*> 78*> \param[in] DIAG 79*> \verbatim 80*> DIAG is CHARACTER*1 81*> On entry, DIAG specifies whether or not A is unit triangular 82*> as follows: 83*> 84*> DIAG = 'U' or 'u' A is assumed to be unit triangular. 85*> 86*> DIAG = 'N' or 'n' A is not assumed to be unit 87*> triangular. 88*> \endverbatim 89*> 90*> \param[in] M 91*> \verbatim 92*> M is INTEGER 93*> On entry, M specifies the number of rows of B. M must be at 94*> least zero. 95*> \endverbatim 96*> 97*> \param[in] N 98*> \verbatim 99*> N is INTEGER 100*> On entry, N specifies the number of columns of B. N must be 101*> at least zero. 102*> \endverbatim 103*> 104*> \param[in] ALPHA 105*> \verbatim 106*> ALPHA is COMPLEX*16 107*> On entry, ALPHA specifies the scalar alpha. When alpha is 108*> zero then A is not referenced and B need not be set before 109*> entry. 110*> \endverbatim 111*> 112*> \param[in] A 113*> \verbatim 114*> A is COMPLEX*16 array, dimension ( LDA, k ), 115*> where k is m when SIDE = 'L' or 'l' 116*> and k is n when SIDE = 'R' or 'r'. 117*> Before entry with UPLO = 'U' or 'u', the leading k by k 118*> upper triangular part of the array A must contain the upper 119*> triangular matrix and the strictly lower triangular part of 120*> A is not referenced. 121*> Before entry with UPLO = 'L' or 'l', the leading k by k 122*> lower triangular part of the array A must contain the lower 123*> triangular matrix and the strictly upper triangular part of 124*> A is not referenced. 125*> Note that when DIAG = 'U' or 'u', the diagonal elements of 126*> A are not referenced either, but are assumed to be unity. 127*> \endverbatim 128*> 129*> \param[in] LDA 130*> \verbatim 131*> LDA is INTEGER 132*> On entry, LDA specifies the first dimension of A as declared 133*> in the calling (sub) program. When SIDE = 'L' or 'l' then 134*> LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' 135*> then LDA must be at least max( 1, n ). 136*> \endverbatim 137*> 138*> \param[in,out] B 139*> \verbatim 140*> B is COMPLEX*16 array, dimension ( LDB, N ) 141*> Before entry, the leading m by n part of the array B must 142*> contain the right-hand side matrix B, and on exit is 143*> overwritten by the solution matrix X. 144*> \endverbatim 145*> 146*> \param[in] LDB 147*> \verbatim 148*> LDB is INTEGER 149*> On entry, LDB specifies the first dimension of B as declared 150*> in the calling (sub) program. LDB must be at least 151*> max( 1, m ). 152*> \endverbatim 153* 154* Authors: 155* ======== 156* 157*> \author Univ. of Tennessee 158*> \author Univ. of California Berkeley 159*> \author Univ. of Colorado Denver 160*> \author NAG Ltd. 161* 162*> \ingroup complex16_blas_level3 163* 164*> \par Further Details: 165* ===================== 166*> 167*> \verbatim 168*> 169*> Level 3 Blas routine. 170*> 171*> -- Written on 8-February-1989. 172*> Jack Dongarra, Argonne National Laboratory. 173*> Iain Duff, AERE Harwell. 174*> Jeremy Du Croz, Numerical Algorithms Group Ltd. 175*> Sven Hammarling, Numerical Algorithms Group Ltd. 176*> \endverbatim 177*> 178* ===================================================================== 179 SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) 180* 181* -- Reference BLAS level3 routine -- 182* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 183* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 184* 185* .. Scalar Arguments .. 186 COMPLEX*16 ALPHA 187 INTEGER LDA,LDB,M,N 188 CHARACTER DIAG,SIDE,TRANSA,UPLO 189* .. 190* .. Array Arguments .. 191 COMPLEX*16 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 DCONJG,MAX 205* .. 206* .. Local Scalars .. 207 COMPLEX*16 TEMP 208 INTEGER I,INFO,J,K,NROWA 209 LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER 210* .. 211* .. Parameters .. 212 COMPLEX*16 ONE 213 PARAMETER (ONE= (1.0D+0,0.0D+0)) 214 COMPLEX*16 ZERO 215 PARAMETER (ZERO= (0.0D+0,0.0D+0)) 216* .. 217* 218* Test the input parameters. 219* 220 LSIDE = LSAME(SIDE,'L') 221 IF (LSIDE) THEN 222 NROWA = M 223 ELSE 224 NROWA = N 225 END IF 226 NOCONJ = LSAME(TRANSA,'T') 227 NOUNIT = LSAME(DIAG,'N') 228 UPPER = LSAME(UPLO,'U') 229* 230 INFO = 0 231 IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN 232 INFO = 1 233 ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN 234 INFO = 2 235 ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND. 236 + (.NOT.LSAME(TRANSA,'T')) .AND. 237 + (.NOT.LSAME(TRANSA,'C'))) THEN 238 INFO = 3 239 ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN 240 INFO = 4 241 ELSE IF (M.LT.0) THEN 242 INFO = 5 243 ELSE IF (N.LT.0) THEN 244 INFO = 6 245 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN 246 INFO = 9 247 ELSE IF (LDB.LT.MAX(1,M)) THEN 248 INFO = 11 249 END IF 250 IF (INFO.NE.0) THEN 251 CALL XERBLA('ZTRSM ',INFO) 252 RETURN 253 END IF 254* 255* Quick return if possible. 256* 257 IF (M.EQ.0 .OR. N.EQ.0) RETURN 258* 259* And when alpha.eq.zero. 260* 261 IF (ALPHA.EQ.ZERO) THEN 262 DO 20 J = 1,N 263 DO 10 I = 1,M 264 B(I,J) = ZERO 265 10 CONTINUE 266 20 CONTINUE 267 RETURN 268 END IF 269* 270* Start the operations. 271* 272 IF (LSIDE) THEN 273 IF (LSAME(TRANSA,'N')) THEN 274* 275* Form B := alpha*inv( A )*B. 276* 277 IF (UPPER) THEN 278 DO 60 J = 1,N 279 IF (ALPHA.NE.ONE) THEN 280 DO 30 I = 1,M 281 B(I,J) = ALPHA*B(I,J) 282 30 CONTINUE 283 END IF 284 DO 50 K = M,1,-1 285 IF (B(K,J).NE.ZERO) THEN 286 IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) 287 DO 40 I = 1,K - 1 288 B(I,J) = B(I,J) - B(K,J)*A(I,K) 289 40 CONTINUE 290 END IF 291 50 CONTINUE 292 60 CONTINUE 293 ELSE 294 DO 100 J = 1,N 295 IF (ALPHA.NE.ONE) THEN 296 DO 70 I = 1,M 297 B(I,J) = ALPHA*B(I,J) 298 70 CONTINUE 299 END IF 300 DO 90 K = 1,M 301 IF (B(K,J).NE.ZERO) THEN 302 IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) 303 DO 80 I = K + 1,M 304 B(I,J) = B(I,J) - B(K,J)*A(I,K) 305 80 CONTINUE 306 END IF 307 90 CONTINUE 308 100 CONTINUE 309 END IF 310 ELSE 311* 312* Form B := alpha*inv( A**T )*B 313* or B := alpha*inv( A**H )*B. 314* 315 IF (UPPER) THEN 316 DO 140 J = 1,N 317 DO 130 I = 1,M 318 TEMP = ALPHA*B(I,J) 319 IF (NOCONJ) THEN 320 DO 110 K = 1,I - 1 321 TEMP = TEMP - A(K,I)*B(K,J) 322 110 CONTINUE 323 IF (NOUNIT) TEMP = TEMP/A(I,I) 324 ELSE 325 DO 120 K = 1,I - 1 326 TEMP = TEMP - DCONJG(A(K,I))*B(K,J) 327 120 CONTINUE 328 IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I)) 329 END IF 330 B(I,J) = TEMP 331 130 CONTINUE 332 140 CONTINUE 333 ELSE 334 DO 180 J = 1,N 335 DO 170 I = M,1,-1 336 TEMP = ALPHA*B(I,J) 337 IF (NOCONJ) THEN 338 DO 150 K = I + 1,M 339 TEMP = TEMP - A(K,I)*B(K,J) 340 150 CONTINUE 341 IF (NOUNIT) TEMP = TEMP/A(I,I) 342 ELSE 343 DO 160 K = I + 1,M 344 TEMP = TEMP - DCONJG(A(K,I))*B(K,J) 345 160 CONTINUE 346 IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I)) 347 END IF 348 B(I,J) = TEMP 349 170 CONTINUE 350 180 CONTINUE 351 END IF 352 END IF 353 ELSE 354 IF (LSAME(TRANSA,'N')) THEN 355* 356* Form B := alpha*B*inv( A ). 357* 358 IF (UPPER) THEN 359 DO 230 J = 1,N 360 IF (ALPHA.NE.ONE) THEN 361 DO 190 I = 1,M 362 B(I,J) = ALPHA*B(I,J) 363 190 CONTINUE 364 END IF 365 DO 210 K = 1,J - 1 366 IF (A(K,J).NE.ZERO) THEN 367 DO 200 I = 1,M 368 B(I,J) = B(I,J) - A(K,J)*B(I,K) 369 200 CONTINUE 370 END IF 371 210 CONTINUE 372 IF (NOUNIT) THEN 373 TEMP = ONE/A(J,J) 374 DO 220 I = 1,M 375 B(I,J) = TEMP*B(I,J) 376 220 CONTINUE 377 END IF 378 230 CONTINUE 379 ELSE 380 DO 280 J = N,1,-1 381 IF (ALPHA.NE.ONE) THEN 382 DO 240 I = 1,M 383 B(I,J) = ALPHA*B(I,J) 384 240 CONTINUE 385 END IF 386 DO 260 K = J + 1,N 387 IF (A(K,J).NE.ZERO) THEN 388 DO 250 I = 1,M 389 B(I,J) = B(I,J) - A(K,J)*B(I,K) 390 250 CONTINUE 391 END IF 392 260 CONTINUE 393 IF (NOUNIT) THEN 394 TEMP = ONE/A(J,J) 395 DO 270 I = 1,M 396 B(I,J) = TEMP*B(I,J) 397 270 CONTINUE 398 END IF 399 280 CONTINUE 400 END IF 401 ELSE 402* 403* Form B := alpha*B*inv( A**T ) 404* or B := alpha*B*inv( A**H ). 405* 406 IF (UPPER) THEN 407 DO 330 K = N,1,-1 408 IF (NOUNIT) THEN 409 IF (NOCONJ) THEN 410 TEMP = ONE/A(K,K) 411 ELSE 412 TEMP = ONE/DCONJG(A(K,K)) 413 END IF 414 DO 290 I = 1,M 415 B(I,K) = TEMP*B(I,K) 416 290 CONTINUE 417 END IF 418 DO 310 J = 1,K - 1 419 IF (A(J,K).NE.ZERO) THEN 420 IF (NOCONJ) THEN 421 TEMP = A(J,K) 422 ELSE 423 TEMP = DCONJG(A(J,K)) 424 END IF 425 DO 300 I = 1,M 426 B(I,J) = B(I,J) - TEMP*B(I,K) 427 300 CONTINUE 428 END IF 429 310 CONTINUE 430 IF (ALPHA.NE.ONE) THEN 431 DO 320 I = 1,M 432 B(I,K) = ALPHA*B(I,K) 433 320 CONTINUE 434 END IF 435 330 CONTINUE 436 ELSE 437 DO 380 K = 1,N 438 IF (NOUNIT) THEN 439 IF (NOCONJ) THEN 440 TEMP = ONE/A(K,K) 441 ELSE 442 TEMP = ONE/DCONJG(A(K,K)) 443 END IF 444 DO 340 I = 1,M 445 B(I,K) = TEMP*B(I,K) 446 340 CONTINUE 447 END IF 448 DO 360 J = K + 1,N 449 IF (A(J,K).NE.ZERO) THEN 450 IF (NOCONJ) THEN 451 TEMP = A(J,K) 452 ELSE 453 TEMP = DCONJG(A(J,K)) 454 END IF 455 DO 350 I = 1,M 456 B(I,J) = B(I,J) - TEMP*B(I,K) 457 350 CONTINUE 458 END IF 459 360 CONTINUE 460 IF (ALPHA.NE.ONE) THEN 461 DO 370 I = 1,M 462 B(I,K) = ALPHA*B(I,K) 463 370 CONTINUE 464 END IF 465 380 CONTINUE 466 END IF 467 END IF 468 END IF 469* 470 RETURN 471* 472* End of ZTRSM 473* 474 END 475