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