C FUSION    SOURCE    CHAT      05/01/13    00:12:38     5004
C**************************************************************************
C**************************************************************************
C****************************                   ***************************
c************************          FUSION          ***********************
c****************************                   ***************************
C**************************************************************************
C**************************************************************************



C       compare la liste des voisins de NOEUD (noeud elimine) a celle d'un de
C       ces voisins et associe a ce dernier une nouvelle liste de voisins,
C       liste de "concatenation"ou de fusion. .



        SUBROUTINE FUSION(NPVOIS,NVOIS,NOEUD,NBENS)

      IMPLICIT INTEGER(I-N)
        SEGMENT NPVOIS(0),NVOIS(0)
        INTEGER NBENS
        INTEGER NOEUD

        INTEGER X,Y
        SEGMENT IFUS(0)
        SEGMENT NEFFET(NBENS+1)

        SEGINI NEFFET

C       on cree une liste memoire des voisins de noeud.
        NEFFET(1)=1
        DO 200 I=NPVOIS(NOEUD),NPVOIS(NOEUD+NBENS)
                NEFFET(1)=NEFFET(1)+1
                NEFFET(NEFFET(1))=NVOIS(I)
200     CONTINUE

C       on a range NVOIS par ordre croissant.

        DO 500 I=2,NEFFET(1)

            SEGINI IFUS
            IFUS(**)=0
C           fus: liste intermediaire de fusion.

            X=NEFFET(I)
C           X  : voisin de NOEUD.

            J=NPVOIS(NOEUD)
            K=NPVOIS(X)
100    IF((J.LE.NPVOIS(NOEUD+NBENS)).AND.(K.LE.NPVOIS(X+NBENS))) THEN
C           J decrit la gestion de Noeud et K celle de X.

              IF(NVOIS(J).EQ.X) THEN
C             le voisin de Noeud est X.On passe au voisin suivant de Noeud.
                J=J+1
                GOTO 100
              ELSE

                IF(NVOIS(K).EQ.NOEUD) THEN
C               le voisin de X est Noeud .On passe au voisin suivant de X.
                   K=K+1
                   GOTO 100
                ELSE

                  IF(NVOIS(J).LE.NVOIS(K)) THEN
C                 cas ou le vois de Noeud <= celui de X.
                   IF(NVOIS(J).EQ.NVOIS(K)) THEN
                        K=K+1
C                       si le voisin de noeud est voisin de X,
C                       on ne le rajoute pas.
                   ENDIF
                   IFUS(1)=IFUS(1)+1
                   IFUS(**)=NVOIS(J)
C                  sinon,on le met dans Fus.
C                  Fus est range dans l'ordre croissant.
                   J=J+1
C                  On passe au voisin suivant de Noeud.
                   GOTO 100

                 ELSE
C                cas ou le voisin de Noeud >au voisin de X.
                   IFUS(1)=IFUS(1)+1
                   IFUS(**)=NVOIS(K)
C                  on met dans Fus le voisin de X.
                   K=K+1
                   GOTO 100
                 ENDIF

               ENDIF

             ENDIF

           ENDIF



          IF(.NOT.((K.GT.NPVOIS(X+NBENS)).AND.
     *                    (J.GT.NPVOIS(NOEUD+NBENS)))) THEN
C         si on n'a fini de decrire l'une des 2 listes,


            IF(K.GT.(NPVOIS(X+NBENS))) THEN
C           on a fini de rajouter tous les voisins de X.
C           on rajoute ceux de NOEUD restants.
               DO 220 L=J,NPVOIS(NOEUD+NBENS)
                  IF (NVOIS(L).NE.X) THEN
                     IFUS(1)=IFUS(1)+1
                     IFUS(**)=NVOIS(L)
                  ENDIF
220            CONTINUE

           ELSE

C       ***(J.GT.NPVOIS(NOEUD+NBENS)****

C          on finit de rajouter les voisins de X
                DO 330 L=K,NPVOIS(X+NBENS)
                  IF (NVOIS(L).NE.NOEUD) THEN
                    IFUS(1)=IFUS(1)+1
                    IFUS(**)=NVOIS(L)
                  ENDIF
330             CONTINUE


           ENDIF

C           *******(K.GT.NPVOIS(X+NBENS)).AND.(J.GT.NPVOIS(NOEUD+NBENS)******

        ENDIF
C*******End du IF(.NOT.(K.GT.NPVOIS(X+NBENS))
C                 .AND.(J.GT.NPVOIS(NOEUD+NBENS))******

        CALL RAJOUT(IFUS,X,NPVOIS,NVOIS,NBENS)

        SEGSUP IFUS

500     CONTINUE

        SEGSUP NEFFET

        RETURN
        END