Sources Esope | Cast3M

partxr
C PARTXR    SOURCE    CB215821  24/04/12    21:16:50     11897          
 
      SUBROUTINE PARTXR (IMODLC,IMAILR, IMODLR)
 
C-----------------------------------------------------------------------
C     SOUS-PROGRAMME REALISANT LE PARTITIONNEMENT/REDUCTION DU MCHAML
C     D'ENRICHISSEMENT CONTENU DANS LE MODELE ASSOCIE A DES ELEMENTS
C     DE TYPE XFEM/RUPTURE
C-----------------------------------------------------------------------
C     IMODLC   Si IMODLC non nul :
C              Modele elementaire de REFERENCE (complet) s'appyant sur
C              des elements de type XFEM (formulation MFR=63), contenant
C              en particulier le MCHAML d'ENRICHISSEMENT
C              Segment IMODEL : ACTIF en Entree/Sortie & non modifie
C     IMAILR   Maillage sur lequel on souhaite reduire le MCHAML
C              d'ENRICHISSEMENT du sous-modele IMODLC
C              Si IMAILR=0 en entree, on recupere le maillage contenu
C              dans IMODLR (suppose alors non nul)
C              Segment MELEME : non modifie
C     IMODLR   Modele elementaire REDUIT contenant le MCHAML d'ENRICHIS-
C              SEMENT reduit s'appuyant sur IMAILR
C              Segment IMODEL : ACTIF en Sortie
C              Si IMODLR=0 en Entree, segment cree par copie de IMODLC
C              s'appuyant sur IMAILR (suppose alors non nul)
C              Sinon on utilise le segment tel quel.
C              Le sous-programme met ensuite a jour le MCHAML ENRICHIS
C              reduit au maillage IMAILR ou IMODLR.IMAMOD !
C-----------------------------------------------------------------------
 
      IMPLICIT INTEGER (I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMCHAML
-INC SMELEME
-INC SMMODEL
 
C-
      IF (IMODLC.GT.0) THEN
        IMODEL = IMODLC
        SEGACT,IMODEL
        IF (IMODLR.EQ.0) THEN
          IF (IMAILR.EQ.0) THEN
            WRITE(IOIMP,*) '#####  SOUS-PROGRAMME PARTXR #####'
            CALL ERREUR(21)
            RETURN
          ENDIF
          SEGINI,IMODE1=IMODEL
          IMODE1.IMAMOD = IMAILR
          IMODE1.INFMOD(2) = 0
          IMODLR = IMODE1
        ELSE
          IMODE1 = IMODLR
          SEGACT,IMODE1*MOD
          IF (IMAILR.NE.0) IMODE1.IMAMOD = IMAILR
        ENDIF
      ELSE
        IF (IMODLR.EQ.0 .OR. IMAILR.EQ.0) THEN
          WRITE(IOIMP,*) '#####  SOUS-PROGRAMME PARTXR #####'
          CALL ERREUR(21)
          RETURN
        ENDIF
        IMODE1 = IMODLR
        SEGINI,IMODEL = IMODE1
        SEGACT,IMODE1*MOD
        IMODE1.IMAMOD = IMAILR
      ENDIF
      IMAIL1 = IMODE1.IMAMOD
 
C- Petit test pour gagner du temps ?
      IF (IMAMOD .EQ. IMAIL1) GOTO 900
 
C- Recuperation du MCHAML d enrichissement dans IMODEL
      CALL ICHAXR(IMODEL, ICHAMX,MCHELM)
      IF (ICHAMX .EQ. 0) GOTO 900
 
C- Reduction du MCHAML d'enrichissement au maillage concerne
      CALL REDUIC(MCHELM,IMAIL1, ICHAMR)
      IF (IERR.NE.0) GOTO 900
      IMODE1.IVAMOD(ICHAMX) = ICHAMR
 
C- Reactivation du maillage support du modele complet suite a reduction
      IF (IMODLC.NE.0) THEN
        MELEME = IMAMOD
        SEGACT,MELEME
      ENDIF
C- Reactivation du maillage support du modele reduit suite a reduction
      MELEME = IMAIL1
      SEGACT,MELEME
 
 900  CONTINUE
C*    SEGDES,IMODE1
C*    SEGDES,IMODEL
      IF (IMODLC.EQ.0) SEGSUP,IMODEL
 
      RETURN
      END