upenric1_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	upenric1_n3 (iparg, ixtg, nft, jft, jlt, elcutc, iad_crktg, iel_crktg, inod_crk, nxlay, nodedge, enrtag, crkedge, xedge3n)

Function/Subroutine Documentation

upenric1_n3()

subroutine upenric1_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	nxlay,
		integer, dimension(2,*)	nodedge,
		integer, dimension(numnod,*)	enrtag,
		type (xfem_edge_), dimension(*)	crkedge,
		integer, dimension(3,*)	xedge3n )

Definition at line 31 of file upenric1_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 IPARG(NPARG,*),IXTG(NIXTG,*),NFT,JFT,JLT,NXLAY,
     .        ELCUTC(2,*),IAD_CRKTG(3,*),XEDGE3N(3,*),IEL_CRKTG(*),
     .        INOD_CRK(*),NODEDGE(2,*),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,II,ELCRK,ILEV,LAYCUT,IECUT,ILAY,IXEL,
     .   IR,NELCRK,EDGE,IADC1,IADC2,IADC3,NOD1,NOD2,ELCRKTG,IED,
     .   IE10,IE20,IE1,IE2,K1,K2,EN1,EN2,EN3
      INTEGER JCT(MVSIZ),ENR0(3),NS(3),D(3)
      DATA d/2,3,1/
C=======================================================================
      ir = 0
      DO i=jft,jlt
        jct(i) = 0
        IF (elcutc(1,i+nft) /= 0) THEN
          ir = ir + 1
          jct(ir) = i
        ENDIF
      ENDDO
C---
      nelcrk = ir
      IF (nelcrk == 0) RETURN
C---
      DO ilay=1,nxlay
        ii = nxel*(ilay-1)    
        DO ir=1,nelcrk
          i = jct(ir)
          elcrktg = iel_crktg(i+nft)
          elcrk   = elcrktg + ecrkxfec
          laycut  = crkedge(ilay)%LAYCUT(elcrk)
          IF (laycut /= 0) THEN
            iadc1 = iad_crktg(1,elcrktg)
            iadc2 = iad_crktg(2,elcrktg)
            iadc3 = iad_crktg(3,elcrktg)
            ns(1) = ixtg(2,i+nft)
            ns(2) = ixtg(3,i+nft)
            ns(3) = ixtg(4,i+nft)
c
            DO ixel=1,nxel
              ilev = ii+ixel  
              enr0(1) = 0
              enr0(2) = 0
              enr0(3) = 0
              en1 = crklvset(ilev)%ENR0(1,iadc1)
              en2 = crklvset(ilev)%ENR0(1,iadc2)
              en3 = crklvset(ilev)%ENR0(1,iadc3)
              IF (en1 /= 0) enr0(1) = en1
              IF (en2 /= 0) enr0(2) = en2
              IF (en3 /= 0) enr0(3) = en3
c
              DO k=1,3
                edge  = xedge3n(k,elcrktg)
                ied   = crkedge(ilay)%IEDGETG(k,elcrktg)
                iecut = crkedge(ilay)%ICUTEDGE(edge)
                ie1 = 0
                ie2 = 0
                IF (iecut == 3 .AND. ied > 0) THEN ! connection edge
                  nod1 = nodedge(1,edge)
                  nod2 = nodedge(2,edge)
                  ie10 = crkedge(ilay)%EDGEENR(1,edge)
                  ie20 = crkedge(ilay)%EDGEENR(2,edge)
                  IF (nod1 == ixtg(k+1,i+nft) .and.
     .                nod2 == ixtg(d(k)+1,i+nft)) THEN
                    k1  = k
                    k2  = d(k)
                    ie1 = enr0(k)
                    ie2 = enr0(d(k))
                  ELSE IF (nod2 == ixtg(k+1,i+nft) .and.
     .                     nod1 == ixtg(d(k)+1,i+nft)) THEN
                    k1  = d(k)
                    k2  = k
                    ie1 = enr0(d(k))
                    ie2 = enr0(k)
                  ENDIF
c
c                 set ENRTAG for nodal enrichment update
                  IF(ie1 /= 0) enrtag(ns(k1),abs(ie1))
     .                               = max(enrtag(ns(k1),abs(ie1)),ie10)
                  IF(ie2 /= 0) enrtag(ns(k2),abs(ie2))
     .                               = max(enrtag(ns(k2),abs(ie2)),ie20)
c
                ENDIF ! IF(IECUT == 3)THEN
              ENDDO ! DO K=1,3
            ENDDO   ! IXEL=1,NXEL
          ENDIF ! IF(LAYCUT /= 0)THEN
        ENDDO ! DO IR=1,NELCRK
      ENDDO ! DO ILAY=1,NXLAY
C-----------------------------------------------
      RETURN