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 266