C MOCE      SOURCE    PV        20/03/30    21:21:17     10567          
C  MODI RECENTRAGE DES POINTS MILIEUX (SAUF LE CONTOUR)
C
      SUBROUTINE MOCE(MELEME,XPROJ,ICPR,IBOUJ)
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC CCGEOME
-INC SMCOORD
      SEGMENT ICPR(0)
      SEGMENT IBOUJ(0)
      SEGMENT XPROJ(3,0)
      SEGMENT IAUX(nbpts)
      CALL ECROBJ('MAILLAGE',MELEME)
      CALL PRCONT
      CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
      IF (IERR.NE.0) RETURN
      SEGACT IPT1
*  REACTIVONS LE  MAILLAGE A TOUT HASARD
      SEGACT MELEME
      DO 100 I=1,LISOUS(/1)
         IPT2=LISOUS(I)
         SEGACT IPT2
 100  CONTINUE
      IF (IPT1.ITYPEL.NE.3) THEN
        SEGDES IPT1
        RETURN
      ENDIF
      SEGINI IAUX
      DO 110 I=1,IPT1.NUM(/2)
         IAUX(IPT1.NUM(2,I))=1
 110  CONTINUE
      SEGDES IPT1
      IPT1=MELEME
      DO 30 IO=1,MAX(1,LISOUS(/1))
         IF (LISOUS(/1).NE.0) IPT1=LISOUS(IO)
         K=IPT1.ITYPEL
         IF (K.NE.KSURF(K)) GOTO 21
C  LE NOMBRE DE FACE EST 1 QUEL EST SON TYPE
         KK=LTEL(2,K)
         ITYP=LDEL(1,KK)
         NBNN=KDEGRE(K)
         IF (NBNN.NE.3) GOTO 21
         IPAS=NBNN-1
         IDEP=LDEL(2,KK)
         IFEP=IDEP+KDFAC(1,ITYP)-1
*     SG 20160711 pour les faces TRI7 et QUA9, on ignore le dernier
*     point (centre de la face)
         IF (ITYP.EQ.7.OR.ITYP.EQ.8) IFEP=IFEP-1
         DO 22 I=1,IPT1.NUM(/2)
            DO 221 J=IDEP,IFEP,IPAS
               N1=IPT1.NUM(LFAC(J),I)
               JSUIV=J+IPAS
               IF (JSUIV.GT.IFEP) JSUIV=IDEP
               N2=IPT1.NUM(LFAC(JSUIV),I)
               NMIL=IPT1.NUM(LFAC(J+1),I)
               IF (IAUX(NMIL).NE.0) GOTO  221
               IP1=ICPR(N1)
               IP2=ICPR(N2)
               IPMIL=ICPR(NMIL)
               XPROJ(1,IPMIL)=(XPROJ(1,IP1)+XPROJ(1,IP2))/2
               XPROJ(2,IPMIL)=(XPROJ(2,IP1)+XPROJ(2,IP2))/2
               XPROJ(3,IPMIL)=(XPROJ(3,IP1)+XPROJ(3,IP2))/2
               CALL PROMOD(ICPR,XPROJ,NMIL,4,IBOUJ)
               IAUX(NMIL)=1
 221        CONTINUE
 22      CONTINUE
 21      CONTINUE
 30   CONTINUE
      SEGSUP IAUX
      RETURN
      END