upxfem2.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    upxfem2            ../engine/source/elements/xfem/upxfem2.F
!||--- called by ------------------------------------------------------
!||    resol              ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||    spmd_exch_iedge    ../engine/source/mpi/elements/spmd_xfem.F
!||    spmd_exch_nodenr   ../engine/source/mpi/elements/spmd_xfem.F
!||    spmd_exch_redge    ../engine/source/mpi/elements/spmd_xfem.F
!||    spmd_max_xfe_i     ../engine/source/mpi/elements/spmd_xfem.F
!||    startimeg          ../engine/source/system/timer.F
!||    stoptimeg          ../engine/source/system/timer.F
!||    upenric_last       ../engine/source/elements/xfem/upenric_last.F
!||    upenritg_last      ../engine/source/elements/xfem/upenritg_last.F
!||--- uses       -----------------------------------------------------
!||    crackxfem_mod      ../engine/share/modules/crackxfem_mod.F
!||    element_mod        ../common_source/modules/elements/element_mod.F90
!||====================================================================
      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  )
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
      END