C EXCOC2    SOURCE    PV090527  25/01/07    14:42:35     12115          
      SUBROUTINE EXCOC2(IPCH1,LMOT1,IPCH2,LMOT2,IVID)
C-----------------------------------------------------------------------
C     EXTRACTION D UNE LISTE DE COMPOSANTES D UN MCHAML
C
C ENTREE
C     IPCH1= POINTEUR SUR UN MCHAML
C     LMOT1= LISTE DES NOMS DES COMPOSANTES A EXTRAIRE
C     LMOT2= LISTE DES NOUVEAUX NOMS UNE FOIS EXTRAITS
C     IVID = 1 SI ON A LU LE MOT 'NOID', 0 SINON
C
C SORTIE
C     IPCH2= POINTEUR SUR LE MCHAML CONTENANT LES COMPOSANTES EXTRAITES
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC SMCHAML
-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
-INC SMCOORD

      CHARACTER*(LOCOMP) LEMOT,MOLIST

      MLMOTS=LMOT1
      MLMOT2=LMOT2

      JGN   =MLMOTS.MOTS(/1)
      JGM   =MLMOTS.MOTS(/2)


      MCHELM=IPCH1

      SEGINI,MCHEL1=MCHELM
      IPCH2 =MCHEL1

      N1ori =MCHEL1.ICHAML(/1)
      N3    =MCHEL1.INFCHE(/2)

C     BOUCLE SUR MCHAML
      N1loc=0
      DO 100 IN1=1,N1ori
        MCHAML=MCHEL1.ICHAML(IN1)
        SEGINI,MCHAM1=MCHAML
        N2ori =MCHAM1.IELVAL(/1)

C       BOUCLE SUR MELVAL
        N2loc=0
        DO 110 IN2=1,N2ori
          LEMOT=MCHAML.NOMCHE(IN2)

C         BOUCLE SUR MLMOTS
          DO 150 IMO=1,JGM
            MOLIST=MOTS(IMO)
            IF (MOLIST.EQ.LEMOT) THEN
              N2loc = N2loc + 1
              MCHAM1.NOMCHE(N2loc)=MLMOT2.MOTS(IMO)
              MCHAM1.TYPCHE(N2loc)=MCHAML.TYPCHE(iN2)
              MCHAM1.IELVAL(N2loc)=MCHAML.IELVAL(iN2)
              GOTO 110
            ENDIF
 150      CONTINUE
 110    CONTINUE

        IF (N2loc .EQ. 0) THEN
          SEGSUP,MCHAM1
          GOTO 100

        ELSE
          N1loc = N1loc + 1
          MCHEL1.ICHAML(N1loc)=MCHAM1
          MCHEL1.CONCHE(N1loc)=MCHELM.CONCHE(IN1)
          MCHEL1.IMACHE(N1loc)=MCHELM.IMACHE(IN1)
          DO IN3=1,N3
            MCHEL1.INFCHE(N1loc,IN3)=MCHELM.INFCHE(IN1,IN3)
          ENDDO

          IF (N2loc .NE. N2ori) THEN
            N2=N2loc
            SEGADJ,MCHAM1
          ENDIF
        ENDIF
 100  CONTINUE

      IF    (N1loc.EQ.0 .AND. IVID.NE.1) THEN
        MOTERR(1:8)=MLMOTS.MOTS(1)
        CALL ERREUR(236)
        RETURN
      ELSEIF(N1loc .NE. N1ori) THEN
        N1 = N1loc
        L1 = MCHEL1.TITCHE(/1)
        SEGADJ,MCHEL1
      ENDIF

      END
 
 
