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
|
