Télécharger bcaldp.eso

Retour à la liste

Numérotation des lignes :

bcaldp
  1. C BCALDP SOURCE CB215821 16/04/21 21:15:13 8920
  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.  
  31. CALL BCALQ(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
  32. $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
  33. $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  34.  
  35. DP = (PSQ-PS)/PS
  36. DP0=DP
  37. C WRITE(6,*) ' Q PSQ DP ',Q,PSQ,DP
  38. IF (ABS(DP).GT.FPM) THEN
  39.  
  40. NIT = 1
  41. 10 CONTINUE
  42. IF ((DP.GT.FPM).AND.(NIT.LE.NITMAX)) THEN
  43. IF (KIMP.GE.1) write(6,*) 'bcaldp: p sortie trop grand Q= ',Q
  44. Q=Q*(1.+AL)
  45.  
  46. CALL BCALQ(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
  47. $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
  48. $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  49.  
  50. NIT = NIT + 1
  51. DP = (PSQ-PS)/PS
  52. IF ( (NIT.GT.99).AND.(KIMP.GE.1)) THEN
  53. write(6,*) 'bcaldp: NIT10=100 DP= ',DP
  54. ENDIF
  55. GOTO 10
  56. ENDIF
  57.  
  58. NIT = 1
  59. 20 CONTINUE
  60. IF ((DP.LT.EPM).AND.(DP0.LT.EPM).AND.(NIT.LE.NITMAX)) THEN
  61. IF (KIMP.GE.1) write(6,*) 'bcaldp: p sortie trop petit Q= ',Q
  62. Q=Q*(1.-AL)
  63.  
  64. CALL BCALQ(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
  65. $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
  66. $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  67.  
  68. NIT = NIT + 1
  69. DP = (PSQ-PS)/PS
  70. IF ( NIT.GT.99) THEN
  71. write(6,*) 'bcaldp: NIT20=100 DP= ',DP
  72. ENDIF
  73. GOTO 20
  74. ENDIF
  75.  
  76. C>>> Q1 ET Q2 SONT LES BORNES DE LA DICHOTOMIE
  77.  
  78. Q1=MIN(Q0,Q)
  79. Q2=MAX(Q0,Q)
  80.  
  81. NIT = 1
  82. 30 CONTINUE
  83.  
  84. Q=(Q1+Q2)/2
  85. IF (KIMP.GE.1) write(6,*) 'bcaldp: dichotomie Q1 Q2 Q= ',Q1,Q2,Q
  86.  
  87. CALL BCALQ(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
  88. $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
  89. $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  90.  
  91. NIT = NIT + 1
  92. DP = (PSQ-PS)/PS
  93. c IF ( NIT.GT.99) THEN
  94. IF (KIMP.GE.1.AND.NIT.GT.NITMAX30) THEN
  95. write(6,*) 'bcaldp: NIT30=200 DP= ',DP
  96. ENDIF
  97.  
  98. IF (ABS(DP).GT.FPM.AND.NIT.LE.NITMAX30) THEN
  99.  
  100. IF (DP.GT.FPM) THEN
  101. Q1=Q
  102. ELSE
  103. Q2=Q
  104. ENDIF
  105. GOTO 30
  106.  
  107. ENDIF
  108.  
  109. ENDIF
  110.  
  111. IF ((ABS(DP).GT.FPM).AND.(KIMP.GE.1)) THEN
  112. write(6,*) 'bcaldp: precision sur pression aval = ',(ABS(DP))
  113. ENDIF
  114.  
  115. IF (KIMP.GE.1) THEN
  116. WRITE(6,*) ' '
  117. WRITE(6,*) 'bcaldp dico Q0 Q PS PSQ NX NIT ',Q0,Q,PS,PSQ,NX,NIT
  118. WRITE(6,*) ' '
  119. ENDIF
  120. RETURN
  121. END
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  

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