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