LAPACK 3.3.1
Linear Algebra PACKage

cgbmv.f

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