C EXCOPP    SOURCE    CB215821  25/04/23    21:15:20     12247          
      SUBROUTINE EXCOPP(IPCH1,MOT,NIF1,IPCH2,MOT2,NIF2,IVID)
C=======================================================================
C
C               EXTRACTION D UNE COMPOSANTE D UN CHPOINT
C               ROUTINE APPELLEE PAR L OPERATEUR EXCOMP
C ENTREE
C     IPCH1= POINTEUR SUR UN CHPOINT
C     MOT  = NOM DE LA COMPOSANTE A EXTRAIRE
C     NIF1 = harmonique de Fourier
C SORTIE
C     IPCH2= POINTEUR SUR LE CHPOINT CONTENANT UNIQUEMENT LA
C            COMPOSANTE  MOT LE NOM DE CETTE COMPOSANTE EST
C            REPABTISE  MOT2 + harmonique NIF2
C     CODE DECEMBRE 84 MODIFIE NOVEMBRE 1986
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      
-INC SMCHPOI
-INC SMCOORD
-INC SMELEME
-INC PPARAM
-INC CCOPTIO

      CHARACTER*(*) MOT,MOT2
      CHARACTER*(LOCOMP) MOT1
C
c     write(*,*) 'EXCOPP: search ',MOT,NIF1,' a renommer en ',MOT2,NIF2
      MCHPO1=IPCH1
C
C     INITIALISATION DES SEGMENTS DE TRAVAIL
C
C
      MPOVAL=0
      IPT1  =0
      NBSOUS=0
      NBREF =0
      NSOUP1=MCHPO1.IPCHP(/1)
C
C     BOUCLE SUR LES SOUS PAQUETS DE MCHPO1
C
      DO 100 IA=1,NSOUP1
        MSOUP1=MCHPO1.IPCHP(IA)
        NC1=MSOUP1.NOCOMP(/2)
        DO 110 IB=1,NC1
          MOT1=MSOUP1.NOCOMP(IB)
          IHA =MSOUP1.NOHARM(IB)
          IF(MOT1.NE.MOT .OR. IHA.NE.NIF1)  GOTO 110
          IBVAL=IB
          GOTO 120
  110   CONTINUE
C
C       ON A PAS TROUVE UNE COMPOSANTE MOT DANS CE SOUS PAQUET
C
        GOTO 130
C
C       ON A TROUVE DANS LE SOUS PAQUET UNE COMPOSANTE MOT
C
 120    CONTINUE
        MELEME=MSOUP1.IGEOC
        MPOVA1=MSOUP1.IPOVAL
        NBNN  =NUM(/1)
        NBELEM=NUM(/2)
        IF(MPOVAL.EQ.0) THEN
           NDEJ=0
           NC  =1
           N   =NBELEM
           SEGINI,MPOVAL,IPT1
        ELSE
           NC    =1
           N     =NBELEM+NDEJ
           NBELEM=N
           SEGADJ,MPOVAL,IPT1
        ENDIF
        DO 140 IC=1,NUM(/2)
          IPT1.NUM(1,IC+NDEJ)=NUM(1,IC)
          MPOVAL.VPOCHA(IC+NDEJ,1)=MPOVA1.VPOCHA(IC,IBVAL)
 140    CONTINUE

        NDEJ=NDEJ+NUM(/2)
 130    CONTINUE
 100  CONTINUE
C

      IF(MPOVAL.NE.0)  GOTO 200
C
C     ERREUR PAS DE COMPOSANTE DU TYPE RECHERCHE DANS MCHPOI
C
      IF(IVID.EQ.1) THEN
          NSOUPO=0
          NAT=MCHPO1.JATTRI(/1)
          SEGINI,MCHPOI
          mochde='chpoint vide'
          mtypoi='SCALAIRE'
          IFOPOI=MCHPO1.IFOPOI
          DO 160 II=1,NAT
             JATTRI(II)=MCHPO1.JATTRI(II)
 160      CONTINUE
          IPCH2=MCHPOI
          RETURN
      ELSE
          MOTERR=MOT
          CALL ERREUR(181)
          RETURN
      ENDIF
  200 CONTINUE
C
C     ON REMPLIT LE NOUVEAU CHPOINT
C
      NSOUPO=1
      NAT=MCHPO1.JATTRI(/1)
      SEGINI,MCHPOI
      IPCH2=MCHPOI
      MTYPOI='SCALAIRE'
      MOCHDE=MCHPO1.MOCHDE
      DO 170 II=1,NAT
          JATTRI(II)=MCHPO1.JATTRI(II)
 170  CONTINUE
      IFOPOI=MCHPO1.IFOPOI
      NC=1
      SEGINI,MSOUPO
      IPCHP(1)=MSOUPO
      NOCOMP(1)=MOT2

      NOHARM(1)=NIF2
      IPOVAL=MPOVAL
      IPT1.ITYPEL=1
      call crech1(ipt1,1)
      IGEOC=IPT1

      END