Télécharger mindeg.eso

Retour à la liste

Numérotation des lignes :

  1. C MINDEG SOURCE CHAT 05/01/13 01:45:16 5004
  2. C**************************************************************************
  3. C**************************************************************************
  4. C**************************************************************************
  5. C***************************** ******************************
  6. C************************* ***************************
  7. c******************* MINIDEG *********************
  8. c************************** ***************************
  9. C**************************** ******************************
  10. C**************************************************************************
  11. C**************************************************************************
  12. C**************************************************************************
  13.  
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20. SUBROUTINE MINDEG(NPVOIS,NVOIS,NBENS,IORDRE)
  21. C*****************************************************************************
  22.  
  23.  
  24. C Cette procedure permet:
  25. C - tout d'abord, de renumeroter les noeuds a partir
  26. C du minimum degre.
  27. C - ensuite,a partir de cette nouvelle renumerotation,d'obtenir
  28. C une matrice par blocs par le biais de la methode multifrontale.
  29.  
  30.  
  31. C domaine d'etude.
  32. C***********************
  33.  
  34. IMPLICIT INTEGER(I-N)
  35. SEGMENT NPVOIS(0),NVOIS(0)
  36. INTEGER NBENS
  37.  
  38. SEGMENT MPVOIS(NBENS*2),MVOIS(0)
  39. C MVOIS contient pour chaque noeud:
  40. C tous les voisins de noeud contenus dans NVOIS.
  41. C des nouveaux voisins qui apparaissent lors de l'elimination
  42. C d'un voisin (appartenant a MVOIS) de noeud.
  43. C le nombre de voisins total du noeud X= MPVOIS(X,2)-MPVOIS(X,1)
  44.  
  45. SEGMENT NOERES(NBENS+1)
  46. C NOERES=tableau des noeuds non elimines.
  47. C NOERES(1)=dimension de NOERES
  48.  
  49. SEGMENT IORDRE(NBENS*2)
  50.  
  51. INTEGER COMPT,RACINE,NOEUD
  52. SEGMENT IFILS(NBENS),IFRERE(NBENS)
  53. C RACINE,IFILS,IFRERE servent a la confection du graphe de
  54. C renumerotation.
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61. C initialisation :
  62. C************************
  63. SEGINI NOERES,MPVOIS,MVOIS,IORDRE
  64. DO 10 I=1,NBENS
  65. NOERES(I+1)=I
  66. MPVOIS(I)=NPVOIS(I)
  67. IORDRE(I)=0
  68. IORDRE(I+NBENS)=0
  69. MPVOIS(I+NBENS)=NPVOIS(I+NBENS)
  70. DO 20 J=NPVOIS(I),NPVOIS(I+NBENS)
  71. MVOIS(**)=NVOIS(J)
  72. 20 CONTINUE
  73. 10 CONTINUE
  74. NOERES(1)=NBENS
  75. C tous les noeuds sont des noeuds restants.
  76. COMPT=0
  77. C le compteur est initialise a 0.
  78.  
  79.  
  80. C Boucle principale :
  81. C**************************
  82.  
  83. 100 IF (NOERES(1).NE.0) THEN
  84. C si le nombre de noeuds restants n'est pas nul,
  85.  
  86. CALL CHDEG(NPVOIS,NVOIS,NOERES,NOEUD,NBENS)
  87. C on cherche alors le NOEUD de degre minimum.
  88.  
  89. CALL FUSION(NPVOIS,NVOIS,NOEUD,NBENS)
  90. C on elimine ce NOEUD de la gestion de donnees de
  91. C ses voisins .
  92. C on rajoute a la gestion de donnees des voisins de NOEUD
  93. C tous les voisins de NOEUD qui ne leur sont pas deja
  94. C voisins et differents d'eux-memes.
  95. C dans MGD, on ne fait que rajouter;on n'elimine pas.
  96. C CALL MFUSIO(MPVOIS,MVOIS,NOEUD,NPVOIS,NVOIS,NBENS)
  97.  
  98. CALL DELIMI(NOEUD,NOERES)
  99. C on elimine NOEUD de NOERES.
  100.  
  101. COMPT=COMPT+1
  102. C COMPT correspond au nombre de noeuds elimines.
  103.  
  104.  
  105. IORDRE(NOEUD+NBENS)=COMPT
  106. IORDRE(COMPT)=NOEUD
  107. C IORDRE(NOEUD+NBENS)=ordre d'elimination de noeud.
  108. C = nouvelle numerotation.
  109. C IORDRE(NOEUD)=ancienne numerotation.
  110.  
  111. GOTO 100
  112. ENDIF
  113.  
  114. SEGINI IFILS,IFRERE
  115.  
  116. CALL IFILSF(MPVOIS,MVOIS,IORDRE,COMPT,IFILS,
  117. & IFRERE,RACINE,NBENS)
  118. C cree les liens de parente entre noeuds.
  119.  
  120. SEGSUP MPVOIS,MVOIS
  121. C suppression des segments inutiles.
  122.  
  123. CALL NUMO(IFILS,IFRERE,RACINE,IORDRE,NBENS)
  124. C renumerote les noeuds a partir des liens de parente.
  125.  
  126. SEGSUP NOERES,IFILS,IFRERE
  127. C suppression des segments.
  128.  
  129. RETURN
  130. END
  131.  
  132.  

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