LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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 of 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 of 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 of 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.
Date
November 2011
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 144 of file sspr2.f.

144 *
145 * -- Reference BLAS level2 routine (version 3.4.0) --
146 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
147 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
148 * November 2011
149 *
150 * .. Scalar Arguments ..
151  REAL alpha
152  INTEGER incx,incy,n
153  CHARACTER uplo
154 * ..
155 * .. Array Arguments ..
156  REAL ap(*),x(*),y(*)
157 * ..
158 *
159 * =====================================================================
160 *
161 * .. Parameters ..
162  REAL zero
163  parameter(zero=0.0e+0)
164 * ..
165 * .. Local Scalars ..
166  REAL temp1,temp2
167  INTEGER i,info,ix,iy,j,jx,jy,k,kk,kx,ky
168 * ..
169 * .. External Functions ..
170  LOGICAL lsame
171  EXTERNAL lsame
172 * ..
173 * .. External Subroutines ..
174  EXTERNAL xerbla
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 (n.LT.0) THEN
183  info = 2
184  ELSE IF (incx.EQ.0) THEN
185  info = 5
186  ELSE IF (incy.EQ.0) THEN
187  info = 7
188  END IF
189  IF (info.NE.0) THEN
190  CALL xerbla('SSPR2 ',info)
191  RETURN
192  END IF
193 *
194 * Quick return if possible.
195 *
196  IF ((n.EQ.0) .OR. (alpha.EQ.zero)) RETURN
197 *
198 * Set up the start points in X and Y if the increments are not both
199 * unity.
200 *
201  IF ((incx.NE.1) .OR. (incy.NE.1)) THEN
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  jx = kx
213  jy = ky
214  END IF
215 *
216 * Start the operations. In this version the elements of the array AP
217 * are accessed sequentially with one pass through AP.
218 *
219  kk = 1
220  IF (lsame(uplo,'U')) THEN
221 *
222 * Form A when upper triangle is stored in AP.
223 *
224  IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
225  DO 20 j = 1,n
226  IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
227  temp1 = alpha*y(j)
228  temp2 = alpha*x(j)
229  k = kk
230  DO 10 i = 1,j
231  ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
232  k = k + 1
233  10 CONTINUE
234  END IF
235  kk = kk + j
236  20 CONTINUE
237  ELSE
238  DO 40 j = 1,n
239  IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
240  temp1 = alpha*y(jy)
241  temp2 = alpha*x(jx)
242  ix = kx
243  iy = ky
244  DO 30 k = kk,kk + j - 1
245  ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
246  ix = ix + incx
247  iy = iy + incy
248  30 CONTINUE
249  END IF
250  jx = jx + incx
251  jy = jy + incy
252  kk = kk + j
253  40 CONTINUE
254  END IF
255  ELSE
256 *
257 * Form A when lower triangle is stored in AP.
258 *
259  IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
260  DO 60 j = 1,n
261  IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
262  temp1 = alpha*y(j)
263  temp2 = alpha*x(j)
264  k = kk
265  DO 50 i = j,n
266  ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
267  k = k + 1
268  50 CONTINUE
269  END IF
270  kk = kk + n - j + 1
271  60 CONTINUE
272  ELSE
273  DO 80 j = 1,n
274  IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
275  temp1 = alpha*y(jy)
276  temp2 = alpha*x(jx)
277  ix = jx
278  iy = jy
279  DO 70 k = kk,kk + n - j
280  ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
281  ix = ix + incx
282  iy = iy + incy
283  70 CONTINUE
284  END IF
285  jx = jx + incx
286  jy = jy + incy
287  kk = kk + n - j + 1
288  80 CONTINUE
289  END IF
290  END IF
291 *
292  RETURN
293 *
294 * End of SSPR2 .
295 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: