Télécharger la plaquette Cast3M


fr en

Télécharger demcha.eso

Retour à la liste

Numérotation des lignes : 

demcha

  1. C DEMCHA    SOURCE    PV        20/04/04    21:15:01     10567          
  2.       SUBROUTINE DEMCHA(IPT8,MELEME)
  3. *
  4. *    met en element quadratique un maillage meleme.
  5. *    on teste dans ipt8 si des elements quadratiques existent deja
  6. *
  7. * SG 2016/07/21 : ajout gestion des elements QUAF
  8. *
  9.       IMPLICIT INTEGER(I-N)
  10. -INC SMELEME
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. -INC CCGEOME
  14. -INC SMCOORD
  15.       logical ltelq
  16.       SEGMENT KONPOS(NBPTS)
  17.       SEGMENT KONFIN(IKOUR)
  18.       SEGMENT KONMIL(IKOUR)
  19.       SEGMENT KONSUI(IKOUR)
  20.       SEGMENT INOU(NBS)
  21. *
  22.       PARAMETER(NQUAF=2+4)
  23. *     Tableau indiquant les numeros des elements QUAFs (quadratiques
  24. *     fluides) et des QUADs (quadratiques normaux) correspondant 
  25. *     cf. tableau NOMS de bdata.eso
  26. * 
  27.       INTEGER ITQUAF(NQUAF)
  28.       INTEGER ITQUAD(NQUAF)
  29. *                  TRI7  QUA9  CU27  PR21  TE15  PY19
  30.       DATA ITQUAF/   7 ,  11,   33,   34,   35,   36/
  31. *                  TRI6  QUA8  CU20  PR15  TE10  PY13
  32.       DATA ITQUAD/   6 ,  10,   15,   17,   24,   26/
  33. *
  34. *
  35. *  I   PRISE EN COMPTE DU MAILLAGE DE SURFACE
  36.       SEGINI KONPOS
  37.       IKOUR=4*NBPTS
  38.       SEGINI KONFIN,KONMIL,KONSUI
  39.       KONCOU=0
  40. *
  41. *  traitement des elements deja quadratiques
  42. *
  43.       SEGACT IPT8
  44.       IPT7=IPT8
  45.       NBSOUS=IPT8.LISOUS(/1)
  46.       DO 60 ISOUS=1,MAX(1,NBSOUS)
  47.          IF (NBSOUS.NE.0) IPT7=IPT8.LISOUS(ISOUS)
  48.          SEGACT IPT7
  49.          ITY= IPT7.ITYPEL
  50.          ISUP=0
  51.          IF(KDEGRE(ITY).NE.3) GOTO 61
  52.          IF(ITY.NE.3) THEN
  53.             ISUP=1
  54.             CALL ECROBJ('MAILLAGE', IPT7)
  55.             CALL CHANLG
  56.             CALL LIROBJ('MAILLAGE',IPT7,1,IRETOU)
  57.             IF(IERR.NE.0) RETURN
  58.             SEGACT IPT7
  59.          ENDIF
  60.          DO 70 J=1,IPT7.NUM(/2)
  61.             I1=IPT7.NUM(1,J)
  62.             I3=IPT7.NUM(3,J)
  63.             J1=MIN(I1,I3)
  64.             J3=MAX(I1,I3)
  65.             ITFA=KONPOS(J1)
  66.             IF (ITFA.EQ.0) GOTO 90
  67.  85         CONTINUE
  68.             ITF=KONSUI(ITFA)
  69.             IF (KONFIN(ITFA).EQ.J3) GOTO 70
  70.             IF (ITF.EQ.0) GOTO 90
  71.             ITFA=ITF
  72.             GOTO 85
  73.  90         KONCOU=KONCOU+1
  74.             IF (KONCOU.GE.KONFIN(/1)) THEN
  75.                IKOUR=KONCOU+500
  76.                SEGADJ KONFIN,KONMIL,KONSUI
  77.             ENDIF
  78.             IF (ITFA.EQ.0) THEN
  79.                KONPOS(J1)=KONCOU
  80.             ELSE
  81.                KONSUI(ITFA)=KONCOU
  82.             ENDIF
  83.             KONFIN(KONCOU)=J3
  84.             KONMIL(KONCOU)=IPT7.NUM(2,J)
  85.  70      CONTINUE
  86.  61      CONTINUE
  87.          IF(ISUP.NE.0) THEN
  88.             SEGSUP IPT7
  89.          ENDIF
  90.  60   CONTINUE
  91. *  MAINTENANT ON S'ATTAQUE A LA TRANSFORMATION DU MAILLAGE lineaire
  92. *     SG 2016/07/21 et/ou des QUAF (dans ce dernier cas, il suffit
  93. *     d'oublier les noeuds au centre des faces et de l'element)
  94.  
  95.       IPT7=MELEME
  96.       SEGACT MELEME
  97.       NBSOU7=LISOUS(/1)
  98.       NBSOUS=NBSOU7
  99.       NBS = MAX(1,NBSOU7)
  100.       SEGINI INOU
  101.       NBREF=0
  102.       NBELEM=0
  103.       NBNN=0
  104.       DO 100 ISOUS=1,MAX(1,NBSOU7)
  105.          IF (NBSOU7.NE.0) IPT7=LISOUS(ISOUS)
  106.          SEGACT IPT7
  107.          INOU(ISOUS)=IPT7
  108.          NBELEM=IPT7.NUM(/2)
  109.          ITY=IPT7.ITYPEL
  110. * l'element est-il un quadratique fluide (quaf) ?
  111.          iquaf=0
  112.          do i=1,nquaf
  113.             if (ity.eq.itquaf(i)) then
  114.                iquaf=i
  115.                goto 666
  116.             endif
  117.          enddo
  118.  666     continue
  119. *     oui, c'est un quaf, on ne garde que les noeuds quadratiques
  120. *     "normaux" (par chance de la definition des quaf, ce sont les n premiers)
  121.          if (iquaf.ne.0) then 
  122.             itype=itquad(iquaf)
  123.             NBNN=NBNNE(ITYPE)
  124.             NBSOUS=0
  125.             NBREF=0
  126.             SEGINI IPT6
  127.             IPT6.ITYPEL=ITYPE
  128.             INOU(ISOUS)=IPT6
  129.             DO J=1,NBELEM
  130.                DO I=1,NBNN
  131.                   IPT6.NUM(I,J)=IPT7.NUM(I,J)
  132.                   IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  133.                ENDDO
  134.             ENDDO
  135.             goto 101
  136.          endif
  137.          ITYPE=IPT7.ITYPEL+1
  138.          IF(IPT7.ITYPEL.EQ.4 . OR.  IPT7.ITYPEL.EQ.5. OR .
  139.      #IPT7.ITYPEL.EQ.8 . OR. IPT7.ITYPEL.EQ.9. OR.
  140.      #IPT7.ITYPEL.EQ.18 . OR. IPT7.ITYPEL.EQ.19) ITYPE=ITYPE+1
  141.          NBNN=NBNNE(ITYPE)
  142.          NBSOUS=0
  143.          NBREF=0
  144.          SEGINI IPT6
  145.          IPT6.ITYPEL=ITYPE
  146. *       IF (NBSOU7.NE.0) IPT1.LISOUS(ISOUS)=IPT6
  147. *  CAS DES TETRAEDRES
  148.          IF (IPT7.ITYPEL.EQ.23) THEN
  149.             INOU(ISOUS)=IPT6
  150.             DO 200 J=1,NBELEM
  151.                I1=IPT7.NUM(1,J)
  152.                I2=IPT7.NUM(2,J)
  153.                I3=IPT7.NUM(3,J)
  154.                I4=IPT7.NUM(4,J)
  155.                CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  156.                IPT6.NUM(1,J)=I1
  157.                IPT6.NUM(2,J)=I5
  158.                IPT6.NUM(3,J)=I2
  159.                CALL DEMCH1(I2,I3,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  160.                IPT6.NUM(4,J)=I5
  161.                IPT6.NUM(5,J)=I3
  162.                CALL DEMCH1(I3,I1,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  163.                IPT6.NUM(6,J)=I5
  164.                CALL DEMCH1(I1,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  165.                IPT6.NUM(7,J)=I5
  166.                CALL DEMCH1(I2,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  167.                IPT6.NUM(8,J)=I5
  168.                CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  169.                IPT6.NUM(9,J)=I5
  170.                IPT6.NUM(10,J)=I4
  171.                IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  172.  200        CONTINUE
  173. *  CAS DES PYRAMIDES
  174.          ELSEIF (IPT7.ITYPEL.EQ.25) THEN
  175.             INOU(ISOUS)=IPT6
  176.             DO 210 J=1,NBELEM
  177.                I1=IPT7.NUM(1,J)
  178.                I2=IPT7.NUM(2,J)
  179.                I3=IPT7.NUM(3,J)
  180.                I4=IPT7.NUM(4,J)
  181.                I5=IPT7.NUM(5,J)
  182.                CALL DEMCH1(I1,I2,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  183.                IPT6.NUM(1,J)=I1
  184.                IPT6.NUM(2,J)=I6
  185.                IPT6.NUM(3,J)=I2
  186.                CALL DEMCH1(I2,I3,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  187.                IPT6.NUM(4,J)=I6
  188.                IPT6.NUM(5,J)=I3
  189.                CALL DEMCH1(I3,I4,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  190.                IPT6.NUM(6,J)=I6
  191.                IPT6.NUM(7,J)=I4
  192.                CALL DEMCH1(I4,I1,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  193.                IPT6.NUM(8,J)=I6
  194.                CALL DEMCH1(I1,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  195.                IPT6.NUM(9,J)=I6
  196.                CALL DEMCH1(I2,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  197.                IPT6.NUM(10,J)=I6
  198.                CALL DEMCH1(I3,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  199.                IPT6.NUM(11,J)=I6
  200.                CALL DEMCH1(I4,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  201.                IPT6.NUM(12,J)=I6
  202.                IPT6.NUM(13,J)=I5
  203.                IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  204.  210        CONTINUE
  205. *     CAS DES PRISMES
  206.          ELSEIF (IPT7.ITYPEL.EQ.16) THEN
  207.             INOU(ISOUS)=IPT6
  208.             DO 220 J=1,NBELEM
  209.                I1=IPT7.NUM(1,J)
  210.                I2=IPT7.NUM(2,J)
  211.                I3=IPT7.NUM(3,J)
  212.                I4=IPT7.NUM(4,J)
  213.                I5=IPT7.NUM(5,J)
  214.                I6=IPT7.NUM(6,J)
  215.                CALL DEMCH1(I1,I2,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  216.                IPT6.NUM(1,J)=I1
  217.                IPT6.NUM(2,J)=I7
  218.                IPT6.NUM(3,J)=I2
  219.                CALL DEMCH1(I2,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  220.                IPT6.NUM(4,J)=I7
  221.                IPT6.NUM(5,J)=I3
  222.                CALL DEMCH1(I3,I1,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  223.                IPT6.NUM(6,J)=I7
  224.                CALL DEMCH1(I1,I4,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  225.                IPT6.NUM(7,J)=I7
  226.                CALL DEMCH1(I2,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  227.                IPT6.NUM(8,J)=I7
  228.                CALL DEMCH1(I3,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  229.                IPT6.NUM(9,J)=I7
  230.                CALL DEMCH1(I4,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  231.                IPT6.NUM(10,J)=I4
  232.                IPT6.NUM(11,J)=I7
  233.                IPT6.NUM(12,J)=I5
  234.                CALL DEMCH1(I5,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  235.                IPT6.NUM(13,J)=I7
  236.                IPT6.NUM(14,J)=I6
  237.                CALL DEMCH1(I6,I4,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  238.                IPT6.NUM(15,J)=I7
  239.                IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  240.  220        CONTINUE
  241. *     CAS DES CUBES
  242.          ELSEIF (IPT7.ITYPEL.EQ.14) THEN
  243.             INOU(ISOUS)=IPT6
  244.             DO 230 J=1,NBELEM
  245.                I1=IPT7.NUM(1,J)
  246.                I2=IPT7.NUM(2,J)
  247.                I3=IPT7.NUM(3,J)
  248.                I4=IPT7.NUM(4,J)
  249.                I5=IPT7.NUM(5,J)
  250.                I6=IPT7.NUM(6,J)
  251.                I7=IPT7.NUM(7,J)
  252.                I8=IPT7.NUM(8,J)
  253.                CALL DEMCH1(I1,I2,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  254.                IPT6.NUM(1,J)=I1
  255.                IPT6.NUM(2,J)=I9
  256.                IPT6.NUM(3,J)=I2
  257.                CALL DEMCH1(I2,I3,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  258.                IPT6.NUM(4,J)=I9
  259.                IPT6.NUM(5,J)=I3
  260.                CALL DEMCH1(I3,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  261.                IPT6.NUM(6,J)=I9
  262.                IPT6.NUM(7,J)=I4
  263.                CALL DEMCH1(I4,I1,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  264.                IPT6.NUM(8,J)=I9
  265.                CALL DEMCH1(I1,I5,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  266.                IPT6.NUM(9,J)=I9
  267.                CALL DEMCH1(I2,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  268.                IPT6.NUM(10,J)=I9
  269.                CALL DEMCH1(I3,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  270.                IPT6.NUM(11,J)=I9
  271.                CALL DEMCH1(I4,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  272.                IPT6.NUM(12,J)=I9
  273.                CALL DEMCH1(I5,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  274.                IPT6.NUM(13,J)=I5
  275.                IPT6.NUM(14,J)=I9
  276.                IPT6.NUM(15,J)=I6
  277.                CALL DEMCH1(I6,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  278.                IPT6.NUM(16,J)=I9
  279.                IPT6.NUM(17,J)=I7
  280.                CALL DEMCH1(I7,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  281.                IPT6.NUM(18,J)=I9
  282.                IPT6.NUM(19,J)=I8
  283.                CALL DEMCH1(I5,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  284.                IPT6.NUM(20,J)=I9
  285.                IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  286.  230        CONTINUE
  287. *  CAS DES SEG2
  288.          ELSEIF (IPT7.ITYPEL.EQ.2) THEN
  289.             INOU(ISOUS)=IPT6
  290.             DO 240 J=1,NBELEM
  291.                I1=IPT7.NUM(1,J)
  292.                I2=IPT7.NUM(2,J)
  293.                CALL DEMCH1(I1,I2,I3,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  294.                IPT6.NUM(1,J)=I1
  295.                IPT6.NUM(2,J)=I3
  296.                IPT6.NUM(3,J)=I2
  297.                IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  298.  240        CONTINUE
  299. *  CAS DES TRI3 ou des tri4
  300.          ELSEIF (IPT7.ITYPEL.EQ.4.OR.IPT7.ITYPEL.EQ.5) THEN
  301.             INOU(ISOUS)=IPT6
  302.             DO 250 J=1,NBELEM
  303.                I1=IPT7.NUM(1,J)
  304.                I2=IPT7.NUM(2,J)
  305.                I3=IPT7.NUM(3,J)
  306.                CALL DEMCH1(I1,I2,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  307.                IPT6.NUM(1,J)=I1
  308.                IPT6.NUM(2,J)=I4
  309.                IPT6.NUM(3,J)=I2
  310.                CALL DEMCH1(I2,I3,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  311.                IPT6.NUM(4,J)=I4
  312.                IPT6.NUM(5,J)=I3
  313.                CALL DEMCH1(I1,I3,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  314.                IPT6.NUM(6,J)=I4
  315.                IF(IPT7.ITYPEL.EQ.5)IPT6.NUM(7,J)=IPT7.NUM(4,J)
  316.                IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  317.  250        CONTINUE
  318. *  CAS DES QUA4 ou des QUA5
  319.          ELSEIF (IPT7.ITYPEL.EQ.8.OR.IPT7.ITYPEL.EQ.9) THEN
  320.             INOU(ISOUS)=IPT6
  321.             DO 260 J=1,NBELEM
  322.                I1=IPT7.NUM(1,J)
  323.                I2=IPT7.NUM(2,J)
  324.                I3=IPT7.NUM(3,J)
  325.                I4=IPT7.NUM(4,J)
  326.                CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  327.                IPT6.NUM(1,J)=I1
  328.                IPT6.NUM(2,J)=I5
  329.                IPT6.NUM(3,J)=I2
  330.                CALL DEMCH1(I2,I3,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  331.                IPT6.NUM(4,J)=I5
  332.                IPT6.NUM(5,J)=I3
  333.                CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  334.                IPT6.NUM(6,J)=I5
  335.                IPT6.NUM(7,J)=I4
  336.                CALL DEMCH1(I1,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  337.                IPT6.NUM(8,J)=I5
  338.                IF(IPT7.ITYPEL.EQ.9)IPT6.NUM(9,J)=IPT7.NUM(5,J)
  339.                IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  340.  260        CONTINUE
  341. *     CAS des RAC2
  342.          ELSEIF (IPT7.ITYPEL.EQ.12) THEN
  343.             INOU(ISOUS)=IPT6
  344.             DO 270 J=1,NBELEM
  345.                I1=IPT7.NUM(1,J)
  346.                I2=IPT7.NUM(2,J)
  347.                I3=IPT7.NUM(3,J)
  348.                I4=IPT7.NUM(4,J)
  349.                CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  350.                IPT6.NUM(1,J)=I1
  351.                IPT6.NUM(2,J)=I5
  352.                IPT6.NUM(3,J)=I2
  353.                CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  354.                IPT6.NUM(4,J)=I3
  355.                IPT6.NUM(5,J)=I5
  356.                IPT6.NUM(5,J)=I4
  357.                IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  358.  270        CONTINUE
  359. * CAS des lia3
  360.          ELSEIF (IPT7.ITYPEL.EQ.18) THEN
  361.             INOU(ISOUS)=IPT6
  362.             DO 280 J=1,NBELEM
  363.                I1=IPT7.NUM(1,J)
  364.                I2=IPT7.NUM(2,J)
  365.                I3=IPT7.NUM(3,J)
  366.                I4=IPT7.NUM(4,J)
  367.                I5=IPT7.NUM(5,J)
  368.                I6=IPT7.NUM(6,J)
  369.                CALL DEMCH1(I1,I2,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  370.                IPT6.NUM(1,J)=I1
  371.                IPT6.NUM(2,J)=I7
  372.                IPT6.NUM(3,J)=I2
  373.                CALL DEMCH1(I2,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  374.                IPT6.NUM(4,J)=I7
  375.                IPT6.NUM(5,J)=I3
  376.                CALL DEMCH1(I1,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  377.                IPT6.NUM(6,J)=I7
  378.                CALL DEMCH1(I4,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  379.                IPT6.NUM(7,J)=I4
  380.                IPT6.NUM(8,J)=I7
  381.                IPT6.NUM(9,J)=I5
  382.                CALL DEMCH1(I5,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  383.                IPT6.NUM(10,J)=I7
  384.                IPT6.NUM(11,J)=I5
  385.                CALL DEMCH1(I4,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  386.                IPT6.NUM(12,J)=I7
  387.                IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  388.  280        CONTINUE
  389. *     CAS des lia4
  390.          ELSEIF (IPT7.ITYPEL.EQ.18) THEN
  391.             INOU(ISOUS)=IPT6
  392.             DO 290 J=1,NBELEM
  393.                I1=IPT7.NUM(1,J)
  394.                I2=IPT7.NUM(2,J)
  395.                I3=IPT7.NUM(3,J)
  396.                I4=IPT7.NUM(4,J)
  397.                I5=IPT7.NUM(5,J)
  398.                I6=IPT7.NUM(6,J)
  399.                I7=IPT7.NUM(7,J)
  400.                I8=IPT7.NUM(8,J)
  401.                CALL DEMCH1(I1,I2,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  402.                IPT6.NUM(1,J)=I1
  403.                IPT6.NUM(2,J)=I9
  404.                IPT6.NUM(3,J)=I2
  405.                CALL DEMCH1(I2,I3,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  406.                IPT6.NUM(4,J)=I9
  407.                IPT6.NUM(5,J)=I3
  408.                CALL DEMCH1(I3,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  409.                IPT6.NUM(6,J)=I9
  410.                IPT6.NUM(7,J)=I4
  411.                CALL DEMCH1(I1,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  412.                IPT6.NUM(8,J)=I9
  413.                CALL DEMCH1(I5,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  414.                IPT6.NUM(9,J)=I5
  415.                IPT6.NUM(10,J)=I9
  416.                IPT6.NUM(11,J)=I6
  417.                CALL DEMCH1(I6,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  418.                IPT6.NUM(12,J)=I9
  419.                IPT6.NUM(13,J)=I7
  420.                CALL DEMCH1(I7,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  421.                IPT6.NUM(14,J)=I9
  422.                IPT6.NUM(15,J)=I8
  423.                CALL DEMCH1(I5,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  424.                IPT6.NUM(16,J)=I9
  425.                IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  426.  290        CONTINUE
  427.          ENDIF
  428.  101     CONTINUE
  429.  100  CONTINUE
  430.       SEGSUP KONFIN,KONMIL,KONSUI,KONPOS
  431. * on fusionne les sous parties
  432.       II=INOU(/1)
  433.       IRETOU=INOU(1)
  434.       IF(II.EQ.1) GO TO 15
  435.       DO 16 J=2,II
  436.          INN=INOU(J)
  437.          ltelq=.false.
  438.          CALL FUSE( IRETOU,INN,IPT5,ltelq)
  439.          IRETOU=IPT5
  440.  16   CONTINUE
  441.  15   CONTINUE
  442.       MELEME=IRETOU
  443.       END
  444.  
  445.  
  446.  
  447.  
  448.  

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