*DECK DTRMM SUBROUTINE DTRMM (SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, \$ B, LDB) C***BEGIN PROLOGUE DTRMM C***PURPOSE Perform one of the matrix-matrix operations. C***LIBRARY SLATEC (BLAS) C***CATEGORY D1B6 C***TYPE DOUBLE PRECISION (STRMM-S, DTRMM-D, CTRMM-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 DTRMM performs one of the matrix-matrix operations C C B := alpha*op( A )*B, or B := alpha*B*op( A ), C C where alpha is a scalar, B is an m by n matrix, 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'. C C Parameters C ========== C C SIDE - CHARACTER*1. C On entry, SIDE specifies whether op( A ) multiplies B from C the left or right as follows: C C SIDE = 'L' or 'l' B := alpha*op( A )*B. C C SIDE = 'R' or 'r' B := alpha*B*op( A ). 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 ) = 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 - DOUBLE PRECISION. 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 - DOUBLE PRECISION 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 - DOUBLE PRECISION array of DIMENSION ( LDB, n ). C Before entry, the leading m by n part of the array B must C contain the matrix B, and on exit is overwritten by the C transformed matrix. 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 DTRMM C .. Scalar Arguments .. CHARACTER*1 SIDE, UPLO, TRANSA, DIAG INTEGER M, N, LDA, LDB DOUBLE PRECISION ALPHA C .. Array Arguments .. DOUBLE PRECISION A( LDA, * ), B( LDB, * ) C .. External Functions .. LOGICAL LSAME EXTERNAL LSAME C .. External Subroutines .. EXTERNAL XERBLA C .. Intrinsic Functions .. INTRINSIC MAX C .. Local Scalars .. LOGICAL LSIDE, NOUNIT, UPPER INTEGER I, INFO, J, K, NROWA DOUBLE PRECISION TEMP C .. Parameters .. DOUBLE PRECISION ONE , ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) C***FIRST EXECUTABLE STATEMENT DTRMM C C Test the input parameters. C LSIDE = LSAME( SIDE , 'L' ) IF( LSIDE )THEN NROWA = M ELSE NROWA = N END IF 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( 'DTRMM ', 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*A*B. C IF( UPPER )THEN DO 50, J = 1, N DO 40, K = 1, M IF( B( K, J ).NE.ZERO )THEN TEMP = ALPHA*B( K, J ) DO 30, I = 1, K - 1 B( I, J ) = B( I, J ) + TEMP*A( I, K ) 30 CONTINUE IF( NOUNIT ) \$ TEMP = TEMP*A( K, K ) B( K, J ) = TEMP END IF 40 CONTINUE 50 CONTINUE ELSE DO 80, J = 1, N DO 70 K = M, 1, -1 IF( B( K, J ).NE.ZERO )THEN TEMP = ALPHA*B( K, J ) B( K, J ) = TEMP IF( NOUNIT ) \$ B( K, J ) = B( K, J )*A( K, K ) DO 60, I = K + 1, M B( I, J ) = B( I, J ) + TEMP*A( I, K ) 60 CONTINUE END IF 70 CONTINUE 80 CONTINUE END IF ELSE C C Form B := alpha*B*A'. C IF( UPPER )THEN DO 110, J = 1, N DO 100, I = M, 1, -1 TEMP = B( I, J ) IF( NOUNIT ) \$ TEMP = TEMP*A( I, I ) DO 90, K = 1, I - 1 TEMP = TEMP + A( K, I )*B( K, J ) 90 CONTINUE B( I, J ) = ALPHA*TEMP 100 CONTINUE 110 CONTINUE ELSE DO 140, J = 1, N DO 130, I = 1, M TEMP = B( I, J ) IF( NOUNIT ) \$ TEMP = TEMP*A( I, I ) DO 120, K = I + 1, M TEMP = TEMP + A( K, I )*B( K, J ) 120 CONTINUE B( I, J ) = ALPHA*TEMP 130 CONTINUE 140 CONTINUE END IF END IF ELSE IF( LSAME( TRANSA, 'N' ) )THEN C C Form B := alpha*B*A. C IF( UPPER )THEN DO 180, J = N, 1, -1 TEMP = ALPHA IF( NOUNIT ) \$ TEMP = TEMP*A( J, J ) DO 150, I = 1, M B( I, J ) = TEMP*B( I, J ) 150 CONTINUE DO 170, K = 1, J - 1 IF( A( K, J ).NE.ZERO )THEN TEMP = ALPHA*A( K, J ) DO 160, I = 1, M B( I, J ) = B( I, J ) + TEMP*B( I, K ) 160 CONTINUE END IF 170 CONTINUE 180 CONTINUE ELSE DO 220, J = 1, N TEMP = ALPHA IF( NOUNIT ) \$ TEMP = TEMP*A( J, J ) DO 190, I = 1, M B( I, J ) = TEMP*B( I, J ) 190 CONTINUE DO 210, K = J + 1, N IF( A( K, J ).NE.ZERO )THEN TEMP = ALPHA*A( K, J ) DO 200, I = 1, M B( I, J ) = B( I, J ) + TEMP*B( I, K ) 200 CONTINUE END IF 210 CONTINUE 220 CONTINUE END IF ELSE C C Form B := alpha*B*A'. C IF( UPPER )THEN DO 260, K = 1, N DO 240, J = 1, K - 1 IF( A( J, K ).NE.ZERO )THEN TEMP = ALPHA*A( J, K ) DO 230, I = 1, M B( I, J ) = B( I, J ) + TEMP*B( I, K ) 230 CONTINUE END IF 240 CONTINUE TEMP = ALPHA IF( NOUNIT ) \$ TEMP = TEMP*A( K, K ) IF( TEMP.NE.ONE )THEN DO 250, I = 1, M B( I, K ) = TEMP*B( I, K ) 250 CONTINUE END IF 260 CONTINUE ELSE DO 300, K = N, 1, -1 DO 280, J = K + 1, N IF( A( J, K ).NE.ZERO )THEN TEMP = ALPHA*A( J, K ) DO 270, I = 1, M B( I, J ) = B( I, J ) + TEMP*B( I, K ) 270 CONTINUE END IF 280 CONTINUE TEMP = ALPHA IF( NOUNIT ) \$ TEMP = TEMP*A( K, K ) IF( TEMP.NE.ONE )THEN DO 290, I = 1, M B( I, K ) = TEMP*B( I, K ) 290 CONTINUE END IF 300 CONTINUE END IF END IF END IF C RETURN C C End of DTRMM . C END