Télécharger la plaquette Cast3M


fr en

Télécharger bcalq2.eso

Retour à la liste

Numérotation des lignes : 

bcalq2

  1. C BCALQ2    SOURCE    CB215821  16/04/21    21:15:15     8920
  2.       SUBROUTINE BCALQ2(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. BECALC2
  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.1) THEN
  20.         WRITE(6,*)
  21.         WRITE(6,*) 'entree bcalq2'
  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=PSO
  29.       NITMAX = 100
  30.  
  31.       PHI = PVE/PE
  32.  
  33. C     IMPLEMENTATION DES PROPRIETES PHYSIQUES
  34.       CALL BPHYS(T0,P0,RA,RV,CA,XCV,XCL,XLAT0,XROL,XKL,XKT,REL)
  35.  
  36. C     Calcul des debits en entree Qa et Qv
  37.  
  38. C     Calcul de la masse volumique de vapeur entree
  39.  
  40.        RHOVE=ROVAP0(PVE,TE)
  41.  
  42. C     Calcul du facteur Z Compressibilite en entree
  43.  
  44.        ZE=ZVAP0(RHOVE,TE)
  45.  
  46.  
  47. C     Calcul des debits air et eau, le debit total Q etant connu
  48.  
  49.        IF(PHI.LT.1D-3) THEN
  50.          RQ = 1.E8
  51.        ELSE
  52.          RQ = (1-PHI)*(RV*ZE)/PHI/RA
  53.        ENDIF
  54. C
  55.        QA = Q*RQ/(1+RQ)
  56.        QV = Q/(1+RQ)
  57.  
  58. C !!
  59. C     QAE invariant
  60.  
  61.       QAE=QA*EN(1)*BN(1)
  62.  
  63. C      'constante de gaz' equivalente a l'entree
  64.  
  65.        R = PHI/RV/ZE+(1-PHI)/RA
  66.        R=1/R
  67.  
  68.       ROE = PE/R/TE
  69.       UE=Q/ROE
  70.  
  71.       IF(KIMP.NE.0) THEN
  72.       write(6,*)
  73.       write(6,*) ' bcalq2: conditions en entree'
  74.       write(6,2000) TE,RHOVE,ZE,R,QA,QV
  75.  2000 FORMAT(1X,'   TE ROV ZE R QA QV', 6E12.5)
  76.       ENDIF
  77.  
  78. C>>>  positionnement a l'entree de la fissure
  79.  
  80.       PSQ=1
  81.       IX=1
  82.  
  83.       P2=PE
  84.       PV2=PVE
  85.       T2=TE
  86.       U2=UE
  87.  
  88.       QEE2=QV*EN(1)*BN(1)
  89.       PHI2=PHI
  90.  
  91.       IF(KIMP.NE.0) THEN
  92.       write(6,*) '>BCALQ2 Q PHI R ZE ',Q,PHI,R,ZE
  93.       ENDIF
  94.  
  95.       X=0.D0
  96.  
  97.       TIT=1
  98.       ITP=1
  99.  
  100. C>>>  le gaz a l'entree est-il surchauffe ou sature
  101.  
  102.       PS2=PSATT0(T2)
  103.       R2=ROVAP0(PS2,T2)
  104.       ZV =ZVAP0(R2,T2)
  105.       IF (PVE.GT.PS2) THEN
  106.          TIT=0
  107.          Y2=(PS2/(P2-PS2))*(1-PHI)/(PHI*ZV)
  108.       ELSE
  109.          Y2=1
  110.       ENDIF
  111.  
  112.       QTOT=QEE2+QAE
  113.  
  114.       CALL BSTOK(IX,X,P2,T2-T0,Y2,U2,0.D0,QEE2,0.D0,0.D0,0.D0,
  115.      &               XX,XP,XT,XY,XU,XHF,XQ,XQW,XRE,XDH,NT)
  116.  
  117. C>>>  boucle "tant que" sur la longueur de la fissure
  118.  
  119.  
  120.   10  CONTINUE
  121.       IF ((X.LT.0.999).AND.(PSQ.NE.-1.)) THEN
  122.       IF(KIMP.GE.1) THEN
  123.         write(6,*)
  124.         write(6,*) 'bcalq2 X',X
  125.       ENDIF
  126.  
  127. C>>>  positionnement au point local 1
  128.  
  129.          P1=P2
  130.          PS1=PSATT0(T2)
  132.          Y1=Y2
  133.  
  134.          QEE1=QEE2
  135.          PHI1=PHI2
  136.  
  137.          DX=DX0
  138.  
  139. C>>>  test sur le titre
  140.  
  141.          IF (TIT.EQ.1) THEN
  142.  
  143.              Y2=1
  144.              NIT = 0
  145.   20         CONTINUE
  146.              NIT = NIT + 1
  147.              IF (NIT.GT.99) THEN
  148.                 write(6,*) 'bcalq2: NIT20=100 X',X
  149.              ENDIF
  150.  
  151.            CALL BSUR2 (X,DX,XL,RUG,XW,XN,TN,EN,BN,KIMP,PSLIM,REL,RINDEX,
  152.      &     P1,T1,QAE,QEE1,PHI1,P2,T2,U2,QEE2,PHI2,QW2,RE,H,PSQ,
  153.      &     NPP,ITP,PF,PP,DPF,DPP,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  154.  
  155.              IF (PSQ.EQ.-1.) THEN
  156.                 RETURN
  157.              ENDIF
  158.  
  159.              IF ((RINDEX.LT.0.999).AND.
  160.      &       (NIT.LE.NITMAX)) THEN
  161.                 X=X-DX
  162.                 DX=DX*0.5
  163.                 GO TO 20
  164.              ENDIF
  165.  
  166.  
  167. C>>>  y-a-t'il condensation ?
  168.  
  169.              PS2=PSATT0(T2)
  170. C            WRITE(6,*) 'PS2',PS2
  171.              PSI=PS2/P2
  172. C            write(6,*) ' PSI ',PSI
  173.              AL=PHI2/PSI
  174.  
  175.              IF(KIMP.GE.2) THEN
  176.              WRITE(6,998) X,AL,P2/P0,T2-T0,QEE1/EN(1),QEE2/EN(1),U2
  177.  998         FORMAT(1X,'sur -XALP2T2 ',F9.6,F9.4,E12.5,4F9.2)
  178.              WRITE(6,*)
  179.              ENDIF
  180.  
  181.              IF ((AL.GT.(1.02)).OR.(ABS(T2-T1).GT.DTMX).AND.
  182.      &       (NIT.LE.NITMAX)) THEN
  183.                  X=X-DX
  184.                  DX=DX/2
  185.                  GOTO 20
  186.              ENDIF
  187.  
  188.              IF (AL.GT.1.) THEN
  189.                TIT=0
  190. C
  191.                PS2=PSATT0(T2)
  192.                RHO2=ROVAP0(PS2,T2)
  193.                ZVAP2=ZVAP0(RHO2,T2)
  194.                Y2 = (RA/RV)*(QAE/QEE2)*(PSI/(1-PSI))
  195.                Y2 = Y2/ZVAP2
  196.  
  197.               IF(KIMP.NE.0) THEN
  198.                 write(6,*) 'bcalq2: QAE QEE2 ',QAE,QEE2
  199.                 write(6,*) 'bcalq2: transition vers condensation X= ',X
  200.                 write(6,2100) PS2,AL,RHO2,ZVAP2,Y2
  201.  2100           FORMAT(1X,'bcalq2: PS2 AL RO2 Z2 Y2 ', 6E12.5)
  202.               ENDIF
  203.  
  204. C
  205.              ENDIF
  206.  
  207.  
  208.          ELSE
  209.  
  210.              NIT = 0
  211.   30         CONTINUE
  212.              NIT = NIT + 1
  213.              IF (NIT.GT.99) THEN
  214.                 write(6,*) 'bcalq2: NIT30=100 X',X
  215.              ENDIF
  216.  
  217.              CALL BCOND2 (X,DX,XL,RUG,XW,XN,TN,EN,BN,KIMP,PSLIM,REL,
  218.      &       P1,PS1,T1,Y1,QAE,QEE1,PHI1,
  219.      &       P2,T2,Y2,U2,QEE2,PHI2,QW2,RE,H,PSQ,RINDEX,
  220.      &       NPP,ITP,PF,PP,DPF,DPP,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  221. C
  222. C            WRITE(6,*)'****** RINDEX,X= ',RINDEX,X
  223.  
  224.              IF(KIMP.GE.2) THEN
  225.              WRITE(6,999) X,Y2,P2/P0,T2-T0,QEE1/EN(1)/BN(1),
  226.      &       QEE2/EN(1)/BN(1),U2
  227.  999         FORMAT(1X,'bcalq2: XY2P2T2 ',F9.6,F9.4,E12.5,4F9.2)
  228.              ENDIF
  229.  
  230.              IF (PSQ.EQ.-1.) THEN
  231.                 RETURN
  232.              ENDIF
  233.  
  234.              IF ((RINDEX.LT.0.999).AND.
  235.      &       (NIT.LE.NITMAX)) THEN
  236.                 X=X-DX
  237.                 DX=DX*0.5
  238.                 GO TO 30
  239.              ENDIF
  240.  
  241. C>>>        y-a-t'il evaporation totale ?
  242.  
  243.              IF ((Y2.GT.(1.01)).OR.(ABS(T2-T1).GT.DTMX).AND.
  244.      &       (NIT.LE.NITMAX)) THEN
  245.                 X=X-DX
  246.                 DX=DX/2
  247.                 GOTO 30
  248.              ENDIF
  249.  
  250. * vapeur surchauffee
  251.              IF (Y2.GT.0.999) THEN
  252.                 TIT=1
  253. * attention si E variable : OK
  254.                IF((QEE2/QAE).LT.1.D-7) THEN
  255. C                write(6,*) ' QEE2/QAE ',QEE2/QAE
  256.                  PHI2=0.D0
  257.                ELSE
  258.  
  259.  
  260.                  ZTRAN = 1.D0
  261.                  NZ=0
  262.  31              CONTINUE
  263.                  NZ = NZ + 1
  264.  
  265.                  AA = (QEE2/QAE)* (RV*ZTRAN/RA)
  266.                  PHI2 = AA/(1.+AA)
  267.                  PV2 = PHI2 * P2
  268.  
  269.                  RHO2 = ROVAP0(PV2,T2)
  270.                  Z2  = ZVAP0(RHO2,T2)
  271.  
  272.                  DELTAZ = ABS(Z2 - ZTRAN)
  273.  
  274.                  IF(KIMP.GE.2) THEN
  275.                  WRITE(6,*) ' NZ ZVAP ', NZ,DELTAZ
  276.                  ENDIF
  277.                  ZTRAN=Z2
  278.  
  279.                  IF ((DELTAZ.GT.1D-5).AND.(NZ.LE.20)) GOTO 31
  280.  
  281.  
  282.               IF(KIMP.NE.0) THEN
  283.                  write(6,*) 'bcalq2: transition vers evaporation  '
  284.                  write(6,2200) PHI2,RHO2,Z2
  285.  2200            FORMAT(1X,'bcalq2 PHI2 RHO2 Z2 ', 3E12.5)
  286.               ENDIF
  287.  
  288.                ENDIF
  289.              ENDIF
  290.  
  291.          ENDIF
  292.  
  293.          QTOT=QEE2+QAE
  294.  
  295.          CALL BSTOK(IX,X,P2,T2-T0,Y2,U2,H,QEE2,QW2,RE,DPF,
  296.      &                XX,XP,XT,XY,XU,XHF,XQ,XQW,XRE,XDH,NT)
  297.  
  298.       DHTOT = DHTOT + PF
  299.       PPTOT = PPTOT + PP
  300.  
  301.       GOTO 10
  302.       ENDIF
  303.  
  304.       NX=IX-1
  305.       PSQ=P2
  306.  
  307.       XX(NX)=1.D0
  308. C     write(6,*) ' bcalq  NX ',NX
  309. C     CALL UTPRIM(XX,NX)
  310. C**
  311.       IF(KIMP.GT.0) THEN
  312.       WRITE(*,*) 'bcalq: X,PSQ= ',X,PSQ
  313.       ENDIF
  314.       IF(KIMP.GT.1) THEN
  315.       write(6,1000) Q,PHI,DHTOT,PPTOT
  316.  1000 FORMAT(1X,'bcalq2 Q phi DH H*T',4E12.5)
  317.       ENDIF
  318. C**
  319.  
  320.       RETURN
  321.       END
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  

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