C FFDBIT    SOURCE    MAGN      10/05/18    21:15:28     6675           
      SUBROUTINE FFDBIT(IZTUU,MELEME,IZIPAD,IAXI,QD,IMPR)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
C************************************************************************       
C
C OPERATEUR DBIT
C
C     CALCUL DU DEBIT D'UN VECTEUR A TRAVERS UNE SURFACE                        
C     SUR LE DOMAINE COURANT 
C                                                             
C CALCUL EFFECTIF DU DEBIT.
C                                                             
C     IZTUU  : POINTEUR SUR LE CHPOINT-MPOVAL QUI DOIT ETRE DE TYPE VECT.
C     MELEME : POINTEUR SUR L'OBJET MAILLAGE 
C     IZIPAD : Pointeur sur IPADL
C     QD     : LE DEBIT
C                                                                               
C                                                                               
C************************************************************************       
                                                                                
      PARAMETER (NLIS2=1,NLIS3=2)                                               
      CHARACTER*8 LIST2(NLIS2),LIST3(NLIS3)                                     
      CHARACTER*8 NOM0                                      
      DIMENSION P2(2,2),P3(3,3),UI(3,9),UU(9)                                   
      DIMENSION XN(3)                                                           
                                                                                
-INC CCOPTIO
-INC CCGEOME                                                                    
-INC SMCOORD
-INC SMCHPOI
       POINTEUR IZTUU.MPOVAL
-INC SMELEME                                                                    
-INC SIZFFB                                                                     
-INC SMLENTI
                                                                                
                                                                                
C***                                                                            
C                                                                               
      DATA LIST2/'SEG2    '/                                                    
      DATA LIST3/'TRI3    ','QUA4    '/                                         
C                                                                               
C***                                                                            
C   INITIALISATION                                                              
C
      ULP = 0.                                                                  
      ULM = 0.                                                                  
      QD=0.                                                                     
                                                                                
*
* On peut y aller, les controles ont eu lieu dans DBIT
*
      MLENTI=IZIPAD
      SEGACT IZTUU
      SEGACT MELEME                                                             
      NBSOUS=LISOUS(/1)                                                         
      IF(NBSOUS.EQ.0)NBSOUS=1                                                   
      DO 10 NS=1,NBSOUS                                                         
      IF(LISOUS(/1).EQ.0) IPT1 = MELEME
      IF(LISOUS(/1).NE.0) IPT1 = LISOUS(NS)
      SEGACT IPT1                                                               
      NBEL=IPT1.NUM(/2)                                                         
      NP=IPT1.NUM(/1)                                                           
      NOM0=NOMS(IPT1.ITYPEL)//'    '                                            
      IF(IDIM.EQ.2)CALL OPTLI(IP,LIST2,NOM0,1)
      IF(IDIM.EQ.3)CALL OPTLI(IP,LIST3,NOM0,2)
      IF(IP.EQ.0)WRITE(6,*)' CET ELEMENT :',NOM0,': NE CONVIENT PAS ',          
     & 'POUR CALCULER UN DEBIT EN ',IDIM,' D'
      IF(IP.EQ.0)RETURN                                                         
                                                                                
      CALL KALPBG(NOM0,'FONFORM ',IZFFM)
      IF(IZFFM.EQ.0)CALL ARRET(0)                                               
      SEGACT IZFFM                                                              
      IZHR=KZHR(1)                                                              
      SEGACT IZHR*MOD
                                                                                
      NPG=GR(/3)                                                                
      NES=GR(/1)                                                                

      DO 20 K=1,NBEL                                                            
                                                                                
      DO 11 I=1,NP                                                              
      J=IPT1.NUM(I,K)                                                           
      DO 19 N=1,IDIM
      XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
      J1=LECT(J)
      UI(N,I)=IZTUU.VPOCHA(J1,N)
 19   CONTINUE                                                                  
 11   CONTINUE                                                                  
                                                                                
      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE)
                                                                                
      IF(IDIM.EQ.3) THEN
                                                                                
        CALL CALJQB(XYZ,P3,IDIM,NP)
        DO 13 I=1,NP                                                            
        UU(I)=UI(1,I)*P3(3,1)+UI(2,I)*P3(3,2)+UI(3,I)*P3(3,3)                   
 13     CONTINUE                                                                
        DO 133 KS=1,IDIM
        XN(KS)= P3(3,KS)                                                        
 133    CONTINUE                                                                
      ELSE                                                                      
                                                                                
        CALL CALJQB(XYZ,P2,IDIM,NP)
        DO 12 I=1,NP                                                            
        UU(I)=UI(1,I)*P2(2,1)+UI(2,I)*P2(2,2)                                   
 12     CONTINUE                                                                
        DO 122 KS=1,IDIM
        XN(KS)= P2(2,KS)                                                        
 122    CONTINUE                                                                
                                                                                
      ENDIF                                                                     
                                                                                
      UL=0.                                                                     
      DO 14 I=1,NP                                                              
      DO 14 L=1,NPG                                                             
      UL=UL+UU(I)*FN(I,L)*PGSQ(L)                                               
 14   CONTINUE                                                                  

      IF(UL.GT.0.)THEN                                                          
      ULP = ULP+UL                                                              
      ELSE                                                                      
      ULM = ULM+UL                                                              
      ENDIF                                                                     
      QD=QD+UL                                                                  
 20   CONTINUE                                                                  
      IF(LISOUS(/1).NE.0) SEGDES IPT1
 10   CONTINUE                                                                  
      SEGDES MELEME,IZTUU
      SEGSUP IZHR,IZFFM
                                                                                
      IF(IMPR.NE.0)THEN
      WRITE(6,*)' DEBIT GLOBAL DANS LE SENS DE LA NORMALE =      ',ULP          
      WRITE(6,*)' DEBIT GLOBAL DANS LE SENS OPPOSE A LA NORMALE =',ULM          
      ENDIF
C******************************************************                         
                                                                                
      RETURN                                                                    
      END