ENH: Improving the travis dashboard name
[platform/upstream/lapack.git] / SRC / zsyr.f
1 *> \brief \b ZSYR performs the symmetric rank-1 update of a complex symmetric matrix.
2 *
3 *  =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 *            http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download ZSYR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 *  Definition:
19 *  ===========
20 *
21 *       SUBROUTINE ZSYR( UPLO, N, ALPHA, X, INCX, A, LDA )
22 *
23 *       .. Scalar Arguments ..
24 *       CHARACTER          UPLO
25 *       INTEGER            INCX, LDA, N
26 *       COMPLEX*16         ALPHA
27 *       ..
28 *       .. Array Arguments ..
29 *       COMPLEX*16         A( LDA, * ), X( * )
30 *       ..
31 *
32 *
33 *> \par Purpose:
34 *  =============
35 *>
36 *> \verbatim
37 *>
38 *> ZSYR   performs the symmetric rank 1 operation
39 *>
40 *>    A := alpha*x*x**H + A,
41 *>
42 *> where alpha is a complex scalar, x is an n element vector and A is an
43 *> n by n symmetric matrix.
44 *> \endverbatim
45 *
46 *  Arguments:
47 *  ==========
48 *
49 *> \param[in] UPLO
50 *> \verbatim
51 *>          UPLO is CHARACTER*1
52 *>           On entry, UPLO specifies whether the upper or lower
53 *>           triangular part of the array A is to be referenced as
54 *>           follows:
55 *>
56 *>              UPLO = 'U' or 'u'   Only the upper triangular part of A
57 *>                                  is to be referenced.
58 *>
59 *>              UPLO = 'L' or 'l'   Only the lower triangular part of A
60 *>                                  is to be referenced.
61 *>
62 *>           Unchanged on exit.
63 *> \endverbatim
64 *>
65 *> \param[in] N
66 *> \verbatim
67 *>          N is INTEGER
68 *>           On entry, N specifies the order of the matrix A.
69 *>           N must be at least zero.
70 *>           Unchanged on exit.
71 *> \endverbatim
72 *>
73 *> \param[in] ALPHA
74 *> \verbatim
75 *>          ALPHA is COMPLEX*16
76 *>           On entry, ALPHA specifies the scalar alpha.
77 *>           Unchanged on exit.
78 *> \endverbatim
79 *>
80 *> \param[in] X
81 *> \verbatim
82 *>          X is COMPLEX*16 array, dimension at least
83 *>           ( 1 + ( N - 1 )*abs( INCX ) ).
84 *>           Before entry, the incremented array X must contain the N-
85 *>           element vector x.
86 *>           Unchanged on exit.
87 *> \endverbatim
88 *>
89 *> \param[in] INCX
90 *> \verbatim
91 *>          INCX is INTEGER
92 *>           On entry, INCX specifies the increment for the elements of
93 *>           X. INCX must not be zero.
94 *>           Unchanged on exit.
95 *> \endverbatim
96 *>
97 *> \param[in,out] A
98 *> \verbatim
99 *>          A is COMPLEX*16 array, dimension ( LDA, N )
100 *>           Before entry, with  UPLO = 'U' or 'u', the leading n by n
101 *>           upper triangular part of the array A must contain the upper
102 *>           triangular part of the symmetric matrix and the strictly
103 *>           lower triangular part of A is not referenced. On exit, the
104 *>           upper triangular part of the array A is overwritten by the
105 *>           upper triangular part of the updated matrix.
106 *>           Before entry, with UPLO = 'L' or 'l', the leading n by n
107 *>           lower triangular part of the array A must contain the lower
108 *>           triangular part of the symmetric matrix and the strictly
109 *>           upper triangular part of A is not referenced. On exit, the
110 *>           lower triangular part of the array A is overwritten by the
111 *>           lower triangular part of the updated matrix.
112 *> \endverbatim
113 *>
114 *> \param[in] LDA
115 *> \verbatim
116 *>          LDA is INTEGER
117 *>           On entry, LDA specifies the first dimension of A as declared
118 *>           in the calling (sub) program. LDA must be at least
119 *>           max( 1, N ).
120 *>           Unchanged on exit.
121 *> \endverbatim
122 *
123 *  Authors:
124 *  ========
125 *
126 *> \author Univ. of Tennessee
127 *> \author Univ. of California Berkeley
128 *> \author Univ. of Colorado Denver
129 *> \author NAG Ltd.
130 *
131 *> \date September 2012
132 *
133 *> \ingroup complex16SYauxiliary
134 *
135 *  =====================================================================
136       SUBROUTINE ZSYR( UPLO, N, ALPHA, X, INCX, A, LDA )
137 *
138 *  -- LAPACK auxiliary routine (version 3.4.2) --
139 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
140 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
141 *     September 2012
142 *
143 *     .. Scalar Arguments ..
144       CHARACTER          UPLO
145       INTEGER            INCX, LDA, N
146       COMPLEX*16         ALPHA
147 *     ..
148 *     .. Array Arguments ..
149       COMPLEX*16         A( LDA, * ), X( * )
150 *     ..
151 *
152 * =====================================================================
153 *
154 *     .. Parameters ..
155       COMPLEX*16         ZERO
156       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
157 *     ..
158 *     .. Local Scalars ..
159       INTEGER            I, INFO, IX, J, JX, KX
160       COMPLEX*16         TEMP
161 *     ..
162 *     .. External Functions ..
163       LOGICAL            LSAME
164       EXTERNAL           LSAME
165 *     ..
166 *     .. External Subroutines ..
167       EXTERNAL           XERBLA
168 *     ..
169 *     .. Intrinsic Functions ..
170       INTRINSIC          MAX
171 *     ..
172 *     .. Executable Statements ..
173 *
174 *     Test the input parameters.
175 *
176       INFO = 0
177       IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
178          INFO = 1
179       ELSE IF( N.LT.0 ) THEN
180          INFO = 2
181       ELSE IF( INCX.EQ.0 ) THEN
182          INFO = 5
183       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
184          INFO = 7
185       END IF
186       IF( INFO.NE.0 ) THEN
187          CALL XERBLA( 'ZSYR  ', INFO )
188          RETURN
189       END IF
190 *
191 *     Quick return if possible.
192 *
193       IF( ( N.EQ.0 ) .OR. ( ALPHA.EQ.ZERO ) )
194      $   RETURN
195 *
196 *     Set the start point in X if the increment is not unity.
197 *
198       IF( INCX.LE.0 ) THEN
199          KX = 1 - ( N-1 )*INCX
200       ELSE IF( INCX.NE.1 ) THEN
201          KX = 1
202       END IF
203 *
204 *     Start the operations. In this version the elements of A are
205 *     accessed sequentially with one pass through the triangular part
206 *     of A.
207 *
208       IF( LSAME( UPLO, 'U' ) ) THEN
209 *
210 *        Form  A  when A is stored in upper triangle.
211 *
212          IF( INCX.EQ.1 ) THEN
213             DO 20 J = 1, N
214                IF( X( J ).NE.ZERO ) THEN
215                   TEMP = ALPHA*X( J )
216                   DO 10 I = 1, J
217                      A( I, J ) = A( I, J ) + X( I )*TEMP
218    10             CONTINUE
219                END IF
220    20       CONTINUE
221          ELSE
222             JX = KX
223             DO 40 J = 1, N
224                IF( X( JX ).NE.ZERO ) THEN
225                   TEMP = ALPHA*X( JX )
226                   IX = KX
227                   DO 30 I = 1, J
228                      A( I, J ) = A( I, J ) + X( IX )*TEMP
229                      IX = IX + INCX
230    30             CONTINUE
231                END IF
232                JX = JX + INCX
233    40       CONTINUE
234          END IF
235       ELSE
236 *
237 *        Form  A  when A is stored in lower triangle.
238 *
239          IF( INCX.EQ.1 ) THEN
240             DO 60 J = 1, N
241                IF( X( J ).NE.ZERO ) THEN
242                   TEMP = ALPHA*X( J )
243                   DO 50 I = J, N
244                      A( I, J ) = A( I, J ) + X( I )*TEMP
245    50             CONTINUE
246                END IF
247    60       CONTINUE
248          ELSE
249             JX = KX
250             DO 80 J = 1, N
251                IF( X( JX ).NE.ZERO ) THEN
252                   TEMP = ALPHA*X( JX )
253                   IX = JX
254                   DO 70 I = J, N
255                      A( I, J ) = A( I, J ) + X( IX )*TEMP
256                      IX = IX + INCX
257    70             CONTINUE
258                END IF
259                JX = JX + INCX
260    80       CONTINUE
261          END IF
262       END IF
263 *
264       RETURN
265 *
266 *     End of ZSYR
267 *
268       END