ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
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