3
4
5
6
7
8
9
10 CHARACTER UPLO
11 INTEGER INCW, INCX, INCY, INCZ, LDT, N
12
13
14 COMPLEX*16 T( LDT, * ), W( * ), X( * ), Y( * ), Z( * )
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 INTEGER INFO
105
106
107 LOGICAL LSAME
109
110
112
113
115
116
117
118
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(
'ZTRMVT', info )
138 RETURN
139 END IF
140
141
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 zcopy( n, y, incy, x, incx )
151 CALL ztrmv( uplo,
'C',
'N', n, t, ldt, x, incx )
152 CALL zcopy( n, z, incz, w, incw )
153 CALL ztrmv( uplo,
'N',
'N', n, t, ldt, w, incw )
154 RETURN
155 END IF
156
157 RETURN
158
159
160
subroutine xerbla(srname, info)
XERBLA
logical function lsame(ca, cb)
LSAME
subroutine zcopy(n, zx, incx, zy, incy)
ZCOPY
subroutine ztrmv(uplo, trans, diag, n, a, lda, x, incx)
ZTRMV