var/external/blas/dger.inc

   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 SUBROUTINE DGER