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