Télécharger la plaquette Cast3M


fr en

Télécharger bcaldp2.eso

Retour à la liste

Numérotation des lignes : 

bcaldp2

  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