LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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)
Definition cblat2.f:3285
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: