C KCTRP0    SOURCE    CHAT      07/10/29    21:21:30     5940           
      SUBROUTINE KCTRP0(MTABLE,IPOINT)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC CCOPTIO
-INC CCGEOME
-INC SMTABLE
-INC SMCOORD
-INC SMELEME
      POINTEUR MELEMI.MELEME
      DIMENSION XA(3,27),XL(3,4),XG(3,4)
      CHARACTER*8 TYPE,NOME

      IPOINT=0
      TYPE=' '
      CALL ACMO(MTABLE,'MACRO',TYPE,MACRO)
      TYPE=' '
      CALL ACMO(MTABLE,'QUADRATI',TYPE,MQ)
      IF(MACRO.EQ.0.AND.MQ.EQ.0)THEN

      TYPE=' '
      CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
      IF(MELEMC.EQ.0)THEN
      MOTERR(1: 8) = 'DOMAINE.'
      MOTERR(9:16) = 'CENTRE  '
      CALL ERREUR(792)
      IPOINT=0
      RETURN
      ENDIF

      ELSE
      IF(MACRO.NE.0)MELEMI=MACRO
      IF(MQ   .NE.0)MELEMI=MQ

      CALL ECROBJ('MAILLAGE',MELEMI)
      CALL NBEL
      CALL LIRENT(NBELEM,1,IRET)
      IF(IRET.EQ.0)RETURN
      NBSOUS=0
      NBREF=0
      NBNN=1
      SEGINI MELEME
      ITYPEL=1
      NBV0=XCOOR(/1)/(IDIM+1)
      NBPTS=NBV0+NBELEM
      SEGADJ MCOORD
      K0=NBV0
      KE=0


      SEGACT MELEMI
      NBSOUL=MELEMI.LISOUS(/1)
      IF(NBSOUL.EQ.0)NBSOUL=1

      DO 1 L=1,NBSOUL
      IPT1=MELEMI
      IF(NBSOUL.NE.1)IPT1=MELEMI.LISOUS(L)
      SEGACT IPT1
      NP=IPT1.NUM(/1)
      NEL=IPT1.NUM(/2)

      NOME=NOMS(IPT1.ITYPEL)//'    '
      CALL KXL(NOME,'P0',XL)

      DO 2 K=1,NEL
      K0=K0+1
      KE=KE+1
      DO 3 M=1,IDIM
      DO 3 I=1,NP
      NI=IPT1.NUM(I,K)
      XA(M,I)=XCOOR((NI-1)*(IDIM+1)    +M)
 3    CONTINUE

      CALL FFQ(NOME,XA,XL,XG,IDIM,1)
      DO 4 M=1,IDIM
      XCOOR((K0-1)*(IDIM+1)    +M)=XG(M,1)
 4    CONTINUE
      NUM(1,KE)=K0
 2    CONTINUE
 1    CONTINUE

      IPOINT=MELEME
      CALL ECMO(MTABLE,'CENTREP0','MAILLAGE',MELEME)
      ENDIF

      RETURN
 1002 FORMAT(10(1X,1PE11.4))
      END