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