Download bcalq2.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer