Télécharger dger.eso

Retour à la liste

Numérotation des lignes :

  1. C DGER SOURCE BP208322 15/10/13 21:15:21 8670
  2. SUBROUTINE DGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
  3. * .. Scalar Arguments ..
  4. REAL*8 ALPHA
  5. INTEGER INCX, INCY, LDA, M, N
  6. * .. Array Arguments ..
  7. REAL*8 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. * Parameters
  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. *
  71. * Level 2 Blas routine.
  72. *
  73. * -- Written on 22-October-1986.
  74. * Jack Dongarra, Argonne National Lab.
  75. * Jeremy Du Croz, Nag Central Office.
  76. * Sven Hammarling, Nag Central Office.
  77. * Richard Hanson, Sandia National Labs.
  78. *
  79. *
  80. * .. Parameters ..
  81. REAL*8 ZERO
  82. PARAMETER ( ZERO = 0.0D+0 )
  83. * .. Local Scalars ..
  84. REAL*8 TEMP
  85. INTEGER I, INFO, IX, J, JY, KX
  86. * .. External Subroutines ..
  87. EXTERNAL XERBLA
  88. ** .. Intrinsic Functions ..
  89. * INTRINSIC MAX
  90. ** ..
  91. ** .. Executable Statements ..
  92. *
  93. * Test the input parameters.
  94. *
  95. INFO = 0
  96. IF ( M.LT.0 )THEN
  97. INFO = 1
  98. ELSE IF( N.LT.0 )THEN
  99. INFO = 2
  100. ELSE IF( INCX.EQ.0 )THEN
  101. INFO = 5
  102. ELSE IF( INCY.EQ.0 )THEN
  103. INFO = 7
  104. ELSE IF( LDA.LT.MAX( 1, M ) )THEN
  105. INFO = 9
  106. END IF
  107. IF( INFO.NE.0 )THEN
  108. CALL XERBLA( 'DGER ', INFO )
  109. RETURN
  110. END IF
  111. *
  112. * Quick return if possible.
  113. *
  114. IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
  115. $ RETURN
  116. *
  117. * Start the operations. In this version the elements of A are
  118. * accessed sequentially with one pass through A.
  119. *
  120. IF( INCY.GT.0 )THEN
  121. JY = 1
  122. ELSE
  123. JY = 1 - ( N - 1 )*INCY
  124. END IF
  125. IF( INCX.EQ.1 )THEN
  126. DO 20, J = 1, N
  127. IF( Y( JY ).NE.ZERO )THEN
  128. TEMP = ALPHA*Y( JY )
  129. DO 10, I = 1, M
  130. A( I, J ) = A( I, J ) + X( I )*TEMP
  131. 10 CONTINUE
  132. END IF
  133. JY = JY + INCY
  134. 20 CONTINUE
  135. ELSE
  136. IF( INCX.GT.0 )THEN
  137. KX = 1
  138. ELSE
  139. KX = 1 - ( M - 1 )*INCX
  140. END IF
  141. DO 40, J = 1, N
  142. IF( Y( JY ).NE.ZERO )THEN
  143. TEMP = ALPHA*Y( JY )
  144. IX = KX
  145. DO 30, I = 1, M
  146. A( I, J ) = A( I, J ) + X( IX )*TEMP
  147. IX = IX + INCX
  148. 30 CONTINUE
  149. END IF
  150. JY = JY + INCY
  151. 40 CONTINUE
  152. END IF
  153. *
  154. RETURN
  155. *
  156. * End of DGER .
  157. *
  158. END
  159.  
  160.  

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