upenric2_n3.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "com_xfem1.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	upenric2_n3 (iparg, ixtg, nft, jft, jlt, elcutc, iad_crktg, iel_crktg, inod_crk, enrtag, nxlay, crkedge, xedge3n)

Function/Subroutine Documentation

upenric2_n3()

subroutine upenric2_n3	(	integer, dimension(nparg,*)	iparg,
		integer, dimension(nixtg,*)	ixtg,
		integer	nft,
		integer	jft,
		integer	jlt,
		integer, dimension(2,*)	elcutc,
		integer, dimension(3,*)	iad_crktg,
		integer, dimension(*)	iel_crktg,
		integer, dimension(*)	inod_crk,
		integer, dimension(numnod,*)	enrtag,
		integer	nxlay,
		type (xfem_edge_), dimension(*)	crkedge,
		integer, dimension(3,*)	xedge3n )

Definition at line 30 of file upenric2_n3.F.

C-----------------------------------------------
      USE crackxfem_mod
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,*)
      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,IECUT,NELCRK,NSX,
     .  IED,EDGE,FAC,IBOUNDEDGE,LAYCUT,ENR,ITRI,ITIP,IAD,COUNT
      INTEGER JCT(MVSIZ),IADC(3),ENR0(3),IENR(3),NTAG(3),d(3),NS(3)
      DATA d/2,3,1/
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)
C
              fac      = 0
              ntag(1:3)= 0
              itri     = xfem_phantom(ilay)%ITRI(1,elcrk)
              laycut   = crkedge(ilay)%LAYCUT(elcrk)
c---------------------------------------
              IF (abs(laycut) == 1) THEN
c               new advancing crack
c---------------------------------------
                DO k=1,3
                  ied  = crkedge(ilay)%IEDGETG(k,elcrktg)   ! = 1,2 => sequence des arretes coupes
                  edge = xedge3n(k,elcrktg)
                  iecut = crkedge(ilay)%ICUTEDGE(edge)
c                 Tip edges => NTAG = 2               
                  IF (ied > 0 .and. iecut == 2) THEN    ! (cas IECUT=3 traite avant)
                    ntag(k)    = 2
                    ntag(d(k)) = 2
                    fac = fac + 1
                  ENDIF
                ENDDO
c               crack touches boundary or goes through a hole due to erased element
c               touching boundary    => (IBOUNDEDGE == 1)
c               going through a hole => (IBOUNDEDGE == 2)
                DO k=1,3
                  edge = xedge3n(k,elcrktg)
                  iboundedge = crkedge(ilay)%IBORDEDGE(edge)
c                 Tag boundary edges : NTAG=1               
                  ied = crkedge(ilay)%IEDGETG(k,elcrktg)
                  IF (iboundedge > 0 .AND. ied > 0) THEN
                    ntag(k)    = 1
                    ntag(d(k)) = 1
                    fac = fac + 1
                  ENDIF
                ENDDO
                DO k=1,3
                  ied  = crkedge(ilay)%IEDGETG(k,elcrktg)
                  edge = xedge3n(k,elcrktg)
                  itip = crkedge(ilay)%EDGETIP(2,edge)
                  IF (ied > 0 .and. itip == 1) THEN
                    IF (itri /= 0 .and. ixel == 3) THEN  
                      ntag(k)    = 1
                      ntag(d(k)) = 1
                      fac = fac + 1
                    ENDIF                           
                  ENDIF                           
                ENDDO
c
c               NTAG = 1 for all except internal tip nodes
                IF (fac > 0) THEN
                  DO k=1,3
                    IF (ntag(k) /= 2) ntag(k) = 1
                  END DO
                ENDIF
c---------------------------------------
              ELSE IF (laycut == 2) THEN
c               old crack, element already cut previously
c---------------------------------------
                DO k=1,3
                  ied  = crkedge(ilay)%IEDGETG(k,elcrktg)
                  edge = xedge3n(k,elcrktg)
                  iboundedge = crkedge(ilay)%IBORDEDGE(edge)
                  IF (ied > 0 .and. iboundedge == 2) THEN
                    ntag(k)    = 1
                    ntag(d(k)) = 1
                    fac = fac + 1
                  ENDIF
                ENDDO
c
c               check if no tip edge in phantom element (count=0 => no tip)
c
                count = 0
                DO k=1,3
                  ied  = crkedge(ilay)%IEDGETG(k,elcrktg)
                  edge = xedge3n(k,elcrktg)
                  itip = crkedge(ilay)%EDGETIP(2,edge)
                  IF (ied > 0 .and. itip == 1) count = count + 1
                END DO
c                
                IF (count == 0) THEN  ! already cracked phantom, no tip edge => no negative enrichments
                  DO k=1,3
                    ied  = crkedge(ilay)%IEDGETG(k,elcrktg)
                    edge = xedge3n(k,elcrktg)
                    iad  = iadc(k)
                    IF (itri < 0 .and. ixel == 2 .and. crklvset(ilev)%ENR0(1,iad) < 0) THEN
c                     enrichment of IXEL = 2 < 0 => copy from IXEL = 3 and tag edge
                      crklvset(ilev)%ENR0(1,iad) = crklvset(ilev+1)%ENR0(1,iad)
                      fac = fac + 1
                      ntag(k)    = 1
                      ntag(d(k)) = 1
                    ELSEIF (itri > 0.and. ixel == 1 .and. crklvset(ilev)%ENR0(1,iad) < 0) THEN
c                     enrichment of IXEL = 1 < 0 => copy from IXEL = 3 and tag edge
                      crklvset(ilev)%ENR0(1,iad) = crklvset(ilev+2)%ENR0(1,iad)
                      fac = fac + 1
                      ntag(k)    = 1
                      ntag(d(k)) = 1
                    ENDIF
                  END DO
                ENDIF  !  COUNT == 0
c
              ENDIF  !  LAYCUT
C--------------------------------------------------------------------------
c             set ENRTAG for nodal enrichment update (ENR > 0 only for boundary nodes)
C--------------------------------------------------------------------------
              IF (fac > 0) THEN
                DO k=1,3
                  enr = abs(crklvset(ilev)%ENR0(1,iadc(k)))
                  IF (enr > 0 .AND. ntag(k) == 1) THEN
                    IF (enrtag(ns(k),enr) == 0) enrtag(ns(k),enr) = enr
                  ENDIF
                ENDDO
              ENDIF
C--------------------------------------------------------------------------
            ENDIF  ! IF(ELCUT /= 0)THEN
          ENDDO  !  DO IR=1,NELCRK
        ENDDO  !  DO IXEL=1,NXEL
      ENDDO  !  DO ILAY=1,NXLAY
C-----------------------------------------------
      RETURN