Télécharger la plaquette Cast3M


fr en

Télécharger change.eso

Retour à la liste

Numérotation des lignes : 

change

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales