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