upxfem2.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com_xfem1.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	upxfem2 (iparg, ixc, ngrouc, igrouc, iadc_crk, iel_crk, elcutc, ixtg, enrtag, inod_crk, iad_elem, fr_elem, iad_edge, fr_edge, fr_nbedge, crkedge)

Function/Subroutine Documentation

upxfem2()

subroutine upxfem2	(	integer, dimension(nparg,*)	iparg,
		integer, dimension(nixc,*)	ixc,
		integer	ngrouc,
		integer, dimension(*)	igrouc,
		integer, dimension(*)	iadc_crk,
		integer, dimension(*)	iel_crk,
		integer, dimension(2,*)	elcutc,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(numnod,*)	enrtag,
		integer, dimension(*)	inod_crk,
		integer, dimension(2,*)	iad_elem,
		integer, dimension(*)	fr_elem,
		integer, dimension(*)	iad_edge,
		integer, dimension(*)	fr_edge,
		integer, dimension(*)	fr_nbedge,
		type (xfem_edge_), dimension(*)	crkedge )

Definition at line 40 of file upxfem2.F.

C-----------------------------------------------
      USE crackxfem_mod
      use element_mod , only : nixc,nixtg
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com_xfem1.inc"
#include      "param_c.inc"
#include      "task_c.inc"
#include      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,*),IXC(NIXC,*),NGROUC,IGROUC(*),
     .        IADC_CRK(*),IEL_CRK(*),ELCUTC(2,*),IXTG(NIXTG,*),
     .        ENRTAG(NUMNOD,*),INOD_CRK(*),FR_ELEM(*),FR_EDGE(*),
     .        IAD_ELEM(2,*),IAD_EDGE(*),FR_NBEDGE(*)
      TYPE (XFEM_EDGE_)   , DIMENSION(*) :: CRKEDGE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER IG,NG,JFT,JLT,NEL,ITG1,ITG2,
     .        SIZE,LSDRC,FLAG,ACTIFXFEM,NXLAY
C=======================================================================
C---
C_tmp      IF(NUMELCRK2 == NUMELCRK)RETURN  ! check in hypethreading, SPMD
C---
C----------------------------------------
      itg1 = 1+numelc
      itg2 = 1 + ecrkxfec*4
      nxlay = nxlaymax
c-------------------------------
C SMP dynamic parallel loop
!$omp DO schedule(dynamic,1)
c-------------------------------
c     Save actual phantom enrichments at the end of cycle
c-------------------------------
      DO ig = 1, ngrouc
        ng = igrouc(ig)
        IF (iparg(54,ng) == 0) GOTO 100    ! IXFEM 
        IF (iparg(8,ng)  == 1) GOTO 100    ! GROUP OFF
        IF (iddw > 0) CALL startimeg(ng)
C---
        ity   = iparg(5,ng)
        nel   = iparg(2,ng)
        nft   = iparg(3,ng)
        actifxfem=iparg(70,ng)
        lft   = 1 
        llt   = min(nvsiz,nel)
        jft=lft
        jlt=llt
        IF (actifxfem == 0) GOTO 100
C---
        IF (ity == 3) THEN
          CALL upenric_last(
     .        ixc    ,nft     ,jft    ,jlt  ,iadc_crk, 
     .        iel_crk,elcutc,nxlay   ,crkedge )
C---
        ELSEIF (ity == 7) THEN
          CALL upenritg_last(
     .        ixtg  ,nft    ,jft  ,jlt,iadc_crk(itg2),
     .        iel_crk(itg1),elcutc(1,itg1),nxlay,crkedge )
        ENDIF
C---
        IF (iddw > 0) CALL stoptimeg(ng)
 100  CONTINUE
      END DO
!$OMP END DO
C-------------
      numelcrk2 = numelcrk  
c                                                anim file / crack advance)
C-------------
C
      IF(nspmd > 1)THEN
        CALL spmd_max_xfe_i(numelcrk2)  ! no more used
        SIZE = ienrnod
        lsdrc = iad_elem(1,nspmd+1)-iad_elem(1,1)
        flag = 2
        CALL spmd_exch_nodenr(iad_elem,fr_elem,SIZE,lsdrc,inod_crk,
     .                        enrtag,flag)
C
        flag = 2
        SIZE  = nxlay
        lsdrc = fr_nbedge(nspmd+1)
        CALL spmd_exch_iedge(iad_edge,fr_edge,SIZE  ,lsdrc,fr_nbedge,
     .                       flag    ,crkedge)
C
        SIZE  = nxlay
        lsdrc = fr_nbedge(nspmd+1)
        CALL spmd_exch_redge(iad_edge,fr_edge,SIZE,lsdrc,fr_nbedge,crkedge)
C
      END IF
C-------------
      RETURN