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