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