C KCTRP1    SOURCE    PV        20/04/02    21:15:24     10567          
      SUBROUTINE KCTRP1(MTABLE,IPOINT,IKAS)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMTABLE
-INC SMCOORD
-INC SMELEME
      POINTEUR MELEMI.MELEME
      DIMENSION XA(3,64),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=IDIM+1
      SEGINI MELEME
      IF(IDIM.EQ.2)ITYPEL=4
      IF(IDIM.EQ.3)ITYPEL=23
      segact mcoord*mod
      NBV0=nbpts
      NBPTS=NBV0+(NBELEM*(IDIM+1))
      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,'P1',XL)

      DO 2 K=1,NEL
      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,NBNN)

      DO 5 MI=1,NBNN
      K0=K0+1
      DO 4 M=1,IDIM
      XCOOR((K0-1)*(IDIM+1)    +M)=XG(M,MI)
 4    CONTINUE
      NUM(MI,KE)=K0
 5    CONTINUE
 2    CONTINUE
 1    CONTINUE
      segact mcoord

      CALL ECMO(MTABLE,'ELTP1NC ','MAILLAGE',MELEME)
      CALL ECRCHA('POI1')
      CALL ECROBJ('MAILLAGE',MELEME)
      CALL PRCHAN
      CALL LIROBJ('MAILLAGE',MELEM1,1,IRET)
      CALL ECMO(MTABLE,'CENTREP1','MAILLAGE',MELEM1)
      ENDIF

      IF(IKAS.EQ.1)IPOINT=MELEM1
      IF(IKAS.EQ.2)IPOINT=MELEME

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






 
 
 
 
