ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
dtrmvt.f
Go to the documentation of this file.
1  SUBROUTINE dtrmvt( UPLO, N, T, LDT, X, INCX, Y, INCY, W, INCW, Z,
2  $ INCZ )
3 *
4 * -- ScaLAPACK routine (version 1.7) --
5 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6 * and University of California, Berkeley.
7 * March 13, 2000
8 *
9 * .. Scalar Arguments ..
10  CHARACTER UPLO
11  INTEGER INCW, INCX, INCY, INCZ, LDT, N
12 * ..
13 * .. Array Arguments ..
14  DOUBLE PRECISION T( LDT, * ), W( * ), X( * ), Y( * ), Z( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * DTRMVT performs the matrix-vector operations
21 *
22 * x := T' *y, and w := T *z,
23 *
24 * where x is an n element vector and T is an n by n
25 * upper or lower triangular matrix.
26 *
27 * Arguments
28 * =========
29 *
30 * UPLO - CHARACTER*1.
31 * On entry, UPLO specifies whether the matrix is an upper or
32 * lower triangular matrix as follows:
33 *
34 * UPLO = 'U' or 'u' A is an upper triangular matrix.
35 *
36 * UPLO = 'L' or 'l' A is a lower triangular matrix.
37 *
38 * Unchanged on exit.
39 *
40 * N - INTEGER.
41 * On entry, N specifies the order of the matrix A.
42 * N must be at least zero.
43 * Unchanged on exit.
44 *
45 * T - DOUBLE PRECISION array of DIMENSION ( LDT, n ).
46 * Before entry with UPLO = 'U' or 'u', the leading n by n
47 * upper triangular part of the array T must contain the upper
48 * triangular matrix and the strictly lower triangular part of
49 * T is not referenced.
50 * Before entry with UPLO = 'L' or 'l', the leading n by n
51 * lower triangular part of the array T must contain the lower
52 * triangular matrix and the strictly upper triangular part of
53 * T is not referenced.
54 *
55 * LDT - INTEGER.
56 * On entry, LDA specifies the first dimension of A as declared
57 * in the calling (sub) program. LDA must be at least
58 * max( 1, n ).
59 * Unchanged on exit.
60 *
61 * X - DOUBLE PRECISION array of dimension at least
62 * ( 1 + ( n - 1 )*abs( INCX ) ).
63 * On exit, X = T' * y
64 *
65 * INCX - INTEGER.
66 * On entry, INCX specifies the increment for the elements of
67 * X. INCX must not be zero.
68 * Unchanged on exit.
69 *
70 * Y - DOUBLE PRECISION array of dimension at least
71 * ( 1 + ( n - 1 )*abs( INCY ) ).
72 * Before entry, the incremented array Y must contain the n
73 * element vector y. Unchanged on exit.
74 *
75 * INCY - INTEGER.
76 * On entry, INCY specifies the increment for the elements of
77 * Y. INCY must not be zero.
78 * Unchanged on exit.
79 *
80 * W - DOUBLE PRECISION array of dimension at least
81 * ( 1 + ( n - 1 )*abs( INCW ) ).
82 * On exit, W = T * z
83 *
84 * INCW - INTEGER.
85 * On entry, INCW specifies the increment for the elements of
86 * W. INCW must not be zero.
87 * Unchanged on exit.
88 *
89 * Z - DOUBLE PRECISION array of dimension at least
90 * ( 1 + ( n - 1 )*abs( INCZ ) ).
91 * Before entry, the incremented array Z must contain the n
92 * element vector z. Unchanged on exit.
93 *
94 * INCY - INTEGER.
95 * On entrz, INCY specifies the increment for the elements of
96 * Y. INCY must not be zero.
97 * Unchanged on exit.
98 *
99 *
100 * Level 2 Blas routine.
101 *
102 *
103 * .. Local Scalars ..
104  INTEGER INFO
105 * ..
106 * .. External Functions ..
107  LOGICAL LSAME
108  EXTERNAL lsame
109 * ..
110 * .. External Subroutines ..
111  EXTERNAL dcopy, dtrmv, xerbla
112 * ..
113 * .. Intrinsic Functions ..
114  INTRINSIC max
115 * ..
116 * .. Executable Statements ..
117 *
118 * Test the input parameters.
119 *
120  info = 0
121  IF( .NOT.lsame( uplo, 'U' ) .AND. .NOT.lsame( uplo, 'L' ) ) THEN
122  info = 1
123  ELSE IF( n.LT.0 ) THEN
124  info = 2
125  ELSE IF( ldt.LT.max( 1, n ) ) THEN
126  info = 4
127  ELSE IF( incw.EQ.0 ) THEN
128  info = 6
129  ELSE IF( incx.EQ.0 ) THEN
130  info = 8
131  ELSE IF( incy.EQ.0 ) THEN
132  info = 10
133  ELSE IF( incz.EQ.0 ) THEN
134  info = 12
135  END IF
136  IF( info.NE.0 ) THEN
137  CALL xerbla( 'DTRMVT', info )
138  RETURN
139  END IF
140 *
141 * Quick return if possible.
142 *
143  IF( n.EQ.0 )
144  $ RETURN
145 *
146 *
147 *
148  IF( incx.NE.1 .OR. incy.NE.1 .OR. incw.NE.1 .OR. incz.NE.1 .OR.
149  $ .true. ) THEN
150  CALL dcopy( n, y, incy, x, incx )
151  CALL dtrmv( uplo, 'C', 'N', n, t, ldt, x, incx )
152  CALL dcopy( n, z, incz, w, incw )
153  CALL dtrmv( uplo, 'N', 'N', n, t, ldt, w, incw )
154  RETURN
155  END IF
156 *
157  RETURN
158 *
159 * End of DTRMVT.
160 *
161  END
max
#define max(A, B)
Definition: pcgemr.c:180
dtrmvt
subroutine dtrmvt(UPLO, N, T, LDT, X, INCX, Y, INCY, W, INCW, Z, INCZ)
Definition: dtrmvt.f:3