Sources Esope | Cast3M

mocon4
C MOCON4    SOURCE    MB234859  26/05/13    21:15:07     12548          
C----------------------------------------------------------------------
C          Verification et adaptation du maillage de contact
C
C  Verifier les elements supports du maillage de contact.
C  S'il ne s'agit pas de SEG2 (2D) ou de TRI3 (3D), adapter le 
C  maillage et construire, s'il s'agit d'elements quadratiques,
C  les conditions cinematiques a imposer aux noeuds milieu.
C
C  Entrees :
C  --------
C    MELEME : Pointeur sur le maillage du modele de contact.
C
C  Sorties :
C  --------
C    IPMAI  : Si le type d'element n'etait pas celui attendu et que 
C             le maillage a pu etre adapte, pointeur sur ce maillage.
C             Sinon, pointeur sur le maillagei initial.
C    IPRIG  : Si necessaire, pointeur sur un objet MRIGID imposant des 
C             conditions cinematiques sur les noeuds milieu. Sinon vaut 0
C
C  Remarque :
C  ----------
C  En presence d'elements quadratiques, ces derniers sont remplaces par 
C  des elements lineaires.
C  Si on souhaite remplace 1 element quadratique par 1 element lineaire,
C  il faut uitliser la subroutine CHANL2 au lieu de CHANGE.
C
C  Appelee par : MOCON1
C----------------------------------------------------------------------
      SUBROUTINE MOCON4(MELEME,IPMAI,IPRIG)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC CCGEOME
C
      IPMAI=0
      IPRIG=0
C
      NBMAI0=LISOUS(/1)
      NBMAI=NBMAI0
      IF (NBMAI0.EQ.0) NBMAI=1
      IPT1=MELEME
C
C     Verification du type d'element
      DO IMAI=1,NBMAI
C
        IF (NBMAI0.NE.0) IPT1=LISOUS(IMAI)
C
        ITYEL = IPT1.ITYPEL
        IF     (IDIM.EQ.2) THEN
C         Elements SEG2 ou SEG3
          IF ((ITYEL.NE.2).AND.(ITYEL.NE.3))  CALL ERREUR(16)
        ELSEIF (IDIM.EQ.3) THEN
C         Elements TRI3 TRI6 QUA4 ou QUA8
          IF ((ITYEL.NE.4).AND.(ITYEL.NE.6).AND.
     &        (ITYEL.NE.8).AND.(ITYEL.NE.10)) CALL ERREUR(16)
        ENDIF
        IF (IERR.NE.0) RETURN
      ENDDO
C
      CALL PLACE(NOMS,NOMBR,IS2,'SEG2')
      CALL PLACE(NOMS,NOMBR,IT3,'TRI3')
      CALL PLACE(NOMS,NOMBR,IQ4,'QUA4')
C
C     Modifier les elements si necessaire
      DO IMAI=1,NBMAI
        IRI2=0
        IPT2=0
        IF (NBMAI0.NE.0) IPT1=LISOUS(IMAI)
        ITYEL = IPT1.ITYPEL
        IF     (IDIM.EQ.2) THEN
          IF (ITYEL.EQ.3) THEN
            CALL RELAMI(0,IPT1,IRI2)
C           Changer SEG3 -> SEG2
            CALL CHANGE(IPT1,IS2)
            IPT2=IPT1
          ENDIF
        ELSEIF (IDIM.EQ.3) THEN
          IF     (ITYEL.EQ.6) THEN
            IPT0=IPT1
            CALL RELAMI(0,IPT0,IRI2)
C           Changer TRI6 -> TRI3
            CALL CHANGE(IPT1,IT3)
            IPT2=IPT1
          ELSEIF (ITYEL.EQ.8) THEN
C           Changer QUA4 -> TRI3
            CALL CHANGE(IPT1,IT3)
            IPT2=IPT1
          ELSEIF (ITYEL.EQ.10) THEN
            IPT0=IPT1
            CALL RELAMI(0,IPT0,IRI2)
C           Changer QUA8 -> TRI3
            CALL CHANGE(IPT1,IT3)
            IPT2=IPT1
          ENDIF
          IF (IERR.NE.0) RETURN
        ENDIF
C
C       Fusionner les rigidites
        IF (IRI2.NE.0) THEN
          IF (IPRIG.NE.0) THEN
            CALL FUSRIG(IRI2,IPRIG,IRI3)
            IPRIG=IRI3
          ELSE
            IPRIG=IRI2
          ENDIF
        ENDIF
C
C       Fusionner les maillages
        IF (IPT2.NE.0) THEN
          IF (IPMAI.NE.0) THEN
            CALL FUSE(IPT2,IPMAI,IPT3,.FALSE.)
            IPMAI=IPT3
          ELSE
            IPMAI=IPT2
          ENDIF
        ELSE
          IPMAI=IPT1
        ENDIF
C
      ENDDO
      IF (IPMAI.EQ.0) IPMAI=MELEME
      END