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

◆ sspr2()

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

SSPR2

Purpose:
 SSPR2  performs the symmetric rank 2 operation

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

 where alpha is a scalar, 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]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]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.
[in]INCY
          INCY is INTEGER
           On entry, INCY specifies the increment for the elements of
           Y. INCY must not be zero.
[in,out]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. On exit, the array
           AP is overwritten by the upper triangular part of the
           updated matrix.
           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. On exit, the array
           AP is overwritten by the lower triangular part of the
           updated matrix.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
  Level 2 Blas routine.

  -- 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 sspr2.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 REAL ALPHA
149 INTEGER INCX,INCY,N
150 CHARACTER UPLO
151* ..
152* .. Array Arguments ..
153 REAL AP(*),X(*),Y(*)
154* ..
155*
156* =====================================================================
157*
158* .. Parameters ..
159 REAL ZERO
160 parameter(zero=0.0e+0)
161* ..
162* .. Local Scalars ..
163 REAL TEMP1,TEMP2
164 INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
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 (n.LT.0) THEN
180 info = 2
181 ELSE IF (incx.EQ.0) THEN
182 info = 5
183 ELSE IF (incy.EQ.0) THEN
184 info = 7
185 END IF
186 IF (info.NE.0) THEN
187 CALL xerbla('SSPR2 ',info)
188 RETURN
189 END IF
190*
191* Quick return if possible.
192*
193 IF ((n.EQ.0) .OR. (alpha.EQ.zero)) RETURN
194*
195* Set up the start points in X and Y if the increments are not both
196* unity.
197*
198 IF ((incx.NE.1) .OR. (incy.NE.1)) THEN
199 IF (incx.GT.0) THEN
200 kx = 1
201 ELSE
202 kx = 1 - (n-1)*incx
203 END IF
204 IF (incy.GT.0) THEN
205 ky = 1
206 ELSE
207 ky = 1 - (n-1)*incy
208 END IF
209 jx = kx
210 jy = ky
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 kk = 1
217 IF (lsame(uplo,'U')) THEN
218*
219* Form A when upper triangle is stored in AP.
220*
221 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
222 DO 20 j = 1,n
223 IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
224 temp1 = alpha*y(j)
225 temp2 = alpha*x(j)
226 k = kk
227 DO 10 i = 1,j
228 ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
229 k = k + 1
230 10 CONTINUE
231 END IF
232 kk = kk + j
233 20 CONTINUE
234 ELSE
235 DO 40 j = 1,n
236 IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
237 temp1 = alpha*y(jy)
238 temp2 = alpha*x(jx)
239 ix = kx
240 iy = ky
241 DO 30 k = kk,kk + j - 1
242 ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
243 ix = ix + incx
244 iy = iy + incy
245 30 CONTINUE
246 END IF
247 jx = jx + incx
248 jy = jy + incy
249 kk = kk + j
250 40 CONTINUE
251 END IF
252 ELSE
253*
254* Form A when lower triangle is stored in AP.
255*
256 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
257 DO 60 j = 1,n
258 IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
259 temp1 = alpha*y(j)
260 temp2 = alpha*x(j)
261 k = kk
262 DO 50 i = j,n
263 ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
264 k = k + 1
265 50 CONTINUE
266 END IF
267 kk = kk + n - j + 1
268 60 CONTINUE
269 ELSE
270 DO 80 j = 1,n
271 IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
272 temp1 = alpha*y(jy)
273 temp2 = alpha*x(jx)
274 ix = jx
275 iy = jy
276 DO 70 k = kk,kk + n - j
277 ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
278 ix = ix + incx
279 iy = iy + incy
280 70 CONTINUE
281 END IF
282 jx = jx + incx
283 jy = jy + incy
284 kk = kk + n - j + 1
285 80 CONTINUE
286 END IF
287 END IF
288*
289 RETURN
290*
291* End of SSPR2
292*
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: