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