spmd_anim_ply_xyznod.F File Reference

#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	spmd_anim_ply_xyznod (nodglob, iply, idply, nod_pxfem, x, zi_ply, empsizpl)

Function/Subroutine Documentation

spmd_anim_ply_xyznod()

subroutine spmd_anim_ply_xyznod	(	integer, dimension(*)	nodglob,
		integer	iply,
		integer	idply,
		integer, dimension(*)	nod_pxfem,
			x,
			zi_ply,
		integer	empsizpl )

Definition at line 33 of file spmd_anim_ply_xyznod.F.

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,*)
      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
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 Les plynods du 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 Les plynods des autres 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