LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ dspr()

subroutine dspr ( character  UPLO,
integer  N,
double precision  ALPHA,
double precision, dimension(*)  X,
integer  INCX,
double precision, dimension(*)  AP 
)

DSPR

Purpose:
 DSPR    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 DOUBLE PRECISION.
           On entry, ALPHA specifies the scalar alpha.
[in]X
          X is DOUBLE PRECISION 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,out]AP
          AP is DOUBLE PRECISION 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 126 of file dspr.f.

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