1 : C CHANGE SOURCE PV 13/04/16 21:15:01 7765 2 : C SERT A CHANGER LE TYPE DE L'ELEMENT DE L'OBJET 3 : C 4 : C CONVERSION QUA8->QUA9 5 : C CONVERSION QUA9->QUA4 PP 9/9/92 6 : C 7 : SUBROUTINE CHANGE(IPT1,ITY) 8 : IMPLICIT REAL*8 (A-H,O-Z) 9 : IMPLICIT INTEGER (I-N) 10 : -INC CCOPTIO 11 : -INC SMCOORD 12 : -INC CCGEOME 13 : -INC SMELEME 14 : SEGMENT NKON(IKOUR) 15 : SEGMENT KON(IKOUR,NKMAX,3) 16 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 17 : PARAMETER(NTYP2=5) 18 : CHARACTER*4 LTYP2(NTYP2),MTYP2 19 : REAL*8 Q89(4) 20 : * 21 : DATA LTYP2/'TRI3','TET4','QUA4','CUB8','PYR5'/ 22 : * 23 : * Si ce sont des QUAF et qu'on demande à changer 24 : * en TRI3, TET4, QUA4, CUB8, PYR5, on branche vers chang2 24 : CALL KQCEST(IPT1,IKR) 25 : IF (IKR.EQ.1341.OR.IKR.EQ.1.OR.IKR.EQ.13.OR.IKR.EQ.134) THEN 26 : MTYP2=NOMS(ITY) 26 : CALL FIMOT2(MTYP2,LTYP2,NTYP2,ITYP2,0,IRET) 27 : IF (IRET.NE.0) THEN 27 : CALL ERREUR(5) 28 : RETURN 29 : ENDIF 30 : IF (ITYP2.NE.0) THEN 30 : CALL CHANG2(IPT1,ITY) 31 : RETURN 32 : ENDIF 33 : ENDIF 34 : * 35 : SEGACT IPT1 36 : IF (ITY.EQ.1) GOTO 10 36 : IF (IPT1.LISOUS(/1).NE.0) CALL ERREUR(25) 37 : IF (IERR.NE.0) RETURN 38 : IF (IPT1.ITYPEL.EQ.ITY) RETURN 39 : IF (IPT1.ITYPEL.EQ.KSURF(ITY)) RETURN 40 : IF (KSURF(ITY).NE.4.OR.IPT1.ITYPEL.NE.8) GOTO 10 41 : C 42 : C ON CHANGE DES Q4 EN COUPLES DE T3 43 : C 44 : NBELEM=2*IPT1.NUM(/2) 45 : NBNN=3 46 : NBSOUS=0 47 : NBREF=IPT1.LISREF(/1) 48 : SEGINI IPT2 49 : IPT2.ITYPEL=4 50 : IF (NBREF.EQ.0) GOTO 1 51 : DO 2 I=1,NBREF 52 : IPT2.LISREF(I)=IPT1.LISREF(I) 53 : 2 CONTINUE 54 : 1 DO 3 I=1,IPT1.NUM(/2),2 55 : J=2*I-1 56 : IPT2.NUM(1,J)=IPT1.NUM(1,I) 57 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 58 : IPT2.NUM(3,J)=IPT1.NUM(3,I) 59 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 60 : J=J+1 61 : IPT2.NUM(1,J)=IPT1.NUM(1,I) 62 : IPT2.NUM(2,J)=IPT1.NUM(3,I) 63 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 64 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 65 : J=J+1 66 : IF (J.GT.IPT2.NUM(/2)) GOTO 3 67 : IPT2.NUM(1,J)=IPT1.NUM(1,I+1) 68 : IPT2.NUM(2,J)=IPT1.NUM(2,I+1) 69 : IPT2.NUM(3,J)=IPT1.NUM(4,I+1) 70 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1) 71 : J=J+1 72 : IPT2.NUM(1,J)=IPT1.NUM(2,I+1) 73 : IPT2.NUM(2,J)=IPT1.NUM(3,I+1) 74 : IPT2.NUM(3,J)=IPT1.NUM(4,I+1) 75 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1) 76 : 3 CONTINUE 77 : GOTO 100 78 : 10 CONTINUE 79 : * IF (IPT1.ITYPEL.EQ.ITY) RETURN 80 : IF (ITY.NE.1) GOTO 20 81 : C 82 : C ON CHANGE EN P1 83 : C 84 : SEGINI ICPR 85 : DO 11 I=1,XCOOR(/1)/(IDIM+1) 86 : ICPR(I)=0 87 : 11 CONTINUE 88 : ICON=0 89 : IPT2=IPT1 90 : DO 14 IOB=1,MAX(1,IPT1.LISOUS(/1)) 91 : IF (IPT1.LISOUS(/1).NE.0) THEN 92 : IPT2=IPT1.LISOUS(IOB) 93 : SEGACT IPT2 94 : ENDIF 95 : DO 12 I=1,IPT2.NUM(/1) 96 : DO 12 J=1,IPT2.NUM(/2) 97 : IKI=IPT2.NUM(I,J) 98 : IF (ICPR(IKI).NE.0) GOTO 12 99 : ICON=ICON+1 100 : ICPR(IKI)=ICON 101 : 12 CONTINUE 102 : IF (IPT1.LISOUS(/1).NE.0) SEGDES IPT2 103 : 14 CONTINUE 104 : NBSOUS=0 105 : NBREF=0 106 : NBELEM=ICON 107 : NBNN=1 108 : SEGINI IPT2 109 : IPT2.ITYPEL=1 110 : DO 13 I=1,XCOOR(/1)/(IDIM+1) 111 : IF (ICPR(I).EQ.0) GOTO 13 112 : IPT2.NUM(1,ICPR(I))=I 113 : 13 CONTINUE 113 : call crech1(ipt2,1) 114 : SEGSUP ICPR 115 : GOTO 100 116 : * 117 : 20 IF ((IPT1.ITYPEL.NE.4.OR.KSURF(ITY).NE.6).AND. 118 : # (IPT1.ITYPEL.NE.8.OR.KSURF(ITY).NE.10).AND. 119 : # (IPT1.ITYPEL.NE.8.OR.KSURF(ITY).NE.6).AND. 120 : # (IPT1.ITYPEL.NE.14.OR.ITY.NE.15)) GOTO 50 121 : C 122 : C ON CHANGE EVENTUELLEMENT EN DEUX TEMPS DES Q4 EN T6 123 : C ON CHANGE DES T3 EN T6 OU DES Q4 EN Q8 OU DES CUB8 EN CUB20. 124 : C 125 : SEGINI ICPR 126 : DO 21 I=1,XCOOR(/1)/(IDIM+1) 127 : ICPR(I)=0 128 : 21 CONTINUE 129 : IKOUR=0 130 : DO 22 I=1,IPT1.NUM(/1) 131 : DO 22 J=1,IPT1.NUM(/2) 132 : ITH=IPT1.NUM(I,J) 133 : IF (ICPR(ITH).NE.0) GOTO 22 134 : IKOUR=IKOUR+1 135 : ICPR(ITH)=IKOUR 136 : 22 CONTINUE 137 : SEGINI NKON 138 : DO 23 I=1,IKOUR 139 : NKON(I)=0 140 : 23 CONTINUE 141 : DO 24 I=1,IPT1.NUM(/1) 142 : DO 24 J=1,IPT1.NUM(/2) 143 : NKON(ICPR(IPT1.NUM(I,J)))=NKON(ICPR(IPT1.NUM(I,J)))+1 144 : 24 CONTINUE 145 : NKMAX=0 146 : DO 25 I=1,IKOUR 147 : NKMAX=MAX(NKMAX,NKON(I)) 148 : 25 CONTINUE 149 : 26 SEGINI KON 150 : DO 27 I=1,IKOUR 151 : DO 27 J=1,NKMAX 152 : KON(I,J,1)=0 153 : KON(I,J,2)=0 154 : KON(I,J,3)=0 155 : 27 CONTINUE 156 : IF (IPT1.LISREF(/1).EQ.0) GOTO 33 157 : C 158 : C REMPLISSAGE DE KON DANS LE CAS OU LES COTES DE L'OBJET 159 : C SONT A 3 NOEUDS OU 8 NOEUDS. 160 : DO 32 IN=1,IPT1.LISREF(/1) 161 : IPT3=IPT1.LISREF(IN) 162 : SEGACT IPT3 163 : IF ((IPT3.ITYPEL.NE.3).AND.(IPT3.ITYPEL.NE.10)) GOTO 32 164 : DO 31 J=1,IPT3.NUM(/2) 165 : DO 31 I=1,IPT3.NUM(/1),2 166 : IFI=I+2 167 : IF ((I.EQ.IPT3.NUM(/1)).AND.(IPT3.ITYPEL.EQ.3)) GOTO 31 168 : IF (IFI.GT.IPT3.NUM(/1)) IFI=1 169 : I1=IPT3.NUM(I,J) 170 : I2=IPT3.NUM(IFI,J) 171 : J1=ICPR(MIN(I1,I2)) 172 : J2=MAX(I1,I2) 173 : KSCOL=IPT3.ICOLOR(J) 174 : ITF=0 175 : 29 ITF=ITF+1 176 : IF (ITF.GT.NKMAX) GOTO 61 177 : IF ((KON(J1,ITF,1).EQ.J2).OR.(KON(J1,ITF,1).EQ.0)) GOTO 30 178 : GOTO 29 179 : 30 KON(J1,ITF,1)=J2 180 : KON(J1,ITF,2)=IPT3.NUM(I+1,J) 181 : KON(J1,ITF,3)=KSCOL 182 : 31 CONTINUE 183 : SEGDES IPT3 184 : 32 CONTINUE 185 : C 186 : C CREATION DES NOUVEAUX NOEUDS. 187 : 33 NBELEM=IPT1.NUM(/2) 188 : NBNN1=IPT1.NUM(/1) 189 : NBNN=NBNN1*2 190 : IF (IPT1.ITYPEL.EQ.14) NBNN=20 191 : NBSOUS=0 192 : NBREF=IPT1.LISREF(/1) 193 : SEGINI IPT2 194 : IPT2.ITYPEL=IPT1.ITYPEL+2 195 : IF (IPT1.ITYPEL.EQ.14) IPT2.ITYPEL=15 196 : SEGACT MCOORD 197 : DO 38 J=1,NBELEM 198 : DO 38 I=1,NBNN1 199 : IND=0 200 : IF (I.GT.4) IND=4 201 : IPT2.NUM(2*I-1+IND,J)=IPT1.NUM(I,J) 202 : IFI=I+1 203 : IF ((IPT1.ITYPEL.EQ.14).AND.(I.EQ.4)) IFI=1 204 : IF ((IPT1.ITYPEL.EQ.14).AND.(I.EQ.NBNN1)) IFI=5 205 : IF ((IPT1.ITYPEL.NE.14).AND.(I.EQ.NBNN1)) IFI=1 206 : I1=IPT1.NUM(I,J) 207 : I2=IPT1.NUM(IFI,J) 208 : J1=ICPR(MIN(I1,I2)) 209 : J2=MAX(I1,I2) 210 : KSCOL=IPT1.ICOLOR(J) 211 : ITF=0 212 : 34 ITF=ITF+1 213 : IF (ITF.GT.NKMAX) GOTO 61 214 : IF (KON(J1,ITF,1).EQ.J2) GOTO 35 215 : IF (KON(J1,ITF,1).NE.0) GOTO 34 216 : KON(J1,ITF,1)=J2 217 : KON(J1,ITF,3)=KSCOL 218 : IREFI=(IDIM+1)*(I1-1) 219 : IREFJ=(IDIM+1)*(I2-1) 220 : NBPTS=XCOOR(/1)/(IDIM+1)+1 221 : SEGADJ MCOORD 222 : DO 71 K=1,IDIM+1 223 : XCOOR((NBPTS-1)*(IDIM+1)+K)=0.5D0*(XCOOR(IREFI+K)+XCOOR(IREFJ+K)) 224 : 71 CONTINUE 225 : KON(J1,ITF,2)=XCOOR(/1)/(IDIM+1) 226 : 35 IPT2.NUM(2*I+IND,J)=KON(J1,ITF,2) 227 : IPT2.ICOLOR(J)=KON(J1,ITF,3) 228 : IF ((IPT1.ITYPEL.NE.14).OR.(I.GT.4)) GOTO 38 229 : I2=IPT1.NUM(I+4,J) 230 : J1=ICPR(MIN(I1,I2)) 231 : J2=MAX(I1,I2) 232 : ITF=0 233 : 36 ITF=ITF+1 234 : IF (ITF.GT.NKMAX) GOTO 61 235 : IF (KON(J1,ITF,1).EQ.J2) GOTO 37 236 : IF (KON(J1,ITF,1).NE.0) GOTO 36 237 : KON(J1,ITF,1)=J2 238 : IREFI=(IDIM+1)*(I1-1) 239 : IREFJ=(IDIM+1)*(I2-1) 240 : NBPTS=XCOOR(/1)/(IDIM+1)+1 241 : SEGADJ MCOORD 242 : DO 72 K=1,IDIM+1 243 : XCOOR((NBPTS-1)*(IDIM+1)+K)=0.5D0*(XCOOR(IREFI+K)+XCOOR(IREFJ+K)) 244 : 72 CONTINUE 245 : KON(J1,ITF,2)=XCOOR(/1)/(IDIM+1) 246 : 37 IPT2.NUM(I+8,J)=KON(J1,ITF,2) 247 : IPT2.ICOLOR(J)=KON(J1,ITF,3) 248 : 38 CONTINUE 249 : IF (IPT1.LISREF(/1).EQ.0) GOTO 48 250 : C 251 : C MISE A JOUR DES COTES DE L'OBJET. 252 : DO 46 IN=1,IPT1.LISREF(/1) 253 : IPT3=IPT1.LISREF(IN) 254 : SEGACT IPT3 255 : IF (IPT3.ITYPEL.EQ.2) GOTO 40 256 : IF (IPT3.ITYPEL.EQ.8) GOTO 41 257 : IPT2.LISREF(IN)=IPT3 258 : GOTO 46 259 : 40 NBELEM=IPT3.NUM(/2) 260 : NBNN=3 261 : NBSOUS=0 262 : NBREF=IPT3.LISREF(/1) 263 : SEGINI IPT4 264 : IPT4.ITYPEL=3 265 : GOTO 42 266 : 41 NBELEM=IPT3.NUM(/2) 267 : NBNN=8 268 : NBSOUS=0 269 : * pv on ne cree pas les cotes NBREF=IPT3.LISREF(/1) 270 : nbref=0 271 : SEGINI IPT4 272 : IPT4.ITYPEL=10 273 : 42 NBNN3=IPT3.NUM(/1) 274 : DO 44 J=1,NBELEM 275 : DO 44 I=1,NBNN3 276 : IFI=I+1 277 : IF (I.EQ.NBNN3) IFI=1 278 : I1=IPT3.NUM(I,J) 279 : I2=IPT3.NUM(IFI,J) 280 : IPT4.NUM(2*I-1,J)=I1 281 : IPT4.ICOLOR(J)=IPT3.ICOLOR(J) 282 : IF ((NBNN3.EQ.2).AND.(IFI.EQ.1)) GOTO 44 283 : J1=ICPR(MIN(I1,I2)) 284 : J2=MAX(I1,I2) 285 : ITF=0 286 : 43 ITF=ITF+1 287 : IF (KON(J1,ITF,1).NE.J2) GOTO 43 288 : IPT4.NUM(2*I,J)=KON(J1,ITF,2) 289 : IPT4.ICOLOR(J)=KON(J1,ITF,3) 290 : 44 CONTINUE 291 : IPT2.LISREF(IN)=IPT4 292 : SEGDES IPT4 293 : SEGDES IPT3 294 : 46 CONTINUE 295 : 48 SEGSUP ICPR,NKON,KON 296 : IF ((IPT2.ITYPEL.EQ.KSURF(ITY)).OR.(IPT2.ITYPEL.EQ.15)) GOTO 100 297 : SEGDES IPT1 298 : IPT1=IPT2 299 : 50 IF (KSURF(ITY).NE.6.OR.IPT1.ITYPEL.NE.10) GOTO 60 300 : C 301 : C ON CHANGE DES Q8 EN COUPLES DE TRI6 302 : C 303 : SEGACT MCOORD 304 : NBELEM=2*IPT1.NUM(/2) 305 : NBNN=6 306 : NBSOUS=0 307 : NBREF=IPT1.LISREF(/1) 308 : SEGINI IPT2 309 : IPT2.ITYPEL=6 310 : IF (NBREF.EQ.0) GOTO 51 311 : DO 52 I=1,NBREF 312 : IPT2.LISREF(I)=IPT1.LISREF(I) 313 : 52 CONTINUE 314 : 51 CONTINUE 315 : NBPTT=XCOOR(/1)/(IDIM+1) 316 : NBPTS=NBPTT+IPT1.NUM(/2) 317 : SEGADJ MCOORD 318 : DO 53 I=1,IPT1.NUM(/2),2 319 : J=2*I-1 320 : I1=IPT1.NUM(1,I) 321 : I2=IPT1.NUM(3,I) 322 : I3=IPT1.NUM(5,I) 323 : I4=IPT1.NUM(7,I) 324 : IREF1=(I1-1)*(IDIM+1) 325 : IREF2=(I2-1)*(IDIM+1) 326 : IREF3=(I3-1)*(IDIM+1) 327 : IREF4=(I4-1)*(IDIM+1) 328 : DO 73 K=1,IDIM+1 329 : XCOOR(NBPTT*(IDIM+1)+K)= 330 : $0.25D0*(XCOOR(IREF1+K)+XCOOR(IREF2+K)+ 331 : $ XCOOR(IREF3+K)+XCOOR(IREF4+K)) 332 : 73 CONTINUE 333 : NBPTT=NBPTT+1 334 : ISUP=NBPTT 335 : IPT2.NUM(1,J)=I1 336 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 337 : IPT2.NUM(3,J)=I2 338 : IPT2.NUM(4,J)=IPT1.NUM(4,I) 339 : IPT2.NUM(5,J)=I3 340 : IPT2.NUM(6,J)=ISUP 341 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 342 : J=J+1 343 : IPT2.NUM(1,J)=I1 344 : IPT2.NUM(2,J)=ISUP 345 : IPT2.NUM(3,J)=I3 346 : IPT2.NUM(4,J)=IPT1.NUM(6,I) 347 : IPT2.NUM(5,J)=I4 348 : IPT2.NUM(6,J)=IPT1.NUM(8,I) 349 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 350 : J=J+1 351 : IF (J.GT.IPT2.NUM(/2)) GOTO 53 352 : I1=IPT1.NUM(1,I+1) 353 : I2=IPT1.NUM(3,I+1) 354 : I3=IPT1.NUM(5,I+1) 355 : I4=IPT1.NUM(7,I+1) 356 : IREF1=(I1-1)*(IDIM+1) 357 : IREF2=(I2-1)*(IDIM+1) 358 : IREF3=(I3-1)*(IDIM+1) 359 : IREF4=(I4-1)*(IDIM+1) 360 : DO 74 K=1,IDIM+1 361 : XCOOR(NBPTT*(IDIM+1)+K)= 362 : #0.25D0*(XCOOR(IREF1+K)+XCOOR(IREF2+K)+ 363 : $ XCOOR(IREF3+K)+XCOOR(IREF4+K)) 364 : 74 CONTINUE 365 : NBPTT=NBPTT+1 366 : ISUP=NBPTT 367 : IPT2.NUM(1,J)=I1 368 : IPT2.NUM(2,J)=IPT1.NUM(2,I+1) 369 : IPT2.NUM(3,J)=I2 370 : IPT2.NUM(4,J)=ISUP 371 : IPT2.NUM(5,J)=I4 372 : IPT2.NUM(6,J)=IPT1.NUM(8,I+1) 373 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1) 374 : J=J+1 375 : IPT2.NUM(1,J)=I2 376 : IPT2.NUM(2,J)=IPT1.NUM(4,I+1) 377 : IPT2.NUM(3,J)=I3 378 : IPT2.NUM(4,J)=IPT1.NUM(6,I+1) 379 : IPT2.NUM(5,J)=I4 380 : IPT2.NUM(6,J)=ISUP 381 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1) 382 : 53 CONTINUE 383 : GOTO 100 384 : 60 CONTINUE 385 : IF(IPT1.ITYPEL.NE.3.OR.KDEGRE(ITY).NE.2) GO TO 70 386 : N1=IPT1.NUM(/2) 387 : NBELEM=N1*2 388 : NBNN=2 389 : NBSOUS=0 390 : NBREF=0 391 : SEGINI IPT2 392 : IPT2.ITYPEL=2 393 : DO 63 I=1,N1 394 : I2=(I-1)*2+1 395 : IPT2.NUM(1,I2 )=IPT1.NUM(1,I) 396 : IPT2.NUM(2,I2 )=IPT1.NUM(2,I) 397 : IPT2.ICOLOR(I2)=IPT1.ICOLOR(I) 398 : IPT2.NUM(1,I2+1)=IPT1.NUM(2,I) 399 : IPT2.NUM(2,I2+1)=IPT1.NUM(3,I) 400 : IPT2.ICOLOR(I2+1)=IPT1.ICOLOR(I) 401 : 63 CONTINUE 402 : GO TO 100 403 : 70 CONTINUE 404 : C ON CHANGE DES T6 EN QUATRE T3 405 : IF(IPT1.ITYPEL.NE.6.OR.KSURF(ITY).NE.4) GO TO 80 406 : C 407 : NBELEM=4*IPT1.NUM(/2) 408 : NBNN=3 409 : NBSOUS=0 410 : * on oublie les cotes ou contours 411 : NBREF=0 412 : SEGINI IPT2 413 : IPT2.ITYPEL=4 414 : DO 77 I=1,IPT1.NUM(/2) 415 : J=4*I-3 416 : IPT2.NUM(1,J)=IPT1.NUM(1,I) 417 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 418 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 419 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 420 : J=J+1 421 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 422 : IPT2.NUM(2,J)=IPT1.NUM(3,I) 423 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 424 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 425 : J=J+1 426 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 427 : IPT2.NUM(2,J)=IPT1.NUM(5,I) 428 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 429 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 430 : J=J+1 431 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 432 : IPT2.NUM(2,J)=IPT1.NUM(4,I) 433 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 434 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 435 : 77 CONTINUE 436 : GOTO 100 437 : 80 CONTINUE 438 : C ON CHANGE DES Q8 EN SIX T3 439 : IF(IPT1.ITYPEL.NE.10.OR.KSURF(ITY).NE.4) GO TO 90 440 : C 441 : NBELEM=6*IPT1.NUM(/2) 442 : NBNN=3 443 : NBSOUS=0 444 : * on oublie les cotes ou contours 445 : NBREF=0 446 : SEGINI IPT2 447 : IPT2.ITYPEL=4 448 : DO 83 I=1,IPT1.NUM(/2) 449 : J=6*I-5 450 : IPT2.NUM(1,J)=IPT1.NUM(1,I) 451 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 452 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 453 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 454 : J=J+1 455 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 456 : IPT2.NUM(2,J)=IPT1.NUM(3,I) 457 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 458 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 459 : J=J+1 460 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 461 : IPT2.NUM(2,J)=IPT1.NUM(5,I) 462 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 463 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 464 : J=J+1 465 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 466 : IPT2.NUM(2,J)=IPT1.NUM(4,I) 467 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 468 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 469 : J=J+1 470 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 471 : IPT2.NUM(2,J)=IPT1.NUM(6,I) 472 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 473 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 474 : J=J+1 475 : IPT2.NUM(1,J)=IPT1.NUM(6,I) 476 : IPT2.NUM(2,J)=IPT1.NUM(7,I) 477 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 478 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 479 : 83 CONTINUE 480 : GOTO 100 481 : 90 CONTINUE 482 : C ON CHANGE DES CUB8 EN CINQ TET4 483 : IF(IPT1.ITYPEL.NE.14.OR.ITY.NE.23) GO TO 130 484 : C 485 : NBELEM=5*IPT1.NUM(/2) 486 : NBNN=4 487 : NBSOUS=0 488 : * on oublie les cotes ou contours ou faces 489 : NBREF=0 490 : SEGINI IPT2 491 : IPT2.ITYPEL=23 492 : DO 93 I=1,IPT1.NUM(/2) 493 : J=5*I-4 494 : IPT2.NUM(1,J)=IPT1.NUM(1,I) 495 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 496 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 497 : IPT2.NUM(4,J)=IPT1.NUM(5,I) 498 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 499 : J=J+1 500 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 501 : IPT2.NUM(2,J)=IPT1.NUM(3,I) 502 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 503 : IPT2.NUM(4,J)=IPT1.NUM(7,I) 504 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 505 : J=J+1 506 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 507 : IPT2.NUM(2,J)=IPT1.NUM(5,I) 508 : IPT2.NUM(3,J)=IPT1.NUM(7,I) 509 : IPT2.NUM(4,J)=IPT1.NUM(8,I) 510 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 511 : J=J+1 512 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 513 : IPT2.NUM(2,J)=IPT1.NUM(5,I) 514 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 515 : IPT2.NUM(4,J)=IPT1.NUM(7,I) 516 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 517 : J=J+1 518 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 519 : IPT2.NUM(2,J)=IPT1.NUM(4,I) 520 : IPT2.NUM(3,J)=IPT1.NUM(5,I) 521 : IPT2.NUM(4,J)=IPT1.NUM(7,I) 522 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 523 : 93 CONTINUE 524 : GOTO 100 525 : 130 CONTINUE 526 : C ON CHANGE DES PRI6 EN TROIS TET4 527 : IF(IPT1.ITYPEL.NE.16.OR.ITY.NE.23) GO TO 140 528 : C 529 : NBELEM=3*IPT1.NUM(/2) 530 : NBNN=4 531 : NBSOUS=0 532 : * on oublie les cotes ou contours ou faces 533 : NBREF=0 534 : SEGINI IPT2 535 : IPT2.ITYPEL=23 536 : DO 133 I=1,IPT1.NUM(/2) 537 : J=3*I-2 538 : IPT2.NUM(1,J)=IPT1.NUM(1,I) 539 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 540 : IPT2.NUM(3,J)=IPT1.NUM(3,I) 541 : IPT2.NUM(4,J)=IPT1.NUM(4,I) 542 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 543 : J=J+1 544 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 545 : IPT2.NUM(2,J)=IPT1.NUM(3,I) 546 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 547 : IPT2.NUM(4,J)=IPT1.NUM(5,I) 548 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 549 : J=J+1 550 : IPT2.NUM(1,J)=IPT1.NUM(3,I) 551 : IPT2.NUM(2,J)=IPT1.NUM(4,I) 552 : IPT2.NUM(3,J)=IPT1.NUM(5,I) 553 : IPT2.NUM(4,J)=IPT1.NUM(6,I) 554 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 555 : 133 CONTINUE 556 : GOTO 100 557 : 140 CONTINUE 558 : C ON CHANGE DES PYR5 EN DEUX TET4 559 : IF(IPT1.ITYPEL.NE.25.OR.ITY.NE.23) GO TO 150 560 : C 561 : NBELEM=2*IPT1.NUM(/2) 562 : NBNN=4 563 : NBSOUS=0 564 : * on oublie les cotes ou contours ou faces 565 : NBREF=0 566 : SEGINI IPT2 567 : IPT2.ITYPEL=23 568 : DO 143 I=1,IPT1.NUM(/2) 569 : J=2*I-1 570 : IPT2.NUM(1,J)=IPT1.NUM(1,I) 571 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 572 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 573 : IPT2.NUM(4,J)=IPT1.NUM(5,I) 574 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 575 : J=J+1 576 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 577 : IPT2.NUM(2,J)=IPT1.NUM(3,I) 578 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 579 : IPT2.NUM(4,J)=IPT1.NUM(5,I) 580 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 581 : 143 CONTINUE 582 : GOTO 100 583 : 150 CONTINUE 584 : C ON CHANGE DES TE10 EN HUIT TET4 585 : IF(IPT1.ITYPEL.NE.24.OR.ITY.NE.23) GO TO 160 586 : C 587 : NBELEM=8*IPT1.NUM(/2) 588 : NBNN=4 589 : NBSOUS=0 590 : * on oublie les cotes ou contours ou faces 591 : NBREF=0 592 : SEGINI IPT2 593 : IPT2.ITYPEL=23 594 : DO 153 I=1,IPT1.NUM(/2) 595 : J=8*I-7 596 : IPT2.NUM(1,J)=IPT1.NUM(1,I) 597 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 598 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 599 : IPT2.NUM(4,J)=IPT1.NUM(7,I) 600 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 601 : J=J+1 602 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 603 : IPT2.NUM(2,J)=IPT1.NUM(3,I) 604 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 605 : IPT2.NUM(4,J)=IPT1.NUM(8,I) 606 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 607 : J=J+1 608 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 609 : IPT2.NUM(2,J)=IPT1.NUM(5,I) 610 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 611 : IPT2.NUM(4,J)=IPT1.NUM(9,I) 612 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 613 : J=J+1 614 : IPT2.NUM(1,J)=IPT1.NUM(7,I) 615 : IPT2.NUM(2,J)=IPT1.NUM(8,I) 616 : IPT2.NUM(3,J)=IPT1.NUM(9,I) 617 : IPT2.NUM(4,J)=IPT1.NUM(10,I) 618 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 619 : J=J+1 620 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 621 : IPT2.NUM(2,J)=IPT1.NUM(4,I) 622 : IPT2.NUM(3,J)=IPT1.NUM(7,I) 623 : IPT2.NUM(4,J)=IPT1.NUM(8,I) 624 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 625 : J=J+1 626 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 627 : IPT2.NUM(2,J)=IPT1.NUM(7,I) 628 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 629 : IPT2.NUM(4,J)=IPT1.NUM(9,I) 630 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 631 : J=J+1 632 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 633 : IPT2.NUM(2,J)=IPT1.NUM(4,I) 634 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 635 : IPT2.NUM(4,J)=IPT1.NUM(7,I) 636 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 637 : J=J+1 638 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 639 : IPT2.NUM(2,J)=IPT1.NUM(6,I) 640 : IPT2.NUM(3,J)=IPT1.NUM(7,I) 641 : IPT2.NUM(4,J)=IPT1.NUM(9,I) 642 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 643 : 153 CONTINUE 644 : GOTO 100 645 : 160 CONTINUE 646 : C ON CHANGE DES CU20 EN 22 TET4 647 : IF(IPT1.ITYPEL.NE.15.OR.ITY.NE.23) GO TO 170 648 : C 649 : NBELEM=22*IPT1.NUM(/2) 650 : NBNN=4 651 : NBSOUS=0 652 : * on oublie les cotes ou contours ou faces 653 : NBREF=0 654 : SEGINI IPT2 655 : IPT2.ITYPEL=23 656 : DO 163 I=1,IPT1.NUM(/2) 657 : J=22*I-21 658 : IPT2.NUM(1,J)=IPT1.NUM(1,I) 659 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 660 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 661 : IPT2.NUM(4,J)=IPT1.NUM(9,I) 662 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 663 : J=J+1 664 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 665 : IPT2.NUM(2,J)=IPT1.NUM(3,I) 666 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 667 : IPT2.NUM(4,J)=IPT1.NUM(10,I) 668 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 669 : J=J+1 670 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 671 : IPT2.NUM(2,J)=IPT1.NUM(4,I) 672 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 673 : IPT2.NUM(4,J)=IPT1.NUM(10,I) 674 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 675 : J=J+1 676 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 677 : IPT2.NUM(2,J)=IPT1.NUM(8,I) 678 : IPT2.NUM(3,J)=IPT1.NUM(9,I) 679 : IPT2.NUM(4,J)=IPT1.NUM(10,I) 680 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 681 : J=J+1 682 : IPT2.NUM(1,J)=IPT1.NUM(6,I) 683 : IPT2.NUM(2,J)=IPT1.NUM(7,I) 684 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 685 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 686 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 687 : J=J+1 688 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 689 : IPT2.NUM(2,J)=IPT1.NUM(5,I) 690 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 691 : IPT2.NUM(4,J)=IPT1.NUM(11,I) 692 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 693 : J=J+1 694 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 695 : IPT2.NUM(2,J)=IPT1.NUM(6,I) 696 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 697 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 698 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 699 : J=J+1 700 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 701 : IPT2.NUM(2,J)=IPT1.NUM(6,I) 702 : IPT2.NUM(3,J)=IPT1.NUM(11,I) 703 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 704 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 705 : J=J+1 706 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 707 : IPT2.NUM(2,J)=IPT1.NUM(10,I) 708 : IPT2.NUM(3,J)=IPT1.NUM(11,I) 709 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 710 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 711 : J=J+1 712 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 713 : IPT2.NUM(2,J)=IPT1.NUM(8,I) 714 : IPT2.NUM(3,J)=IPT1.NUM(10,I) 715 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 716 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 717 : J=J+1 718 : IPT2.NUM(1,J)=IPT1.NUM(8,I) 719 : IPT2.NUM(2,J)=IPT1.NUM(9,I) 720 : IPT2.NUM(3,J)=IPT1.NUM(10,I) 721 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 722 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 723 : J=J+1 724 : IPT2.NUM(1,J)=IPT1.NUM(9,I) 725 : IPT2.NUM(2,J)=IPT1.NUM(10,I) 726 : IPT2.NUM(3,J)=IPT1.NUM(12,I) 727 : IPT2.NUM(4,J)=IPT1.NUM(20,I) 728 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 729 : J=J+1 730 : IPT2.NUM(1,J)=IPT1.NUM(10,I) 731 : IPT2.NUM(2,J)=IPT1.NUM(12,I) 732 : IPT2.NUM(3,J)=IPT1.NUM(16,I) 733 : IPT2.NUM(4,J)=IPT1.NUM(20,I) 734 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 735 : J=J+1 736 : IPT2.NUM(1,J)=IPT1.NUM(10,I) 737 : IPT2.NUM(2,J)=IPT1.NUM(11,I) 738 : IPT2.NUM(3,J)=IPT1.NUM(12,I) 739 : IPT2.NUM(4,J)=IPT1.NUM(16,I) 740 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 741 : J=J+1 742 : IPT2.NUM(1,J)=IPT1.NUM(10,I) 743 : IPT2.NUM(2,J)=IPT1.NUM(15,I) 744 : IPT2.NUM(3,J)=IPT1.NUM(16,I) 745 : IPT2.NUM(4,J)=IPT1.NUM(14,I) 746 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 747 : J=J+1 748 : IPT2.NUM(1,J)=IPT1.NUM(11,I) 749 : IPT2.NUM(2,J)=IPT1.NUM(16,I) 750 : IPT2.NUM(3,J)=IPT1.NUM(17,I) 751 : IPT2.NUM(4,J)=IPT1.NUM(18,I) 752 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 753 : J=J+1 754 : IPT2.NUM(1,J)=IPT1.NUM(12,I) 755 : IPT2.NUM(2,J)=IPT1.NUM(18,I) 756 : IPT2.NUM(3,J)=IPT1.NUM(19,I) 757 : IPT2.NUM(4,J)=IPT1.NUM(20,I) 758 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 759 : J=J+1 760 : IPT2.NUM(1,J)=IPT1.NUM(11,I) 761 : IPT2.NUM(2,J)=IPT1.NUM(12,I) 762 : IPT2.NUM(3,J)=IPT1.NUM(16,I) 763 : IPT2.NUM(4,J)=IPT1.NUM(18,I) 764 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 765 : J=J+1 766 : IPT2.NUM(1,J)=IPT1.NUM(12,I) 767 : IPT2.NUM(2,J)=IPT1.NUM(16,I) 768 : IPT2.NUM(3,J)=IPT1.NUM(18,I) 769 : IPT2.NUM(4,J)=IPT1.NUM(20,I) 770 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 771 : J=J+1 772 : IPT2.NUM(1,J)=IPT1.NUM(9,I) 773 : IPT2.NUM(2,J)=IPT1.NUM(13,I) 774 : IPT2.NUM(3,J)=IPT1.NUM(14,I) 775 : IPT2.NUM(4,J)=IPT1.NUM(20,I) 776 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 777 : J=J+1 778 : IPT2.NUM(1,J)=IPT1.NUM(9,I) 779 : IPT2.NUM(2,J)=IPT1.NUM(10,I) 780 : IPT2.NUM(3,J)=IPT1.NUM(14,I) 781 : IPT2.NUM(4,J)=IPT1.NUM(16,I) 782 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 783 : J=J+1 784 : IPT2.NUM(1,J)=IPT1.NUM(9,I) 785 : IPT2.NUM(2,J)=IPT1.NUM(14,I) 786 : IPT2.NUM(3,J)=IPT1.NUM(16,I) 787 : IPT2.NUM(4,J)=IPT1.NUM(20,I) 788 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 789 : 163 CONTINUE 790 : GOTO 100 791 : 170 CONTINUE 792 : C ON CHANGE DES PY13 EN 13 TET4 793 : IF(IPT1.ITYPEL.NE.26.OR.ITY.NE.23) GO TO 180 794 : C 795 : NBELEM=13*IPT1.NUM(/2) 796 : NBNN=4 797 : NBSOUS=0 798 : NBREF=IPT1.LISREF(/1) 799 : SEGINI IPT2 800 : IPT2.ITYPEL=23 801 : * on oublie les cotes ou contours ou faces 802 : NBREF=0 803 : DO 173 I=1,IPT1.NUM(/2) 804 : J=13*I-12 805 : IPT2.NUM(1,J)=IPT1.NUM(1,I) 806 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 807 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 808 : IPT2.NUM(4,J)=IPT1.NUM(9,I) 809 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 810 : J=J+1 811 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 812 : IPT2.NUM(2,J)=IPT1.NUM(3,I) 813 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 814 : IPT2.NUM(4,J)=IPT1.NUM(10,I) 815 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 816 : J=J+1 817 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 818 : IPT2.NUM(2,J)=IPT1.NUM(4,I) 819 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 820 : IPT2.NUM(4,J)=IPT1.NUM(10,I) 821 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 822 : J=J+1 823 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 824 : IPT2.NUM(2,J)=IPT1.NUM(8,I) 825 : IPT2.NUM(3,J)=IPT1.NUM(9,I) 826 : IPT2.NUM(4,J)=IPT1.NUM(10,I) 827 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 828 : J=J+1 829 : IPT2.NUM(1,J)=IPT1.NUM(6,I) 830 : IPT2.NUM(2,J)=IPT1.NUM(7,I) 831 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 832 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 833 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 834 : J=J+1 835 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 836 : IPT2.NUM(2,J)=IPT1.NUM(5,I) 837 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 838 : IPT2.NUM(4,J)=IPT1.NUM(11,I) 839 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 840 : J=J+1 841 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 842 : IPT2.NUM(2,J)=IPT1.NUM(6,I) 843 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 844 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 845 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 846 : J=J+1 847 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 848 : IPT2.NUM(2,J)=IPT1.NUM(6,I) 849 : IPT2.NUM(3,J)=IPT1.NUM(11,I) 850 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 851 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 852 : J=J+1 853 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 854 : IPT2.NUM(2,J)=IPT1.NUM(10,I) 855 : IPT2.NUM(3,J)=IPT1.NUM(11,I) 856 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 857 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 858 : J=J+1 859 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 860 : IPT2.NUM(2,J)=IPT1.NUM(8,I) 861 : IPT2.NUM(3,J)=IPT1.NUM(10,I) 862 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 863 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 864 : J=J+1 865 : IPT2.NUM(1,J)=IPT1.NUM(8,I) 866 : IPT2.NUM(2,J)=IPT1.NUM(9,I) 867 : IPT2.NUM(3,J)=IPT1.NUM(10,I) 868 : IPT2.NUM(4,J)=IPT1.NUM(12,I) 869 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 870 : J=J+1 871 : IPT2.NUM(1,J)=IPT1.NUM(9,I) 872 : IPT2.NUM(2,J)=IPT1.NUM(10,I) 873 : IPT2.NUM(3,J)=IPT1.NUM(12,I) 874 : IPT2.NUM(4,J)=IPT1.NUM(13,I) 875 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 876 : J=J+1 877 : IPT2.NUM(1,J)=IPT1.NUM(10,I) 878 : IPT2.NUM(2,J)=IPT1.NUM(11,I) 879 : IPT2.NUM(3,J)=IPT1.NUM(12,I) 880 : IPT2.NUM(4,J)=IPT1.NUM(13,I) 881 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 882 : 173 CONTINUE 883 : GOTO 100 884 : 180 CONTINUE 885 : C ON CHANGE DES PR15 EN 14 TET4 886 : C PP IF(IPT1.ITYPEL.NE.17.OR.ITY.NE.23) GO TO 770 887 : IF(IPT1.ITYPEL.NE.17.OR.ITY.NE.23) GO TO 200 888 : C 889 : NBELEM=14*IPT1.NUM(/2) 890 : NBNN=4 891 : NBSOUS=0 892 : * on oublie les cotes ou contours ou faces 893 : NBREF=0 894 : SEGINI IPT2 895 : IPT2.ITYPEL=23 896 : DO 183 I=1,IPT1.NUM(/2) 897 : J=14*I-13 898 : IPT2.NUM(1,J)=IPT1.NUM(1,I) 899 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 900 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 901 : IPT2.NUM(4,J)=IPT1.NUM(7,I) 902 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 903 : J=J+1 904 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 905 : IPT2.NUM(2,J)=IPT1.NUM(3,I) 906 : IPT2.NUM(3,J)=IPT1.NUM(4,I) 907 : IPT2.NUM(4,J)=IPT1.NUM(8,I) 908 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 909 : J=J+1 910 : IPT2.NUM(1,J)=IPT1.NUM(4,I) 911 : IPT2.NUM(2,J)=IPT1.NUM(5,I) 912 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 913 : IPT2.NUM(4,J)=IPT1.NUM(9,I) 914 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 915 : J=J+1 916 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 917 : IPT2.NUM(2,J)=IPT1.NUM(4,I) 918 : IPT2.NUM(3,J)=IPT1.NUM(6,I) 919 : IPT2.NUM(4,J)=IPT1.NUM(9,I) 920 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 921 : J=J+1 922 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 923 : IPT2.NUM(2,J)=IPT1.NUM(4,I) 924 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 925 : IPT2.NUM(4,J)=IPT1.NUM(9,I) 926 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 927 : J=J+1 928 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 929 : IPT2.NUM(2,J)=IPT1.NUM(6,I) 930 : IPT2.NUM(3,J)=IPT1.NUM(7,I) 931 : IPT2.NUM(4,J)=IPT1.NUM(9,I) 932 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 933 : J=J+1 934 : IPT2.NUM(1,J)=IPT1.NUM(2,I) 935 : IPT2.NUM(2,J)=IPT1.NUM(7,I) 936 : IPT2.NUM(3,J)=IPT1.NUM(8,I) 937 : IPT2.NUM(4,J)=IPT1.NUM(9,I) 938 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 939 : J=J+1 940 : IPT2.NUM(1,J)=IPT1.NUM(7,I) 941 : IPT2.NUM(2,J)=IPT1.NUM(8,I) 942 : IPT2.NUM(3,J)=IPT1.NUM(9,I) 943 : IPT2.NUM(4,J)=IPT1.NUM(11,I) 944 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 945 : J=J+1 946 : IPT2.NUM(1,J)=IPT1.NUM(7,I) 947 : IPT2.NUM(2,J)=IPT1.NUM(10,I) 948 : IPT2.NUM(3,J)=IPT1.NUM(11,I) 949 : IPT2.NUM(4,J)=IPT1.NUM(15,I) 950 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 951 : J=J+1 952 : IPT2.NUM(1,J)=IPT1.NUM(9,I) 953 : IPT2.NUM(2,J)=IPT1.NUM(13,I) 954 : IPT2.NUM(3,J)=IPT1.NUM(14,I) 955 : IPT2.NUM(4,J)=IPT1.NUM(15,I) 956 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 957 : J=J+1 958 : IPT2.NUM(1,J)=IPT1.NUM(9,I) 959 : IPT2.NUM(2,J)=IPT1.NUM(11,I) 960 : IPT2.NUM(3,J)=IPT1.NUM(13,I) 961 : IPT2.NUM(4,J)=IPT1.NUM(15,I) 962 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 963 : J=J+1 964 : IPT2.NUM(1,J)=IPT1.NUM(7,I) 965 : IPT2.NUM(2,J)=IPT1.NUM(9,I) 966 : IPT2.NUM(3,J)=IPT1.NUM(11,I) 967 : IPT2.NUM(4,J)=IPT1.NUM(15,I) 968 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 969 : J=J+1 970 : IPT2.NUM(1,J)=IPT1.NUM(8,I) 971 : IPT2.NUM(2,J)=IPT1.NUM(9,I) 972 : IPT2.NUM(3,J)=IPT1.NUM(11,I) 973 : IPT2.NUM(4,J)=IPT1.NUM(13,I) 974 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 975 : J=J+1 976 : IPT2.NUM(1,J)=IPT1.NUM(8,I) 977 : IPT2.NUM(2,J)=IPT1.NUM(11,I) 978 : IPT2.NUM(3,J)=IPT1.NUM(12,I) 979 : IPT2.NUM(4,J)=IPT1.NUM(13,I) 980 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 981 : 183 CONTINUE 982 : GOTO 100 983 : C+PP 984 : 200 CONTINUE 985 : IF(IPT1.ITYPEL.NE.10.OR.KSURF(ITY).NE.11) GO TO 210 986 : C 987 : C ON CHANGE DES Q8 EN Q9 988 : C 989 : C ON CHERCHE LES DIMENSIONS DU MAILLAGE 990 : NBELEM=IPT1.NUM(/2) 991 : NBNN=9 992 : NBSOUS=0 993 : NBREF=IPT1.LISREF(/1) 994 : C ON CREE LE MAILLAGE 995 : SEGINI IPT2 996 : C ON REMPLIT LE TYPE ET LES REFERENCES 997 : IPT2.ITYPEL=11 998 : IF (NBREF.NE.0) THEN 999 : DO 201 I=1,NBREF 1000 : IPT2.LISREF(I)=IPT1.LISREF(I) 1001 : 201 CONTINUE 1002 : ENDIF 1003 : C ON ALLONGE LE TABLEAU DES COORDONNEES 1004 : SEGACT MCOORD 1005 : NBPTT=XCOOR(/1)/(IDIM+1) 1006 : NBPTS=NBPTT+NBELEM 1007 : SEGADJ MCOORD 1008 : C ON BOUCLE SUR LES ELEMENTS 1009 : DO 209 I=1,IPT1.NUM(/2) 1010 : C ON CHERCHE LES COORDONNEES DU NOUVEAU POINT 1010 : CALL ZERO(Q89,4,1) 1011 : DO 203 J=1,8 1012 : IREFJ=(IPT1.NUM(J,I)-1)*(IDIM+1) 1013 : DO 202 K=1,IDIM+1 1014 : Q89(K)=Q89(K)+XCOOR(IREFJ+K) 1015 : 202 CONTINUE 1016 : 203 CONTINUE 1017 : C ON STOCKE LE NOUVEAU POINT 1018 : DO 204 K=1,IDIM+1 1019 : XCOOR(NBPTT*(IDIM+1)+K)=Q89(K)*0.125D0 1020 : 204 CONTINUE 1021 : NBPTT=NBPTT+1 1022 : C ON REMPLIE LE NOUVEL ELEMENT 1023 : DO 205 J=1,8 1024 : IPT2.NUM(J,I)=IPT1.NUM(J,I) 1025 : 205 CONTINUE 1026 : IPT2.NUM(9,I)=NBPTT 1027 : C ON DUPLIQUE LA COULEUR 1028 : IPT2.ICOLOR(I)=IPT1.ICOLOR(I) 1029 : 209 CONTINUE 1030 : C ON A FINI 1031 : GOTO 100 1032 : C 1033 : 210 CONTINUE 1034 : IF(IPT1.ITYPEL.NE.11.OR.KSURF(ITY).NE.8) GO TO 220 1035 : C 1036 : C ON CHANGE DES Q9 EN QUATRE Q4 1037 : C 1038 : C ON CHERCHE LES DIMENSIONS DU MAILLAGE 1039 : NBELEM=4*IPT1.NUM(/2) 1040 : NBNN=4 1041 : NBSOUS=0 1042 : * on oublie les cotes ou contours ou faces 1043 : NBREF=0 1044 : C ON CREE LE MAILLAGE 1045 : SEGINI IPT2 1046 : C ON REMPLIT LE TYPE ET LES REFERENCES 1047 : IPT2.ITYPEL=8 1048 : C ON BOUCLE SUR LES GROS ELEMENTS 1049 : DO 215 I=1,IPT1.NUM(/2) 1050 : C ON LES TRANSFORME EN QUATRE PETITS 1051 : J=4*(I-1) 1052 : C 1ER ELEMENT 1053 : J=J+1 1054 : IPT2.NUM(1,J)=IPT1.NUM(9,I) 1055 : IPT2.NUM(2,J)=IPT1.NUM(8,I) 1056 : IPT2.NUM(3,J)=IPT1.NUM(1,I) 1057 : IPT2.NUM(4,J)=IPT1.NUM(2,I) 1058 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 1059 : C 2EME ELEMENT 1060 : J=J+1 1061 : IPT2.NUM(1,J)=IPT1.NUM(9,I) 1062 : IPT2.NUM(2,J)=IPT1.NUM(2,I) 1063 : IPT2.NUM(3,J)=IPT1.NUM(3,I) 1064 : IPT2.NUM(4,J)=IPT1.NUM(4,I) 1065 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 1066 : C 3EME ELEMENT 1067 : J=J+1 1068 : IPT2.NUM(1,J)=IPT1.NUM(9,I) 1069 : IPT2.NUM(2,J)=IPT1.NUM(4,I) 1070 : IPT2.NUM(3,J)=IPT1.NUM(5,I) 1071 : IPT2.NUM(4,J)=IPT1.NUM(6,I) 1072 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 1073 : C 4EME ELEMENT 1074 : J=J+1 1075 : IPT2.NUM(1,J)=IPT1.NUM(9,I) 1076 : IPT2.NUM(2,J)=IPT1.NUM(6,I) 1077 : IPT2.NUM(3,J)=IPT1.NUM(7,I) 1078 : IPT2.NUM(4,J)=IPT1.NUM(8,I) 1079 : IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 1080 : C 1081 : 215 CONTINUE 1082 : C ON A FINI 1083 : GOTO 100 1084 : C+PP 1085 : 220 CONTINUE 1086 : IF(IPT1.ITYPEL.NE.6.OR.KSURF(ITY).NE.7) GO TO 770 1087 : C 1088 : C ON CHANGE DES T6 EN T7 1089 : C 1090 : C ON CHERCHE LES DIMENSIONS DU MAILLAGE 1091 : NBELEM=IPT1.NUM(/2) 1092 : NBNN=7 1093 : NBSOUS=0 1094 : NBREF=IPT1.LISREF(/1) 1095 : C ON CREE LE MAILLAGE 1096 : SEGINI IPT2 1097 : C ON REMPLIT LE TYPE ET LES REFERENCES 1098 : IPT2.ITYPEL=7 1099 : IF (NBREF.NE.0) THEN 1100 : DO 221 I=1,NBREF 1101 : IPT2.LISREF(I)=IPT1.LISREF(I) 1102 : 221 CONTINUE 1103 : ENDIF 1104 : C ON ALLONGE LE TABLEAU DES COORDONNEES 1105 : SEGACT MCOORD 1106 : NBPTT=XCOOR(/1)/(IDIM+1) 1107 : NBPTS=NBPTT+NBELEM 1108 : SEGADJ MCOORD 1109 : C ON BOUCLE SUR LES ELEMENTS 1110 : DO 229 I=1,IPT1.NUM(/2) 1111 : C ON CHERCHE LES COORDONNEES DU NOUVEAU POINT 1111 : CALL ZERO(Q89,3,1) 1112 : DO 223 J=1,6 1113 : IREFJ=(IPT1.NUM(J,I)-1)*(IDIM+1) 1114 : DO 222 K=1,IDIM+1 1115 : Q89(K)=Q89(K)+XCOOR(IREFJ+K) 1116 : 222 CONTINUE 1117 : 223 CONTINUE 1118 : C ON STOCKE LE NOUVEAU POINT 1119 : DO 224 K=1,IDIM+1 1120 : XCOOR(NBPTT*(IDIM+1)+K)=Q89(K)/6.D0 1121 : 224 CONTINUE 1122 : NBPTT=NBPTT+1 1123 : C ON REMPLIE LE NOUVEL ELEMENT 1124 : DO 225 J=1,6 1125 : IPT2.NUM(J,I)=IPT1.NUM(J,I) 1126 : 225 CONTINUE 1127 : IPT2.NUM(7,I)=NBPTT 1128 : C ON DUPLIQUE LA COULEUR 1129 : IPT2.ICOLOR(I)=IPT1.ICOLOR(I) 1130 : 229 CONTINUE 1131 : C ON A FINI 1132 : GOTO 100 1133 : * 1133 : 770 CALL ERREUR(29) 1134 : RETURN 1135 : 61 SEGSUP KON 1136 : NKMAX=NKMAX+1 1137 : IF (IIMPI.NE.0) WRITE (IOIMP,1000) NKMAX 1138 : 1000 FORMAT(/,' NOUVELLE VALEUR DE NKMAX TENTEE DANS CHANGE ',I4) 1139 : GOTO 26 1140 : 100 CONTINUE 1141 : * ON LAISSE IPT2 ACTIF CAR BEAUCOUP DE GENS L'UTILISE AINSI 1142 : IPT1=IPT2 1143 : RETURN 1144 : END 1145 : 1146 : 1147 : 1148 : 1149 : 1150 : 1151 : 1152 : 1153 : 1154 : 1155 : 1156 : 1157 : 1158 : 1159 : 1160 : 1161 : 1162 :
© Cast3M 2003 - All rights reserved.
Disclaimer