home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / blas / dger.f < prev    next >
Text File  |  1996-09-28  |  4KB  |  161 lines
  1. *
  2. ************************************************************************
  3. *
  4.       SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
  5. *     .. Scalar Arguments ..
  6.       DOUBLE PRECISION   ALPHA
  7.       INTEGER            INCX, INCY, LDA, M, N
  8. *     .. Array Arguments ..
  9.       DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
  10. *     ..
  11. *
  12. *  Purpose
  13. *  =======
  14. *
  15. *  DGER   performs the rank 1 operation
  16. *
  17. *     A := alpha*x*y' + A,
  18. *
  19. *  where alpha is a scalar, x is an m element vector, y is an n element
  20. *  vector and A is an m by n matrix.
  21. *
  22. *  Parameters
  23. *  ==========
  24. *
  25. *  M      - INTEGER.
  26. *           On entry, M specifies the number of rows of the matrix A.
  27. *           M must be at least zero.
  28. *           Unchanged on exit.
  29. *
  30. *  N      - INTEGER.
  31. *           On entry, N specifies the number of columns of the matrix A.
  32. *           N must be at least zero.
  33. *           Unchanged on exit.
  34. *
  35. *  ALPHA  - DOUBLE PRECISION.
  36. *           On entry, ALPHA specifies the scalar alpha.
  37. *           Unchanged on exit.
  38. *
  39. *  X      - DOUBLE PRECISION array of dimension at least
  40. *           ( 1 + ( m - 1 )*abs( INCX ) ).
  41. *           Before entry, the incremented array X must contain the m
  42. *           element vector x.
  43. *           Unchanged on exit.
  44. *
  45. *  INCX   - INTEGER.
  46. *           On entry, INCX specifies the increment for the elements of
  47. *           X. INCX must not be zero.
  48. *           Unchanged on exit.
  49. *
  50. *  Y      - DOUBLE PRECISION array of dimension at least
  51. *           ( 1 + ( n - 1 )*abs( INCY ) ).
  52. *           Before entry, the incremented array Y must contain the n
  53. *           element vector y.
  54. *           Unchanged on exit.
  55. *
  56. *  INCY   - INTEGER.
  57. *           On entry, INCY specifies the increment for the elements of
  58. *           Y. INCY must not be zero.
  59. *           Unchanged on exit.
  60. *
  61. *  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
  62. *           Before entry, the leading m by n part of the array A must
  63. *           contain the matrix of coefficients. On exit, A is
  64. *           overwritten by the updated matrix.
  65. *
  66. *  LDA    - INTEGER.
  67. *           On entry, LDA specifies the first dimension of A as declared
  68. *           in the calling (sub) program. LDA must be at least
  69. *           max( 1, m ).
  70. *           Unchanged on exit.
  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. *     .. Parameters ..
  83.       DOUBLE PRECISION   ZERO
  84.       PARAMETER        ( ZERO = 0.0D+0 )
  85. *     .. Local Scalars ..
  86.       DOUBLE PRECISION   TEMP
  87.       INTEGER            I, INFO, IX, J, JY, KX
  88. *     .. External Subroutines ..
  89.       EXTERNAL           XERBLA
  90. *     .. Intrinsic Functions ..
  91.       INTRINSIC          MAX
  92. *     ..
  93. *     .. Executable Statements ..
  94. *
  95. *     Test the input parameters.
  96. *
  97.       INFO = 0
  98.       IF     ( M.LT.0 )THEN
  99.          INFO = 1
  100.       ELSE IF( N.LT.0 )THEN
  101.          INFO = 2
  102.       ELSE IF( INCX.EQ.0 )THEN
  103.          INFO = 5
  104.       ELSE IF( INCY.EQ.0 )THEN
  105.          INFO = 7
  106.       ELSE IF( LDA.LT.MAX( 1, M ) )THEN
  107.          INFO = 9
  108.       END IF
  109.       IF( INFO.NE.0 )THEN
  110.          CALL XERBLA( 'DGER  ', INFO )
  111.          RETURN
  112.       END IF
  113. *
  114. *     Quick return if possible.
  115. *
  116.       IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
  117.      $   RETURN
  118. *
  119. *     Start the operations. In this version the elements of A are
  120. *     accessed sequentially with one pass through A.
  121. *
  122.       IF( INCY.GT.0 )THEN
  123.          JY = 1
  124.       ELSE
  125.          JY = 1 - ( N - 1 )*INCY
  126.       END IF
  127.       IF( INCX.EQ.1 )THEN
  128.          DO 20, J = 1, N
  129.             IF( Y( JY ).NE.ZERO )THEN
  130.                TEMP = ALPHA*Y( JY )
  131.                DO 10, I = 1, M
  132.                   A( I, J ) = A( I, J ) + X( I )*TEMP
  133.    10          CONTINUE
  134.             END IF
  135.             JY = JY + INCY
  136.    20    CONTINUE
  137.       ELSE
  138.          IF( INCX.GT.0 )THEN
  139.             KX = 1
  140.          ELSE
  141.             KX = 1 - ( M - 1 )*INCX
  142.          END IF
  143.          DO 40, J = 1, N
  144.             IF( Y( JY ).NE.ZERO )THEN
  145.                TEMP = ALPHA*Y( JY )
  146.                IX   = KX
  147.                DO 30, I = 1, M
  148.                   A( I, J ) = A( I, J ) + X( IX )*TEMP
  149.                   IX        = IX        + INCX
  150.    30          CONTINUE
  151.             END IF
  152.             JY = JY + INCY
  153.    40    CONTINUE
  154.       END IF
  155. *
  156.       RETURN
  157. *
  158. *     End of DGER  .
  159. *
  160.       END
  161.