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. -INC CCOPTIO
  39. -INC SMLENTI
  40. C
  41. -INC SMTABLE
  42. POINTEUR MTABD.MTABLE
  43. C
  44. -INC SMELEME
  45. POINTEUR MELEMA.MELEME,MELEMC.MELEME,MELEMF.MELEME
  46. C
  47. -INC SMCHPOI
  48. POINTEUR IPHI.MPOVAL,IPHR.MPOVAL
  49. POINTEUR IZDD.MPOVAL,IZGG.MPOVAL,IZSS.MPOVAL
  50. C
  51. -INC SMCHAML
  52. C
  53. REAL*8 PHI
  54. C
  55. C
  56. C - Lecture du tableau des sens des normales : chamelem
  57. C ---------------------------------------------------
  58. CALL LEKTAB(MTABD,'XXNORMAE',MCHELM)
  59. IF(MCHELM.EQ.0)THEN
  60. MOTERR(1:40)='Pas de CHAMELEM des Normales '
  61. CALL ERREUR(-301)
  62. GO TO 99
  63. ENDIF
  64. SEGACT MCHELM
  65. C
  66. C - Lecture des connexions Faces/Elements
  67. C -------------------------------------
  68. CALL LEKTAB(MTABD,'ELTFA',MELEMA)
  69. IF(MELEMA.EQ.0)THEN
  70. MOTERR(1:40)='Pas de Meleme connexions Faces/Elements '
  71. CALL ERREUR(-301)
  72. GO TO 99
  73. ENDIF
  74. SEGACT MELEMA
  75. C
  76. CALL LEKTAB(MTABD,'FACE',MELEMF)
  77. IF(MELEMF.EQ.0)THEN
  78. MOTERR(1:40)='Pas de Meleme des FACES '
  79. CALL ERREUR(-301)
  80. GO TO 99
  81. ENDIF
  82. SEGACT MELEMF
  83. C
  84. C
  85. NBSOUS = MELEMA.LISOUS(/1)
  86. C
  87. IF(NBSOUS.EQ.0)NBSOUS = 1
  88. II = 0
  89. C
  90. NBF = MELEMF.NUM(/2)
  91. MELEMC = MELEMF
  92. CALL KRIPAD(MELEMC,MLENTI)
  93. C CALL RSETXI(LECT,MELEMF.NUM,NBF)
  94. SEGACT MELEMC
  95. C
  96. C - Boucle sur les sous Objets
  97. C ==========================
  98. DO 1 L=1,NBSOUS
  99. IPT1 = MELEMA
  100. IF(NBSOUS.NE.1)IPT1 = MELEMA.LISOUS(L)
  101. SEGACT IPT1
  102. NP = IPT1.NUM(/1)
  103. NEL = IPT1.NUM(/2)
  104. MCHAML = ICHAML(L)
  105. SEGACT MCHAML
  106. MELVAL = IELVAL(1)
  107. SEGACT MELVAL
  108. C
  109. C - Cas ou il n'y a pas de terme Source
  110. C -----------------------------------
  111. C
  112. IF(IZSS.EQ.0)THEN
  113. C
  114. DO 10 K=1,NEL
  115. II = II+1
  116. PHI = 0.D0
  117. C
  118. C bilan sur chaque element
  119. C -----------------------
  120. DO 11 I=1,NP
  121. NF = IPT1.NUM(I,K)
  122. NF = LECT(NF)
  123. PHI = PHI + IZGG.VPOCHA(nf,numcom)*MELVAL.VELCHE(I,K)
  124. 11 CONTINUE
  125. C
  126. IPHR.VPOCHA(II,numcom) = IPHI.VPOCHA(II,numcom)
  127. & -DT*PHI/IZDD.VPOCHA(II,numcom)
  128. C
  129. 10 CONTINUE
  130. C
  131. ELSE
  132. C
  133. C - Cas ou il n'y a un terme Source
  134. C -------------------------------
  135. C
  136. DO 20 K=1,NEL
  137. II = II+1
  138. PHI = 0.D0
  139. C
  140. C bilan sur chaque element
  141. C -----------------------
  142. DO 21 I=1,NP
  143. NF = IPT1.NUM(I,K)
  144. NF = LECT(NF)
  145. PHI = PHI + IZGG.VPOCHA(nf,numcom)*MELVAL.VELCHE(I,K)
  146. 21 CONTINUE
  147. C
  148. IPHR.VPOCHA(II,numcom)= IPHI.VPOCHA(II,numcom)
  149. 1 -DT*PHI/IZDD.VPOCHA(II,numcom)
  150. 2 +DT*IZSS.VPOCHA(II,numcom)
  151. C
  152. 20 CONTINUE
  153. ENDIF
  154. SEGDES IPT1,MELVAL,MCHAML
  155. 1 CONTINUE
  156. C
  157. C - Fin de Boucle sur les Sous-Objets
  158. C =================================
  159. C
  160. SEGSUP MLENTI
  161. SEGDES MELEMC,MELEMA,MELEMF,MCHELM
  162. C
  163. RETURN
  164. C
  165. 99 CONTINUE
  166. MOTERR(1:40)=' Interruption anormale de PF500 '
  167. CALL ERREUR(-301)
  168. C
  169. RETURN
  170. END
  171.  
  172.  
  173.  
  174.  
  175.  

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