crk_tagxp3.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/.
c
!||====================================================================
!||    crk_tagxp3      ../engine/source/elements/xfem/crk_tagxp3.F
!||--- called by ------------------------------------------------------
!||    upxfem_tagxp    ../engine/source/elements/xfem/upxfem_tagxp.F
!||--- uses       -----------------------------------------------------
!||    crackxfem_mod   ../engine/share/modules/crackxfem_mod.F
!||    element_mod     ../common_source/modules/elements/element_mod.F90
!||====================================================================
      SUBROUTINE crk_tagxp3(IPARG  ,IXTG     ,NFT      ,JFT     ,JLT   ,
     .                      ELCUTC ,IAD_CRKTG,IEL_CRKTG,INOD_CRK,ENRTAG,
     .                      NXLAY  ,CRKEDGE  ,XEDGE3N  ,ITAB    )
C-----------------------------------------------
      USE crackxfem_mod
      use element_mod , only : nixtg
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "com_xfem1.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NFT,JFT,JLT,NXLAY
      INTEGER IPARG(NPARG,*),IXTG(NIXTG,*),ELCUTC(2,*),INOD_CRK(*),
     .  iad_crktg(3,*),xedge3n(3,*),iel_crktg(*),enrtag(numnod,*),itab(numnod)
      TYPE (XFEM_EDGE_)   , DIMENSION(*) :: CRKEDGE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K,IR,ELCRK,ELCRKTG,ILEV,ILAY,IXEL,ELCUT,NELCRK,NSX,
     .  EDGE,IBOUNDEDGE,LAYCUT,ENR0,ENR,ITRI,IAD
      INTEGER JCT(MVSIZ),IADC(3),NS(3)
C=======================================================================
      nelcrk = 0
      DO i=jft,jlt
        jct(i) = 0
        IF (elcutc(1,i+nft) /= 0) THEN
          nelcrk = nelcrk + 1
          jct(nelcrk) = i
        ENDIF
      ENDDO
      IF (nelcrk == 0) RETURN
C
      DO ilay=1,nxlay
        DO ixel=1,nxel
          ilev = nxel*(ilay-1) + ixel
          DO ir=1,nelcrk
            i = jct(ir)
            elcrktg = iel_crktg(i+nft)
            elcrk  = elcrktg + ecrkxfec
            elcut  = xfem_phantom(ilay)%ELCUT(elcrk)
            IF (elcut /= 0) THEN
              ns(1) = ixtg(2,i+nft)
              ns(2) = ixtg(3,i+nft)
              ns(3) = ixtg(4,i+nft)
              iadc(1) = iad_crktg(1,elcrktg)
              iadc(2) = iad_crktg(2,elcrktg)
              iadc(3) = iad_crktg(3,elcrktg)
              itri    = xfem_phantom(ilay)%ITRI(1,elcrk)
              laycut  = crkedge(ilay)%LAYCUT(elcrk)
c---------------------------------------
              IF (abs(laycut) == 1) THEN
c               new advancing crack
c               Tag phantom nodes with positive enrichment to copy the velocities
c---------------------------------------
                IF (ixel == 3) THEN         ! sender
                  DO k=1,3                                                       
                    iad  = iadc(k)                                                 
                    enr0 = crklvset(ilev)%ENR0(2,iad)
                    enr  = crklvset(ilev)%ENR0(1,iad)
                    edge = xedge3n(k,elcrktg) ! global egdge N       
                    iboundedge = crkedge(ilay)%IBORDEDGE(edge)
                    nsx = inod_crk(ns(k))
                    IF (enr > 0 .and. iboundedge /= 2) THEN
                      xfem_phantom(ilay)%TAGXP(1,nsx,enr) = iad                                       
                      xfem_phantom(ilay)%TAGXP(2,nsx,enr) = ilev 
                      xfem_phantom(ilay)%TAGXP(3,nsx,enr) = 2   ! counter
                    ENDIF                                                             
                  ENDDO                                                               
                ELSE                        ! receiver                                             
                  DO k=1,3                                                        
                    iad  = iadc(k)                                                 
                    enr0 = crklvset(ilev)%ENR0(2,iad)
                    enr  = abs(crklvset(ilev)%ENR0(1,iad))
                    edge = xedge3n(k,elcrktg) ! global egdge N       
                    iboundedge = crkedge(ilay)%IBORDEDGE(edge)
                    nsx = inod_crk(ns(k))
                    IF (enr > 0 .and. iboundedge /= 2) THEN
                      xfem_phantom(ilay)%TAGXP(4,nsx,enr) = iad                                  
                      xfem_phantom(ilay)%TAGXP(5,nsx,enr) = ilev
                      xfem_phantom(ilay)%TAGXP(3,nsx,enr) = 2      ! counter
                    ENDIF                                                             
                  ENDDO
                ENDIF                                                             
              ENDIF   ! LAYCUT = 1                                                            
C--------------------------------------------------------------------------
            ENDIF  ! IF(ELCUT /= 0)THEN
          ENDDO  !  DO IR=1,NELCRK
        ENDDO  !  DO IXEL=1,NXEL
      ENDDO  !  DO ILAY=1,NXLAY
C-----------------------------------------------
      RETURN
      END