LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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*
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
lsame
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: