LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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)
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: