Télécharger la plaquette Cast3M


fr en

Télécharger fusion.eso

Retour à la liste

Numérotation des lignes : 

fusion

  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.  
  134.         CALL RAJOUT(IFUS,X,NPVOIS,NVOIS,NBENS)
  135.  
  136.         SEGSUP IFUS
  137.  
  138. 500     CONTINUE
  139.  
  140.         SEGSUP NEFFET
  141.  
  142.         RETURN
  143.         END
  144.  
  145.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales