upoffc.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	upoffc (xfem_tab, ng, nft, jft, jlt, ixfem, iel_crk, elcutc, inod_crk, iadc_crk, ixc, nxlay, crkedge, xedge4n)

Function/Subroutine Documentation

upoffc()

subroutine upoffc	(	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(4,*)	iadc_crk,
		integer, dimension(nixc,*)	ixc,
		integer	nxlay,
		type (xfem_edge_), dimension(*)	crkedge,
		integer, dimension(4,*)	xedge4n )

Definition at line 31 of file upoffc.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,IXFEM,NXLAY,
     .  IEL_CRK(*),ELCUTC(2,*),INOD_CRK(*),IADC_CRK(4,*),XEDGE4N(4,*),
     .  IXC(NIXC,*)
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,NEL,ELCRK,ICUT,ILAYCUT,ILAY,ILEV,ITRI,P1,P2,
     .  IEDGE,IBOUNDEDGE,ELCUT,IXEL,IR,IS,IT,IEDGE0,FAC,ICUT0
      INTEGER D(4),NN(4),OPEN_EDGE(4,NXLAY),ENR_NOD(4),IADC(4),IOFF(NXEL,JLT)
      my_real, DIMENSION(:) ,POINTER  ::  xoff
      DATA d/2,3,4,1/
C=======================================================================
      ioff = 0
      ir = 1
      is = 1
      it = 1
      nel = jlt - jft + 1
C
      DO i=jft,jlt
        iel  = i+nft
        icut = elcutc(1,iel)
        IF (icut == 0) cycle
        elcrk = iel_crk(iel)
C
        iadc(1) = iadc_crk(1,elcrk)
        iadc(2) = iadc_crk(2,elcrk)
        iadc(3) = iadc_crk(3,elcrk)
        iadc(4) = iadc_crk(4,elcrk)
C
        nn(1) = inod_crk(ixc(2,iel))   ! noeud sys xfem
        nn(2) = inod_crk(ixc(3,iel))
        nn(3) = inod_crk(ixc(4,iel))
        nn(4) = inod_crk(ixc(5,iel))
C
        DO ilay=1,nxlay
          ilaycut = crkedge(ilay)%LAYCUT(elcrk)
          DO k=1,4
            open_edge(k,ilay) = 0
          ENDDO
c
          DO ixel=1,nxel
            IF (nxlay> 1) THEN
              xoff => xfem_tab(ng,ixel)%BUFLY(ilay)%LBUF(ir,is,it)%OFF(1:nel)
            ELSEIF (nxlay== 1) THEN
              xoff => xfem_tab(ng,ixel)%GBUF%OFF(1:nel)
            ENDIF
C---
            IF (abs(ilaycut) == 1) THEN  !  new crack initialized ou avance (+1,-1)
c             activate new cracked layer:
              xoff(i) = -xoff(i)
            ELSE IF (ilaycut == 2) THEN  ! old cut layer
c             delete already cracked phantom element if new crack is touching it
c
              ilev = nxel*(ilay-1) + ixel
              enr_nod(1) = crklvset(ilev)%ENR0(1,iadc(1))
              enr_nod(2) = crklvset(ilev)%ENR0(1,iadc(2))
              enr_nod(3) = crklvset(ilev)%ENR0(1,iadc(3))
              enr_nod(4) = crklvset(ilev)%ENR0(1,iadc(4))
              DO k=1,4
                p1 = k
                p2 = d(k)
                iedge = xedge4n(k,elcrk)
                iboundedge = 0
                icut0      = 0
                iedge0 = crkedge(ilay)%IEDGEC(k,elcrk)
                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
                    ioff(ixel,i) = 1
                    open_edge(k,ilay) = 1     ! bord libre
                  ENDIF
                ENDIF
              ENDDO
C---
            ENDIF  !  IF (ABS(ILAYCUT) == 1)
          ENDDO  !  DO IXEL=1,NXEL
c
          fac = 0                                      
          DO k=1,4                                     
            IF (open_edge(k,ilay) == 1) fac = fac + 1  
          ENDDO                                        
          IF (fac > 0) THEN                            
            DO k=1,4                                   
              iedge = xedge4n(k,elcrk)                 
              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