BLAS / cgbmv.f

Fortran project BLAS, source module cgbmv.f.

Source module last modified on Thu, 2 Jul 1998, 23:17;
HTML image of Fortran source automatically generated by for2html on Sun, 23 Jun 2002, 15:10.


      SUBROUTINE CGBMV ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX,
     $                   BETA, Y, INCY )
#     .. Scalar Arguments ..
      COMPLEX            ALPHA, BETA
      INTEGER            INCX, INCY, KL, KU, LDA, M, N
      CHARACTER*1        TRANS
#     .. Array Arguments ..
      COMPLEX            A( LDA, * ), X( * ), Y( * )
#     ..
#
#  Purpose
#  =======
#
#  CGBMV  performs one of the matrix-vector operations
#
#     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,   or
#
#     y := alpha*conjg( A' )*x + beta*y,
#
#  where alpha and beta are scalars, x and y are vectors and A is an
#  m by n band matrix, with kl sub-diagonals and ku super-diagonals.
#
#  Parameters
#  ==========
#
#  TRANS  - CHARACTER*1.
#           On entry, TRANS specifies the operation to be performed as
#           follows:
#
#              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
#
#              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
#
#              TRANS = 'C' or 'c'   y := alpha*conjg( A' )*x + beta*y.
#
#           Unchanged on exit.
#
#  M      - INTEGER.
#           On entry, M specifies the number of rows of the matrix A.
#           M must be at least zero.
#           Unchanged on exit.
#
#  N      - INTEGER.
#           On entry, N specifies the number of columns of the matrix A.
#           N must be at least zero.
#           Unchanged on exit.
#
#  KL     - INTEGER.
#           On entry, KL specifies the number of sub-diagonals of the
#           matrix A. KL must satisfy  0 .le. KL.
#           Unchanged on exit.
#
#  KU     - INTEGER.
#           On entry, KU specifies the number of super-diagonals of the
#           matrix A. KU must satisfy  0 .le. KU.
#           Unchanged on exit.
#
#  ALPHA  - COMPLEX         .
#           On entry, ALPHA specifies the scalar alpha.
#           Unchanged on exit.
#
#  A      - COMPLEX          array of DIMENSION ( LDA, n ).
#           Before entry, the leading ( kl + ku + 1 ) by n part of the
#           array A must contain the matrix of coefficients, supplied
#           column by column, with the leading diagonal of the matrix in
#           row ( ku + 1 ) of the array, the first super-diagonal
#           starting at position 2 in row ku, the first sub-diagonal
#           starting at position 1 in row ( ku + 2 ), and so on.
#           Elements in the array A that do not correspond to elements
#           in the band matrix (such as the top left ku by ku triangle)
#           are not referenced.
#           The following program segment will transfer a band matrix
#           from conventional full matrix storage to band storage:
#
#                 DO 20, J = 1, N
#                    K = KU + 1 - J
#                    DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
#                       A( K + I, J ) = matrix( I, J )
#              10    CONTINUE
#              20 CONTINUE
#
#           Unchanged on exit.
#
#  LDA    - INTEGER.
#           On entry, LDA specifies the first dimension of A as declared
#           in the calling (sub) program. LDA must be at least
#           ( kl + ku + 1 ).
#           Unchanged on exit.
#
#  X      - COMPLEX          array of DIMENSION at least
#           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
#           and at least
#           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
#           Before entry, the incremented array X must contain the
#           vector x.
#           Unchanged on exit.
#
#  INCX   - INTEGER.
#           On entry, INCX specifies the increment for the elements of
#           X. INCX must not be zero.
#           Unchanged on exit.
#
#  BETA   - COMPLEX         .
#           On entry, BETA specifies the scalar beta. When BETA is
#           supplied as zero then Y need not be set on input.
#           Unchanged on exit.
#
#  Y      - COMPLEX          array of DIMENSION at least
#           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
#           and at least
#           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
#           Before entry, the incremented array Y must contain the
#           vector y. On exit, Y is overwritten by the updated vector y.
#
#
#  INCY   - INTEGER.
#           On entry, INCY specifies the increment for the elements of
#           Y. INCY must not be zero.
#           Unchanged on exit.
#
#
#  Level 2 Blas routine.
#
#  -- Written on 22-October-1986.
#     Jack Dongarra, Argonne National Lab.
#     Jeremy Du Croz, Nag Central Office.
#     Sven Hammarling, Nag Central Office.
#     Richard Hanson, Sandia National Labs.
#
#
#     .. Parameters ..
      COMPLEX            ONE
      PARAMETER        ( ONE  = ( 1.0E+0, 0.0E+0 ) )
      COMPLEX            ZERO
      PARAMETER        ( ZERO = ( 0.0E+0, 0.0E+0 ) )
#     .. Local Scalars ..
      COMPLEX            TEMP
      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KUP1, KX, KY,
     $                   LENX, LENY
      LOGICAL            NOCONJ
#     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
#     .. External Subroutines ..
      EXTERNAL           XERBLA
#     .. Intrinsic Functions ..
      INTRINSIC          CONJG, MAX, MIN
#     ..
#     .. Executable Statements ..
#
#     Test the input parameters.
#
      INFO = 0
      IF     ( ! LSAME( TRANS, 'N' )&&
     $         ! LSAME( TRANS, 'T' )&&
     $         ! LSAME( TRANS, 'C' )      )THEN
         INFO = 1
      ELSE IF( M<0 )THEN
         INFO = 2
      ELSE IF( N<0 )THEN
         INFO = 3
      ELSE IF( KL<0 )THEN
         INFO = 4
      ELSE IF( KU<0 )THEN
         INFO = 5
      ELSE IF( LDA<( KL + KU + 1 ) )THEN
         INFO = 8
      ELSE IF( INCX==0 )THEN
         INFO = 10
      ELSE IF( INCY==0 )THEN
         INFO = 13
      END IF
      IF( INFO!=0 )THEN
         CALL XERBLA( 'CGBMV ', INFO )
         RETURN
      END IF
#
#     Quick return if possible.
#
      IF( ( M==0 )||( N==0 )||
     $    ( ( ALPHA==ZERO )&&( BETA==ONE ) ) )
     $   RETURN
#
      NOCONJ = LSAME( TRANS, 'T' )
#
#     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
#     up the start points in  X  and  Y.
#
      IF( LSAME( TRANS, 'N' ) )THEN
         LENX = N
         LENY = M
      ELSE
         LENX = M
         LENY = N
      END IF
      IF( INCX>0 )THEN
         KX = 1
      ELSE
         KX = 1 - ( LENX - 1 )*INCX
      END IF
      IF( INCY>0 )THEN
         KY = 1
      ELSE
         KY = 1 - ( LENY - 1 )*INCY
      END IF
#
#     Start the operations. In this version the elements of A are
#     accessed sequentially with one pass through the band part of A.
#
#     First form  y := beta*y.
#
      IF( BETA!=ONE )THEN
         IF( INCY==1 )THEN
            IF( BETA==ZERO )THEN
               DO 10, I = 1, LENY
                  Y( I ) = ZERO
   10          CONTINUE
            ELSE
               DO 20, I = 1, LENY
                  Y( I ) = BETA*Y( I )
   20          CONTINUE
            END IF
         ELSE
            IY = KY
            IF( BETA==ZERO )THEN
               DO 30, I = 1, LENY
                  Y( IY ) = ZERO
                  IY      = IY   + INCY
   30          CONTINUE
            ELSE
               DO 40, I = 1, LENY
                  Y( IY ) = BETA*Y( IY )
                  IY      = IY           + INCY
   40          CONTINUE
            END IF
         END IF
      END IF
      IF( ALPHA==ZERO )
     $   RETURN
      KUP1 = KU + 1
      IF( LSAME( TRANS, 'N' ) )THEN
#
#        Form  y := alpha*A*x + y.
#
         JX = KX
         IF( INCY==1 )THEN
            DO 60, J = 1, N
               IF( X( JX )!=ZERO )THEN
                  TEMP = ALPHA*X( JX )
                  K    = KUP1 - J
                  DO 50, I = MAX( 1, J - KU ), MIN( M, J + KL )
                     Y( I ) = Y( I ) + TEMP*A( K + I, J )
   50             CONTINUE
               END IF
               JX = JX + INCX
   60       CONTINUE
         ELSE
            DO 80, J = 1, N
               IF( X( JX )!=ZERO )THEN
                  TEMP = ALPHA*X( JX )
                  IY   = KY
                  K    = KUP1 - J
                  DO 70, I = MAX( 1, J - KU ), MIN( M, J + KL )
                     Y( IY ) = Y( IY ) + TEMP*A( K + I, J )
                     IY      = IY      + INCY
   70             CONTINUE
               END IF
               JX = JX + INCX
               IF( J>KU )
     $            KY = KY + INCY
   80       CONTINUE
         END IF
      ELSE
#
#        Form  y := alpha*A'*x + y  or  y := alpha*conjg( A' )*x + y.
#
         JY = KY
         IF( INCX==1 )THEN
            DO 110, J = 1, N
               TEMP = ZERO
               K    = KUP1 - J
               IF( NOCONJ )THEN
                  DO 90, I = MAX( 1, J - KU ), MIN( M, J + KL )
                     TEMP = TEMP + A( K + I, J )*X( I )
   90             CONTINUE
               ELSE
                  DO 100, I = MAX( 1, J - KU ), MIN( M, J + KL )
                     TEMP = TEMP + CONJG( A( K + I, J ) )*X( I )
  100             CONTINUE
               END IF
               Y( JY ) = Y( JY ) + ALPHA*TEMP
               JY      = JY      + INCY
  110       CONTINUE
         ELSE
            DO 140, J = 1, N
               TEMP = ZERO
               IX   = KX
               K    = KUP1 - J
               IF( NOCONJ )THEN
                  DO 120, I = MAX( 1, J - KU ), MIN( M, J + KL )
                     TEMP = TEMP + A( K + I, J )*X( IX )
                     IX   = IX   + INCX
  120             CONTINUE
               ELSE
                  DO 130, I = MAX( 1, J - KU ), MIN( M, J + KL )
                     TEMP = TEMP + CONJG( A( K + I, J ) )*X( IX )
                     IX   = IX   + INCX
  130             CONTINUE
               END IF
               Y( JY ) = Y( JY ) + ALPHA*TEMP
               JY      = JY      + INCY
               IF( J>KU )
     $            KX = KX + INCX
  140       CONTINUE
         END IF
      END IF
#
      RETURN
#
#     End of CGBMV .
#
      END