Download delimi.eso

Back to the list

   1 : C DELIMI    SOURCE    CHAT      05/01/12    22:41:19     5004           
   2 : C**************************************************************************
   3 : C**************************************************************************
   4 : C****************************                   ***************************
   5 : c************************          ELIMINE          ***********************
   6 : c****************************                   ***************************
   7 : C**************************************************************************
   8 : C**************************************************************************
   9 : 
  10 : C       elimine NOEUD de NOERES.
  11 : 
  12 : 
  13 :         SUBROUTINE DELIMI(NOEUD,NOERES)
  14 : 
  15 : 
  16 :       IMPLICIT INTEGER(I-N)
  17 :         INTEGER NOEUD
  18 :         SEGMENT NOERES(0)
  19 : 
  20 :         LOGICAL BOOL
  21 : 
  22 :         BOOL=.FALSE.
  23 :         DO 100 J=1,NOERES(1)-1
  24 :            IF (NOEUD.EQ.NOERES(J+1)) BOOL=.TRUE.
  25 : 
  26 :            IF (BOOL)  NOERES(J+1)=NOERES(J+2)
  27 : C          a partir de la position(J+1) ou BOOL est vrai, on decale
  28 : C          tous les noeuds de position superieure.
  29 : C          on enleve ainsi NOEUD.
  30 : 
  31 : 
  32 : 100     CONTINUE
  33 :         IF (NOEUD.EQ.NOERES(NOERES(1)+1)) BOOL=.TRUE.
  34 : C       si NOEUD est a la derniere position de NOERES, on a bool=vrai.
  35 : 
  36 :         IF (BOOL) THEN
  37 :            NOERES(1)=NOERES(1)-1
  38 :         ENDIF
  39 : C       dans les cas ou bool est vrai, on desincremente la taille de
  40 : C       NOERES de 1.
  41 : 
  42 :         RETURN
  43 :         END
  44 :  

© Cast3M 2003 - All rights reserved.
Disclaimer