001:       SUBROUTINE CSYR( UPLO, N, ALPHA, X, INCX, A, LDA )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
005: *     November 2006
006: *
007: *     .. Scalar Arguments ..
008:       CHARACTER          UPLO
009:       INTEGER            INCX, LDA, N
010:       COMPLEX            ALPHA
011: *     ..
012: *     .. Array Arguments ..
013:       COMPLEX            A( LDA, * ), X( * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  CSYR   performs the symmetric rank 1 operation
020: *
021: *     A := alpha*x*( x' ) + A,
022: *
023: *  where alpha is a complex scalar, x is an n element vector and A is an
024: *  n by n symmetric matrix.
025: *
026: *  Arguments
027: *  ==========
028: *
029: *  UPLO     (input) CHARACTER*1
030: *           On entry, UPLO specifies whether the upper or lower
031: *           triangular part of the array A is to be referenced as
032: *           follows:
033: *
034: *              UPLO = 'U' or 'u'   Only the upper triangular part of A
035: *                                  is to be referenced.
036: *
037: *              UPLO = 'L' or 'l'   Only the lower triangular part of A
038: *                                  is to be referenced.
039: *
040: *           Unchanged on exit.
041: *
042: *  N        (input) INTEGER
043: *           On entry, N specifies the order of the matrix A.
044: *           N must be at least zero.
045: *           Unchanged on exit.
046: *
047: *  ALPHA    (input) COMPLEX
048: *           On entry, ALPHA specifies the scalar alpha.
049: *           Unchanged on exit.
050: *
051: *  X        (input) COMPLEX array, dimension at least
052: *           ( 1 + ( N - 1 )*abs( INCX ) ).
053: *           Before entry, the incremented array X must contain the N-
054: *           element vector x.
055: *           Unchanged on exit.
056: *
057: *  INCX     (input) INTEGER
058: *           On entry, INCX specifies the increment for the elements of
059: *           X. INCX must not be zero.
060: *           Unchanged on exit.
061: *
062: *  A        (input/output) COMPLEX array, dimension ( LDA, N )
063: *           Before entry, with  UPLO = 'U' or 'u', the leading n by n
064: *           upper triangular part of the array A must contain the upper
065: *           triangular part of the symmetric matrix and the strictly
066: *           lower triangular part of A is not referenced. On exit, the
067: *           upper triangular part of the array A is overwritten by the
068: *           upper triangular part of the updated matrix.
069: *           Before entry, with UPLO = 'L' or 'l', the leading n by n
070: *           lower triangular part of the array A must contain the lower
071: *           triangular part of the symmetric matrix and the strictly
072: *           upper triangular part of A is not referenced. On exit, the
073: *           lower triangular part of the array A is overwritten by the
074: *           lower triangular part of the updated matrix.
075: *
076: *  LDA      (input) INTEGER
077: *           On entry, LDA specifies the first dimension of A as declared
078: *           in the calling (sub) program. LDA must be at least
079: *           max( 1, N ).
080: *           Unchanged on exit.
081: *
082: * =====================================================================
083: *
084: *     .. Parameters ..
085:       COMPLEX            ZERO
086:       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
087: *     ..
088: *     .. Local Scalars ..
089:       INTEGER            I, INFO, IX, J, JX, KX
090:       COMPLEX            TEMP
091: *     ..
092: *     .. External Functions ..
093:       LOGICAL            LSAME
094:       EXTERNAL           LSAME
095: *     ..
096: *     .. External Subroutines ..
097:       EXTERNAL           XERBLA
098: *     ..
099: *     .. Intrinsic Functions ..
100:       INTRINSIC          MAX
101: *     ..
102: *     .. Executable Statements ..
103: *
104: *     Test the input parameters.
105: *
106:       INFO = 0
107:       IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
108:          INFO = 1
109:       ELSE IF( N.LT.0 ) THEN
110:          INFO = 2
111:       ELSE IF( INCX.EQ.0 ) THEN
112:          INFO = 5
113:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
114:          INFO = 7
115:       END IF
116:       IF( INFO.NE.0 ) THEN
117:          CALL XERBLA( 'CSYR  ', INFO )
118:          RETURN
119:       END IF
120: *
121: *     Quick return if possible.
122: *
123:       IF( ( N.EQ.0 ) .OR. ( ALPHA.EQ.ZERO ) )
124:      $   RETURN
125: *
126: *     Set the start point in X if the increment is not unity.
127: *
128:       IF( INCX.LE.0 ) THEN
129:          KX = 1 - ( N-1 )*INCX
130:       ELSE IF( INCX.NE.1 ) THEN
131:          KX = 1
132:       END IF
133: *
134: *     Start the operations. In this version the elements of A are
135: *     accessed sequentially with one pass through the triangular part
136: *     of A.
137: *
138:       IF( LSAME( UPLO, 'U' ) ) THEN
139: *
140: *        Form  A  when A is stored in upper triangle.
141: *
142:          IF( INCX.EQ.1 ) THEN
143:             DO 20 J = 1, N
144:                IF( X( J ).NE.ZERO ) THEN
145:                   TEMP = ALPHA*X( J )
146:                   DO 10 I = 1, J
147:                      A( I, J ) = A( I, J ) + X( I )*TEMP
148:    10             CONTINUE
149:                END IF
150:    20       CONTINUE
151:          ELSE
152:             JX = KX
153:             DO 40 J = 1, N
154:                IF( X( JX ).NE.ZERO ) THEN
155:                   TEMP = ALPHA*X( JX )
156:                   IX = KX
157:                   DO 30 I = 1, J
158:                      A( I, J ) = A( I, J ) + X( IX )*TEMP
159:                      IX = IX + INCX
160:    30             CONTINUE
161:                END IF
162:                JX = JX + INCX
163:    40       CONTINUE
164:          END IF
165:       ELSE
166: *
167: *        Form  A  when A is stored in lower triangle.
168: *
169:          IF( INCX.EQ.1 ) THEN
170:             DO 60 J = 1, N
171:                IF( X( J ).NE.ZERO ) THEN
172:                   TEMP = ALPHA*X( J )
173:                   DO 50 I = J, N
174:                      A( I, J ) = A( I, J ) + X( I )*TEMP
175:    50             CONTINUE
176:                END IF
177:    60       CONTINUE
178:          ELSE
179:             JX = KX
180:             DO 80 J = 1, N
181:                IF( X( JX ).NE.ZERO ) THEN
182:                   TEMP = ALPHA*X( JX )
183:                   IX = JX
184:                   DO 70 I = J, N
185:                      A( I, J ) = A( I, J ) + X( IX )*TEMP
186:                      IX = IX + INCX
187:    70             CONTINUE
188:                END IF
189:                JX = JX + INCX
190:    80       CONTINUE
191:          END IF
192:       END IF
193: *
194:       RETURN
195: *
196: *     End of CSYR
197: *
198:       END
199: