Télécharger la plaquette Cast3M


fr en

Télécharger ifilsf.eso

Retour à la liste

Numérotation des lignes : 

ifilsf

  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