1: SUBROUTINE DSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
2: * .. Scalar Arguments ..
3: DOUBLE PRECISION ALPHA,BETA
4: INTEGER INCX,INCY,LDA,N
5: CHARACTER UPLO
6: * ..
7: * .. Array Arguments ..
8: DOUBLE PRECISION A(LDA,*),X(*),Y(*)
9: * ..
10: *
11: * Purpose
12: * =======
13: *
14: * DSYMV performs the matrix-vector operation
15: *
16: * y := alpha*A*x + beta*y,
17: *
18: * where alpha and beta are scalars, x and y are n element vectors and
19: * A is an n by n symmetric matrix.
20: *
21: * Arguments
22: * ==========
23: *
24: * UPLO - CHARACTER*1.
25: * On entry, UPLO specifies whether the upper or lower
26: * triangular part of the array A is to be referenced as
27: * follows:
28: *
29: * UPLO = 'U' or 'u' Only the upper triangular part of A
30: * is to be referenced.
31: *
32: * UPLO = 'L' or 'l' Only the lower triangular part of A
33: * is to be referenced.
34: *
35: * Unchanged on exit.
36: *
37: * N - INTEGER.
38: * On entry, N specifies the order of the matrix A.
39: * N must be at least zero.
40: * Unchanged on exit.
41: *
42: * ALPHA - DOUBLE PRECISION.
43: * On entry, ALPHA specifies the scalar alpha.
44: * Unchanged on exit.
45: *
46: * A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
47: * Before entry with UPLO = 'U' or 'u', the leading n by n
48: * upper triangular part of the array A must contain the upper
49: * triangular part of the symmetric matrix and the strictly
50: * lower triangular part of A is not referenced.
51: * Before entry with UPLO = 'L' or 'l', the leading n by n
52: * lower triangular part of the array A must contain the lower
53: * triangular part of the symmetric matrix and the strictly
54: * upper triangular part of A is not referenced.
55: * Unchanged on exit.
56: *
57: * LDA - INTEGER.
58: * On entry, LDA specifies the first dimension of A as declared
59: * in the calling (sub) program. LDA must be at least
60: * max( 1, n ).
61: * Unchanged on exit.
62: *
63: * X - DOUBLE PRECISION array of dimension at least
64: * ( 1 + ( n - 1 )*abs( INCX ) ).
65: * Before entry, the incremented array X must contain the n
66: * element vector x.
67: * Unchanged on exit.
68: *
69: * INCX - INTEGER.
70: * On entry, INCX specifies the increment for the elements of
71: * X. INCX must not be zero.
72: * Unchanged on exit.
73: *
74: * BETA - DOUBLE PRECISION.
75: * On entry, BETA specifies the scalar beta. When BETA is
76: * supplied as zero then Y need not be set on input.
77: * Unchanged on exit.
78: *
79: * Y - DOUBLE PRECISION array of dimension at least
80: * ( 1 + ( n - 1 )*abs( INCY ) ).
81: * Before entry, the incremented array Y must contain the n
82: * element vector y. On exit, Y is overwritten by the updated
83: * vector y.
84: *
85: * INCY - INTEGER.
86: * On entry, INCY specifies the increment for the elements of
87: * Y. INCY must not be zero.
88: * Unchanged on exit.
89: *
90: * Further Details
91: * ===============
92: *
93: * Level 2 Blas routine.
94: *
95: * -- Written on 22-October-1986.
96: * Jack Dongarra, Argonne National Lab.
97: * Jeremy Du Croz, Nag Central Office.
98: * Sven Hammarling, Nag Central Office.
99: * Richard Hanson, Sandia National Labs.
100: *
101: * =====================================================================
102: *
103: * .. Parameters ..
104: DOUBLE PRECISION ONE,ZERO
105: PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
106: * ..
107: * .. Local Scalars ..
108: DOUBLE PRECISION TEMP1,TEMP2
109: INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
110: * ..
111: * .. External Functions ..
112: LOGICAL LSAME
113: EXTERNAL LSAME
114: * ..
115: * .. External Subroutines ..
116: EXTERNAL XERBLA
117: * ..
118: * .. Intrinsic Functions ..
119: INTRINSIC MAX
120: * ..
121: *
122: * Test the input parameters.
123: *
124: INFO = 0
125: IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
126: INFO = 1
127: ELSE IF (N.LT.0) THEN
128: INFO = 2
129: ELSE IF (LDA.LT.MAX(1,N)) THEN
130: INFO = 5
131: ELSE IF (INCX.EQ.0) THEN
132: INFO = 7
133: ELSE IF (INCY.EQ.0) THEN
134: INFO = 10
135: END IF
136: IF (INFO.NE.0) THEN
137: CALL XERBLA('DSYMV ',INFO)
138: RETURN
139: END IF
140: *
141: * Quick return if possible.
142: *
143: IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
144: *
145: * Set up the start points in X and Y.
146: *
147: IF (INCX.GT.0) THEN
148: KX = 1
149: ELSE
150: KX = 1 - (N-1)*INCX
151: END IF
152: IF (INCY.GT.0) THEN
153: KY = 1
154: ELSE
155: KY = 1 - (N-1)*INCY
156: END IF
157: *
158: * Start the operations. In this version the elements of A are
159: * accessed sequentially with one pass through the triangular part
160: * of A.
161: *
162: * First form y := beta*y.
163: *
164: IF (BETA.NE.ONE) THEN
165: IF (INCY.EQ.1) THEN
166: IF (BETA.EQ.ZERO) THEN
167: DO 10 I = 1,N
168: Y(I) = ZERO
169: 10 CONTINUE
170: ELSE
171: DO 20 I = 1,N
172: Y(I) = BETA*Y(I)
173: 20 CONTINUE
174: END IF
175: ELSE
176: IY = KY
177: IF (BETA.EQ.ZERO) THEN
178: DO 30 I = 1,N
179: Y(IY) = ZERO
180: IY = IY + INCY
181: 30 CONTINUE
182: ELSE
183: DO 40 I = 1,N
184: Y(IY) = BETA*Y(IY)
185: IY = IY + INCY
186: 40 CONTINUE
187: END IF
188: END IF
189: END IF
190: IF (ALPHA.EQ.ZERO) RETURN
191: IF (LSAME(UPLO,'U')) THEN
192: *
193: * Form y when A is stored in upper triangle.
194: *
195: IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
196: DO 60 J = 1,N
197: TEMP1 = ALPHA*X(J)
198: TEMP2 = ZERO
199: DO 50 I = 1,J - 1
200: Y(I) = Y(I) + TEMP1*A(I,J)
201: TEMP2 = TEMP2 + A(I,J)*X(I)
202: 50 CONTINUE
203: Y(J) = Y(J) + TEMP1*A(J,J) + ALPHA*TEMP2
204: 60 CONTINUE
205: ELSE
206: JX = KX
207: JY = KY
208: DO 80 J = 1,N
209: TEMP1 = ALPHA*X(JX)
210: TEMP2 = ZERO
211: IX = KX
212: IY = KY
213: DO 70 I = 1,J - 1
214: Y(IY) = Y(IY) + TEMP1*A(I,J)
215: TEMP2 = TEMP2 + A(I,J)*X(IX)
216: IX = IX + INCX
217: IY = IY + INCY
218: 70 CONTINUE
219: Y(JY) = Y(JY) + TEMP1*A(J,J) + ALPHA*TEMP2
220: JX = JX + INCX
221: JY = JY + INCY
222: 80 CONTINUE
223: END IF
224: ELSE
225: *
226: * Form y when A is stored in lower triangle.
227: *
228: IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
229: DO 100 J = 1,N
230: TEMP1 = ALPHA*X(J)
231: TEMP2 = ZERO
232: Y(J) = Y(J) + TEMP1*A(J,J)
233: DO 90 I = J + 1,N
234: Y(I) = Y(I) + TEMP1*A(I,J)
235: TEMP2 = TEMP2 + A(I,J)*X(I)
236: 90 CONTINUE
237: Y(J) = Y(J) + ALPHA*TEMP2
238: 100 CONTINUE
239: ELSE
240: JX = KX
241: JY = KY
242: DO 120 J = 1,N
243: TEMP1 = ALPHA*X(JX)
244: TEMP2 = ZERO
245: Y(JY) = Y(JY) + TEMP1*A(J,J)
246: IX = JX
247: IY = JY
248: DO 110 I = J + 1,N
249: IX = IX + INCX
250: IY = IY + INCY
251: Y(IY) = Y(IY) + TEMP1*A(I,J)
252: TEMP2 = TEMP2 + A(I,J)*X(IX)
253: 110 CONTINUE
254: Y(JY) = Y(JY) + ALPHA*TEMP2
255: JX = JX + INCX
256: JY = JY + INCY
257: 120 CONTINUE
258: END IF
259: END IF
260: *
261: RETURN
262: *
263: * End of DSYMV .
264: *
265: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dsymv.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / blas