C CHANGE SOURCE PV 20/04/02 21:15:11 10567 C SERT A CHANGER LE TYPE DE L'ELEMENT DE L'OBJET C C CONVERSION QUA8->QUA9 C CONVERSION QUA9->QUA4 PP 9/9/92 C SUBROUTINE CHANGE(IPT1,ITY) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC CCGEOME -INC SMELEME SEGMENT NKON(IKOUR) SEGMENT KON(IKOUR,NKMAX,3) SEGMENT ICPR(nbpts) PARAMETER(NTYP2=5) CHARACTER*4 LTYP2(NTYP2),MTYP2 REAL*8 Q89(4) * DATA LTYP2/'TRI3','TET4','QUA4','CUB8','PYR5'/ * * regarder l'etat de mcoord pour remettre le meme en sortie call oooeta(mcoord,ieta,imod) * * Si ce sont des QUAF et qu'on demande à changer * en TRI3, TET4, QUA4, CUB8, PYR5, on branche vers chang2 CALL KQCEST(IPT1,IKR) IF (IKR.EQ.1341.OR.IKR.EQ.1.OR.IKR.EQ.13.OR.IKR.EQ.134) THEN MTYP2=NOMS(ITY) CALL FIMOT2(MTYP2,LTYP2,NTYP2,ITYP2,0,IRET) IF (IRET.NE.0) THEN CALL ERREUR(5) RETURN ENDIF IF (ITYP2.NE.0) THEN CALL CHANG2(IPT1,ITY) RETURN ENDIF ENDIF * SEGACT IPT1 IPT5=IPT1 IF (ITY.EQ.1) GOTO 10 c IF (IPT1.LISOUS(/1).NE.0) CALL ERREUR(25) c IF (IERR.NE.0) RETURN ISOU=1 5 CONTINUE IF (IPT5.LISOUS(/1).NE.0) THEN IPT1=IPT5.LISOUS(ISOU) SEGACT,IPT1 IF (IPT1.ITYPEL.EQ.ITY.OR.IPT1.ITYPEL.EQ.KSURF(ITY)) THEN IPT2=IPT1 GOTO 100 ENDIF ELSE IF (IPT1.ITYPEL.EQ.ITY) RETURN IF (IPT1.ITYPEL.EQ.KSURF(ITY)) RETURN ENDIF * SG 2016/11/29 Gestion maillage vide IF (IPT1.NUM(/2).EQ.0) THEN CALL MELVID(ITY,IPT2) * ON LAISSE IPT2 ACTIF CAR BEAUCOUP DE GENS L'UTILISE AINSI SEGACT IPT2*MOD GOTO 100 ENDIF IF (KSURF(ITY).NE.4.OR.IPT1.ITYPEL.NE.8) GOTO 10 C C ON CHANGE DES Q4 EN COUPLES DE T3 C NBELEM=2*IPT1.NUM(/2) NBNN=3 NBSOUS=0 NBREF=IPT1.LISREF(/1) SEGINI IPT2 IPT2.ITYPEL=4 IF (NBREF.EQ.0) GOTO 1 DO 2 I=1,NBREF IPT2.LISREF(I)=IPT1.LISREF(I) 2 CONTINUE 1 DO 3 I=1,IPT1.NUM(/2),2 J=2*I-1 IPT2.NUM(1,J)=IPT1.NUM(1,I) IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=IPT1.NUM(3,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(1,I) IPT2.NUM(2,J)=IPT1.NUM(3,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IF (J.GT.IPT2.NUM(/2)) GOTO 3 IPT2.NUM(1,J)=IPT1.NUM(1,I+1) IPT2.NUM(2,J)=IPT1.NUM(2,I+1) IPT2.NUM(3,J)=IPT1.NUM(4,I+1) IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I+1) IPT2.NUM(2,J)=IPT1.NUM(3,I+1) IPT2.NUM(3,J)=IPT1.NUM(4,I+1) IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1) 3 CONTINUE GOTO 100 10 CONTINUE * IF (IPT1.ITYPEL.EQ.ITY) RETURN IF (ITY.NE.1) GOTO 20 C C ON CHANGE EN P1 C SEGINI ICPR DO 11 I=1,nbpts ICPR(I)=0 11 CONTINUE ICON=0 IPT2=IPT1 DO 14 IOB=1,MAX(1,IPT1.LISOUS(/1)) IF (IPT1.LISOUS(/1).NE.0) THEN IPT2=IPT1.LISOUS(IOB) SEGACT IPT2 ENDIF DO 12 I=1,IPT2.NUM(/1) DO 12 J=1,IPT2.NUM(/2) IKI=IPT2.NUM(I,J) IF (ICPR(IKI).NE.0) GOTO 12 ICON=ICON+1 ICPR(IKI)=ICON 12 CONTINUE C IF (IPT1.LISOUS(/1).NE.0) SEGDES IPT2 14 CONTINUE NBSOUS=0 NBREF=0 NBELEM=ICON NBNN=1 SEGINI IPT2 IPT2.ITYPEL=1 DO 13 I=1,nbpts IF (ICPR(I).EQ.0) GOTO 13 IPT2.NUM(1,ICPR(I))=I 13 CONTINUE call crech1(ipt2,1) SEGSUP ICPR GOTO 100 * 20 IF ((IPT1.ITYPEL.NE.4.OR.KSURF(ITY).NE.6).AND. # (IPT1.ITYPEL.NE.8.OR.KSURF(ITY).NE.10).AND. # (IPT1.ITYPEL.NE.8.OR.KSURF(ITY).NE.6).AND. # (IPT1.ITYPEL.NE.14.OR.ITY.NE.15)) GOTO 50 C C ON CHANGE EVENTUELLEMENT EN DEUX TEMPS DES Q4 EN T6 C ON CHANGE DES T3 EN T6 OU DES Q4 EN Q8 OU DES CUB8 EN CUB20. C SEGINI ICPR DO 21 I=1,nbpts ICPR(I)=0 21 CONTINUE IKOUR=0 DO 22 I=1,IPT1.NUM(/1) DO 22 J=1,IPT1.NUM(/2) ITH=IPT1.NUM(I,J) IF (ICPR(ITH).NE.0) GOTO 22 IKOUR=IKOUR+1 ICPR(ITH)=IKOUR 22 CONTINUE SEGINI NKON DO 23 I=1,IKOUR NKON(I)=0 23 CONTINUE DO 24 I=1,IPT1.NUM(/1) DO 24 J=1,IPT1.NUM(/2) NKON(ICPR(IPT1.NUM(I,J)))=NKON(ICPR(IPT1.NUM(I,J)))+1 24 CONTINUE NKMAX=0 DO 25 I=1,IKOUR NKMAX=MAX(NKMAX,NKON(I)) 25 CONTINUE 26 SEGINI KON DO 27 I=1,IKOUR DO 27 J=1,NKMAX KON(I,J,1)=0 KON(I,J,2)=0 KON(I,J,3)=0 27 CONTINUE IF (IPT1.LISREF(/1).EQ.0) GOTO 33 C C REMPLISSAGE DE KON DANS LE CAS OU LES COTES DE L'OBJET C SONT A 3 NOEUDS OU 8 NOEUDS. DO 32 IN=1,IPT1.LISREF(/1) IPT3=IPT1.LISREF(IN) SEGACT IPT3 IF ((IPT3.ITYPEL.NE.3).AND.(IPT3.ITYPEL.NE.10)) GOTO 32 DO 31 J=1,IPT3.NUM(/2) DO 31 I=1,IPT3.NUM(/1),2 IFI=I+2 IF ((I.EQ.IPT3.NUM(/1)).AND.(IPT3.ITYPEL.EQ.3)) GOTO 31 IF (IFI.GT.IPT3.NUM(/1)) IFI=1 I1=IPT3.NUM(I,J) I2=IPT3.NUM(IFI,J) J1=ICPR(MIN(I1,I2)) J2=MAX(I1,I2) KSCOL=IPT3.ICOLOR(J) ITF=0 29 ITF=ITF+1 IF (ITF.GT.NKMAX) GOTO 61 IF ((KON(J1,ITF,1).EQ.J2).OR.(KON(J1,ITF,1).EQ.0)) GOTO 30 GOTO 29 30 KON(J1,ITF,1)=J2 KON(J1,ITF,2)=IPT3.NUM(I+1,J) KON(J1,ITF,3)=KSCOL 31 CONTINUE C SEGDES IPT3 32 CONTINUE C C CREATION DES NOUVEAUX NOEUDS. 33 NBELEM=IPT1.NUM(/2) NBNN1=IPT1.NUM(/1) NBNN=NBNN1*2 IF (IPT1.ITYPEL.EQ.14) NBNN=20 NBSOUS=0 NBREF=IPT1.LISREF(/1) SEGINI IPT2 IPT2.ITYPEL=IPT1.ITYPEL+2 IF (IPT1.ITYPEL.EQ.14) IPT2.ITYPEL=15 SEGACT MCOORD*mod DO 38 J=1,NBELEM DO 38 I=1,NBNN1 IND=0 IF (I.GT.4) IND=4 IPT2.NUM(2*I-1+IND,J)=IPT1.NUM(I,J) IFI=I+1 IF ((IPT1.ITYPEL.EQ.14).AND.(I.EQ.4)) IFI=1 IF ((IPT1.ITYPEL.EQ.14).AND.(I.EQ.NBNN1)) IFI=5 IF ((IPT1.ITYPEL.NE.14).AND.(I.EQ.NBNN1)) IFI=1 I1=IPT1.NUM(I,J) I2=IPT1.NUM(IFI,J) J1=ICPR(MIN(I1,I2)) J2=MAX(I1,I2) KSCOL=IPT1.ICOLOR(J) ITF=0 34 ITF=ITF+1 IF (ITF.GT.NKMAX) GOTO 61 IF (KON(J1,ITF,1).EQ.J2) GOTO 35 IF (KON(J1,ITF,1).NE.0) GOTO 34 KON(J1,ITF,1)=J2 KON(J1,ITF,3)=KSCOL IREFI=(IDIM+1)*(I1-1) IREFJ=(IDIM+1)*(I2-1) NBPTS=nbpts+1 SEGADJ MCOORD DO 71 K=1,IDIM+1 XCOOR((NBPTS-1)*(IDIM+1)+K)=0.5D0*(XCOOR(IREFI+K)+XCOOR(IREFJ+K)) 71 CONTINUE KON(J1,ITF,2)=nbpts 35 IPT2.NUM(2*I+IND,J)=KON(J1,ITF,2) IPT2.ICOLOR(J)=KON(J1,ITF,3) IF ((IPT1.ITYPEL.NE.14).OR.(I.GT.4)) GOTO 38 I2=IPT1.NUM(I+4,J) J1=ICPR(MIN(I1,I2)) J2=MAX(I1,I2) ITF=0 36 ITF=ITF+1 IF (ITF.GT.NKMAX) GOTO 61 IF (KON(J1,ITF,1).EQ.J2) GOTO 37 IF (KON(J1,ITF,1).NE.0) GOTO 36 KON(J1,ITF,1)=J2 IREFI=(IDIM+1)*(I1-1) IREFJ=(IDIM+1)*(I2-1) NBPTS=nbpts+1 SEGADJ MCOORD DO 72 K=1,IDIM+1 XCOOR((NBPTS-1)*(IDIM+1)+K)=0.5D0*(XCOOR(IREFI+K)+XCOOR(IREFJ+K)) 72 CONTINUE KON(J1,ITF,2)=nbpts 37 IPT2.NUM(I+8,J)=KON(J1,ITF,2) IPT2.ICOLOR(J)=KON(J1,ITF,3) 38 CONTINUE IF (IPT1.LISREF(/1).EQ.0) GOTO 48 C C MISE A JOUR DES COTES DE L'OBJET. DO 46 IN=1,IPT1.LISREF(/1) IPT3=IPT1.LISREF(IN) SEGACT IPT3 IF (IPT3.ITYPEL.EQ.2) GOTO 40 IF (IPT3.ITYPEL.EQ.8) GOTO 41 IPT2.LISREF(IN)=IPT3 GOTO 46 40 NBELEM=IPT3.NUM(/2) NBNN=3 NBSOUS=0 NBREF=IPT3.LISREF(/1) SEGINI IPT4 IPT4.ITYPEL=3 GOTO 42 41 NBELEM=IPT3.NUM(/2) NBNN=8 NBSOUS=0 * pv on ne cree pas les cotes NBREF=IPT3.LISREF(/1) nbref=0 SEGINI IPT4 IPT4.ITYPEL=10 42 NBNN3=IPT3.NUM(/1) DO 44 J=1,NBELEM DO 44 I=1,NBNN3 IFI=I+1 IF (I.EQ.NBNN3) IFI=1 I1=IPT3.NUM(I,J) I2=IPT3.NUM(IFI,J) IPT4.NUM(2*I-1,J)=I1 IPT4.ICOLOR(J)=IPT3.ICOLOR(J) IF ((NBNN3.EQ.2).AND.(IFI.EQ.1)) GOTO 44 J1=ICPR(MIN(I1,I2)) J2=MAX(I1,I2) ITF=0 43 ITF=ITF+1 IF (KON(J1,ITF,1).NE.J2) GOTO 43 IPT4.NUM(2*I,J)=KON(J1,ITF,2) IPT4.ICOLOR(J)=KON(J1,ITF,3) 44 CONTINUE IPT2.LISREF(IN)=IPT4 C SEGDES IPT4,IPT3 46 CONTINUE 48 SEGSUP ICPR,NKON,KON IF ((IPT2.ITYPEL.EQ.KSURF(ITY)).OR.(IPT2.ITYPEL.EQ.15)) GOTO 100 C SEGDES IPT1 IPT1=IPT2 50 IF (KSURF(ITY).NE.6.OR.IPT1.ITYPEL.NE.10) GOTO 60 C C ON CHANGE DES Q8 EN COUPLES DE TRI6 C SEGACT MCOORD*mod NBELEM=2*IPT1.NUM(/2) NBNN=6 NBSOUS=0 NBREF=IPT1.LISREF(/1) SEGINI IPT2 IPT2.ITYPEL=6 IF (NBREF.EQ.0) GOTO 51 DO 52 I=1,NBREF IPT2.LISREF(I)=IPT1.LISREF(I) 52 CONTINUE 51 CONTINUE NBPTT=nbpts NBPTS=NBPTT+IPT1.NUM(/2) SEGADJ MCOORD DO 53 I=1,IPT1.NUM(/2),2 J=2*I-1 I1=IPT1.NUM(1,I) I2=IPT1.NUM(3,I) I3=IPT1.NUM(5,I) I4=IPT1.NUM(7,I) IREF1=(I1-1)*(IDIM+1) IREF2=(I2-1)*(IDIM+1) IREF3=(I3-1)*(IDIM+1) IREF4=(I4-1)*(IDIM+1) DO 73 K=1,IDIM+1 XCOOR(NBPTT*(IDIM+1)+K)= $0.25D0*(XCOOR(IREF1+K)+XCOOR(IREF2+K)+ $ XCOOR(IREF3+K)+XCOOR(IREF4+K)) 73 CONTINUE NBPTT=NBPTT+1 ISUP=NBPTT IPT2.NUM(1,J)=I1 IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=I2 IPT2.NUM(4,J)=IPT1.NUM(4,I) IPT2.NUM(5,J)=I3 IPT2.NUM(6,J)=ISUP IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=I1 IPT2.NUM(2,J)=ISUP IPT2.NUM(3,J)=I3 IPT2.NUM(4,J)=IPT1.NUM(6,I) IPT2.NUM(5,J)=I4 IPT2.NUM(6,J)=IPT1.NUM(8,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IF (J.GT.IPT2.NUM(/2)) GOTO 53 I1=IPT1.NUM(1,I+1) I2=IPT1.NUM(3,I+1) I3=IPT1.NUM(5,I+1) I4=IPT1.NUM(7,I+1) IREF1=(I1-1)*(IDIM+1) IREF2=(I2-1)*(IDIM+1) IREF3=(I3-1)*(IDIM+1) IREF4=(I4-1)*(IDIM+1) DO 74 K=1,IDIM+1 XCOOR(NBPTT*(IDIM+1)+K)= #0.25D0*(XCOOR(IREF1+K)+XCOOR(IREF2+K)+ $ XCOOR(IREF3+K)+XCOOR(IREF4+K)) 74 CONTINUE NBPTT=NBPTT+1 ISUP=NBPTT IPT2.NUM(1,J)=I1 IPT2.NUM(2,J)=IPT1.NUM(2,I+1) IPT2.NUM(3,J)=I2 IPT2.NUM(4,J)=ISUP IPT2.NUM(5,J)=I4 IPT2.NUM(6,J)=IPT1.NUM(8,I+1) IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1) J=J+1 IPT2.NUM(1,J)=I2 IPT2.NUM(2,J)=IPT1.NUM(4,I+1) IPT2.NUM(3,J)=I3 IPT2.NUM(4,J)=IPT1.NUM(6,I+1) IPT2.NUM(5,J)=I4 IPT2.NUM(6,J)=ISUP IPT2.ICOLOR(J)=IPT1.ICOLOR(I+1) 53 CONTINUE GOTO 100 60 CONTINUE IF(IPT1.ITYPEL.NE.3.OR.KDEGRE(ITY).NE.2) GO TO 70 N1=IPT1.NUM(/2) NBELEM=N1*2 NBNN=2 NBSOUS=0 NBREF=0 SEGINI IPT2 IPT2.ITYPEL=2 DO 63 I=1,N1 I2=(I-1)*2+1 IPT2.NUM(1,I2 )=IPT1.NUM(1,I) IPT2.NUM(2,I2 )=IPT1.NUM(2,I) IPT2.ICOLOR(I2)=IPT1.ICOLOR(I) IPT2.NUM(1,I2+1)=IPT1.NUM(2,I) IPT2.NUM(2,I2+1)=IPT1.NUM(3,I) IPT2.ICOLOR(I2+1)=IPT1.ICOLOR(I) 63 CONTINUE GO TO 100 70 CONTINUE C ON CHANGE DES T6 EN QUATRE T3 IF(IPT1.ITYPEL.NE.6.OR.KSURF(ITY).NE.4) GO TO 80 C NBELEM=4*IPT1.NUM(/2) NBNN=3 NBSOUS=0 * on oublie les cotes ou contours NBREF=0 SEGINI IPT2 IPT2.ITYPEL=4 DO 77 I=1,IPT1.NUM(/2) J=4*I-3 IPT2.NUM(1,J)=IPT1.NUM(1,I) IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(3,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(5,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(4,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 77 CONTINUE GOTO 100 80 CONTINUE C ON CHANGE DES Q8 EN SIX T3 IF(IPT1.ITYPEL.NE.10.OR.KSURF(ITY).NE.4) GO TO 90 C NBELEM=6*IPT1.NUM(/2) NBNN=3 NBSOUS=0 * on oublie les cotes ou contours NBREF=0 SEGINI IPT2 IPT2.ITYPEL=4 DO 83 I=1,IPT1.NUM(/2) J=6*I-5 IPT2.NUM(1,J)=IPT1.NUM(1,I) IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(3,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(5,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(4,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(6,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(6,I) IPT2.NUM(2,J)=IPT1.NUM(7,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 83 CONTINUE GOTO 100 90 CONTINUE C ON CHANGE DES CUB8 EN CINQ TET4 IF(IPT1.ITYPEL.NE.14.OR.ITY.NE.23) GO TO 130 C NBELEM=5*IPT1.NUM(/2) NBNN=4 NBSOUS=0 * on oublie les cotes ou contours ou faces NBREF=0 SEGINI IPT2 IPT2.ITYPEL=23 DO 93 I=1,IPT1.NUM(/2) J=5*I-4 IPT2.NUM(1,J)=IPT1.NUM(1,I) IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.NUM(4,J)=IPT1.NUM(5,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(3,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.NUM(4,J)=IPT1.NUM(7,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(5,I) IPT2.NUM(3,J)=IPT1.NUM(7,I) IPT2.NUM(4,J)=IPT1.NUM(8,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(5,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.NUM(4,J)=IPT1.NUM(7,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(4,I) IPT2.NUM(3,J)=IPT1.NUM(5,I) IPT2.NUM(4,J)=IPT1.NUM(7,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 93 CONTINUE GOTO 100 130 CONTINUE C ON CHANGE DES PRI6 EN TROIS TET4 IF(IPT1.ITYPEL.NE.16.OR.ITY.NE.23) GO TO 140 C NBELEM=3*IPT1.NUM(/2) NBNN=4 NBSOUS=0 * on oublie les cotes ou contours ou faces NBREF=0 SEGINI IPT2 IPT2.ITYPEL=23 DO 133 I=1,IPT1.NUM(/2) J=3*I-2 IPT2.NUM(1,J)=IPT1.NUM(1,I) IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=IPT1.NUM(3,I) IPT2.NUM(4,J)=IPT1.NUM(4,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(3,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.NUM(4,J)=IPT1.NUM(5,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(3,I) IPT2.NUM(2,J)=IPT1.NUM(4,I) IPT2.NUM(3,J)=IPT1.NUM(5,I) IPT2.NUM(4,J)=IPT1.NUM(6,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 133 CONTINUE GOTO 100 140 CONTINUE C ON CHANGE DES PYR5 EN DEUX TET4 IF(IPT1.ITYPEL.NE.25.OR.ITY.NE.23) GO TO 150 C NBELEM=2*IPT1.NUM(/2) NBNN=4 NBSOUS=0 * on oublie les cotes ou contours ou faces NBREF=0 SEGINI IPT2 IPT2.ITYPEL=23 DO 143 I=1,IPT1.NUM(/2) J=2*I-1 IPT2.NUM(1,J)=IPT1.NUM(1,I) IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.NUM(4,J)=IPT1.NUM(5,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(3,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.NUM(4,J)=IPT1.NUM(5,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 143 CONTINUE GOTO 100 150 CONTINUE C ON CHANGE DES TE10 EN HUIT TET4 IF(IPT1.ITYPEL.NE.24.OR.ITY.NE.23) GO TO 160 C NBELEM=8*IPT1.NUM(/2) NBNN=4 NBSOUS=0 * on oublie les cotes ou contours ou faces NBREF=0 SEGINI IPT2 IPT2.ITYPEL=23 DO 153 I=1,IPT1.NUM(/2) J=8*I-7 IPT2.NUM(1,J)=IPT1.NUM(1,I) IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.NUM(4,J)=IPT1.NUM(7,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(3,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.NUM(4,J)=IPT1.NUM(8,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(5,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.NUM(4,J)=IPT1.NUM(9,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(7,I) IPT2.NUM(2,J)=IPT1.NUM(8,I) IPT2.NUM(3,J)=IPT1.NUM(9,I) IPT2.NUM(4,J)=IPT1.NUM(10,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(4,I) IPT2.NUM(3,J)=IPT1.NUM(7,I) IPT2.NUM(4,J)=IPT1.NUM(8,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(7,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.NUM(4,J)=IPT1.NUM(9,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(4,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.NUM(4,J)=IPT1.NUM(7,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(6,I) IPT2.NUM(3,J)=IPT1.NUM(7,I) IPT2.NUM(4,J)=IPT1.NUM(9,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 153 CONTINUE GOTO 100 160 CONTINUE C ON CHANGE DES CU20 EN 22 TET4 IF(IPT1.ITYPEL.NE.15.OR.ITY.NE.23) GO TO 170 C NBELEM=22*IPT1.NUM(/2) NBNN=4 NBSOUS=0 * on oublie les cotes ou contours ou faces NBREF=0 SEGINI IPT2 IPT2.ITYPEL=23 DO 163 I=1,IPT1.NUM(/2) J=22*I-21 IPT2.NUM(1,J)=IPT1.NUM(1,I) IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.NUM(4,J)=IPT1.NUM(9,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(3,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.NUM(4,J)=IPT1.NUM(10,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(4,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.NUM(4,J)=IPT1.NUM(10,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(8,I) IPT2.NUM(3,J)=IPT1.NUM(9,I) IPT2.NUM(4,J)=IPT1.NUM(10,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(6,I) IPT2.NUM(2,J)=IPT1.NUM(7,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(5,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.NUM(4,J)=IPT1.NUM(11,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(6,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(6,I) IPT2.NUM(3,J)=IPT1.NUM(11,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(10,I) IPT2.NUM(3,J)=IPT1.NUM(11,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(8,I) IPT2.NUM(3,J)=IPT1.NUM(10,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(8,I) IPT2.NUM(2,J)=IPT1.NUM(9,I) IPT2.NUM(3,J)=IPT1.NUM(10,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(9,I) IPT2.NUM(2,J)=IPT1.NUM(10,I) IPT2.NUM(3,J)=IPT1.NUM(12,I) IPT2.NUM(4,J)=IPT1.NUM(20,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(10,I) IPT2.NUM(2,J)=IPT1.NUM(12,I) IPT2.NUM(3,J)=IPT1.NUM(16,I) IPT2.NUM(4,J)=IPT1.NUM(20,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(10,I) IPT2.NUM(2,J)=IPT1.NUM(11,I) IPT2.NUM(3,J)=IPT1.NUM(12,I) IPT2.NUM(4,J)=IPT1.NUM(16,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(10,I) IPT2.NUM(2,J)=IPT1.NUM(15,I) IPT2.NUM(3,J)=IPT1.NUM(16,I) IPT2.NUM(4,J)=IPT1.NUM(14,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(11,I) IPT2.NUM(2,J)=IPT1.NUM(16,I) IPT2.NUM(3,J)=IPT1.NUM(17,I) IPT2.NUM(4,J)=IPT1.NUM(18,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(12,I) IPT2.NUM(2,J)=IPT1.NUM(18,I) IPT2.NUM(3,J)=IPT1.NUM(19,I) IPT2.NUM(4,J)=IPT1.NUM(20,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(11,I) IPT2.NUM(2,J)=IPT1.NUM(12,I) IPT2.NUM(3,J)=IPT1.NUM(16,I) IPT2.NUM(4,J)=IPT1.NUM(18,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(12,I) IPT2.NUM(2,J)=IPT1.NUM(16,I) IPT2.NUM(3,J)=IPT1.NUM(18,I) IPT2.NUM(4,J)=IPT1.NUM(20,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(9,I) IPT2.NUM(2,J)=IPT1.NUM(13,I) IPT2.NUM(3,J)=IPT1.NUM(14,I) IPT2.NUM(4,J)=IPT1.NUM(20,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(9,I) IPT2.NUM(2,J)=IPT1.NUM(10,I) IPT2.NUM(3,J)=IPT1.NUM(14,I) IPT2.NUM(4,J)=IPT1.NUM(16,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(9,I) IPT2.NUM(2,J)=IPT1.NUM(14,I) IPT2.NUM(3,J)=IPT1.NUM(16,I) IPT2.NUM(4,J)=IPT1.NUM(20,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 163 CONTINUE GOTO 100 170 CONTINUE C ON CHANGE DES PY13 EN 13 TET4 IF(IPT1.ITYPEL.NE.26.OR.ITY.NE.23) GO TO 180 C NBELEM=13*IPT1.NUM(/2) NBNN=4 NBSOUS=0 NBREF=IPT1.LISREF(/1) SEGINI IPT2 IPT2.ITYPEL=23 * on oublie les cotes ou contours ou faces NBREF=0 DO 173 I=1,IPT1.NUM(/2) J=13*I-12 IPT2.NUM(1,J)=IPT1.NUM(1,I) IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.NUM(4,J)=IPT1.NUM(9,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(3,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.NUM(4,J)=IPT1.NUM(10,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(4,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.NUM(4,J)=IPT1.NUM(10,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(8,I) IPT2.NUM(3,J)=IPT1.NUM(9,I) IPT2.NUM(4,J)=IPT1.NUM(10,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(6,I) IPT2.NUM(2,J)=IPT1.NUM(7,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(5,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.NUM(4,J)=IPT1.NUM(11,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(6,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(6,I) IPT2.NUM(3,J)=IPT1.NUM(11,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(10,I) IPT2.NUM(3,J)=IPT1.NUM(11,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(8,I) IPT2.NUM(3,J)=IPT1.NUM(10,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(8,I) IPT2.NUM(2,J)=IPT1.NUM(9,I) IPT2.NUM(3,J)=IPT1.NUM(10,I) IPT2.NUM(4,J)=IPT1.NUM(12,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(9,I) IPT2.NUM(2,J)=IPT1.NUM(10,I) IPT2.NUM(3,J)=IPT1.NUM(12,I) IPT2.NUM(4,J)=IPT1.NUM(13,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(10,I) IPT2.NUM(2,J)=IPT1.NUM(11,I) IPT2.NUM(3,J)=IPT1.NUM(12,I) IPT2.NUM(4,J)=IPT1.NUM(13,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 173 CONTINUE GOTO 100 180 CONTINUE C ON CHANGE DES PR15 EN 14 TET4 C PP IF(IPT1.ITYPEL.NE.17.OR.ITY.NE.23) GO TO 770 IF(IPT1.ITYPEL.NE.17.OR.ITY.NE.23) GO TO 200 C NBELEM=14*IPT1.NUM(/2) NBNN=4 NBSOUS=0 * on oublie les cotes ou contours ou faces NBREF=0 SEGINI IPT2 IPT2.ITYPEL=23 DO 183 I=1,IPT1.NUM(/2) J=14*I-13 IPT2.NUM(1,J)=IPT1.NUM(1,I) IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.NUM(4,J)=IPT1.NUM(7,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(3,I) IPT2.NUM(3,J)=IPT1.NUM(4,I) IPT2.NUM(4,J)=IPT1.NUM(8,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(4,I) IPT2.NUM(2,J)=IPT1.NUM(5,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.NUM(4,J)=IPT1.NUM(9,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(4,I) IPT2.NUM(3,J)=IPT1.NUM(6,I) IPT2.NUM(4,J)=IPT1.NUM(9,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(4,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.NUM(4,J)=IPT1.NUM(9,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(6,I) IPT2.NUM(3,J)=IPT1.NUM(7,I) IPT2.NUM(4,J)=IPT1.NUM(9,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(2,I) IPT2.NUM(2,J)=IPT1.NUM(7,I) IPT2.NUM(3,J)=IPT1.NUM(8,I) IPT2.NUM(4,J)=IPT1.NUM(9,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(7,I) IPT2.NUM(2,J)=IPT1.NUM(8,I) IPT2.NUM(3,J)=IPT1.NUM(9,I) IPT2.NUM(4,J)=IPT1.NUM(11,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(7,I) IPT2.NUM(2,J)=IPT1.NUM(10,I) IPT2.NUM(3,J)=IPT1.NUM(11,I) IPT2.NUM(4,J)=IPT1.NUM(15,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(9,I) IPT2.NUM(2,J)=IPT1.NUM(13,I) IPT2.NUM(3,J)=IPT1.NUM(14,I) IPT2.NUM(4,J)=IPT1.NUM(15,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(9,I) IPT2.NUM(2,J)=IPT1.NUM(11,I) IPT2.NUM(3,J)=IPT1.NUM(13,I) IPT2.NUM(4,J)=IPT1.NUM(15,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(7,I) IPT2.NUM(2,J)=IPT1.NUM(9,I) IPT2.NUM(3,J)=IPT1.NUM(11,I) IPT2.NUM(4,J)=IPT1.NUM(15,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(8,I) IPT2.NUM(2,J)=IPT1.NUM(9,I) IPT2.NUM(3,J)=IPT1.NUM(11,I) IPT2.NUM(4,J)=IPT1.NUM(13,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) J=J+1 IPT2.NUM(1,J)=IPT1.NUM(8,I) IPT2.NUM(2,J)=IPT1.NUM(11,I) IPT2.NUM(3,J)=IPT1.NUM(12,I) IPT2.NUM(4,J)=IPT1.NUM(13,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) 183 CONTINUE GOTO 100 C+PP 200 CONTINUE IF(IPT1.ITYPEL.NE.10.OR.KSURF(ITY).NE.11) GO TO 210 C C ON CHANGE DES Q8 EN Q9 C C ON CHERCHE LES DIMENSIONS DU MAILLAGE NBELEM=IPT1.NUM(/2) NBNN=9 NBSOUS=0 NBREF=IPT1.LISREF(/1) C ON CREE LE MAILLAGE SEGINI IPT2 C ON REMPLIT LE TYPE ET LES REFERENCES IPT2.ITYPEL=11 IF (NBREF.NE.0) THEN DO 201 I=1,NBREF IPT2.LISREF(I)=IPT1.LISREF(I) 201 CONTINUE ENDIF C ON ALLONGE LE TABLEAU DES COORDONNEES SEGACT MCOORD*mod NBPTT=nbpts NBPTS=NBPTT+NBELEM SEGADJ MCOORD C ON BOUCLE SUR LES ELEMENTS DO 209 I=1,IPT1.NUM(/2) C ON CHERCHE LES COORDONNEES DU NOUVEAU POINT CALL ZERO(Q89,4,1) DO 203 J=1,8 IREFJ=(IPT1.NUM(J,I)-1)*(IDIM+1) DO 202 K=1,IDIM+1 Q89(K)=Q89(K)+XCOOR(IREFJ+K) 202 CONTINUE 203 CONTINUE C ON STOCKE LE NOUVEAU POINT DO 204 K=1,IDIM+1 XCOOR(NBPTT*(IDIM+1)+K)=Q89(K)*0.125D0 204 CONTINUE NBPTT=NBPTT+1 C ON REMPLIE LE NOUVEL ELEMENT DO 205 J=1,8 IPT2.NUM(J,I)=IPT1.NUM(J,I) 205 CONTINUE IPT2.NUM(9,I)=NBPTT C ON DUPLIQUE LA COULEUR IPT2.ICOLOR(I)=IPT1.ICOLOR(I) 209 CONTINUE C ON A FINI GOTO 100 C 210 CONTINUE IF(IPT1.ITYPEL.NE.11.OR.KSURF(ITY).NE.8) GO TO 220 C C ON CHANGE DES Q9 EN QUATRE Q4 C C ON CHERCHE LES DIMENSIONS DU MAILLAGE NBELEM=4*IPT1.NUM(/2) NBNN=4 NBSOUS=0 * on oublie les cotes ou contours ou faces NBREF=0 C ON CREE LE MAILLAGE SEGINI IPT2 C ON REMPLIT LE TYPE ET LES REFERENCES IPT2.ITYPEL=8 C ON BOUCLE SUR LES GROS ELEMENTS DO 215 I=1,IPT1.NUM(/2) C ON LES TRANSFORME EN QUATRE PETITS J=4*(I-1) C 1ER ELEMENT J=J+1 IPT2.NUM(1,J)=IPT1.NUM(9,I) IPT2.NUM(2,J)=IPT1.NUM(8,I) IPT2.NUM(3,J)=IPT1.NUM(1,I) IPT2.NUM(4,J)=IPT1.NUM(2,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) C 2EME ELEMENT J=J+1 IPT2.NUM(1,J)=IPT1.NUM(9,I) IPT2.NUM(2,J)=IPT1.NUM(2,I) IPT2.NUM(3,J)=IPT1.NUM(3,I) IPT2.NUM(4,J)=IPT1.NUM(4,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) C 3EME ELEMENT J=J+1 IPT2.NUM(1,J)=IPT1.NUM(9,I) IPT2.NUM(2,J)=IPT1.NUM(4,I) IPT2.NUM(3,J)=IPT1.NUM(5,I) IPT2.NUM(4,J)=IPT1.NUM(6,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) C 4EME ELEMENT J=J+1 IPT2.NUM(1,J)=IPT1.NUM(9,I) IPT2.NUM(2,J)=IPT1.NUM(6,I) IPT2.NUM(3,J)=IPT1.NUM(7,I) IPT2.NUM(4,J)=IPT1.NUM(8,I) IPT2.ICOLOR(J)=IPT1.ICOLOR(I) C 215 CONTINUE C ON A FINI GOTO 100 C+PP 220 CONTINUE IF(IPT1.ITYPEL.NE.6.OR.KSURF(ITY).NE.7) GO TO 770 C C ON CHANGE DES T6 EN T7 C C ON CHERCHE LES DIMENSIONS DU MAILLAGE NBELEM=IPT1.NUM(/2) NBNN=7 NBSOUS=0 NBREF=IPT1.LISREF(/1) C ON CREE LE MAILLAGE SEGINI IPT2 C ON REMPLIT LE TYPE ET LES REFERENCES IPT2.ITYPEL=7 IF (NBREF.NE.0) THEN DO 221 I=1,NBREF IPT2.LISREF(I)=IPT1.LISREF(I) 221 CONTINUE ENDIF C ON ALLONGE LE TABLEAU DES COORDONNEES SEGACT MCOORD*mod NBPTT=nbpts NBPTS=NBPTT+NBELEM SEGADJ MCOORD C ON BOUCLE SUR LES ELEMENTS DO 229 I=1,IPT1.NUM(/2) C ON CHERCHE LES COORDONNEES DU NOUVEAU POINT CALL ZERO(Q89,3,1) DO 223 J=1,6 IREFJ=(IPT1.NUM(J,I)-1)*(IDIM+1) DO 222 K=1,IDIM+1 Q89(K)=Q89(K)+XCOOR(IREFJ+K) 222 CONTINUE 223 CONTINUE C ON STOCKE LE NOUVEAU POINT DO 224 K=1,IDIM+1 XCOOR(NBPTT*(IDIM+1)+K)=Q89(K)/6.D0 224 CONTINUE NBPTT=NBPTT+1 C ON REMPLIE LE NOUVEL ELEMENT DO 225 J=1,6 IPT2.NUM(J,I)=IPT1.NUM(J,I) 225 CONTINUE IPT2.NUM(7,I)=NBPTT C ON DUPLIQUE LA COULEUR IPT2.ICOLOR(I)=IPT1.ICOLOR(I) 229 CONTINUE C ON A FINI GOTO 100 * 770 CALL ERREUR(29) RETURN 61 SEGSUP KON NKMAX=NKMAX+1 IF (IIMPI.NE.0) WRITE (IOIMP,1000) NKMAX 1000 FORMAT(/,' NOUVELLE VALEUR DE NKMAX TENTEE DANS CHANGE ',I4) GOTO 26 100 CONTINUE IF (ITY.NE.1.AND.ISOU.LE.IPT5.LISOUS(/1)) THEN IF (ISOU.EQ.1) THEN SEGINI,IPT6=IPT2 ELSE NBSOUS=0 NBREF=0 NBNN=IPT6.NUM(/1) NEL6=IPT6.NUM(/2) NEL2=IPT2.NUM(/2) NBELEM=NEL6+NEL2 SEGADJ,IPT6 DO K=1,NEL2 DO L=1,NBNN IPT6.NUM(L,NEL6+K)=IPT2.NUM(L,K) ENDDO ENDDO C SEGDES,IPT2 ENDIF ISOU=ISOU+1 IF (ISOU.LE.IPT5.LISOUS(/1)) GOTO 5 IPT2=IPT6 ENDIF * ON LAISSE IPT2 ACTIF CAR BEAUCOUP DE GENS L'UTILISE AINSI IPT1=IPT2 if (ieta.eq.1) then segact mcoord else segdes mcoord endif END