Télécharger la plaquette Cast3M


fr en

Télécharger bcalq.eso

Retour à la liste

Numérotation des lignes : 

bcalq

  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)
  95.          Y1=Y2
  96.  
  97.          QEE1=QEE2
  98.          PHI1=PHI2
  99.  
  100.          DX=DX0
  101.  
  102. C>>>  test sur le titre (TIT=1 surchauff ; TIT=0 condens)
  103.  
  104.          IF (TIT.EQ.1) THEN
  105.  
  106.              Y2=1
  107.              NIT = 0
  108.   20         CONTINUE
  109.              NIT = NIT + 1
  110.              IF (KIMP.GT.0.AND.NIT.GT.99) THEN
  111.                 write(6,*) 'bcalq: NIT20=100 X',X
  112.              ENDIF
  113.              CALL BSUR (X,DX,XL,RUG,XW,XN,TN,EN,BN,KIMP,PSLIM,REL,
  114.      &       RINDEX,P1,T1,QAE,QEE1,PHI1,P2,T2,U2,QEE2,PHI2,QW2,RE,H,PSQ,
  115.      &       NPP,ITP,PF,PP,DPF,DPP,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  116.  
  117.              IF (PSQ.EQ.-1.) THEN
  118.                IF (KIMP.GT.0) THEN
  119.                  write(6,*) 'bcalq apres bsur PSQ = -1. X P2',X,P2
  120.                ENDIF
  121.                RETURN
  122.              ENDIF
  123.  
  124. C>>>  y-a-t'il condensation ?
  125.  
  126.              PS2=BPSAT(T2)
  127.              PSI=PS2/P2
  128.              AL=PHI2/PSI
  129.  
  130.              IF(KIMP.GE.2) THEN
  131.              WRITE(6,998) X,AL,P2/P0,T2-T0,QEE1/EN(1)/BN(1),
  132.      &       QEE2/EN(1)/BN(1),U2
  133.  998         FORMAT(1X,'sur -XALP2T2 ',2F9.4,E12.5,4F9.2)
  134.              ENDIF
  135.  
  136.              IF ((RINDEX.LT.0.999).AND.
  137.      &       (NIT.LE.NITMAX)) THEN
  138.                 X=X-DX
  139.                 DX=DX*0.5
  140.                 IF(KIMP.NE.0) THEN
  141.                  write(*,*) 'bcalq RINDEX goto20 NIT= ',NIT
  142.                 ENDIF
  143.                 GO TO 20
  144.              ENDIF
  145.  
  146.              IF ((AL.GT.(1.02)).OR.(ABS(T2-T1).GT.DTMX).AND.
  147.      &       (NIT.LE.NITMAX)) THEN
  148.                  X=X-DX
  149.                  DX=DX/2
  150.                 IF(KIMP.NE.0) THEN
  151.                  write(*,*) 'bcalq: goto20 X AL NIT ',X, AL,NIT
  152.                 ENDIF
  153.                  GOTO 20
  154.              ENDIF
  155.  
  156.              IF (AL.GT.1.) THEN
  157.                TIT=0
  158. C
  159.                Y2 = (RA/RV)*(QAE/QEE2)*(PSI/(1-PSI))
  160. C
  161.                IF(KIMP.NE.0) THEN
  162.                 write(6,*) 'bcalq: transition vers condensation X=  ',X
  163.                 write(6,*) 'bcalq: TIT QAE QEE2 ',TIT,QAE,QEE2
  164.                 write(6,2100) PS2,AL,Y2
  165.  2100           FORMAT(1X,'bcalq: PS2 AL Y2 ', 3E12.5)
  166.                ENDIF
  167.              ENDIF
  168.  
  169.          ELSE
  170.  
  171.              NIT = 0
  172.   30         CONTINUE
  173.              NIT = NIT + 1
  174.              IF (KIMP.GT.0.AND.NIT.GT.99) THEN
  175.                 write(6,*) 'bcalq: NIT30=100 X',X
  176.              ENDIF
  177.  
  178.              CALL BCOND (X,DX,XL,RUG,XW,XN,TN,EN,BN,KIMP,PSLIM,REL,
  179.      &       P1,PS1,T1,Y1,QAE,QEE1,PHI1,
  180.      &       P2,T2,Y2,U2,QEE2,PHI2,QW2,RE,H,PSQ,RINDEX,
  181.      &       NPP,ITP,PF,PP,DPF,DPP,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  182.  
  183. C            WRITE(6,*)'****** RINDEX,X= ',RINDEX,X
  184.  
  185.              IF(KIMP.GE.2) THEN
  186.              WRITE(6,999) X,Y2,P2/P0,T2-T0,QEE1/EN(1)/BN(1),
  187.      &       QEE2/EN(1)/BN(1),U2
  188.  999         FORMAT(1X,'cond-XY2P2T2 ',2F9.4,E12.5,4F9.2)
  189.              ENDIF
  190.  
  191.              IF (PSQ.EQ.-1.) THEN
  192.                 RETURN
  193.              ENDIF
  194.  
  195.              IF ((RINDEX.LT.0.999).AND.
  196.      &       (NIT.LE.NITMAX)) THEN
  197.                 X=X-DX
  198.                 DX=DX*0.5
  199.                 GO TO 30
  200.              ENDIF
  201.  
  202. C>>>        y-a-t'il evaporation totale ?
  203.  
  204.              IF ((Y2.GT.(1.01)).OR.(ABS(T2-T1).GT.DTMX).AND.
  205.      &       (NIT.LE.NITMAX)) THEN
  206.                 X=X-DX
  207.                 DX=DX/2
  208.                 IF(KIMP.GE.1) write(6,*) 'bcalq apres bcond Y2DT DX05 X
  209.      &  P2 ',X,P2
  210.                 GOTO 30
  211.              ENDIF
  212.  
  213. * vapeur surchauffee
  214.              IF (Y2.GT.0.999) THEN
  215.                TIT=1
  216.                IF(KIMP.GE.1) write(*,*) 'bcalq:vapeur surchauffee:TIT=1'
  217. * attention si E variable : OK
  218.               IF((QEE2/QAE).LT.1.D-7) THEN
  219. C                write(6,*) ' QEE2/QAE ',QEE2/QAE
  220.                  PHI2=0.D0
  221.               ELSE
  222.                   AA=RA*QAE/RV/QEE2
  223.                  PHI2=1./(1.+AA)
  224.               ENDIF
  225.              ENDIF
  226.  
  227.          ENDIF
  228.  
  229.          QTOT=QEE2+QAE
  230.  
  231.          CALL BSTOK(IX,X,P2,T2-T0,Y2,U2,H,QEE2,QW2,RE,DPF,
  232.      &                XX,XP,XT,XY,XU,XHF,XQ,XQW,XRE,XDH,NT)
  233.  
  234.       DHTOT = DHTOT + PF
  235.       PPTOT = PPTOT + PP
  236.  
  237.       GOTO 10
  238.       ENDIF
  239.  
  240.       NX=IX-1
  241.       PSQ=P2
  242.  
  243.       XX(NX)=1.D0
  244. C     write(6,*) ' bcalq  NX ',NX
  245. C     CALL UTPRIM(XX,NX)
  246. C**
  247.       IF(KIMP.GT.0) THEN
  248.       WRITE(*,*) 'bcalq: X,PSQ= ',X,PSQ
  249.       ENDIF
  250.       IF(KIMP.GT.1) THEN
  251.       write(6,1000) Q,PHI,DHTOT,PPTOT
  252.  1000 FORMAT(1X,'bcalq Q phi DH H*T',4E12.5)
  253.       ENDIF
  254. C**
  255.  
  256.       RETURN
  257.       END
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  

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