Télécharger fullery.eso

Retour à la liste

Numérotation des lignes :

  1. C FULLERY SOURCE SERRE 16/12/13 21:15:08 9254
  2. SUBROUTINE FULLERY
  3. C
  4. C--------------------------------------------------------------------
  5. C Evaluation du coefficient de diffusion de la vapeur dans un melange
  6. C de gaz pour une pression et une temperature donnee
  7. C--------------------------------------------------------------------
  8. C
  9. C---------------------------
  10. C Phrase d'appel (GIBIANE) :
  11. C---------------------------
  12. C
  13. C CHP1 = FULLERNC TAB1 ;
  14. C
  15. C------------------------
  16. C Operandes et resultat :
  17. C------------------------
  18. C
  19. C TAB1 : TABLE SET contenant l'ensemble des data 0D
  20. C CHP1 : CHPO de support CELL contenant le coefficient de diffusion
  21. C de la vapeur dans le melange de gaz (en m2/s)
  22. C
  23. C--------------------------------------------------------------------
  24. C
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8 (A-H,O-Z)
  27. CHARACTER*4 NOMTOT(1)
  28. CHARACTER*8 TYPE,TYPS,MTYPI,MTYPR,MOT1,MOT2,BETA(7)
  29. CHARACTER*72 CHARR
  30. LOGICAL LOGI,LOGR
  31. C
  32. -INC CCOPTIO
  33. -INC SMCHPOI
  34. -INC SMELEME
  35. -INC SMTABLE
  36. SEGMENT IWORK
  37. REAL*8 V(NBCONS,2),W(NBCELL,2)
  38. CHARACTER*8 BETA(NBCONS)
  39. ENDSEGMENT
  40. C
  41. C- Lecture et controles des donnees d'entree,
  42. C
  43. C MTAB1 : Table SET
  44. C MTAB2 : Table INCO
  45. C MTAB3 : Table COMPONENT
  46. C MTAB4 : Table GEOINF
  47. C
  48. CALL LIRTAB('SET',MTAB1,1,IRETOU)
  49. IF (IERR.NE.0) RETURN
  50. MTYPI = 'MOT '
  51. MTYPR = 'TABLE '
  52. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'INCO',LOGI,IRETI,
  53. & MTYPR,IVALR,XVALR,CHARR,LOGR,MTAB2)
  54. IF (IERR.NE.0) RETURN
  55. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'COMPONENT',LOGI,IRETI,
  56. & MTYPR,IVALR,XVALR,CHARR,LOGR,MTAB3)
  57. IF (IERR.NE.0) RETURN
  58. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'GEOINF',LOGI,IRETI,
  59. & MTYPR,IVALR,XVALR,CHARR,LOGR,MTAB4)
  60. IF (IERR.NE.0) RETURN
  61. C
  62. C IPT1 : Maillage POI1 des CELLs
  63. C
  64. TYPE = 'MAILLAGE'
  65. CALL ACMO(MTAB4,'CELL',TYPE,IPT1)
  66. IF (IERR.NE.0) RETURN
  67. C
  68. C MCHPO1 : Pression
  69. C MCHPO2 : Temperature
  70. C MCHPO4 : Densité
  71. C
  72. TYPE = 'CHPOINT '
  73. TYPS = ' '
  74. CALL ACMO(MTAB2,'PT',TYPE,MCHPO1)
  75. CALL LRCHT(MCHPO1,MPOVA1,TYPS,IGEO1)
  76. IF (IERR.NE.0) RETURN
  77. IF (IGEO1.NE.IPT1) THEN
  78. INDIC = 1
  79. NBCOMP = -1
  80. CALL QUEPOI(MCHPO1,IPT1,INDIC,NBCOMP,NOMTOT)
  81. IF (IERR.NE.0) RETURN
  82. CALL LRCHT(MCHPO1,MPOVA1,TYPS,IGEO1)
  83. ENDIF
  84. C
  85. TYPE = 'CHPOINT '
  86. CALL ACMO(MTAB2,'TGAS',TYPE,MCHPO2)
  87. IF (IERR.NE.0) RETURN
  88. CALL LRCHT(MCHPO2,MPOVA2,TYPS,IGEO1)
  89. IF (IGEO1.NE.IPT1) THEN
  90. INDIC = 1
  91. NBCOMP = -1
  92. CALL QUEPOI(MCHPO2,IPT1,INDIC,NBCOMP,NOMTOT)
  93. IF (IERR.NE.0) RETURN
  94. CALL LRCHT(MCHPO2,MPOVA2,TYPS,IGEO1)
  95. ENDIF
  96. C
  97. TYPE = 'CHPOINT '
  98. CALL ACMO(MTAB2,'RGAS',TYPE,MCHPO4)
  99. IF (IERR.NE.0) RETURN
  100. CALL LRCHT(MCHPO4,MPOVA4,TYPS,IGEO1)
  101. IF (IGEO1.NE.IPT1) THEN
  102. INDIC = 1
  103. NBCOMP = -1
  104. CALL QUEPOI(MCHPO4,IPT1,INDIC,NBCOMP,NOMTOT)
  105. IF (IERR.NE.0) RETURN
  106. CALL LRCHT(MCHPO4,MPOVA4,TYPS,IGEO1)
  107. ENDIF
  108. C
  109. C- Creation du chpo contenant le coefficient de diffusion
  110. C- de la vapeur dans les incondensables
  111. C
  112. SEGINI, MCHPOI=MCHPO1
  113. NC = 1
  114. SEGINI MSOUPO
  115. SEGINI, MPOVAL=MPOVA1
  116. IPCHP(1) = MSOUPO
  117. NOCOMP(1) = 'SCAL'
  118. IGEOC = IPT1
  119. IPOVAL = MPOVAL
  120. NOHARM(1) = NIFOUR
  121. C
  122. C Creation du segment IWORK
  123. C Ordre des constituants : H2O, H2, He, N2, O2, CO2, CO
  124. C
  125. SEGACT IPT1
  126. NBCELL = IPT1.NUM(/2)
  127. SEGDES IPT1
  128. NBCONS = 7
  129. SEGINI IWORK
  130. C
  131. C- Liste des constituants autorises
  132. BETA(1) = 'H2O '
  133. BETA(2) = 'H2 '
  134. BETA(3) = 'HE '
  135. BETA(4) = 'N2 '
  136. BETA(5) = 'O2 '
  137. BETA(6) = 'CO2 '
  138. BETA(7) = 'CO '
  139. C
  140. C- Masse molaire (en kg/mol)
  141. V(1,1) = 0.018D0
  142. V(2,1) = 0.002D0
  143. V(3,1) = 0.004D0
  144. V(4,1) = 0.028D0
  145. V(5,1) = 0.032D0
  146. V(6,1) = 0.044D0
  147. V(7,1) = 0.028D0
  148. C
  149. C- Coefficient intervenant dans l'expression de la loi de diffusion
  150. C- de la vapeur dans le constituant de rang i lorsqu'il est seul
  151. V(1,2) = 13.1
  152. V(2,2) = 6.12
  153. V(3,2) = 2.67
  154. V(4,2) = 18.5
  155. V(5,2) = 16.3
  156. V(6,2) = 26.9
  157. V(7,2) = 18.0
  158. C
  159. SEGACT MTAB3
  160. IDIM1 = MTAB3.MLOTAB
  161. DO 40 I=1,IDIM1
  162. CALL ACEM(MTAB3,I,MOT1)
  163. MOT2 = 'R' // MOT1(1:7)
  164. TYPE = 'CHPOINT '
  165. CALL ACMO(MTAB2,MOT2,TYPE,MCHPO3)
  166. IF (IERR.NE.0) RETURN
  167. II = 0
  168. DO 10 K=1,NBCONS
  169. IF (BETA(K).EQ.MOT1) THEN
  170. II = K
  171. GOTO 20
  172. ENDIF
  173. 10 CONTINUE
  174. C Le mot %m1:4 n'est pas un nom de composante reconnu
  175. MOTERR(1:4) = MOT1(1:4)
  176. CALL ERREUR(197)
  177. RETURN
  178. 20 CONTINUE
  179. CALL LRCHT(MCHPO3,MPOVA3,TYPS,IGEO1)
  180. IF (IGEO1.NE.IPT1) THEN
  181. INDIC = 1
  182. NBCOMP = -1
  183. CALL QUEPOI(MCHPO3,IPT1,INDIC,NBCOMP,NOMTOT)
  184. IF (IERR.NE.0) RETURN
  185. CALL LRCHT(MCHPO3,MPOVA3,TYPS,IGEO1)
  186. ENDIF
  187. A1 = V(II,1)
  188. A2 = 1.D0 / V(II,1)
  189. A3 = 1.D0 / V(1,1)
  190. WAB = 2.D3 / (A2 + A3)
  191. A4 = (V(II,2)**(1.D0/3.D0) + V(1,2)**(1.D0/3.D0))**2.D0
  192. DO 30 J=1,NBCELL
  193. GIIJ = MPOVA3.VPOCHA(J,1) / MPOVA4.VPOCHA(J,1)
  194. IF (II.NE.1) THEN
  195. DVIIJ = (1.D-4 * 0.00143D0) * (MPOVA2.VPOCHA(J,1) ** 1.75)
  196. & / ((MPOVA1.VPOCHA(J,1) * 1.D-5)*(WAB ** 0.5D0)*A4)
  197. W(J,2) = W(J,2) + GIIJ/DVIIJ
  198. ELSE
  199. VPOCHA(J,1) = MPOVA3.VPOCHA(J,1) / MPOVA4.VPOCHA(J,1)
  200. ENDIF
  201. 30 CONTINUE
  202. SEGDES MPOVA3
  203. 40 CONTINUE
  204. SEGDES MTAB3,MPOVA1,MPOVA2,MPOVA4
  205. C
  206. C- Remplissage du chpo contenant le coefficient de diffusion
  207. C- de la vapeur dans les incondensables (loi de Blanc)
  208. C
  209. DO 50 I=1,NBCELL
  210. VPOCHA(I,1) = (1.D0 - VPOCHA(I,1)) / W(I,2)
  211. 50 CONTINUE
  212. SEGDES MCHPOI,MSOUPO,MPOVAL
  213. C
  214. SEGSUP IWORK
  215. CALL ECROBJ('CHPOINT ',MCHPOI)
  216. RETURN
  217. END
  218.  
  219.  
  220.  
  221.  
  222.  

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