Télécharger gmomvf.eso

Retour à la liste

Numérotation des lignes :

  1. C GMOMVF SOURCE GOUNAND 11/10/07 21:15:29 7149
  2. SUBROUTINE GMOMVF(IMVEC,ITRAN,N,ALPHA,NNZ,ROWPTR,COLIND,VAL,X,
  3. $ BETA,Y,
  4. $ ithr,nbthr)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : GMOMVF
  9. C DESCRIPTION : Partie en fortran du produit matrice-vecteur
  10. C
  11. C
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES :
  18. C APPELES (E/S) :
  19. C APPELES (BLAS) :
  20. C APPELES (CALCUL) :
  21. C APPELE PAR :
  22. C***********************************************************************
  23. C SYNTAXE GIBIANE :
  24. C ENTREES :
  25. C ENTREES/SORTIES :
  26. C SORTIES :
  27. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  28. C***********************************************************************
  29. C VERSION : v1, 08/01/2008, version initiale
  30. C HISTORIQUE : v1, 08/01/2008, création
  31. C HISTORIQUE :
  32. C HISTORIQUE :
  33. C***********************************************************************
  34. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  35. C en cas de modification de ce sous-programme afin de faciliter
  36. C la maintenance !
  37. C***********************************************************************
  38. * .. Scalar Arguments ..
  39. REAL*8 ALPHA, BETA
  40. INTEGER N, NNZ,ITRAN
  41. CHARACTER*1 TRANS
  42. * .. Array Arguments ..
  43. * .. Morse Matrix
  44. INTEGER ROWPTR( N+1 )
  45. INTEGER COLIND( NNZ )
  46. REAL*8 VAL( NNZ )
  47. * .. Vectors
  48. REAL*8 X( N ), Y( N )
  49. * .. Parameters ..
  50. REAL*8 ONE , ZERO
  51. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  52. *
  53. * Quick return if possible.
  54. *
  55. IF( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) )
  56. $ RETURN
  57. ISTRAT=IMVEC
  58. *
  59. * Stratégie 1 : une ligne pour proc 1, la suivante pour proc 2...
  60. *
  61. IF (ISTRAT.EQ.1) THEN
  62. * First form y := beta*y.
  63. IF (BETA.NE.ONE)THEN
  64. IF (BETA.EQ.ZERO)THEN
  65. DO 10 I=ithr,N,nbthr
  66. Y(I)=ZERO
  67. 10 CONTINUE
  68. ELSE
  69. DO 20 I=ithr,N,nbthr
  70. Y(I)=BETA*Y(I)
  71. 20 CONTINUE
  72. END IF
  73. END IF
  74. IF (ALPHA.EQ.ZERO) RETURN
  75. * Form y := alpha*A*x + y.
  76. IF (ITRAN.EQ.0) THEN
  77. DO 60 I=ithr,N,nbthr
  78. DO 50 J=ROWPTR(I),(ROWPTR(I+1)-1)
  79. Y(I)=Y(I)+(ALPHA*VAL(J)*X(COLIND(J)))
  80. 50 CONTINUE
  81. 60 CONTINUE
  82. ELSE
  83. DO 61 J=ithr,N,nbthr
  84. IF (X(J).NE.ZERO) THEN
  85. XTMP=ALPHA*X(J)
  86. DO 51 I=ROWPTR(J),(ROWPTR(J+1)-1)
  87. Y(COLIND(I))=Y(COLIND(I))+(VAL(I)*XTMP)
  88. 51 CONTINUE
  89. ENDIF
  90. 61 CONTINUE
  91. ENDIF
  92. *
  93. * Stratégie : bloc de lignes consécutives pour chaque proc
  94. *
  95. ELSE
  96. * First form y := beta*y.
  97. ideb = (((ithr-1)*n)/nbthr)+1
  98. iend = (ithr*n)/nbthr
  99. IF (BETA.NE.ONE)THEN
  100. IF (BETA.EQ.ZERO)THEN
  101. DO 110 I=ideb,iend
  102. Y(I)=ZERO
  103. 110 CONTINUE
  104. ELSE
  105. DO 120 I=ideb,iend
  106. Y(I)=BETA*Y(I)
  107. 120 CONTINUE
  108. END IF
  109. END IF
  110. IF (ALPHA.EQ.ZERO) RETURN
  111. * Form y := alpha*A*x + y.
  112. IF (ITRAN.EQ.0) THEN
  113. DO 160 I=ideb,iend
  114. DO 150 J=ROWPTR(I),(ROWPTR(I+1)-1)
  115. Y(I)=Y(I)+(ALPHA*VAL(J)*X(COLIND(J)))
  116. 150 CONTINUE
  117. 160 CONTINUE
  118. ELSE
  119. DO 161 J=ideb,iend
  120. IF (X(J).NE.ZERO) THEN
  121. XTMP=ALPHA*X(J)
  122. DO 151 I=ROWPTR(J),(ROWPTR(J+1)-1)
  123. Y(COLIND(I))=Y(COLIND(I))+(VAL(I)*XTMP)
  124. 151 CONTINUE
  125. ENDIF
  126. 161 CONTINUE
  127. ENDIF
  128. ENDIF
  129. C
  130. C CALL DMOMV ('No transpose',N,ALPHA,
  131. C $ NNZ,KMORS.IA,KMORS.JA,KISA.A,
  132. C $ X.A,BETA,Y.A)
  133. *
  134. * Normal termination
  135. *
  136. RETURN
  137. *
  138. * End of subroutine GMOMVF
  139. *
  140. END
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  

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