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