Télécharger bcaldp2.eso

Retour à la liste

Numérotation des lignes :

  1. C BCALDP2 SOURCE CB215821 16/04/21 21:15:14 8920
  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
  29. CALL BCALQ2(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
  30. $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
  31. $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  32.  
  33. DP = (PSQ-PS)/PS
  34. DP0=DP
  35. C WRITE(6,*) ' Q PSQ DP ',Q,PSQ,DP
  36. IF (ABS(DP).GT.FPM) THEN
  37. NIT=1
  38. 10 CONTINUE
  39. IF ((DP.GT.FPM).AND.(NIT.LE.NITMAX)) THEN
  40. IF (KIMP.GE.1) write(6,*) 'bcaldp2: p sortie trop grand Q ',Q
  41. Q=Q*(1.+AL)
  42.  
  43. CALL BCALQ2(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
  44. $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
  45. $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  46.  
  47. NIT = NIT + 1
  48. DP = (PSQ-PS)/PS
  49. IF ( NIT.GT.99) THEN
  50. write(6,*) 'bcaldp2: NIT10=100 DP= ',DP
  51. ENDIF
  52. GOTO 10
  53. ENDIF
  54.  
  55. NIT=1
  56. 20 CONTINUE
  57. IF ((DP.LT.EPM).AND.(DP0.LT.EPM).AND.(NIT.LE.NITMAX)) THEN
  58. IF (KIMP.GE.1) write(6,*) 'bcaldp2: p sortie trop petit Q ',Q
  59. Q=Q*(1.-AL)
  60.  
  61. CALL BCALQ2(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,*) 'bcaldp2: dichotomie Q1 Q2 Q= ',Q1,Q2,Q
  83.  
  84. CALL BCALQ2(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
  85. $ KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
  86. $ QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)
  87.  
  88. NIT = NIT + 1
  89. DP = (PSQ-PS)/PS
  90. IF ( NIT.GT.99) THEN
  91. write(6,*) 'bcaldp2: NIT30=100 DP= ',DP
  92. ENDIF
  93.  
  94. IF (ABS(DP).GT.FPM.AND.NIT.LE.NITMAX) 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 ((ABS(DP).GT.FPM).AND.(KIMP.GE.1)) THEN
  108. write(6,*) 'bcaldp2: precision sur pression aval = ',(ABS(DP))
  109. ENDIF
  110.  
  111. IF (KIMP.GE.1) THEN
  112. WRITE(6,*) ' '
  113. WRITE(6,*) 'bcaldp2 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.  
  126.  
  127.  

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