ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
zahemv.f
Go to the documentation of this file.
1  SUBROUTINE zahemv( 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  DOUBLE PRECISION ALPHA, BETA
13 * ..
14 * .. Array Arguments ..
15  DOUBLE PRECISION Y( * )
16  COMPLEX*16 A( LDA, * ), X( * )
17 * ..
18 *
19 * Purpose
20 * =======
21 *
22 * ZAHEMV 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) DOUBLE PRECISION
46 * On entry, ALPHA specifies the real scalar alpha.
47 *
48 * A (input) COMPLEX*16 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*16 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) DOUBLE PRECISION
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) DOUBLE PRECISION 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  DOUBLE PRECISION ONE, ZERO
94  parameter( one = 1.0d+0, zero = 0.0d+0 )
95 * ..
96 * .. Local Scalars ..
97  INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
98  DOUBLE PRECISION TALPHA, TEMP0, TEMP1, TEMP2
99  COMPLEX*16 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, dble, dconjg, dimag, max
110 * ..
111 * .. Statement Functions ..
112  DOUBLE PRECISION CABS1
113  cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( 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( 'ZAHEMV', 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( dble( 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( dble( 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( dble( 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( dble( 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 ZAHEMV
296 *
297  END
max
#define max(A, B)
Definition: pcgemr.c:180
zahemv
subroutine zahemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
Definition: zahemv.f:3