LAPACK  3.4.2 LAPACK: Linear Algebra PACKage
zsyr.f
Go to the documentation of this file.
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
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