Télécharger flamcr.eso

Retour à la liste

Numérotation des lignes :

  1. C FLAMCR SOURCE CHAT 06/08/24 21:35:58 5529
  2. SUBROUTINE FLAMCR()
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : FLAMCR
  8. C
  9. C DESCRIPTION : CREBCOM: critere de combustion
  10. C
  11. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  12. C
  13. C AUTEUR : A. BECCANTINI, DM2S/SFME/LTMF
  14. C
  15. C************************************************************************
  16. C
  17. C
  18. C************************************************************************
  19. C
  20. C HISTORIQUE (Anomalies et modifications éventuelles)
  21. C
  22. C HISTORIQUE :
  23. C
  24. C
  25. C************************************************************************
  26. C
  27. IMPLICIT INTEGER(I-N)
  28. -INC CCOPTIO
  29. -INC SMELEME
  30. POINTEUR MELEFE.MELEME
  31. -INC SMCHPOI
  32. POINTEUR MPOCSI.MPOVAL
  33. -INC SMLMOTS
  34. -INC SMLENTI
  35. INTEGER JGN, JGM
  36. POINTEUR MLECEN.MLENTI
  37. C
  38. C**** Variables de COOPTIO
  39. C
  40. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  41. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  42. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  43. C & ,IECHO, IIMPI, IOSPI
  44. C & ,IDIM
  45. C & ,MCOORD
  46. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  47. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  48. C & ,NORINC,NORVAL,NORIND,NORVAD
  49. C & ,NUCROU, IPSAUV
  50. C
  51. C**** Les variables
  52. C
  53. INTEGER IDOMA,IRET,MELEMC,ICSI,IGEOM,NCEN,NFAC,NLCF,ICEN
  54. & ,ICHPO1,NGCED,NGCEG,NLCED,NLCEG,N,NC, ICOND, INEFMD
  55.  
  56. REAL*8 EPS1, CSIMAX, VCSIG, VCSID, VCSI2G, VCSI2D, EPS12
  57. & , CSIG
  58. CHARACTER*8 TYPE
  59. C
  60. C**** Lecture de l'objet MODELE
  61. C
  62. ICOND = 1
  63. CALL QUETYP(TYPE,ICOND,IRET)
  64.  
  65. IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  66. WRITE(6,*)' On attend un objet MMODEL'
  67. RETURN
  68. ENDIF
  69. CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
  70. IF(IERR.NE.0)GOTO 9999
  71. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  72. IF(IERR.NE.0)GOTO 9999
  73. C
  74. C**** CENTRE, et FACEL
  75. C
  76. CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
  77. IF(IERR .NE. 0) GOTO 9999
  78. C
  79. CALL LEKTAB(IDOMA,'FACEL',MELEFE)
  80. IF(IERR .NE. 0) GOTO 9999
  81. C
  82. C**** EPS1
  83. C Critere original du model CREBCOM
  84. C
  85. CALL LIRREE(EPS1,1,IRET)
  86. IF(IERR.NE.0) GOTO 9999
  87. C
  88. C**** CSIMAX
  89. C
  90. CALL LIRREE(CSIMAX,1,IRET)
  91. IF(IERR.NE.0) GOTO 9999
  92. C
  93. C**** ICSI = Progress Variable
  94. C
  95. TYPE='CHPOINT '
  96. CALL LIROBJ(TYPE,ICSI,1,IRET)
  97. IF(IERR.NE.0) GOTO 9999
  98. C
  99. MLMOT1=0
  100. CALL QUEPO1(ICSI,MELEMC,MLMOT1)
  101. IF(IERR.NE.0) GOTO 9999
  102. SEGSUP MLMOT1
  103. C
  104. CALL LICHT(ICSI,MPOCSI,TYPE,IGEOM)
  105. C SEGACT MPOCSI
  106. IF(IERR.NE.0) GOTO 9999
  107. C
  108. C**** CHPOINT qui vaut 1 si on a combustion
  109. C zero o contraire
  110. JGN=4
  111. JGM=1
  112. SEGINI MLMOT1
  113. MLMOT1.MOTS(1)='SCAL'
  114. TYPE = ' '
  115. CALL KRCHP1(TYPE, MELEMC, ICHPO1, MLMOT1)
  116. C SEGDES MLMOT1
  117. IF(IERR.NE.0) GOTO 9999
  118. CALL LICHT(ICHPO1,MPOVA1,TYPE,IGEOM)
  119. C SEGACT MPOVA1
  120. IF(IERR.NE.0) GOTO 9999
  121. C
  122. C**** KRIPAD pour la correspondance global/local de centre
  123. C
  124. CALL KRIPAD(MELEMC,MLECEN)
  125. IF(IERR .NE. 0)GOTO 9999
  126. C
  127. C SEGACT MLECEN
  128. IPT1 = MELEMC
  129. SEGACT IPT1
  130. NCEN = IPT1.NUM(/2)
  131. SEGDES IPT1
  132. C
  133. SEGACT MELEFE
  134. NFAC=MELEFE.NUM(/2)
  135. C
  136. DO NLCF = 1, NFAC
  137. C
  138. C******* NLCF = numero local du centre de facel
  139. C NGCEG = numero global du centre ELT "gauche"
  140. C NLCEG = numero local du centre ELT "gauche"
  141. C NGCED = numero global du centre ELT "droite"
  142. C NLCED = numero local du centre ELT "droite"
  143. C
  144. NGCEG = MELEFE.NUM(1,NLCF)
  145. NGCED = MELEFE.NUM(3,NLCF)
  146. NLCEG = MLECEN.LECT(NGCEG)
  147. NLCED = MLECEN.LECT(NGCED)
  148. C
  149. VCSIG=MPOCSI.VPOCHA(NLCEG,1)
  150. VCSID=MPOCSI.VPOCHA(NLCED,1)
  151. VCSI2G=VCSIG*VCSIG
  152. VCSI2D=VCSID*VCSID
  153. C
  154. IF(NLCEG .EQ. NLCED)THEN
  155. C
  156. C********** Murs
  157. C
  158. MPOVA1.VPOCHA(NLCEG,1)=MPOVA1.VPOCHA(NLCEG,1) + (0.5D0 *
  159. & VCSI2D)
  160. C
  161. ELSE
  162. C
  163. MPOVA1.VPOCHA(NLCEG,1)=MPOVA1.VPOCHA(NLCEG,1) +
  164. & (VCSI2D - (0.5D0 * VCSI2G))
  165. MPOVA1.VPOCHA(NLCED,1)=MPOVA1.VPOCHA(NLCED,1) +
  166. & (VCSI2G - (0.5D0 * VCSI2D))
  167. C
  168. ENDIF
  169. ENDDO
  170. C
  171. EPS12 = EPS1 * EPS1
  172. DO ICEN = 1, NCEN, 1
  173. VCSIG = MPOVA1.VPOCHA(ICEN,1)
  174. CSIG = MPOCSI.VPOCHA(ICEN,1)
  175. C
  176. C******* In 2D, contribution of the ideal upper and lower cells
  177. C
  178. IF(IDIM .EQ. 2) VCSIG = VCSIG + (CSIG * CSIG)
  179. IF((VCSIG .GT. EPS12) .AND. (CSIG .LT. CSIMAX))THEN
  180. C
  181. C********** Il y a combustion
  182. C
  183. MPOVA1.VPOCHA(ICEN,1) = 1.0D0
  184. ELSE
  185. MPOVA1.VPOCHA(ICEN,1) = 0.0D0
  186. ENDIF
  187. ENDDO
  188. C
  189. SEGDES MPOVA1
  190. SEGDES MPOCSI
  191. SEGDES MELEFE
  192. SEGSUP MLECEN
  193. C
  194. C**** Ecriture du resultat
  195. C
  196. CALL ECROBJ('CHPOINT ',ICHPO1)
  197. IF(IERR.NE.0)GOTO 9999
  198. C
  199. 9999 RETURN
  200. END
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  

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