w_anim_ply.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
!||====================================================================
!||    w_anim_ply    ../starter/source/restart/ddsplit/w_anim_ply.F
!||--- called by ------------------------------------------------------
!||    ddsplit       ../starter/source/restart/ddsplit/ddsplit.F
!||--- calls      -----------------------------------------------------
!||    get_ply_nod   ../starter/source/spmd/spmd_anim_ply_init.F
!||--- uses       -----------------------------------------------------
!||    plyxfem_mod   ../starter/share/modules1/plyxfem_mod.F
!||====================================================================
      SUBROUTINE w_anim_ply(IXC,NUMELC_L,NODLOCAL,
     *                      NUMNOD_L,CEL,CEP,PROC)
      USE plyxfem_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 IXC(NIXC,*),NUMELC_L, NODLOCAL(*),
     *        numnod_l,cel(*),cep(*),proc
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K,P,ELEM,ND,NDSZ_L,ELSZ_L,ELPL,NCOUNT,EMPL
      INTEGER, DIMENSION(:), ALLOCATABLE :: ELNUM,ELEMIPT,ELEMXFEMID,
     *                                      nodnum,nodextn,
     .                                      nodtag,elemtag,plysizng
      INTEGER GET_PLY_NOD
      EXTERNAL get_ply_nod
C-----------------------------------------------
!     1d array
      ALLOCATE( nodtag(numnod_l),elemtag(numelc_l) )
      ALLOCATE( plysizng(nplymax) )
! ----------------------------------
 
      CALL write_i_c(nplypart,1)
      CALL write_i_c(indx_ply,nplypart)
 
      DO k=1,nplymax
        nodtag=0
        elemtag=0
 
        plysizng(k)=plynod(k)%PLYNUMNODS
C Premiere partie, sur 1 pli on tag les elements et
C les noeuds du proc
        DO i=1,plyshell(k)%PLYNUMSHELL
           elem = plyshell(k)%SHID(i)
           IF (cep(elem)==proc)THEN
             elemtag(cel(elem))=i
             nd = ixc(2,elem)
             nodtag(nodlocal(nd))=nd
             nd = ixc(3,elem)
             nodtag(nodlocal(nd))=nd
             nd = ixc(4,elem)
             nodtag(nodlocal(nd))=nd
             nd = ixc(5,elem)
             nodtag(nodlocal(nd))=nd
           ENDIF
        ENDDO
C On les compte pour preparer les tableaux a envoyer a
C L engine
        elsz_l=0
        ndsz_l =0
        DO i=1,numelc_l
          IF (elemtag(i)  > 0) elsz_l=elsz_l+1
        ENDDO
        DO i=1,numnod_l
          IF (nodtag(i) > 0) ndsz_l=ndsz_l+1
        ENDDO
 
C on prepare les tableaux a envoyer
        elpl = 0
        ALLOCATE ( elnum(elsz_l),elemipt(elsz_l),elemxfemid(elsz_l) )
 
C Tableaux locaux elements
        DO i=1,numelc_l
          IF (elemtag(i)  > 0) THEN
             elpl=elpl+1
             nd = elemtag(i)
C
             elnum(elpl)      = i
             elemipt(elpl)    = plyshell(k)%SHELLIPT(nd)
             elemxfemid(elpl) = plyshell(k)%SHELLID(nd)
          ENDIF
        ENDDO
C Tableaux locaux noeuds xfem
        ncount = 0
        ALLOCATE ( nodnum(ndsz_l), nodextn(ndsz_l) )
        DO i=1,numnod_l
          IF (nodtag(i) > 0) THEN
            ncount = ncount + 1
            nd=nodtag(i)
C
            empl = get_ply_nod(k,nd)
            nodnum(ncount) = i
            nodextn(ncount) = plynod(k)%PLYNODID(empl)
          ENDIF
        ENDDO
C Ecriture par ply des tableaux
C Coques ply
        CALL write_i_c(elsz_l    , 1     )
        CALL write_i_c(elnum     , elsz_l)
        CALL write_i_c(elemipt   , elsz_l)
        CALL write_i_c(elemxfemid, elsz_l)
C noeuds ply
        CALL write_i_c(ndsz_l    , 1     )
        CALL write_i_c(nodnum    , ndsz_l)
        CALL write_i_c(nodextn   , ndsz_l)
 
C
        DEALLOCATE ( nodextn,nodnum,elnum,elemipt,elemxfemid)
      ENDDO
 
        CALL write_i_c(plysizng,nplymax)
C id ply pid     
        CALL write_i_c(idpid_ply,nplypart)    
! ----------------------------------    
!     1d array
      DEALLOCATE( nodtag,elemtag )
      DEALLOCATE( plysizng )
! ----------------------------------   
      RETURN
      END