ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
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
max
#define max(A, B)
Definition: pcgemr.c:180
casymv
subroutine casymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
Definition: casymv.f:3