1: *> \brief \b DSPR
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: * Definition:
9: * ===========
10: *
11: * SUBROUTINE DSPR(UPLO,N,ALPHA,X,INCX,AP)
12: *
13: * .. Scalar Arguments ..
14: * DOUBLE PRECISION ALPHA
15: * INTEGER INCX,N
16: * CHARACTER UPLO
17: * ..
18: * .. Array Arguments ..
19: * DOUBLE PRECISION AP(*),X(*)
20: * ..
21: *
22: *
23: *> \par Purpose:
24: * =============
25: *>
26: *> \verbatim
27: *>
28: *> DSPR performs the symmetric rank 1 operation
29: *>
30: *> A := alpha*x*x**T + A,
31: *>
32: *> where alpha is a real scalar, x is an n element vector and A is an
33: *> n by n symmetric matrix, supplied in packed form.
34: *> \endverbatim
35: *
36: * Arguments:
37: * ==========
38: *
39: *> \param[in] UPLO
40: *> \verbatim
41: *> UPLO is CHARACTER*1
42: *> On entry, UPLO specifies whether the upper or lower
43: *> triangular part of the matrix A is supplied in the packed
44: *> array AP as follows:
45: *>
46: *> UPLO = 'U' or 'u' The upper triangular part of A is
47: *> supplied in AP.
48: *>
49: *> UPLO = 'L' or 'l' The lower triangular part of A is
50: *> supplied in AP.
51: *> \endverbatim
52: *>
53: *> \param[in] N
54: *> \verbatim
55: *> N is INTEGER
56: *> On entry, N specifies the order of the matrix A.
57: *> N must be at least zero.
58: *> \endverbatim
59: *>
60: *> \param[in] ALPHA
61: *> \verbatim
62: *> ALPHA is DOUBLE PRECISION.
63: *> On entry, ALPHA specifies the scalar alpha.
64: *> \endverbatim
65: *>
66: *> \param[in] X
67: *> \verbatim
68: *> X is DOUBLE PRECISION array, dimension at least
69: *> ( 1 + ( n - 1 )*abs( INCX ) ).
70: *> Before entry, the incremented array X must contain the n
71: *> element vector x.
72: *> \endverbatim
73: *>
74: *> \param[in] INCX
75: *> \verbatim
76: *> INCX is INTEGER
77: *> On entry, INCX specifies the increment for the elements of
78: *> X. INCX must not be zero.
79: *> \endverbatim
80: *>
81: *> \param[in,out] AP
82: *> \verbatim
83: *> AP is DOUBLE PRECISION array, dimension at least
84: *> ( ( n*( n + 1 ) )/2 ).
85: *> Before entry with UPLO = 'U' or 'u', the array AP must
86: *> contain the upper triangular part of the symmetric matrix
87: *> packed sequentially, column by column, so that AP( 1 )
88: *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
89: *> and a( 2, 2 ) respectively, and so on. On exit, the array
90: *> AP is overwritten by the upper triangular part of the
91: *> updated matrix.
92: *> Before entry with UPLO = 'L' or 'l', the array AP must
93: *> contain the lower triangular part of the symmetric matrix
94: *> packed sequentially, column by column, so that AP( 1 )
95: *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
96: *> and a( 3, 1 ) respectively, and so on. On exit, the array
97: *> AP is overwritten by the lower triangular part of the
98: *> updated matrix.
99: *> \endverbatim
100: *
101: * Authors:
102: * ========
103: *
104: *> \author Univ. of Tennessee
105: *> \author Univ. of California Berkeley
106: *> \author Univ. of Colorado Denver
107: *> \author NAG Ltd.
108: *
109: *> \ingroup double_blas_level2
110: *
111: *> \par Further Details:
112: * =====================
113: *>
114: *> \verbatim
115: *>
116: *> Level 2 Blas routine.
117: *>
118: *> -- Written on 22-October-1986.
119: *> Jack Dongarra, Argonne National Lab.
120: *> Jeremy Du Croz, Nag Central Office.
121: *> Sven Hammarling, Nag Central Office.
122: *> Richard Hanson, Sandia National Labs.
123: *> \endverbatim
124: *>
125: * =====================================================================
126: SUBROUTINE DSPR(UPLO,N,ALPHA,X,INCX,AP)
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: *
258: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dspr.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / blas