1 : C BCALDP SOURCE DURA 07/07/27 21:15:00 5781 2 : SUBROUTINE BCALDP(PE,PVE,TE,PS,XL,DX0,RUG,Q0,XW,NPP,XN,TN,EN,BN, 3 : $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW, 4 : $ Q,QAE,XRE,XDH,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4) 5 : 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : C 9 : C operateur FUITE 10 : C calcul du debit solution par dichotomie 11 : C RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4 : coef lois de frot utilisateur 12 : C 13 : C>>> cf. sub. BECALC 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,*) ' entree bcaldp' 21 : ENDIF 22 : FPM = 1.D-3 23 : EPM = -FPM 24 : AL = 0.2 25 : NITMAX = 100 26 : NITMAX30 = 200 27 : C WRITE(6,*) ' PRECISION ',FPM 28 : C 29 : Q=Q0 30 : 30 : CALL BCALQ(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN, 31 : $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW, 32 : $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4) 33 : 34 : DP = (PSQ-PS)/PS 35 : DP0=DP 36 : C WRITE(6,*) ' Q PSQ DP ',Q,PSQ,DP 37 : IF (DABS(DP).GT.FPM) THEN 38 : 39 : NIT = 1 40 : 10 CONTINUE 41 : IF ((DP.GT.FPM).AND.(NIT.LE.NITMAX)) THEN 42 : IF (KIMP.GE.1) write(6,*) 'bcaldp: p sortie trop grand Q= ',Q 43 : Q=Q*(1.+AL) 44 : 44 : CALL BCALQ(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN, 45 : $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW, 46 : $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4) 47 : 48 : NIT = NIT + 1 49 : DP = (PSQ-PS)/PS 50 : IF ( (NIT.GT.99).AND.(KIMP.GE.1)) THEN 51 : write(6,*) 'bcaldp: NIT10=100 DP= ',DP 52 : ENDIF 53 : GOTO 10 54 : ENDIF 55 : 56 : NIT = 1 57 : 20 CONTINUE 58 : IF ((DP.LT.EPM).AND.(DP0.LT.EPM).AND.(NIT.LE.NITMAX)) THEN 59 : IF (KIMP.GE.1) write(6,*) 'bcaldp: p sortie trop petit Q= ',Q 60 : Q=Q*(1.-AL) 61 : 61 : CALL BCALQ(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN, 62 : $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW, 63 : $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4) 64 : 65 : NIT = NIT + 1 66 : DP = (PSQ-PS)/PS 67 : IF ( NIT.GT.99) THEN 68 : write(6,*) 'bcaldp: NIT20=100 DP= ',DP 69 : ENDIF 70 : GOTO 20 71 : ENDIF 72 : 73 : C>>> Q1 ET Q2 SONT LES BORNES DE LA DICHOTOMIE 74 : 75 : Q1=MIN(Q0,Q) 76 : Q2=MAX(Q0,Q) 77 : 78 : NIT = 1 79 : 30 CONTINUE 80 : 81 : Q=(Q1+Q2)/2 82 : IF (KIMP.GE.1) write(6,*) 'bcaldp: dichotomie Q1 Q2 Q= ',Q1,Q2,Q 83 : 83 : CALL BCALQ(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN, 84 : $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW, 85 : $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4) 86 : 87 : NIT = NIT + 1 88 : DP = (PSQ-PS)/PS 89 : c IF ( NIT.GT.99) THEN 90 : IF (KIMP.GE.1.AND.NIT.GT.NITMAX30) THEN 91 : write(6,*) 'bcaldp: NIT30=200 DP= ',DP 92 : ENDIF 93 : 94 : IF (DABS(DP).GT.FPM.AND.NIT.LE.NITMAX30) THEN 95 : 96 : IF (DP.GT.FPM) THEN 97 : Q1=Q 98 : ELSE 99 : Q2=Q 100 : ENDIF 101 : GOTO 30 102 : 103 : ENDIF 104 : 105 : ENDIF 106 : 107 : IF ((DABS(DP).GT.FPM).AND.(KIMP.GE.1)) THEN 108 : write(6,*) 'bcaldp: precision sur pression aval = ',(DABS(DP)) 109 : ENDIF 110 : 111 : IF (KIMP.GE.1) THEN 112 : WRITE(6,*) ' ' 113 : WRITE(6,*) 'bcaldp dico Q0 Q PS PSQ NX NIT ',Q0,Q,PS,PSQ,NX,NIT 114 : WRITE(6,*) ' ' 115 : ENDIF 116 : RETURN 117 : END 118 : 119 : 120 : 121 : 122 : 123 : 124 : 125 :
© Cast3M 2003 - All rights reserved.
Disclaimer