SRC\strmvt.f
#lines: 161   size: 4 Kb   creation: 18/01/2006 23:36:04   last modification: 08/05/2008 18:38:22   attribute: ARCH    Find   Reload   
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
 
      SUBROUTINE STRMVT( UPLO, N, T, LDT, X, INCX, Y, INCY, W, INCW, Z,
     $                   INCZ )
*
*  -- ScaLAPACK routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     March 13, 2000
*
*     .. Scalar Arguments ..
      CHARACTER          UPLO
      INTEGER            INCW, INCX, INCY, INCZ, LDT, N
*     ..
*     .. Array Arguments ..
      REAL               T( LDT, * ), W( * ), X( * ), Y( * ), Z( * )
*     ..
*
*  Purpose
*  =======
*
*  STRMVT  performs the matrix-vector operations
*
*     x := T' *y, and w := T *z,
*
*  where x is an n element vector and  T is an n by n
*  upper or lower triangular matrix.
*
*  Arguments 
*  =========
*
*  UPLO   - 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.
*
*           Unchanged on exit.
*
*  N      - INTEGER.
*           On entry, N specifies the order of the matrix A.
*           N must be at least zero.
*           Unchanged on exit.
*
*  T      - REAL array of DIMENSION ( LDT, n ).
*           Before entry with  UPLO = 'U' or 'u', the leading n by n
*           upper triangular part of the array T must contain the upper
*           triangular matrix and the strictly lower triangular part of
*           T is not referenced.
*           Before entry with UPLO = 'L' or 'l', the leading n by n
*           lower triangular part of the array T must contain the lower
*           triangular matrix and the strictly upper triangular part of
*           T is not referenced.
*
*  LDT    - 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 ).
*           Unchanged on exit.
*
*  X      - REAL array of dimension at least
*           ( 1 + ( n - 1 )*abs( INCX ) ).
*           On exit, X = T' * y
*
*  INCX   - INTEGER.
*           On entry, INCX specifies the increment for the elements of
*           X. INCX must not be zero.
*           Unchanged on exit.
*
*  Y      - REAL array of dimension at least
*           ( 1 + ( n - 1 )*abs( INCY ) ).
*           Before entry, the incremented array Y must contain the n
*           element vector y.  Unchanged on exit.
*
*  INCY   - INTEGER.
*           On entry, INCY specifies the increment for the elements of
*           Y. INCY must not be zero.
*           Unchanged on exit.
*
*  W      - REAL array of dimension at least
*           ( 1 + ( n - 1 )*abs( INCW ) ).
*           On exit, W = T * z
*
*  INCW   - INTEGER.
*           On entry, INCW specifies the increment for the elements of
*           W. INCW must not be zero.
*           Unchanged on exit.
*
*  Z      - REAL array of dimension at least
*           ( 1 + ( n - 1 )*abs( INCZ ) ).
*           Before entry, the incremented array Z must contain the n
*           element vector z.  Unchanged on exit.
*
*  INCY   - INTEGER.
*           On entrz, INCY specifies the increment for the elements of
*           Y. INCY must not be zero.
*           Unchanged on exit.
*
*
*  Level 2 Blas routine.
*
*
*     .. Local Scalars ..
      INTEGER            INFO
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     ..
*     .. External Subroutines ..
      EXTERNAL           SCOPY, STRMV, XERBLA
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          MAX
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      INFO = 0
      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
         INFO = 1
      ELSE IF( N.LT.0 ) THEN
         INFO = 2
      ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
         INFO = 4
      ELSE IF( INCW.EQ.0 ) THEN
         INFO = 6
      ELSE IF( INCX.EQ.0 ) THEN
         INFO = 8
      ELSE IF( INCY.EQ.0 ) THEN
         INFO = 10
      ELSE IF( INCZ.EQ.0 ) THEN
         INFO = 12
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'STRMVT', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( N.EQ.0 )
     $   RETURN
*
*
*
      IF( INCX.NE.1 .OR. INCY.NE.1 .OR. INCW.NE.1 .OR. INCZ.NE.1 .OR.
     $    .TRUE. ) THEN
         CALL SCOPY( N, Y, INCY, X, INCX )
         CALL STRMV( UPLO, 'C', 'N', N, T, LDT, X, INCX )
         CALL SCOPY( N, Z, INCZ, W, INCW )
         CALL STRMV( UPLO, 'N', 'N', N, T, LDT, W, INCW )
         RETURN
      END IF
*
      RETURN
*
*     End of STRMVT.
*
      END