1 : C COUPE SOURCE CHAT 07/10/29 21:17:01 5940 2 : SUBROUTINE COUPE 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : -INC CCOPTIO 6 : -INC SMELEME 7 : -INC CCGEOME 8 : -INC SMCOORD 9 : -INC SMLENTI 10 : -INC SMLREEL 11 : C 12 : DIMENSION XYZT(3),XYZ2(3),XYZ3(3),XYZN(3) 13 : DIMENSION XYZ(4,4),DIS(4) 14 : C 15 : EQUIVALENCE(XYZT(1),XCT),(XYZT(2),YCT),(XYZT(3),ZCT) 16 : EQUIVALENCE(XYZ2(1),XC2),(XYZ2(2),YC2),(XYZ2(3),ZC2) 17 : EQUIVALENCE(XYZ3(1),XC3),(XYZ3(2),YC3),(XYZ3(3),ZC3) 18 : EQUIVALENCE(XYZN(1),XN) ,(XYZN(2),YN) ,(XYZN(3),ZN) 19 : C 20 : EQUIVALENCE(XYZ(1,1),XCA),(XYZ(2,1),YCA),(XYZ(3,1),ZCA) 21 : EQUIVALENCE(XYZ(1,2),XCB),(XYZ(2,2),YCB),(XYZ(3,2),ZCB) 22 : EQUIVALENCE(XYZ(1,3),XCC),(XYZ(2,3),YCC),(XYZ(3,3),ZCC) 23 : EQUIVALENCE(XYZ(1,4),XCD),(XYZ(2,4),YCD),(XYZ(3,4),ZCD) 24 : EQUIVALENCE(DIS(1),DI1),(DIS(2),DI2),(DIS(3),DI3),(DIS(4),DI4) 25 : C 26 : PARAMETER(UN=1.D0,DEUX=2.D0,ZERO=0.D0) 27 : C 28 : C LECTURE DES DONNEES 29 : C 30 : IF (IDIM.NE.3) THEN 31 : WRITE(IOIMP,*)'COUPE: You must be in 3D' 31 : CALL ERREUR(0) 32 : RETURN 33 : ENDIF 34 : C 34 : CALL LIROBJ('POINT',ICOUP1,1,IRETOU) 35 : IF (IRETOU.EQ.0) RETURN 35 : CALL LIROBJ('POINT',ICOUP2,1,IRETOU) 36 : IF (IRETOU.EQ.0) RETURN 36 : CALL LIROBJ('POINT',ICOUP3,1,IRETOU) 37 : IF (IRETOU.EQ.0) RETURN 37 : CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU) 38 : IF (IRETOU.EQ.0) RETURN 39 : C 40 : C CARACTERISTIQUE DU PLAN DE COUPE 41 : C 42 : IREF=(ICOUP1-1)*4 43 : XCT=XCOOR(IREF+1) 44 : YCT=XCOOR(IREF+2) 45 : ZCT=XCOOR(IREF+3) 46 : C 47 : IREF=(ICOUP2-1)*4 48 : XC2=XCOOR(IREF+1) 49 : YC2=XCOOR(IREF+2) 50 : ZC2=XCOOR(IREF+3) 51 : C 52 : IREF=(ICOUP3-1)*4 53 : XC3=XCOOR(IREF+1) 54 : YC3=XCOOR(IREF+2) 55 : ZC3=XCOOR(IREF+3) 56 : C 57 : TOL1=MIN(SQRT((XC2-XCT)**2+(YC2-YCT)**2+(ZC2-ZCT)**2), 58 : > SQRT((XC3-XCT)**2+(YC3-YCT)**2+(ZC3-ZCT)**2))/10 59 : TOL4=TOL1/1000 60 : C : 61 : XV=XC2-XCT 62 : YV=YC2-YCT 63 : ZV=ZC2-ZCT 64 : XW=XC3-XCT 65 : YW=YC3-YCT 66 : ZW=ZC3-ZCT 67 : XN=YV*ZW-ZV*YW 68 : YN=ZV*XW-XV*ZW 69 : ZN=XV*YW-YV*XW 70 : RN=XN**2+YN**2+ZN**2 70 : IF (RN.EQ.0.) CALL ERREUR(21) 71 : IF (IERR.NE.0) RETURN 72 : RN=SQRT(RN) 73 : XN=XN/RN 74 : YN=YN/RN 75 : ZN=ZN/RN 76 : C 77 : C PREPARATION DU MAILLAGE 78 : C 79 : SEGACT,IPT1 80 : MBSOUS=IPT1.LISOUS(/1) 81 : IF(MBSOUS.EQ.0)THEN 82 : NBSOUS=1 83 : NBREF=0 84 : NBNN=0 85 : NBELEM=0 86 : SEGINI,IPT2 87 : IPT2.LISOUS(1)=IPT1 88 : ELSE 89 : SEGINI,IPT2=IPT1 90 : ENDIF 91 : SEGDES,IPT1 92 : C 93 : C BOUCLE SUR LES ZONES DU MAILLAGE 94 : C 95 : MBSOUS=IPT2.LISOUS(/1) 96 : DO IE1=1,MBSOUS 97 : C 98 : C -> REDUCTION DES MAILLAGES A 3 TYPES D'ELEMENTS 99 : C 100 : IPT1=IPT2.LISOUS(IE1) 101 : SEGACT,IPT1 102 : ITYP=IPT1.ITYPEL 103 : ITYQ=0 104 : C CAS DES SEG3 QUE L'ON TRANFORME EN SEG2 105 : IF(ITYP.EQ.3)THEN 106 : ITYQ=2 106 : CALL CHANGE(IPT1,ITYQ) 107 : C CAS DE TRI6, QUA4 ET QUA8 QUE L'ON TRANFORME EN TRI3 108 : ELSE IF(ITYP.EQ.6.OR.ITYP.EQ.8.OR.ITYP.EQ.10)THEN 109 : ITYQ=4 109 : CALL CHANGE(IPT1,ITYQ) 110 : C CAS DE CUB8, CU20, PRI6, PR15, 111 : C TE10, PYR5, PY13 QUE L'ON TRANFORME EN TRI3 112 : C IF(ITYP.EQ.14.OR.ITYP.EQ.15.OR.ITYP.EQ.16.OR.ITYP.EQ.17 113 : C > .OR.ITYP.EQ.24.OR.ITYP.EQ.25.OR.ITYP.EQ.26)THEN 114 : C CAS DE TE10 QUE L'ON TRANFORME EN TET4 115 : ELSE IF (ITYP.EQ.24)THEN 116 : ITYQ=23 116 : CALL CHANGE(IPT1,ITYQ) 117 : ENDIF 118 : ITYP=IPT1.ITYPEL 119 : NBELEM=IPT1.NUM(/2) 120 : MBELEM=NBELEM 121 : NBREF=0 122 : NBSOUS=0 123 : C 124 : C -> AIGUILLAGE SUR LES TYPES D'ELEMENTS 125 : C 126 : IF(ITYP.EQ.2)THEN 127 : C 128 : C --> TRAVAIL SUR LES SEG2 (--> SEG2 OR POI1) 129 : C 130 : NBNN=1 131 : SEGINI,MELEME 132 : ITYPEL=1 133 : C 134 : NBNN=2 135 : SEGINI,IPT3 136 : IPT3.ITYPEL=2 137 : C 138 : NBELEM=0 139 : NBELE3=0 140 : C 141 : DO IE2=1,MBELEM 142 : JCOLOR=IPT1.ICOLOR(IE2) 143 : DO IE3=1,2 144 : IREF=(IPT1.NUM(IE3,IE2)-1)*4 145 : DO IE4=1,3+1 146 : XYZ(IE4,IE3)=XCOOR(IREF+IE4) 147 : ENDDO 147 : CALL COUPEC(XYZ(1,IE3),XYZT,XYZ2,XYZ3,XYZN,TOL1, DIS(IE3)) 148 : ENDDO 149 : C COTE DANS LE PLAN DE COUPE 150 : IF (ABS(DI1)+ABS(DI2).LT.TOL4)THEN 151 : NBELE3=NBELE3+1 152 : IPT3.NUM(1,NBELE3)=IPT1.NUM(1,IE2) 153 : IPT3.NUM(2,NBELE3)=IPT1.NUM(2,IE2) 154 : IPT3.ICOLOR(NBELE3)=JCOLOR 155 : C 156 : ELSEIF(SIGN(UN,DI1)+SIGN(UN,DI2).EQ.ZERO .OR. 157 : > ABS(DI1).LT.TOL4 .OR. ABS(DI2).LT.TOL4)THEN 158 : C INTERSECTION OU POINT DANS LE PLAN DE COUPE 159 : NBPTI=XCOOR(/1)/4 160 : NBPTS=NBPTI+1 161 : SEGADJ,MCOORD 162 : C 163 : COEFF=ABS(DI1)/(ABS(DI1)+ABS(DI2)) 164 : NBPTI=NBPTI+1 165 : IREF=(NBPTI-1)*4 166 : DO IE3=1,4 167 : XCOOR(IREF+IE3)=XYZ(1,IE3)+COEFF*(XYZ(2,IE3)-XYZ(1,IE3)) 168 : ENDDO 169 : C 170 : NBELEM=NBELEM+1 171 : NUM(1,NBELEM)=NBPTI 172 : ICOLOR(NBELEM)=JCOLOR 173 : ENDIF 174 : ENDDO 175 : C STOCKAGE EVENTUEL DU MAILLAGE SUPLEMENTAIRE 176 : IF(NBELEM.EQ.0)THEN 177 : SEGSUP,MELEME 178 : NBELEM=NBELE3 179 : MELEME=IPT3 180 : SEGADJ,MELEME 181 : ELSE 182 : NBNN=1 183 : SEGADJ,MELEME 184 : NBELEM=NBELE3 185 : NBNN=2 186 : SEGADJ,IPT3 187 : C 188 : NBELEM=0 189 : NBNN=0 190 : NBSOUS=IPT2.LISOUS(/1)+1 191 : SEGADJ,IPT2 192 : IPT2.LISOUS(NBSOUS)=IPT3 193 : ENDIF 194 : ELSE IF(ITYP.EQ.4)THEN 195 : C 196 : C --> TRAVAIL SUR LES TRI3 (--> TRI3 OR SEG2) 197 : C 198 : NBNN=2 199 : SEGINI,MELEME 200 : ITYPEL=2 201 : NBELEM=0 202 : DO IE2=1,MBELEM 203 : C A FAIRE...... 204 : ENDDO 205 : SEGADJ,MELEME 206 : ELSE IF(ITYP.EQ.23)THEN 207 : C 208 : C --> TRAVAIL SUR LES TET4 (--> TRI3) 209 : C 210 : NBELEM=NBELEM*2 211 : NBNN=3 212 : SEGINI,MELEME 213 : ITYPEL=4 214 : NBELEM=0 215 : C 216 : DO IE2=1,MBELEM 217 : JCOLOR=IPT1.ICOLOR(IE2) 218 : DO IE3=1,4 219 : IREF=(IPT1.NUM(IE3,IE2)-1)*4 220 : DO IE4=1,3+1 221 : XYZ(IE4,IE3)=XCOOR(IREF+IE4) 222 : ENDDO 222 : CALL COUPEC(XYZ(1,IE3),XYZT,XYZ2,XYZ3,XYZN,TOL1, DIS(IE3)) 223 : ENDDO 224 : C 225 : IF (ABS(DIS(1))+ABS(DIS(2))+ABS(DIS(3)).LT.TOL4)THEN 226 : C FACE 1 DS LE PLAN DE COUPE 227 : NBELEM=NBELEM+1 228 : NUM(1,NBELEM)=IPT1.NUM(1,IE2) 229 : NUM(2,NBELEM)=IPT1.NUM(2,IE2) 230 : NUM(3,NBELEM)=IPT1.NUM(3,IE2) 231 : ICOLOR(NBELEM)=JCOLOR 232 : ELSEIF(ABS(DIS(1))+ABS(DIS(2))+ABS(DIS(4)).LT.TOL4)THEN 233 : C FACE 2 DS LE PLAN DE COUPE 234 : NBELEM=NBELEM+1 235 : NUM(1,NBELEM)=IPT1.NUM(1,IE2) 236 : NUM(2,NBELEM)=IPT1.NUM(2,IE2) 237 : NUM(3,NBELEM)=IPT1.NUM(4,IE2) 238 : ICOLOR(NBELEM)=JCOLOR 239 : ELSEIF(ABS(DIS(1))+ABS(DIS(3))+ABS(DIS(4)).LT.TOL4)THEN 240 : C FACE 3 DS LE PLAN DE COUPE 241 : NBELEM=NBELEM+1 242 : NUM(1,NBELEM)=IPT1.NUM(1,IE2) 243 : NUM(2,NBELEM)=IPT1.NUM(3,IE2) 244 : NUM(3,NBELEM)=IPT1.NUM(4,IE2) 245 : ICOLOR(NBELEM)=JCOLOR 246 : ELSEIF(ABS(DIS(2))+ABS(DIS(3))+ABS(DIS(4)).LT.TOL4)THEN 247 : C FACE 4 DS LE PLAN DE COUPE 248 : NBELEM=NBELEM+1 249 : NUM(1,NBELEM)=IPT1.NUM(2,IE2) 250 : NUM(2,NBELEM)=IPT1.NUM(3,IE2) 251 : NUM(3,NBELEM)=IPT1.NUM(4,IE2) 252 : ICOLOR(NBELEM)=JCOLOR 253 : ELSEIF(ABS(DI1)+ABS(DI2).LT.TOL4)THEN 254 : C COTE 12 DS LE PLAN DE COUPE 255 : DINDEX=SIGN(UN,DI3)+SIGN(UN,DI4) 256 : IF(DINDEX.EQ.0)THEN 257 : NUMA=IPT1.NUM(1,IE2) 258 : NUMB=IPT1.NUM(2,IE2) 258 : CALL COUPEM(XYZ(1,3),XYZ(1,4),DI3,DI4, 259 : > NUMA,NUMB,MELEME,NBELEM,JCOLOR) 260 : ENDIF 261 : ELSEIF(ABS(DI1)+ABS(DI3).LT.TOL4)THEN 262 : C COTE 13 DS LE PLAN DE COUPE 263 : DINDEX=SIGN(UN,DI2)+SIGN(UN,DI4) 264 : IF(DINDEX.EQ.0)THEN 265 : NUMA=IPT1.NUM(1,IE2) 266 : NUMB=IPT1.NUM(3,IE2) 266 : CALL COUPEM(XYZ(1,2),XYZ(1,4),DI2,DI4, 267 : > NUMA,NUMB,MELEME,NBELEM,JCOLOR) 268 : ENDIF 269 : ELSEIF(ABS(DI1)+ABS(DI4).LT.TOL4)THEN 270 : C COTE 14 DS LE PLAN DE COUPE 271 : DINDEX=SIGN(UN,DI2)+SIGN(UN,DI3) 272 : IF(DINDEX.EQ.0)THEN 273 : NUMA=IPT1.NUM(1,IE2) 274 : NUMB=IPT1.NUM(4,IE2) 274 : CALL COUPEM(XYZ(1,2),XYZ(1,3),DI2,DI3, 275 : > NUMA,NUMB,MELEME,NBELEM,JCOLOR) 276 : ENDIF 277 : ELSEIF(ABS(DI2)+ABS(DI3).LT.TOL4)THEN 278 : C COTE 23 DS LE PLAN DE COUPE 279 : DINDEX=SIGN(UN,DI1)+SIGN(UN,DI4) 280 : IF(DINDEX.EQ.0)THEN 281 : NUMA=IPT1.NUM(2,IE2) 282 : NUMB=IPT1.NUM(3,IE2) 282 : CALL COUPEM(XYZ(1,1),XYZ(1,4),DI1,DI4, 283 : > NUMA,NUMB,MELEME,NBELEM,JCOLOR) 284 : ENDIF 285 : ELSEIF(ABS(DI2)+ABS(DI4).LT.TOL4)THEN 286 : C COTE 24 DS LE PLAN DE COUPE 287 : DINDEX=SIGN(UN,DI1)+SIGN(UN,DI3) 288 : IF(DINDEX.EQ.0)THEN 289 : NUMA=IPT1.NUM(2,IE2) 290 : NUMB=IPT1.NUM(4,IE2) 290 : CALL COUPEM(XYZ(1,1),XYZ(1,3),DI1,DI3, 291 : > NUMA,NUMB,MELEME,NBELEM,JCOLOR) 292 : ENDIF 293 : ELSEIF(ABS(DI3)+ABS(DI4).LT.TOL4)THEN 294 : C COTE 34 DS LE PLAN DE COUPE 295 : DINDEX=SIGN(UN,DI1)+SIGN(UN,DI2) 296 : IF(DINDEX.EQ.0)THEN 297 : NUMA=IPT1.NUM(3,IE2) 298 : NUMB=IPT1.NUM(4,IE2) 298 : CALL COUPEM(XYZ(1,1),XYZ(1,2),DI1,DI2, 299 : > NUMA,NUMB,MELEME,NBELEM,JCOLOR) 300 : ENDIF 301 : ELSEIF(ABS(DI1).LT.TOL4)THEN 302 : C POINT 1 DANS LE PLAN DE COUPE 303 : DINDEX=SIGN(UN,DI2)+SIGN(UN,DI3)+SIGN(UN,DI4) 304 : IF(ABS(DINDEX).EQ.UN)THEN 305 : NUM0=IPT1.NUM(1,IE2) 305 : CALL COUPEK(XYZ(1,2),XYZ(1,3),XYZ(1,4), 306 : > DI2 , DI3 , DI4, 307 : > NUM0,MELEME,NBELEM,JCOLOR) 308 : ENDIF 309 : ELSE IF(ABS(DI2).LT.TOL4)THEN 310 : C POINT 2 DANS LE PLAN DE COUPE 311 : DINDEX=SIGN(UN,DI3)+SIGN(UN,DI4)+SIGN(UN,DI1) 312 : IF(ABS(DINDEX).EQ.UN)THEN 313 : NUM0=IPT1.NUM(2,IE2) 313 : CALL COUPEK(XYZ(1,3),XYZ(1,4),XYZ(1,1), 314 : > DI3 , DI4 , DI1, 315 : > NUM0,MELEME,NBELEM,JCOLOR) 316 : ENDIF 317 : ELSE IF(ABS(DI3).LT.TOL4)THEN 318 : C POINT 3 DANS LE PLAN DE COUPE 319 : DINDEX=SIGN(UN,DI4)+SIGN(UN,DI1)+SIGN(UN,DI2) 320 : IF(ABS(DINDEX).EQ.UN)THEN 321 : NUM0=IPT1.NUM(3,IE2) 321 : CALL COUPEK(XYZ(1,4),XYZ(1,1),XYZ(1,2), 322 : > DI4 , DI1 , DI2, 323 : > NUM0,MELEME,NBELEM,JCOLOR) 324 : ENDIF 325 : ELSE IF(ABS(DI4).LT.TOL4)THEN 326 : C POINT 4 DANS LE PLAN DE COUPE 327 : DINDEX=SIGN(UN,DI1)+SIGN(UN,DI2)+SIGN(UN,DI3) 328 : IF(ABS(DINDEX).EQ.UN)THEN 329 : NUM0=IPT1.NUM(4,IE2) 329 : CALL COUPEK(XYZ(1,1),XYZ(1,2),XYZ(1,3), 330 : > DI1 , DI2 , DI3, 331 : > NUM0,MELEME,NBELEM,JCOLOR) 332 : ENDIF 333 : ELSE 334 : DINDEX=SIGN(UN,DI1)+SIGN(UN,DI2)+SIGN(UN,DI3)+SIGN(UN,DI4) 335 : IF(ABS(DINDEX).EQ.DEUX)THEN 336 : C INTERSECTION PAR UNE POINTE 337 : IF(SIGN(UN,DI1).NE.SIGN(UN,DINDEX))THEN 338 : C POINTE N.1 338 : CALL COUPEI(XYZ(1,1),XYZ(1,2),XYZ(1,3),XYZ(1,4), 339 : > DI1 , DI2 , DI3 , DI4, 340 : > MELEME,NBELEM,JCOLOR) 341 : ELSE IF(SIGN(UN,DI2).NE.SIGN(UN,DINDEX))THEN 342 : C POINTE N.2 342 : CALL COUPEI(XYZ(1,2),XYZ(1,3),XYZ(1,4),XYZ(1,1), 343 : > DI2 , DI3 , DI4 , DI1, 344 : > MELEME,NBELEM,JCOLOR) 345 : ELSE IF(SIGN(UN,DI3).NE.SIGN(UN,DINDEX))THEN 346 : C POINTE N.3 346 : CALL COUPEI(XYZ(1,3),XYZ(1,4),XYZ(1,1),XYZ(1,2), 347 : > DI3 , DI4 , DI1 , DI2, 348 : > MELEME,NBELEM,JCOLOR) 349 : ELSE IF(SIGN(UN,DI4).NE.SIGN(UN,DINDEX))THEN 350 : C POINTE N.4 350 : CALL COUPEI(XYZ(1,4),XYZ(1,1),XYZ(1,2),XYZ(1,3), 351 : > DI4 , DI1 , DI2 , DI3, 352 : > MELEME,NBELEM,JCOLOR) 353 : C ERREUR 354 : ELSE 355 : C A FAIRE...... 356 : ENDIF 357 : ELSEIF(ABS(DINDEX).EQ.ZERO)THEN 358 : C INTERSECTION PAR UN COTE 359 : IF(SIGN(UN,DI1).EQ.SIGN(UN,DI2))THEN 360 : C COTE 12 360 : CALL COUPEJ(XYZ(1,1),XYZ(1,2),XYZ(1,3),XYZ(1,4), 361 : > DI1 , DI2 , DI3 , DI4, 362 : > MELEME,NBELEM,JCOLOR) 363 : ELSE IF(SIGN(UN,DI1).EQ.SIGN(UN,DI3))THEN 364 : C COTE 13 364 : CALL COUPEJ(XYZ(1,1),XYZ(1,3),XYZ(1,2),XYZ(1,4), 365 : > DI1 , DI3 , DI2 , DI4, 366 : > MELEME,NBELEM,JCOLOR) 367 : ELSE IF(SIGN(UN,DI1).EQ.SIGN(UN,DI4))THEN 368 : C COTE 14 368 : CALL COUPEJ(XYZ(1,1),XYZ(1,4),XYZ(1,2),XYZ(1,3), 369 : > DI1 , DI4 , DI2 , DI3, 370 : > MELEME,NBELEM,JCOLOR) 371 : ELSE IF(SIGN(UN,DI2).EQ.SIGN(UN,DI3))THEN 372 : C COTE 23 372 : CALL COUPEJ(XYZ(1,2),XYZ(1,3),XYZ(1,1),XYZ(1,4), 373 : > DI2 , DI3 , DI1 , DI4, 374 : > MELEME,NBELEM,JCOLOR) 375 : ELSE IF(SIGN(UN,DI2).EQ.SIGN(UN,DI4))THEN 376 : C COTE 24 376 : CALL COUPEJ(XYZ(1,2),XYZ(1,4),XYZ(1,1),XYZ(1,3), 377 : > DI2 , DI4 , DI1 , DI3, 378 : > MELEME,NBELEM,JCOLOR) 379 : ELSE IF(SIGN(UN,DI3).EQ.SIGN(UN,DI4))THEN 380 : C COTE 34 380 : CALL COUPEJ(XYZ(1,3),XYZ(1,4),XYZ(1,1),XYZ(1,2), 381 : > DI3 , DI4 , DI1 , DI2, 382 : > MELEME,NBELEM,JCOLOR) 383 : C ERREUR 384 : ELSE 385 : C A FAIRE...... 386 : ENDIF 387 : ENDIF 388 : ENDIF 389 : ENDDO 390 : SEGADJ,MELEME 391 : C ELIMINATION DES DOUBLONS (FACE DANS LE PLAN) 392 : C (on fait un tri prealable) 393 : JG=NBELEM 394 : SEGINI,MLENT1,MLENTI 395 : DO IE2=1,NBELEM 396 : LECT(IE2)=IE2 397 : MLENT1.LECT(IE2)=0 398 : DO IE3=1,NBNN 399 : MLENT1.LECT(IE2)=MLENT1.LECT(IE2)+NUM(IE3,IE2) 400 : ENDDO 401 : ENDDO 402 : SEGINI,MLENT2=MLENTI 403 : C 403 : CALL GENOR2(MLENT1.LECT,MLENT2.LECT,NBELEM) 404 : C 405 : IDIMP1=IDIM+1 406 : NBPTS=XCOOR(/1)/IDIMP1 406 : CALL COUPEN(NUM,NBNN,NBELEM,XCOOR,IDIMP1,NBPTS, 407 : > MLENT1.LECT,MLENT2.LECT,LECT) 408 : C 409 : MBELEM=0 410 : DO IE2=1,NBELEM 411 : IF(LECT(IE2).NE.0)THEN 412 : IF(LECT(IE2).NE.IE2)THEN 413 : LECT(LECT(IE2))=0 414 : ENDIF 415 : MBELEM=MBELEM+1 416 : DO IE3=1,NBNN 417 : NUM(IE3,MBELEM)=NUM(IE3,IE2) 418 : ENDDO 419 : ICOLOR(MBELEM) =ICOLOR(IE2) 420 : ENDIF 421 : ENDDO 422 : C 423 : SEGSUP,MLENTI,MLENT1,MLENT2 424 : NBELEM=MBELEM 425 : SEGADJ,MELEME 426 : C 427 : ELSE 428 : C 429 : C --> ERREUR 430 : C 431 : WRITE(IOIMP,*)'COUPE: Incorrect type of element',ITYP 432 : SEGSUP,MELEME 433 : IF(IE1.GT.1)THEN 434 : DO IE2=1,IE1-1 435 : MELEME=IPT2.LISOUS(IE2) 436 : SEGSUP,MELEME 437 : ENDDO 438 : ENDIF 439 : SEGSUP,IPT2 439 : CALL ERREUR(0) 440 : RETURN 441 : ENDIF 442 : C 443 : C FIN BOUCLE SUR LES ZONES DU MAILLAGE 444 : C 445 : C SEGDES,MELEME 446 : IPT2.LISOUS(IE1)=MELEME 447 : IF(ITYQ.NE.0)SEGSUP,IPT1 448 : ENDDO 449 : C 450 : C ON TASSE LE MAILLAGE POUR ELIMINER LES ZONES VIDES 451 : C 452 : MELEME=IPT2 453 : NBSOUS=0 454 : DO IE1=1,LISOUS(/1) 455 : IPT1=LISOUS(IE1) 456 : NBELEM=IPT1.NUM(/2) 457 : IF(NBELEM.EQ.0)THEN 458 : SEGSUP,IPT1 459 : ELSE 460 : NBSOUS=NBSOUS+1 461 : LISOUS(NBSOUS)=IPT1 462 : SEGDES,IPT1 463 : ENDIF 464 : ENDDO 465 : NBNN=0 466 : NBELEM=0 467 : NBREF=0 468 : SEGADJ,MELEME 469 : C 470 : C SI LE MAILLAGE NE CONTIENT QU'UNE SEULE ZONE... 471 : C 472 : IF(NBSOUS.EQ.1)THEN 473 : IPT1=LISOUS(1) 474 : SEGSUP,MELEME 475 : MELEME=IPT1 476 : ELSE 477 : SEGDES,MELEME 478 : ENDIF 479 : C 479 : CALL ECROBJ('MAILLAGE',MELEME) 480 : RETURN 481 : END 482 : 483 : 484 : 485 :
© Cast3M 2003 - All rights reserved.
Disclaimer