Sources Esope | Cast3M

kfdbit
C KFDBIT    SOURCE    CB215821  20/11/25    13:31:10     10792          
      SUBROUTINE KFDBIT(IZTUU,MELEME,IZIPAD,IAXI,QD,ULP,ULM,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************************************************************************
 
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMCOORD
-INC SMCHPOI
       POINTEUR IZTUU.MPOVAL
-INC SMELEME
-INC SIZFFB
-INC SMLENTI
-INC CCREEL
      CHARACTER*8 NOM0
      DIMENSION ULN(3)
C***
C
C
C***
      IAXI=0
      IF(IFOMOD.EQ.0)IAXI=1
      DEUPI=1.D0
      IF(IAXI.NE.0)DEUPI=2.D0*XPI
 
      ULP = 0.D0
      ULM = 0.D0
      QD=0.D0
 
*
* 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
      IPT1 = MELEME
      IF(LISOUS(/1).NE.0) IPT1 = LISOUS(NS)
      SEGACT IPT1
      NBEL=IPT1.NUM(/2)
      NP=IPT1.NUM(/1)
      NOM0=NOMS(IPT1.ITYPEL)//'    '
 
      CALL KALPBG(NOM0,'FONFORM ',IZFFM)
 
      IF(IZFFM.EQ.0)THEN
C% Type d'élément incorrect
      CALL ERREUR(16)
      RETURN
      ENDIF
 
      SEGACT IZFFM*MOD
      IZHR=KZHR(1)
      SEGACT IZHR*MOD
 
      NPG=GR(/3)
      NES=GR(/1)
 
      DO 20 K=1,NBEL
 
      DO 19 N=1,IDIM
      DO 11 I=1,NP
      J=IPT1.NUM(I,K)
      XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
 11   CONTINUE
 19   CONTINUE
 
      CALL CALJBR
     & (FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
C       do 73964 ll=1,npg
C       write(6,*)'AJ'
C       write(6,1002)((aj(ii,jj,ll),ii=1,idim),jj=1,idim)
C73964  continue
 
        U=0.D0
        DO 14 L=1,NPG
        UNL=0.D0
        DO 12 N=1,IDIM
        ULN(N)=0.D0
        DO 13 I=1,NP
        I1=LECT(IPT1.NUM(I,K))
        ULN(N)=ULN(N)+FN(I,L)*IZTUU.VPOCHA(I1,N)
 13     CONTINUE
        UNL=UNL+ULN(N)*AJ(N,IDIM,L)
 12     CONTINUE
        U=U+UNL*PGSQ(L)*DEUPI*RPG(L)
 14     CONTINUE
 
 
      IF(U.GT.0.D0)THEN
      ULP = ULP+U
      ELSE
      ULM = ULM+U
      ENDIF
      QD=QD+U
 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
      write(6,*)' DEBIT TOTAL QD=',QD
      ENDIF
C******************************************************
 
      RETURN
 1002 FORMAT(10(1X,1PE11.4))
      END