1 : C NOEPER SOURCE CHAT 05/01/13 01:58:03 5004 2 : C**************************************************************************** 3 : C**************************************************************************** 4 : C*************NOEPERI ..NOEuds PERIpheriques********************************* 5 : C**************************************************************************** 6 : C**************************************************************************** 7 : 8 : C NOEPERI part de PIVOT,lui associe l=1, associe l=l+1 a ses voisins directs, 9 : C repart des voisins directs pour associer un l a leur voisins.... 10 : C LONG=max(l). 11 : C NRELONG(I)=l ,NOELON contient les noeuds tels que l=LONG. 12 : 13 : 14 : 15 : 16 : SUBROUTINE NOEPER(IADJ,IVOIS,PIVOT,LONG,NRELONG,NOELON, 17 : *DIMLON,MASQUE,IPOS,NODES) 18 : 19 : 20 : IMPLICIT INTEGER(I-N) 21 : SEGMENT IADJ(0) 22 : SEGMENT IVOIS(0) 23 : 24 : INTEGER PIVOT,LONG,DIMLON,Y,X 25 : SEGMENT NRELONG(0),NOELON(0) 26 : 27 : SEGMENT IPOS(0) 28 : 29 : SEGMENT MASQUE 30 : LOGICAL MASQ(0) 31 : ENDSEGMENT 32 : 33 : INTEGER NODES 34 : 35 : 36 : SEGMENT NOEL2(NODES) 37 : INTEGER DIML2 38 : LOGICAL BOOL 39 : 40 : SEGINI NOEL2 41 : 42 : 43 : DO 5 I=1,NODES 44 : NRELONG(I)=0 45 : 5 CONTINUE 46 : 47 : 48 : BOOL=.FALSE. 49 : DIMLON=0 50 : LONG=1 51 : 52 : NRELONG(PIVOT)=LONG 53 : LONG=LONG+1 54 : 55 : 56 : DO 10 I=1,IADJ(PIVOT+1)-IADJ(PIVOT) 57 : Y=IVOIS(IADJ(PIVOT)+I-1) 58 : C Y:voisin de PIVOT. 59 : IF(Y.EQ.0) GOTO 10 60 : IF((NRELONG(Y).EQ.0).AND.(MASQ(Y))) THEN 61 : BOOL=.TRUE. 62 : DIMLON=DIMLON+1 63 : NOELON(DIMLON)=Y 64 : NRELONG(Y)=LONG 65 : ENDIF 66 : C pour chaque voisin Y de PIVOT, on determine sa profondeur. 67 : 10 CONTINUE 68 : C Tous les voisins Y de PIVOT non masques tels que RELONG(Y)=LONG 69 : C constituent NOELON. 70 : C DIMLON=dimension(NOELON) 71 : 72 : DIML2=DIMLON 73 : C on copie DIMLON dans DIML2. 74 : 75 : 20 IF(BOOL) THEN 76 : BOOL=.FALSE. 77 : DIMLON=DIML2 78 : DIML2=0 79 : LONG=LONG+1 80 : DO 30 I=1,DIMLON 81 : X=NOELON(I) 82 : DO 40 J=1,IADJ(X+1)-IADJ(X) 83 : Y=IVOIS(IADJ(X)+J-1) 84 : C Y: voisin d'un noeud de profondeur LONG-1. 85 : IF(Y.EQ.0) GOTO 40 86 : IF((NRELONG(Y).EQ.0).AND.(MASQ(Y))) THEN 87 : BOOL=.TRUE. 88 : DIML2=DIML2+1 89 : NOEL2(DIML2)=Y 90 : NRELONG(Y)=LONG 91 : ENDIF 92 : 40 CONTINUE 93 : 30 CONTINUE 94 : C On recherche les voisins de NOELON(I) pouvant avoir 95 : C une profondeur LONG. On les met dans NOEL2. 96 : 97 : 98 : DO 50 I=1,DIML2 99 : NOELON(I)=NOEL2(I) 100 : C On recopie NOEL2 dans NOELON. 101 : 50 CONTINUE 102 : 103 : GOTO 20 104 : C on s'arrete que si BOOL=.FALSE. 105 : ENDIF 106 : 107 : 108 : SEGSUP NOEL2 109 : C suppression du segment de travail. 110 : 111 : RETURN 112 : END 113 :
© Cast3M 2003 - All rights reserved.
Disclaimer