C MUCHP2    SOURCE    CB215821  21/08/20    21:15:26     11089          
      SUBROUTINE MUCHP2(MCHPOI,MLMOTS,MCORES,JCHACO,KCHACO,IHARNUM,NMIN)
c=======================================================================
c
c  appelé par muchp1
c  sert à determiner si il existe des zones à fusionner
c
c=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC SMCHPOI
-INC PPARAM
-INC SMELEME
-INC SMLMOTS

*  ENTREE
* ce segment contient les numéro des différents harmoniques trouvées
* et l'inversion du tableau
      SEGMENT NUMHAR(NHAR)
      SEGMENT IHARNUM(NVHAR)
*  SORTIE
* ces segment servent au moment de l'assemblage du nouveau chpoint
* celui stocke le nombre de sous zone du nouveau chpoint
      SEGMENT JCHACO(4,NSOUP1)
*    indice 1 kcomp , 2 khar , 3 nombre de pts , 4 nbre de composante
*  kchaco donne l'adresse dans jchaco de la sous zone
      SEGMENT KCHACO(NSOUPO)
*
      SEGMENT MCORES
*   correspondence comp listmot comp sous zone
*     numero dans la sous zone de la composante si elle existe
       INTEGER ICOR3(NCOMP1,NSOUPO)
*      indice 1 contient sum 2**i si i présent
*      indice 2 contient le nombre de composantes
       INTEGER KCOMP(2,NSOUPO)
       INTEGER KHARM(NSOUPO)
      ENDSEGMENT
*
* EXECUTABLE
*
*  première partie on remplis mcores pour chaque sous zone
* et on calcul kcomp et kharm pour les comparaison
*
      NCOMP1 = MOTS(/2)
      NSOUPO = IPCHP(/1)
      SEGINI MCORES
      DO 120 I=1,NSOUPO
        MSOUPO = IPCHP(I)
            NC = NOHARM(/1)
            NC1 = 0
*        boucle sur les composantes
            DO 110 J=1,NCOMP1
*               ICOR3(J,I)=0
*          boucle sur les composantes du chpoints
               DO 100 K=1,NC
                   IF(MOTS(J).EQ.NOCOMP(K)) THEN
                      ICOR3(J,I)=K
                      KCOMP(1,I)=KCOMP(1,I) + 2**J
                      KCOMP(2,I)=KCOMP(2,I) + 1
                      IHA = IHARNUM(NOHARM(K)-NMIN+1)
                      KHARM(I)=KHARM(I) + 2**IHA
                      GOTO 110
                   ENDIF
 100           CONTINUE
 110        CONTINUE
 120   CONTINUE

*
* deuxieme partie on rempli jchaco et kchaco
*
      NSOUP1 = NSOUPO
      SEGINI JCHACO,KCHACO
      NSOUP1=0
      DO 140 I=1,NSOUPO
        MSOUPO = IPCHP(I)
        MELEME = IGEOC
        DO 130 J=1,NSOUP1
         IF(KCOMP(1,I).EQ.JCHACO(1,J).AND.KHARM(I).EQ.JCHACO(2,J))THEN
            KCHACO(I)=J
            JCHACO(3,J)=JCHACO(3,J)+NUM(/2)
            GOTO 140
          ENDIF
 130    CONTINUE
        NSOUP1=NSOUP1+1
        JCHACO(1,NSOUP1)=KCOMP(1,I)
        JCHACO(2,NSOUP1)=KHARM(I)
        JCHACO(3,NSOUP1)=NUM(/2)
        JCHACO(4,NSOUP1)=KCOMP(2,I)
        KCHACO(I)=NSOUP1
 140  CONTINUE
      SEGADJ JCHACO
      RETURN
      END