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
286