Esope source files

   1 : C PARTXR    SOURCE    CHAT      11/03/16    21:28:46     6902           
   2 : 
   3 :       SUBROUTINE PARTXR (IMODLC,IMAILR, IMODLR)
   4 : 
   5 : C-----------------------------------------------------------------------
   6 : C     SOUS-PROGRAMME REALISANT LE PARTITIONNEMENT/REDUCTION DU MCHAML
   7 : C     D'ENRICHISSEMENT CONTENU DANS LE MODELE ASSOCIE A DES ELEMENTS
   8 : C     DE TYPE XFEM/RUPTURE
   9 : C-----------------------------------------------------------------------
  10 : C     IMODLC   Si IMODLC non nul :
  11 : C              Modele elementaire de REFERENCE (complet) s'appyant sur 
  12 : C              des elements de type XFEM (formulation MFR=63), contenant
  13 : C              en particulier le MCHAML d'ENRICHISSEMENT
  14 : C              Segment IMODEL : ACTIF en Entree/Sortie & non modifie
  15 : C     IMAILR   Maillage sur lequel on souhaite reduire le MCHAML 
  16 : C              d'ENRICHISSEMENT du sous-modele IMODLC
  17 : C              Si IMAILR=0 en entree, on recupere le maillage contenu
  18 : C              dans IMODLR (suppose alors non nul)
  19 : C              Segment MELEME : non modifie
  20 : C     IMODLR   Modele elementaire REDUIT contenant le MCHAML d'ENRICHIS-
  21 : C              SEMENT reduit s'appuyant sur IMAILR
  22 : C              Segment IMODEL : ACTIF en Sortie
  23 : C              Si IMODLR=0 en Entree, segment cree par copie de IMODLC
  24 : C              s'appuyant sur IMAILR (suppose alors non nul)
  25 : C              Sinon on utilise le segment tel quel.
  26 : C              Le sous-programme met ensuite a jour le MCHAML ENRICHIS
  27 : C              reduit au maillage IMAILR ou IMODLR.IMAMOD !
  28 : C-----------------------------------------------------------------------
  29 : 
  30 :       IMPLICIT INTEGER (I-N)
  31 :       IMPLICIT REAL*8 (A-H,O-Z)
  32 : 
  33 : -INC CCOPTIO
  34 : 
  35 : -INC SMCHAML
  36 : -INC SMELEME
  37 : -INC SMMODEL
  38 : 
  39 : C- 
  40 :       IF (IMODLC.GT.0) THEN
  41 :         IMODEL = IMODLC
  42 :         SEGACT,IMODEL
  43 :         IF (IMODLR.EQ.0) THEN
  44 :           IF (IMAILR.EQ.0) THEN
  45 :             WRITE(IOIMP,*) '#####  SOUS-PROGRAMME PARTXR #####'
  45 :             CALL ERREUR(21)
  46 :             RETURN
  47 :           ENDIF
  48 :           SEGINI,IMODE1=IMODEL
  49 :           IMODE1.IMAMOD = IMAILR
  50 :           IMODE1.INFMOD(2) = 0
  51 :           IMODLR = IMODE1
  52 :         ELSE
  53 :           IMODE1 = IMODLR
  54 :           SEGACT,IMODE1*MOD
  55 :           IF (IMAILR.NE.0) IMODE1.IMAMOD = IMAILR
  56 :         ENDIF
  57 :       ELSE
  58 :         IF (IMODLR.EQ.0 .OR. IMAILR.EQ.0) THEN
  59 :           WRITE(IOIMP,*) '#####  SOUS-PROGRAMME PARTXR #####'
  59 :           CALL ERREUR(21)
  60 :           RETURN
  61 :         ENDIF
  62 :         IMODE1 = IMODLR
  63 :         SEGINI,IMODEL = IMODE1
  64 :         SEGACT,IMODE1*MOD
  65 :         IMODE1.IMAMOD = IMAILR
  66 :       ENDIF
  67 :       IMAIL1 = IMODE1.IMAMOD
  68 :       
  69 : C- Petit test pour gagner du temps ?
  70 :       IF (IMAMOD .EQ. IMAIL1) GOTO 900
  71 : 
  72 : C- Recuperation du MCHAML d enrichissement dans IMODEL
  72 :       CALL ICHAXR(IMODEL, ICHAMX,MCHELM)
  73 :       IF (ICHAMX .EQ. 0) GOTO 900
  74 : 
  75 : C- Reduction du MCHAML d'enrichissement au maillage concerne
  75 :       CALL REDUIC(MCHELM,IMAIL1, ICHAMR)
  76 :       IF (IERR.NE.0) GOTO 900
  77 :       IMODE1.IVAMOD(ICHAMX) = ICHAMR
  78 : 
  79 : C- Reactivation du maillage support du modele complet suite a reduction
  80 :       IF (IMODLC.NE.0) THEN
  81 :         MELEME = IMAMOD
  82 :         SEGACT,MELEME
  83 :       ENDIF
  84 : C- Reactivation du maillage support du modele reduit suite a reduction
  85 :       MELEME = IMAIL1
  86 :       SEGACT,MELEME
  87 : 
  88 :  900  CONTINUE
  89 : C*    SEGDES,IMODE1
  90 : C*    SEGDES,IMODEL
  91 :       IF (IMODLC.EQ.0) SEGSUP,IMODEL
  92 : 
  93 :       RETURN
  94 :       END
  95 : 
  96 :  
  97 :