Esope source files

   1 : C NUMO      SOURCE    CHAT      05/01/13    02:03:22     5004           
   2 : C**************************************************************************
   3 : C**************************************************************************
   4 : C****************************                   ***************************
   5 : c************************         NUMero         **************************
   6 : c****************************                   ***************************
   7 : C**************************************************************************
   8 : C**************************************************************************     
   9 : 
  10 :         
  11 : 
  12 : C       on renumerote les noeuds a partir de l'arborescence obtenue
  13 : C       par le biais de la subroutine IFILSFRE.
  14 : C       pour se faire, on se sert d'une pile, surlaquelle on empile ou depile.
  15 : 
  16 : 
  17 :         SUBROUTINE NUMO(IFILS,IFRERE,RACINE,IORDRE,NBENS)
  18 :       IMPLICIT INTEGER(I-N)
  19 :         
  20 :         INTEGER RACINE,NBENS
  21 :         SEGMENT IORDRE(0)
  22 :         SEGMENT IFRERE(0),IFILS(0)
  23 :         
  24 :         SEGMENT IPILE(NBENS+1)
  25 :         INTEGER EMPIL,DEPIL
  26 : 
  27 :         SEGINI IPILE
  28 :         N=NBENS
  29 : C       le nombre de noeuds a empiler est egal a NBENS.
  30 : 
  31 :         IPILE(1)=1
  32 :         IPILE(2)=RACINE
  33 : C       la taille de la pile est dans IPILE(1). 
  34 : C       le premier element de la pile est la RACINE.
  35 : 
  36 : 10      IF (N.NE.0) THEN
  37 : C       s'il reste des elements a empiler,
  38 :         
  39 : 50         EMPIL=IFRERE(IPILE(IPILE(1)+1))
  40 : C          on cherche, le frere du dernier element empile.
  41 : 
  42 :            IF (EMPIL.NE.0) THEN
  43 : C          s'il existe,
  44 :                 IPILE(1)=IPILE(1)+1
  45 :                 IPILE(IPILE(1)+1)=EMPIL
  46 : C               on l'empile dans la pile.
  47 :            GOTO 50
  48 : C          on recommence jusqu'a ne plus avoir de frere.
  49 :            ENDIF
  50 : 
  51 : 20         IF (N.EQ.0) GOTO 30
  52 : C          quand on a tout empile,on a fini.
  53 : 
  54 :            DEPIL=IPILE(IPILE(1)+1)
  55 :            IPILE(1)=IPILE(1)-1
  56 : C          au fur et a mesure qu'on empile,on depile
  57 : 
  58 : 
  59 :           IORDRE(DEPIL+NBENS)=N
  60 :           IORDRE(N)=DEPIL
  61 :           N=N-1
  62 : C         on numerote les noeuds depiles par ordre decroissant.
  63 : 
  64 :           IF(IFILS(DEPIL).NE.0)  THEN
  65 :              IPILE(1)=IPILE(1)+1
  66 :              IPILE(IPILE(1)+1)=IFILS(DEPIL)
  67 : C           si le noeud depile a un fils,
  68 : C           on empile ce fils a la position de son pere 
  69 : C           qui a ete depile.
  70 :           ELSE
  71 :            GOTO 20
  72 : C          sinon,on redepile.
  73 :           ENDIF
  74 : 
  75 :         GOTO 10
  76 :         ENDIF
  77 : 
  78 :         SEGSUP IPILE
  79 : C       suppression du segment de travail.
  80 : 
  81 : 30      RETURN
  82 :         END
  83 :