#include "ESMF_LapackBlas.inc" !> \brief \b DTRMV ! ! =========== DOCUMENTATION =========== ! ! Online html documentation available at ! http://www.netlib.org/lapack/explore-html/ ! ! Definition: ! =========== ! ! SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) ! ! .. Scalar Arguments .. ! INTEGER INCX,LDA,N ! CHARACTER DIAG,TRANS,UPLO ! .. ! .. Array Arguments .. ! DOUBLE PRECISION A(LDA,*),X(*) ! .. ! ! !> \par Purpose: ! ============= !> !> \verbatim !> !> DTRMV performs one of the matrix-vector operations !> !> x := A*x, or x := A**T*x, !> !> where x is an n element vector and A is an n by n unit, or non-unit, !> upper or lower triangular matrix. !> \endverbatim ! ! Arguments: ! ========== ! !> \param[in] UPLO !> \verbatim !> UPLO is CHARACTER*1 !> On entry, UPLO specifies whether the matrix 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] TRANS !> \verbatim !> TRANS is CHARACTER*1 !> On entry, TRANS specifies the operation to be performed as !> follows: !> !> TRANS = 'N' or 'n' x := A*x. !> !> TRANS = 'T' or 't' x := A**T*x. !> !> TRANS = 'C' or 'c' x := A**T*x. !> \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] N !> \verbatim !> N is INTEGER !> On entry, N specifies the order of the matrix A. !> N must be at least zero. !> \endverbatim !> !> \param[in] A !> \verbatim !> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ). !> Before entry with UPLO = 'U' or 'u', the leading n by n !> 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 n by n !> 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. LDA must be at least !> max( 1, n ). !> \endverbatim !> !> \param[in,out] X !> \verbatim !> X is DOUBLE PRECISION array of dimension at least !> ( 1 + ( n - 1 )*abs( INCX ) ). !> Before entry, the incremented array X must contain the n !> element vector x. On exit, X is overwritten with the !> tranformed vector x. !> \endverbatim !> !> \param[in] INCX !> \verbatim !> INCX is INTEGER !> On entry, INCX specifies the increment for the elements of !> X. INCX must not be zero. !> \endverbatim ! ! Authors: ! ======== ! !> \author Univ. of Tennessee !> \author Univ. of California Berkeley !> \author Univ. of Colorado Denver !> \author NAG Ltd. ! !> \date November 2011 ! !> \ingroup double_blas_level2 ! !> \par Further Details: ! ===================== !> !> \verbatim !> !> Level 2 Blas routine. !> The vector and matrix arguments are not referenced when N = 0, or M = 0 !> !> -- Written on 22-October-1986. !> Jack Dongarra, Argonne National Lab. !> Jeremy Du Croz, Nag Central Office. !> Sven Hammarling, Nag Central Office. !> Richard Hanson, Sandia National Labs. !> \endverbatim !> ! ===================================================================== SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX) ! ! -- Reference BLAS level2 routine (version 3.4.0) -- ! -- Reference BLAS is a software package provided by Univ. of Tennessee, -- ! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- ! November 2011 ! ! .. Scalar Arguments .. INTEGER INCX,LDA,N CHARACTER DIAG,TRANS,UPLO ! .. ! .. Array Arguments .. DOUBLE PRECISION A(LDA,*),X(*) ! .. ! ! ===================================================================== ! ! .. Parameters .. DOUBLE PRECISION ZERO PARAMETER (ZERO=0.0D+0) ! .. ! .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I,INFO,IX,J,JX,KX LOGICAL NOUNIT ! .. ! .. External Functions .. LOGICAL LSAME EXTERNAL LSAME ! .. ! .. External Subroutines .. EXTERNAL XERBLA ! .. ! .. Intrinsic Functions .. INTRINSIC MAX ! .. ! ! Test the input parameters. ! INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. & & .NOT.LSAME(TRANS,'C')) THEN INFO = 2 ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN INFO = 3 ELSE IF (N.LT.0) THEN INFO = 4 ELSE IF (LDA.LT.MAX(1,N)) THEN INFO = 6 ELSE IF (INCX.EQ.0) THEN INFO = 8 END IF IF (INFO.NE.0) THEN CALL XERBLA('DTRMV ',INFO) RETURN END IF ! ! Quick return if possible. ! IF (N.EQ.0) RETURN ! NOUNIT = LSAME(DIAG,'N') ! ! Set up the start point in X if the increment is not unity. This ! will be ( N - 1 )*INCX too small for descending loops. ! IF (INCX.LE.0) THEN KX = 1 - (N-1)*INCX ELSE IF (INCX.NE.1) THEN KX = 1 END IF ! ! Start the operations. In this version the elements of A are ! accessed sequentially with one pass through A. ! IF (LSAME(TRANS,'N')) THEN ! ! Form x := A*x. ! IF (LSAME(UPLO,'U')) THEN IF (INCX.EQ.1) THEN DO 20 J = 1,N IF (X(J).NE.ZERO) THEN TEMP = X(J) DO 10 I = 1,J - 1 X(I) = X(I) + TEMP*A(I,J) 10 CONTINUE IF (NOUNIT) X(J) = X(J)*A(J,J) END IF 20 CONTINUE ELSE JX = KX DO 40 J = 1,N IF (X(JX).NE.ZERO) THEN TEMP = X(JX) IX = KX DO 30 I = 1,J - 1 X(IX) = X(IX) + TEMP*A(I,J) IX = IX + INCX 30 CONTINUE IF (NOUNIT) X(JX) = X(JX)*A(J,J) END IF JX = JX + INCX 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = N,1,-1 IF (X(J).NE.ZERO) THEN TEMP = X(J) DO 50 I = N,J + 1,-1 X(I) = X(I) + TEMP*A(I,J) 50 CONTINUE IF (NOUNIT) X(J) = X(J)*A(J,J) END IF 60 CONTINUE ELSE KX = KX + (N-1)*INCX JX = KX DO 80 J = N,1,-1 IF (X(JX).NE.ZERO) THEN TEMP = X(JX) IX = KX DO 70 I = N,J + 1,-1 X(IX) = X(IX) + TEMP*A(I,J) IX = IX - INCX 70 CONTINUE IF (NOUNIT) X(JX) = X(JX)*A(J,J) END IF JX = JX - INCX 80 CONTINUE END IF END IF ELSE ! ! Form x := A**T*x. ! IF (LSAME(UPLO,'U')) THEN IF (INCX.EQ.1) THEN DO 100 J = N,1,-1 TEMP = X(J) IF (NOUNIT) TEMP = TEMP*A(J,J) DO 90 I = J - 1,1,-1 TEMP = TEMP + A(I,J)*X(I) 90 CONTINUE X(J) = TEMP 100 CONTINUE ELSE JX = KX + (N-1)*INCX DO 120 J = N,1,-1 TEMP = X(JX) IX = JX IF (NOUNIT) TEMP = TEMP*A(J,J) DO 110 I = J - 1,1,-1 IX = IX - INCX TEMP = TEMP + A(I,J)*X(IX) 110 CONTINUE X(JX) = TEMP JX = JX - INCX 120 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 140 J = 1,N TEMP = X(J) IF (NOUNIT) TEMP = TEMP*A(J,J) DO 130 I = J + 1,N TEMP = TEMP + A(I,J)*X(I) 130 CONTINUE X(J) = TEMP 140 CONTINUE ELSE JX = KX DO 160 J = 1,N TEMP = X(JX) IX = JX IF (NOUNIT) TEMP = TEMP*A(J,J) DO 150 I = J + 1,N IX = IX + INCX TEMP = TEMP + A(I,J)*X(IX) 150 CONTINUE X(JX) = TEMP JX = JX + INCX 160 CONTINUE END IF END IF END IF ! RETURN ! ! End of DTRMV . ! END