Esope source files

   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 :