C NOEPER SOURCE CHAT 05/01/13 01:58:03 5004 C**************************************************************************** C**************************************************************************** C*************NOEPERI ..NOEuds PERIpheriques********************************* C**************************************************************************** C**************************************************************************** C NOEPERI part de PIVOT,lui associe l=1, associe l=l+1 a ses voisins directs, C repart des voisins directs pour associer un l a leur voisins.... C LONG=max(l). C NRELONG(I)=l ,NOELON contient les noeuds tels que l=LONG. SUBROUTINE NOEPER(IADJ,IVOIS,PIVOT,LONG,NRELONG,NOELON, *DIMLON,MASQUE,IPOS,NODES) IMPLICIT INTEGER(I-N) SEGMENT IADJ(0) SEGMENT IVOIS(0) INTEGER PIVOT,LONG,DIMLON,Y,X SEGMENT NRELONG(0),NOELON(0) SEGMENT IPOS(0) SEGMENT MASQUE LOGICAL MASQ(0) ENDSEGMENT INTEGER NODES SEGMENT NOEL2(NODES) INTEGER DIML2 LOGICAL BOOL SEGINI NOEL2 DO 5 I=1,NODES NRELONG(I)=0 5 CONTINUE BOOL=.FALSE. DIMLON=0 LONG=1 NRELONG(PIVOT)=LONG LONG=LONG+1 DO 10 I=1,IADJ(PIVOT+1)-IADJ(PIVOT) Y=IVOIS(IADJ(PIVOT)+I-1) C Y:voisin de PIVOT. IF(Y.EQ.0) GOTO 10 IF((NRELONG(Y).EQ.0).AND.(MASQ(Y))) THEN BOOL=.TRUE. DIMLON=DIMLON+1 NOELON(DIMLON)=Y NRELONG(Y)=LONG ENDIF C pour chaque voisin Y de PIVOT, on determine sa profondeur. 10 CONTINUE C Tous les voisins Y de PIVOT non masques tels que RELONG(Y)=LONG C constituent NOELON. C DIMLON=dimension(NOELON) DIML2=DIMLON C on copie DIMLON dans DIML2. 20 IF(BOOL) THEN BOOL=.FALSE. DIMLON=DIML2 DIML2=0 LONG=LONG+1 DO 30 I=1,DIMLON X=NOELON(I) DO 40 J=1,IADJ(X+1)-IADJ(X) Y=IVOIS(IADJ(X)+J-1) C Y: voisin d'un noeud de profondeur LONG-1. IF(Y.EQ.0) GOTO 40 IF((NRELONG(Y).EQ.0).AND.(MASQ(Y))) THEN BOOL=.TRUE. DIML2=DIML2+1 NOEL2(DIML2)=Y NRELONG(Y)=LONG ENDIF 40 CONTINUE 30 CONTINUE C On recherche les voisins de NOELON(I) pouvant avoir C une profondeur LONG. On les met dans NOEL2. DO 50 I=1,DIML2 NOELON(I)=NOEL2(I) C On recopie NOEL2 dans NOELON. 50 CONTINUE GOTO 20 C on s'arrete que si BOOL=.FALSE. ENDIF SEGSUP NOEL2 C suppression du segment de travail. RETURN END