Sources Esope | Cast3M

inver4
C INVER4    SOURCE    CB215821  16/07/05    21:15:03     9005           
      SUBROUTINE INVER4(ipt1,ipt2,icle,mlenti)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : INVER4
C DESCRIPTION :
C
C   INVERSE UN OBJET MAILLAGE ELEMENTAIRE
C
C   IPT1     (E)   MAILLAGE A INVERSER (segment ACTIF)
C   IPT2     (S)   MAILLAGE INVERSE    (segment ACTIF)
C   ICLE     1 : on inverse les elements et aussi l'ordre
C                de parcours des elements dans le maillage
C                Ceci est indispensable pour les lignes.
C            2 : on inverse juste les elements
C            3 : on inverse une partie des elements en se basant sur le
C                mlenti (si +1, on garde tel quel, si -1 on inverse)
C
C   MLENTI  (E)   LISTE DES ELEMENTS a INVERSER (segment ACTIF)
C
C  ipt1 et ipt2 sont des maillages elementaires (nbsous=0)
C  Si le type de l'element n'est pas "inversable", on retourne le
C  maillage d'entree tel quel.
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C VERSION    : v1, 11/05/2016, version initiale
C HISTORIQUE : v1, 11/05/2016, création (inspiration invers.eso)
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMLENTI
*
      PARAMETER (NLINVE=22)
      PARAMETER (NLNOIN=214)
*     Tableau donnant la liste des types d'elements susceptibles d'etre
*     traites. Ce tableau devrait etre sensiblement identique a celui de
*     orient.eso
      INTEGER LTYINV(NLINVE)
*     Pour chaque element susceptible d'etre traite, ce tableau donne
*     l'adresse dans le tableau LNOINV
      INTEGER LADINV(NLINVE)
*     Ce tableau donne les nbnne noeuds de chaque element apres
*     inversion. Pour chaque element, c'est une permutation
      INTEGER LNOINV(NLNOIN)
*
*                  SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9   10
      DATA LTYINV/ 2,     3,  4,   5,   6,   7,   8,   9,   10,  11,
C                  CUB8 CU20  PRI6  PR15  TET4 TE10  PYR5  PY13        18
     $             14,   15,   16,   17,   23,  24,   25,   26,
C                  CU27  PR21  TE15  PY19                              22
     $             33,   34,   35,   36/
*                  SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9   10
      DATA LADINV/ 1,     3,   6,   9,   13,  19,  26,  30,  35,  43,
C                  CUB8 CU20  PRI6  PR15  TET4 TE10  PYR5  PY13        18
     $             52,    60,   80,  86,   101, 105,  115,  120,
C                  CU27  PR21  TE15  PY19                              22
     $             133,   160,  181,  196/
*                  SEG2   SEG3    TRI3    TRI4     TRI6         18
      DATA LNOINV/ 2,1,   3,2,1,  1,3,2,  1,3,2,4, 1,6,5,4,3,2,
C          TRI7            QUA4      QUA5       QUA8            24
     $     1,6,5,4,3,2,7,  1,4,3,2,  1,4,3,2,5, 1,8,7,6,5,4,3,2,
C          QUA9                CUB8                             17
     $     1,8,7,6,5,4,3,2,9,  1,4,3,2, 5,8,7,6,
C          CU20                                                 20
     $     1,8,7,6,5,4,3,2, 9,12,11,10, 13,20,19,18,17,16,15,14,
C          PRI6          PR15                                   21
     $     1,3,2,4,6,5,  1,6,5,4,3,2,7,9,8,10,15,14,13,12,11,
C          TET4      TE10                                       14
     $     1,3,2,4,  1,6,5,4,3,2, 7,9,8, 10,
C          PYR5        PY13                                     18
     $     1,4,3,2,5,  1,8,7,6,5,4,3,2, 9,12,11,10, 13,
C          CU27                                                 27
     $     1,8,7,6,5,4,3,2, 9,12,11,10, 13,20,19,18,17,16,15,14,
     $     24,23,22,21, 25,26,27,
C          PR21                                                 21
     $     1,6,5,4,3,2, 7,9,8, 10,15,14,13,12,11, 18,17,16, 19,20,21,
C          TE15 (pas la meme logique que CU27 et PR21 pour les faces !)
     $     1,6,5,4,3,2, 7,9,8, 10, 11, 14,13,12, 15,
C          PY19 (comme TE15)
     $     1,8,7,6,5,4,3,2, 9,12,11,10, 13, 14, 18,17,16,15, 19/
*
* Executable statements
*
 
C CB215821 : Ajout de controles sur les donnees d'entree
      IF ((ICLE .EQ. 3 .AND. MLENTI .EQ. 0) .OR. 
     &    (ICLE .NE. 3 .AND. MLENTI .NE. 0) .OR. 
     &    (ICLE .LT. 1 .OR.  ICLE   .GT. 3)) THEN
        CALL ERREUR(5)
        RETURN
      ENDIF
 
 
* Sait-on inverser l'element ?
      ILINVE=0
      ITY=IPT1.ITYPEL
      DO I=1,NLINVE
         IF (ITY.EQ.LTYINV(I)) THEN
            ILINVE=I
            GOTO 666
         ENDIF
      ENDDO
 666  CONTINUE
      IF (ILINVE.EQ.0) THEN
         IPT2=IPT1
         RETURN
      ENDIF
*
      NBREF =IPT1.LISREF(/1)
      NBSOUS=0
      NBNN  =IPT1.NUM(/1)
      NBELEM=IPT1.NUM(/2)
      IF (ICLE .EQ. 3) THEN
         JG=LECT(/1)
         IF (JG .NE. NBELEM) THEN
            CALL ERREUR(5)
            RETURN
         ENDIF
      ENDIF
*
C On choisit d'oublier le contour suite a l'inversion.
      IF (NBREF .EQ. 1) NBREF=0
      SEGINI,MELEME
      IF (NBREF .GT. 0) THEN
         DO I=1,NBREF
            LISREF(I)=IPT1.LISREF(I)
         ENDDO
      ENDIF
      ITYPEL=IPT1.ITYPEL
      IADR=LADINV(ILINVE)-1
      DO IL=1,NBELEM
         IF (ICLE.EQ.1) THEN
            IK=NBELEM+1-IL
         ELSE
            IK=IL
         ENDIF
 
         DO IN=1,NBNN
           IF (ICLE .NE. 3) THEN
             IO=LNOINV(IADR+IN)
           ELSE
             IF (LECT(IL) .EQ. -1) THEN
               IO=LNOINV(IADR+IN)
             ELSE
               IO=IN
             ENDIF
           ENDIF
           NUM(IO,IK)=IPT1.NUM(IN,IL)
         ENDDO
         ICOLOR(IK)=IPT1.ICOLOR(IL)
      ENDDO
      IPT2=MELEME
*
* Normal termination
*
      RETURN
*
* End of subroutine INVER4
*
      END