Télécharger fusion.eso

Retour à la liste

Numérotation des lignes :

  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