001:       SUBROUTINE CGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
002: *     .. Scalar Arguments ..
003:       COMPLEX ALPHA,BETA
004:       INTEGER INCX,INCY,LDA,M,N
005:       CHARACTER TRANS
006: *     ..
007: *     .. Array Arguments ..
008:       COMPLEX A(LDA,*),X(*),Y(*)
009: *     ..
010: *
011: *  Purpose
012: *  =======
013: *
014: *  CGEMV performs one of the matrix-vector operations
015: *
016: *     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,   or
017: *
018: *     y := alpha*conjg( A' )*x + beta*y,
019: *
020: *  where alpha and beta are scalars, x and y are vectors and A is an
021: *  m by n matrix.
022: *
023: *  Arguments
024: *  ==========
025: *
026: *  TRANS  - CHARACTER*1.
027: *           On entry, TRANS specifies the operation to be performed as
028: *           follows:
029: *
030: *              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
031: *
032: *              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
033: *
034: *              TRANS = 'C' or 'c'   y := alpha*conjg( A' )*x + beta*y.
035: *
036: *           Unchanged on exit.
037: *
038: *  M      - INTEGER.
039: *           On entry, M specifies the number of rows of the matrix A.
040: *           M must be at least zero.
041: *           Unchanged on exit.
042: *
043: *  N      - INTEGER.
044: *           On entry, N specifies the number of columns of the matrix A.
045: *           N must be at least zero.
046: *           Unchanged on exit.
047: *
048: *  ALPHA  - COMPLEX         .
049: *           On entry, ALPHA specifies the scalar alpha.
050: *           Unchanged on exit.
051: *
052: *  A      - COMPLEX          array of DIMENSION ( LDA, n ).
053: *           Before entry, the leading m by n part of the array A must
054: *           contain the matrix of coefficients.
055: *           Unchanged on exit.
056: *
057: *  LDA    - INTEGER.
058: *           On entry, LDA specifies the first dimension of A as declared
059: *           in the calling (sub) program. LDA must be at least
060: *           max( 1, m ).
061: *           Unchanged on exit.
062: *
063: *  X      - COMPLEX          array of DIMENSION at least
064: *           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
065: *           and at least
066: *           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
067: *           Before entry, the incremented array X must contain the
068: *           vector x.
069: *           Unchanged on exit.
070: *
071: *  INCX   - INTEGER.
072: *           On entry, INCX specifies the increment for the elements of
073: *           X. INCX must not be zero.
074: *           Unchanged on exit.
075: *
076: *  BETA   - COMPLEX         .
077: *           On entry, BETA specifies the scalar beta. When BETA is
078: *           supplied as zero then Y need not be set on input.
079: *           Unchanged on exit.
080: *
081: *  Y      - COMPLEX          array of DIMENSION at least
082: *           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
083: *           and at least
084: *           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
085: *           Before entry with BETA non-zero, the incremented array Y
086: *           must contain the vector y. On exit, Y is overwritten by the
087: *           updated vector y.
088: *
089: *  INCY   - INTEGER.
090: *           On entry, INCY specifies the increment for the elements of
091: *           Y. INCY must not be zero.
092: *           Unchanged on exit.
093: *
094: *  Further Details
095: *  ===============
096: *
097: *  Level 2 Blas routine.
098: *
099: *  -- Written on 22-October-1986.
100: *     Jack Dongarra, Argonne National Lab.
101: *     Jeremy Du Croz, Nag Central Office.
102: *     Sven Hammarling, Nag Central Office.
103: *     Richard Hanson, Sandia National Labs.
104: *
105: *  =====================================================================
106: *
107: *     .. Parameters ..
108:       COMPLEX ONE
109:       PARAMETER (ONE= (1.0E+0,0.0E+0))
110:       COMPLEX ZERO
111:       PARAMETER (ZERO= (0.0E+0,0.0E+0))
112: *     ..
113: *     .. Local Scalars ..
114:       COMPLEX TEMP
115:       INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
116:       LOGICAL NOCONJ
117: *     ..
118: *     .. External Functions ..
119:       LOGICAL LSAME
120:       EXTERNAL LSAME
121: *     ..
122: *     .. External Subroutines ..
123:       EXTERNAL XERBLA
124: *     ..
125: *     .. Intrinsic Functions ..
126:       INTRINSIC CONJG,MAX
127: *     ..
128: *
129: *     Test the input parameters.
130: *
131:       INFO = 0
132:       IF (.NOT.LSAME(TRANS,'N') .AND. .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('CGEMV ',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))) RETURN
155: *
156:       NOCONJ = LSAME(TRANS,'T')
157: *
158: *     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
159: *     up the start points in  X  and  Y.
160: *
161:       IF (LSAME(TRANS,'N')) THEN
162:           LENX = N
163:           LENY = M
164:       ELSE
165:           LENX = M
166:           LENY = N
167:       END IF
168:       IF (INCX.GT.0) THEN
169:           KX = 1
170:       ELSE
171:           KX = 1 - (LENX-1)*INCX
172:       END IF
173:       IF (INCY.GT.0) THEN
174:           KY = 1
175:       ELSE
176:           KY = 1 - (LENY-1)*INCY
177:       END IF
178: *
179: *     Start the operations. In this version the elements of A are
180: *     accessed sequentially with one pass through A.
181: *
182: *     First form  y := beta*y.
183: *
184:       IF (BETA.NE.ONE) THEN
185:           IF (INCY.EQ.1) THEN
186:               IF (BETA.EQ.ZERO) THEN
187:                   DO 10 I = 1,LENY
188:                       Y(I) = ZERO
189:    10             CONTINUE
190:               ELSE
191:                   DO 20 I = 1,LENY
192:                       Y(I) = BETA*Y(I)
193:    20             CONTINUE
194:               END IF
195:           ELSE
196:               IY = KY
197:               IF (BETA.EQ.ZERO) THEN
198:                   DO 30 I = 1,LENY
199:                       Y(IY) = ZERO
200:                       IY = IY + INCY
201:    30             CONTINUE
202:               ELSE
203:                   DO 40 I = 1,LENY
204:                       Y(IY) = BETA*Y(IY)
205:                       IY = IY + INCY
206:    40             CONTINUE
207:               END IF
208:           END IF
209:       END IF
210:       IF (ALPHA.EQ.ZERO) RETURN
211:       IF (LSAME(TRANS,'N')) THEN
212: *
213: *        Form  y := alpha*A*x + y.
214: *
215:           JX = KX
216:           IF (INCY.EQ.1) THEN
217:               DO 60 J = 1,N
218:                   IF (X(JX).NE.ZERO) THEN
219:                       TEMP = ALPHA*X(JX)
220:                       DO 50 I = 1,M
221:                           Y(I) = Y(I) + TEMP*A(I,J)
222:    50                 CONTINUE
223:                   END IF
224:                   JX = JX + INCX
225:    60         CONTINUE
226:           ELSE
227:               DO 80 J = 1,N
228:                   IF (X(JX).NE.ZERO) THEN
229:                       TEMP = ALPHA*X(JX)
230:                       IY = KY
231:                       DO 70 I = 1,M
232:                           Y(IY) = Y(IY) + TEMP*A(I,J)
233:                           IY = IY + INCY
234:    70                 CONTINUE
235:                   END IF
236:                   JX = JX + INCX
237:    80         CONTINUE
238:           END IF
239:       ELSE
240: *
241: *        Form  y := alpha*A'*x + y  or  y := alpha*conjg( A' )*x + y.
242: *
243:           JY = KY
244:           IF (INCX.EQ.1) THEN
245:               DO 110 J = 1,N
246:                   TEMP = ZERO
247:                   IF (NOCONJ) THEN
248:                       DO 90 I = 1,M
249:                           TEMP = TEMP + A(I,J)*X(I)
250:    90                 CONTINUE
251:                   ELSE
252:                       DO 100 I = 1,M
253:                           TEMP = TEMP + CONJG(A(I,J))*X(I)
254:   100                 CONTINUE
255:                   END IF
256:                   Y(JY) = Y(JY) + ALPHA*TEMP
257:                   JY = JY + INCY
258:   110         CONTINUE
259:           ELSE
260:               DO 140 J = 1,N
261:                   TEMP = ZERO
262:                   IX = KX
263:                   IF (NOCONJ) THEN
264:                       DO 120 I = 1,M
265:                           TEMP = TEMP + A(I,J)*X(IX)
266:                           IX = IX + INCX
267:   120                 CONTINUE
268:                   ELSE
269:                       DO 130 I = 1,M
270:                           TEMP = TEMP + CONJG(A(I,J))*X(IX)
271:                           IX = IX + INCX
272:   130                 CONTINUE
273:                   END IF
274:                   Y(JY) = Y(JY) + ALPHA*TEMP
275:                   JY = JY + INCY
276:   140         CONTINUE
277:           END IF
278:       END IF
279: *
280:       RETURN
281: *
282: *     End of CGEMV .
283: *
284:       END
285: