upofftg.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com_xfem1.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	upofftg (xfem_tab, ng, nft, jft, jlt, ixfem, iel_crk, elcutc, inod_crk, iadtg_crk, ixtg, nxlay, crkedge, xedge3n)

Function/Subroutine Documentation

upofftg()

subroutine upofftg	(	type(elbuf_struct_), dimension(ngroup,nxel)	xfem_tab,
		integer	ng,
		integer	nft,
		integer	jft,
		integer	jlt,
		integer	ixfem,
		integer, dimension(*)	iel_crk,
		integer, dimension(2,*)	elcutc,
		integer, dimension(*)	inod_crk,
		integer, dimension(3,*)	iadtg_crk,
		integer, dimension(nixtg,*)	ixtg,
		integer	nxlay,
		type (xfem_edge_), dimension(*)	crkedge,
		integer, dimension(3,*)	xedge3n )

Definition at line 31 of file upofftg.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE crackxfem_mod
      USE elbufdef_mod
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      "com_xfem1.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NG,NFT,JFT,JLT,IEL_CRK(*),ELCUTC(2,*),IXFEM,
     .        INOD_CRK(*),IADTG_CRK(3,*),XEDGE3N(3,*),
     .        IXTG(NIXTG,*),NXLAY
C
      TYPE(ELBUF_STRUCT_),  DIMENSION(NGROUP,NXEL) :: XFEM_TAB
      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,IEL,ELCRK,ELCRKTG,ICUT,ILAYCUT,ILAY,ILEV,ITRI,P1,P2,
     .  IEDGE,IBOUNDEDGE,ELCUT,IXEL,IR,IS,IT,IEDGE0,FAC
      INTEGER  D(3),NN(3),OPEN_EDGE(3,NXLAY),ICUT0,ENR_NOD(3),IADTG(3)
      my_real, DIMENSION(:) ,POINTER  ::  xoff
      DATA d/2,3,1/
C=======================================================================
      ir = 1
      is = 1
      it = 1
C
      DO i=jft,jlt
        iel  = i+nft
        icut = elcutc(1,iel)
        IF (icut == 0) cycle
        elcrktg = iel_crk(iel)
        elcrk   = elcrktg + ecrkxfec
C
        iadtg(1) = iadtg_crk(1,elcrktg)
        iadtg(2) = iadtg_crk(2,elcrktg)
        iadtg(3) = iadtg_crk(3,elcrktg)
C
        nn(1) = inod_crk(ixtg(2,iel))
        nn(2) = inod_crk(ixtg(3,iel))
        nn(3) = inod_crk(ixtg(4,iel))
C
        DO ilay=1,nxlay
          ilaycut = crkedge(ilay)%LAYCUT(elcrk)
          DO k=1,3
            open_edge(k,ilay) = 0
          ENDDO
          DO ixel=1,nxel
            IF (nxlay> 1) THEN
              xoff => xfem_tab(ng,ixel)%BUFLY(ilay)%LBUF(ir,is,it)%OFF
            ELSEIF (nxlay== 1) THEN
              xoff => xfem_tab(ng,ixel)%GBUF%OFF
            ENDIF
C--- 
            IF (abs(ilaycut) == 1) THEN  !  new crack initialized
c             activate new cracked layer:
              xoff(i) = -xoff(i)
            ELSE IF (ilaycut == 2) THEN  ! old cut layer
c             delete already cracked element if new crack is touching it
c
              ilev = nxel*(ilay-1) + ixel
              enr_nod(1) = crklvset(ilev)%ENR0(1,iadtg(1))
              enr_nod(2) = crklvset(ilev)%ENR0(1,iadtg(2))
              enr_nod(3) = crklvset(ilev)%ENR0(1,iadtg(3))
              DO k=1,3
                p1 = k
                p2 = d(k)
                iedge = xedge3n(k,elcrktg)
                iboundedge = 0
                icut0      = 0
                iedge0 = crkedge(ilay)%IEDGETG(k,elcrktg)
                IF (iedge > 0) THEN
                  iboundedge = crkedge(ilay)%IBORDEDGE(iedge)
                  icut0      = crkedge(ilay)%ICUTEDGE(iedge)
                ENDIF
                IF (iboundedge==0 .and. iedge0==0 .and. icut0> 0) THEN
                  IF (enr_nod(p1) == 0 .AND. enr_nod(p2) == 0) THEN
                    xoff(i) = zero
                    open_edge(k,ilay) = 1
                  ENDIF
                ENDIF
              ENDDO
C---
            ENDIF  !  IF (ABS(ILAYCUT) == 1)
          ENDDO  !  DO IXEL=1,NXEL
c
          fac = 0                                      
          DO k=1,3                                     
            IF (open_edge(k,ilay) == 1) fac = fac + 1  
          ENDDO                                        
          IF (fac > 0) THEN                            
            DO k=1,3                                   
              iedge = xedge3n(k,elcrktg)                
              IF (open_edge(k,ilay) == 1) THEN         
                crkedge(ilay)%IBORDEDGE(iedge) = 2     
              ENDIF                                    
            ENDDO                                      
          ENDIF                                        
C--------------------------
c         delete both phantoms on the same side for ITRI /= 0
C--------------------------
          itri  = xfem_phantom(ilay)%ITRI(1,elcrk)
          
          IF (itri < 0) THEN
            IF (nxlay > 1) THEN
              IF (xfem_tab(ng,2)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) == zero) THEN
                  xfem_tab(ng,3)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) =  zero
              ELSEIF (xfem_tab(ng,3)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) == zero) THEN
                  xfem_tab(ng,2)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) =  zero
              ENDIF
            ELSE
              IF (xfem_tab(ng,2)%GBUF%OFF(i) == zero) THEN
                  xfem_tab(ng,3)%GBUF%OFF(i) =  zero
              ELSEIF (xfem_tab(ng,3)%GBUF%OFF(i) == zero) THEN
                  xfem_tab(ng,2)%GBUF%OFF(i) =  zero
              ENDIF
            ENDIF              
          ELSEIF (itri > 0) THEN
            IF (nxlay > 1) THEN
              IF (xfem_tab(ng,1)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) == zero) THEN
                  xfem_tab(ng,3)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) =  zero
              ELSEIF (xfem_tab(ng,3)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) == zero) THEN
                  xfem_tab(ng,1)%BUFLY(ilay)%LBUF(1,1,1)%OFF(i) =  zero
              ENDIF
            ELSE
              IF (xfem_tab(ng,1)%GBUF%OFF(i) == zero) THEN
                  xfem_tab(ng,3)%GBUF%OFF(i) =  zero
              ELSEIF (xfem_tab(ng,3)%GBUF%OFF(i) == zero) THEN
                  xfem_tab(ng,1)%GBUF%OFF(i) =  zero
              ENDIF
            ENDIF              
          ENDIF
C---
        ENDDO  !  DO ILAY=1,NXLAY
      ENDDO  !  DO I=JFT,JLT
C-----------------------------------------------
      RETURN