*> \brief \b ZTRSM * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * * Definition: * =========== * * SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * * .. Scalar Arguments .. * COMPLEX*16 ALPHA * INTEGER LDA,LDB,M,N * CHARACTER DIAG,SIDE,TRANSA,UPLO * .. * .. Array Arguments .. * COMPLEX*16 A(LDA,*),B(LDB,*) * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> ZTRSM solves one of the matrix equations *> *> op( A )*X = alpha*B, or X*op( A ) = alpha*B, *> *> where alpha is a scalar, X and B are m by n matrices, A is a unit, or *> non-unit, upper or lower triangular matrix and op( A ) is one of *> *> op( A ) = A or op( A ) = A**T or op( A ) = A**H. *> *> The matrix X is overwritten on B. *> \endverbatim * * Arguments: * ========== * *> \param[in] SIDE *> \verbatim *> SIDE is CHARACTER*1 *> On entry, SIDE specifies whether op( A ) appears on the left *> or right of X as follows: *> *> SIDE = 'L' or 'l' op( A )*X = alpha*B. *> *> SIDE = 'R' or 'r' X*op( A ) = alpha*B. *> \endverbatim *> *> \param[in] UPLO *> \verbatim *> UPLO is CHARACTER*1 *> On entry, UPLO specifies whether the matrix A is an upper or *> lower triangular matrix as follows: *> *> UPLO = 'U' or 'u' A is an upper triangular matrix. *> *> UPLO = 'L' or 'l' A is a lower triangular matrix. *> \endverbatim *> *> \param[in] TRANSA *> \verbatim *> TRANSA is CHARACTER*1 *> On entry, TRANSA specifies the form of op( A ) to be used in *> the matrix multiplication as follows: *> *> TRANSA = 'N' or 'n' op( A ) = A. *> *> TRANSA = 'T' or 't' op( A ) = A**T. *> *> TRANSA = 'C' or 'c' op( A ) = A**H. *> \endverbatim *> *> \param[in] DIAG *> \verbatim *> DIAG is CHARACTER*1 *> On entry, DIAG specifies whether or not A is unit triangular *> as follows: *> *> DIAG = 'U' or 'u' A is assumed to be unit triangular. *> *> DIAG = 'N' or 'n' A is not assumed to be unit *> triangular. *> \endverbatim *> *> \param[in] M *> \verbatim *> M is INTEGER *> On entry, M specifies the number of rows of B. M must be at *> least zero. *> \endverbatim *> *> \param[in] N *> \verbatim *> N is INTEGER *> On entry, N specifies the number of columns of B. N must be *> at least zero. *> \endverbatim *> *> \param[in] ALPHA *> \verbatim *> ALPHA is COMPLEX*16 *> On entry, ALPHA specifies the scalar alpha. When alpha is *> zero then A is not referenced and B need not be set before *> entry. *> \endverbatim *> *> \param[in] A *> \verbatim *> A is COMPLEX*16 array, dimension ( LDA, k ), *> where k is m when SIDE = 'L' or 'l' *> and k is n when SIDE = 'R' or 'r'. *> Before entry with UPLO = 'U' or 'u', the leading k by k *> upper triangular part of the array A must contain the upper *> triangular matrix and the strictly lower triangular part of *> A is not referenced. *> Before entry with UPLO = 'L' or 'l', the leading k by k *> lower triangular part of the array A must contain the lower *> triangular matrix and the strictly upper triangular part of *> A is not referenced. *> Note that when DIAG = 'U' or 'u', the diagonal elements of *> A are not referenced either, but are assumed to be unity. *> \endverbatim *> *> \param[in] LDA *> \verbatim *> LDA is INTEGER *> On entry, LDA specifies the first dimension of A as declared *> in the calling (sub) program. When SIDE = 'L' or 'l' then *> LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' *> then LDA must be at least max( 1, n ). *> \endverbatim *> *> \param[in,out] B *> \verbatim *> B is COMPLEX*16 array, dimension ( LDB, N ) *> Before entry, the leading m by n part of the array B must *> contain the right-hand side matrix B, and on exit is *> overwritten by the solution matrix X. *> \endverbatim *> *> \param[in] LDB *> \verbatim *> LDB is INTEGER *> On entry, LDB specifies the first dimension of B as declared *> in the calling (sub) program. LDB must be at least *> max( 1, m ). *> \endverbatim * * Authors: * ======== * *> \author Univ. of Tennessee *> \author Univ. of California Berkeley *> \author Univ. of Colorado Denver *> \author NAG Ltd. * *> \ingroup complex16_blas_level3 * *> \par Further Details: * ===================== *> *> \verbatim *> *> Level 3 Blas routine. *> *> -- Written on 8-February-1989. *> Jack Dongarra, Argonne National Laboratory. *> Iain Duff, AERE Harwell. *> Jeremy Du Croz, Numerical Algorithms Group Ltd. *> Sven Hammarling, Numerical Algorithms Group Ltd. *> \endverbatim *> * ===================================================================== SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB) * * -- Reference BLAS level3 routine -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. COMPLEX*16 ALPHA INTEGER LDA,LDB,M,N CHARACTER DIAG,SIDE,TRANSA,UPLO * .. * .. Array Arguments .. COMPLEX*16 A(LDA,*),B(LDB,*) * .. * * ===================================================================== * * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. EXTERNAL XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DCONJG,MAX * .. * .. Local Scalars .. COMPLEX*16 TEMP INTEGER I,INFO,J,K,NROWA LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER * .. * .. Parameters .. COMPLEX*16 ONE PARAMETER (ONE= (1.0D+0,0.0D+0)) COMPLEX*16 ZERO PARAMETER (ZERO= (0.0D+0,0.0D+0)) * .. * * Test the input parameters. * LSIDE = LSAME(SIDE,'L') IF (LSIDE) THEN NROWA = M ELSE NROWA = N END IF NOCONJ = LSAME(TRANSA,'T') NOUNIT = LSAME(DIAG,'N') UPPER = LSAME(UPLO,'U') * INFO = 0 IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN INFO = 1 ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN INFO = 2 ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND. + (.NOT.LSAME(TRANSA,'T')) .AND. + (.NOT.LSAME(TRANSA,'C'))) THEN INFO = 3 ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN INFO = 4 ELSE IF (M.LT.0) THEN INFO = 5 ELSE IF (N.LT.0) THEN INFO = 6 ELSE IF (LDA.LT.MAX(1,NROWA)) THEN INFO = 9 ELSE IF (LDB.LT.MAX(1,M)) THEN INFO = 11 END IF IF (INFO.NE.0) THEN CALL XERBLA('ZTRSM ',INFO) RETURN END IF * * Quick return if possible. * IF (M.EQ.0 .OR. N.EQ.0) RETURN * * And when alpha.eq.zero. * IF (ALPHA.EQ.ZERO) THEN DO 20 J = 1,N DO 10 I = 1,M B(I,J) = ZERO 10 CONTINUE 20 CONTINUE RETURN END IF * * Start the operations. * IF (LSIDE) THEN IF (LSAME(TRANSA,'N')) THEN * * Form B := alpha*inv( A )*B. * IF (UPPER) THEN DO 60 J = 1,N IF (ALPHA.NE.ONE) THEN DO 30 I = 1,M B(I,J) = ALPHA*B(I,J) 30 CONTINUE END IF DO 50 K = M,1,-1 IF (B(K,J).NE.ZERO) THEN IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) DO 40 I = 1,K - 1 B(I,J) = B(I,J) - B(K,J)*A(I,K) 40 CONTINUE END IF 50 CONTINUE 60 CONTINUE ELSE DO 100 J = 1,N IF (ALPHA.NE.ONE) THEN DO 70 I = 1,M B(I,J) = ALPHA*B(I,J) 70 CONTINUE END IF DO 90 K = 1,M IF (B(K,J).NE.ZERO) THEN IF (NOUNIT) B(K,J) = B(K,J)/A(K,K) DO 80 I = K + 1,M B(I,J) = B(I,J) - B(K,J)*A(I,K) 80 CONTINUE END IF 90 CONTINUE 100 CONTINUE END IF ELSE * * Form B := alpha*inv( A**T )*B * or B := alpha*inv( A**H )*B. * IF (UPPER) THEN DO 140 J = 1,N DO 130 I = 1,M TEMP = ALPHA*B(I,J) IF (NOCONJ) THEN DO 110 K = 1,I - 1 TEMP = TEMP - A(K,I)*B(K,J) 110 CONTINUE IF (NOUNIT) TEMP = TEMP/A(I,I) ELSE DO 120 K = 1,I - 1 TEMP = TEMP - DCONJG(A(K,I))*B(K,J) 120 CONTINUE IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I)) END IF B(I,J) = TEMP 130 CONTINUE 140 CONTINUE ELSE DO 180 J = 1,N DO 170 I = M,1,-1 TEMP = ALPHA*B(I,J) IF (NOCONJ) THEN DO 150 K = I + 1,M TEMP = TEMP - A(K,I)*B(K,J) 150 CONTINUE IF (NOUNIT) TEMP = TEMP/A(I,I) ELSE DO 160 K = I + 1,M TEMP = TEMP - DCONJG(A(K,I))*B(K,J) 160 CONTINUE IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I)) END IF B(I,J) = TEMP 170 CONTINUE 180 CONTINUE END IF END IF ELSE IF (LSAME(TRANSA,'N')) THEN * * Form B := alpha*B*inv( A ). * IF (UPPER) THEN DO 230 J = 1,N IF (ALPHA.NE.ONE) THEN DO 190 I = 1,M B(I,J) = ALPHA*B(I,J) 190 CONTINUE END IF DO 210 K = 1,J - 1 IF (A(K,J).NE.ZERO) THEN DO 200 I = 1,M B(I,J) = B(I,J) - A(K,J)*B(I,K) 200 CONTINUE END IF 210 CONTINUE IF (NOUNIT) THEN TEMP = ONE/A(J,J) DO 220 I = 1,M B(I,J) = TEMP*B(I,J) 220 CONTINUE END IF 230 CONTINUE ELSE DO 280 J = N,1,-1 IF (ALPHA.NE.ONE) THEN DO 240 I = 1,M B(I,J) = ALPHA*B(I,J) 240 CONTINUE END IF DO 260 K = J + 1,N IF (A(K,J).NE.ZERO) THEN DO 250 I = 1,M B(I,J) = B(I,J) - A(K,J)*B(I,K) 250 CONTINUE END IF 260 CONTINUE IF (NOUNIT) THEN TEMP = ONE/A(J,J) DO 270 I = 1,M B(I,J) = TEMP*B(I,J) 270 CONTINUE END IF 280 CONTINUE END IF ELSE * * Form B := alpha*B*inv( A**T ) * or B := alpha*B*inv( A**H ). * IF (UPPER) THEN DO 330 K = N,1,-1 IF (NOUNIT) THEN IF (NOCONJ) THEN TEMP = ONE/A(K,K) ELSE TEMP = ONE/DCONJG(A(K,K)) END IF DO 290 I = 1,M B(I,K) = TEMP*B(I,K) 290 CONTINUE END IF DO 310 J = 1,K - 1 IF (A(J,K).NE.ZERO) THEN IF (NOCONJ) THEN TEMP = A(J,K) ELSE TEMP = DCONJG(A(J,K)) END IF DO 300 I = 1,M B(I,J) = B(I,J) - TEMP*B(I,K) 300 CONTINUE END IF 310 CONTINUE IF (ALPHA.NE.ONE) THEN DO 320 I = 1,M B(I,K) = ALPHA*B(I,K) 320 CONTINUE END IF 330 CONTINUE ELSE DO 380 K = 1,N IF (NOUNIT) THEN IF (NOCONJ) THEN TEMP = ONE/A(K,K) ELSE TEMP = ONE/DCONJG(A(K,K)) END IF DO 340 I = 1,M B(I,K) = TEMP*B(I,K) 340 CONTINUE END IF DO 360 J = K + 1,N IF (A(J,K).NE.ZERO) THEN IF (NOCONJ) THEN TEMP = A(J,K) ELSE TEMP = DCONJG(A(J,K)) END IF DO 350 I = 1,M B(I,J) = B(I,J) - TEMP*B(I,K) 350 CONTINUE END IF 360 CONTINUE IF (ALPHA.NE.ONE) THEN DO 370 I = 1,M B(I,K) = ALPHA*B(I,K) 370 CONTINUE END IF 380 CONTINUE END IF END IF END IF * RETURN * * End of ZTRSM * END