C KVOL      SOURCE    GOUNAND   25/11/12    21:15:37     12399          
      SUBROUTINE KVOL(MELEME,MELEMC,TYPP,MCHPOI)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C*************************************************************************
C
C     OBJET   : Cree un CHAMPOINT CENTRE contenant le volume des éléments
C               du domaine
C
C     SYNTAXE : CHPC = KVOL OBJDOM ;
C
C               OBJDOM : TABLE de SOUSTYPE DOMAINE
C
C*************************************************************************

-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMELEME
      POINTEUR MELEMC.MELEME
-INC SMCOORD
-INC SMCHPOI
-INC SIZFFB

      REAL*8 AAJ(3,3,9),U,XC(3)
      PARAMETER (NTB=1)
      CHARACTER*8 LTAB(NTB),TYPE,TYPC
      CHARACTER*(*) TYPP
C***
      SEGACT MELEMC
      NC=1
      TYPE=TYPP
      CALL CRCHPT(TYPE,MELEMC,NC,2,MCHPOI)
      CALL LICHTM(MCHPOI,MPOVAL,TYPC,IGEOM)
      SEGDES MELEMC

      SEGACT MELEME

      IAXI=0
      IF(IFOMOD.EQ.0)IAXI=2

      NBSOUS=LISOUS(/1)
      IF(NBSOUS.EQ.0)NBSOUS=1

      KK=0
      DO 1 L=1,NBSOUS
      IPT1=MELEME
      IF(NBSOUS.NE.1)IPT1=LISOUS(L)
      SEGACT IPT1
      NP=IPT1.NUM(/1)
      NEL=IPT1.NUM(/2)
      TYPE=NOMS(IPT1.ITYPEL)//'    '
      CALL KALPBG(TYPE,'FONFORM ',IZFFM)
      SEGACT IZFFM*MOD
      IZHR=KZHR(1)
      SEGACT IZHR*MOD
      NES=GR(/1)
      NPG=GR(/3)

      DO 10 K=1,NEL
      KK=KK+1
      NPGR=0
      IF(IAXI.NE.0)NPGR=NPG
C
C     REMPLISSAGE DE XYZ
C     ------------------
C
      DO 12 I=1,NP
      J=IPT1.NUM(I,K)
      DO 121 N=1,IDIM
      XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
 121  CONTINUE
 12   CONTINUE

      MP1=0
      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE)

C             CALCUL DU VOLUME / AIRE

      VPOCHA(KK,1)=AIRE

 10   CONTINUE
      SEGDES IPT1
 1    CONTINUE
      SEGDES MELEME,MPOVAL,MCHPOI
C
      RETURN

 90   CONTINUE
      WRITE(6,*)' Interruption anormale de KVOL'
      RETURN
 1001 FORMAT(20(1X,I5))
      END