LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
csyr.f
Go to the documentation of this file.
1 *> \brief \b CSYR 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 CSYR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csyr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csyr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csyr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE CSYR( UPLO, N, ALPHA, X, INCX, A, LDA )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER UPLO
25 * INTEGER INCX, LDA, N
26 * COMPLEX ALPHA
27 * ..
28 * .. Array Arguments ..
29 * COMPLEX A( LDA, * ), X( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> CSYR 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
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 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 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 *> \ingroup complexSYauxiliary
132 *
133 * =====================================================================
134  SUBROUTINE csyr( UPLO, N, ALPHA, X, INCX, A, LDA )
135 *
136 * -- LAPACK auxiliary routine --
137 * -- LAPACK is a software package provided by Univ. of Tennessee, --
138 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
139 *
140 * .. Scalar Arguments ..
141  CHARACTER UPLO
142  INTEGER INCX, LDA, N
143  COMPLEX ALPHA
144 * ..
145 * .. Array Arguments ..
146  COMPLEX A( LDA, * ), X( * )
147 * ..
148 *
149 * =====================================================================
150 *
151 * .. Parameters ..
152  COMPLEX ZERO
153  parameter( zero = ( 0.0e+0, 0.0e+0 ) )
154 * ..
155 * .. Local Scalars ..
156  INTEGER I, INFO, IX, J, JX, KX
157  COMPLEX TEMP
158 * ..
159 * .. External Functions ..
160  LOGICAL LSAME
161  EXTERNAL lsame
162 * ..
163 * .. External Subroutines ..
164  EXTERNAL xerbla
165 * ..
166 * .. Intrinsic Functions ..
167  INTRINSIC max
168 * ..
169 * .. Executable Statements ..
170 *
171 * Test the input parameters.
172 *
173  info = 0
174  IF( .NOT.lsame( uplo, 'U' ) .AND. .NOT.lsame( uplo, 'L' ) ) THEN
175  info = 1
176  ELSE IF( n.LT.0 ) THEN
177  info = 2
178  ELSE IF( incx.EQ.0 ) THEN
179  info = 5
180  ELSE IF( lda.LT.max( 1, n ) ) THEN
181  info = 7
182  END IF
183  IF( info.NE.0 ) THEN
184  CALL xerbla( 'CSYR ', info )
185  RETURN
186  END IF
187 *
188 * Quick return if possible.
189 *
190  IF( ( n.EQ.0 ) .OR. ( alpha.EQ.zero ) )
191  $ RETURN
192 *
193 * Set the start point in X if the increment is not unity.
194 *
195  IF( incx.LE.0 ) THEN
196  kx = 1 - ( n-1 )*incx
197  ELSE IF( incx.NE.1 ) THEN
198  kx = 1
199  END IF
200 *
201 * Start the operations. In this version the elements of A are
202 * accessed sequentially with one pass through the triangular part
203 * of A.
204 *
205  IF( lsame( uplo, 'U' ) ) THEN
206 *
207 * Form A when A is stored in upper triangle.
208 *
209  IF( incx.EQ.1 ) THEN
210  DO 20 j = 1, n
211  IF( x( j ).NE.zero ) THEN
212  temp = alpha*x( j )
213  DO 10 i = 1, j
214  a( i, j ) = a( i, j ) + x( i )*temp
215  10 CONTINUE
216  END IF
217  20 CONTINUE
218  ELSE
219  jx = kx
220  DO 40 j = 1, n
221  IF( x( jx ).NE.zero ) THEN
222  temp = alpha*x( jx )
223  ix = kx
224  DO 30 i = 1, j
225  a( i, j ) = a( i, j ) + x( ix )*temp
226  ix = ix + incx
227  30 CONTINUE
228  END IF
229  jx = jx + incx
230  40 CONTINUE
231  END IF
232  ELSE
233 *
234 * Form A when A is stored in lower triangle.
235 *
236  IF( incx.EQ.1 ) THEN
237  DO 60 j = 1, n
238  IF( x( j ).NE.zero ) THEN
239  temp = alpha*x( j )
240  DO 50 i = j, n
241  a( i, j ) = a( i, j ) + x( i )*temp
242  50 CONTINUE
243  END IF
244  60 CONTINUE
245  ELSE
246  jx = kx
247  DO 80 j = 1, n
248  IF( x( jx ).NE.zero ) THEN
249  temp = alpha*x( jx )
250  ix = jx
251  DO 70 i = j, n
252  a( i, j ) = a( i, j ) + x( ix )*temp
253  ix = ix + incx
254  70 CONTINUE
255  END IF
256  jx = jx + incx
257  80 CONTINUE
258  END IF
259  END IF
260 *
261  RETURN
262 *
263 * End of CSYR
264 *
265  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine csyr(UPLO, N, ALPHA, X, INCX, A, LDA)
CSYR performs the symmetric rank-1 update of a complex symmetric matrix.
Definition: csyr.f:135