*DECK CTRSM SUBROUTINE CTRSM (SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, \$ B, LDB) C***BEGIN PROLOGUE CTRSM C***PURPOSE Solve a complex triangular system of equations with C multiple right-hand sides. C***LIBRARY SLATEC (BLAS) C***CATEGORY D1B6 C***TYPE COMPLEX (STRSM-S, DTRSM-D, CTRSM-C) C***KEYWORDS LEVEL 3 BLAS, LINEAR ALGEBRA C***AUTHOR Dongarra, J., (ANL) C Duff, I., (AERE) C Du Croz, J., (NAG) C Hammarling, S. (NAG) C***DESCRIPTION C C CTRSM solves one of the matrix equations C C op( A )*X = alpha*B, or X*op( A ) = alpha*B, C C where alpha is a scalar, X and B are m by n matrices, A is a unit, or C non-unit, upper or lower triangular matrix and op( A ) is one of C C op( A ) = A or op( A ) = A' or op( A ) = conjg( A' ). C C The matrix X is overwritten on B. C C Parameters C ========== C C SIDE - CHARACTER*1. C On entry, SIDE specifies whether op( A ) appears on the left C or right of X as follows: C C SIDE = 'L' or 'l' op( A )*X = alpha*B. C C SIDE = 'R' or 'r' X*op( A ) = alpha*B. C C Unchanged on exit. C C UPLO - CHARACTER*1. C On entry, UPLO specifies whether the matrix A is an upper or C lower triangular matrix as follows: C C UPLO = 'U' or 'u' A is an upper triangular matrix. C C UPLO = 'L' or 'l' A is a lower triangular matrix. C C Unchanged on exit. C C TRANSA - CHARACTER*1. C On entry, TRANSA specifies the form of op( A ) to be used in C the matrix multiplication as follows: C C TRANSA = 'N' or 'n' op( A ) = A. C C TRANSA = 'T' or 't' op( A ) = A'. C C TRANSA = 'C' or 'c' op( A ) = conjg( A' ). C C Unchanged on exit. C C DIAG - CHARACTER*1. C On entry, DIAG specifies whether or not A is unit triangular C as follows: C C DIAG = 'U' or 'u' A is assumed to be unit triangular. C C DIAG = 'N' or 'n' A is not assumed to be unit C triangular. C C Unchanged on exit. C C M - INTEGER. C On entry, M specifies the number of rows of B. M must be at C least zero. C Unchanged on exit. C C N - INTEGER. C On entry, N specifies the number of columns of B. N must be C at least zero. C Unchanged on exit. C C ALPHA - COMPLEX . C On entry, ALPHA specifies the scalar alpha. When alpha is C zero then A is not referenced and B need not be set before C entry. C Unchanged on exit. C C A - COMPLEX array of DIMENSION ( LDA, k ), where k is m C when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. C Before entry with UPLO = 'U' or 'u', the leading k by k C upper triangular part of the array A must contain the upper C triangular matrix and the strictly lower triangular part of C A is not referenced. C Before entry with UPLO = 'L' or 'l', the leading k by k C lower triangular part of the array A must contain the lower C triangular matrix and the strictly upper triangular part of C A is not referenced. C Note that when DIAG = 'U' or 'u', the diagonal elements of C A are not referenced either, but are assumed to be unity. C Unchanged on exit. C C LDA - INTEGER. C On entry, LDA specifies the first dimension of A as declared C in the calling (sub) program. When SIDE = 'L' or 'l' then C LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' C then LDA must be at least max( 1, n ). C Unchanged on exit. C C B - COMPLEX array of DIMENSION ( LDB, n ). C Before entry, the leading m by n part of the array B must C contain the right-hand side matrix B, and on exit is C overwritten by the solution matrix X. C C LDB - INTEGER. C On entry, LDB specifies the first dimension of B as declared C in the calling (sub) program. LDB must be at least C max( 1, m ). C Unchanged on exit. C C***REFERENCES Dongarra, J., Du Croz, J., Duff, I., and Hammarling, S. C A set of level 3 basic linear algebra subprograms. C ACM TOMS, Vol. 16, No. 1, pp. 1-17, March 1990. C***ROUTINES CALLED LSAME, XERBLA C***REVISION HISTORY (YYMMDD) C 890208 DATE WRITTEN C 910605 Modified to meet SLATEC prologue standards. Only comment C lines were modified. (BKS) C***END PROLOGUE CTRSM C .. Scalar Arguments .. CHARACTER*1 SIDE, UPLO, TRANSA, DIAG INTEGER M, N, LDA, LDB COMPLEX ALPHA C .. Array Arguments .. COMPLEX A( LDA, * ), B( LDB, * ) C .. External Functions .. LOGICAL LSAME EXTERNAL LSAME C .. External Subroutines .. EXTERNAL XERBLA C .. Intrinsic Functions .. INTRINSIC CONJG, MAX C .. Local Scalars .. LOGICAL LSIDE, NOCONJ, NOUNIT, UPPER INTEGER I, INFO, J, K, NROWA COMPLEX TEMP C .. Parameters .. COMPLEX ONE PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) COMPLEX ZERO PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) ) C***FIRST EXECUTABLE STATEMENT CTRSM C C Test the input parameters. C 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' ) C 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( 'CTRSM ', INFO ) RETURN END IF C C Quick return if possible. C IF( N.EQ.0 ) \$ RETURN C C And when alpha.eq.zero. C 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 C C Start the operations. C IF( LSIDE )THEN IF( LSAME( TRANSA, 'N' ) )THEN C C Form B := alpha*inv( A )*B. C 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 C C Form B := alpha*inv( A' )*B C or B := alpha*inv( conjg( A' ) )*B. C 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 - CONJG( A( K, I ) )*B( K, J ) 120 CONTINUE IF( NOUNIT ) \$ TEMP = TEMP/CONJG( 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 - CONJG( A( K, I ) )*B( K, J ) 160 CONTINUE IF( NOUNIT ) \$ TEMP = TEMP/CONJG( A( I, I ) ) END IF B( I, J ) = TEMP 170 CONTINUE 180 CONTINUE END IF END IF ELSE IF( LSAME( TRANSA, 'N' ) )THEN C C Form B := alpha*B*inv( A ). C 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 C C Form B := alpha*B*inv( A' ) C or B := alpha*B*inv( conjg( A' ) ). C IF( UPPER )THEN DO 330, K = N, 1, -1 IF( NOUNIT )THEN IF( NOCONJ )THEN TEMP = ONE/A( K, K ) ELSE TEMP = ONE/CONJG( 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 = CONJG( 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/CONJG( 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 = CONJG( 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 C RETURN C C End of CTRSM . C END