Télécharger ifilsf.eso

Retour à la liste

Numérotation des lignes :

  1. C IFILSF SOURCE CHAT 05/01/13 00:32:54 5004
  2. C**************************************************************************
  3. C**************************************************************************
  4. C**************************** ***************************
  5. c************************ IFILSFRE ***********************
  6. c**************************** ***************************
  7. C**************************************************************************
  8. C**************************************************************************
  9. C IFILS FREres.
  10.  
  11. C cree une "arborescence" a partir de la racine, de gd,
  12. C de l'ordre d'elimination des noeuds.
  13.  
  14. SUBROUTINE IFILSF(MPVOIS,MVOIS,IORDRE,COMPT,
  15. * IFILS,IFRERE,RACINE,NBENS)
  16.  
  17.  
  18. IMPLICIT INTEGER(I-N)
  19.  
  20.  
  21. SEGMENT MPVOIS(0),MVOIS(0)
  22. SEGMENT IORDRE(0)
  23. INTEGER COMPT,RACINE
  24. SEGMENT IFILS(0),IFRERE(0)
  25.  
  26. LOGICAL B,B2,BOOL
  27. INTEGER NOEUD,R,PERE,Y,FILLE
  28. SEGMENT IENS(NBENS)
  29.  
  30.  
  31. SEGINI IENS
  32.  
  33. C construction de l'arbre
  34. DO 10 I=1,NBENS
  35. IFRERE(I)=0
  36. IFILS(I)=0
  37. 10 CONTINUE
  38. C chaque noeud n'a ni fils, ni frere.
  39.  
  40.  
  41.  
  42. RACINE=IORDRE(COMPT)
  43. C la racine est toujours le dernier noeud elimine
  44. C car il n'a pas de pere.
  45.  
  46.  
  47. DO 200 I=1,COMPT-1
  48.  
  49. NOEUD=IORDRE(I)
  50. C noeud est dans l'ancienne numerotation.
  51.  
  52.  
  53. L=0
  54. DO 220 J=MPVOIS(NOEUD),MPVOIS(NOEUD+NBENS)
  55.  
  56. B2=(IORDRE(MVOIS(J)+NBENS).GT.IORDRE(NOEUD+NBENS))
  57. C B2 est vrai si le voisin de NOEUD possede un nouveau
  58. C numero superieur au nouveau numero de NOEUD.
  59.  
  60. IF (B2) THEN
  61. L=L+1
  62. IENS(L)=MVOIS(J)
  63. C si b2 vrai, alors le voisin considere est un pere
  64. C possible.
  65. ENDIF
  66. 220 CONTINUE
  67.  
  68. PERE=IENS(1)
  69. C PERE est initialise a IENS(1)
  70.  
  71. DO 230 J=2,L
  72. B=(IORDRE(IENS(J)+NBENS).LT.IORDRE(PERE+NBENS))
  73. IF(B) PERE=IENS(J)
  74. C s'il existe un element de ens ayant un nouveau numero
  75. C inferieur a celui de pere alors il devient le veritable
  76. C pere(l'autre n'est qu'un grand pere).
  77. C pere est dans l'ancienne numerotation.
  78. 230 CONTINUE
  79.  
  80. FILLE=IFILS(PERE)
  81.  
  82. IF (FILLE.EQ.0) THEN
  83. C s'il n'existe pas d'autre fils de pere,alors
  84. C noeud n'a pas de frere.
  85. IFILS(PERE)=NOEUD
  86. IFRERE(NOEUD)=0
  87. ELSE
  88. C si pere a un autre fils que noeud,
  89. 240 IF(IFRERE(FILLE).EQ.0) THEN
  90. IFRERE(FILLE)=NOEUD
  91. C et si cet autre fils n'a pas de frere,noeud devient
  92. C ce frere.
  93. ELSE
  94. C sinon on prend le frere de cet autre fils du pere,
  95. C on recherche si lui-meme a un frere jusqu'a aboutir
  96. C a ne plus avoir de frere,et on met noeud a cette
  97. C position.
  98. FILLE=IFRERE(FILLE)
  99. GOTO 240
  100. ENDIF
  101. ENDIF
  102.  
  103. 200 CONTINUE
  104.  
  105. SEGSUP IENS
  106.  
  107.  
  108. RETURN
  109. END
  110.  
  111.  

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