1 : C TIRET3 SOURCE FANDEUR 13/01/16 21:15:26 7666 2 : C NOUVELLE VERSION DE TIRET 3 : C LA BOUCLE SE FAIT SUR LES ELEMENTS ET NON PLUS SUR LES NOEUDS 4 : C CETTE VERSION EST ADAPTEE A GIBI 5 : C 6 : SUBROUTINE TIRET3(XPROJ,MELEME,ICPR,XMIN,XMAX,YMIN,YMAX,IVU,NELEM, 7 : # TMIN,TMAX,MCOUP) 8 : C NUMNP NOMBRE DE POINTS A TRACER 9 : C NBELEM NOMBRE D'ELEMENTS DANS L'OBJET ELEMENTAIRE 10 : C MCOUP <>0 => COUPE LA PLAN DE COUPE EST DANS LA DERNIERE 11 : C COMPOSANTE DE MELEME ET SES NOEUDS SONT VUS 12 : IMPLICIT INTEGER(I-N) 13 : C 14 : C TABLEAUX : KTR TRIANGLES PAR ELEMENTS 15 : C KTL NOMBRE DE TRIANGLES PAR ELEM 16 : C NPZON ZONE A LAQUELLE APPARTIENT UN POINT 17 : C INDZON POINTEUR SUR NPOIN 18 : C NPOIN TABLEAU DES POINTS CLASSES 19 : C IVU TABLEAU VU PAS VU (POINT) 20 : C 21 : C----------------------------------------------------------------------- 22 : C 23 : C SEGMENTS 24 : C 25 : SEGMENT/XPROJ/(X(3,ITE)) 26 : SEGMENT IVU(NUMNP) 27 : SEGMENT ICPR(0) 28 : SEGMENT/TRAV/(NTAUX(NUMNP),INDZON(NUMNP+2),NPZON(NUMNP+2), 29 : # IJK(NUMNP+2),NPOIN(NUMNP+2)) 30 : SEGMENT MCOUP(0) 31 : C 32 : C----------------------------------------------------------------------- 33 : -INC CCOPTIO 34 : -INC CCGEOME 35 : -INC CCREEL 36 : *- 37 : -INC SMELEME 38 : NMULT=3 39 : SEGACT ICPR 40 : NUMNP=X(/2) 41 : NUPLUS=NUMNP+1 41 : * CALL LIRENT(NMULT,0,IRETOU) GENANT EN FULLSCREEN 42 : * IF (IRETOU.EQ.1) NMULT=MAX(1,NMULT) 43 : SEGINI TRAV 44 : C INITIALISATION DE L'HORLOGE 45 : XDIST=XMAX-XMIN 46 : YDIST=YMAX-YMIN 47 : SMO=1E-5*XDIST*YDIST/NUMNP 48 : SMA=1E-5*(XDIST*YDIST/NUMNP)**1.5 49 : C CALCUL DU DECOUPAGE EN ZONE 50 : NBZONE=NUMNP*NMULT 51 : RAP=YDIST/XDIST 52 : NDEC=MAX(INT(SQRT(REAL(NBZONE)/RAP)),1) 53 : MDEC=NBZONE/NDEC 54 : NBZONE=NDEC*MDEC 55 : IF (IIMPI.NE.0) WRITE (IOIMP,8933) NDEC,MDEC,NBZONE 56 : 8933 FORMAT(' DECOUPAGE EN X ',I6,' EN Y ',I6,' SOIT ',I8,'ZONES ') 57 : XDEC=XDIST/NDEC*1.00001 58 : YDEC=YDIST/MDEC*1.00001 59 : IF (IIMPI.NE.0) WRITE (IOIMP,8935) XMIN,XMAX,YMIN,YMAX,XDEC,YDEC 60 : 8935 FORMAT (' XMIN,XMAX,YMIN,YMAX,XDEC,YDEC ',6G12.5) 61 : C CLASSEMENT DES POINTS 62 : DO 40 I=1,NUPLUS+1 63 : INDZON(I)=0 64 : 40 IJK(I)=0 65 : DO 2 I=1,NUMNP 66 : IZONE=INT(real((X(1,I)-XMIN)/XDEC))+1+ 67 : & INT(real((X(2,I)-YMIN)/YDEC))*NDEC 68 : NTAUX(I)=IZONE 69 : IPOINT=IZONE/NMULT+1 70 : INDZON(IPOINT)=INDZON(IPOINT)+1 71 : 2 CONTINUE 72 : C INDZON= NB DE POINTS PAR SUPER-ZONE DE CLASSEMENT 73 : DO 4 I=2,NUPLUS 74 : 4 INDZON(I)=INDZON(I-1)+INDZON(I) 75 : C INDZON(I)=FIN DE SUPER-ZONE I 76 : C RANGEMENT DES POINTS PAR SUPER-ZONE 77 : NBPOIN=INDZON(NUPLUS) 78 : INDZON(NUPLUS+1)=NBPOIN 79 : DO 5 I=1,NUMNP 80 : IZONE=NTAUX(I) 81 : IPOINT=IZONE/NMULT+1 82 : IAD=INDZON(IPOINT) 83 : NPZON(IAD)=I 84 : INDZON(IPOINT)=IAD-1 85 : 5 CONTINUE 86 : C TRI DANS CHAQUE SUPER-ZONE 87 : C INDZON(I+1) EST DEVENU LA FIN DE SUPER-ZONE I 88 : DO 6 I=1,NUPLUS 89 : IDEB=INDZON(I)+1 90 : IFIN=INDZON(I+1) 91 : IF (IDEB.GT.IFIN) GOTO 6 92 : C IL FAUT ORDONNER NPZON SUIVANT NTAUX ET METTRE LE RESULTAT DANS NPOIN 93 : IJK(1)=IDEB 94 : IJK(2)=IFIN 95 : IZ=2 96 : 8 IZ=IZ-1 97 : IF (IZ.LE.0) GOTO 9 98 : IPB=IJK(IZ*2-1) 99 : IPH=IJK(IZ*2) 100 : IF (IPB.GE.IPH) GOTO 8 101 : JPB=IPB-1 102 : JPH=IPH+1 103 : C CALCUL DU PIVOT 104 : IPV=0 105 : DO 7 J=IPB,IPH 106 : IPV=IPV+NTAUX(NPZON(J)) 107 : 7 CONTINUE 108 : IPV=IPV/(IPH-IPB+1) 109 : 42 JPB=JPB+1 110 : IF (JPH.EQ.JPB) GOTO 45 111 : IF (NTAUX(NPZON(JPB)).GE.IPV) GOTO 43 112 : GOTO 42 113 : 43 JPH=JPH-1 114 : IF (JPH.EQ.JPB) GOTO 45 115 : IF (NTAUX(NPZON(JPH)).LE.IPV) GOTO 44 116 : GOTO 43 117 : 44 IAUX=NPZON(JPB) 118 : C CORRECTION JPH AU LIEU DE IPH 119 : NPZON(JPB)=NPZON(JPH) 120 : NPZON(JPH)=IAUX 121 : GOTO 42 122 : C JPH=JPB MAIS ATTENTION PEUT ETRE A L'EXTERIEUR 123 : 45 IF (JPB.GE.IPB) GOTO 47 124 : JPB=JPB+1 125 : JPH=JPH+2 126 : GOTO 48 127 : 47 IF (JPH.LE.IPH) GOTO 49 128 : JPB=JPB-2 129 : JPH=JPH-1 130 : GOTO 48 131 : 49 IF (NTAUX(NPZON(JPB)).GE.IPV) GOTO 50 132 : IF (JPH.EQ.IPH) GOTO 51 133 : 52 JPH=JPH+1 134 : GOTO 48 135 : 50 IF (JPB.EQ.IPB) GOTO 52 136 : 51 JPB=JPB-1 137 : 48 IF (JPB.EQ.IPB) GOTO 53 138 : IJK(2*IZ)=JPB 139 : IZ=IZ+1 140 : 53 IF (JPH.EQ.IPH) GOTO 8 141 : IJK(2*IZ)=IPH 142 : IJK(2*IZ-1)=JPH 143 : IZ=IZ+1 144 : GOTO 8 145 : 9 CONTINUE 146 : DO 46 J=IDEB,IFIN 147 : NPOIN(J)=NPZON(J) 148 : 46 CONTINUE 149 : 6 CONTINUE 150 : C REMPLISSAGE DE NPZON 151 : DO 41 I=1,NUMNP 152 : 41 NPZON(I)=NTAUX(NPOIN(I)) 153 : C# TMIN=XGRAND 154 : TMIN=XSGRAN 155 : TMAX=0. 156 : DO 30 I=1,NUMNP 157 : TMIN=MIN(TMIN,X(3,I)) 158 : TMAX=MAX(TMAX,X(3,I)) 159 : 30 CONTINUE 160 : TDIST=(TMAX-TMIN)/NUMNP*1.00001 161 : C ATTENTION PAS DE CLASSEMENT DES ELEMENTS SELON LA DISTANCE 162 : C REMPLISSAGE DE INDZON 163 : NBZOR=NBZONE/NMULT+1 164 : DO 23 I=1,NBZOR+1 165 : 23 INDZON(I)=0 166 : DO 21 I=1,NUMNP 167 : NPOS=NPZON(I)/NMULT+1 168 : IF (INDZON(NPOS).EQ.0) INDZON(NPOS)=I 169 : 21 CONTINUE 170 : INDZON(NBZOR+1)=NUMNP 171 : DO 35 I=1,NBZOR 172 : II=NBZOR+1-I 173 : IF (INDZON(II).EQ.0) INDZON(II)=INDZON(II+1) 174 : 35 CONTINUE 175 : C ON COMPTE LES ELEMENTS 176 : NELEM=0 177 : IPT1=MELEME 178 : SEGACT MELEME 179 : DO 3101 IOB=1,MAX(1,LISOUS(/1)) 180 : IF (LISOUS(/1).NE.0) THEN 181 : IPT1=LISOUS(IOB) 182 : SEGACT IPT1 183 : ENDIF 184 : NELEM=NELEM+IPT1.NUM(/2) 185 : 3101 CONTINUE 186 : C MODIF JUIN 1986 IVU=2 POUR LES POINTS DU PLAN DE COUPE (NON CACHABLE 187 : IF (MCOUP.NE.0) THEN 188 : IPT1=LISOUS(LISOUS(/1)) 189 : DO 3200 IEL=1,IPT1.NUM(/2) 190 : IF (MOD(MCOUP(IEL)/8,2).EQ.0) GOTO 3200 191 : DO 3201 JNN=1,IPT1.NUM(/1) 192 : IVU(ICPR(IPT1.NUM(JNN,IEL)))=2 193 : 3201 CONTINUE 194 : 3200 CONTINUE 195 : ENDIF 196 : C 197 : C FIN DES PREPARATIFS 198 : C MAINTENANT ON PEUT TRAVAILLER 199 : C ON BOUCLE SUR LES ELEMENTS EN CACHANT TOUT CE QUI DOIT ETRE CACHE 200 : C 201 : C ON TRAVAILLE PAR OBJET ELEMENTAIRE 202 : IPT1=MELEME 203 : DO 3001 IOB=1,MAX(1,LISOUS(/1)) 204 : IF (LISOUS(/1).NE.0) IPT1=LISOUS(IOB) 205 : SEGACT IPT1 206 : IF (KSURF(IPT1.ITYPEL).EQ.0) GOTO 3004 207 : NBELEM=IPT1.NUM(/2) 208 : NBNN=IPT1.NUM(/1) 209 : NBFAC=LTEL(1,IPT1.ITYPEL) 210 : IAD=LTEL(2,IPT1.ITYPEL)-1 211 : IF (NBFAC.EQ.0) GOTO 3004 212 : DO 101 IFAC=1,NBFAC 213 : ITYP=LDEL(1,IAD+IFAC) 214 : NPFAC=KDFAC(1,ITYP) 215 : JAD=LDEL(2,IAD+IFAC)-1 216 : IDEP=KDFAC(2,ITYP) 217 : IFEP=IDEP+3*(KDFAC(3,ITYP)-1) 218 : DO 101 ITRIAN=IDEP,IFEP,3 219 : IAFA=LFAC(JAD+KFAC(ITRIAN)) 220 : IBFA=LFAC(JAD+KFAC(ITRIAN+1)) 221 : ICFA=LFAC(JAD+KFAC(ITRIAN+2)) 222 : DO 110 IEL=1,NBELEM 223 : IA=ICPR(IPT1.NUM(IAFA,IEL)) 224 : IB=ICPR(IPT1.NUM(IBFA,IEL)) 225 : IC=ICPR(IPT1.NUM(ICFA,IEL)) 226 : IF (IVU(IA).LT.1.AND.IVU(IB).LT.1.AND.IVU(IC).LT.1) GOTO 110 227 : XA=X(1,IA) 228 : XB=X(1,IB) 229 : XC=X(1,IC) 230 : YA=X(2,IA) 231 : YB=X(2,IB) 232 : YC=X(2,IC) 233 : IZA=INT(real((XA-XMIN)/XDEC))+1+INT(real((YA-YMIN)/YDEC))*NDEC 234 : IZB=INT(real((XB-XMIN)/XDEC))+1+INT(real((YB-YMIN)/YDEC))*NDEC 235 : IZC=INT(real((XC-XMIN)/XDEC))+1+INT((real(YC-YMIN)/YDEC))*NDEC 236 : ZA=X(3,IA) 237 : ZB=X(3,IB) 238 : ZC=X(3,IC) 239 : DISTLI=MIN(ZA,ZB,ZC) 240 : DISTLS=MAX(ZA,ZB,ZC) 241 : C DECOUPONS LE TRIANGLE IA,IB,IC EN BANDELETTES DE ZONES 242 : IRETO = 0 243 : C CLASSEMENT DE A B C 244 : IF (IZA.LE.IZB) GOTO 200 245 : IAUX=IZA 246 : IZA=IZB 247 : IZB=IAUX 248 : IAUX=IA 249 : IA=IB 250 : IB=IAUX 251 : 200 IF(IZA.LE.IZC) GOTO 201 252 : IAUX=IZA 253 : IZA=IZC 254 : IZC=IAUX 255 : IAUX=IA 256 : IA=IC 257 : IC=IAUX 258 : C IA EST LE POINT LE PLUS BAS 259 : 201 MIA=(IZA-1)/NDEC 260 : NIA=IZA-MIA*NDEC 261 : MIB=(IZB-1)/NDEC 262 : NIB=IZB-MIB*NDEC 263 : MIC=(IZC-1)/NDEC 264 : NIC=IZC-MIC*NDEC 265 : IF (MIA.EQ.MIB) GOTO 300 266 : IF (MIA.NE.MIC) GOTO 202 267 : IAUX=IZB 268 : IZB=IZC 269 : IZC=IAUX 270 : IAUX=IB 271 : IB=IC 272 : IC=IAUX 273 : IAUX=MIC 274 : MIC=MIB 275 : MIB=IAUX 276 : IAUX=NIC 277 : NIC=NIB 278 : NIB=IAUX 279 : GOTO 300 280 : C AUCUN POINT N'EST DANS LA MEME BANDE QUE A 281 : 202 PENTB=REAL(NIA-NIB)/REAL(MIA-MIB) 282 : PENTC=REAL(NIA-NIC)/REAL(MIA-MIC) 283 : IF (PENTC.GT.PENTB) GOTO 203 284 : IAUX=IB 285 : IB=IC 286 : IC=IAUX 287 : IAUX=NIB 288 : NIB=NIC 289 : NIC=IAUX 290 : IAUX=MIB 291 : MIB=MIC 292 : MIC=IAUX 293 : AUX=PENTB 294 : PENTB=PENTC 295 : PENTC=AUX 296 : C IB EST MAITENANT LE POINT DE GAUCHE 297 : 203 IBAND=MIA-1 298 : ISTEP=0 299 : IFINB=MAX(MIB,MIC) 300 : NP=MIN(NIA,NIB) 301 : NG=MAX(NIA,NIC) 302 : NMP=MIN(NIB,NIC) 303 : NMG=MAX(NIB,NIC) 304 : IRETO = 1 305 : C* ASSIGN 205 TO IRETO <- DELETED 306 : IF (MIB.EQ.MIC) GOTO 205 307 : PENTA=REAL(NIB-NIC)/REAL(MIB-MIC) 308 : 205 IBAND=IBAND+1 309 : IF(IBAND.GT.IFINB) GOTO 400 310 : IF (IBAND.GT.MIB) GOTO 210 311 : PZ=NIA+PENTB*REAL(IBAND-MIA) 312 : IZD=INT(PZ-ABS(PENTB)) 313 : IZD1=INT(PZ+1+ABS(PENTB)) 314 : IZD=MAX(IZD,NP) 315 : IF (IBAND.EQ.MIB.AND.ISTEP.EQ.0) GOTO 210 316 : 220 IF (IBAND.GT.MIC) GOTO 211 317 : PZ=NIA+PENTC*REAL(IBAND-MIA) 318 : IZF=INT(PZ+1+ABS(PENTC)) 319 : IZF1=INT(PZ-ABS(PENTC)) 320 : IZF=MIN(IZF,NG) 321 : IF (IBAND.EQ.MIC.AND.ISTEP.EQ.0) GOTO 211 322 : GOTO 1000 323 : 231 CONTINUE 324 : PZ=NIA+PENTC*REAL(IBAND-MIA) 325 : IZF=INT(PZ+1+ABS(PENTC)) 326 : IZF=MIN(IZF,NG) 327 : GOTO 230 328 : 210 IF (IBAND.EQ.MIC.AND.ISTEP.EQ.0) GOTO 231 329 : ISTEP=1 330 : PZ=NIB+PENTA*REAL(IBAND-MIB) 331 : IZD1S=INT(PZ+1+ABS(PENTA)) 332 : IZDS=INT(PZ-ABS(PENTA)) 333 : IZDS=MAX(IZDS,NMP) 334 : IF (IBAND.EQ.MIB) IZDS=MIN(IZD,IZDS) 335 : IF (IBAND.EQ.MIB) IZD1S=MAX(IZD1S,IZD1) 336 : IZD=IZDS 337 : IZD1=IZD1S 338 : GOTO 220 339 : 211 ISTEP=1 340 : PZ=NIB+PENTA*REAL(IBAND-MIB) 341 : IZFS=INT(PZ+1+ABS(PENTA)) 342 : IZFS=MIN(IZFS,NMG) 343 : IZF1S=INT(PZ-ABS(PENTA)) 344 : IF (IBAND.EQ.MIC) IZFS=MAX(IZF,IZFS) 345 : IF (IBAND.EQ.MIC) IZF1S=MIN(IZF1,IZF1S) 346 : IZF=IZFS 347 : IZF1=IZF1S 348 : GOTO 1000 349 : 230 IZD1=IZF 350 : IZF1=IZD 351 : IRETO = 2 352 : C* ASSIGN 400 TO IRETO <- DELETED 353 : GOTO 1000 354 : 300 IBAND=MIA-1 355 : IF (MIA.EQ.MIC) GOTO 311 356 : PENTA=REAL(NIA-NIC)/REAL(MIA-MIC) 357 : PENTB=REAL(NIB-NIC)/REAL(MIB-MIC) 358 : IRETO = 3 359 : C* ASSIGN 301 TO IRETO <- DELETED 360 : NP=MIN(NIA,NIC) 361 : NG=MAX(NIB,NIC) 362 : 301 IBAND=IBAND+1 363 : IF (IBAND.GT.MIC) GOTO 400 364 : PZ=NIA+PENTA*REAL(IBAND-MIA) 365 : IZD=INT(PZ-ABS(PENTA)) 366 : IZD1=INT(PZ+1+ABS(PENTA)) 367 : IZD=MAX(NP,IZD) 368 : PZ=NIB+PENTB*REAL(IBAND-MIB) 369 : IZF=INT(PZ+1+ABS(PENTB)) 370 : IZF=MIN(NG,IZF) 371 : IZF1=INT(PZ-ABS(PENTB)) 372 : IF (IBAND.EQ.MIA) GOTO 410 373 : GOTO 1000 374 : 410 IZD1=IZF 375 : IZF1=IZD 376 : GOTO 1000 377 : 311 IZD=NIA 378 : IZF=MAX(NIB,NIC) 379 : IBAND=MIA 380 : IRETO = 2 381 : C* ASSIGN 400 TO IRETO <- DELETED 382 : GOTO 410 383 : C BOUCLE SUR LES ZONES INTERNES AU TRIANGLE 384 : C ON VA TRAVAILLER DANS UNE BANDE ALLANT DE IZD A IZF. 385 : C ON SAIT PAR AILLEURS QUE LES ZONES COMPRISES ENTRE IZD1 ET IZF1 SONT 386 : C ENTIEREMENT INSCRITE DANS LE TRIANGLE IA IB IC 387 : 1000 CONTINUE 388 : IOORD=NDEC*IBAND 389 : IZD=IZD+IOORD 390 : IZD1=IZD1+IOORD 391 : IZF=IZF+IOORD 392 : IZF1=IZF1+IOORD 393 : INDDEB=INDZON(IZD/NMULT+1) 394 : C ON SE LIMITE A CHERCHER ENTRE LE DEBUT ET LA FIN DE LA BANDE 395 : C POINT DE LA BANDE 396 : DO 2000 INDDD=INDDEB,NBPOIN 397 : IPZO=NPZON(INDDD) 398 : * ON EST AVANT LE DEBUT 399 : IF (IPZO.LT.IZD) GOTO 2000 400 : * ON EST APRES LA FIN 401 : IF (IPZO.GT.IZF) GOTO 2100 402 : IPOINT=NPOIN(INDDD) 403 : IF (IVU(IPOINT).LT.1.OR.IVU(IPOINT).EQ.2) GOTO 2000 404 : IF (IPOINT.EQ.IA) GOTO 2000 405 : IF (IPOINT.EQ.IB) GOTO 2000 406 : IF (IPOINT.EQ.IC) GOTO 2000 407 : ZP=X(3,IPOINT) 408 : IF (ZP.LT.DISTLI) GOTO 2000 409 : C DE TOUTE FACON LE POINT EST DEVANT LE TRIANGLE 410 : XP=X(1,IPOINT) 411 : YP=X(2,IPOINT) 412 : VAX=XP-XA 413 : VBX=XP-XB 414 : VCX=XP-XC 415 : VAY=YP-YA 416 : VBY=YP-YB 417 : VCY=YP-YC 418 : DC=VAX*VBY-VAY*VBX 419 : DA=VBX*VCY-VBY*VCX 420 : IF (DA*DC.LT.0.) GOTO 2000 421 : DB=VCX*VAY-VCY*VAX 422 : IF (DA*DB.LT.0.) GOTO 2000 423 : IF (DB*DC.LT.0.) GOTO 2000 424 : IF (IPZO.GT.IZD1.AND.IPZO.LT.IZF1) GOTO 2020 425 : C CAR LE POINT EST STRICTEMENT DANS LE TRIANGLE 426 : IF (ABS(DA).GT.SMO) GOTO 2020 427 : IF (ABS(DB).GT.SMO) GOTO 2020 428 : IF (ABS(DC).GT.SMO) GOTO 2020 429 : IF (VAX*VBX.LT.-SMO) GOTO 2020 430 : IF (VAX*VCX.LT.-SMO) GOTO 2020 431 : IF (VAY*VCY.LT.-SMO) GOTO 2020 432 : IF (VAY*VCY.LT.-SMO) GOTO 2020 433 : IF (VBX*VCX.LT.-SMO) GOTO 2020 434 : IF (VBY*VCY.LT.-SMO) GOTO 2020 435 : GOTO 2000 436 : C IPOINT EST INSCRIT A L'INTERIEUR DU TRIANGLE 437 : C EST-IL DERRIERE 438 : 2020 IF (ZP.GT.DISTLS) GOTO 2030 439 : C ON FAIT UNE INTERPOLATION LINEAIRE ENTRE LES DISTANCES AUX SOMMETS 440 : C EN UTILISANT LES COORDONNEES BARYCENTRIQUES QUI NE SONT AUTRES 441 : C QUE LE RAPPORT DES SURFACES DES PETITS TRIANGLES AU GRAND 442 : S=DA+DB+DC 443 : IF (S.EQ.0.) GOTO 2000 444 : DA=DA/S 445 : DB=DB/S 446 : DC=DC/S 447 : S=DA*ZA+DB*ZB+DC*ZC 448 : IF (S.GT.ZP) GOTO 2000 449 : 2030 CONTINUE 450 : C SOMME NOUS VRAIMENT A L'INTERIEUR DE LA FACE 451 : C METHODE : NOUS DEVONS APPARTENIR A UN NOMBRE PAIR DE TRIANGLE DE 452 : C L'ELEMENT 453 : IF (NPFAC.EQ.3) GOTO 2009 454 : IDEDAN=1 455 : DO 2200 ITRIA1=IDEP,IFEP,3 456 : IF (ITRIA1.EQ.ITRIAN) GOTO 2200 457 : IAJ=ICPR(IPT1.NUM(LFAC(JAD+KFAC(ITRIA1)),IEL)) 458 : IBJ=ICPR(IPT1.NUM(LFAC(JAD+KFAC(ITRIA1+1)),IEL)) 459 : ICJ=ICPR(IPT1.NUM(LFAC(JAD+KFAC(ITRIA1+2)),IEL)) 460 : XAJ=X(1,IAJ) 461 : XBJ=X(1,IBJ) 462 : XCJ=X(1,ICJ) 463 : YAJ=X(2,IAJ) 464 : YBJ=X(2,IBJ) 465 : YCJ=X(2,ICJ) 466 : VAX=XP-XAJ 467 : VBX=XP-XBJ 468 : VCX=XP-XCJ 469 : VAY=YP-YAJ 470 : VBY=YP-YBJ 471 : VCY=YP-YCJ 472 : DC=VAX*VBY-VAY*VBX 473 : DA=VBX*VCY-VBY*VCX 474 : IF (DA*DC.LT.0.) GOTO 2200 475 : DB=VCX*VAY-VCY*VAX 476 : IF (DA*DB.LT.0.) GOTO 2200 477 : IF (DB*DC.LT.0.) GOTO 2200 478 : * ON EST DANS LE TRIANGLE 479 : IDEDAN=IDEDAN+1 480 : 2200 CONTINUE 481 : IF (MOD(IDEDAN,2).EQ.0) GOTO 2000 482 : 2009 IF (IVU(IPOINT).NE.2) IVU(IPOINT)=-IEL-IOB*NELEM 483 : 2000 CONTINUE 484 : 2100 CONTINUE 485 : GOTO (205,400,301),IRETO 486 : C* GOTO IRETO,(205,400,301) <- DELETED 487 : 400 CONTINUE 488 : C ON A FINI L'ANALYSE D'UN TRIANGLE 489 : 110 CONTINUE 490 : 101 CONTINUE 491 : 3004 CONTINUE 492 : IF (LISOUS(/1).NE.0) SEGDES IPT1 493 : 3001 CONTINUE 494 : SEGDES MELEME,ICPR 495 : SEGSUP TRAV 496 : C ON MET A 1 LES IVU 2 ( POINTS NON CACHABLES) 497 : DO 3400 II=1,IVU(/1) 498 : IF (IVU(II).EQ.2) IVU(II)=1 499 : 3400 CONTINUE 500 : RETURN 501 : END 502 : 503 :
© Cast3M 2003 - All rights reserved.
Disclaimer