Esope source files

   1 : C FUSION    SOURCE    CHAT      05/01/13    00:12:38     5004           
   2 : C**************************************************************************
   3 : C**************************************************************************
   4 : C****************************                   ***************************
   5 : c************************          FUSION          ***********************
   6 : c****************************                   ***************************
   7 : C**************************************************************************
   8 : C**************************************************************************
   9 : 
  10 : 
  11 : 
  12 : C       compare la liste des voisins de NOEUD (noeud elimine) a celle d'un de 
  13 : C       ces voisins et associe a ce dernier une nouvelle liste de voisins,
  14 : C       liste de "concatenation"ou de fusion. . 
  15 : 
  16 : 
  17 : 
  18 :         SUBROUTINE FUSION(NPVOIS,NVOIS,NOEUD,NBENS)
  19 : 
  20 :       IMPLICIT INTEGER(I-N)
  21 :         SEGMENT NPVOIS(0),NVOIS(0)
  22 :         INTEGER NBENS
  23 :         INTEGER NOEUD
  24 : 
  25 :         INTEGER X,Y
  26 :         SEGMENT IFUS(0)
  27 :         SEGMENT NEFFET(NBENS+1)
  28 : 
  29 :         SEGINI NEFFET
  30 :         
  31 : C       on cree une liste memoire des voisins de noeud.
  32 :         NEFFET(1)=1
  33 :         DO 200 I=NPVOIS(NOEUD),NPVOIS(NOEUD+NBENS)
  34 :                 NEFFET(1)=NEFFET(1)+1
  35 :                 NEFFET(NEFFET(1))=NVOIS(I)
  36 : 200     CONTINUE        
  37 : 
  38 : C       on a range NVOIS par ordre croissant.
  39 :         
  40 :         DO 500 I=2,NEFFET(1)
  41 : 
  42 :             SEGINI IFUS
  43 :             IFUS(**)=0
  44 : C           fus: liste intermediaire de fusion.
  45 : 
  46 :             X=NEFFET(I)
  47 : C           X  : voisin de NOEUD.
  48 : 
  49 :             J=NPVOIS(NOEUD)     
  50 :             K=NPVOIS(X)
  51 : 100    IF((J.LE.NPVOIS(NOEUD+NBENS)).AND.(K.LE.NPVOIS(X+NBENS))) THEN
  52 : C           J decrit la gestion de Noeud et K celle de X.
  53 : 
  54 :               IF(NVOIS(J).EQ.X) THEN
  55 : C             le voisin de Noeud est X.On passe au voisin suivant de Noeud.
  56 :                 J=J+1
  57 :                 GOTO 100
  58 :               ELSE
  59 :         
  60 :                 IF(NVOIS(K).EQ.NOEUD) THEN
  61 : C               le voisin de X est Noeud .On passe au voisin suivant de X.
  62 :                    K=K+1
  63 :                    GOTO 100
  64 :                 ELSE
  65 : 
  66 :                   IF(NVOIS(J).LE.NVOIS(K)) THEN
  67 : C                 cas ou le vois de Noeud <= celui de X.
  68 :                    IF(NVOIS(J).EQ.NVOIS(K)) THEN        
  69 :                         K=K+1
  70 : C                       si le voisin de noeud est voisin de X,
  71 : C                       on ne le rajoute pas.
  72 :                    ENDIF
  73 :                    IFUS(1)=IFUS(1)+1
  74 :                    IFUS(**)=NVOIS(J)
  75 : C                  sinon,on le met dans Fus.
  76 : C                  Fus est range dans l'ordre croissant.
  77 :                    J=J+1
  78 : C                  On passe au voisin suivant de Noeud.
  79 :                    GOTO 100     
  80 : 
  81 :                  ELSE
  82 : C                cas ou le voisin de Noeud >au voisin de X.
  83 :                    IFUS(1)=IFUS(1)+1
  84 :                    IFUS(**)=NVOIS(K)
  85 : C                  on met dans Fus le voisin de X.
  86 :                    K=K+1
  87 :                    GOTO 100
  88 :                  ENDIF
  89 : 
  90 :                ENDIF
  91 : 
  92 :              ENDIF
  93 : 
  94 :            ENDIF   
  95 : 
  96 : 
  97 : 
  98 :           IF(.NOT.((K.GT.NPVOIS(X+NBENS)).AND.
  99 :      *                    (J.GT.NPVOIS(NOEUD+NBENS)))) THEN
 100 : C         si on n'a fini de decrire l'une des 2 listes, 
 101 :         
 102 :         
 103 :             IF(K.GT.(NPVOIS(X+NBENS))) THEN
 104 : C           on a fini de rajouter tous les voisins de X.
 105 : C           on rajoute ceux de NOEUD restants.
 106 :                DO 220 L=J,NPVOIS(NOEUD+NBENS)
 107 :                   IF (NVOIS(L).NE.X) THEN
 108 :                      IFUS(1)=IFUS(1)+1
 109 :                      IFUS(**)=NVOIS(L)
 110 :                   ENDIF
 111 : 220            CONTINUE
 112 : 
 113 :            ELSE
 114 : 
 115 : C       ***(J.GT.NPVOIS(NOEUD+NBENS)****
 116 : 
 117 : C          on finit de rajouter les voisins de X             
 118 :                 DO 330 L=K,NPVOIS(X+NBENS)
 119 :                   IF (NVOIS(L).NE.NOEUD) THEN
 120 :                     IFUS(1)=IFUS(1)+1
 121 :                     IFUS(**)=NVOIS(L)
 122 :                   ENDIF
 123 : 330             CONTINUE
 124 : 
 125 : 
 126 :            ENDIF
 127 : 
 128 : C           *******(K.GT.NPVOIS(X+NBENS)).AND.(J.GT.NPVOIS(NOEUD+NBENS)******
 129 : 
 130 :         ENDIF
 131 : C*******End du IF(.NOT.(K.GT.NPVOIS(X+NBENS))
 132 : C                 .AND.(J.GT.NPVOIS(NOEUD+NBENS))******
 133 : 
 133 :         CALL RAJOUT(IFUS,X,NPVOIS,NVOIS,NBENS)
 134 : 
 135 :         SEGSUP IFUS
 136 : 
 137 : 500     CONTINUE
 138 : 
 139 :         SEGSUP NEFFET
 140 : 
 141 :         RETURN
 142 :         END
 143 :