spmd_anim_ply_velvec.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	spmd_anim_ply_velvec (nodglob, iply, nod_pxfem, ifunc, empsizpl)

Function/Subroutine Documentation

spmd_anim_ply_velvec()

subroutine spmd_anim_ply_velvec	(	integer, dimension(*)	nodglob,
		integer	iply,
		integer, dimension(*)	nod_pxfem,
		integer	ifunc,
		integer	empsizpl )

Definition at line 34 of file spmd_anim_ply_velvec.F.

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      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NODGLOB(*),NOD_PXFEM(*)
      INTEGER IPLY,IFUNC,EMPSIZPL
 
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
      INTEGER PLYSIZ
C
      REAL , DIMENSION(:,:), ALLOCATABLE :: WRTBUF
      my_real
     * , DIMENSION(:,:), ALLOCATABLE :: fsendbuf,frecbuf
      INTEGER, DIMENSION(:), ALLOCATABLE :: ISENDBUF,IRECBUF
C-----------------------------------------------
      DATA msgoff/7060/
      DATA msgoff2/7061/
C-----------------------------------------------
 
C
      IF (ispmd ==0) THEN
        plysiz  = plynod(iply)%PLYNUMNODS
        ALLOCATE(wrtbuf(3,plysizg(iply)))
 
C the plynods of processor 0
        DO nd=1,plysiz
             i = plynod(iply)%NODES(nd)
             n = nod_pxfem(i)
             empl = plynod(iply)%PLYNODID(nd)-empsizpl
 
             IF (ifunc==1)THEN
                wrtbuf(1,empl)= ply(iply)%V(1,n)
                wrtbuf(2,empl)= ply(iply)%V(2,n)
                wrtbuf(3,empl)= ply(iply)%V(3,n)
 
             ELSEIF (ifunc==2)THEN
                wrtbuf(1,empl)= ply(iply)%U(1,n)
                wrtbuf(2,empl)= ply(iply)%U(2,n)
                wrtbuf(3,empl)= ply(iply)%U(3,n)
 
             ELSEIF (ifunc==3)THEN
                wrtbuf(1,empl)= ply(iply)%A(1,n)
                wrtbuf(2,empl)= ply(iply)%A(2,n)
                wrtbuf(3,empl)= ply(iply)%A(3,n)
             ELSE
                wrtbuf(1,empl)= zero
                wrtbuf(2,empl)= zero
                wrtbuf(3,empl)= zero
             ENDIF
        END DO
C the plynods of other processors
           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)
 
           IF (ifunc==1)THEN
              fsendbuf(1,nd) = ply(iply)%V(1,n)
              fsendbuf(2,nd) = ply(iply)%V(2,n)
              fsendbuf(3,nd) = ply(iply)%V(3,n)
 
           ELSEIF (ifunc==2)THEN
              fsendbuf(1,nd) = ply(iply)%U(1,n)
              fsendbuf(2,nd) = ply(iply)%U(2,n)
              fsendbuf(3,nd) = ply(iply)%U(3,n)
 
           ELSEIF (ifunc==3)THEN
              fsendbuf(1,nd) = ply(iply)%A(1,n)
              fsendbuf(2,nd) = ply(iply)%A(2,n)
              fsendbuf(3,nd) = ply(iply)%A(3,n)
           ELSE
              fsendbuf(1,nd) = zero
              fsendbuf(2,nd) = zero
              fsendbuf(3,nd) = zero
           ENDIF
 
             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