Numérotation des lignes :

C DTRMM     SOURCE    BP208322  15/10/13    21:16:01     8670      SUBROUTINE DTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,     $B, LDB )* .. Scalar Arguments .. CHARACTER*1 SIDE, UPLO, TRANSA, DIAG INTEGER M, N, LDA, LDB REAL*8 ALPHA* .. Array Arguments .. REAL*8 A( LDA, * ), B( LDB, * )* ..** Purpose* =======** DTRMM performs one of the matrix-matrix operations** B := alpha*op( A )*B, or B := alpha*B*op( A ),** where alpha is a scalar, B is an m by n matrix, 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'.** Parameters* ==========** SIDE - CHARACTER*1.* On entry, SIDE specifies whether op( A ) multiplies B from* the left or right as follows:** SIDE = 'L' or 'l' B := alpha*op( A )*B.** SIDE = 'R' or 'r' B := alpha*B*op( A ).** Unchanged on exit.** UPLO - 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.** Unchanged on exit.** TRANSA - 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'.** TRANSA = 'C' or 'c' op( A ) = A'.** Unchanged on exit.** DIAG - 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.** Unchanged on exit.** M - INTEGER.* On entry, M specifies the number of rows of B. M must be at* least zero.* Unchanged on exit.** N - INTEGER.* On entry, N specifies the number of columns of B. N must be* at least zero.* Unchanged on exit.** ALPHA - DOUBLE PRECISION.* On entry, ALPHA specifies the scalar alpha. When alpha is* zero then A is not referenced and B need not be set before* entry.* Unchanged on exit.** A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m* when SIDE = 'L' or 'l' and 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.* Unchanged on exit.** LDA - 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 ).* Unchanged on exit.** B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).* Before entry, the leading m by n part of the array B must* contain the matrix B, and on exit is overwritten by the* transformed matrix.** LDB - 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 ).* Unchanged on exit.*** 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.*** .. External Functions .. LOGICAL LSAME EXTERNAL LSAME* .. External Subroutines .. EXTERNAL XERBLA** .. Intrinsic Functions ..* INTRINSIC MAX** .. Local Scalars .. LOGICAL LSIDE, NOUNIT, UPPER INTEGER I, INFO, J, K, NROWA REAL*8 TEMP** .. Parameters .. REAL*8 ONE , ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )** ..** .. Executable Statements ..** Test the input parameters.* LSIDE = LSAME( SIDE , 'L' ) IF( LSIDE )THEN NROWA = M ELSE NROWA = N END IF 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( 'DTRMM ', INFO )         RETURN      END IF**     Quick return if possible.*      IF( 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*A*B.* 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** Form B := alpha*B*A'.* 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** Form B := alpha*B*A.* 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** Form B := alpha*B*A'.* 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*      RETURN**     End of DTRMM .*      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales