Télécharger bcalq.eso

Retour à la liste

Numérotation des lignes :

  1. C BCALQ SOURCE CB215821 16/04/21 21:15:15 8920
  2. SUBROUTINE BCALQ(PE,PVE,TE,PSO,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
  3. $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
  4. $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7.  
  8. C operateur FUITE
  9. C cf. sub. BECALC
  10. C calcul de la solution pour un debit Q d'injection impose
  11. C QAE, XQ : debit air, debit eau,
  12. C XQW: flux d'eau a la paroi
  13. C RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4 : coef lois de frot utilisateur
  14. C
  15. DIMENSION XX(NT),XP(NT),XT(NT),XY(NT),XU(NT),XN(NPP),TN(NPP)
  16. DIMENSION EN(NPP),BN(NPP)
  17. DIMENSION XHF(NT),XQ(NT),XQW(NT),XRE(NT),XDH(NT)
  18.  
  19. IF(KIMP.GE.2) THEN
  20. write(6,*) '************************** '
  21. WRITE(6,*) 'entree bcalq '
  22. ENDIF
  23. C** variation enthalpie et puissance echangée avec la paroi
  24. DHTOT = 0.D0
  25. PPTOT = 0.D0
  26.  
  27. DTMX=10
  28. PSLIM=0.5*PSO
  29.  
  30. PHI = PVE/PE
  31. CALL BPHYS(T0,P0,RA,RV,CA,CV,CL,XLAT,ROL,XKL,XKT,REL)
  32.  
  33. C caracteristiques a l'entree
  34. CALL BCAR(RA,RV,PHI,CV,CA,Q,RQ,R,QA,QV,CPS)
  35.  
  36. C QAE invariant
  37. QAE=QA*EN(1)*BN(1)
  38.  
  39. ROE = PE/R/TE
  40. UE=Q/ROE
  41.  
  42. C>>> positionnement a l'entree de la fissure
  43.  
  44. PSQ=1
  45. IX=1
  46.  
  47. P2=PE
  48. PV2=PVE
  49. T2=TE
  50. U2=UE
  51.  
  52. QEE2=QV*EN(1)*BN(1)
  53. PHI2=PHI
  54.  
  55. IF(KIMP.GE.1) THEN
  56. write(6,*) 'bcalq : Q PHI= ',Q,PHI
  57. ENDIF
  58.  
  59. X=0.D0
  60.  
  61. TIT=1
  62. ITP=1
  63. NITMAX = 100
  64.  
  65. C>>> le gaz a l'entree est-il surchauffe ou sature
  66.  
  67. PS2=BPSAT(T2)
  68. IF (PVE.GT.PS2) THEN
  69. TIT=0
  70. Y2=(PS2/(P2-PS2))*(1-PHI)/PHI
  71. ELSE
  72. Y2=1
  73. ENDIF
  74.  
  75. QTOT=QEE2+QAE
  76.  
  77. CALL BSTOK(IX,X,P2,T2-T0,Y2,U2,0.D0,QEE2,0.D0,0.D0,0.D0,
  78. & XX,XP,XT,XY,XU,XHF,XQ,XQW,XRE,XDH,NT)
  79.  
  80. C>>> boucle "tant que" sur la longueur de la fissure
  81.  
  82.  
  83. 10 CONTINUE
  84. IF ((X.LT.0.9999).AND.(PSQ.NE.-1.)) THEN
  85. IF(KIMP.GE.2) THEN
  86. write(6,*)
  87. write(6,*) 'bcalq X',X
  88. ENDIF
  89.  
  90. C>>> positionnement au point local 1
  91.  
  92. P1=P2
  93. PS1=BPSAT(T2)
  94. Y1=Y2
  95.  
  96. QEE1=QEE2
  97. PHI1=PHI2
  98.  
  99. DX=DX0
  100.  
  101. C>>> test sur le titre (TIT=1 surchauff ; TIT=0 condens)
  102.  
  103. IF (TIT.EQ.1) THEN
  104.  
  105. Y2=1
  106. NIT = 0
  107. 20 CONTINUE
  108. NIT = NIT + 1
  109. IF (KIMP.GT.0.AND.NIT.GT.99) THEN
  110. write(6,*) 'bcalq: NIT20=100 X',X
  111. ENDIF
  112. CALL BSUR (X,DX,XL,RUG,XW,XN,TN,EN,BN,KIMP,PSLIM,REL,
  113. & RINDEX,P1,T1,QAE,QEE1,PHI1,P2,T2,U2,QEE2,PHI2,QW2,RE,H,PSQ,
  114. & NPP,ITP,PF,PP,DPF,DPP,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  115.  
  116. IF (PSQ.EQ.-1.) THEN
  117. IF (KIMP.GT.0) THEN
  118. write(6,*) 'bcalq apres bsur PSQ = -1. X P2',X,P2
  119. ENDIF
  120. RETURN
  121. ENDIF
  122.  
  123. C>>> y-a-t'il condensation ?
  124.  
  125. PS2=BPSAT(T2)
  126. PSI=PS2/P2
  127. AL=PHI2/PSI
  128.  
  129. IF(KIMP.GE.2) THEN
  130. WRITE(6,998) X,AL,P2/P0,T2-T0,QEE1/EN(1)/BN(1),
  131. & QEE2/EN(1)/BN(1),U2
  132. 998 FORMAT(1X,'sur -XALP2T2 ',2F9.4,E12.5,4F9.2)
  133. ENDIF
  134.  
  135. IF ((RINDEX.LT.0.999).AND.
  136. & (NIT.LE.NITMAX)) THEN
  137. X=X-DX
  138. DX=DX*0.5
  139. IF(KIMP.NE.0) THEN
  140. write(*,*) 'bcalq RINDEX goto20 NIT= ',NIT
  141. ENDIF
  142. GO TO 20
  143. ENDIF
  144.  
  145. IF ((AL.GT.(1.02)).OR.(ABS(T2-T1).GT.DTMX).AND.
  146. & (NIT.LE.NITMAX)) THEN
  147. X=X-DX
  148. DX=DX/2
  149. IF(KIMP.NE.0) THEN
  150. write(*,*) 'bcalq: goto20 X AL NIT ',X, AL,NIT
  151. ENDIF
  152. GOTO 20
  153. ENDIF
  154.  
  155. IF (AL.GT.1.) THEN
  156. TIT=0
  157. C
  158. Y2 = (RA/RV)*(QAE/QEE2)*(PSI/(1-PSI))
  159. C
  160. IF(KIMP.NE.0) THEN
  161. write(6,*) 'bcalq: transition vers condensation X= ',X
  162. write(6,*) 'bcalq: TIT QAE QEE2 ',TIT,QAE,QEE2
  163. write(6,2100) PS2,AL,Y2
  164. 2100 FORMAT(1X,'bcalq: PS2 AL Y2 ', 3E12.5)
  165. ENDIF
  166. ENDIF
  167.  
  168. ELSE
  169.  
  170. NIT = 0
  171. 30 CONTINUE
  172. NIT = NIT + 1
  173. IF (KIMP.GT.0.AND.NIT.GT.99) THEN
  174. write(6,*) 'bcalq: NIT30=100 X',X
  175. ENDIF
  176.  
  177. CALL BCOND (X,DX,XL,RUG,XW,XN,TN,EN,BN,KIMP,PSLIM,REL,
  178. & P1,PS1,T1,Y1,QAE,QEE1,PHI1,
  179. & P2,T2,Y2,U2,QEE2,PHI2,QW2,RE,H,PSQ,RINDEX,
  180. & NPP,ITP,PF,PP,DPF,DPP,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  181.  
  182. C WRITE(6,*)'****** RINDEX,X= ',RINDEX,X
  183.  
  184. IF(KIMP.GE.2) THEN
  185. WRITE(6,999) X,Y2,P2/P0,T2-T0,QEE1/EN(1)/BN(1),
  186. & QEE2/EN(1)/BN(1),U2
  187. 999 FORMAT(1X,'cond-XY2P2T2 ',2F9.4,E12.5,4F9.2)
  188. ENDIF
  189.  
  190. IF (PSQ.EQ.-1.) THEN
  191. RETURN
  192. ENDIF
  193.  
  194. IF ((RINDEX.LT.0.999).AND.
  195. & (NIT.LE.NITMAX)) THEN
  196. X=X-DX
  197. DX=DX*0.5
  198. GO TO 30
  199. ENDIF
  200.  
  201. C>>> y-a-t'il evaporation totale ?
  202.  
  203. IF ((Y2.GT.(1.01)).OR.(ABS(T2-T1).GT.DTMX).AND.
  204. & (NIT.LE.NITMAX)) THEN
  205. X=X-DX
  206. DX=DX/2
  207. IF(KIMP.GE.1) write(6,*) 'bcalq apres bcond Y2DT DX05 X
  208. & P2 ',X,P2
  209. GOTO 30
  210. ENDIF
  211.  
  212. * vapeur surchauffee
  213. IF (Y2.GT.0.999) THEN
  214. TIT=1
  215. IF(KIMP.GE.1) write(*,*) 'bcalq:vapeur surchauffee:TIT=1'
  216. * attention si E variable : OK
  217. IF((QEE2/QAE).LT.1.D-7) THEN
  218. C write(6,*) ' QEE2/QAE ',QEE2/QAE
  219. PHI2=0.D0
  220. ELSE
  221. AA=RA*QAE/RV/QEE2
  222. PHI2=1./(1.+AA)
  223. ENDIF
  224. ENDIF
  225.  
  226. ENDIF
  227.  
  228. QTOT=QEE2+QAE
  229.  
  230. CALL BSTOK(IX,X,P2,T2-T0,Y2,U2,H,QEE2,QW2,RE,DPF,
  231. & XX,XP,XT,XY,XU,XHF,XQ,XQW,XRE,XDH,NT)
  232.  
  233. DHTOT = DHTOT + PF
  234. PPTOT = PPTOT + PP
  235.  
  236. GOTO 10
  237. ENDIF
  238.  
  239. NX=IX-1
  240. PSQ=P2
  241.  
  242. XX(NX)=1.D0
  243. C write(6,*) ' bcalq NX ',NX
  244. C CALL UTPRIM(XX,NX)
  245. C**
  246. IF(KIMP.GT.0) THEN
  247. WRITE(*,*) 'bcalq: X,PSQ= ',X,PSQ
  248. ENDIF
  249. IF(KIMP.GT.1) THEN
  250. write(6,1000) Q,PHI,DHTOT,PPTOT
  251. 1000 FORMAT(1X,'bcalq Q phi DH H*T',4E12.5)
  252. ENDIF
  253. C**
  254.  
  255. RETURN
  256. END
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  

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