SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
casymv.f
Go to the documentation of this file.
1 SUBROUTINE casymv( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
2 $ INCY )
3*
4* -- PBLAS auxiliary routine (version 2.0) --
5* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6* and University of California, Berkeley.
7* April 1, 1998
8*
9* .. Scalar Arguments ..
10 CHARACTER*1 UPLO
11 INTEGER INCX, INCY, LDA, N
12 REAL ALPHA, BETA
13* ..
14* .. Array Arguments ..
15 REAL Y( * )
16 COMPLEX A( LDA, * ), X( * )
17* ..
18*
19* Purpose
20* =======
21*
22* CASYMV performs the following matrix-vector operation
23*
24* y := abs( alpha )*abs( A )*abs( x )+ abs( beta*y ),
25*
26* where alpha and beta are real scalars, y is a real vector, x is a
27* vector and A is an n by n symmetric matrix.
28*
29* Arguments
30* =========
31*
32* UPLO (input) CHARACTER*1
33* On entry, UPLO specifies whether the upper or lower triangu-
34* lar part of the array A is to be referenced as follows:
35*
36* UPLO = 'U' or 'u' Only the upper triangular part of A is
37* to be referenced.
38* UPLO = 'L' or 'l' Only the lower triangular part of A is
39* to be referenced.
40*
41* N (input) INTEGER
42* On entry, N specifies the order of the matrix A. N must be at
43* least zero.
44*
45* ALPHA (input) REAL
46* On entry, ALPHA specifies the real scalar alpha.
47*
48* A (input) COMPLEX array
49* On entry, A is an array of dimension (LDA,N). Before entry
50* with UPLO = 'U' or 'u', the leading n by n part of the array
51* A must contain the upper triangular part of the symmetric ma-
52* trix and the strictly lower triangular part of A is not refe-
53* renced. When UPLO = 'L' or 'l', the leading n by n part of
54* the array A must contain the lower triangular part of the
55* symmetric matrix and the strictly upper trapezoidal part of A
56* is not referenced.
57*
58* LDA (input) INTEGER
59* On entry, LDA specifies the leading dimension of the array A.
60* LDA must be at least max( 1, N ).
61*
62* X (input) COMPLEX array of dimension at least
63* ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented
64* array X must contain the vector x.
65*
66* INCX (input) INTEGER
67* On entry, INCX specifies the increment for the elements of X.
68* INCX must not be zero.
69*
70* BETA (input) REAL
71* On entry, BETA specifies the real scalar beta. When BETA is
72* supplied as zero then Y need not be set on input.
73*
74* Y (input/output) REAL array of dimension at least
75* ( 1 + ( n - 1 )*abs( INCY ) ). Before entry with BETA non-
76* zero, the incremented array Y must contain the vector y. On
77* exit, the incremented array Y is overwritten by the updated
78* vector y.
79*
80* INCY (input) INTEGER
81* On entry, INCY specifies the increment for the elements of Y.
82* INCY must not be zero.
83*
84* -- Written on April 1, 1998 by
85* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
86*
87* =====================================================================
88*
89* .. Parameters ..
90 REAL ONE, ZERO
91 parameter( one = 1.0e+0, zero = 0.0e+0 )
92* ..
93* .. Local Scalars ..
94 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
95 REAL TALPHA, TEMP0, TEMP1, TEMP2
96 COMPLEX ZDUM
97* ..
98* .. External Functions ..
99 LOGICAL LSAME
100 EXTERNAL lsame
101* ..
102* .. External Subroutines ..
103 EXTERNAL xerbla
104* ..
105* .. Intrinsic Functions ..
106 INTRINSIC abs, aimag, max, real
107* ..
108* .. Statement Functions ..
109 REAL CABS1
110 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
111* ..
112* .. Executable Statements ..
113*
114* Test the input parameters.
115*
116 info = 0
117 IF ( .NOT.lsame( uplo, 'U' ).AND.
118 $ .NOT.lsame( uplo, 'L' ) )THEN
119 info = 1
120 ELSE IF( n.LT.0 )THEN
121 info = 2
122 ELSE IF( lda.LT.max( 1, n ) )THEN
123 info = 5
124 ELSE IF( incx.EQ.0 )THEN
125 info = 7
126 ELSE IF( incy.EQ.0 )THEN
127 info = 10
128 END IF
129 IF( info.NE.0 )THEN
130 CALL xerbla( 'CASYMV', info )
131 RETURN
132 END IF
133*
134* Quick return if possible.
135*
136 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
137 $ RETURN
138*
139* Set up the start points in X and Y.
140*
141 IF( incx.GT.0 ) THEN
142 kx = 1
143 ELSE
144 kx = 1 - ( n - 1 ) * incx
145 END IF
146 IF( incy.GT.0 )THEN
147 ky = 1
148 ELSE
149 ky = 1 - ( n - 1 ) * incy
150 END IF
151*
152* Start the operations. In this version the elements of A are
153* accessed sequentially with one pass through the triangular part
154* of A.
155*
156* First form y := abs( beta * y ).
157*
158 IF( beta.NE.one ) THEN
159 IF( incy.EQ.1 ) THEN
160 IF( beta.EQ.zero ) THEN
161 DO 10, i = 1, n
162 y( i ) = zero
163 10 CONTINUE
164 ELSE
165 DO 20, i = 1, n
166 y( i ) = abs( beta * y( i ) )
167 20 CONTINUE
168 END IF
169 ELSE
170 iy = ky
171 IF( beta.EQ.zero ) THEN
172 DO 30, i = 1, n
173 y( iy ) = zero
174 iy = iy + incy
175 30 CONTINUE
176 ELSE
177 DO 40, i = 1, n
178 y( iy ) = abs( beta * y( iy ) )
179 iy = iy + incy
180 40 CONTINUE
181 END IF
182 END IF
183 END IF
184*
185 IF( alpha.EQ.zero )
186 $ RETURN
187*
188 talpha = abs( alpha )
189*
190 IF( lsame( uplo, 'U' ) ) THEN
191*
192* Form y when A is stored in upper triangle.
193*
194 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) ) THEN
195 DO 60, j = 1, n
196 temp1 = talpha * cabs1( x( j ) )
197 temp2 = zero
198 DO 50, i = 1, j - 1
199 temp0 = cabs1( a( i, j ) )
200 y( i ) = y( i ) + temp1 * temp0
201 temp2 = temp2 + temp0 * cabs1( x( i ) )
202 50 CONTINUE
203 y( j ) = y( j ) + temp1 * cabs1( a( j, j ) ) +
204 $ alpha * temp2
205*
206 60 CONTINUE
207*
208 ELSE
209*
210 jx = kx
211 jy = ky
212*
213 DO 80, j = 1, n
214 temp1 = talpha * cabs1( x( jx ) )
215 temp2 = zero
216 ix = kx
217 iy = ky
218*
219 DO 70, i = 1, j - 1
220 temp0 = cabs1( a( i, j ) )
221 y( iy ) = y( iy ) + temp1 * temp0
222 temp2 = temp2 + temp0 * cabs1( x( ix ) )
223 ix = ix + incx
224 iy = iy + incy
225 70 CONTINUE
226 y( jy ) = y( jy ) + temp1 * cabs1( a( j, j ) ) +
227 $ alpha * temp2
228 jx = jx + incx
229 jy = jy + incy
230*
231 80 CONTINUE
232*
233 END IF
234*
235 ELSE
236*
237* Form y when A is stored in lower triangle.
238*
239 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) ) THEN
240*
241 DO 100, j = 1, n
242*
243 temp1 = talpha * cabs1( x( j ) )
244 temp2 = zero
245 y( j ) = y( j ) + temp1 * cabs1( a( j, j ) )
246*
247 DO 90, i = j + 1, n
248 temp0 = cabs1( a( i, j ) )
249 y( i ) = y( i ) + temp1 * temp0
250 temp2 = temp2 + temp0 * cabs1( x( i ) )
251*
252 90 CONTINUE
253*
254 y( j ) = y( j ) + alpha * temp2
255*
256 100 CONTINUE
257*
258 ELSE
259*
260 jx = kx
261 jy = ky
262*
263 DO 120, j = 1, n
264 temp1 = talpha * cabs1( x( jx ) )
265 temp2 = zero
266 y( jy ) = y( jy ) + temp1 * cabs1( a( j, j ) )
267 ix = jx
268 iy = jy
269*
270 DO 110, i = j + 1, n
271*
272 ix = ix + incx
273 iy = iy + incy
274 temp0 = cabs1( a( i, j ) )
275 y( iy ) = y( iy ) + temp1 * temp0
276 temp2 = temp2 + temp0 * cabs1( x( ix ) )
277*
278 110 CONTINUE
279*
280 y( jy ) = y( jy ) + alpha * temp2
281 jx = jx + incx
282 jy = jy + incy
283*
284 120 CONTINUE
285*
286 END IF
287*
288 END IF
289*
290 RETURN
291*
292* End of CASYMV
293*
294 END
casymv
subroutine casymv(uplo, n, alpha, a, lda, x, incx, beta, y, incy)
Definition casymv.f:3
max
#define max(A, B)
Definition pcgemr.c:180