spmd_anim_ply_xyznod.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/.
!||====================================================================
!||    spmd_anim_ply_xyznod   ../engine/source/mpi/anim/spmd_anim_ply_xyznod.F
!||--- called by ------------------------------------------------------
!||    xyznod_ply             ../engine/source/output/anim/generate/xyznod_ply.F
!||--- calls      -----------------------------------------------------
!||    write_r_c              ../common_source/tools/input_output/write_routines.c
!||--- uses       -----------------------------------------------------
!||    plyxfem_mod            ../engine/share/modules/plyxfem_mod.F
!||    spmd_mod               ../engine/source/mpi/spmd_mod.F90
!||====================================================================
      SUBROUTINE spmd_anim_ply_xyznod( NODGLOB,IPLY, IDPLY,
     *                                 NOD_PXFEM, X, ZI_PLY,EMPSIZPL )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE plyxfem_mod
      USE spmd_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   M e s s a g e   P a s s i n g
C-----------------------------------------------
#include "spmd.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "param_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NODGLOB(*),NOD_PXFEM(*),EMPSIZPL
      INTEGER IPLY,IDPLY
      my_real
     .   x(3,*),zi_ply(nplyxfe,*)
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
#ifdef MPI
      INTEGER MSGOFF,MSGOFF2,STAT(MPI_STATUS_SIZE,NSPMD-1), IERR
C-----------------------------------------------
      DATA msgoff/7055/
      DATA msgoff2/7056/
C-----------------------------------------------
      INTEGER I,N,II,ND,EMPL,P,ITAG
      INTEGER PLYSIZ
      my_real
     .   vn,val,norm
C
      REAL , DIMENSION(:,:), ALLOCATABLE :: WRTBUF
      my_real
     * , DIMENSION(:,:), ALLOCATABLE :: fsendbuf,frecbuf
      INTEGER, DIMENSION(:), ALLOCATABLE :: ISENDBUF,IRECBUF
C-----------------------------------------------
 
       ii = idply
C
 
      IF (ispmd ==0) THEN
        plysiz  = plynod(iply)%PLYNUMNODS
        ALLOCATE(wrtbuf(3,plysizg(iply)))
 
C The plynods of proc 0
        DO nd=1,plysiz
             i = plynod(iply)%NODES(nd)
             n = nod_pxfem(i)
             norm = sqrt(vn_nod(1,n)**2+vn_nod(2,n)**2+vn_nod(3,n)**2)
             norm = one/max(em20,norm)
             empl = plynod(iply)%PLYNODID(nd)-empsizpl
             
             vn = vn_nod(1,n)*norm
             val = x(1,i)+zi_ply(n,iply)*vn + ply(iply)%U(1,n)
             wrtbuf(1,empl)= val
 
             vn = vn_nod(2,n)*norm
             val = x(2,i)+zi_ply(n,iply)*vn + ply(iply)%U(2,n)
             wrtbuf(2,empl)= val
 
             vn = vn_nod(3,n)*norm
             val = x(3,i)+zi_ply(n,iply)*vn + ply(iply)%U(3,n)
             wrtbuf(3,empl)= val
        END DO
C The plynods of other procs
           DO p=2,nspmd
             IF (plyiadnod(iply,p)>0)THEN
              ALLOCATE(irecbuf(plyiadnod(iply,p)))
              ALLOCATE(frecbuf(3,plyiadnod(iply,p)))
              itag=msgoff
              CALL mpi_recv(irecbuf,plyiadnod(iply,p), mpi_integer,
     .                      it_spmd(p),itag, spmd_comm_world, stat, ierr)
              itag=msgoff2
              CALL mpi_recv(frecbuf,plyiadnod(iply,p)*3, real,
     .                      it_spmd(p),itag, spmd_comm_world, stat, ierr)
              DO i=1,plyiadnod(iply,p)
                 empl = irecbuf(i)-empsizpl
                 wrtbuf(1,empl)=frecbuf(1,i)
                 wrtbuf(2,empl)=frecbuf(2,i)
                 wrtbuf(3,empl)=frecbuf(3,i)
              ENDDO
              DEALLOCATE(irecbuf,frecbuf)
            ENDIF
           ENDDO
 
           CALL write_r_c(wrtbuf,3*plysizg(iply))
           DEALLOCATE(wrtbuf)
           empsizpl=empsizpl+plysizg(iply)
      ELSE
        plysiz = plynod(iply)%PLYNUMNODS
        ALLOCATE (fsendbuf(3,plysiz))
        ALLOCATE (isendbuf(plysiz))
        IF (plysiz > 0) THEN
         DO nd=1,plysiz
           i = plynod(iply)%NODES(nd)
           n = nod_pxfem(i)
           norm = sqrt(vn_nod(1,n)**2+vn_nod(2,n)**2+vn_nod(3,n)**2)
           norm = one/max(em20,norm)
           vn = vn_nod(1,n)*norm
           fsendbuf(1,nd) = x(1,i)+zi_ply(n,iply)*vn + ply(iply)%U(1,n)
           vn = vn_nod(2,n)*norm
           fsendbuf(2,nd) = x(2,i)+zi_ply(n,iply)*vn + ply(iply)%U(2,n)
           vn = vn_nod(3,n)*norm
           fsendbuf(3,nd) = x(3,i)+zi_ply(n,iply)*vn + ply(iply)%U(3,n)
           isendbuf(nd) = plynod(iply)%PLYNODID(nd)
         END DO
         itag=msgoff
         CALL mpi_send(isendbuf,plysiz,mpi_integer,it_spmd(1),
     .                   itag,spmd_comm_world,ierr)
 
         itag=msgoff2
         CALL mpi_send(fsendbuf,plysiz*3,real,it_spmd(1),
     .                   itag,spmd_comm_world,ierr)
C
         DEALLOCATE(isendbuf,fsendbuf)
        ENDIF
      ENDIF
C-----------------------------------------------
 
#endif
      RETURN
      END