C BCALDP2   SOURCE    DURA      06/07/11    21:15:03     5481           
      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 (DABS(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 (DABS(DP).GT.FPM.AND.NIT.LE.NITMAX) THEN
                                                                                
         IF (DP.GT.FPM) THEN                                                    
            Q1=Q                                                                
         ELSE                                                                   
            Q2=Q                                                                
         ENDIF                                                                  
         GOTO 30                                                                
                                                                                
      ENDIF                                                                     
                                                                                
      ENDIF                                                                     

      IF ((DABS(DP).GT.FPM).AND.(KIMP.GE.1)) THEN
        write(6,*) 'bcaldp2: precision sur pression aval = ',(DABS(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