Télécharger la plaquette Cast3M


fr en

Télécharger numo.eso

Retour à la liste

Numérotation des lignes : 

numo

  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.  
  84.  

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