1 : C PART2 SOURCE PV 09/03/27 21:15:11 6347 2 : C partition de domaine 3 : C 4 : C methode utilisee: Monte Carlo avec fonction de cout 5 : C dérivé de numop2 6 : C 7 : SUBROUTINE PART2(MELEME,IPOS,NB,ICPR,IADJ,JADJC) 8 : IMPLICIT INTEGER(I-N) 9 : -INC SMELEME 10 : -INC SMCOORD 11 : -INC CCOPTIO 12 : -INC CCASSIS 13 : 14 : 15 : SEGMENT JMEM(NODES+1),JMEMN(NODES+1) 16 : C JMEM et JMEMN contiennent le nombre d'element auquel appartient un noeud 17 : 18 : SEGMENT JNT(NODES) 19 : C JNT contient la nouvelle numerotation 20 : 21 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 22 : C ICPR au debut contient l'ancienne numerotation , 23 : C a la fin la nouvelle. 24 : 25 : SEGMENT IADJ(NODES+1) 26 : SEGMENT JADJC(0) 27 : C IADJ(i) pointe sur JADJC qui contient les voisins de i entre 28 : C IADJ(i) et IADJ(i+1)-1 29 : 30 : SEGMENT BOOLEEN 31 : LOGICAL BOOL(NODES) 32 : ENDSEGMENT 33 : C BOOL(i) = true si le noeud i a ete deja mentionne dans la liste 34 : C des voisins JADJC. 35 : 36 : SEGMENT IMEMOIR(NBV),LMEMOIR(NBV) 37 : C contient les elements appartenant a chaque noeud,sous forme de liste. 38 : 39 : INTEGER ELEM 40 : C nom d'un element 41 : 42 : INTEGER N 43 : 44 : 45 : SEGMENT MASQUE 46 : LOGICAL MASQ(NODES) 47 : ENDSEGMENT 48 : C MASQ(X)=.TRUE. si le noeud X n'a pas ete renumerote; 49 : C .FALSE. si il l'a ete. 50 : 51 : INTEGER DIM,DIMSEP 52 : C DIM= nombre de noeuds renumerotes. 53 : 54 : INTEGER PIVOT 55 : C PIVOT est le noeud utile a la division du domaine. 56 : 57 : SEGMENT IPOS(NODES*3) 58 : C est le vecteur contenant le numero de zone et le poid de la zone a NODES 59 : C puis de NODES+1 a 2* NODES, cf la subroutine SEPAR 60 : C 61 : C segments utilisés dans sepa2 62 : C 63 : SEGMENT NRELONG(NODES*nbthr) 64 : C NRELONG contient pour chaque noeud sa profondeur. 65 : 66 : SEGMENT NOELON(NODES*nbthr) 67 : SEGMENT NOEL2(NODES) 68 : SEGMENT LONDIM(NODES*nbthr) 69 : C NOELON contient les noeuds de profondeur LONG. 70 : C DIMLON= dimension de NOELON. 71 : c 72 : C********************************** 73 : 74 : C debut du program 75 : 76 : C********************************** 77 : 78 : 79 : 80 : C initialisation 81 : C******************************* 82 : IENORM=2000000000 83 : C norme d'erreur 84 : SEGINI ICPR 85 : NODES=ICPR(/1) 86 : SEGACT MELEME 87 : C icpr: numero des noeuds. 88 : 89 : IPT1=MELEME 90 : IKOU=0 91 : NBV=0 92 : NB1=0 93 : NB2=0 94 : 95 : DO 100 IO=1,MAX(1,LISOUS(/1)) 96 : IF (LISOUS(/1).GT.0) THEN 97 : IPT1=LISOUS(IO) 98 : SEGACT IPT1 99 : ENDIF 100 : C on cree la numerotation des noeuds. 101 : C 'nb noeuds/element'=IPT1.NUM(/1) 102 : C 'nb element'=IPT1.NUM(/2) 103 : IF(IPT1.ITYPEL.EQ.22) THEN 104 : NB1=NB1+IPT1.NUM(/2) 105 : NB2=MAX(NB2,IPT1.NUM(/1)) 106 : C NB1= nbre d'éléments de type 22. 107 : C NB2=nbre de noeuds/élément maximum parmi 108 : C les éléments de type 22. 109 : ENDIF 110 : DO 150 J=1,IPT1.NUM(/2) 111 : DO 150 I=1,IPT1.NUM(/1) 112 : IJ=IPT1.NUM(I,J) 113 : C IJ est le Ième noeud du Jème élément. 114 : IF (ICPR(IJ).EQ.0) THEN 115 : C s'il est déjà numéroté, on ne fait rien. 116 : IKOU=IKOU+1 117 : ICPR(IJ)=IKOU 118 : ENDIF 119 : 150 CONTINUE 120 : 100 CONTINUE 121 : 122 : NODES=IKOU 123 : 124 : C***** initalisation des segments********* 125 : 126 : SEGINI IADJ,JADJC,JMEM,JMEMN 127 : SEGINI BOOLEEN,JNT 128 : 129 : DO 20 I=1,NODES+1 130 : IADJ(I)=0 131 : JMEM(I)=0 132 : JMEMN(I)=0 133 : 20 CONTINUE 134 : 135 : C****************************************** 136 : 137 : IPT1=MELEME 138 : NGRAND=0 139 : IADJ(1)=1 140 : INC=0 141 : DO 200 IO=1,MAX(1,LISOUS(/1)) 142 : 143 : IF (LISOUS(/1).NE.0) THEN 144 : IPT1=LISOUS(IO) 145 : ENDIF 146 : 147 : DO 210 J=1,IPT1.NUM(/2) 148 : 149 : DO 230 I=1,IPT1.NUM(/1) 150 : IJ=ICPR(IPT1.NUM(I,J))+1 151 : JMEM(IJ)=JMEM(IJ)+1 152 : C JMEM(I+1): nb elements auquel le noeud I appartient 153 : 230 CONTINUE 154 : 210 CONTINUE 155 : NGRAND=MAX(NGRAND,IPT1.NUM(/2)) 156 : 157 : 200 CONTINUE 158 : 159 : NGRAND=NGRAND+1 160 : 161 : JMEM(1)=1 162 : DO 30 I=1,NODES 163 : JMEM(I+1)=JMEM(I)+JMEM(I+1) 164 : C JMEM(I+1)=indice de depart des elements 165 : C auxquels le noeud I appartient. 166 : 30 CONTINUE 167 : NBV=JMEM(NODES+1) 168 : C NBV= dimension de IMEMOIR. 169 : SEGINI IMEMOIR,LMEMOIR 170 : 171 : 172 : 173 : IPT1=MELEME 174 : 175 : DO 300 IO=1,MAX(1,LISOUS(/1)) 176 : IF (LISOUS(/1).NE.0) THEN 177 : IPT1=LISOUS(IO) 178 : ENDIF 179 : DO 350 J=1,IPT1.NUM(/2) 180 : DO 350 I=1,IPT1.NUM(/1) 181 : IJ=ICPR(IPT1.NUM(I,J)) 182 : JMEMN(IJ+1)=JMEMN(IJ+1)+1 183 : IMEMOIR(JMEM(IJ)+JMEMN(IJ+1)-1)=J 184 : LMEMOIR(JMEM(IJ)+JMEMN(IJ+1)-1)=IO 185 : C on range dans IMEMOIR tous les elements des sous-objets 186 : C IO auxquels appartient le noeud ICPR(IPT1.NUM(I,J)). 187 : C On connait pour chaque element, le sous-objet auquel 188 : C il appartient. 189 : 350 CONTINUE 190 : 300 CONTINUE 191 : 192 : DO 410 J=1,NODES 193 : BOOL(J)=.FALSE. 194 : 410 CONTINUE 195 : DO 400 I=1,NODES 196 : IADJ(I+1)=IADJ(I) 197 : DO 420 J=JMEM(I),JMEM(I+1)-1 198 : ELEM=IMEMOIR(J) 199 : C ELEM=element auquel appartient le noeud I. 200 : 201 : IPT1=MELEME 202 : IF (LISOUS(/1).NE.0) IPT1=LISOUS(LMEMOIR(J)) 203 : DO 430 K=1,IPT1.NUM(/1) 204 : C k representatif du nb de noeuds par elements. 205 : IK=ICPR(IPT1.NUM(K,ELEM)) 206 : IF ((I.NE.IK).AND. 207 : & (.NOT.(BOOL(IK)))) THEN 208 : C si i n'est pas egal a un des nouveaux numeros des noeuds 209 : C de l'element ELEM et si il n'appartient pas deja a l'ens des 210 : C voisins du noeud i(jadjc(i)),alors on le rajoute. 211 : C JADJC(IADJ(I+1))=IK 212 : JADJC(**)=IK 213 : IADJ(I+1)=IADJ(I+1)+1 214 : BOOL(IK)=.TRUE. 215 : ENDIF 216 : 430 CONTINUE 217 : 420 CONTINUE 218 : * remise a faux de bool 219 : DO 412 J=IADJ(I),IADJ(I+1)-1 220 : IK=JADJC(J) 221 : BOOL(IK)=.FALSE. 222 : 412 CONTINUE 223 : 400 CONTINUE 224 : 225 : SEGSUP JMEM,JMEMN,IMEMOIR,LMEMOIR,BOOLEEN 226 : 227 : 228 : 229 : C************************************************************************** 230 : 231 : 232 : C affectation 233 : C************************ 234 : 235 : 236 : SEGINI IPOS,MASQUE 237 : IPOSMAX=0 238 : 239 : DO 50 I=1,NODES 240 : MASQ(I)=.TRUE. 241 : IPOS(I)=0 242 : IPOS(NODES+I)=0 243 : IPOS(2*NODES+I)=0 244 : 50 CONTINUE 245 : C initialement, les noeuds ne sont pas masques,ont donc 246 : C une position nulle. 247 : 248 : DIM=0 249 : C le nombre de noeuds renumerotes DIM est initialement egal a zero. 250 : 251 : 252 : C **************************************** 253 : C boucle principale 254 : NS=NODES 255 : 256 : nbthr=max(1,nbesc) 257 : nbthr=min(64,nbesc) 257 : if (nbthr.gt.1) call threadii 258 : SEGINI NRELONG,NOELON,noel2,londim 259 : ** write (6,*) ' avant appel sepa2 ' 260 : DO 500 I=1,NODES 261 : 550 IF (ipos(i+2*nodes).eq.nb) masq(i)=.false. 262 : ** write (6,*) ' part2 i ipos nb ',i,ipos(i+2*nodes),nb 263 : IF(.NOT.MASQ(I)) GOTO 500 264 : C si le noeud est masque alors ne rien faire: il est deja 265 : C renumerote. On passe au noeud suivant. 266 : 267 : PIVOT=I 268 : 268 : CALL SEPA2(IADJ,JADJC,PIVOT,MASQUE,DIMSEP,NS, 269 : > IPOS,NODES,IPOSMAX,nrelong,noelon,noel2, 270 : > londim,nbthr) 271 : C separe le domaine d'etude en 2 parties. 272 : C on decrit le domaine d'etude a partir du pivot et on cherche la 273 : C longueur maximale en decrivant les voisins de pivot, et leurs 274 : C voisins... jusqu'a rencontrer un voisin masque. On cree alors 275 : C une nouvelle separation. 276 : C les noeuds masques delimitent la separation du domaine. 277 : do ii=1,nodes 278 : IF (ipos(ii+2*nodes).eq.nb) masq(ii)=.false. 279 : enddo 280 : 281 : DIM=DIM+DIMSEP 282 : NS=NS-DIMSEP 283 : C la dimension de noeuds renumerotes est augmente de DIMSEP. 284 : C Celle de noeuds a renumeroter est diminue de DIMSEP. 285 : 286 : ***** IF (DIM.GE.NODES) GOTO 600 287 : C si tous les noeuds ont ete renumerotes, on arrete. 288 : 289 : GOTO 550 290 : 291 : 500 CONTINUE 292 : ** write (6,*) ' apres appel sepa2 ' 293 : 294 : SEGSUP NRELONG,NOELON,noel2,londim 294 : if (nbthr.gt.1) call threadis 295 : 296 : 297 : 600 SEGSUP MASQUE 298 : * 298 : * CALL SORTI2(IPOS,JNT,NODES) 299 : ** write (6,*) ' apres sorti2 ' 300 : 301 : SEGSUP JNT 302 : 303 : 304 : RETURN 305 : END 306 : 307 : 308 : 309 : 310 : 311 : 312 : 313 : 314 : 315 : 316 : 317 :
© Cast3M 2003 - All rights reserved.
Disclaimer