Télécharger la plaquette Cast3M


fr en

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