LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ dtpmv()

subroutine dtpmv ( character  UPLO,
character  TRANS,
character  DIAG,
integer  N,
double precision, dimension(*)  AP,
double precision, dimension(*)  X,
integer  INCX 
)

DTPMV

Purpose:
 DTPMV  performs one of the matrix-vector operations

    x := A*x,   or   x := A**T*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**T*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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 dtpmv.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  DOUBLE PRECISION AP(*),X(*)
153 * ..
154 *
155 * =====================================================================
156 *
157 * .. Parameters ..
158  DOUBLE PRECISION ZERO
159  parameter(zero=0.0d+0)
160 * ..
161 * .. Local Scalars ..
162  DOUBLE PRECISION TEMP
163  INTEGER I,INFO,IX,J,JX,K,KK,KX
164  LOGICAL NOUNIT
165 * ..
166 * .. External Functions ..
167  LOGICAL LSAME
168  EXTERNAL lsame
169 * ..
170 * .. External Subroutines ..
171  EXTERNAL xerbla
172 * ..
173 *
174 * Test the input parameters.
175 *
176  info = 0
177  IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
178  info = 1
179  ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
180  + .NOT.lsame(trans,'C')) THEN
181  info = 2
182  ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
183  info = 3
184  ELSE IF (n.LT.0) THEN
185  info = 4
186  ELSE IF (incx.EQ.0) THEN
187  info = 7
188  END IF
189  IF (info.NE.0) THEN
190  CALL xerbla('DTPMV ',info)
191  RETURN
192  END IF
193 *
194 * Quick return if possible.
195 *
196  IF (n.EQ.0) RETURN
197 *
198  nounit = lsame(diag,'N')
199 *
200 * Set up the start point in X if the increment is not unity. This
201 * will be ( N - 1 )*INCX too small for descending loops.
202 *
203  IF (incx.LE.0) THEN
204  kx = 1 - (n-1)*incx
205  ELSE IF (incx.NE.1) THEN
206  kx = 1
207  END IF
208 *
209 * Start the operations. In this version the elements of AP are
210 * accessed sequentially with one pass through AP.
211 *
212  IF (lsame(trans,'N')) THEN
213 *
214 * Form x:= A*x.
215 *
216  IF (lsame(uplo,'U')) THEN
217  kk = 1
218  IF (incx.EQ.1) THEN
219  DO 20 j = 1,n
220  IF (x(j).NE.zero) THEN
221  temp = x(j)
222  k = kk
223  DO 10 i = 1,j - 1
224  x(i) = x(i) + temp*ap(k)
225  k = k + 1
226  10 CONTINUE
227  IF (nounit) x(j) = x(j)*ap(kk+j-1)
228  END IF
229  kk = kk + j
230  20 CONTINUE
231  ELSE
232  jx = kx
233  DO 40 j = 1,n
234  IF (x(jx).NE.zero) THEN
235  temp = x(jx)
236  ix = kx
237  DO 30 k = kk,kk + j - 2
238  x(ix) = x(ix) + temp*ap(k)
239  ix = ix + incx
240  30 CONTINUE
241  IF (nounit) x(jx) = x(jx)*ap(kk+j-1)
242  END IF
243  jx = jx + incx
244  kk = kk + j
245  40 CONTINUE
246  END IF
247  ELSE
248  kk = (n* (n+1))/2
249  IF (incx.EQ.1) THEN
250  DO 60 j = n,1,-1
251  IF (x(j).NE.zero) THEN
252  temp = x(j)
253  k = kk
254  DO 50 i = n,j + 1,-1
255  x(i) = x(i) + temp*ap(k)
256  k = k - 1
257  50 CONTINUE
258  IF (nounit) x(j) = x(j)*ap(kk-n+j)
259  END IF
260  kk = kk - (n-j+1)
261  60 CONTINUE
262  ELSE
263  kx = kx + (n-1)*incx
264  jx = kx
265  DO 80 j = n,1,-1
266  IF (x(jx).NE.zero) THEN
267  temp = x(jx)
268  ix = kx
269  DO 70 k = kk,kk - (n- (j+1)),-1
270  x(ix) = x(ix) + temp*ap(k)
271  ix = ix - incx
272  70 CONTINUE
273  IF (nounit) x(jx) = x(jx)*ap(kk-n+j)
274  END IF
275  jx = jx - incx
276  kk = kk - (n-j+1)
277  80 CONTINUE
278  END IF
279  END IF
280  ELSE
281 *
282 * Form x := A**T*x.
283 *
284  IF (lsame(uplo,'U')) THEN
285  kk = (n* (n+1))/2
286  IF (incx.EQ.1) THEN
287  DO 100 j = n,1,-1
288  temp = x(j)
289  IF (nounit) temp = temp*ap(kk)
290  k = kk - 1
291  DO 90 i = j - 1,1,-1
292  temp = temp + ap(k)*x(i)
293  k = k - 1
294  90 CONTINUE
295  x(j) = temp
296  kk = kk - j
297  100 CONTINUE
298  ELSE
299  jx = kx + (n-1)*incx
300  DO 120 j = n,1,-1
301  temp = x(jx)
302  ix = jx
303  IF (nounit) temp = temp*ap(kk)
304  DO 110 k = kk - 1,kk - j + 1,-1
305  ix = ix - incx
306  temp = temp + ap(k)*x(ix)
307  110 CONTINUE
308  x(jx) = temp
309  jx = jx - incx
310  kk = kk - j
311  120 CONTINUE
312  END IF
313  ELSE
314  kk = 1
315  IF (incx.EQ.1) THEN
316  DO 140 j = 1,n
317  temp = x(j)
318  IF (nounit) temp = temp*ap(kk)
319  k = kk + 1
320  DO 130 i = j + 1,n
321  temp = temp + ap(k)*x(i)
322  k = k + 1
323  130 CONTINUE
324  x(j) = temp
325  kk = kk + (n-j+1)
326  140 CONTINUE
327  ELSE
328  jx = kx
329  DO 160 j = 1,n
330  temp = x(jx)
331  ix = jx
332  IF (nounit) temp = temp*ap(kk)
333  DO 150 k = kk + 1,kk + n - j
334  ix = ix + incx
335  temp = temp + ap(k)*x(ix)
336  150 CONTINUE
337  x(jx) = temp
338  jx = jx + incx
339  kk = kk + (n-j+1)
340  160 CONTINUE
341  END IF
342  END IF
343  END IF
344 *
345  RETURN
346 *
347 * End of DTPMV .
348 *
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: