LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zhbmv.f
Go to the documentation of this file.
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
 All Files Functions