1*DECK CAXPY
2      SUBROUTINE CAXPY (N, CA, CX, INCX, CY, INCY)
3C***BEGIN PROLOGUE  CAXPY
4C***PURPOSE  Compute a constant times a vector plus a vector.
5C***LIBRARY   SLATEC (BLAS)
6C***CATEGORY  D1A7
7C***TYPE      COMPLEX (SAXPY-S, DAXPY-D, CAXPY-C)
8C***KEYWORDS  BLAS, LINEAR ALGEBRA, TRIAD, VECTOR
9C***AUTHOR  Lawson, C. L., (JPL)
10C           Hanson, R. J., (SNLA)
11C           Kincaid, D. R., (U. of Texas)
12C           Krogh, F. T., (JPL)
13C***DESCRIPTION
14C
15C                B L A S  Subprogram
16C    Description of Parameters
17C
18C     --Input--
19C        N  number of elements in input vector(s)
20C       CA  complex scalar multiplier
21C       CX  complex vector with N elements
22C     INCX  storage spacing between elements of CX
23C       CY  complex vector with N elements
24C     INCY  storage spacing between elements of CY
25C
26C     --Output--
27C       CY  complex result (unchanged if N .LE. 0)
28C
29C     Overwrite complex CY with complex  CA*CX + CY.
30C     For I = 0 to N-1, replace  CY(LY+I*INCY) with CA*CX(LX+I*INCX) +
31C       CY(LY+I*INCY),
32C     where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
33C     defined in a similar way using INCY.
34C
35C***REFERENCES  C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
36C                 Krogh, Basic linear algebra subprograms for Fortran
37C                 usage, Algorithm No. 539, Transactions on Mathematical
38C                 Software 5, 3 (September 1979), pp. 308-323.
39C***ROUTINES CALLED  (NONE)
40C***REVISION HISTORY  (YYMMDD)
41C   791001  DATE WRITTEN
42C   861211  REVISION DATE from Version 3.2
43C   891214  Prologue converted to Version 4.0 format.  (BAB)
44C   920310  Corrected definition of LX in DESCRIPTION.  (WRB)
45C   920501  Reformatted the REFERENCES section.  (WRB)
46C   920801  Removed variable CANORM.  (RWC, WRB)
47C***END PROLOGUE  CAXPY
48      COMPLEX CX(*), CY(*), CA
49C***FIRST EXECUTABLE STATEMENT  CAXPY
50      IF (N.LE.0 .OR. CA.EQ.(0.0E0,0.0E0)) RETURN
51      IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 20
52C
53C     Code for unequal or nonpositive increments.
54C
55      KX = 1
56      KY = 1
57      IF (INCX .LT. 0) KX = 1+(1-N)*INCX
58      IF (INCY .LT. 0) KY = 1+(1-N)*INCY
59      DO 10 I = 1,N
60        CY(KY) = CY(KY) + CA*CX(KX)
61        KX = KX + INCX
62        KY = KY + INCY
63   10 CONTINUE
64      RETURN
65C
66C     Code for equal, positive, non-unit increments.
67C
68   20 NS = N*INCX
69      DO 30 I = 1,NS,INCX
70        CY(I) = CA*CX(I) + CY(I)
71   30 CONTINUE
72      RETURN
73      END
74