1*> \brief \b ZHER 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE ZHER(UPLO,N,ALPHA,X,INCX,A,LDA) 12* 13* .. Scalar Arguments .. 14* DOUBLE PRECISION ALPHA 15* INTEGER INCX,LDA,N 16* CHARACTER UPLO 17* .. 18* .. Array Arguments .. 19* COMPLEX*16 A(LDA,*),X(*) 20* .. 21* 22* 23*> \par Purpose: 24* ============= 25*> 26*> \verbatim 27*> 28*> ZHER performs the hermitian rank 1 operation 29*> 30*> A := alpha*x*x**H + A, 31*> 32*> where alpha is a real scalar, x is an n element vector and A is an 33*> n by n hermitian matrix. 34*> \endverbatim 35* 36* Arguments: 37* ========== 38* 39*> \param[in] UPLO 40*> \verbatim 41*> UPLO is CHARACTER*1 42*> On entry, UPLO specifies whether the upper or lower 43*> triangular part of the array A is to be referenced as 44*> follows: 45*> 46*> UPLO = 'U' or 'u' Only the upper triangular part of A 47*> is to be referenced. 48*> 49*> UPLO = 'L' or 'l' Only the lower triangular part of A 50*> is to be referenced. 51*> \endverbatim 52*> 53*> \param[in] N 54*> \verbatim 55*> N is INTEGER 56*> On entry, N specifies the order of the matrix A. 57*> N must be at least zero. 58*> \endverbatim 59*> 60*> \param[in] ALPHA 61*> \verbatim 62*> ALPHA is DOUBLE PRECISION. 63*> On entry, ALPHA specifies the scalar alpha. 64*> \endverbatim 65*> 66*> \param[in] X 67*> \verbatim 68*> X is COMPLEX*16 array of dimension at least 69*> ( 1 + ( n - 1 )*abs( INCX ) ). 70*> Before entry, the incremented array X must contain the n 71*> element vector x. 72*> \endverbatim 73*> 74*> \param[in] INCX 75*> \verbatim 76*> INCX is INTEGER 77*> On entry, INCX specifies the increment for the elements of 78*> X. INCX must not be zero. 79*> \endverbatim 80*> 81*> \param[in,out] A 82*> \verbatim 83*> A is COMPLEX*16 array of DIMENSION ( LDA, n ). 84*> Before entry with UPLO = 'U' or 'u', the leading n by n 85*> upper triangular part of the array A must contain the upper 86*> triangular part of the hermitian matrix and the strictly 87*> lower triangular part of A is not referenced. On exit, the 88*> upper triangular part of the array A is overwritten by the 89*> upper triangular part of the updated matrix. 90*> Before entry with UPLO = 'L' or 'l', the leading n by n 91*> lower triangular part of the array A must contain the lower 92*> triangular part of the hermitian matrix and the strictly 93*> upper triangular part of A is not referenced. On exit, the 94*> lower triangular part of the array A is overwritten by the 95*> lower triangular part of the updated matrix. 96*> Note that the imaginary parts of the diagonal elements need 97*> not be set, they are assumed to be zero, and on exit they 98*> are set to zero. 99*> \endverbatim 100*> 101*> \param[in] LDA 102*> \verbatim 103*> LDA is INTEGER 104*> On entry, LDA specifies the first dimension of A as declared 105*> in the calling (sub) program. LDA must be at least 106*> max( 1, n ). 107*> \endverbatim 108* 109* Authors: 110* ======== 111* 112*> \author Univ. of Tennessee 113*> \author Univ. of California Berkeley 114*> \author Univ. of Colorado Denver 115*> \author NAG Ltd. 116* 117*> \date November 2011 118* 119*> \ingroup complex16_blas_level2 120* 121*> \par Further Details: 122* ===================== 123*> 124*> \verbatim 125*> 126*> Level 2 Blas routine. 127*> 128*> -- Written on 22-October-1986. 129*> Jack Dongarra, Argonne National Lab. 130*> Jeremy Du Croz, Nag Central Office. 131*> Sven Hammarling, Nag Central Office. 132*> Richard Hanson, Sandia National Labs. 133*> \endverbatim 134*> 135* ===================================================================== 136 SUBROUTINE ZHER(UPLO,N,ALPHA,X,INCX,A,LDA) 137* 138* -- Reference BLAS level2 routine (version 3.4.0) -- 139* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 140* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 141* November 2011 142* 143* .. Scalar Arguments .. 144 DOUBLE PRECISION ALPHA 145 INTEGER INCX,LDA,N 146 CHARACTER UPLO 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 COMPLEX*16 TEMP 160 INTEGER I,INFO,IX,J,JX,KX 161* .. 162* .. External Functions .. 163 LOGICAL LSAME 164 EXTERNAL LSAME 165* .. 166* .. External Subroutines .. 167 EXTERNAL XERBLA 168* .. 169* .. Intrinsic Functions .. 170 INTRINSIC DBLE,DCONJG,MAX 171* .. 172* 173* Test the input parameters. 174* 175 INFO = 0 176 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN 177 INFO = 1 178 ELSE IF (N.LT.0) THEN 179 INFO = 2 180 ELSE IF (INCX.EQ.0) THEN 181 INFO = 5 182 ELSE IF (LDA.LT.MAX(1,N)) THEN 183 INFO = 7 184 END IF 185 IF (INFO.NE.0) THEN 186 CALL XERBLA('ZHER ',INFO) 187 RETURN 188 END IF 189* 190* Quick return if possible. 191* 192 IF ((N.EQ.0) .OR. (ALPHA.EQ.DBLE(ZERO))) RETURN 193* 194* Set the start point in X if the increment is not unity. 195* 196 IF (INCX.LE.0) THEN 197 KX = 1 - (N-1)*INCX 198 ELSE IF (INCX.NE.1) THEN 199 KX = 1 200 END IF 201* 202* Start the operations. In this version the elements of A are 203* accessed sequentially with one pass through the triangular part 204* of A. 205* 206 IF (LSAME(UPLO,'U')) THEN 207* 208* Form A when A is stored in upper triangle. 209* 210 IF (INCX.EQ.1) THEN 211 DO 20 J = 1,N 212 IF (X(J).NE.ZERO) THEN 213 TEMP = ALPHA*DCONJG(X(J)) 214 DO 10 I = 1,J - 1 215 A(I,J) = A(I,J) + X(I)*TEMP 216 10 CONTINUE 217 A(J,J) = DBLE(A(J,J)) + DBLE(X(J)*TEMP) 218 ELSE 219 A(J,J) = DBLE(A(J,J)) 220 END IF 221 20 CONTINUE 222 ELSE 223 JX = KX 224 DO 40 J = 1,N 225 IF (X(JX).NE.ZERO) THEN 226 TEMP = ALPHA*DCONJG(X(JX)) 227 IX = KX 228 DO 30 I = 1,J - 1 229 A(I,J) = A(I,J) + X(IX)*TEMP 230 IX = IX + INCX 231 30 CONTINUE 232 A(J,J) = DBLE(A(J,J)) + DBLE(X(JX)*TEMP) 233 ELSE 234 A(J,J) = DBLE(A(J,J)) 235 END IF 236 JX = JX + INCX 237 40 CONTINUE 238 END IF 239 ELSE 240* 241* Form A when A is stored in lower triangle. 242* 243 IF (INCX.EQ.1) THEN 244 DO 60 J = 1,N 245 IF (X(J).NE.ZERO) THEN 246 TEMP = ALPHA*DCONJG(X(J)) 247 A(J,J) = DBLE(A(J,J)) + DBLE(TEMP*X(J)) 248 DO 50 I = J + 1,N 249 A(I,J) = A(I,J) + X(I)*TEMP 250 50 CONTINUE 251 ELSE 252 A(J,J) = DBLE(A(J,J)) 253 END IF 254 60 CONTINUE 255 ELSE 256 JX = KX 257 DO 80 J = 1,N 258 IF (X(JX).NE.ZERO) THEN 259 TEMP = ALPHA*DCONJG(X(JX)) 260 A(J,J) = DBLE(A(J,J)) + DBLE(TEMP*X(JX)) 261 IX = JX 262 DO 70 I = J + 1,N 263 IX = IX + INCX 264 A(I,J) = A(I,J) + X(IX)*TEMP 265 70 CONTINUE 266 ELSE 267 A(J,J) = DBLE(A(J,J)) 268 END IF 269 JX = JX + INCX 270 80 CONTINUE 271 END IF 272 END IF 273* 274 RETURN 275* 276* End of ZHER . 277* 278 END 279