LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ ztpmv()

subroutine ztpmv ( character  UPLO,
character  TRANS,
character  DIAG,
integer  N,
complex*16, dimension(*)  AP,
complex*16, dimension(*)  X,
integer  INCX 
)

ZTPMV

Purpose:
 ZTPMV  performs one of the matrix-vector operations

    x := A*x,   or   x := A**T*x,   or   x := A**H*x,

 where x is an n element vector and  A is an n by n unit, or non-unit,
 upper or lower triangular matrix, supplied in packed form.
Parameters
[in]UPLO
          UPLO is 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.
[in]TRANS
          TRANS is CHARACTER*1
           On entry, TRANS specifies the operation to be performed as
           follows:

              TRANS = 'N' or 'n'   x := A*x.

              TRANS = 'T' or 't'   x := A**T*x.

              TRANS = 'C' or 'c'   x := A**H*x.
[in]DIAG
          DIAG is CHARACTER*1
           On entry, DIAG specifies whether or not A is unit
           triangular as follows:

              DIAG = 'U' or 'u'   A is assumed to be unit triangular.

              DIAG = 'N' or 'n'   A is not assumed to be unit
                                  triangular.
[in]N
          N is INTEGER
           On entry, N specifies the order of the matrix A.
           N must be at least zero.
[in]AP
          AP is COMPLEX*16 array, dimension at least
           ( ( n*( n + 1 ) )/2 ).
           Before entry with  UPLO = 'U' or 'u', the array AP must
           contain the upper triangular matrix packed sequentially,
           column by column, so that AP( 1 ) contains a( 1, 1 ),
           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
           respectively, and so on.
           Before entry with UPLO = 'L' or 'l', the array AP must
           contain the lower triangular matrix packed sequentially,
           column by column, so that AP( 1 ) contains a( 1, 1 ),
           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
           respectively, and so on.
           Note that when  DIAG = 'U' or 'u', the diagonal elements of
           A are not referenced, but are assumed to be unity.
[in,out]X
          X is COMPLEX*16 array, dimension at least
           ( 1 + ( n - 1 )*abs( INCX ) ).
           Before entry, the incremented array X must contain the n
           element vector x. On exit, X is overwritten with the
           transformed vector x.
[in]INCX
          INCX is INTEGER
           On entry, INCX specifies the increment for the elements of
           X. INCX must not be zero.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
  Level 2 Blas routine.
  The vector and matrix arguments are not referenced when N = 0, or M = 0

  -- Written on 22-October-1986.
     Jack Dongarra, Argonne National Lab.
     Jeremy Du Croz, Nag Central Office.
     Sven Hammarling, Nag Central Office.
     Richard Hanson, Sandia National Labs.

Definition at line 141 of file ztpmv.f.

142 *
143 * -- Reference BLAS level2 routine --
144 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
145 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
146 *
147 * .. Scalar Arguments ..
148  INTEGER INCX,N
149  CHARACTER DIAG,TRANS,UPLO
150 * ..
151 * .. Array Arguments ..
152  COMPLEX*16 AP(*),X(*)
153 * ..
154 *
155 * =====================================================================
156 *
157 * .. Parameters ..
158  COMPLEX*16 ZERO
159  parameter(zero= (0.0d+0,0.0d+0))
160 * ..
161 * .. Local Scalars ..
162  COMPLEX*16 TEMP
163  INTEGER I,INFO,IX,J,JX,K,KK,KX
164  LOGICAL NOCONJ,NOUNIT
165 * ..
166 * .. External Functions ..
167  LOGICAL LSAME
168  EXTERNAL lsame
169 * ..
170 * .. External Subroutines ..
171  EXTERNAL xerbla
172 * ..
173 * .. Intrinsic Functions ..
174  INTRINSIC dconjg
175 * ..
176 *
177 * Test the input parameters.
178 *
179  info = 0
180  IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
181  info = 1
182  ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
183  + .NOT.lsame(trans,'C')) THEN
184  info = 2
185  ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
186  info = 3
187  ELSE IF (n.LT.0) THEN
188  info = 4
189  ELSE IF (incx.EQ.0) THEN
190  info = 7
191  END IF
192  IF (info.NE.0) THEN
193  CALL xerbla('ZTPMV ',info)
194  RETURN
195  END IF
196 *
197 * Quick return if possible.
198 *
199  IF (n.EQ.0) RETURN
200 *
201  noconj = lsame(trans,'T')
202  nounit = lsame(diag,'N')
203 *
204 * Set up the start point in X if the increment is not unity. This
205 * will be ( N - 1 )*INCX too small for descending loops.
206 *
207  IF (incx.LE.0) THEN
208  kx = 1 - (n-1)*incx
209  ELSE IF (incx.NE.1) THEN
210  kx = 1
211  END IF
212 *
213 * Start the operations. In this version the elements of AP are
214 * accessed sequentially with one pass through AP.
215 *
216  IF (lsame(trans,'N')) THEN
217 *
218 * Form x:= A*x.
219 *
220  IF (lsame(uplo,'U')) THEN
221  kk = 1
222  IF (incx.EQ.1) THEN
223  DO 20 j = 1,n
224  IF (x(j).NE.zero) THEN
225  temp = x(j)
226  k = kk
227  DO 10 i = 1,j - 1
228  x(i) = x(i) + temp*ap(k)
229  k = k + 1
230  10 CONTINUE
231  IF (nounit) x(j) = x(j)*ap(kk+j-1)
232  END IF
233  kk = kk + j
234  20 CONTINUE
235  ELSE
236  jx = kx
237  DO 40 j = 1,n
238  IF (x(jx).NE.zero) THEN
239  temp = x(jx)
240  ix = kx
241  DO 30 k = kk,kk + j - 2
242  x(ix) = x(ix) + temp*ap(k)
243  ix = ix + incx
244  30 CONTINUE
245  IF (nounit) x(jx) = x(jx)*ap(kk+j-1)
246  END IF
247  jx = jx + incx
248  kk = kk + j
249  40 CONTINUE
250  END IF
251  ELSE
252  kk = (n* (n+1))/2
253  IF (incx.EQ.1) THEN
254  DO 60 j = n,1,-1
255  IF (x(j).NE.zero) THEN
256  temp = x(j)
257  k = kk
258  DO 50 i = n,j + 1,-1
259  x(i) = x(i) + temp*ap(k)
260  k = k - 1
261  50 CONTINUE
262  IF (nounit) x(j) = x(j)*ap(kk-n+j)
263  END IF
264  kk = kk - (n-j+1)
265  60 CONTINUE
266  ELSE
267  kx = kx + (n-1)*incx
268  jx = kx
269  DO 80 j = n,1,-1
270  IF (x(jx).NE.zero) THEN
271  temp = x(jx)
272  ix = kx
273  DO 70 k = kk,kk - (n- (j+1)),-1
274  x(ix) = x(ix) + temp*ap(k)
275  ix = ix - incx
276  70 CONTINUE
277  IF (nounit) x(jx) = x(jx)*ap(kk-n+j)
278  END IF
279  jx = jx - incx
280  kk = kk - (n-j+1)
281  80 CONTINUE
282  END IF
283  END IF
284  ELSE
285 *
286 * Form x := A**T*x or x := A**H*x.
287 *
288  IF (lsame(uplo,'U')) THEN
289  kk = (n* (n+1))/2
290  IF (incx.EQ.1) THEN
291  DO 110 j = n,1,-1
292  temp = x(j)
293  k = kk - 1
294  IF (noconj) THEN
295  IF (nounit) temp = temp*ap(kk)
296  DO 90 i = j - 1,1,-1
297  temp = temp + ap(k)*x(i)
298  k = k - 1
299  90 CONTINUE
300  ELSE
301  IF (nounit) temp = temp*dconjg(ap(kk))
302  DO 100 i = j - 1,1,-1
303  temp = temp + dconjg(ap(k))*x(i)
304  k = k - 1
305  100 CONTINUE
306  END IF
307  x(j) = temp
308  kk = kk - j
309  110 CONTINUE
310  ELSE
311  jx = kx + (n-1)*incx
312  DO 140 j = n,1,-1
313  temp = x(jx)
314  ix = jx
315  IF (noconj) THEN
316  IF (nounit) temp = temp*ap(kk)
317  DO 120 k = kk - 1,kk - j + 1,-1
318  ix = ix - incx
319  temp = temp + ap(k)*x(ix)
320  120 CONTINUE
321  ELSE
322  IF (nounit) temp = temp*dconjg(ap(kk))
323  DO 130 k = kk - 1,kk - j + 1,-1
324  ix = ix - incx
325  temp = temp + dconjg(ap(k))*x(ix)
326  130 CONTINUE
327  END IF
328  x(jx) = temp
329  jx = jx - incx
330  kk = kk - j
331  140 CONTINUE
332  END IF
333  ELSE
334  kk = 1
335  IF (incx.EQ.1) THEN
336  DO 170 j = 1,n
337  temp = x(j)
338  k = kk + 1
339  IF (noconj) THEN
340  IF (nounit) temp = temp*ap(kk)
341  DO 150 i = j + 1,n
342  temp = temp + ap(k)*x(i)
343  k = k + 1
344  150 CONTINUE
345  ELSE
346  IF (nounit) temp = temp*dconjg(ap(kk))
347  DO 160 i = j + 1,n
348  temp = temp + dconjg(ap(k))*x(i)
349  k = k + 1
350  160 CONTINUE
351  END IF
352  x(j) = temp
353  kk = kk + (n-j+1)
354  170 CONTINUE
355  ELSE
356  jx = kx
357  DO 200 j = 1,n
358  temp = x(jx)
359  ix = jx
360  IF (noconj) THEN
361  IF (nounit) temp = temp*ap(kk)
362  DO 180 k = kk + 1,kk + n - j
363  ix = ix + incx
364  temp = temp + ap(k)*x(ix)
365  180 CONTINUE
366  ELSE
367  IF (nounit) temp = temp*dconjg(ap(kk))
368  DO 190 k = kk + 1,kk + n - j
369  ix = ix + incx
370  temp = temp + dconjg(ap(k))*x(ix)
371  190 CONTINUE
372  END IF
373  x(jx) = temp
374  jx = jx + incx
375  kk = kk + (n-j+1)
376  200 CONTINUE
377  END IF
378  END IF
379  END IF
380 *
381  RETURN
382 *
383 * End of ZTPMV
384 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
Here is the call graph for this function:
Here is the caller graph for this function: