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