C ENLEV5    SOURCE    PV        13/04/11    21:15:44     7755           
      SUBROUTINE ENLEV5(IPOIN1,MSWMIL,IPOIN2)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCOPTIO
-INC SMCHPOI
-INC SMCOORD
-INC SMELEME
-INC TMTRAV
      SEGMENT MSWMIL
      CHARACTER*4 MOTDDL(IAAA)
      ENDSEGMENT
      SEGMENT/MTRA/(ICPR(XCOOR(/1)/(IDIM+1)))
      SEGMENT MTR1
      CHARACTER*4 IPCOM(0)
      ENDSEGMENT
      SEGMENT/MTR2/(IPHAR(0))
C     
      SEGACT MSWMIL
      IBDDL=MOTDDL(/2)
      IF(IBDDL.EQ.0) THEN
         IPOIN2=IPOIN1
         RETURN
      ENDIF
      IF(IBDDL.EQ.1) THEN
         MCHPOI=IPOIN1
         SEGACT MCHPOI
         NSOUPO=IPCHP(/1)
         ITOT=0
         ISOU=0
         DO 4 IA=1,NSOUPO
            MSOUPO=IPCHP(IA)
            SEGACT MSOUPO
            NCBBB=NOCOMP(/2)
            IEXT=0
            DO 5 IB=1,NCBBB
               IF(NOCOMP(IB).EQ.MOTDDL(1)) THEN
                  IEXT=IA
                  ITOT=ITOT+1
               ENDIF
 5          CONTINUE
 4       CONTINUE
         IF(ITOT.NE.1)    GO TO 2876
         IF(IEXT.EQ.0)    GO TO 2876
         MSOUPO=IPCHP(IEXT)
         IF(NOCOMP(/2).NE.1) GO TO 2876
         NSOUPO=NSOUPO-1
         NC=IBDDL
         NAT=MAX ( JATTRI(/1) , 1)
         SEGINI MCHPO1
         MCHPO1.MTYPOI=MTYPOI
         MCHPO1.MOCHDE=MOCHDE
         IF ( JATTRI(/1) .GE. 1 ) THEN
            MCHPO1.JATTRI(1) = JATTRI(1)
         ELSE
            MCHPO1.JATTRI(1) = 0
         ENDIF
         MCHPO1.IFOPOI=IFOPOI
         IBB=0
         DO 7 IA=1,IPCHP(/1)
            MSOUPO=IPCHP(IA)
            IF ( IEXT.EQ.IA) THEN
               SEGDES MSOUPO
            ELSE
               SEGINI,MSOUP1=MSOUPO
               IBB=IBB+1
               IPT1=IGEOC
               SEGACT IPT1
**             SEGINI,MELEME=IPT1
               MELEME=IPT1
               MPOVAL=IPOVAL
               SEGACT MPOVAL
               SEGINI,MPOVA1=MPOVAL
               MSOUP1.IGEOC=MELEME
               MSOUP1.IPOVAL=MPOVA1
               SEGDES MPOVA1,MPOVAL,MSOUP1,MSOUPO,MELEME,IPT1
               MCHPO1.IPCHP(IBB)=MSOUP1
            ENDIF
 7       CONTINUE
         IPOIN2 = MCHPO1
         SEGDES MCHPO1,MCHPOI
         RETURN
      ENDIF
 2876 CONTINUE
C     
      SEGINI MTRA,MTR1,MTR2
C     
      NC=0
      IK=0
      MCHPOI=IPOIN1
      SEGACT MCHPOI
      NSOUPO=IPCHP(/1)
C     
C     BOUCLE SUR LES SOUS REFERENCES DU CHPOINT
C     
      DO 350 IA=1,NSOUPO
         MSOUPO=IPCHP(IA)
         SEGACT MSOUPO
         NCBBB=NOCOMP(/2)
         MILCO=0
C     
         DO 330 IB=1,NCBBB
            DO 344 MIK=1,IBDDL
               IF(NOCOMP(IB).EQ.MOTDDL(MIK)) GO TO 330
 344        CONTINUE
            NC=IPCOM(/2)
            DO 320 IC=1,NC
               IF(IPCOM(IC).NE.NOCOMP(IB)) GO TO 320
               IF(IPHAR(IC).EQ.NOHARM(IB))  GO TO 331
 320        CONTINUE
            IPCOM(**)=NOCOMP(IB)
            IPHAR(**)=NOHARM(IB)
            NC=NC+1
 331        MILCO=MILCO+1
 330     CONTINUE
C     
         IF(MILCO.NE.0) THEN
            MELEME=IGEOC
            SEGACT MELEME
            NBELEM=NUM(/2)
            DO 310 IB=1,NBELEM
               K=NUM(1,IB)
               IF(ICPR(K).NE.0) GO TO 310
               IK=IK+1
               ICPR(K)=IK
 310        CONTINUE
            SEGDES MELEME
         ENDIF
         SEGDES MSOUPO
 350  CONTINUE
      SEGDES MSWMIL
C     
      NNIN=NC
      NNNOE=IK
      SEGINI MTRAV
C     
C     REMPLISSAGE DES TABLEAUX DU SEGMENT MTRAV
C     
      DO 380 IA=1,NNIN
         INCO(IA)=IPCOM(IA)
         NHAR(IA)=IPHAR(IA)
 380  CONTINUE
C     
      DO 430 IA=1,NSOUPO
         MSOUPO=IPCHP(IA)
         SEGACT MSOUPO
         MELEME=IGEOC
         SEGACT MELEME
         MPOVAL=IPOVAL
         SEGACT MPOVAL
         NBELEM=NUM(/2)
C     
         DO 420 IB=1,NOCOMP(/2)
            DO 390 IC=1,NNIN
               IF(NOCOMP(IB).NE.IPCOM(IC)) GO TO 390
               IF(NOHARM(IB).EQ.IPHAR(IC)) GO TO 400
 390        CONTINUE
            GO TO 420
 400        CONTINUE
            DO 410 ID=1,NBELEM
               KI=ICPR(NUM(1,ID))
               IF(KI.EQ.0) GO TO 410
               IGEO(KI)=NUM(1,ID)
               IBIN(IC,KI)=1
               BB(IC,KI)=VPOCHA(ID,IB)
 410        CONTINUE
 420     CONTINUE
         SEGDES MELEME,MSOUPO,MPOVAL
 430  CONTINUE
C     
      ITRAV=MTRAV
      SEGDES MTRAV
C     
      CALL CRECHP(ITRAV,IPOIN2)
C      ATTRIBUTION D'UNE NATURE A IPOIN2 IDENTIQUE AU CHPO IPOIN1
      MCHPO1 = IPOIN2
      SEGACT MCHPO1
      NAT = MAX ( MCHPO1.JATTRI(/1) , 1)
      NSOUPO = MCHPO1.IPCHP(/1)
      SEGADJ MCHPO1
      IF ( JATTRI(/1) .GE. 1 ) THEN
         MCHPO1.JATTRI(1) = JATTRI(1)
      ELSE
         MCHPO1.JATTRI(1) = 0
      ENDIF
      SEGDES MCHPOI,MCHPO1
      SEGSUP MTRAV,MTRA,MTR1,MTR2
      RETURN
      END