LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine ctpmv ( character  UPLO,
character  TRANS,
character  DIAG,
integer  N,
complex, dimension(*)  AP,
complex, dimension(*)  X,
integer  INCX 
)

CTPMV

Purpose: 
 CTPMV  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 array of 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 array of 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
           tranformed 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.
Date
November 2011
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 144 of file ctpmv.f.

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 ap(*),x(*)
156 * ..
157 *
158 * =====================================================================
159 *
160 * .. Parameters ..
161  COMPLEX zero
162  parameter(zero= (0.0e+0,0.0e+0))
163 * ..
164 * .. Local Scalars ..
165  COMPLEX 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 conjg
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('CTPMV ',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*conjg(ap(kk))
305  DO 100 i = j - 1,1,-1
306  temp = temp + conjg(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*conjg(ap(kk))
326  DO 130 k = kk - 1,kk - j + 1,-1
327  ix = ix - incx
328  temp = temp + conjg(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*conjg(ap(kk))
350  DO 160 i = j + 1,n
351  temp = temp + conjg(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*conjg(ap(kk))
371  DO 190 k = kk + 1,kk + n - j
372  ix = ix + incx
373  temp = temp + conjg(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 CTPMV .
387 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: