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