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