LAPACK: BLAS/SRC/cgbmv.f Source File

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