spmd_anim_ply_xyznor.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_xyznor   ../engine/source/mpi/anim/spmd_anim_ply_xyznor.f
!||--- called by ------------------------------------------------------
!||    xyznor_ply             ../engine/source/output/anim/generate/xyznor_ply.F
!||--- calls      -----------------------------------------------------
!||    write_s_c              ../common_source/tools/input_output/write_routtines.c
!||--- uses       -----------------------------------------------------
!||    plyxfem_mod            ../engine/share/modules/plyxfem_mod.F
!||    spmd_comm_world_mod    ../engine/source/mpi/spmd_comm_world.F90
!||====================================================================
      SUBROUTINE spmd_anim_ply_xyznor( NODGLOB,IPLY,XNORM,EMPSIZPL)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE plyxfem_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
        USE spmd_comm_world_mod, ONLY : spmd_comm_world
#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      "scr14_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(*)
      INTEGER IPLY,IDPLY,EMPSIZPL
      my_real
     .   xnorm(3,*)
      REAL R4
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
      INTEGER I,N,ND,EMPL,P,ITAG,INORM(3),K,IXNN
 
      INTEGER PLYSIZ
      my_real
     .   s3000,s
C
      INTEGER, DIMENSION(:,:), ALLOCATABLE :: WRTBUF
      INTEGER, DIMENSION(:,:), ALLOCATABLE :: FSENDBUF,FRECBUF
      INTEGER, DIMENSION(:), ALLOCATABLE :: ISENDBUF,IRECBUF
C-----------------------------------------------
      DATA msgoff/7058/
      DATA msgoff2/7059/
C-----------------------------------------------
      s3000 = three1000
      ixnn = s3000
      IF(fmt_ani==4)ixnn=0
C
      IF (ispmd ==0) THEN
        plysiz  = plynod(iply)%PLYNUMNODS
        ALLOCATE(wrtbuf(3,plysizg(iply)))
 
C Les plynods du proc 0
        DO nd=1,plysiz
             i = plynod(iply)%NODES(nd)
             empl =  plynod(iply)%PLYNODID(nd)-empsizpl
 
             s = sqrt(xnorm(1,i)**2 + xnorm(2,i)**2 + xnorm(3,i)**2)
             IF(s/=zero)THEN
                s = s3000 / s
                inorm(1) = xnorm(1,i) * s
                inorm(2) = xnorm(2,i) * s
                inorm(3) = xnorm(3,i) * s
             ELSE
                inorm(1) = 0
                inorm(2) = 0
                inorm(3) = ixnn
             END IF
 
             wrtbuf(1,empl)= inorm(1)
             wrtbuf(2,empl)= inorm(2)
             wrtbuf(3,empl)= inorm(3)
        END DO
C Les plynods des autres procs
           DO p=2,nspmd
              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, mpi_integer,
     .                      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)
           ENDDO
 
           CALL write_s_c(wrtbuf,3*plysizg(iply))
           DEALLOCATE(wrtbuf)
           empsizpl=empsizpl+plysizg(iply)
 
      ELSE
        plysiz = plynod(iply)%PLYNUMNODS
        ALLOCATE (fsendbuf(3,plysiz))
        ALLOCATE (isendbuf(plysiz))
 
        DO nd=1,plysiz
             i = plynod(iply)%NODES(nd)
 
             s = sqrt(xnorm(1,i)**2 + xnorm(2,i)**2 + xnorm(3,i)**2)
             IF(s/=zero)THEN
                s = s3000 / s
                inorm(1) = xnorm(1,i) * s
                inorm(2) = xnorm(2,i) * s
                inorm(3) = xnorm(3,i) * s
             ELSE
                inorm(1) = 0
                inorm(2) = 0
                inorm(3) = ixnn
             END IF
 
           fsendbuf(1,nd) = inorm(1)
           fsendbuf(2,nd) = inorm(2)
           fsendbuf(3,nd) = inorm(3)
 
           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,mpi_integer,it_spmd(1),
     .                   itag,spmd_comm_world,ierr)
C
        DEALLOCATE(isendbuf,fsendbuf)
      ENDIF
 
#endif
      RETURN
      END