LAPACK 3.3.1
Linear Algebra PACKage

dgbmv.f

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