c_ncrkxfem.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/.
!||====================================================================
!||    c_ncrkxfem     ../starter/source/restart/ddsplit/c_ncrkxfem.F
!||--- called by ------------------------------------------------------
!||    ddsplit        ../starter/source/restart/ddsplit/ddsplit.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      SUBROUTINE c_ncrkxfem(NODGLOB,INOD_CRKXFEM,INOD_L,
     .                      NUMNOD_L,NUMNODCRKXFE_L,INDEX,PROC,
     .                      IXC,IXTG,CEP_XFE,NODLOCAL,NODLEVXF_L,
     .                      NODLEVXF,NODGLOBXFE,NOD_XFE_L,CRKSHELL)
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"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  NODGLOB(*),INOD_CRKXFEM(*),INOD_L(*),
     .         NUMNOD_L,NUMNODCRKXFE_L,INDEX(*),PROC,
     .         IXC(NIXC,*),IXTG(NIXTG,*),CEP_XFE(*),
     .         nodlocal(*),nodlevxf_l(*),nodlevxf(*),
     .         nodglobxfe(*),nod_xfe_l
      TYPE (XFEM_SHELL_) , DIMENSION(NLEVMAX)       :: CRKSHELL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NL_L,II,JJ,J,K,NOD,ELTYP,ELEM,
     .        INOD_CRK,NOD_XFE_G,NELCRK
      INTEGER, DIMENSION(:), ALLOCATABLE :: NODTAG
C=======================================================================
!     1d array
      ALLOCATE( nodtag(0:numnod_l+1) )
! ----------------------------------
c     Tableaux noeuds phantomes chaque ply
C-----------------------------------------------
      nelcrk = 0
      DO k=1,nlevmax
        DO i=1,crkshell(k)%CRKNUMSHELL
          elem  = crkshell(k)%PHANTOML(i)
          eltyp = crkshell(k)%ELTYPE(i)
          IF (cep_xfe(i) == proc) THEN
            IF(eltyp == 4) THEN
               DO j=1,eltyp
                nod = ixc(j+1,elem)
                IF (nod > 0) THEN
                  IF (inod_crkxfem(nod) > 0) THEN        ! N noeud local xfem
                    nod_xfe_g = crkshell(k)%XNODEG(j,i)  ! ID glob node phantome sur ply
                    nod_xfe_l = nod_xfe_l + 1            ! ID local node phantome sur ply
                    nodglobxfe(nod_xfe_l) = nod_xfe_g    ! Id local -> Id global (phant)
                  ENDIF
                ENDIF
              ENDDO
            ELSEIF (eltyp == 3) THEN
              DO j=1,eltyp
               nod = ixtg(j+1,elem)
               IF (nod > 0) THEN
                 IF(inod_crkxfem(nod) > 0)THEN
                   nod_xfe_g = crkshell(k)%XNODEG(j,i)
                   nod_xfe_l = nod_xfe_l + 1
                   nodglobxfe(nod_xfe_l) = nod_xfe_g
                  ENDIF
                ENDIF
              ENDDO
C
c             add one more node (as sh4) for animation files  (3N -> 4N)
C
              nod_xfe_g = crkshell(k)%XNODEG(4,i)
              nod_xfe_l = nod_xfe_l + 1
              nodglobxfe(nod_xfe_l) = nod_xfe_g
            END IF
          ENDIF
        ENDDO
        nelcrk = nelcrk + crkshell(k)%CRKNUMSHELL     ! Nb elements total sur nlevmax
      ENDDO
      numnodxfe = nod_xfe_l                           ! Nb noeuds total sur nlevmax
C
      nodtag(1:numnod_l) = 0
      k = 1 ! the same as K=1,NLEVMAX
      DO i=1,crkshell(k)%CRKNUMSHELL
        eltyp = crkshell(k)%ELTYPE(i)
        elem  = crkshell(k)%PHANTOML(i)
        IF (cep_xfe(i) == proc) THEN
          IF (eltyp == 4) THEN
            DO j=1,eltyp
              nod = ixc(j+1,elem)
              nodtag(nodlocal(nod))=nod
            ENDDO
          ELSEIF (eltyp == 3) THEN
            DO j=1,eltyp
              nod = ixtg(j+1,elem)
              nodtag(nodlocal(nod))=nod
            ENDDO
          END IF
        END IF
      END DO
C---
      nl_l = 0
      DO i=1,numnod_l
        nod = nodtag(i)
        IF (nod > 0) THEN
          IF (inod_crkxfem(nod) > 0) THEN
            nl_l = nl_l + 1
            inod_l(i) = nl_l
            index(nl_l) = inod_crkxfem(nod)
            inod_crk = inod_crkxfem(nod)
            nodlevxf_l(nl_l) = nodlevxf(inod_crk) ! nb des copies d'un nooeuds std xfem
          ENDIF
        ENDIF
      ENDDO
C---
      numnodcrkxfe_l = nl_l
C---
! ----------------------------------
!     1d array
      DEALLOCATE( nodtag )
! ----------------------------------
      RETURN
      END