Télécharger fullert.eso

Retour à la liste

Numérotation des lignes :

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

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