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

◆ ctpmv()

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, 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, 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 ctpmv.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 AP(*),X(*)
153* ..
154*
155* =====================================================================
156*
157* .. Parameters ..
158 COMPLEX ZERO
159 parameter(zero= (0.0e+0,0.0e+0))
160* ..
161* .. Local Scalars ..
162 COMPLEX 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 conjg
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.
183 + .NOT.lsame(trans,'T') .AND.
184 + .NOT.lsame(trans,'C')) THEN
185 info = 2
186 ELSE IF (.NOT.lsame(diag,'U') .AND.
187 + .NOT.lsame(diag,'N')) THEN
188 info = 3
189 ELSE IF (n.LT.0) THEN
190 info = 4
191 ELSE IF (incx.EQ.0) THEN
192 info = 7
193 END IF
194 IF (info.NE.0) THEN
195 CALL xerbla('CTPMV ',info)
196 RETURN
197 END IF
198*
199* Quick return if possible.
200*
201 IF (n.EQ.0) RETURN
202*
203 noconj = lsame(trans,'T')
204 nounit = lsame(diag,'N')
205*
206* Set up the start point in X if the increment is not unity. This
207* will be ( N - 1 )*INCX too small for descending loops.
208*
209 IF (incx.LE.0) THEN
210 kx = 1 - (n-1)*incx
211 ELSE IF (incx.NE.1) THEN
212 kx = 1
213 END IF
214*
215* Start the operations. In this version the elements of AP are
216* accessed sequentially with one pass through AP.
217*
218 IF (lsame(trans,'N')) THEN
219*
220* Form x:= A*x.
221*
222 IF (lsame(uplo,'U')) THEN
223 kk = 1
224 IF (incx.EQ.1) THEN
225 DO 20 j = 1,n
226 IF (x(j).NE.zero) THEN
227 temp = x(j)
228 k = kk
229 DO 10 i = 1,j - 1
230 x(i) = x(i) + temp*ap(k)
231 k = k + 1
232 10 CONTINUE
233 IF (nounit) x(j) = x(j)*ap(kk+j-1)
234 END IF
235 kk = kk + j
236 20 CONTINUE
237 ELSE
238 jx = kx
239 DO 40 j = 1,n
240 IF (x(jx).NE.zero) THEN
241 temp = x(jx)
242 ix = kx
243 DO 30 k = kk,kk + j - 2
244 x(ix) = x(ix) + temp*ap(k)
245 ix = ix + incx
246 30 CONTINUE
247 IF (nounit) x(jx) = x(jx)*ap(kk+j-1)
248 END IF
249 jx = jx + incx
250 kk = kk + j
251 40 CONTINUE
252 END IF
253 ELSE
254 kk = (n* (n+1))/2
255 IF (incx.EQ.1) THEN
256 DO 60 j = n,1,-1
257 IF (x(j).NE.zero) THEN
258 temp = x(j)
259 k = kk
260 DO 50 i = n,j + 1,-1
261 x(i) = x(i) + temp*ap(k)
262 k = k - 1
263 50 CONTINUE
264 IF (nounit) x(j) = x(j)*ap(kk-n+j)
265 END IF
266 kk = kk - (n-j+1)
267 60 CONTINUE
268 ELSE
269 kx = kx + (n-1)*incx
270 jx = kx
271 DO 80 j = n,1,-1
272 IF (x(jx).NE.zero) THEN
273 temp = x(jx)
274 ix = kx
275 DO 70 k = kk,kk - (n- (j+1)),-1
276 x(ix) = x(ix) + temp*ap(k)
277 ix = ix - incx
278 70 CONTINUE
279 IF (nounit) x(jx) = x(jx)*ap(kk-n+j)
280 END IF
281 jx = jx - incx
282 kk = kk - (n-j+1)
283 80 CONTINUE
284 END IF
285 END IF
286 ELSE
287*
288* Form x := A**T*x or x := A**H*x.
289*
290 IF (lsame(uplo,'U')) THEN
291 kk = (n* (n+1))/2
292 IF (incx.EQ.1) THEN
293 DO 110 j = n,1,-1
294 temp = x(j)
295 k = kk - 1
296 IF (noconj) THEN
297 IF (nounit) temp = temp*ap(kk)
298 DO 90 i = j - 1,1,-1
299 temp = temp + ap(k)*x(i)
300 k = k - 1
301 90 CONTINUE
302 ELSE
303 IF (nounit) temp = temp*conjg(ap(kk))
304 DO 100 i = j - 1,1,-1
305 temp = temp + conjg(ap(k))*x(i)
306 k = k - 1
307 100 CONTINUE
308 END IF
309 x(j) = temp
310 kk = kk - j
311 110 CONTINUE
312 ELSE
313 jx = kx + (n-1)*incx
314 DO 140 j = n,1,-1
315 temp = x(jx)
316 ix = jx
317 IF (noconj) THEN
318 IF (nounit) temp = temp*ap(kk)
319 DO 120 k = kk - 1,kk - j + 1,-1
320 ix = ix - incx
321 temp = temp + ap(k)*x(ix)
322 120 CONTINUE
323 ELSE
324 IF (nounit) temp = temp*conjg(ap(kk))
325 DO 130 k = kk - 1,kk - j + 1,-1
326 ix = ix - incx
327 temp = temp + conjg(ap(k))*x(ix)
328 130 CONTINUE
329 END IF
330 x(jx) = temp
331 jx = jx - incx
332 kk = kk - j
333 140 CONTINUE
334 END IF
335 ELSE
336 kk = 1
337 IF (incx.EQ.1) THEN
338 DO 170 j = 1,n
339 temp = x(j)
340 k = kk + 1
341 IF (noconj) THEN
342 IF (nounit) temp = temp*ap(kk)
343 DO 150 i = j + 1,n
344 temp = temp + ap(k)*x(i)
345 k = k + 1
346 150 CONTINUE
347 ELSE
348 IF (nounit) temp = temp*conjg(ap(kk))
349 DO 160 i = j + 1,n
350 temp = temp + conjg(ap(k))*x(i)
351 k = k + 1
352 160 CONTINUE
353 END IF
354 x(j) = temp
355 kk = kk + (n-j+1)
356 170 CONTINUE
357 ELSE
358 jx = kx
359 DO 200 j = 1,n
360 temp = x(jx)
361 ix = jx
362 IF (noconj) THEN
363 IF (nounit) temp = temp*ap(kk)
364 DO 180 k = kk + 1,kk + n - j
365 ix = ix + incx
366 temp = temp + ap(k)*x(ix)
367 180 CONTINUE
368 ELSE
369 IF (nounit) temp = temp*conjg(ap(kk))
370 DO 190 k = kk + 1,kk + n - j
371 ix = ix + incx
372 temp = temp + conjg(ap(k))*x(ix)
373 190 CONTINUE
374 END IF
375 x(jx) = temp
376 jx = jx + incx
377 kk = kk + (n-j+1)
378 200 CONTINUE
379 END IF
380 END IF
381 END IF
382*
383 RETURN
384*
385* End of CTPMV
386*
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: