lslocal.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	lslocal (elbuf_tab, xfem_tab, iparg, ixc, ixtg, xrefc, xreftg, x, icrk, inod_crk, nxseg, nodls, ratiols, ntag, ielcrkc, ielcrktg, iedgesh4, iedgesh3, nodedge, tagskyc, tagskytg, knod2elc, tagedge, crklvset, crkshell, crkedge, xfem_phantom, itab, id, titr)
subroutine	xyzloc4n (x1l, y1l, x2l, y2l, x3l, y3l, x4l, y4l, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4)
subroutine	xyzloc3n (x1l, y1l, x2l, y2l, x3l, y3l, x1g, x2g, x3g, y1g, y2g, y3g, z1g, z2g, z3g)
subroutine	activ_xfem (iparg, nft, lft, llt, nxlay, ng, iel_crk, ity, crkedge)
subroutine	elcut4n (iel, ixc, xnod, edgec, fac, ied)
subroutine	elcut3n (iel, ixtg, xnod, edgetg, fac, ied)
subroutine	edgetip4n (lft, llt, nft, ielcrkc, iedgesh4, nxlay, edgec, tagedge, crklvset, crkedge)
subroutine	edgetip3n (lft, llt, nft, ielcrktg, iedgesh3, nxlay, edgetg, tagedge, crklvset, crkedge)

Function/Subroutine Documentation

activ_xfem()

subroutine activ_xfem	(	integer, dimension(nparg,*)	iparg,
		integer	nft,
		integer	lft,
		integer	llt,
		integer	nxlay,
		integer	ng,
		integer, dimension(*)	iel_crk,
		integer	ity,
		type (xfem_edge_), dimension(*)	crkedge )

Definition at line 561 of file lslocal.F.

C-----------------------------------------------
      USE xfem2def_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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NFT,LFT,LLT,NXLAY,NG,ITY
      INTEGER IPARG(NPARG,*),IEL_CRK(*)
      TYPE (XFEM_EDGE_) , DIMENSION(*)  :: CRKEDGE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,ELCRK,ILAYCUT,ILAY,IGON,ISHEON
C=======================================================================
C     TEST FOR NEW GROUP ACTIVATION
C----------------------------------------
      igon = 0
      DO i=lft,llt
        isheon = 0
        elcrk = iel_crk(i+nft)
c        IF (ITY == 7) ELCRK = ELCRK + ECRKXFEC
        IF (elcrk > 0) THEN
          DO ilay = 1,nxlay
            ilaycut = crkedge(ilay)%LAYCUT(elcrk)
            isheon  = max(isheon, ilaycut)
          ENDDO
          IF (isheon > 0) THEN
            igon = 1
            EXIT
          ENDIF
        ENDIF
      ENDDO
      iparg(70,ng) = igon
C-----------
      RETURN

edgetip3n()

subroutine edgetip3n	(	integer	lft,
		integer	llt,
		integer	nft,
		integer, dimension(*)	ielcrktg,
		integer, dimension(3,*)	iedgesh3,
		integer	nxlay,
		integer, dimension(3,*)	edgetg,
		integer, dimension(*)	tagedge,
		type (xfem_lvset_), dimension(nlevmax)	crklvset,
		type (xfem_edge_), dimension(nxlaymax)	crkedge )

Definition at line 738 of file lslocal.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE xfem2def_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      "com_xfem1.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LFT,LLT,NFT,IELCRKTG(*),EDGETG(3,*),
     .        IEDGESH3(3,*),NXLAY,TAGEDGE(*)
      TYPE (XFEM_LVSET_) , DIMENSION(NLEVMAX) :: CRKLVSET
      TYPE (XFEM_EDGE_)  , DIMENSION(NXLAYMAX):: CRKEDGE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K,ELCRK,IED,IEDGE,IXEL,ILEV,ILAY,ELCUT
C=======================================================================
C     set tip edges:
C--------------------
      DO ilay=1,nxlay
        DO i=lft,llt
          elcrk = ielcrktg(i+nft) - ecrkxfec
          elcut = crkedge(ilay)%LAYCUT(elcrk)
          IF (elcut /= 0) THEN
            DO k=1,3
              ied   = edgetg(k,i+nft)
              iedge = iedgesh3(k,elcrk)
              IF (ied > 0) THEN
                IF (tagedge(iedge) == 1) THEN
                  DO ixel=1,nxel
                    ilev = nxel*(ilay-1) + ixel
                    crklvset(ilev)%ICUTEDGE(iedge) = 2
                  ENDDO
                ENDIF
              ENDIF
            ENDDO
          ENDIF
        ENDDO
      ENDDO
C-----------
      RETURN

edgetip4n()

subroutine edgetip4n	(	integer	lft,
		integer	llt,
		integer	nft,
		integer, dimension(*)	ielcrkc,
		integer, dimension(4,*)	iedgesh4,
		integer	nxlay,
		integer, dimension(4,*)	edgec,
		integer, dimension(*)	tagedge,
		type (xfem_lvset_), dimension(nlevmax)	crklvset,
		type (xfem_edge_), dimension(nxlaymax)	crkedge )

Definition at line 681 of file lslocal.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE xfem2def_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      "com_xfem1.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LFT,LLT,NFT,IELCRKC(*),EDGEC(4,*),
     .        IEDGESH4(4,*),NXLAY,TAGEDGE(*)
      TYPE (XFEM_LVSET_)  , DIMENSION(NLEVMAX) :: CRKLVSET
      TYPE (XFEM_EDGE_)   , DIMENSION(NXLAYMAX):: CRKEDGE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K,ELCRK,IED,IEDGE,IXEL,ILEV,ILAY,ELCUT
C=======================================================================
C     set tip edges:
C--------------------
      DO ilay=1,nxlay
        DO i=lft,llt
          elcrk = ielcrkc(i+nft)
          elcut = crkedge(ilay)%LAYCUT(elcrk)
          IF (elcut /= 0) THEN
            DO k=1,4
              ied = edgec(k,i+nft)
              iedge = iedgesh4(k,elcrk)
              IF (ied > 0)THEN
                IF (tagedge(iedge) == 1) THEN
                  DO ixel=1,nxel
                    ilev = nxel*(ilay-1) + ixel
                    crklvset(ilev)%ICUTEDGE(iedge) = 2
                  ENDDO
                ENDIF
              ENDIF
            ENDDO
          ENDIF
        ENDDO
      ENDDO
C-----------
      RETURN

elcut3n()

subroutine elcut3n	(	integer	iel,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(2,2)	xnod,
		integer, dimension(3,*)	edgetg,
		integer	fac,
		integer	ied )

Definition at line 646 of file lslocal.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IEL,IXTG(NIXTG,*),XNOD(2,2),EDGETG(3,*),FAC,IED
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER K,N1,N2,d1(3),d2(3)
      DATA d1/2,3,4/
      DATA d2/3,4,2/
C=======================================================================
      DO k=1,3
        n1 = ixtg(d1(k),iel)
        n2 = ixtg(d2(k),iel)
        IF ((n1 == xnod(ied,1) .AND. n2 == xnod(ied,2)) .OR.
     .      (n2 == xnod(ied,1) .AND. n1 == xnod(ied,2))) THEN
          fac = fac + 1
          edgetg(k,iel) = fac
          EXIT
        ENDIF
      ENDDO
C-----------
      RETURN

elcut4n()

subroutine elcut4n	(	integer	iel,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(2,2)	xnod,
		integer, dimension(4,*)	edgec,
		integer	fac,
		integer	ied )

Definition at line 612 of file lslocal.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IEL,IXC(NIXC,*),XNOD(2,2),EDGEC(4,*),FAC,IED
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER K,N1,N2,d1(4),d2(4)
      DATA d1/2,3,4,5/
      DATA d2/3,4,5,2/
C=======================================================================
      DO k=1,4    ! edges
        n1 = ixc(d1(k),iel)  ! 1st Node 
        n2 = ixc(d2(k),iel)  ! 2nd Node 
        IF ((n1 == xnod(ied,1) .AND. n2 == xnod(ied,2)) .OR.
     .      (n2 == xnod(ied,1) .AND. n1 == xnod(ied,2))) THEN
          fac = fac + 1
          edgec(k,iel) = fac
          EXIT
        ENDIF
      ENDDO
C---
      RETURN

lslocal()

subroutine lslocal	(	type (elbuf_struct_), dimension(ngroup)	elbuf_tab,
		type (elbuf_struct_), dimension(ngroup,nxel)	xfem_tab,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixtg,*)	ixtg,
			xrefc,
			xreftg,
			x,
		integer	icrk,
		integer, dimension(*)	inod_crk,
		integer	nxseg,
		integer, dimension(2,*)	nodls,
			ratiols,
		integer, dimension(*)	ntag,
		integer, dimension(*)	ielcrkc,
		integer, dimension(*)	ielcrktg,
		integer, dimension(4,*)	iedgesh4,
		integer, dimension(3,*)	iedgesh3,
		integer, dimension(2,*)	nodedge,
		integer, dimension(4,*)	tagskyc,
		integer, dimension(3,*)	tagskytg,
		integer, dimension(*)	knod2elc,
		integer, dimension(*)	tagedge,
		type (xfem_lvset_), dimension(nlevmax)	crklvset,
		type (xfem_shell_), dimension(nlevmax)	crkshell,
		type (xfem_edge_), dimension(nxlaymax)	crkedge,
		type (xfem_phantom_), dimension(nxlaymax)	xfem_phantom,
		integer, dimension(*)	itab,
		integer	id,
		character(len=nchartitle)	titr )

Definition at line 43 of file lslocal.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE xfem2def_mod
      USE elbufdef_mod
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
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      "param_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "vect01_c.inc"
#include      "com_xfem1.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,*),IXC(NIXC,*),IXTG(NIXTG,*),
     .  ICRK,INOD_CRK(*),NXSEG,NODLS(2,*),IELCRKC(*),IELCRKTG(*),
     .  NTAG(*),IEDGESH4(4,*),IEDGESH3(3,*),NODEDGE(2,*),
     .  TAGSKYC(4,*),TAGSKYTG(3,*),KNOD2ELC(*),TAGEDGE(*),ITAB(*),ID
      my_real
     . x(3,*),xrefc(4,3,*),xreftg(3,3,*),ratiols(*)
C
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP)      :: ELBUF_TAB
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP,NXEL) :: XFEM_TAB
      TYPE (XFEM_LVSET_)  , DIMENSION(NLEVMAX)     :: CRKLVSET
      TYPE (XFEM_SHELL_)  , DIMENSION(NLEVMAX)     :: CRKSHELL
      TYPE (XFEM_EDGE_)   , DIMENSION(NXLAYMAX)    :: CRKEDGE       
      TYPE (XFEM_PHANTOM_), DIMENSION(NXLAYMAX)    :: XFEM_PHANTOM  
      CHARACTER(LEN=NCHARTITLE)::TITR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER XNOD(2,2),TAGXNOD(NXSEG+1),
     .  NGL(MVSIZ),IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ)
      INTEGER I,K,IED,NG,NEL,LS,FAC,IHBE,ISH3N,IXFEM,ITG,NELCUT,ILAY,NXLAY
      my_real, DIMENSION(MVSIZ) :: x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,
     .                             x1l,y1l,x2l,y2l,x3l,y3l,x4l,y4l
      my_real beta0(2)
      my_real ratio
C
      INTEGER,DIMENSION(:)  ,ALLOCATABLE :: ELCUT
      INTEGER,DIMENSION(:,:),ALLOCATABLE :: EDGEC,EDGETG
      my_real,DIMENSION(:,:),ALLOCATABLE :: beta
C=======================================================================
      itg = 1+numelc
      ALLOCATE (elcut(numelc+numeltg))  
      ALLOCATE (beta(2,numelc+numeltg)) 
      ALLOCATE (edgec(4,numelc))        
      ALLOCATE (edgetg(3,numeltg))      
      elcut  = 0                         
      beta   = 0                          
      edgec  = 0                         
      edgetg = 0                        
C
      tagxnod = 0
c-----------------------
      DO ls=1,nxseg
C
c           Xnod2
c    (4)- - -x- - -(3)
c     |      |      |
c     |      |      |
c     |   (NXSEG)   |
c     |      |      |
c     |      |      |
c     |      |      |
c    (1)- - -x- - -(2)
c           Xnod1
c
        nelcut = 0
        elcut = 0
C  - first intersection node - (Xnod1)
        xnod(1,1) = nodls(1,ls)  ! node (1)
        xnod(1,2) = nodls(2,ls)  ! node (2)
C  - second intersection node - (Xnod2)
        xnod(2,1) = nodls(1,ls+1)  ! node (3)
        xnod(2,2) = nodls(2,ls+1)  ! node (4)
C
        beta0(1) = ratiols(ls)
        beta0(2) = ratiols(ls+1)
C
        DO i=1,2
          ratio = beta0(i)
          IF(ratio == zero)THEN
            beta0(i) = em05
          ELSEIF(ratio == one)THEN
            beta0(i) = one-em05
          ENDIF
        ENDDO
C-----------------------------------------------
C       TAG  CUT  ELEMENTS :
C-----------------------------------------------
        DO 200 ng=1,ngroup
          ixfem = iparg(54,ng)
          IF (ixfem == 0) cycle
c
          nxlay  = elbuf_tab(ng)%NLAY
          nel    = iparg(2,ng)
          nft    = iparg(3,ng)
          ity    = iparg(5,ng)
          ihbe   = iparg(23,ng)
          lft = 1
          llt = min(nvsiz,nel)
c
          IF (ity == 7) ihbe = 0
c
c-------------------------
          IF (ity==3) THEN
C           SHELL - 4N -
c
            DO i=lft,llt
              fac = 0
C
C      - First check - (coincident nodes not accepted)
C
              IF(xnod(1,1) == xnod(1,2)) fac = 1
C
              IF(fac == 1)THEN
                CALL ancmsg(msgid=1618,
     .            msgtype=msgerror,
     .            anmode=aninfo,
     .            i1=id,
     .            i2=1,
     .            c1=titr )
              ENDIF
C
              IF(xnod(2,1) == xnod(2,2)) fac = 2
C
              IF(fac == 2)THEN
                CALL ancmsg(msgid=1618,
     .            msgtype=msgerror,
     .            anmode=aninfo,
     .            i1=id,
     .            i2=2,
     .            c1=titr )
              ENDIF
C---
              fac = 0
c             find edge corresponding to Xnod1  =>  EDGEC(IED) = 1  
              ied = 1
              CALL elcut4n(i, ixc(1,nft+1), xnod, edgec(1,nft+1),fac,ied)
              IF (fac == 1) tagxnod(ls) = 1
C
C add warning message if FAC /= 1  ! XNOD1 must fit an element edge's
C
c             find edge corresponding to Xnod2  =>  EDGEC(IED) = 2      
              ied = 2
              CALL elcut4n(i, ixc(1,nft+1), xnod, edgec(1,nft+1),fac,ied)
              IF (fac == 2) tagxnod(ls+1) = 1
C
C add warning message if FAC /= 2
C
              IF(fac == 2)THEN
                elcut(i+nft) = 1
                nelcut = 1
                numelcrk = numelcrk + 1
              ENDIF
            ENDDO
C---
            IF(nelcut == 0)GOTO 200
C---
            CALL ccoori(x,xrefc(1,1,nft+1),ixc(1,nft+1),
     .           x1  ,x2  ,x3  ,x4  ,y1  ,y2  ,       
     .           y3  ,y4  ,z1  ,z2  ,z3  ,z4  ,       
     .           ix1 ,ix2 ,ix3 ,ix4 ,ngl )            
C           local coordinates
            CALL xyzloc4n(x1l,y1l,x2l,y2l,x3l,y3l,x4l,y4l,
     .                    x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
     .                    y3 ,y4 ,z1 ,z2 ,z3 ,z4 )
C 
c---
            CALL preinicrk4n(elbuf_tab(ng),xfem_tab(ng,1:nxel)  ,
     .           x1l     ,y1l    ,x2l     ,y2l     ,x3l     ,        
     .           y3l     , x4l   ,y4l     ,lft     ,llt     ,        
     .           nft     ,nxlay  ,ielcrkc ,edgec   ,beta0   ,        
     .           iedgesh4,elcut  ,xnod    ,ixc     ,nodedge ,        
     .           tagskyc ,knod2elc,tagedge,crklvset,crkshell,
     .           crkedge ,xfem_phantom)                 
c
c-------------------------
          ELSE IF (ity==7) THEN
c           SHELL 3N
c-------------------------
            ish3n = iparg(23,ng)
c
            DO i=lft,llt
              fac = 0
C
c             - First check - (coincident nodes not accepted)
C
              IF(xnod(1,1) == xnod(1,2)) fac = 1
C
              IF(fac == 1)THEN
                CALL ancmsg(msgid=1618,
     .            msgtype=msgerror,
     .            anmode=aninfo,
     .            i1=id,
     .            i2=1,
     .            c1=titr )
              ENDIF
C
              IF(xnod(2,1) == xnod(2,2)) fac = 2
C
              IF(fac == 2)THEN
                CALL ancmsg(msgid=1618,
     .            msgtype=msgerror,
     .            anmode=aninfo,
     .            i1=id,
     .            i2=2,
     .            c1=titr )
              ENDIF
C---
              fac = 0
              CALL elcut3n(i,ixtg(1,nft+1),xnod,edgetg(1,nft+1),fac,1)
              IF (fac == 1) tagxnod(ls) = 1
C
c             add warning message if FAC /= 1  ! XNOD1 must fit an element edge's
C
              CALL elcut3n(i,ixtg(1,nft+1),xnod,edgetg(1,nft+1),fac,2)
              IF (fac == 2) tagxnod(ls+1) = 1
C
c             add warning message if FAC /= 2
C
              IF (fac == 2) THEN
                elcut(i+nft+numelc) = 1
                nelcut = 1
                numelcrk = numelcrk + 1
              ENDIF
            ENDDO    !  I=LFT,LLT
c----------------------------------
            IF (nelcut == 0) GOTO 200
C---
            CALL c3coori(x,xreftg(1,1,nft+1),ixtg(1,nft+1),ngl,
     .                   x1  ,x2  ,x3  ,y1  ,y2  ,y3  ,
     .                   z1  ,z2  ,z3  ,ix1 ,ix2 ,ix3 )
C           local coordinates
            CALL xyzloc3n(x1l ,y1l ,x2l ,y2l ,x3l ,y3l ,
     .                    x1  ,x2  ,x3  ,y1  ,y2  ,y3  ,
     .                    z1  ,z2  ,z3  )
c---
            CALL preinicrk3n(elbuf_tab(ng),xfem_tab(ng,1:nxel)   ,
     .              x1l     ,y1l     ,x2l    ,y2l     ,x3l       ,
     .              y3l     ,lft     ,llt    ,nft     ,nxlay     ,
     .              ielcrktg,edgetg  ,beta0  ,iedgesh3,elcut(itg),
     .              xnod    ,ixtg    ,nodedge,tagskytg,knod2elc  ,
     .              tagedge ,crklvset,crkshell,crkedge,xfem_phantom)
          ENDIF
C---
          IF (nelcut == 1) EXIT ! cracked element already tag
C---
 200  CONTINUE
c------------------------------------------------------------------------
C       to update warning message
        IF(nelcut == 0)THEN
          IF(tagxnod(ls) == 0)THEN
            CALL ancmsg(msgid=1617,
     .            msgtype=msgerror,
     .            anmode=aninfo,
     .            i1=id,
     .            i2=itab(xnod(1,1)),
     .            i3=itab(xnod(1,2)),
     .            c1=titr )
 
          ELSEIF(tagxnod(ls+1) == 0)THEN
            CALL ancmsg(msgid=1617,
     .            msgtype=msgerror,
     .            anmode=aninfo,
     .            i1=id,
     .            i2=itab(xnod(2,1)),
     .            i3=itab(xnod(2,2)),
     .            c1=titr )
 
          ENDIF
        ENDIF
c-----
      ENDDO   ! LS=1,NXSEG
c------------------------------------------------------------------------
c     Tag tip edges and activate xfem groups
c------------------------------------------------------------------------
      DO ng=1,ngroup                                                
        ixfem = iparg(54,ng)                                        
        IF (ixfem == 0) cycle                                       
c
        nxlay = elbuf_tab(ng)%NLAY                                  
        nel   = iparg(2,ng)                                         
        nft   = iparg(3,ng)                                         
        ity   = iparg(5,ng)                                         
        lft   = 1                                                   
        llt   = min(nvsiz,nel)                                      
C---
        IF (ity == 3) THEN                                          
          CALL edgetip4n(lft   ,llt    ,nft    ,ielcrkc ,iedgesh4,  
     .                   nxlay ,edgec  ,tagedge,crklvset,crkedge)           
C
C         activation of new group if initial cracks                 
          CALL activ_xfem(iparg ,nft    ,lft    ,llt ,nxlay,        
     .                    ng    ,ielcrkc,ity    ,crkedge)                   
        ELSEIF (ity == 7) THEN                                      
          CALL edgetip3n(lft   ,llt    ,nft    ,ielcrktg,iedgesh3,  
     .                   nxlay ,edgetg ,tagedge,crklvset,crkedge)           
C
C         activation of new group if initial cracks                 
          CALL activ_xfem(iparg ,nft     ,lft    ,llt ,nxlay,       
     .                    ng    ,ielcrktg,ity    ,crkedge)                  
        ENDIF                                                       
      ENDDO                                                         
c     Tag ICUTEDGE=2 for tip edges
      DO ilay=1,nxlay
        DO i=1,numedges
          IF (crkedge(ilay)%EDGETIP(1,i) == 1 .or. 
     .        crkedge(ilay)%EDGETIP(2,i) == 1) THEN 
             DO k=1,nxel                             
               crklvset(nxel*(ilay-1)+k)%ICUTEDGE(i) = 2     
            ENDDO
          ENDIF
        ENDDO                                   
      ENDDO                                                         
c------------------------------------------------------------------------
      IF(ALLOCATED(elcut)) DEALLOCATE(elcut)
      IF(ALLOCATED(beta))  DEALLOCATE(beta)
      IF(ALLOCATED(edgec)) DEALLOCATE(edgec)
      IF(ALLOCATED(edgetg))DEALLOCATE(edgetg)
C-----------
      RETURN

xyzloc3n()

subroutine xyzloc3n	(	intent(out)	x1l,
		intent(out)	y1l,
		intent(out)	x2l,
		intent(out)	y2l,
		intent(out)	x3l,
		intent(out)	y3l,
		intent(in)	x1g,
		intent(in)	x2g,
		intent(in)	x3g,
		intent(in)	y1g,
		intent(in)	y2g,
		intent(in)	y3g,
		intent(in)	z1g,
		intent(in)	z2g,
		intent(in)	z3g )

Definition at line 497 of file lslocal.F.

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      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real, DIMENSION(MVSIZ), INTENT(OUT) :: x1l,y1l,x2l,y2l,x3l,y3l
      my_real, DIMENSION(MVSIZ), INTENT(IN)  :: x1g,x2g,x3g,y1g,y2g,y3g,
     .                                          z1g,z2g,z3g
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,I1
      my_real, DIMENSION(MVSIZ) ::  sum, rx, ry, rz, sx, sy, sz,
     .     e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z
C=======================================================================
      DO i=lft,llt
        rx(i) = x2g(i) - x1g(i)
        ry(i) = y2g(i) - y1g(i)
        rz(i) = z2g(i) - z1g(i)
        sx(i) = x3g(i) - x1g(i)
        sy(i) = y3g(i) - y1g(i)
        sz(i) = z3g(i) - z1g(i)
      ENDDO
C----------------------------
      i1 = 0
      CALL clskew3(lft,llt,i1,
     .     rx, ry, rz, sx, sy, sz, 
     .     e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,sum)
c      DO I=JFT,JLT
c        AREA(I) = HALF*SUM(I)
c      ENDDO
C----------------------------
C
      DO i=lft,llt
        x1l(i) = zero
        y1l(i) = zero
        x2l(i) = e1x(i)*rx(i) + e1y(i)*ry(i) + e1z(i)*rz(i)
        y2l(i) = e2x(i)*rx(i) + e2y(i)*ry(i) + e2z(i)*rz(i)
        y3l(i) = e2x(i)*sx(i) + e2y(i)*sy(i) + e2z(i)*sz(i)
        x3l(i) = e1x(i)*sx(i) + e1y(i)*sy(i) + e1z(i)*sz(i)
      ENDDO
C---------------------------------------------------------
      RETURN

xyzloc4n()

subroutine xyzloc4n	(	intent(out)	x1l,
		intent(out)	y1l,
		intent(out)	x2l,
		intent(out)	y2l,
		intent(out)	x3l,
		intent(out)	y3l,
		intent(out)	x4l,
		intent(out)	y4l,
		intent(in)	x1,
		intent(in)	x2,
		intent(in)	x3,
		intent(in)	x4,
		intent(in)	y1,
		intent(in)	y2,
		intent(in)	y3,
		intent(in)	y4,
		intent(in)	z1,
		intent(in)	z2,
		intent(in)	z3,
		intent(in)	z4 )

Definition at line 392 of file lslocal.F.

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      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real, DIMENSION(MVSIZ), INTENT(OUT) :: x1l,y1l,x2l,y2l,x3l,y3l,x4l,y4l
      my_real, DIMENSION(MVSIZ), INTENT(IN)  :: x1,x2,x3,x4,y1,y2,
     .   y3,y4,z1,z2,z3,z4
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
      my_real s1,s2,suma
      my_real, DIMENSION(MVSIZ) :: x21,y21,z21,x31,y31,z31,x41,y41,z41,
     .   x42,y42,z42,e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,sum
C=======================================================================
      DO i=lft,llt
        x21(i) = x2(i)-x1(i)
        y21(i) = y2(i)-y1(i)
        z21(i) = z2(i)-z1(i)
        x31(i) = x3(i)-x1(i)
        y31(i) = y3(i)-y1(i)
        z31(i) = z3(i)-z1(i)
        x41(i) = x4(i)-x1(i)
        y41(i) = y4(i)-y1(i)
        z41(i) = z4(i)-z1(i)
        x42(i) = x4(i)-x2(i)
        y42(i) = y4(i)-y2(i)
        z42(i) = z4(i)-z2(i)
      ENDDO
c
C---    repere orthogonalise vers 5.0 
      DO i=lft,llt
        e1x(i) = x2(i)+x3(i)-x1(i)-x4(i)
        e1y(i) = y2(i)+y3(i)-y1(i)-y4(i)
        e1z(i) = z2(i)+z3(i)-z1(i)-z4(i)
C
        e2x(i) = x3(i)+x4(i)-x1(i)-x2(i)
        e2y(i) = y3(i)+y4(i)-y1(i)-y2(i)
        e2z(i) = z3(i)+z4(i)-z1(i)-z2(i)
C
        e3x(i) = e1y(i)*e2z(i)-e1z(i)*e2y(i)
        e3y(i) = e1z(i)*e2x(i)-e1x(i)*e2z(i)
        e3z(i) = e1x(i)*e2y(i)-e1y(i)*e2x(i)
      ENDDO
C---
      DO i=lft,llt                         
        suma   = e3x(i)*e3x(i)+e3y(i)*e3y(i)+e3z(i)*e3z(i)  
        suma   = one/max(sqrt(suma),em20)                    
        e3x(i) = e3x(i)*suma                              
        e3y(i) = e3y(i)*suma                              
        e3z(i) = e3z(i)*suma                              
C
        s1     = e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i) 
        s2     = e2x(i)*e2x(i)+e2y(i)*e2y(i)+e2z(i)*e2z(i) 
        suma   = sqrt(s1/s2)                
        e1x(i) = e1x(i) + (e2y(i)*e3z(i)-e2z(i)*e3y(i))*suma
        e1y(i) = e1y(i) + (e2z(i)*e3x(i)-e2x(i)*e3z(i))*suma
        e1z(i) = e1z(i) + (e2x(i)*e3y(i)-e2y(i)*e3x(i))*suma
C
        suma   = e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i)  
        suma   = one/max(sqrt(suma),em20)                    
        e1x(i) = e1x(i)*suma                              
        e1y(i) = e1y(i)*suma                              
        e1z(i) = e1z(i)*suma                              
C
        e2x(i) = e3y(i) * e1z(i) - e3z(i) * e1y(i)
        e2y(i) = e3z(i) * e1x(i) - e3x(i) * e1z(i)
        e2z(i) = e3x(i) * e1y(i) - e3y(i) * e1x(i)
      ENDDO
C
      DO i=lft,llt
        x1l(i) = zero
        y1l(i) = zero
        x2l(i) = e1x(i)*x21(i)+e1y(i)*y21(i)+e1z(i)*z21(i)
        y2l(i) = e2x(i)*x21(i)+e2y(i)*y21(i)+e2z(i)*z21(i)
        x3l(i) = e1x(i)*x31(i)+e1y(i)*y31(i)+e1z(i)*z31(i)
        y3l(i) = e2x(i)*x31(i)+e2y(i)*y31(i)+e2z(i)*z31(i)
        x4l(i) = e1x(i)*x41(i)+e1y(i)*y41(i)+e1z(i)*z41(i)
        y4l(i) = e2x(i)*x41(i)+e2y(i)*y41(i)+e2z(i)*z41(i)
      ENDDO
c-----------
      RETURN