Sources Esope | Cast3M

ffdbit
C FFDBIT    SOURCE    CB215821  20/11/25    13:28:50     10792          
      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 PPARAM
-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