Télécharger fullerx.eso

Retour à la liste

Numérotation des lignes :

  1. C FULLERX SOURCE SERRE 16/12/13 21:15:07 9254
  2. SUBROUTINE FULLERX
  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
  71. TYPE = 'CHPOINT '
  72. TYPS = ' '
  73. CALL ACMO(MTAB2,'PT',TYPE,MCHPO1)
  74. CALL LRCHT(MCHPO1,MPOVA1,TYPS,IGEO1)
  75. IF (IERR.NE.0) RETURN
  76. IF (IGEO1.NE.IPT1) THEN
  77. INDIC = 1
  78. NBCOMP = -1
  79. CALL QUEPOI(MCHPO1,IPT1,INDIC,NBCOMP,NOMTOT)
  80. IF (IERR.NE.0) RETURN
  81. CALL LRCHT(MCHPO1,MPOVA1,TYPS,IGEO1)
  82. ENDIF
  83. C
  84. TYPE = 'CHPOINT '
  85. CALL ACMO(MTAB2,'TGAS',TYPE,MCHPO2)
  86. IF (IERR.NE.0) RETURN
  87. CALL LRCHT(MCHPO2,MPOVA2,TYPS,IGEO1)
  88. IF (IGEO1.NE.IPT1) THEN
  89. INDIC = 1
  90. NBCOMP = -1
  91. CALL QUEPOI(MCHPO2,IPT1,INDIC,NBCOMP,NOMTOT)
  92. IF (IERR.NE.0) RETURN
  93. CALL LRCHT(MCHPO2,MPOVA2,TYPS,IGEO1)
  94. ENDIF
  95. C
  96. C- Creation du chpo contenant le coefficient de diffusion
  97. C- de la vapeur dans les incondensables
  98. C
  99. SEGINI, MCHPOI=MCHPO1
  100. NC = 1
  101. SEGINI MSOUPO
  102. SEGINI, MPOVAL=MPOVA1
  103. IPCHP(1) = MSOUPO
  104. NOCOMP(1) = 'SCAL'
  105. IGEOC = IPT1
  106. IPOVAL = MPOVAL
  107. NOHARM(1) = NIFOUR
  108. C
  109. C Creation du segment IWORK
  110. C Ordre des constituants : H2O, H2, He, N2, O2, CO2, CO
  111. C
  112. SEGACT IPT1
  113. NBCELL = IPT1.NUM(/2)
  114. SEGDES IPT1
  115. NBCONS = 7
  116. SEGINI IWORK
  117. C
  118. C- Liste des constituants autorises
  119. BETA(1) = 'H2O '
  120. BETA(2) = 'H2 '
  121. BETA(3) = 'HE '
  122. BETA(4) = 'N2 '
  123. BETA(5) = 'O2 '
  124. BETA(6) = 'CO2 '
  125. BETA(7) = 'CO '
  126. C
  127. C- Masse molaire (en kg/mol)
  128. V(1,1) = 0.018D0
  129. V(2,1) = 0.002D0
  130. V(3,1) = 0.004D0
  131. V(4,1) = 0.028D0
  132. V(5,1) = 0.032D0
  133. V(6,1) = 0.044D0
  134. V(7,1) = 0.028D0
  135. C
  136. C- Coefficient intervenant dans l'expression de la loi de diffusion
  137. C- de la vapeur dans le constituant de rang i lorsqu'il est seul
  138. V(1,2) = 13.1
  139. V(2,2) = 6.12
  140. V(3,2) = 2.67
  141. V(4,2) = 18.5
  142. V(5,2) = 16.3
  143. V(6,2) = 26.9
  144. V(7,2) = 18.0
  145. C
  146. SEGACT MTAB3
  147. IDIM1 = MTAB3.MLOTAB
  148. DO 40 I=1,IDIM1
  149. CALL ACEM(MTAB3,I,MOT1)
  150. MOT2 = 'R' // MOT1(1:7)
  151. TYPE = 'CHPOINT '
  152. CALL ACMO(MTAB2,MOT2,TYPE,MCHPO3)
  153. IF (IERR.NE.0) RETURN
  154. II = 0
  155. DO 10 K=1,NBCONS
  156. IF (BETA(K).EQ.MOT1) THEN
  157. II = K
  158. GOTO 20
  159. ENDIF
  160. 10 CONTINUE
  161. C Le mot %m1:4 n'est pas un nom de composante reconnu
  162. MOTERR(1:4) = MOT1(1:4)
  163. CALL ERREUR(197)
  164. RETURN
  165. 20 CONTINUE
  166. CALL LRCHT(MCHPO3,MPOVA3,TYPS,IGEO1)
  167. IF (IGEO1.NE.IPT1) THEN
  168. INDIC = 1
  169. NBCOMP = -1
  170. CALL QUEPOI(MCHPO3,IPT1,INDIC,NBCOMP,NOMTOT)
  171. IF (IERR.NE.0) RETURN
  172. CALL LRCHT(MCHPO3,MPOVA3,TYPS,IGEO1)
  173. ENDIF
  174. A1 = V(II,1)
  175. A2 = 1.D0 / V(II,1)
  176. A3 = 1.D0 / V(1,1)
  177. WAB = 2.D3 / (A2 + A3)
  178. A4 = (V(II,2)**(1.D0/3.D0) + V(1,2)**(1.D0/3.D0))**2.D0
  179. DO 30 J=1,NBCELL
  180. GIIJ = MPOVA3.VPOCHA(J,1) / A1
  181. W(J,1) = W(J,1) + GIIJ
  182. IF (II.NE.1) THEN
  183. DVIIJ = (1.D-4 * 0.00143D0) * (MPOVA2.VPOCHA(J,1) ** 1.75)
  184. & / ((MPOVA1.VPOCHA(J,1) * 1.D-5)*(WAB ** 0.5D0)*A4)
  185. W(J,2) = W(J,2) + GIIJ/DVIIJ
  186. ELSE
  187. VPOCHA(J,1) = GIIJ
  188. ENDIF
  189. 30 CONTINUE
  190. SEGDES MPOVA3
  191. 40 CONTINUE
  192. SEGDES MTAB3,MPOVA1,MPOVA2
  193. C
  194. C- Remplissage du chpo contenant le coefficient de diffusion
  195. C- de la vapeur dans les incondensables
  196. C
  197. DO 50 I=1,NBCELL
  198. VPOCHA(I,1) = (1.D0 - VPOCHA(I,1)/W(I,1)) * W(I,1) / W(I,2)
  199. 50 CONTINUE
  200. SEGDES MCHPOI,MSOUPO,MPOVAL
  201. C
  202. SEGSUP IWORK
  203. CALL ECROBJ('CHPOINT ',MCHPOI)
  204. RETURN
  205. END
  206.  
  207.  
  208.  
  209.  
  210.  

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