share/lapack/blas/fortran/dger.f

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