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