Télécharger dmomv.eso

Retour à la liste

Numérotation des lignes :

  1. C DMOMV SOURCE GOUNAND 05/02/16 21:15:19 5029
  2. SUBROUTINE DMOMV ( TRANS, N, ALPHA, NNZ, ROWPTR, COLIND, VAL,
  3. $ X, BETA, Y )
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. IMPLICIT INTEGER (I-N)
  6. ***********************************************************************
  7. C NOM : DMOMV
  8. C DESCRIPTION :
  9. C DMOMV is a modified (16/2/98), reduced,
  10. C version of DGEMV as defined in BLAS 2.
  11. C
  12. C It performs one of the matrix-vector operations
  13. C
  14. C y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
  15. C
  16. C where alpha and beta are scalars, x and y are vectors
  17. C A is an n by n (square) matrix stored in Morse format
  18. C (also known as Compressed Row Storage (CRS)).
  19. C
  20. C LANGAGE : ESOPE
  21. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  22. C mél : gounand@semt2.smts.cea.fr
  23. C REFERENCE (bibtex-like) :
  24. C @BOOK{templates,
  25. C AUTHOR={R.Barrett, M.Berry, T.F.Chan, J.Demmel, J.Donato,
  26. C J.Dongarra, V.Eijkhout, R.Pozo, C.Romine,
  27. C H. Van der Vorst},
  28. C TITLE={Templates for the Solution of Linear Systems :
  29. C Building Blocks for Iterative Methods},
  30. C PUBLISHER={SIAM}, YEAR={1994}, ADDRESS={Philadelphia,PA} }
  31. C -> URL : http://www.netlib.org/templates/Templates.html
  32. C***********************************************************************
  33. C APPELES : -
  34. C***********************************************************************
  35. C ENTREES : TRANS, N, ALPHA,
  36. C NNZ, ROWPTR, COLIND, VAL,
  37. C X, BETA
  38. C ENTREES/SORTIES : Y
  39. C SORTIES : -
  40. C CODE RETOUR (IRET) : -
  41. C TRANS - CHARACTER*1.
  42. C On entry, TRANS specifies the operation to be performed as
  43. C follows:
  44. C TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
  45. C TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
  46. C TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
  47. C Note : working with TRANS = 'T' might be slower due to storage format
  48. C If speed is more important than memory consumption, storing the
  49. C transpose matrix before calling DMOMV might help
  50. C
  51. C N - INTEGER.
  52. C On entry, N specifies the number of columns and rows
  53. C of the matrix A.
  54. C N must be at least zero.
  55. C
  56. C ALPHA - REAL*8.
  57. C On entry, ALPHA specifies the scalar alpha.
  58. C
  59. C NNZ : nombre de valeurs non nulles de la matrice Morse
  60. C ROWPTR, COLIND, VAL : pointeur de ligne, index de colonne
  61. C et valeurs de la matrice Morse
  62. C
  63. C X - REAL*8 array of DIMENSION N
  64. C
  65. C BETA - REAL*8.
  66. C On entry, BETA specifies the scalar beta. When BETA is
  67. C supplied as zero then Y need not be set on input.
  68. C
  69. C Y - REAL*8 array of DIMENSION N
  70. C Before entry with BETA non-zero, the array Y
  71. C must contain the vector y. On exit, Y is overwritten by the
  72. C updated vector y.
  73. C
  74. C***********************************************************************
  75. C VERSION : v1, 16/02/98, version initiale
  76. C HISTORIQUE : v1, 16/02/98, création
  77. C HISTORIQUE :
  78. C HISTORIQUE :
  79. C***********************************************************************
  80. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  81. C en cas de modification de ce sous-programme afin de faciliter
  82. C la maintenance !
  83. C***********************************************************************
  84. * .. Scalar Arguments ..
  85. REAL*8 ALPHA, BETA
  86. INTEGER N, NNZ
  87. CHARACTER*1 TRANS
  88. * .. Array Arguments ..
  89. * .. Morse Matrix
  90. INTEGER ROWPTR( N+1 )
  91. INTEGER COLIND( NNZ )
  92. REAL*8 VAL( NNZ )
  93. * .. Vectors
  94. REAL*8 X( N ), Y( N )
  95. * ..
  96. * Level 2 Blas routine.
  97. *
  98. * -- Written on 22-October-1986.
  99. * Jack Dongarra, Argonne National Lab.
  100. * Jeremy Du Croz, Nag Central Office.
  101. * Sven Hammarling, Nag Central Office.
  102. * Richard Hanson, Sandia National Labs.
  103. * -- Modified on 16-February-1998
  104. *
  105. -INC CCOPTIO
  106. *
  107. * .. Parameters ..
  108. REAL*8 ONE , ZERO
  109. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  110. * .. Local Scalars ..
  111. REAL*8 TEMP
  112. INTEGER I, J
  113. * .. External Functions ..
  114. LOGICAL LSAME
  115. EXTERNAL LSAME
  116. * ..
  117. * .. Executable Statements ..
  118. *
  119. * Test the input parameters.
  120. *
  121. IF ( .NOT.LSAME( TRANS, 'N' ).AND.
  122. $ .NOT.LSAME( TRANS, 'T' ).AND.
  123. $ .NOT.LSAME( TRANS, 'C' ) )THEN
  124. GOTO 9999
  125. ELSE IF( N.LE.0 )THEN
  126. GOTO 9998
  127. END IF
  128. *
  129. * Quick return if possible.
  130. *
  131. IF( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) )
  132. $ RETURN
  133. *
  134. * Start the operations. In this version the elements of A are
  135. * accessed sequentially with one pass through A.
  136. *
  137. * First form y := beta*y.
  138. *
  139. IF( BETA.NE.ONE )THEN
  140. IF( BETA.EQ.ZERO )THEN
  141. DO 10, I = 1, N
  142. Y( I ) = ZERO
  143. 10 CONTINUE
  144. ELSE
  145. DO 20, I = 1, N
  146. Y( I ) = BETA*Y( I )
  147. 20 CONTINUE
  148. END IF
  149. END IF
  150. IF( ALPHA.EQ.ZERO )
  151. $ RETURN
  152. IF( LSAME( TRANS, 'N' ) )THEN
  153. *
  154. * Form y := alpha*A*x + y.
  155. *
  156. DO 60, I = 1, N
  157. DO 50, J = ROWPTR( I ), (ROWPTR( I+1 ) - 1)
  158. *!!! IF ( X( COLIND( J )).NE.ZERO ) THEN
  159. Y( I ) = Y( I ) + (ALPHA * VAL( J ) * X( COLIND( J )))
  160. *!!! ENDIF
  161. 50 CONTINUE
  162. 60 CONTINUE
  163. ELSE
  164. *
  165. * Form y := alpha*A'*x + y.
  166. *
  167. DO 100, J = 1, N
  168. IF ( X( J ).NE.ZERO ) THEN
  169. TEMP = ALPHA * X( J )
  170. DO 90, I = ROWPTR( J ), (ROWPTR( J+1 ) - 1)
  171. Y( COLIND( I )) = Y( COLIND( I ))
  172. $ + VAL( I ) * TEMP
  173. 90 CONTINUE
  174. ENDIF
  175. 100 CONTINUE
  176. ENDIF
  177. *
  178. * Normal termination
  179. *
  180. RETURN
  181. *
  182. * Format handling
  183. *
  184. *
  185. * Error handling
  186. *
  187. 9998 CONTINUE
  188. WRITE(IOIMP,*) 'Dimension or increment lower than 1'
  189. WRITE(IOIMP,*) 'transmitted to subroutine dmomv'
  190. WRITE(IOIMP,*) 'nothing done'
  191. RETURN
  192. 9999 CONTINUE
  193. WRITE(IOIMP,*) 'Wrong option for TRANS'
  194. WRITE(IOIMP,*) 'transmitted to subroutine dmomv'
  195. WRITE(IOIMP,*) 'nothing done'
  196. RETURN
  197. *
  198. * End of DMOMV.
  199. *
  200. END
  201.  
  202.  
  203.  

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