![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZHER 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 ZHER(UPLO,N,ALPHA,X,INCX,A,LDA) 00012 * 00013 * .. Scalar Arguments .. 00014 * DOUBLE PRECISION ALPHA 00015 * INTEGER INCX,LDA,N 00016 * CHARACTER UPLO 00017 * .. 00018 * .. Array Arguments .. 00019 * COMPLEX*16 A(LDA,*),X(*) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> ZHER performs the hermitian rank 1 operation 00029 *> 00030 *> A := alpha*x*x**H + A, 00031 *> 00032 *> where alpha is a real scalar, x is an n element vector and A is an 00033 *> n 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 DOUBLE PRECISION. 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,out] A 00082 *> \verbatim 00083 *> A is COMPLEX*16 array of DIMENSION ( LDA, n ). 00084 *> Before entry with UPLO = 'U' or 'u', the leading n by n 00085 *> upper triangular part of the array A must contain the upper 00086 *> triangular part of the hermitian matrix and the strictly 00087 *> lower triangular part of A is not referenced. On exit, the 00088 *> upper triangular part of the array A is overwritten by the 00089 *> upper triangular part of the updated matrix. 00090 *> Before entry with UPLO = 'L' or 'l', the leading n by n 00091 *> lower triangular part of the array A must contain the lower 00092 *> triangular part of the hermitian matrix and the strictly 00093 *> upper triangular part of A is not referenced. On exit, the 00094 *> lower triangular part of the array A is overwritten by the 00095 *> lower triangular part of the updated matrix. 00096 *> Note that the imaginary parts of the diagonal elements need 00097 *> not be set, they are assumed to be zero, and on exit they 00098 *> are set to zero. 00099 *> \endverbatim 00100 *> 00101 *> \param[in] LDA 00102 *> \verbatim 00103 *> LDA is INTEGER 00104 *> On entry, LDA specifies the first dimension of A as declared 00105 *> in the calling (sub) program. LDA must be at least 00106 *> max( 1, n ). 00107 *> \endverbatim 00108 * 00109 * Authors: 00110 * ======== 00111 * 00112 *> \author Univ. of Tennessee 00113 *> \author Univ. of California Berkeley 00114 *> \author Univ. of Colorado Denver 00115 *> \author NAG Ltd. 00116 * 00117 *> \date November 2011 00118 * 00119 *> \ingroup complex16_blas_level2 00120 * 00121 *> \par Further Details: 00122 * ===================== 00123 *> 00124 *> \verbatim 00125 *> 00126 *> Level 2 Blas routine. 00127 *> 00128 *> -- Written on 22-October-1986. 00129 *> Jack Dongarra, Argonne National Lab. 00130 *> Jeremy Du Croz, Nag Central Office. 00131 *> Sven Hammarling, Nag Central Office. 00132 *> Richard Hanson, Sandia National Labs. 00133 *> \endverbatim 00134 *> 00135 * ===================================================================== 00136 SUBROUTINE ZHER(UPLO,N,ALPHA,X,INCX,A,LDA) 00137 * 00138 * -- Reference BLAS level2 routine (version 3.4.0) -- 00139 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 00140 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00141 * November 2011 00142 * 00143 * .. Scalar Arguments .. 00144 DOUBLE PRECISION ALPHA 00145 INTEGER INCX,LDA,N 00146 CHARACTER UPLO 00147 * .. 00148 * .. Array Arguments .. 00149 COMPLEX*16 A(LDA,*),X(*) 00150 * .. 00151 * 00152 * ===================================================================== 00153 * 00154 * .. Parameters .. 00155 COMPLEX*16 ZERO 00156 PARAMETER (ZERO= (0.0D+0,0.0D+0)) 00157 * .. 00158 * .. Local Scalars .. 00159 COMPLEX*16 TEMP 00160 INTEGER I,INFO,IX,J,JX,KX 00161 * .. 00162 * .. External Functions .. 00163 LOGICAL LSAME 00164 EXTERNAL LSAME 00165 * .. 00166 * .. External Subroutines .. 00167 EXTERNAL XERBLA 00168 * .. 00169 * .. Intrinsic Functions .. 00170 INTRINSIC DBLE,DCONJG,MAX 00171 * .. 00172 * 00173 * Test the input parameters. 00174 * 00175 INFO = 0 00176 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN 00177 INFO = 1 00178 ELSE IF (N.LT.0) THEN 00179 INFO = 2 00180 ELSE IF (INCX.EQ.0) THEN 00181 INFO = 5 00182 ELSE IF (LDA.LT.MAX(1,N)) THEN 00183 INFO = 7 00184 END IF 00185 IF (INFO.NE.0) THEN 00186 CALL XERBLA('ZHER ',INFO) 00187 RETURN 00188 END IF 00189 * 00190 * Quick return if possible. 00191 * 00192 IF ((N.EQ.0) .OR. (ALPHA.EQ.DBLE(ZERO))) RETURN 00193 * 00194 * Set the start point in X if the increment is not unity. 00195 * 00196 IF (INCX.LE.0) THEN 00197 KX = 1 - (N-1)*INCX 00198 ELSE IF (INCX.NE.1) THEN 00199 KX = 1 00200 END IF 00201 * 00202 * Start the operations. In this version the elements of A are 00203 * accessed sequentially with one pass through the triangular part 00204 * of A. 00205 * 00206 IF (LSAME(UPLO,'U')) THEN 00207 * 00208 * Form A when A is stored in upper triangle. 00209 * 00210 IF (INCX.EQ.1) THEN 00211 DO 20 J = 1,N 00212 IF (X(J).NE.ZERO) THEN 00213 TEMP = ALPHA*DCONJG(X(J)) 00214 DO 10 I = 1,J - 1 00215 A(I,J) = A(I,J) + X(I)*TEMP 00216 10 CONTINUE 00217 A(J,J) = DBLE(A(J,J)) + DBLE(X(J)*TEMP) 00218 ELSE 00219 A(J,J) = DBLE(A(J,J)) 00220 END IF 00221 20 CONTINUE 00222 ELSE 00223 JX = KX 00224 DO 40 J = 1,N 00225 IF (X(JX).NE.ZERO) THEN 00226 TEMP = ALPHA*DCONJG(X(JX)) 00227 IX = KX 00228 DO 30 I = 1,J - 1 00229 A(I,J) = A(I,J) + X(IX)*TEMP 00230 IX = IX + INCX 00231 30 CONTINUE 00232 A(J,J) = DBLE(A(J,J)) + DBLE(X(JX)*TEMP) 00233 ELSE 00234 A(J,J) = DBLE(A(J,J)) 00235 END IF 00236 JX = JX + INCX 00237 40 CONTINUE 00238 END IF 00239 ELSE 00240 * 00241 * Form A when A is stored in lower triangle. 00242 * 00243 IF (INCX.EQ.1) THEN 00244 DO 60 J = 1,N 00245 IF (X(J).NE.ZERO) THEN 00246 TEMP = ALPHA*DCONJG(X(J)) 00247 A(J,J) = DBLE(A(J,J)) + DBLE(TEMP*X(J)) 00248 DO 50 I = J + 1,N 00249 A(I,J) = A(I,J) + X(I)*TEMP 00250 50 CONTINUE 00251 ELSE 00252 A(J,J) = DBLE(A(J,J)) 00253 END IF 00254 60 CONTINUE 00255 ELSE 00256 JX = KX 00257 DO 80 J = 1,N 00258 IF (X(JX).NE.ZERO) THEN 00259 TEMP = ALPHA*DCONJG(X(JX)) 00260 A(J,J) = DBLE(A(J,J)) + DBLE(TEMP*X(JX)) 00261 IX = JX 00262 DO 70 I = J + 1,N 00263 IX = IX + INCX 00264 A(I,J) = A(I,J) + X(IX)*TEMP 00265 70 CONTINUE 00266 ELSE 00267 A(J,J) = DBLE(A(J,J)) 00268 END IF 00269 JX = JX + INCX 00270 80 CONTINUE 00271 END IF 00272 END IF 00273 * 00274 RETURN 00275 * 00276 * End of ZHER . 00277 * 00278 END