Télécharger pf500.eso

Retour à la liste

Numérotation des lignes :

  1. C PF500 SOURCE PV 09/03/12 21:30:05 6325
  2. SUBROUTINE PF500(IZDD,IPHI,IZSS,IZGG,IPHR,DT,MTABD,NUMCOM)
  3. C************************************************************************
  4. C
  5. C Pointeurs :
  6. C ---------
  7. C IZDD : Diagonale
  8. C IPHI : Resultat a l'instant precedent
  9. C IZSS : densité de source
  10. C IZGG : Champ point de type FACE representant les flux(l'increment)
  11. C IPHR : Resultat
  12. C MTABD : table du maillage
  13. C
  14. C MELEMA : Connectivites elements/faces 'ELTFA'
  15. C MCHELM : Sens des normales
  16. C MELEMF : Maillage de type face
  17. C
  18. C Variables :
  19. C ---------
  20. C DT : Pas de Temps
  21. C NUMCOM : Numero de Composante
  22. C
  23. C************************************************************************
  24. C
  25. C Objet : Fait le bilan par element pour un schema volume fini
  26. C -----
  27. C IPHR=IPHI + DT*(SOURCE) - DT*(FLUX)/DIAGONALE
  28. C ou encore IPHR=IPHI + DT*IZSS - DT*IZGG/IZDD
  29. C
  30. C************************************************************************
  31. C Modifications pour prendre en compte les champs a plusieurs
  32. C composantes et rajout de Messages d'erreurs : P.G Aout 96
  33. C************************************************************************
  34. C
  35. IMPLICIT INTEGER(I-N)
  36. IMPLICIT REAL*8 (A-H,O-Z)
  37. C
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. -INC SMLENTI
  42. C
  43. -INC SMTABLE
  44. POINTEUR MTABD.MTABLE
  45. C
  46. -INC SMELEME
  47. POINTEUR MELEMA.MELEME,MELEMC.MELEME,MELEMF.MELEME
  48. C
  49. -INC SMCHPOI
  50. POINTEUR IPHI.MPOVAL,IPHR.MPOVAL
  51. POINTEUR IZDD.MPOVAL,IZGG.MPOVAL,IZSS.MPOVAL
  52. C
  53. -INC SMCHAML
  54. C
  55. REAL*8 PHI
  56. C
  57. C
  58. C - Lecture du tableau des sens des normales : chamelem
  59. C ---------------------------------------------------
  60. CALL LEKTAB(MTABD,'XXNORMAE',MCHELM)
  61. IF(MCHELM.EQ.0)THEN
  62. MOTERR(1:40)='Pas de CHAMELEM des Normales '
  63. CALL ERREUR(-301)
  64. GO TO 99
  65. ENDIF
  66. SEGACT MCHELM
  67. C
  68. C - Lecture des connexions Faces/Elements
  69. C -------------------------------------
  70. CALL LEKTAB(MTABD,'ELTFA',MELEMA)
  71. IF(MELEMA.EQ.0)THEN
  72. MOTERR(1:40)='Pas de Meleme connexions Faces/Elements '
  73. CALL ERREUR(-301)
  74. GO TO 99
  75. ENDIF
  76. SEGACT MELEMA
  77. C
  78. CALL LEKTAB(MTABD,'FACE',MELEMF)
  79. IF(MELEMF.EQ.0)THEN
  80. MOTERR(1:40)='Pas de Meleme des FACES '
  81. CALL ERREUR(-301)
  82. GO TO 99
  83. ENDIF
  84. SEGACT MELEMF
  85. C
  86. C
  87. NBSOUS = MELEMA.LISOUS(/1)
  88. C
  89. IF(NBSOUS.EQ.0)NBSOUS = 1
  90. II = 0
  91. C
  92. NBF = MELEMF.NUM(/2)
  93. MELEMC = MELEMF
  94. CALL KRIPAD(MELEMC,MLENTI)
  95. C CALL RSETXI(LECT,MELEMF.NUM,NBF)
  96. SEGACT MELEMC
  97. C
  98. C - Boucle sur les sous Objets
  99. C ==========================
  100. DO 1 L=1,NBSOUS
  101. IPT1 = MELEMA
  102. IF(NBSOUS.NE.1)IPT1 = MELEMA.LISOUS(L)
  103. SEGACT IPT1
  104. NP = IPT1.NUM(/1)
  105. NEL = IPT1.NUM(/2)
  106. MCHAML = ICHAML(L)
  107. SEGACT MCHAML
  108. MELVAL = IELVAL(1)
  109. SEGACT MELVAL
  110. C
  111. C - Cas ou il n'y a pas de terme Source
  112. C -----------------------------------
  113. C
  114. IF(IZSS.EQ.0)THEN
  115. C
  116. DO 10 K=1,NEL
  117. II = II+1
  118. PHI = 0.D0
  119. C
  120. C bilan sur chaque element
  121. C -----------------------
  122. DO 11 I=1,NP
  123. NF = IPT1.NUM(I,K)
  124. NF = LECT(NF)
  125. PHI = PHI + IZGG.VPOCHA(nf,numcom)*MELVAL.VELCHE(I,K)
  126. 11 CONTINUE
  127. C
  128. IPHR.VPOCHA(II,numcom) = IPHI.VPOCHA(II,numcom)
  129. & -DT*PHI/IZDD.VPOCHA(II,numcom)
  130. C
  131. 10 CONTINUE
  132. C
  133. ELSE
  134. C
  135. C - Cas ou il n'y a un terme Source
  136. C -------------------------------
  137. C
  138. DO 20 K=1,NEL
  139. II = II+1
  140. PHI = 0.D0
  141. C
  142. C bilan sur chaque element
  143. C -----------------------
  144. DO 21 I=1,NP
  145. NF = IPT1.NUM(I,K)
  146. NF = LECT(NF)
  147. PHI = PHI + IZGG.VPOCHA(nf,numcom)*MELVAL.VELCHE(I,K)
  148. 21 CONTINUE
  149. C
  150. IPHR.VPOCHA(II,numcom)= IPHI.VPOCHA(II,numcom)
  151. 1 -DT*PHI/IZDD.VPOCHA(II,numcom)
  152. 2 +DT*IZSS.VPOCHA(II,numcom)
  153. C
  154. 20 CONTINUE
  155. ENDIF
  156. SEGDES IPT1,MELVAL,MCHAML
  157. 1 CONTINUE
  158. C
  159. C - Fin de Boucle sur les Sous-Objets
  160. C =================================
  161. C
  162. SEGSUP MLENTI
  163. SEGDES MELEMC,MELEMA,MELEMF,MCHELM
  164. C
  165. RETURN
  166. C
  167. 99 CONTINUE
  168. MOTERR(1:40)=' Interruption anormale de PF500 '
  169. CALL ERREUR(-301)
  170. C
  171. RETURN
  172. END
  173.  
  174.  
  175.  
  176.  
  177.  

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