inicrkfill.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	inicrkfill (elbuf_tab, xfem_tab, ixc, ixtg, iparg, inicrack, x, iel_crk, inod_crk, xrefc, xreftg, iedgesh4, iedgesh3, nodedge, crklvset, crkshell, crkedge, xfem_phantom, itab)

Function/Subroutine Documentation

inicrkfill()

subroutine inicrkfill	(	type (elbuf_struct_), dimension(ngroup)	elbuf_tab,
		type (elbuf_struct_), dimension(ngroup,nxel)	xfem_tab,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(nparg,*)	iparg,
		type (inicrack_), dimension(ninicrack)	inicrack,
			x,
		integer, dimension(*)	iel_crk,
		integer, dimension(*)	inod_crk,
			xrefc,
			xreftg,
		integer, dimension(4,*)	iedgesh4,
		integer, dimension(3,*)	iedgesh3,
		integer, dimension(2,*)	nodedge,
		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 )

Definition at line 31 of file inicrkfill.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE xfem2def_mod
      USE elbufdef_mod
      USE optiondef_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   C o m m o n   B l o c K s
C-----------------------------------------------
#include      "com01_c.inc"
#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
     .   ixc(nixc,*),ixtg(nixtg,*),iparg(nparg,*),inod_crk(*),
     .   iel_crk(*),iedgesh4(4,*),iedgesh3(3,*),nodedge(2,*),itab(*)
      my_real
     .   x(3,*),xrefc(4,3,*),xreftg(3,3,*)
      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  
      TYPE (INICRACK_)    , DIMENSION(NINICRACK)   :: INICRACK
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  I,K,KR,N,ID,ICRK,NXSEG,NXNOD
      INTEGER, DIMENSION(:,:) ,ALLOCATABLE :: NODLS
      INTEGER, DIMENSION(:,:) ,ALLOCATABLE :: TAGSKYC,TAGSKYTG
      INTEGER, DIMENSION(:)   ,ALLOCATABLE :: NTAG
      INTEGER, DIMENSION(:)   ,ALLOCATABLE :: KNOD2ELC,TAGEDGE
      my_real ,DIMENSION(:)   ,ALLOCATABLE :: ratiols
      CHARACTER(LEN=NCHARTITLE) :: TITR
C=======================================================================
      ALLOCATE(knod2elc(numnod+1))
      ALLOCATE(tagskyc(4,numelc))
      ALLOCATE(tagskytg(3,numeltg))
      ALLOCATE(tagedge(numedges))
      knod2elc = 0
      tagskyc  = 0
      tagskytg = 0
      tagedge  = 0
c-----------------
      DO k=1,4
        DO i=1,numelc
          n = ixc(k+1,i)
          knod2elc(n) = knod2elc(n) + 1
          tagskyc(k,i) = knod2elc(n)
        END DO
      END DO
C
      DO k=1,3
        DO i=1,numeltg
          n = ixtg(k+1,i)
          knod2elc(n) = knod2elc(n) + 1
          tagskytg(k,i) = knod2elc(n)
        END DO
      END DO
c-----------------
      DO icrk=1,ninicrack
        id      = inicrack(icrk)%ID
        nxnod   = inicrack(icrk)%NSEG
        titr    = inicrack(icrk)%TITLE
        nxseg   = nxnod - 1
C---
        IF (nxseg > 0) THEN
          ALLOCATE(nodls(2,nxnod))
          ALLOCATE(ntag(numnod))
          ALLOCATE(ratiols(nxnod))
          nodls = 0
          ntag = 0
          ratiols = zero
C---
          DO n=1,nxnod
            nodls(1,n) = inicrack(icrk)%SEG(n)%NODES(1)
            nodls(2,n) = inicrack(icrk)%SEG(n)%NODES(2)
            ratiols(n) = inicrack(icrk)%SEG(n)%RATIO
          ENDDO
C---
          CALL lslocal(elbuf_tab,xfem_tab,
     .          iparg   ,ixc     ,ixtg    ,xrefc            ,xreftg  ,
     .          x       ,icrk    ,inod_crk,nxseg            ,nodls   ,
     .          ratiols ,ntag    ,iel_crk ,iel_crk(1+numelc),iedgesh4,
     .          iedgesh3,nodedge ,tagskyc ,tagskytg         ,knod2elc,
     .          tagedge ,crklvset,crkshell,crkedge          ,xfem_phantom,
     .          itab    ,id      ,titr    )
C---
          DEALLOCATE(nodls,ntag,ratiols)
        END IF
C---
      ENDDO ! DO ICRK=1,NINICRACK
C---
      DEALLOCATE(tagskyc,tagskytg,knod2elc,tagedge)
C-----------
      RETURN