Return to dger.f CVS log

Up to [local] / rpl / lapack / blas

En route pour la 4.0.15 !

    1:       SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
    2: *     .. Scalar Arguments ..
    3:       DOUBLE PRECISION ALPHA
    4:       INTEGER INCX,INCY,LDA,M,N
    5: *     ..
    6: *     .. Array Arguments ..
    7:       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
    8: *     ..
    9: *
   10: *  Purpose
   11: *  =======
   12: *
   13: *  DGER   performs the rank 1 operation
   14: *
   15: *     A := alpha*x*y' + A,
   16: *
   17: *  where alpha is a scalar, x is an m element vector, y is an n element
   18: *  vector and A is an m by n matrix.
   19: *
   20: *  Arguments
   21: *  ==========
   22: *
   23: *  M      - INTEGER.
   24: *           On entry, M specifies the number of rows of the matrix A.
   25: *           M must be at least zero.
   26: *           Unchanged on exit.
   27: *
   28: *  N      - INTEGER.
   29: *           On entry, N specifies the number of columns of the matrix A.
   30: *           N must be at least zero.
   31: *           Unchanged on exit.
   32: *
   33: *  ALPHA  - DOUBLE PRECISION.
   34: *           On entry, ALPHA specifies the scalar alpha.
   35: *           Unchanged on exit.
   36: *
   37: *  X      - DOUBLE PRECISION array of dimension at least
   38: *           ( 1 + ( m - 1 )*abs( INCX ) ).
   39: *           Before entry, the incremented array X must contain the m
   40: *           element vector x.
   41: *           Unchanged on exit.
   42: *
   43: *  INCX   - INTEGER.
   44: *           On entry, INCX specifies the increment for the elements of
   45: *           X. INCX must not be zero.
   46: *           Unchanged on exit.
   47: *
   48: *  Y      - DOUBLE PRECISION array of dimension at least
   49: *           ( 1 + ( n - 1 )*abs( INCY ) ).
   50: *           Before entry, the incremented array Y must contain the n
   51: *           element vector y.
   52: *           Unchanged on exit.
   53: *
   54: *  INCY   - INTEGER.
   55: *           On entry, INCY specifies the increment for the elements of
   56: *           Y. INCY must not be zero.
   57: *           Unchanged on exit.
   58: *
   59: *  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
   60: *           Before entry, the leading m by n part of the array A must
   61: *           contain the matrix of coefficients. On exit, A is
   62: *           overwritten by the updated matrix.
   63: *
   64: *  LDA    - INTEGER.
   65: *           On entry, LDA specifies the first dimension of A as declared
   66: *           in the calling (sub) program. LDA must be at least
   67: *           max( 1, m ).
   68: *           Unchanged on exit.
   69: *
   70: *  Further Details
   71: *  ===============
   72: *
   73: *  Level 2 Blas routine.
   74: *
   75: *  -- Written on 22-October-1986.
   76: *     Jack Dongarra, Argonne National Lab.
   77: *     Jeremy Du Croz, Nag Central Office.
   78: *     Sven Hammarling, Nag Central Office.
   79: *     Richard Hanson, Sandia National Labs.
   80: *
   81: *  =====================================================================
   82: *
   83: *     .. Parameters ..
   84:       DOUBLE PRECISION ZERO
   85:       PARAMETER (ZERO=0.0D+0)
   86: *     ..
   87: *     .. Local Scalars ..
   88:       DOUBLE PRECISION TEMP
   89:       INTEGER I,INFO,IX,J,JY,KX
   90: *     ..
   91: *     .. External Subroutines ..
   92:       EXTERNAL XERBLA
   93: *     ..
   94: *     .. Intrinsic Functions ..
   95:       INTRINSIC MAX
   96: *     ..
   97: *
   98: *     Test the input parameters.
   99: *
  100:       INFO = 0
  101:       IF (M.LT.0) THEN
  102:           INFO = 1
  103:       ELSE IF (N.LT.0) THEN
  104:           INFO = 2
  105:       ELSE IF (INCX.EQ.0) THEN
  106:           INFO = 5
  107:       ELSE IF (INCY.EQ.0) THEN
  108:           INFO = 7
  109:       ELSE IF (LDA.LT.MAX(1,M)) THEN
  110:           INFO = 9
  111:       END IF
  112:       IF (INFO.NE.0) THEN
  113:           CALL XERBLA('DGER  ',INFO)
  114:           RETURN
  115:       END IF
  116: *
  117: *     Quick return if possible.
  118: *
  119:       IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
  120: *
  121: *     Start the operations. In this version the elements of A are
  122: *     accessed sequentially with one pass through A.
  123: *
  124:       IF (INCY.GT.0) THEN
  125:           JY = 1
  126:       ELSE
  127:           JY = 1 - (N-1)*INCY
  128:       END IF
  129:       IF (INCX.EQ.1) THEN
  130:           DO 20 J = 1,N
  131:               IF (Y(JY).NE.ZERO) THEN
  132:                   TEMP = ALPHA*Y(JY)
  133:                   DO 10 I = 1,M
  134:                       A(I,J) = A(I,J) + X(I)*TEMP
  135:    10             CONTINUE
  136:               END IF
  137:               JY = JY + INCY
  138:    20     CONTINUE
  139:       ELSE
  140:           IF (INCX.GT.0) THEN
  141:               KX = 1
  142:           ELSE
  143:               KX = 1 - (M-1)*INCX
  144:           END IF
  145:           DO 40 J = 1,N
  146:               IF (Y(JY).NE.ZERO) THEN
  147:                   TEMP = ALPHA*Y(JY)
  148:                   IX = KX
  149:                   DO 30 I = 1,M
  150:                       A(I,J) = A(I,J) + X(IX)*TEMP
  151:                       IX = IX + INCX
  152:    30             CONTINUE
  153:               END IF
  154:               JY = JY + INCY
  155:    40     CONTINUE
  156:       END IF
  157: *
  158:       RETURN
  159: *
  160: *     End of DGER  .
  161: *
  162:       END