LAPACK 3.12.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.
180 + .NOT.lsame(trans,'T') .AND.
181 + .NOT.lsame(trans,'C')) THEN
182 info = 2
183 ELSE IF (.NOT.lsame(diag,'U') .AND.
184 + .NOT.lsame(diag,'N')) THEN
185 info = 3
186 ELSE IF (n.LT.0) THEN
187 info = 4
188 ELSE IF (incx.EQ.0) THEN
189 info = 7
190 END IF
191 IF (info.NE.0) THEN
192 CALL xerbla('DTPMV ',info)
193 RETURN
194 END IF
195*
196* Quick return if possible.
197*
198 IF (n.EQ.0) RETURN
199*
200 nounit = lsame(diag,'N')
201*
202* Set up the start point in X if the increment is not unity. This
203* will be ( N - 1 )*INCX too small for descending loops.
204*
205 IF (incx.LE.0) THEN
206 kx = 1 - (n-1)*incx
207 ELSE IF (incx.NE.1) THEN
208 kx = 1
209 END IF
210*
211* Start the operations. In this version the elements of AP are
212* accessed sequentially with one pass through AP.
213*
214 IF (lsame(trans,'N')) THEN
215*
216* Form x:= A*x.
217*
218 IF (lsame(uplo,'U')) THEN
219 kk = 1
220 IF (incx.EQ.1) THEN
221 DO 20 j = 1,n
222 IF (x(j).NE.zero) THEN
223 temp = x(j)
224 k = kk
225 DO 10 i = 1,j - 1
226 x(i) = x(i) + temp*ap(k)
227 k = k + 1
228 10 CONTINUE
229 IF (nounit) x(j) = x(j)*ap(kk+j-1)
230 END IF
231 kk = kk + j
232 20 CONTINUE
233 ELSE
234 jx = kx
235 DO 40 j = 1,n
236 IF (x(jx).NE.zero) THEN
237 temp = x(jx)
238 ix = kx
239 DO 30 k = kk,kk + j - 2
240 x(ix) = x(ix) + temp*ap(k)
241 ix = ix + incx
242 30 CONTINUE
243 IF (nounit) x(jx) = x(jx)*ap(kk+j-1)
244 END IF
245 jx = jx + incx
246 kk = kk + j
247 40 CONTINUE
248 END IF
249 ELSE
250 kk = (n* (n+1))/2
251 IF (incx.EQ.1) THEN
252 DO 60 j = n,1,-1
253 IF (x(j).NE.zero) THEN
254 temp = x(j)
255 k = kk
256 DO 50 i = n,j + 1,-1
257 x(i) = x(i) + temp*ap(k)
258 k = k - 1
259 50 CONTINUE
260 IF (nounit) x(j) = x(j)*ap(kk-n+j)
261 END IF
262 kk = kk - (n-j+1)
263 60 CONTINUE
264 ELSE
265 kx = kx + (n-1)*incx
266 jx = kx
267 DO 80 j = n,1,-1
268 IF (x(jx).NE.zero) THEN
269 temp = x(jx)
270 ix = kx
271 DO 70 k = kk,kk - (n- (j+1)),-1
272 x(ix) = x(ix) + temp*ap(k)
273 ix = ix - incx
274 70 CONTINUE
275 IF (nounit) x(jx) = x(jx)*ap(kk-n+j)
276 END IF
277 jx = jx - incx
278 kk = kk - (n-j+1)
279 80 CONTINUE
280 END IF
281 END IF
282 ELSE
283*
284* Form x := A**T*x.
285*
286 IF (lsame(uplo,'U')) THEN
287 kk = (n* (n+1))/2
288 IF (incx.EQ.1) THEN
289 DO 100 j = n,1,-1
290 temp = x(j)
291 IF (nounit) temp = temp*ap(kk)
292 k = kk - 1
293 DO 90 i = j - 1,1,-1
294 temp = temp + ap(k)*x(i)
295 k = k - 1
296 90 CONTINUE
297 x(j) = temp
298 kk = kk - j
299 100 CONTINUE
300 ELSE
301 jx = kx + (n-1)*incx
302 DO 120 j = n,1,-1
303 temp = x(jx)
304 ix = jx
305 IF (nounit) temp = temp*ap(kk)
306 DO 110 k = kk - 1,kk - j + 1,-1
307 ix = ix - incx
308 temp = temp + ap(k)*x(ix)
309 110 CONTINUE
310 x(jx) = temp
311 jx = jx - incx
312 kk = kk - j
313 120 CONTINUE
314 END IF
315 ELSE
316 kk = 1
317 IF (incx.EQ.1) THEN
318 DO 140 j = 1,n
319 temp = x(j)
320 IF (nounit) temp = temp*ap(kk)
321 k = kk + 1
322 DO 130 i = j + 1,n
323 temp = temp + ap(k)*x(i)
324 k = k + 1
325 130 CONTINUE
326 x(j) = temp
327 kk = kk + (n-j+1)
328 140 CONTINUE
329 ELSE
330 jx = kx
331 DO 160 j = 1,n
332 temp = x(jx)
333 ix = jx
334 IF (nounit) temp = temp*ap(kk)
335 DO 150 k = kk + 1,kk + n - j
336 ix = ix + incx
337 temp = temp + ap(k)*x(ix)
338 150 CONTINUE
339 x(jx) = temp
340 jx = jx + incx
341 kk = kk + (n-j+1)
342 160 CONTINUE
343 END IF
344 END IF
345 END IF
346*
347 RETURN
348*
349* End of DTPMV
350*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: