Télécharger la plaquette Cast3M


fr en

Télécharger chang2.eso

Retour à la liste

Numérotation des lignes : 

chang2

  1. C CHANG2    SOURCE    BP208322  16/11/18    21:15:29     9177           
  2.       SUBROUTINE CHANG2(IPT1,ITY)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : CHANG2
  7. C DESCRIPTION : Change un maillage (éventuellement composite)
  8. C               de QUAF en 'TRI3','TET4','QUA4','CUB8','PYR5'
  9. C
  10. C
  11. C LANGAGE     : ESOPE
  12. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  13. C               mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES          :
  16. C APPELES (E/S)    :
  17. C APPELES (BLAS)   :
  18. C APPELES (CALCUL) :
  19. C APPELE PAR       :
  20. C***********************************************************************
  21. C SYNTAXE GIBIANE    :
  22. C ENTREES            :
  23. C ENTREES/SORTIES    :
  24. C SORTIES            :
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION    : v1, 04/01/2007, version initiale
  28. C HISTORIQUE : v1, 04/01/2007, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC CCGEOME
  40. -INC SMELEME
  41. *
  42.       LOGICAL LCOMP,ltelq
  43.       PARAMETER(NTYP2=5)
  44.       CHARACTER*4 LTYP2(NTYP2),LTYPD2(NTYP2),LTYPD3(NTYP2),MTYP,MTYP2
  45.       INTEGER S3S2(2,2),T7T3(3,4),T7Q4(4,3),Q9T3(3,8),Q9Q4(4,4)
  46.       INTEGER T15T4(4,4),T15O6(6),O6T4(4,4),T15C8(8,4),T15T7(7,4)
  47.       INTEGER P19H6(6,4),P19O6(6),H6T4(4,3),P19T7(7,4),P19Q9(9)
  48.       INTEGER P21P6A(6,4),P21P6B(6,4),P6AT4(4,3),P6BT4(4,3)
  49.       INTEGER P21C8(8,6),P21T7(7,2),P21Q9(9,3)
  50.       INTEGER C27C8(8,8),C8T4(4,5),C27Q9(9,6)
  51. *
  52.       DATA LTYP2 /'TRI3','TET4','QUA4','CUB8','PYR5'/
  53.       DATA LTYPD2/'TRI3','TRI3','QUA4','QUA4','QUA4'/
  54.       DATA LTYPD3/'TET4','TET4','CUB8','CUB8','PYR5'/
  55. * SEG3 -> 2 SEG2
  56.       DATA S3S2/1,2 , 2,3/
  57. * TRI7 -> 4 TRI3
  58.       DATA T7T3/1,2,6 , 2,3,4 , 6,4,5 , 2,4,6/
  59. * TRI7 -> 3 QUA4
  60.       DATA T7Q4/1,2,7,6 , 2,3,4,7 , 7,4,5,6/
  61. * QUA9 -> 8 TRI3
  62.       DATA Q9T3/1,2,9 , 2,3,9 , 3,4,9 , 4,5,9 ,
  63.      $     5,6,9 , 6,7,9 , 7,8,9 , 8,1,9/
  64. * QUA9 -> 4 QUA4
  65.       DATA Q9Q4/1,2,9,8 , 2,3,4,9 , 9,4,5,6 , 8,9,6,7/
  66. * TE15 -> 4 TET4 + 1 OCT6
  67.       DATA T15T4/1,2,6,7 , 2,3,4,8 , 4,5,6,9 , 7,8,9,10/
  68.       DATA T15O6/7,2,4,9,8,6/
  69. * OCT6 -> 4 TET4
  70.       DATA O6T4/1,2,6,5 , 2,3,6,5 , 3,4,6,5 , 4,1,6,5/
  71. * TE15 -> 4 CUB8
  72.       DATA T15C8/1,2,11,6,7,12,15,14 , 2,3,4,11,12,8,13,15 ,
  73.      $           4,5,6,11,13,9,14,15 , 8,13,15,12,10,9,14,7/
  74. * TE15 -> 4 TRI7 (Les faces)
  75.       DATA T15T7/1,7,10,8,3,2,12 , 3,8,10,9,5,4,13 ,
  76.      $           5,9,10,7,1,6,14 , 1,2,3,4,5,6,11/
  77. * PY19 -> 4 HEX6 + 1 OCT6
  78.       DATA P19H6/1,2,3,14,9,10 , 3,4,5,14,10,11 ,
  79.      $           5,6,7,14,11,12 , 7,8,1,14,12,9/
  80.       DATA P19O6/9,10,11,12,13,14/
  81. * HEX6 -> 3 TET4
  82.       DATA H6T4/1,2,4,5 , 5,2,4,6 , 2,3,4,6/
  83. * PY19 -> 4 TRI7 (Les faces triangulaires)
  84.       DATA P19T7/1,9,13,10,3,2,15 , 3,10,13,11,5,4,16 ,
  85.      $           5,11,13,12,7,6,17 , 7,12,13,9,1,8,18/
  86. * PY19 -> QUA9 (La face carrée)
  87.       DATA P19Q9/1,2,3,4,5,6,7,8,14/
  88. * PR21 -> 4 PRI6 de type A
  89.       DATA P21P6A/7,16,18,10,11,15 , 9,18,17,14,15,13 ,
  90.      $            7,18,16,1,6,2 ,    9,17,18,5,4,6/
  91. * PR21 -> 4 PRI6 de type B
  92.       DATA P21P6B/ 8,17,16,12,13,11 , 16,17,18,11,13,15 ,
  93.      $             8,16,17,3,2,4    , 2,4,6,16,17,18/
  94. Cbuggé     $             8,16,17,3,2,4    , 16,18,17,2,6,4/
  95. * PRI6 de type A -> 3 TET4
  96.       DATA P6AT4/1,2,3,4 , 5,3,4,6 , 5,2,4,3/
  97. * PRI6 de type B -> 3 TET4
  98.       DATA P6BT4/1,2,3,4 , 3,6,4,2 , 5,2,4,6/
  99. * PR21 -> 6 CUB8
  100.       DATA P21C8/7,16,21,18,10,11,20,15 , 16,8,17,21,11,12,13,20 ,
  101.      $           21,17,9,18,20,13,14,15 , 1,2,19,6,7,16,21,18 ,
  102.      $           2,3,4,19,16,8,17,21    , 19,4,5,6,21,17,9,18/
  103. * PR21 -> 2 TRI7 (Les faces triangulaires)
  104.       DATA P21T7/1,2,3,4,5,6,19 , 10,15,14,13,12,11,20/
  105. * PR21 -> 3 QUA9 (Les faces carrées)
  106.       DATA P21Q9/10,11,12,8,3,2,1,7,16 , 12,13,14,9,5,4,3,8,17 ,
  107.      $           14,15,10,7,1,6,5,9,18/
  108. * CU27 -> 8 CUB8
  109.       DATA C27C8/1,2,25,8,9,21,27,24 , 3,4,25,2,10,22,27,21 ,
  110.      $           5,6,25,4,11,23,27,22 , 7,8,25,6,12,24,27,23 ,
  111.      $           13,20,26,14,9,24,27,21 , 15,14,26,16,10,21,27,22 ,
  112.      $           17,16,26,18,11,22,27,23 , 19,18,26,20,12,23,27,24/
  113. * CUB8 -> 5 TET4
  114.       DATA C8T4/1,2,3,6 , 3,4,1,8 , 1,6,8,5 , 6,3,8,7 , 8,6,1,3/
  115. * CU27 -> 6 QUA9 (Les faces carrées)
  116.       DATA C27Q9/1,9,13,14,15,10,3,2,21 , 3,10,15,16,17,11,5,4,22 ,
  117.      $           5,11,17,18,19,12,7,6,23 , 7,12,19,20,13,9,1,8,24 ,
  118.      $           1,2,3,4,5,6,7,8,25 , 13,20,19,18,17,16,15,14,26/
  119. *
  120. * Executable statements
  121. *
  122.       IMPR=0
  123.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans chang2.eso'
  124. * Numéro de l'élément à créer dans la numérotation de LTYP2
  125.       CALL FIMOT2(NOMS(ITY),LTYP2,NTYP2,JTY,IMPR,IRET)
  126.       IF (IRET.NE.0) GOTO 9999
  127.       SEGACT IPT1
  128.       NBSOUS=IPT1.LISOUS(/1)
  129.       LCOMP=(NBSOUS.GE.1)
  130.       IPT3=0
  131. *
  132.       IF (NBSOUS.EQ.0) NBSOUS=1
  133.       DO ISOUS=1,NBSOUS
  134.          IF (LCOMP) THEN
  135.             IPT2=IPT1.LISOUS(ISOUS)
  136.             SEGACT IPT2
  137.          ELSE
  138.             IPT2=IPT1
  139.          ENDIF
  140.          ITYP=IPT2.ITYPEL
  141.          MTYP=NOMS(ITYP)
  142.          NBL=IPT2.NUM(/2)
  143. *         NBN=IPT2.NUM(/1)
  144.          IF (MTYP.EQ.'SEG3') THEN
  145. * Passage SEG3 -> 2 SEG2
  146.             NBNN=2
  147.             NBELEM=NBL*2
  148.             NBSOUS=0
  149.             NBREF=0
  150.             SEGINI IPT4
  151.             IPT4.ITYPEL=2
  152.             IEL4=0
  153.             DO IBL=1,NBL
  154.                DO IL=1,2
  155.                   IEL4=IEL4+1
  156.                   DO IN=1,2
  157.                      IPT4.NUM(IN,IEL4)=IPT2.NUM(S3S2(IN,IL),IBL)
  158.                   ENDDO
  159.                   IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  160.                ENDDO
  161.             ENDDO
  162.             SEGDES IPT4
  163.          ELSEIF (MTYP.EQ.'TRI7') THEN
  164.             MTYP2=LTYPD2(JTY)
  165.             IF (MTYP2.EQ.'TRI3') THEN
  166. * Passage TRI7 -> 4 TRI3
  167.                NBNN=3
  168.                NBELEM=NBL*4
  169.                NBSOUS=0
  170.                NBREF=0
  171.                SEGINI IPT4
  172.                IPT4.ITYPEL=4
  173.                IEL4=0
  174.                DO IBL=1,NBL
  175.                   DO IL=1,4
  176.                      IEL4=IEL4+1
  177.                      DO IN=1,3
  178.                         IPT4.NUM(IN,IEL4)=IPT2.NUM(T7T3(IN,IL),IBL)
  179.                      ENDDO
  180.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  181.                   ENDDO
  182.                ENDDO
  183.                SEGDES IPT4
  184.             ELSEIF (MTYP2.EQ.'QUA4') THEN
  185. * Passage TRI7 -> 3 QUA4
  186.                NBNN=4
  187.                NBELEM=NBL*3
  188.                NBSOUS=0
  189.                NBREF=0
  190.                SEGINI IPT4
  191.                IPT4.ITYPEL=8
  192.                IEL4=0
  193.                DO IBL=1,NBL
  194.                   DO IL=1,3
  195.                      IEL4=IEL4+1
  196.                      DO IN=1,4
  197.                         IPT4.NUM(IN,IEL4)=IPT2.NUM(T7Q4(IN,IL),IBL)
  198.                      ENDDO
  199.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  200.                   ENDDO
  201.                ENDDO
  202.                SEGDES IPT4
  203.             ELSE
  204.                GOTO 9998
  205.             ENDIF
  206.          ELSEIF (MTYP.EQ.'QUA9') THEN
  207.             MTYP2=LTYPD2(JTY)
  208.             IF (MTYP2.EQ.'TRI3') THEN
  209. * Passage QUA9 -> 8 TRI3
  210.                NBNN=3
  211.                NBELEM=NBL*8
  212.                NBSOUS=0
  213.                NBREF=0
  214.                SEGINI IPT4
  215.                IPT4.ITYPEL=4
  216.                IEL4=0
  217.                DO IBL=1,NBL
  218.                   DO IL=1,8
  219.                      IEL4=IEL4+1
  220.                      DO IN=1,3
  221.                         IPT4.NUM(IN,IEL4)=IPT2.NUM(Q9T3(IN,IL),IBL)
  222.                      ENDDO
  223.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  224.                   ENDDO
  225.                ENDDO
  226.                SEGDES IPT4
  227.             ELSEIF (MTYP2.EQ.'QUA4') THEN
  228. * Passage QUA9 -> 4 QUA4
  229.                NBNN=4
  230.                NBELEM=NBL*4
  231.                NBSOUS=0
  232.                NBREF=0
  233.                SEGINI IPT4
  234.                IPT4.ITYPEL=8
  235.                IEL4=0
  236.                DO IBL=1,NBL
  237.                   DO IL=1,4
  238.                      IEL4=IEL4+1
  239.                      DO IN=1,4
  240.                         IPT4.NUM(IN,IEL4)=IPT2.NUM(Q9Q4(IN,IL),IBL)
  241.                      ENDDO
  242.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  243.                   ENDDO
  244.                ENDDO
  245.                SEGDES IPT4
  246.             ELSE
  247.                GOTO 9998
  248.             ENDIF
  249.          ELSEIF (MTYP.EQ.'TE15') THEN
  250.             MTYP2=LTYPD3(JTY)
  251.             IF (MTYP2.EQ.'TET4') THEN
  252. * Passage TE15 -> 8 TET4
  253.                NBNN=4
  254.                NBELEM=NBL*8
  255.                NBSOUS=0
  256.                NBREF=0
  257.                SEGINI IPT4
  258.                CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  259.                IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  260.                   CALL ERREUR(5)
  261.                   RETURN
  262.                ENDIF
  263.                IPT4.ITYPEL=ITYP2
  264.                IEL4=0
  265.                DO IBL=1,NBL
  266. *   D'abord les 4TET4 des coins
  267.                   DO IL=1,4
  268.                      IEL4=IEL4+1
  269.                      DO IN=1,4
  270.                         IPT4.NUM(IN,IEL4)=IPT2.NUM(T15T4(IN,IL),IBL)
  271.                      ENDDO
  272.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  273.                   ENDDO
  274. *   Puis l'octaèdre du milieu
  275.                   DO IL=1,4
  276.                      IEL4=IEL4+1
  277.                      DO IN=1,4
  278.                         IPT4.NUM(IN,IEL4)=
  279.      $                       IPT2.NUM(T15O6(O6T4(IN,IL)),IBL)
  280.                      ENDDO
  281.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  282.                   ENDDO
  283.                ENDDO
  284.                SEGDES IPT4
  285.             ELSEIF (MTYP2.EQ.'CUB8') THEN
  286. * Passage TE15 -> 4 CUB8
  287.                NBNN=8
  288.                NBELEM=NBL*4
  289.                NBSOUS=0
  290.                NBREF=0
  291.                SEGINI IPT4
  292.                CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  293.                IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  294.                   CALL ERREUR(5)
  295.                   RETURN
  296.                ENDIF
  297.                IPT4.ITYPEL=ITYP2
  298.                IEL4=0
  299.                DO IBL=1,NBL
  300.                   DO IL=1,4
  301.                      IEL4=IEL4+1
  302.                      DO IN=1,8
  303.                         IPT4.NUM(IN,IEL4)=IPT2.NUM(T15C8(IN,IL),IBL)
  304.                      ENDDO
  305.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  306.                   ENDDO
  307.                ENDDO
  308.                SEGDES IPT4
  309.             ELSEIF (MTYP2.EQ.'PYR5') THEN
  310. * Passage TE15 -> 12 PYR5
  311.                NBNN=5
  312.                NBELEM=NBL*12
  313.                NBSOUS=0
  314.                NBREF=0
  315.                SEGINI IPT4
  316.                CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  317.                IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  318.                   CALL ERREUR(5)
  319.                   RETURN
  320.                ENDIF
  321.                IPT4.ITYPEL=ITYP2
  322.                IEL4=0
  323.                DO IBL=1,NBL
  324.                   DO IL=1,4
  325.                      DO IL2=1,3
  326.                         IEL4=IEL4+1
  327.                         DO IN=1,4
  328.                            IPT4.NUM(IN,IEL4)=
  329.      $                          IPT2.NUM(T15T7(T7Q4(IN,IL2),IL),IBL)
  330.                         ENDDO
  331.                         IPT4.NUM(5,IEL4)=IPT2.NUM(15,IBL)
  332.                         IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  333.                      ENDDO
  334.                   ENDDO
  335.                ENDDO
  336.                SEGDES IPT4
  337.             ELSE
  338.                GOTO 9998
  339.             ENDIF
  340.          ELSEIF (MTYP.EQ.'PY19') THEN
  341.             MTYP2=LTYPD3(JTY)
  342.             IF (MTYP2.EQ.'TET4') THEN
  343. * Passage PY19 -> 16 TET4
  344.                NBNN=4
  345.                NBELEM=NBL*16
  346.                NBSOUS=0
  347.                NBREF=0
  348.                SEGINI IPT4
  349.                CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  350.                IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  351.                   CALL ERREUR(5)
  352.                   RETURN
  353.                ENDIF
  354.                IPT4.ITYPEL=ITYP2
  355.                IEL4=0
  356.                DO IBL=1,NBL
  357. *   D'abord les 4 HEX6 des coins
  358.                   DO IL=1,4
  359.                      DO IL2=1,3
  360.                         IEL4=IEL4+1
  361.                         DO IN=1,4
  362.                            IPT4.NUM(IN,IEL4)=
  363.      $                          IPT2.NUM(P19H6(H6T4(IN,IL2),IL),IBL)
  364.                         ENDDO
  365.                         IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  366.                      ENDDO
  367.                   ENDDO
  368. *   Puis l'octaèdre du milieu
  369.                   DO IL=1,4
  370.                      IEL4=IEL4+1
  371.                      DO IN=1,4
  372.                         IPT4.NUM(IN,IEL4)=
  373.      $                       IPT2.NUM(P19O6(O6T4(IN,IL)),IBL)
  374.                      ENDDO
  375.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  376.                   ENDDO
  377.                ENDDO
  378.                SEGDES IPT4
  379.             ELSEIF (MTYP2.EQ.'PYR5') THEN
  380. * Passage PY19 -> 16 PYR5
  381.                NBNN=5
  382.                NBELEM=NBL*16
  383.                NBSOUS=0
  384.                NBREF=0
  385.                SEGINI IPT4
  386.                CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  387.                IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  388.                   CALL ERREUR(5)
  389.                   RETURN
  390.                ENDIF
  391.                IPT4.ITYPEL=ITYP2
  392.                IEL4=0
  393.                DO IBL=1,NBL
  394. *   Les faces triangulaires
  395.                   DO IL=1,4
  396.                      DO IL2=1,3
  397.                         IEL4=IEL4+1
  398.                         DO IN=1,4
  399.                            IPT4.NUM(IN,IEL4)=
  400.      $                          IPT2.NUM(P19T7(T7Q4(IN,IL2),IL),IBL)
  401.                         ENDDO
  402.                         IPT4.NUM(5,IEL4)=IPT2.NUM(19,IBL)
  403.                         IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  404.                      ENDDO
  405.                   ENDDO
  406. *   La face carrée
  407.                   DO IL=1,4
  408.                      IEL4=IEL4+1
  409.                      DO IN=1,4
  410.                         IPT4.NUM(IN,IEL4)=
  411.      $                       IPT2.NUM(P19Q9(Q9Q4(IN,IL)),IBL)
  412.                      ENDDO
  413.                      IPT4.NUM(5,IEL4)=IPT2.NUM(19,IBL)
  414.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  415.                   ENDDO
  416.                ENDDO
  417.                SEGDES IPT4
  418.             ELSE
  419.                GOTO 9998
  420.             ENDIF
  421.          ELSEIF (MTYP.EQ.'PR21') THEN
  422.             MTYP2=LTYPD3(JTY)
  423.             IF (MTYP2.EQ.'TET4') THEN
  424. * Passage PR21 -> 24 TET4
  425.                NBNN=4
  426.                NBELEM=NBL*24
  427.                NBSOUS=0
  428.                NBREF=0
  429.                SEGINI IPT4
  430.                CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  431.                IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  432.                   CALL ERREUR(5)
  433.                   RETURN
  434.                ENDIF
  435.                IPT4.ITYPEL=ITYP2
  436.                IEL4=0
  437.                DO IBL=1,NBL
  438. *   D'abord les 4 PRI6 de type A
  439.                   DO IL=1,4
  440.                      DO IL2=1,3
  441.                         IEL4=IEL4+1
  442.                         DO IN=1,4
  443.                            IPT4.NUM(IN,IEL4)=
  444.      $                          IPT2.NUM(P21P6A(P6AT4(IN,IL2),IL),IBL)
  445.                         ENDDO
  446.                         IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  447.                      ENDDO
  448.                   ENDDO
  449. *   Puis les 4 PRI6 de type B
  450.                   DO IL=1,4
  451.                      DO IL2=1,3
  452.                         IEL4=IEL4+1
  453.                         DO IN=1,4
  454.                            IPT4.NUM(IN,IEL4)=
  455.      $                          IPT2.NUM(P21P6B(P6BT4(IN,IL2),IL),IBL)
  456.                         ENDDO
  457.                         IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  458.                      ENDDO
  459.                   ENDDO
  460.                ENDDO
  461.                SEGDES IPT4
  462.             ELSEIF (MTYP2.EQ.'CUB8') THEN
  463. * Passage PR21 -> 6 CUB8
  464.                NBNN=8
  465.                NBELEM=NBL*6
  466.                NBSOUS=0
  467.                NBREF=0
  468.                SEGINI IPT4
  469.                CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  470.                IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  471.                   CALL ERREUR(5)
  472.                   RETURN
  473.                ENDIF
  474.                IPT4.ITYPEL=ITYP2
  475.                IEL4=0
  476.                DO IBL=1,NBL
  477.                   DO IL=1,6
  478.                      IEL4=IEL4+1
  479.                      DO IN=1,8
  480.                         IPT4.NUM(IN,IEL4)=IPT2.NUM(P21C8(IN,IL),IBL)
  481.                      ENDDO
  482.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  483.                   ENDDO
  484.                ENDDO
  485.                SEGDES IPT4
  486.             ELSEIF (MTYP2.EQ.'PYR5') THEN
  487. * Passage PR21 -> 18 PYR5
  488.                NBNN=5
  489.                NBELEM=NBL*18
  490.                NBSOUS=0
  491.                NBREF=0
  492.                SEGINI IPT4
  493.                CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  494.                IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  495.                   CALL ERREUR(5)
  496.                   RETURN
  497.                ENDIF
  498.                IPT4.ITYPEL=ITYP2
  499.                IEL4=0
  500.                DO IBL=1,NBL
  501. *     Les faces triangulaires
  502.                   DO IL=1,2
  503.                      DO IL2=1,3
  504.                         IEL4=IEL4+1
  505.                         DO IN=1,4
  506.                            IPT4.NUM(IN,IEL4)=
  507.      $                          IPT2.NUM(P21T7(T7Q4(IN,IL2),IL),IBL)
  508.                         ENDDO
  509.                         IPT4.NUM(5,IEL4)=IPT2.NUM(21,IBL)
  510.                         IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  511.                      ENDDO
  512.                   ENDDO
  513. *     Les faces carrées
  514.                   DO IL=1,3
  515.                      DO IL2=1,4
  516.                         IEL4=IEL4+1
  517.                         DO IN=1,4
  518.                            IPT4.NUM(IN,IEL4)=
  519.      $                          IPT2.NUM(P21Q9(Q9Q4(IN,IL2),IL),IBL)
  520.                         ENDDO
  521.                         IPT4.NUM(5,IEL4)=IPT2.NUM(21,IBL)
  522.                         IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  523.                      ENDDO
  524.                   ENDDO
  525.                ENDDO
  526.                SEGDES IPT4
  527.             ELSE
  528.                GOTO 9998
  529.             ENDIF
  530.          ELSEIF (MTYP.EQ.'CU27') THEN
  531.             MTYP2=LTYPD3(JTY)
  532.             IF (MTYP2.EQ.'TET4') THEN
  533. * Passage CU27 -> 40 TET4
  534.                NBNN=4
  535.                NBELEM=NBL*40
  536.                NBSOUS=0
  537.                NBREF=0
  538.                SEGINI IPT4
  539.                CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  540.                IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  541.                   CALL ERREUR(5)
  542.                   RETURN
  543.                ENDIF
  544.                IPT4.ITYPEL=ITYP2
  545.                IEL4=0
  546.                DO IBL=1,NBL
  547.                   DO IL=1,8
  548.                      DO IL2=1,5
  549.                         IEL4=IEL4+1
  550.                         DO IN=1,4
  551.                            IPT4.NUM(IN,IEL4)=
  552.      $                          IPT2.NUM(C27C8(C8T4(IN,IL2),IL),IBL)
  553.                         ENDDO
  554.                      ENDDO
  555.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  556.                   ENDDO
  557.                ENDDO
  558.                SEGDES IPT4
  559.             ELSEIF (MTYP2.EQ.'CUB8') THEN
  560. * Passage CU27 -> 8 CUB8
  561.                NBNN=8
  562.                NBELEM=NBL*8
  563.                NBSOUS=0
  564.                NBREF=0
  565.                SEGINI IPT4
  566.                CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  567.                IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  568.                   CALL ERREUR(5)
  569.                   RETURN
  570.                ENDIF
  571.                IPT4.ITYPEL=ITYP2
  572.                IEL4=0
  573.                DO IBL=1,NBL
  574.                   DO IL=1,8
  575.                      IEL4=IEL4+1
  576.                      DO IN=1,8
  577.                         IPT4.NUM(IN,IEL4)=IPT2.NUM(C27C8(IN,IL),IBL)
  578.                      ENDDO
  579.                      IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  580.                   ENDDO
  581.                ENDDO
  582.                SEGDES IPT4
  583.             ELSEIF (MTYP2.EQ.'PYR5') THEN
  584. * Passage CU27 -> 24 PYR5
  585.                NBNN=5
  586.                NBELEM=NBL*24
  587.                NBSOUS=0
  588.                NBREF=0
  589.                SEGINI IPT4
  590.                CALL FIMOT2(MTYP2,NOMS,NOMBR,ITYP2,0,IRET)
  591.                IF ((IRET.NE.0).OR.ITYP2.EQ.0) THEN
  592.                   CALL ERREUR(5)
  593.                   RETURN
  594.                ENDIF
  595.                IPT4.ITYPEL=ITYP2
  596.                IEL4=0
  597.                DO IBL=1,NBL
  598.                   DO IL=1,6
  599.                      DO IL2=1,4
  600.                         IEL4=IEL4+1
  601.                         DO IN=1,4
  602.                            IPT4.NUM(IN,IEL4)=
  603.      $                          IPT2.NUM(C27Q9(Q9Q4(IN,IL2),IL),IBL)
  604.                         ENDDO
  605.                         IPT4.NUM(5,IEL4)=IPT2.NUM(27,IBL)
  606.                         IPT4.ICOLOR(IEL4)=IPT2.ICOLOR(IBL)
  607.                      ENDDO
  608.                   ENDDO
  609.                ENDDO
  610.                SEGDES IPT4
  611.             ELSE
  612.                GOTO 9998
  613.             ENDIF
  614.          ELSE
  615.             GOTO 9998
  616.          ENDIF
  617. *
  618.          IF (LCOMP) SEGDES IPT2
  619.          IF (IPT3.EQ.0) THEN
  620.             IPT3=IPT4
  621.          ELSE
  622.             ltelq=.false.
  623.             CALL FUSE(IPT3,IPT4,IPT5,ltelq)
  624.             IPT3=IPT5
  625.          ENDIF
  626. *
  627.       ENDDO
  628.       SEGDES IPT1
  629. *
  630.  
  631.       IPT1=IPT3
  632. *
  633. * Normal termination
  634. *
  635.       IRET=0
  636.       RETURN
  637. *
  638. * Format handling
  639. *
  640. *
  641. * Error handling
  642. *
  643. * 995 2
  644. *On ne sait pas changer des éléments %m1:4 en élément %m5:8
  645.  9998 CONTINUE
  646.       MOTERR(1:4)=MTYP
  647.       MOTERR(5:8)=NOMS(ITY)
  648.       CALL ERREUR(995)
  649.       RETURN
  650.  9999 CONTINUE
  651.       IRET=1
  652.       WRITE(IOIMP,*) 'An error was detected in subroutine chang2'
  653.       RETURN
  654. *
  655. * End of subroutine CHANG2
  656. *
  657.       END
  658.  
  659.  
  660.  
  661.  
  662.  
  663.  

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