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

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