C BCALDP2   SOURCE    CB215821  16/04/21    21:15:14     8920
      SUBROUTINE BCALDP2(PE,PVE,TE,PS,XL,DX0,RUG,Q0,XW,NPP,XN,TN,EN,BN,
     $           KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
     $               Q,QAE,XRE,XDH,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
C     operateur FUITE
C     calcul du debit solution par dichotomie
C     RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4 : coef lois de frot utilisateur
C
C>>>  cf. sub. BECALC2
C
      DIMENSION XX(NT),XP(NT),XT(NT),XY(NT),XU(NT),XN(NPP),TN(NPP)
      DIMENSION EN(NPP),BN(NPP)
      DIMENSION XHF(NT),XQ(NT),XQW(NT),XRE(NT),XDH(NT)

      IF(KIMP.GE.1) THEN
        WRITE(6,*) ' entree bcaldp2'
      ENDIF
      FPM = 1.D-3
      EPM = -FPM
      AL = 0.2
      NITMAX = 100
C     WRITE(6,*) ' PRECISION ',FPM
C
      Q=Q0
      CALL BCALQ2(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
     $           KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
     $               QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)

      DP  = (PSQ-PS)/PS
      DP0=DP
C     WRITE(6,*) ' Q PSQ DP ',Q,PSQ,DP
      IF (ABS(DP).GT.FPM) THEN
      NIT=1
  10  CONTINUE
      IF ((DP.GT.FPM).AND.(NIT.LE.NITMAX)) THEN
         IF (KIMP.GE.1) write(6,*) 'bcaldp2: p sortie trop grand Q ',Q
         Q=Q*(1.+AL)

         CALL BCALQ2(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
     $           KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
     $               QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)

         NIT = NIT + 1
         DP = (PSQ-PS)/PS
         IF ( NIT.GT.99) THEN
           write(6,*) 'bcaldp2: NIT10=100 DP= ',DP
         ENDIF
         GOTO 10
      ENDIF

      NIT=1
  20  CONTINUE
      IF ((DP.LT.EPM).AND.(DP0.LT.EPM).AND.(NIT.LE.NITMAX)) THEN
          IF (KIMP.GE.1) write(6,*) 'bcaldp2: p sortie trop petit Q ',Q
         Q=Q*(1.-AL)

         CALL BCALQ2(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
     $           KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
     $               QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)

         NIT = NIT + 1
         DP = (PSQ-PS)/PS
         IF ( NIT.GT.99) THEN
           write(6,*) 'bcaldp: NIT20=100 DP= ',DP
         ENDIF
         GOTO 20
      ENDIF

C>>>  Q1 ET Q2 SONT LES BORNES DE LA DICHOTOMIE

      Q1=MIN(Q0,Q)
      Q2=MAX(Q0,Q)

      NIT=1
  30  CONTINUE

      Q=(Q1+Q2)/2
      IF (KIMP.GE.1) write(6,*) 'bcaldp2: dichotomie Q1 Q2 Q= ',Q1,Q2,Q

      CALL BCALQ2(PE,PVE,TE,PS,XL,DX0,RUG,Q,XW,NPP,XN,TN,EN,BN,
     $           KIMP,NT,NX,XX,XP,XT,XY,XU,XHF,XQ,XQW,
     $               QAE,XRE,XDH,PSQ,RECU,XKUL,XKUT1,XKUT2,XKUT3,XKUT4)

      NIT = NIT + 1
      DP = (PSQ-PS)/PS
      IF ( NIT.GT.99) THEN
        write(6,*) 'bcaldp2: NIT30=100 DP= ',DP
      ENDIF

      IF (ABS(DP).GT.FPM.AND.NIT.LE.NITMAX) THEN

         IF (DP.GT.FPM) THEN
            Q1=Q
         ELSE
            Q2=Q
         ENDIF
         GOTO 30

      ENDIF

      ENDIF

      IF ((ABS(DP).GT.FPM).AND.(KIMP.GE.1)) THEN
        write(6,*) 'bcaldp2: precision sur pression aval = ',(ABS(DP))
      ENDIF

      IF (KIMP.GE.1) THEN
        WRITE(6,*) ' '
        WRITE(6,*) 'bcaldp2 dico Q0 Q PS PSQ NX NIT ',Q0,Q,PS,PSQ,NX,NIT
        WRITE(6,*) ' '
      ENDIF
      RETURN
      END