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

◆ sspmv()

subroutine sspmv ( character  uplo,
integer  n,
real  alpha,
real, dimension(*)  ap,
real, dimension(*)  x,
integer  incx,
real  beta,
real, dimension(*)  y,
integer  incy 
)

SSPMV

Purpose:
 SSPMV  performs the matrix-vector operation

    y := alpha*A*x + beta*y,

 where alpha and beta are scalars, x and y are n element vectors and
 A is an n by n symmetric matrix, supplied in packed form.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
           On entry, UPLO specifies whether the upper or lower
           triangular part of the matrix A is supplied in the packed
           array AP as follows:

              UPLO = 'U' or 'u'   The upper triangular part of A is
                                  supplied in AP.

              UPLO = 'L' or 'l'   The lower triangular part of A is
                                  supplied in AP.
[in]N
          N is INTEGER
           On entry, N specifies the order of the matrix A.
           N must be at least zero.
[in]ALPHA
          ALPHA is REAL
           On entry, ALPHA specifies the scalar alpha.
[in]AP
          AP is REAL array, dimension at least
           ( ( n*( n + 1 ) )/2 ).
           Before entry with UPLO = 'U' or 'u', the array AP must
           contain the upper triangular part of the symmetric 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 part of the symmetric 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.
[in]X
          X is REAL array, dimension at least
           ( 1 + ( n - 1 )*abs( INCX ) ).
           Before entry, the incremented array X must contain the n
           element vector x.
[in]INCX
          INCX is INTEGER
           On entry, INCX specifies the increment for the elements of
           X. INCX must not be zero.
[in]BETA
          BETA is REAL
           On entry, BETA specifies the scalar beta. When BETA is
           supplied as zero then Y need not be set on input.
[in,out]Y
          Y is REAL array, dimension at least
           ( 1 + ( n - 1 )*abs( INCY ) ).
           Before entry, the incremented array Y must contain the n
           element vector y. On exit, Y is overwritten by the updated
           vector y.
[in]INCY
          INCY is INTEGER
           On entry, INCY specifies the increment for the elements of
           Y. INCY 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 146 of file sspmv.f.

147*
148* -- Reference BLAS level2 routine --
149* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
150* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
151*
152* .. Scalar Arguments ..
153 REAL ALPHA,BETA
154 INTEGER INCX,INCY,N
155 CHARACTER UPLO
156* ..
157* .. Array Arguments ..
158 REAL AP(*),X(*),Y(*)
159* ..
160*
161* =====================================================================
162*
163* .. Parameters ..
164 REAL ONE,ZERO
165 parameter(one=1.0e+0,zero=0.0e+0)
166* ..
167* .. Local Scalars ..
168 REAL TEMP1,TEMP2
169 INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
170* ..
171* .. External Functions ..
172 LOGICAL LSAME
173 EXTERNAL lsame
174* ..
175* .. External Subroutines ..
176 EXTERNAL xerbla
177* ..
178*
179* Test the input parameters.
180*
181 info = 0
182 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
183 info = 1
184 ELSE IF (n.LT.0) THEN
185 info = 2
186 ELSE IF (incx.EQ.0) THEN
187 info = 6
188 ELSE IF (incy.EQ.0) THEN
189 info = 9
190 END IF
191 IF (info.NE.0) THEN
192 CALL xerbla('SSPMV ',info)
193 RETURN
194 END IF
195*
196* Quick return if possible.
197*
198 IF ((n.EQ.0) .OR. ((alpha.EQ.zero).AND. (beta.EQ.one))) RETURN
199*
200* Set up the start points in X and Y.
201*
202 IF (incx.GT.0) THEN
203 kx = 1
204 ELSE
205 kx = 1 - (n-1)*incx
206 END IF
207 IF (incy.GT.0) THEN
208 ky = 1
209 ELSE
210 ky = 1 - (n-1)*incy
211 END IF
212*
213* Start the operations. In this version the elements of the array AP
214* are accessed sequentially with one pass through AP.
215*
216* First form y := beta*y.
217*
218 IF (beta.NE.one) THEN
219 IF (incy.EQ.1) THEN
220 IF (beta.EQ.zero) THEN
221 DO 10 i = 1,n
222 y(i) = zero
223 10 CONTINUE
224 ELSE
225 DO 20 i = 1,n
226 y(i) = beta*y(i)
227 20 CONTINUE
228 END IF
229 ELSE
230 iy = ky
231 IF (beta.EQ.zero) THEN
232 DO 30 i = 1,n
233 y(iy) = zero
234 iy = iy + incy
235 30 CONTINUE
236 ELSE
237 DO 40 i = 1,n
238 y(iy) = beta*y(iy)
239 iy = iy + incy
240 40 CONTINUE
241 END IF
242 END IF
243 END IF
244 IF (alpha.EQ.zero) RETURN
245 kk = 1
246 IF (lsame(uplo,'U')) THEN
247*
248* Form y when AP contains the upper triangle.
249*
250 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
251 DO 60 j = 1,n
252 temp1 = alpha*x(j)
253 temp2 = zero
254 k = kk
255 DO 50 i = 1,j - 1
256 y(i) = y(i) + temp1*ap(k)
257 temp2 = temp2 + ap(k)*x(i)
258 k = k + 1
259 50 CONTINUE
260 y(j) = y(j) + temp1*ap(kk+j-1) + alpha*temp2
261 kk = kk + j
262 60 CONTINUE
263 ELSE
264 jx = kx
265 jy = ky
266 DO 80 j = 1,n
267 temp1 = alpha*x(jx)
268 temp2 = zero
269 ix = kx
270 iy = ky
271 DO 70 k = kk,kk + j - 2
272 y(iy) = y(iy) + temp1*ap(k)
273 temp2 = temp2 + ap(k)*x(ix)
274 ix = ix + incx
275 iy = iy + incy
276 70 CONTINUE
277 y(jy) = y(jy) + temp1*ap(kk+j-1) + alpha*temp2
278 jx = jx + incx
279 jy = jy + incy
280 kk = kk + j
281 80 CONTINUE
282 END IF
283 ELSE
284*
285* Form y when AP contains the lower triangle.
286*
287 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
288 DO 100 j = 1,n
289 temp1 = alpha*x(j)
290 temp2 = zero
291 y(j) = y(j) + temp1*ap(kk)
292 k = kk + 1
293 DO 90 i = j + 1,n
294 y(i) = y(i) + temp1*ap(k)
295 temp2 = temp2 + ap(k)*x(i)
296 k = k + 1
297 90 CONTINUE
298 y(j) = y(j) + alpha*temp2
299 kk = kk + (n-j+1)
300 100 CONTINUE
301 ELSE
302 jx = kx
303 jy = ky
304 DO 120 j = 1,n
305 temp1 = alpha*x(jx)
306 temp2 = zero
307 y(jy) = y(jy) + temp1*ap(kk)
308 ix = jx
309 iy = jy
310 DO 110 k = kk + 1,kk + n - j
311 ix = ix + incx
312 iy = iy + incy
313 y(iy) = y(iy) + temp1*ap(k)
314 temp2 = temp2 + ap(k)*x(ix)
315 110 CONTINUE
316 y(jy) = y(jy) + alpha*temp2
317 jx = jx + incx
318 jy = jy + incy
319 kk = kk + (n-j+1)
320 120 CONTINUE
321 END IF
322 END IF
323*
324 RETURN
325*
326* End of SSPMV
327*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
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: