Télécharger la plaquette Cast3M


fr en

Télécharger dger.eso

Retour à la liste

Numérotation des lignes : 

dger

  1. C DGER      SOURCE    BP208322  22/09/16    21:15:03     11454          
  2. *
  3. *  Purpose
  4. *  =======
  5. *
  6. *  DGER   performs the rank 1 operation
  7. *
  8. *     A := alpha*x*y' + A,
  9. *
  10. *  where alpha is a scalar, x is an m element vector, y is an n element
  11. *  vector and A is an m by n matrix.
  12. *
  13. *  Parameters
  14. *  ==========
  15. *
  16. *  M      - INTEGER.
  17. *           On entry, M specifies the number of rows of the matrix A.
  18. *           M must be at least zero.
  19. *           Unchanged on exit.
  20. *
  21. *  N      - INTEGER.
  22. *           On entry, N specifies the number of columns of the matrix A.
  23. *           N must be at least zero.
  24. *           Unchanged on exit.
  25. *
  26. *  ALPHA  - REAL*8.
  27. *           On entry, ALPHA specifies the scalar alpha.
  28. *           Unchanged on exit.
  29. *
  30. *  X      - REAL*8 array of dimension at least
  31. *           ( 1 + ( m - 1 )*abs( INCX ) ).
  32. *           Before entry, the incremented array X must contain the m
  33. *           element vector x.
  34. *           Unchanged on exit.
  35. *
  36. *  INCX   - INTEGER.
  37. *           On entry, INCX specifies the increment for the elements of
  38. *           X. INCX must not be zero.
  39. *           Unchanged on exit.
  40. *
  41. *  Y      - REAL*8 array of dimension at least
  42. *           ( 1 + ( n - 1 )*abs( INCY ) ).
  43. *           Before entry, the incremented array Y must contain the n
  44. *           element vector y.
  45. *           Unchanged on exit.
  46. *
  47. *  INCY   - INTEGER.
  48. *           On entry, INCY specifies the increment for the elements of
  49. *           Y. INCY must not be zero.
  50. *           Unchanged on exit.
  51. *
  52. *  A      - REAL*8 array of DIMENSION ( LDA, n ).
  53. *           Before entry, the leading m by n part of the array A must
  54. *           contain the matrix of coefficients. On exit, A is
  55. *           overwritten by the updated matrix.
  56. *
  57. *  LDA    - INTEGER.
  58. *           On entry, LDA specifies the first dimension of A as declared
  59. *           in the calling (sub) program. LDA must be at least
  60. *           max( 1, m ).
  61. *           Unchanged on exit.
  62. *
  63. *  =====================================================================
  64.       SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
  65. *
  66. *  Level 2 Blas routine.
  67. *
  68. *  -- Written on 22-October-1986.
  69. *     Jack Dongarra, Argonne National Lab.
  70. *     Jeremy Du Croz, Nag Central Office.
  71. *     Sven Hammarling, Nag Central Office.
  72. *     Richard Hanson, Sandia National Labs.
  73. *
  74. *     .. Scalar Arguments ..
  75.       REAL*8   ALPHA
  76.       INTEGER            INCX, INCY, LDA, M, N
  77. *     .. Array Arguments ..
  78.       REAL*8   A( LDA, * ), X( * ), Y( * )
  79. *     ..
  80. *
  81. *
  82. *     .. Parameters ..
  83.       REAL*8   ZERO
  84.       PARAMETER        ( ZERO = 0.0D+0 )
  85. *     .. Local Scalars ..
  86.       REAL*8   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.  
  162.  
  163.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales