LAPACK  3.4.2 LAPACK: Linear Algebra PACKage
ztpmv.f
Go to the documentation of this file.
1 *> \brief \b ZTPMV
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE ZTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX)
12 *
13 * .. Scalar Arguments ..
14 * INTEGER INCX,N
15 * CHARACTER DIAG,TRANS,UPLO
16 * ..
17 * .. Array Arguments ..
18 * COMPLEX*16 AP(*),X(*)
19 * ..
20 *
21 *
22 *> \par Purpose:
23 * =============
24 *>
25 *> \verbatim
26 *>
27 *> ZTPMV performs one of the matrix-vector operations
28 *>
29 *> x := A*x, or x := A**T*x, or x := A**H*x,
30 *>
31 *> where x is an n element vector and A is an n by n unit, or non-unit,
32 *> upper or lower triangular matrix, supplied in packed form.
33 *> \endverbatim
34 *
35 * Arguments:
36 * ==========
37 *
38 *> \param[in] UPLO
39 *> \verbatim
40 *> UPLO is CHARACTER*1
41 *> On entry, UPLO specifies whether the matrix is an upper or
42 *> lower triangular matrix as follows:
43 *>
44 *> UPLO = 'U' or 'u' A is an upper triangular matrix.
45 *>
46 *> UPLO = 'L' or 'l' A is a lower triangular matrix.
47 *> \endverbatim
48 *>
49 *> \param[in] TRANS
50 *> \verbatim
51 *> TRANS is CHARACTER*1
52 *> On entry, TRANS specifies the operation to be performed as
53 *> follows:
54 *>
55 *> TRANS = 'N' or 'n' x := A*x.
56 *>
57 *> TRANS = 'T' or 't' x := A**T*x.
58 *>
59 *> TRANS = 'C' or 'c' x := A**H*x.
60 *> \endverbatim
61 *>
62 *> \param[in] DIAG
63 *> \verbatim
64 *> DIAG is CHARACTER*1
65 *> On entry, DIAG specifies whether or not A is unit
66 *> triangular as follows:
67 *>
68 *> DIAG = 'U' or 'u' A is assumed to be unit triangular.
69 *>
70 *> DIAG = 'N' or 'n' A is not assumed to be unit
71 *> triangular.
72 *> \endverbatim
73 *>
74 *> \param[in] N
75 *> \verbatim
76 *> N is INTEGER
77 *> On entry, N specifies the order of the matrix A.
78 *> N must be at least zero.
79 *> \endverbatim
80 *>
81 *> \param[in] AP
82 *> \verbatim
83 *> AP is COMPLEX*16 array of DIMENSION at least
84 *> ( ( n*( n + 1 ) )/2 ).
85 *> Before entry with UPLO = 'U' or 'u', the array AP must
86 *> contain the upper triangular matrix packed sequentially,
87 *> column by column, so that AP( 1 ) contains a( 1, 1 ),
88 *> AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
89 *> respectively, and so on.
90 *> Before entry with UPLO = 'L' or 'l', the array AP must
91 *> contain the lower triangular matrix packed sequentially,
92 *> column by column, so that AP( 1 ) contains a( 1, 1 ),
93 *> AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
94 *> respectively, and so on.
95 *> Note that when DIAG = 'U' or 'u', the diagonal elements of
96 *> A are not referenced, but are assumed to be unity.
97 *> \endverbatim
98 *>
99 *> \param[in] X
100 *> \verbatim
101 *> X is (input/output) COMPLEX*16 array of dimension at least
102 *> ( 1 + ( n - 1 )*abs( INCX ) ).
103 *> Before entry, the incremented array X must contain the n
104 *> element vector x. On exit, X is overwritten with the
105 *> tranformed vector x.
106 *> \endverbatim
107 *>
108 *> \param[in] INCX
109 *> \verbatim
110 *> INCX is INTEGER
111 *> On entry, INCX specifies the increment for the elements of
112 *> X. INCX must not be zero.
113 *> \endverbatim
114 *
115 * Authors:
116 * ========
117 *
118 *> \author Univ. of Tennessee
119 *> \author Univ. of California Berkeley
120 *> \author Univ. of Colorado Denver
121 *> \author NAG Ltd.
122 *
123 *> \date November 2011
124 *
125 *> \ingroup complex16_blas_level2
126 *
127 *> \par Further Details:
128 * =====================
129 *>
130 *> \verbatim
131 *>
132 *> Level 2 Blas routine.
133 *> The vector and matrix arguments are not referenced when N = 0, or M = 0
134 *>
135 *> -- Written on 22-October-1986.
136 *> Jack Dongarra, Argonne National Lab.
137 *> Jeremy Du Croz, Nag Central Office.
138 *> Sven Hammarling, Nag Central Office.
139 *> Richard Hanson, Sandia National Labs.
140 *> \endverbatim
141 *>
142 * =====================================================================
143  SUBROUTINE ztpmv(UPLO,TRANS,DIAG,N,AP,X,INCX)
144 *
145 * -- Reference BLAS level2 routine (version 3.4.0) --
146 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
147 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
148 * November 2011
149 *
150 * .. Scalar Arguments ..
151  INTEGER incx,n
152  CHARACTER diag,trans,uplo
153 * ..
154 * .. Array Arguments ..
155  COMPLEX*16 ap(*),x(*)
156 * ..
157 *
158 * =====================================================================
159 *
160 * .. Parameters ..
161  COMPLEX*16 zero
162  parameter(zero= (0.0d+0,0.0d+0))
163 * ..
164 * .. Local Scalars ..
165  COMPLEX*16 temp
166  INTEGER i,info,ix,j,jx,k,kk,kx
167  LOGICAL noconj,nounit
168 * ..
169 * .. External Functions ..
170  LOGICAL lsame
171  EXTERNAL lsame
172 * ..
173 * .. External Subroutines ..
174  EXTERNAL xerbla
175 * ..
176 * .. Intrinsic Functions ..
177  INTRINSIC dconjg
178 * ..
179 *
180 * Test the input parameters.
181 *
182  info = 0
183  IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
184  info = 1
185  ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
186  + .NOT.lsame(trans,'C')) THEN
187  info = 2
188  ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
189  info = 3
190  ELSE IF (n.LT.0) THEN
191  info = 4
192  ELSE IF (incx.EQ.0) THEN
193  info = 7
194  END IF
195  IF (info.NE.0) THEN
196  CALL xerbla('ZTPMV ',info)
197  return
198  END IF
199 *
200 * Quick return if possible.
201 *
202  IF (n.EQ.0) return
203 *
204  noconj = lsame(trans,'T')
205  nounit = lsame(diag,'N')
206 *
207 * Set up the start point in X if the increment is not unity. This
208 * will be ( N - 1 )*INCX too small for descending loops.
209 *
210  IF (incx.LE.0) THEN
211  kx = 1 - (n-1)*incx
212  ELSE IF (incx.NE.1) THEN
213  kx = 1
214  END IF
215 *
216 * Start the operations. In this version the elements of AP are
217 * accessed sequentially with one pass through AP.
218 *
219  IF (lsame(trans,'N')) THEN
220 *
221 * Form x:= A*x.
222 *
223  IF (lsame(uplo,'U')) THEN
224  kk = 1
225  IF (incx.EQ.1) THEN
226  DO 20 j = 1,n
227  IF (x(j).NE.zero) THEN
228  temp = x(j)
229  k = kk
230  DO 10 i = 1,j - 1
231  x(i) = x(i) + temp*ap(k)
232  k = k + 1
233  10 continue
234  IF (nounit) x(j) = x(j)*ap(kk+j-1)
235  END IF
236  kk = kk + j
237  20 continue
238  ELSE
239  jx = kx
240  DO 40 j = 1,n
241  IF (x(jx).NE.zero) THEN
242  temp = x(jx)
243  ix = kx
244  DO 30 k = kk,kk + j - 2
245  x(ix) = x(ix) + temp*ap(k)
246  ix = ix + incx
247  30 continue
248  IF (nounit) x(jx) = x(jx)*ap(kk+j-1)
249  END IF
250  jx = jx + incx
251  kk = kk + j
252  40 continue
253  END IF
254  ELSE
255  kk = (n* (n+1))/2
256  IF (incx.EQ.1) THEN
257  DO 60 j = n,1,-1
258  IF (x(j).NE.zero) THEN
259  temp = x(j)
260  k = kk
261  DO 50 i = n,j + 1,-1
262  x(i) = x(i) + temp*ap(k)
263  k = k - 1
264  50 continue
265  IF (nounit) x(j) = x(j)*ap(kk-n+j)
266  END IF
267  kk = kk - (n-j+1)
268  60 continue
269  ELSE
270  kx = kx + (n-1)*incx
271  jx = kx
272  DO 80 j = n,1,-1
273  IF (x(jx).NE.zero) THEN
274  temp = x(jx)
275  ix = kx
276  DO 70 k = kk,kk - (n- (j+1)),-1
277  x(ix) = x(ix) + temp*ap(k)
278  ix = ix - incx
279  70 continue
280  IF (nounit) x(jx) = x(jx)*ap(kk-n+j)
281  END IF
282  jx = jx - incx
283  kk = kk - (n-j+1)
284  80 continue
285  END IF
286  END IF
287  ELSE
288 *
289 * Form x := A**T*x or x := A**H*x.
290 *
291  IF (lsame(uplo,'U')) THEN
292  kk = (n* (n+1))/2
293  IF (incx.EQ.1) THEN
294  DO 110 j = n,1,-1
295  temp = x(j)
296  k = kk - 1
297  IF (noconj) THEN
298  IF (nounit) temp = temp*ap(kk)
299  DO 90 i = j - 1,1,-1
300  temp = temp + ap(k)*x(i)
301  k = k - 1
302  90 continue
303  ELSE
304  IF (nounit) temp = temp*dconjg(ap(kk))
305  DO 100 i = j - 1,1,-1
306  temp = temp + dconjg(ap(k))*x(i)
307  k = k - 1
308  100 continue
309  END IF
310  x(j) = temp
311  kk = kk - j
312  110 continue
313  ELSE
314  jx = kx + (n-1)*incx
315  DO 140 j = n,1,-1
316  temp = x(jx)
317  ix = jx
318  IF (noconj) THEN
319  IF (nounit) temp = temp*ap(kk)
320  DO 120 k = kk - 1,kk - j + 1,-1
321  ix = ix - incx
322  temp = temp + ap(k)*x(ix)
323  120 continue
324  ELSE
325  IF (nounit) temp = temp*dconjg(ap(kk))
326  DO 130 k = kk - 1,kk - j + 1,-1
327  ix = ix - incx
328  temp = temp + dconjg(ap(k))*x(ix)
329  130 continue
330  END IF
331  x(jx) = temp
332  jx = jx - incx
333  kk = kk - j
334  140 continue
335  END IF
336  ELSE
337  kk = 1
338  IF (incx.EQ.1) THEN
339  DO 170 j = 1,n
340  temp = x(j)
341  k = kk + 1
342  IF (noconj) THEN
343  IF (nounit) temp = temp*ap(kk)
344  DO 150 i = j + 1,n
345  temp = temp + ap(k)*x(i)
346  k = k + 1
347  150 continue
348  ELSE
349  IF (nounit) temp = temp*dconjg(ap(kk))
350  DO 160 i = j + 1,n
351  temp = temp + dconjg(ap(k))*x(i)
352  k = k + 1
353  160 continue
354  END IF
355  x(j) = temp
356  kk = kk + (n-j+1)
357  170 continue
358  ELSE
359  jx = kx
360  DO 200 j = 1,n
361  temp = x(jx)
362  ix = jx
363  IF (noconj) THEN
364  IF (nounit) temp = temp*ap(kk)
365  DO 180 k = kk + 1,kk + n - j
366  ix = ix + incx
367  temp = temp + ap(k)*x(ix)
368  180 continue
369  ELSE
370  IF (nounit) temp = temp*dconjg(ap(kk))
371  DO 190 k = kk + 1,kk + n - j
372  ix = ix + incx
373  temp = temp + dconjg(ap(k))*x(ix)
374  190 continue
375  END IF
376  x(jx) = temp
377  jx = jx + incx
378  kk = kk + (n-j+1)
379  200 continue
380  END IF
381  END IF
382  END IF
383 *
384  return
385 *
386 * End of ZTPMV .
387 *
388  END