LAPACK: BLAS/SRC/dgbmv.f Source File

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'*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'*x + beta*y.
00031 *
00032 *              TRANS = 'C' or 'c'   y := alpha*A'*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 *
00123 *  -- Written on 22-October-1986.
00124 *     Jack Dongarra, Argonne National Lab.
00125 *     Jeremy Du Croz, Nag Central Office.
00126 *     Sven Hammarling, Nag Central Office.
00127 *     Richard Hanson, Sandia National Labs.
00128 *
00129 *  =====================================================================
00130 *
00131 *     .. Parameters ..
00132       DOUBLE PRECISION ONE,ZERO
00133       PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
00134 *     ..
00135 *     .. Local Scalars ..
00136       DOUBLE PRECISION TEMP
00137       INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
00138 *     ..
00139 *     .. External Functions ..
00140       LOGICAL LSAME
00141       EXTERNAL LSAME
00142 *     ..
00143 *     .. External Subroutines ..
00144       EXTERNAL XERBLA
00145 *     ..
00146 *     .. Intrinsic Functions ..
00147       INTRINSIC MAX,MIN
00148 *     ..
00149 *
00150 *     Test the input parameters.
00151 *
00152       INFO = 0
00153       IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
00154      +    .NOT.LSAME(TRANS,'C')) THEN
00155           INFO = 1
00156       ELSE IF (M.LT.0) THEN
00157           INFO = 2
00158       ELSE IF (N.LT.0) THEN
00159           INFO = 3
00160       ELSE IF (KL.LT.0) THEN
00161           INFO = 4
00162       ELSE IF (KU.LT.0) THEN
00163           INFO = 5
00164       ELSE IF (LDA.LT. (KL+KU+1)) THEN
00165           INFO = 8
00166       ELSE IF (INCX.EQ.0) THEN
00167           INFO = 10
00168       ELSE IF (INCY.EQ.0) THEN
00169           INFO = 13
00170       END IF
00171       IF (INFO.NE.0) THEN
00172           CALL XERBLA('DGBMV ',INFO)
00173           RETURN
00174       END IF
00175 *
00176 *     Quick return if possible.
00177 *
00178       IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
00179      +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
00180 *
00181 *     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
00182 *     up the start points in  X  and  Y.
00183 *
00184       IF (LSAME(TRANS,'N')) THEN
00185           LENX = N
00186           LENY = M
00187       ELSE
00188           LENX = M
00189           LENY = N
00190       END IF
00191       IF (INCX.GT.0) THEN
00192           KX = 1
00193       ELSE
00194           KX = 1 - (LENX-1)*INCX
00195       END IF
00196       IF (INCY.GT.0) THEN
00197           KY = 1
00198       ELSE
00199           KY = 1 - (LENY-1)*INCY
00200       END IF
00201 *
00202 *     Start the operations. In this version the elements of A are
00203 *     accessed sequentially with one pass through the band part of A.
00204 *
00205 *     First form  y := beta*y.
00206 *
00207       IF (BETA.NE.ONE) THEN
00208           IF (INCY.EQ.1) THEN
00209               IF (BETA.EQ.ZERO) THEN
00210                   DO 10 I = 1,LENY
00211                       Y(I) = ZERO
00212    10             CONTINUE
00213               ELSE
00214                   DO 20 I = 1,LENY
00215                       Y(I) = BETA*Y(I)
00216    20             CONTINUE
00217               END IF
00218           ELSE
00219               IY = KY
00220               IF (BETA.EQ.ZERO) THEN
00221                   DO 30 I = 1,LENY
00222                       Y(IY) = ZERO
00223                       IY = IY + INCY
00224    30             CONTINUE
00225               ELSE
00226                   DO 40 I = 1,LENY
00227                       Y(IY) = BETA*Y(IY)
00228                       IY = IY + INCY
00229    40             CONTINUE
00230               END IF
00231           END IF
00232       END IF
00233       IF (ALPHA.EQ.ZERO) RETURN
00234       KUP1 = KU + 1
00235       IF (LSAME(TRANS,'N')) THEN
00236 *
00237 *        Form  y := alpha*A*x + y.
00238 *
00239           JX = KX
00240           IF (INCY.EQ.1) THEN
00241               DO 60 J = 1,N
00242                   IF (X(JX).NE.ZERO) THEN
00243                       TEMP = ALPHA*X(JX)
00244                       K = KUP1 - J
00245                       DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
00246                           Y(I) = Y(I) + TEMP*A(K+I,J)
00247    50                 CONTINUE
00248                   END IF
00249                   JX = JX + INCX
00250    60         CONTINUE
00251           ELSE
00252               DO 80 J = 1,N
00253                   IF (X(JX).NE.ZERO) THEN
00254                       TEMP = ALPHA*X(JX)
00255                       IY = KY
00256                       K = KUP1 - J
00257                       DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
00258                           Y(IY) = Y(IY) + TEMP*A(K+I,J)
00259                           IY = IY + INCY
00260    70                 CONTINUE
00261                   END IF
00262                   JX = JX + INCX
00263                   IF (J.GT.KU) KY = KY + INCY
00264    80         CONTINUE
00265           END IF
00266       ELSE
00267 *
00268 *        Form  y := alpha*A'*x + y.
00269 *
00270           JY = KY
00271           IF (INCX.EQ.1) THEN
00272               DO 100 J = 1,N
00273                   TEMP = ZERO
00274                   K = KUP1 - J
00275                   DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
00276                       TEMP = TEMP + A(K+I,J)*X(I)
00277    90             CONTINUE
00278                   Y(JY) = Y(JY) + ALPHA*TEMP
00279                   JY = JY + INCY
00280   100         CONTINUE
00281           ELSE
00282               DO 120 J = 1,N
00283                   TEMP = ZERO
00284                   IX = KX
00285                   K = KUP1 - J
00286                   DO 110 I = MAX(1,J-KU),MIN(M,J+KL)
00287                       TEMP = TEMP + A(K+I,J)*X(IX)
00288                       IX = IX + INCX
00289   110             CONTINUE
00290                   Y(JY) = Y(JY) + ALPHA*TEMP
00291                   JY = JY + INCY
00292                   IF (J.GT.KU) KX = KX + INCX
00293   120         CONTINUE
00294           END IF
00295       END IF
00296 *
00297       RETURN
00298 *
00299 *     End of DGBMV .
00300 *
00301       END