LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine sspr ( character  UPLO,
integer  N,
real  ALPHA,
real, dimension(*)  X,
integer  INCX,
real, dimension(*)  AP 
)

SSPR

Purpose: 
 SSPR    performs the symmetric rank 1 operation

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

 where alpha is a real scalar, x is an n element vector 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,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 129 of file sspr.f.

129 *
130 * -- Reference BLAS level2 routine (version 3.4.0) --
131 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
132 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
133 * November 2011
134 *
135 * .. Scalar Arguments ..
136  REAL alpha
137  INTEGER incx,n
138  CHARACTER uplo
139 * ..
140 * .. Array Arguments ..
141  REAL ap(*),x(*)
142 * ..
143 *
144 * =====================================================================
145 *
146 * .. Parameters ..
147  REAL zero
148  parameter(zero=0.0e+0)
149 * ..
150 * .. Local Scalars ..
151  REAL temp
152  INTEGER i,info,ix,j,jx,k,kk,kx
153 * ..
154 * .. External Functions ..
155  LOGICAL lsame
156  EXTERNAL lsame
157 * ..
158 * .. External Subroutines ..
159  EXTERNAL xerbla
160 * ..
161 *
162 * Test the input parameters.
163 *
164  info = 0
165  IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
166  info = 1
167  ELSE IF (n.LT.0) THEN
168  info = 2
169  ELSE IF (incx.EQ.0) THEN
170  info = 5
171  END IF
172  IF (info.NE.0) THEN
173  CALL xerbla('SSPR ',info)
174  RETURN
175  END IF
176 *
177 * Quick return if possible.
178 *
179  IF ((n.EQ.0) .OR. (alpha.EQ.zero)) RETURN
180 *
181 * Set the start point in X if the increment is not unity.
182 *
183  IF (incx.LE.0) THEN
184  kx = 1 - (n-1)*incx
185  ELSE IF (incx.NE.1) THEN
186  kx = 1
187  END IF
188 *
189 * Start the operations. In this version the elements of the array AP
190 * are accessed sequentially with one pass through AP.
191 *
192  kk = 1
193  IF (lsame(uplo,'U')) THEN
194 *
195 * Form A when upper triangle is stored in AP.
196 *
197  IF (incx.EQ.1) THEN
198  DO 20 j = 1,n
199  IF (x(j).NE.zero) THEN
200  temp = alpha*x(j)
201  k = kk
202  DO 10 i = 1,j
203  ap(k) = ap(k) + x(i)*temp
204  k = k + 1
205  10 CONTINUE
206  END IF
207  kk = kk + j
208  20 CONTINUE
209  ELSE
210  jx = kx
211  DO 40 j = 1,n
212  IF (x(jx).NE.zero) THEN
213  temp = alpha*x(jx)
214  ix = kx
215  DO 30 k = kk,kk + j - 1
216  ap(k) = ap(k) + x(ix)*temp
217  ix = ix + incx
218  30 CONTINUE
219  END IF
220  jx = jx + incx
221  kk = kk + j
222  40 CONTINUE
223  END IF
224  ELSE
225 *
226 * Form A when lower triangle is stored in AP.
227 *
228  IF (incx.EQ.1) THEN
229  DO 60 j = 1,n
230  IF (x(j).NE.zero) THEN
231  temp = alpha*x(j)
232  k = kk
233  DO 50 i = j,n
234  ap(k) = ap(k) + x(i)*temp
235  k = k + 1
236  50 CONTINUE
237  END IF
238  kk = kk + n - j + 1
239  60 CONTINUE
240  ELSE
241  jx = kx
242  DO 80 j = 1,n
243  IF (x(jx).NE.zero) THEN
244  temp = alpha*x(jx)
245  ix = jx
246  DO 70 k = kk,kk + n - j
247  ap(k) = ap(k) + x(ix)*temp
248  ix = ix + incx
249  70 CONTINUE
250  END IF
251  jx = jx + incx
252  kk = kk + n - j + 1
253  80 CONTINUE
254  END IF
255  END IF
256 *
257  RETURN
258 *
259 * End of SSPR .
260 *
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: