inicrkfill.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    inicrkfill             ../starter/source/elements/xfem/inicrkfill.F
!||--- called by ------------------------------------------------------
!||    lectur                 ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    lslocal                ../starter/source/elements/xfem/lslocal.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      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)
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
      END