SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
satrmv.f
Go to the documentation of this file.
1 SUBROUTINE satrmv( UPLO, TRANS, DIAG, N, ALPHA, A, LDA, X, INCX,
2 $ BETA, Y, 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 DIAG, TRANS, 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* SATRMV performs one of the matrix-vector operations
22*
23* y := abs( alpha )*abs( A )*abs( x )+ abs( beta*y ),
24*
25* or
26*
27* y := abs( alpha )*abs( A' )*abs( x ) + abs( beta*y ),
28*
29* where alpha and beta are real scalars, y is a real vector, x is a
30* vector and A is an n by n unit or non-unit, upper or lower triangular
31* matrix.
32*
33* Arguments
34* =========
35*
36* UPLO (input) CHARACTER*1
37* On entry, UPLO specifies whether the matrix is an upper or
38* lower triangular matrix as follows:
39*
40* UPLO = 'U' or 'u' A is an upper triangular matrix.
41*
42* UPLO = 'L' or 'l' A is a lower triangular matrix.
43*
44* TRANS (input) CHARACTER*1
45* On entry, TRANS specifies the operation to be performed as
46* follows:
47*
48* TRANS = 'N' or 'n':
49* y := abs( alpha )*abs( A )*abs( x )+ abs( beta*y )
50*
51* TRANS = 'T' or 't':
52* y := abs( alpha )*abs( A' )*abs( x ) + abs( beta*y )
53*
54* TRANS = 'C' or 'c':
55* y := abs( alpha )*abs( A' )*abs( x ) + abs( beta*y )
56*
57* DIAG (input) CHARACTER*1
58* On entry, DIAG specifies whether or not A is unit triangular
59* as follows:
60*
61* DIAG = 'U' or 'u' A is assumed to be unit triangular.
62*
63* DIAG = 'N' or 'n' A is not assumed to be unit triangular.
64*
65* N (input) INTEGER
66* On entry, N specifies the order of the matrix A. N must be at
67* least zero.
68*
69* ALPHA (input) REAL
70* On entry, ALPHA specifies the real scalar alpha.
71*
72* A (input) REAL array
73* On entry, A is an array of dimension (LDA,N). Before entry
74* with UPLO = 'U' or 'u', the leading n by n part of the array
75* A must contain the upper triangular part of the matrix A and
76* the strictly lower triangular part of A is not referenced.
77* When UPLO = 'L' or 'l', the leading n by n part of the array
78* A must contain the lower triangular part of the matrix A and
79* the strictly upper trapezoidal part of A is not referenced.
80* Note that when DIAG = 'U' or 'u', the diagonal elements of A
81* are not referenced either, but are assumed to be unity.
82*
83* LDA (input) INTEGER
84* On entry, LDA specifies the leading dimension of the array A.
85* LDA must be at least max( 1, N ).
86*
87* X (input) REAL array of dimension at least
88* ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented
89* array X must contain the vector x.
90*
91* INCX (input) INTEGER
92* On entry, INCX specifies the increment for the elements of X.
93* INCX must not be zero.
94*
95* BETA (input) REAL
96* On entry, BETA specifies the real scalar beta. When BETA is
97* supplied as zero then Y need not be set on input.
98*
99* Y (input/output) REAL array of dimension at least
100* ( 1 + ( n - 1 )*abs( INCY ) ). Before entry with BETA non-
101* zero, the incremented array Y must contain the vector y. On
102* exit, the incremented array Y is overwritten by the updated
103* vector y.
104*
105* INCY (input) INTEGER
106* On entry, INCY specifies the increment for the elements of Y.
107* INCY must not be zero.
108*
109* -- Written on April 1, 1998 by
110* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
111*
112* =====================================================================
113*
114* .. Parameters ..
115 REAL ONE, ZERO
116 parameter( one = 1.0e+0, zero = 0.0e+0 )
117* ..
118* .. Local Scalars ..
119 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
120 LOGICAL NOUNIT
121 REAL ABSX, TALPHA, TEMP
122* ..
123* .. External Functions ..
124 LOGICAL LSAME
125 EXTERNAL lsame
126* ..
127* .. External Subroutines ..
128 EXTERNAL xerbla
129* ..
130* .. Intrinsic Functions ..
131 INTRINSIC abs, max
132* ..
133* .. Executable Statements ..
134*
135* Test the input parameters.
136*
137 info = 0
138 IF ( .NOT.lsame( uplo , 'U' ).AND.
139 $ .NOT.lsame( uplo , 'L' ) )THEN
140 info = 1
141 ELSE IF( .NOT.lsame( trans, 'N' ).AND.
142 $ .NOT.lsame( trans, 'T' ).AND.
143 $ .NOT.lsame( trans, 'C' ) )THEN
144 info = 2
145 ELSE IF( .NOT.lsame( diag , 'U' ).AND.
146 $ .NOT.lsame( diag , 'N' ) )THEN
147 info = 3
148 ELSE IF( n.LT.0 )THEN
149 info = 4
150 ELSE IF( lda.LT.max( 1, n ) )THEN
151 info = 7
152 ELSE IF( incx.EQ.0 )THEN
153 info = 9
154 ELSE IF( incy.EQ.0 ) THEN
155 info = 12
156 END IF
157 IF( info.NE.0 )THEN
158 CALL xerbla( 'SATRMV', info )
159 RETURN
160 END IF
161*
162* Quick return if possible.
163*
164 IF( ( n.EQ.0 ).OR.
165 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
166 $ RETURN
167*
168 nounit = lsame( diag , 'N' )
169*
170* Set up the start points in X and Y.
171*
172 IF( incx.GT.0 ) THEN
173 kx = 1
174 ELSE
175 kx = 1 - ( n - 1 ) * incx
176 END IF
177 IF( incy.GT.0 ) THEN
178 ky = 1
179 ELSE
180 ky = 1 - ( n - 1 ) * incy
181 END IF
182*
183* Start the operations. In this version the elements of A are
184* accessed sequentially with one pass through A.
185*
186* First form y := abs( beta*y ).
187*
188 IF( incy.EQ.1 ) THEN
189 IF( beta.EQ.zero ) THEN
190 DO 10, i = 1, n
191 y( i ) = zero
192 10 CONTINUE
193 ELSE IF( beta.EQ.one ) THEN
194 DO 20, i = 1, n
195 y( i ) = abs( y( i ) )
196 20 CONTINUE
197 ELSE
198 DO 30, i = 1, n
199 y( i ) = abs( beta * y( i ) )
200 30 CONTINUE
201 END IF
202 ELSE
203 iy = ky
204 IF( beta.EQ.zero ) THEN
205 DO 40, i = 1, n
206 y( iy ) = zero
207 iy = iy + incy
208 40 CONTINUE
209 ELSE IF( beta.EQ.one ) THEN
210 DO 50, i = 1, n
211 y( iy ) = abs( y( iy ) )
212 iy = iy + incy
213 50 CONTINUE
214 ELSE
215 DO 60, i = 1, n
216 y( iy ) = abs( beta * y( iy ) )
217 iy = iy + incy
218 60 CONTINUE
219 END IF
220 END IF
221*
222 IF( alpha.EQ.zero )
223 $ RETURN
224*
225 talpha = abs( alpha )
226*
227 IF( lsame( trans, 'N' ) )THEN
228*
229* Form y := abs( alpha ) * abs( A ) * abs( x ) + y.
230*
231 IF( lsame( uplo, 'U' ) )THEN
232 jx = kx
233 IF( incy.EQ.1 ) THEN
234 DO 80, j = 1, n
235 absx = abs( x( jx ) )
236 IF( absx.NE.zero ) THEN
237 temp = talpha * absx
238 DO 70, i = 1, j - 1
239 y( i ) = y( i ) + temp * abs( a( i, j ) )
240 70 CONTINUE
241*
242 IF( nounit ) THEN
243 y( j ) = y( j ) + temp * abs( a( j, j ) )
244 ELSE
245 y( j ) = y( j ) + temp
246 END IF
247 END IF
248 jx = jx + incx
249 80 CONTINUE
250*
251 ELSE
252*
253 DO 100, j = 1, n
254 absx = abs( x( jx ) )
255 IF( absx.NE.zero ) THEN
256 temp = talpha * absx
257 iy = ky
258 DO 90, i = 1, j - 1
259 y( iy ) = y( iy ) + temp * abs( a( i, j ) )
260 iy = iy + incy
261 90 CONTINUE
262*
263 IF( nounit ) THEN
264 y( iy ) = y( iy ) + temp * abs( a( j, j ) )
265 ELSE
266 y( iy ) = y( iy ) + temp
267 END IF
268 END IF
269 jx = jx + incx
270 100 CONTINUE
271*
272 END IF
273*
274 ELSE
275*
276 jx = kx
277 IF( incy.EQ.1 ) THEN
278 DO 120, j = 1, n
279 absx = abs( x( jx ) )
280 IF( absx.NE.zero ) THEN
281*
282 temp = talpha * absx
283*
284 IF( nounit ) THEN
285 y( j ) = y( j ) + temp * abs( a( j, j ) )
286 ELSE
287 y( j ) = y( j ) + temp
288 END IF
289*
290 DO 110, i = j + 1, n
291 y( i ) = y( i ) + temp * abs( a( i, j ) )
292 110 CONTINUE
293 END IF
294 jx = jx + incx
295 120 CONTINUE
296*
297 ELSE
298*
299 DO 140, j = 1, n
300 absx = abs( x( jx ) )
301 IF( absx.NE.zero ) THEN
302 temp = talpha * absx
303 iy = ky + ( j - 1 ) * incy
304*
305 IF( nounit ) THEN
306 y( iy ) = y( iy ) + temp * abs( a( j, j ) )
307 ELSE
308 y( iy ) = y( iy ) + temp
309 END IF
310*
311 DO 130, i = j + 1, n
312 iy = iy + incy
313 y( iy ) = y( iy ) + temp * abs( a( i, j ) )
314 130 CONTINUE
315 END IF
316 jx = jx + incx
317 140 CONTINUE
318*
319 END IF
320*
321 END IF
322*
323 ELSE
324*
325* Form y := abs( alpha ) * abs( A' ) * abs( x ) + y.
326*
327 IF( lsame( uplo, 'U' ) )THEN
328 jy = ky
329 IF( incx.EQ.1 ) THEN
330 DO 160, j = 1, n
331*
332 temp = zero
333*
334 DO 150, i = 1, j - 1
335 temp = temp + abs( a( i, j ) * x( i ) )
336 150 CONTINUE
337*
338 IF( nounit ) THEN
339 temp = temp + abs( a( j, j ) * x( j ) )
340 ELSE
341 temp = temp + abs( x( j ) )
342 END IF
343*
344 y( jy ) = y( jy ) + talpha * temp
345 jy = jy + incy
346*
347 160 CONTINUE
348*
349 ELSE
350*
351 DO 180, j = 1, n
352 temp = zero
353 ix = kx
354 DO 170, i = 1, j - 1
355 temp = temp + abs( a( i, j ) * x( ix ) )
356 ix = ix + incx
357 170 CONTINUE
358*
359 IF( nounit ) THEN
360 temp = temp + abs( a( j, j ) * x( ix ) )
361 ELSE
362 temp = temp + abs( x( ix ) )
363 END IF
364*
365 y( jy ) = y( jy ) + talpha * temp
366 jy = jy + incy
367*
368 180 CONTINUE
369*
370 END IF
371*
372 ELSE
373*
374 jy = ky
375 IF( incx.EQ.1 ) THEN
376*
377 DO 200, j = 1, n
378*
379 IF( nounit ) THEN
380 temp = abs( a( j, j ) * x( j ) )
381 ELSE
382 temp = abs( x( j ) )
383 END IF
384*
385 DO 190, i = j + 1, n
386 temp = temp + abs( a( i, j ) * x( i ) )
387 190 CONTINUE
388*
389 y( jy ) = y( jy ) + talpha * temp
390 jy = jy + incy
391*
392 200 CONTINUE
393*
394 ELSE
395*
396 DO 220, j = 1, n
397*
398 ix = kx + ( j - 1 ) * incx
399*
400 IF( nounit ) THEN
401 temp = abs( a( j, j ) * x( ix ) )
402 ELSE
403 temp = abs( x( ix ) )
404 END IF
405*
406 DO 210, i = j + 1, n
407 ix = ix + incx
408 temp = temp + abs( a( i, j ) * x( ix ) )
409 210 CONTINUE
410 y( jy ) = y( jy ) + talpha * temp
411 jy = jy + incy
412 220 CONTINUE
413 END IF
414 END IF
415*
416 END IF
417*
418 RETURN
419*
420* End of SATRMV
421*
422 END
max
#define max(A, B)
Definition pcgemr.c:180
satrmv
subroutine satrmv(uplo, trans, diag, n, alpha, a, lda, x, incx, beta, y, incy)
Definition satrmv.f:3