![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZHER2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE ZHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) 00012 * 00013 * .. Scalar Arguments .. 00014 * COMPLEX*16 ALPHA 00015 * INTEGER INCX,INCY,LDA,N 00016 * CHARACTER UPLO 00017 * .. 00018 * .. Array Arguments .. 00019 * COMPLEX*16 A(LDA,*),X(*),Y(*) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> ZHER2 performs the hermitian rank 2 operation 00029 *> 00030 *> A := alpha*x*y**H + conjg( alpha )*y*x**H + A, 00031 *> 00032 *> where alpha is a scalar, x and y are n element vectors and A is an n 00033 *> by n hermitian matrix. 00034 *> \endverbatim 00035 * 00036 * Arguments: 00037 * ========== 00038 * 00039 *> \param[in] UPLO 00040 *> \verbatim 00041 *> UPLO is CHARACTER*1 00042 *> On entry, UPLO specifies whether the upper or lower 00043 *> triangular part of the array A is to be referenced as 00044 *> follows: 00045 *> 00046 *> UPLO = 'U' or 'u' Only the upper triangular part of A 00047 *> is to be referenced. 00048 *> 00049 *> UPLO = 'L' or 'l' Only the lower triangular part of A 00050 *> is to be referenced. 00051 *> \endverbatim 00052 *> 00053 *> \param[in] N 00054 *> \verbatim 00055 *> N is INTEGER 00056 *> On entry, N specifies the order of the matrix A. 00057 *> N must be at least zero. 00058 *> \endverbatim 00059 *> 00060 *> \param[in] ALPHA 00061 *> \verbatim 00062 *> ALPHA is COMPLEX*16 00063 *> On entry, ALPHA specifies the scalar alpha. 00064 *> \endverbatim 00065 *> 00066 *> \param[in] X 00067 *> \verbatim 00068 *> X is COMPLEX*16 array of dimension at least 00069 *> ( 1 + ( n - 1 )*abs( INCX ) ). 00070 *> Before entry, the incremented array X must contain the n 00071 *> element vector x. 00072 *> \endverbatim 00073 *> 00074 *> \param[in] INCX 00075 *> \verbatim 00076 *> INCX is INTEGER 00077 *> On entry, INCX specifies the increment for the elements of 00078 *> X. INCX must not be zero. 00079 *> \endverbatim 00080 *> 00081 *> \param[in] Y 00082 *> \verbatim 00083 *> Y is COMPLEX*16 array of dimension at least 00084 *> ( 1 + ( n - 1 )*abs( INCY ) ). 00085 *> Before entry, the incremented array Y must contain the n 00086 *> element vector y. 00087 *> \endverbatim 00088 *> 00089 *> \param[in] INCY 00090 *> \verbatim 00091 *> INCY is INTEGER 00092 *> On entry, INCY specifies the increment for the elements of 00093 *> Y. INCY must not be zero. 00094 *> \endverbatim 00095 *> 00096 *> \param[in,out] A 00097 *> \verbatim 00098 *> A is COMPLEX*16 array of DIMENSION ( LDA, n ). 00099 *> Before entry with UPLO = 'U' or 'u', the leading n by n 00100 *> upper triangular part of the array A must contain the upper 00101 *> triangular part of the hermitian matrix and the strictly 00102 *> lower triangular part of A is not referenced. On exit, the 00103 *> upper triangular part of the array A is overwritten by the 00104 *> upper triangular part of the updated matrix. 00105 *> Before entry with UPLO = 'L' or 'l', the leading n by n 00106 *> lower triangular part of the array A must contain the lower 00107 *> triangular part of the hermitian matrix and the strictly 00108 *> upper triangular part of A is not referenced. On exit, the 00109 *> lower triangular part of the array A is overwritten by the 00110 *> lower triangular part of the updated matrix. 00111 *> Note that the imaginary parts of the diagonal elements need 00112 *> not be set, they are assumed to be zero, and on exit they 00113 *> are set to zero. 00114 *> \endverbatim 00115 *> 00116 *> \param[in] LDA 00117 *> \verbatim 00118 *> LDA is INTEGER 00119 *> On entry, LDA specifies the first dimension of A as declared 00120 *> in the calling (sub) program. LDA must be at least 00121 *> max( 1, n ). 00122 *> \endverbatim 00123 * 00124 * Authors: 00125 * ======== 00126 * 00127 *> \author Univ. of Tennessee 00128 *> \author Univ. of California Berkeley 00129 *> \author Univ. of Colorado Denver 00130 *> \author NAG Ltd. 00131 * 00132 *> \date November 2011 00133 * 00134 *> \ingroup complex16_blas_level2 00135 * 00136 *> \par Further Details: 00137 * ===================== 00138 *> 00139 *> \verbatim 00140 *> 00141 *> Level 2 Blas routine. 00142 *> 00143 *> -- Written on 22-October-1986. 00144 *> Jack Dongarra, Argonne National Lab. 00145 *> Jeremy Du Croz, Nag Central Office. 00146 *> Sven Hammarling, Nag Central Office. 00147 *> Richard Hanson, Sandia National Labs. 00148 *> \endverbatim 00149 *> 00150 * ===================================================================== 00151 SUBROUTINE ZHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA) 00152 * 00153 * -- Reference BLAS level2 routine (version 3.4.0) -- 00154 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 00155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00156 * November 2011 00157 * 00158 * .. Scalar Arguments .. 00159 COMPLEX*16 ALPHA 00160 INTEGER INCX,INCY,LDA,N 00161 CHARACTER UPLO 00162 * .. 00163 * .. Array Arguments .. 00164 COMPLEX*16 A(LDA,*),X(*),Y(*) 00165 * .. 00166 * 00167 * ===================================================================== 00168 * 00169 * .. Parameters .. 00170 COMPLEX*16 ZERO 00171 PARAMETER (ZERO= (0.0D+0,0.0D+0)) 00172 * .. 00173 * .. Local Scalars .. 00174 COMPLEX*16 TEMP1,TEMP2 00175 INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY 00176 * .. 00177 * .. External Functions .. 00178 LOGICAL LSAME 00179 EXTERNAL LSAME 00180 * .. 00181 * .. External Subroutines .. 00182 EXTERNAL XERBLA 00183 * .. 00184 * .. Intrinsic Functions .. 00185 INTRINSIC DBLE,DCONJG,MAX 00186 * .. 00187 * 00188 * Test the input parameters. 00189 * 00190 INFO = 0 00191 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN 00192 INFO = 1 00193 ELSE IF (N.LT.0) THEN 00194 INFO = 2 00195 ELSE IF (INCX.EQ.0) THEN 00196 INFO = 5 00197 ELSE IF (INCY.EQ.0) THEN 00198 INFO = 7 00199 ELSE IF (LDA.LT.MAX(1,N)) THEN 00200 INFO = 9 00201 END IF 00202 IF (INFO.NE.0) THEN 00203 CALL XERBLA('ZHER2 ',INFO) 00204 RETURN 00205 END IF 00206 * 00207 * Quick return if possible. 00208 * 00209 IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN 00210 * 00211 * Set up the start points in X and Y if the increments are not both 00212 * unity. 00213 * 00214 IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN 00215 IF (INCX.GT.0) THEN 00216 KX = 1 00217 ELSE 00218 KX = 1 - (N-1)*INCX 00219 END IF 00220 IF (INCY.GT.0) THEN 00221 KY = 1 00222 ELSE 00223 KY = 1 - (N-1)*INCY 00224 END IF 00225 JX = KX 00226 JY = KY 00227 END IF 00228 * 00229 * Start the operations. In this version the elements of A are 00230 * accessed sequentially with one pass through the triangular part 00231 * of A. 00232 * 00233 IF (LSAME(UPLO,'U')) THEN 00234 * 00235 * Form A when A is stored in the upper triangle. 00236 * 00237 IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN 00238 DO 20 J = 1,N 00239 IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN 00240 TEMP1 = ALPHA*DCONJG(Y(J)) 00241 TEMP2 = DCONJG(ALPHA*X(J)) 00242 DO 10 I = 1,J - 1 00243 A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2 00244 10 CONTINUE 00245 A(J,J) = DBLE(A(J,J)) + 00246 + DBLE(X(J)*TEMP1+Y(J)*TEMP2) 00247 ELSE 00248 A(J,J) = DBLE(A(J,J)) 00249 END IF 00250 20 CONTINUE 00251 ELSE 00252 DO 40 J = 1,N 00253 IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN 00254 TEMP1 = ALPHA*DCONJG(Y(JY)) 00255 TEMP2 = DCONJG(ALPHA*X(JX)) 00256 IX = KX 00257 IY = KY 00258 DO 30 I = 1,J - 1 00259 A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2 00260 IX = IX + INCX 00261 IY = IY + INCY 00262 30 CONTINUE 00263 A(J,J) = DBLE(A(J,J)) + 00264 + DBLE(X(JX)*TEMP1+Y(JY)*TEMP2) 00265 ELSE 00266 A(J,J) = DBLE(A(J,J)) 00267 END IF 00268 JX = JX + INCX 00269 JY = JY + INCY 00270 40 CONTINUE 00271 END IF 00272 ELSE 00273 * 00274 * Form A when A is stored in the lower triangle. 00275 * 00276 IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN 00277 DO 60 J = 1,N 00278 IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN 00279 TEMP1 = ALPHA*DCONJG(Y(J)) 00280 TEMP2 = DCONJG(ALPHA*X(J)) 00281 A(J,J) = DBLE(A(J,J)) + 00282 + DBLE(X(J)*TEMP1+Y(J)*TEMP2) 00283 DO 50 I = J + 1,N 00284 A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2 00285 50 CONTINUE 00286 ELSE 00287 A(J,J) = DBLE(A(J,J)) 00288 END IF 00289 60 CONTINUE 00290 ELSE 00291 DO 80 J = 1,N 00292 IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN 00293 TEMP1 = ALPHA*DCONJG(Y(JY)) 00294 TEMP2 = DCONJG(ALPHA*X(JX)) 00295 A(J,J) = DBLE(A(J,J)) + 00296 + DBLE(X(JX)*TEMP1+Y(JY)*TEMP2) 00297 IX = JX 00298 IY = JY 00299 DO 70 I = J + 1,N 00300 IX = IX + INCX 00301 IY = IY + INCY 00302 A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2 00303 70 CONTINUE 00304 ELSE 00305 A(J,J) = DBLE(A(J,J)) 00306 END IF 00307 JX = JX + INCX 00308 JY = JY + INCY 00309 80 CONTINUE 00310 END IF 00311 END IF 00312 * 00313 RETURN 00314 * 00315 * End of ZHER2 . 00316 * 00317 END