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