C KDOM3A    SOURCE    OF166741  24/12/13    21:16:02     12097          
      SUBROUTINE KDOM3A(MTAB,IPT1)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KDOM3A
C
C DESCRIPTION       :  Subroutine called by KDOM2A
C                      Axial-symmetric case, SEG3
C                      We compute
C                      MTAB . 'XXVOLUM'
C                      MTAB . 'CENTRE'
C                      and we change the position for the central points
C                      of MELEMQ
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
C
C************************************************************************
C
C INPUT/OUTPUT      : MTAB   : domaine table
C                     IPT1   : elementary QUAF mesh of SEG3
C
C************************************************************************
C
C Created the 24/02/04
C
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMELEME
-INC SMLMOTS
-INC SMCHPOI
      INTEGER MTAB, NBEL,NBELEM, NBSOUS, NBREF, NBNN, IELEM, JGN, JGM
     &     , NN1, NN2, NN3, IEL, IGEOM
      POINTEUR MELMAI.MELEME, MELCEN.MELEME
      REAL*8 X1, Y1, X3, Y3, VOLU, X2, Y2
      CHARACTER*8 TYPI
C
      NBEL=IPT1.NUM(/2)
C
C**** 'MAILLAGE'
C     'CENTRE' (with bad positions)
C
C     Initialisation
C
      NBELEM=NBEL
      NBSOUS=0
      NBREF=0
      NBNN=2
      SEGINI MELMAI
      MELMAI.ITYPEL=2
C
      NBELEM=NBEL
      NBNN=1
      NBSOUS=0
      NBREF=0
      SEGINI MELCEN
      MELCEN.ITYPEL=1
C
C**** Filling
C
      DO IELEM=1,NBELEM,1
         MELMAI.NUM(1,IELEM)=IPT1.NUM(1,IELEM)
         MELMAI.NUM(2,IELEM)=IPT1.NUM(3,IELEM)
         MELMAI.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM)
         MELCEN.NUM(1,IELEM)=IPT1.NUM(2,IELEM)
         MELCEN.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM)
      ENDDO
      CALL ECMO(MTAB,'MAILLAGE','MAILLAGE',MELMAI)
      CALL ECMO(MTAB,'CENTRE','MAILLAGE',MELCEN)
      SEGDES MELCEN
      SEGDES MELMAI
C
C**** Volume
C
      TYPI='CENTRE  '
      JGN=4
      JGM=1
      SEGINI MLMOTS
      MLMOTS.MOTS(1)='SCAL'
      CALL KRCHP1(TYPI,MELCEN,MCHPOI,MLMOTS)
      IF(IERR.NE.0) GOTO 9999
      SEGSUP MLMOTS
      CALL ECMO(MTAB,'XXVOLUM','CHPOINT',MCHPOI)
      IF(IERR.NE.0) GOTO 9999
      CALL LICHT(MCHPOI,MPOVAL,TYPI,IGEOM)
      IF(IERR.NE.0) GOTO 9999
C     SEGACT MPOVAL
C
C
      DO IEL=1,NBEL,1
C
         NN1=IPT1.NUM(1,IEL)
         NN2=IPT1.NUM(2,IEL)
         NN3=IPT1.NUM(3,IEL)
         X1=XCOOR((NN1-1)*(IDIM+1)+1)
         Y1=XCOOR((NN1-1)*(IDIM+1)+2)
         X3=XCOOR((NN3-1)*(IDIM+1)+1)
         Y3=XCOOR((NN3-1)*(IDIM+1)+2)
C
         CALL KDOM3B(X1,Y1,X3,Y3,VOLU,X2,Y2)
C
         MPOVAL.VPOCHA(IEL,1)=VOLU
C
C
         XCOOR((NN2-1)*(IDIM+1)+1)=X2
         XCOOR((NN2-1)*(IDIM+1)+2)=Y2
C
      ENDDO
C
      SEGDES MPOVAL
C
 9999 RETURN
C
      END



 
 
