LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
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.```
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)
XERBLA
Definition: xerbla.f:60
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: