summaryrefslogtreecommitdiff
path: root/src/lib/blas/ztrmm.f
diff options
context:
space:
mode:
authorjofret2009-04-28 07:17:27 +0000
committerjofret2009-04-28 07:17:27 +0000
commitb4291825aaa210d693f4f858e1c8c25f514a3f71 (patch)
tree4ba928deac68d7098a7043cd286acb23351825d8 /src/lib/blas/ztrmm.f
parent8c8d2f518968ce7057eec6aa5cd5aec8faab861a (diff)
downloadscilab2c-b4291825aaa210d693f4f858e1c8c25f514a3f71.tar.gz
scilab2c-b4291825aaa210d693f4f858e1c8c25f514a3f71.tar.bz2
scilab2c-b4291825aaa210d693f4f858e1c8c25f514a3f71.zip
Moving blas to right place
Diffstat (limited to 'src/lib/blas/ztrmm.f')
-rw-r--r--src/lib/blas/ztrmm.f392
1 files changed, 0 insertions, 392 deletions
diff --git a/src/lib/blas/ztrmm.f b/src/lib/blas/ztrmm.f
deleted file mode 100644
index 30910d1d..00000000
--- a/src/lib/blas/ztrmm.f
+++ /dev/null
@@ -1,392 +0,0 @@
- SUBROUTINE ZTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
- $ B, LDB )
-* .. Scalar Arguments ..
- CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
- INTEGER M, N, LDA, LDB
- COMPLEX*16 ALPHA
-* .. Array Arguments ..
- COMPLEX*16 A( LDA, * ), B( LDB, * )
-* ..
-*
-* Purpose
-* =======
-*
-* ZTRMM 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' or op( A ) = conjg( 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 ) = conjg( 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 - 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.
-* Unchanged on exit.
-*
-* A - COMPLEX*16 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 - COMPLEX*16 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 DCONJG, MAX
-* .. Local Scalars ..
- LOGICAL LSIDE, NOCONJ, NOUNIT, UPPER
- INTEGER I, INFO, J, K, NROWA
- COMPLEX*16 TEMP
-* .. Parameters ..
- COMPLEX*16 ONE
- PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
- COMPLEX*16 ZERO
- PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
-* ..
-* .. Executable Statements ..
-*
-* 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( 'ZTRMM ', 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*A'*B or B := alpha*conjg( A' )*B.
-*
- IF( UPPER )THEN
- DO 120, J = 1, N
- DO 110, I = M, 1, -1
- TEMP = B( I, J )
- IF( NOCONJ )THEN
- IF( NOUNIT )
- $ TEMP = TEMP*A( I, I )
- DO 90, K = 1, I - 1
- TEMP = TEMP + A( K, I )*B( K, J )
- 90 CONTINUE
- ELSE
- IF( NOUNIT )
- $ TEMP = TEMP*DCONJG( A( I, I ) )
- DO 100, K = 1, I - 1
- TEMP = TEMP + DCONJG( A( K, I ) )*B( K, J )
- 100 CONTINUE
- END IF
- B( I, J ) = ALPHA*TEMP
- 110 CONTINUE
- 120 CONTINUE
- ELSE
- DO 160, J = 1, N
- DO 150, I = 1, M
- TEMP = B( I, J )
- IF( NOCONJ )THEN
- IF( NOUNIT )
- $ TEMP = TEMP*A( I, I )
- DO 130, K = I + 1, M
- TEMP = TEMP + A( K, I )*B( K, J )
- 130 CONTINUE
- ELSE
- IF( NOUNIT )
- $ TEMP = TEMP*DCONJG( A( I, I ) )
- DO 140, K = I + 1, M
- TEMP = TEMP + DCONJG( A( K, I ) )*B( K, J )
- 140 CONTINUE
- END IF
- B( I, J ) = ALPHA*TEMP
- 150 CONTINUE
- 160 CONTINUE
- END IF
- END IF
- ELSE
- IF( LSAME( TRANSA, 'N' ) )THEN
-*
-* Form B := alpha*B*A.
-*
- IF( UPPER )THEN
- DO 200, J = N, 1, -1
- TEMP = ALPHA
- IF( NOUNIT )
- $ TEMP = TEMP*A( J, J )
- DO 170, I = 1, M
- B( I, J ) = TEMP*B( I, J )
- 170 CONTINUE
- DO 190, K = 1, J - 1
- IF( A( K, J ).NE.ZERO )THEN
- TEMP = ALPHA*A( K, J )
- DO 180, I = 1, M
- B( I, J ) = B( I, J ) + TEMP*B( I, K )
- 180 CONTINUE
- END IF
- 190 CONTINUE
- 200 CONTINUE
- ELSE
- DO 240, J = 1, N
- TEMP = ALPHA
- IF( NOUNIT )
- $ TEMP = TEMP*A( J, J )
- DO 210, I = 1, M
- B( I, J ) = TEMP*B( I, J )
- 210 CONTINUE
- DO 230, K = J + 1, N
- IF( A( K, J ).NE.ZERO )THEN
- TEMP = ALPHA*A( K, J )
- DO 220, I = 1, M
- B( I, J ) = B( I, J ) + TEMP*B( I, K )
- 220 CONTINUE
- END IF
- 230 CONTINUE
- 240 CONTINUE
- END IF
- ELSE
-*
-* Form B := alpha*B*A' or B := alpha*B*conjg( A' ).
-*
- IF( UPPER )THEN
- DO 280, K = 1, N
- DO 260, J = 1, K - 1
- IF( A( J, K ).NE.ZERO )THEN
- IF( NOCONJ )THEN
- TEMP = ALPHA*A( J, K )
- ELSE
- TEMP = ALPHA*DCONJG( A( J, K ) )
- END IF
- DO 250, I = 1, M
- B( I, J ) = B( I, J ) + TEMP*B( I, K )
- 250 CONTINUE
- END IF
- 260 CONTINUE
- TEMP = ALPHA
- IF( NOUNIT )THEN
- IF( NOCONJ )THEN
- TEMP = TEMP*A( K, K )
- ELSE
- TEMP = TEMP*DCONJG( A( K, K ) )
- END IF
- END IF
- IF( TEMP.NE.ONE )THEN
- DO 270, I = 1, M
- B( I, K ) = TEMP*B( I, K )
- 270 CONTINUE
- END IF
- 280 CONTINUE
- ELSE
- DO 320, K = N, 1, -1
- DO 300, J = K + 1, N
- IF( A( J, K ).NE.ZERO )THEN
- IF( NOCONJ )THEN
- TEMP = ALPHA*A( J, K )
- ELSE
- TEMP = ALPHA*DCONJG( A( J, K ) )
- END IF
- DO 290, I = 1, M
- B( I, J ) = B( I, J ) + TEMP*B( I, K )
- 290 CONTINUE
- END IF
- 300 CONTINUE
- TEMP = ALPHA
- IF( NOUNIT )THEN
- IF( NOCONJ )THEN
- TEMP = TEMP*A( K, K )
- ELSE
- TEMP = TEMP*DCONJG( A( K, K ) )
- END IF
- END IF
- IF( TEMP.NE.ONE )THEN
- DO 310, I = 1, M
- B( I, K ) = TEMP*B( I, K )
- 310 CONTINUE
- END IF
- 320 CONTINUE
- END IF
- END IF
- END IF
-*
- RETURN
-*
-* End of ZTRMM .
-*
- END