spmd_h3d_getmsr_update.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_h3d_getmsr_update (fr_wall, disp, msr, xwl, ywl, zwl, rwl)

Function/Subroutine Documentation

spmd_h3d_getmsr_update()

subroutine spmd_h3d_getmsr_update	(	integer, dimension(nspmd+2)	fr_wall,
			disp,
		integer	msr,
			xwl,
			ywl,
			zwl,
			rwl )

Definition at line 31 of file spmd_h3d_getmsr_update.F.

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"
#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-----------------------------------------------
       my_real
     .   disp(3,*),xwl,ywl,zwl,rwl(*)
       INTEGER MSR,FR_WALL(NSPMD+2)
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
#ifdef MPI
       INTEGER P
       INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF,MSGTYP
       my_real
     .         xyzwl(3) 
       DATA msgoff/7032/
 
       p = fr_wall(nspmd+2)
       IF (p==1.OR.p==0) THEN
         IF (ispmd==0) THEN
           IF (msr==0) THEN
              xwl = zero 
              ywl = zero
              zwl = zero
           ELSE
             xwl = disp(1,msr)
             ywl = disp(2,msr)
             zwl = disp(3,msr)
           END IF
         END IF
       ELSE
         IF (p==ispmd+1) THEN
           IF (msr==0) THEN
             xwl = zero 
             ywl = zero
             zwl = zero
           ELSE
             xyzwl(1)= disp(1,msr)
             xyzwl(2)= disp(2,msr)
             xyzwl(3)= disp(3,msr)
           END IF
 
           msgtyp = msgoff 
           CALL mpi_send(xyzwl,3,real,it_spmd(1),msgtyp,
     .     spmd_comm_world,ierror)
         END IF
         IF (ispmd==0) THEN
            msgtyp = msgoff 
            CALL mpi_recv(xyzwl,3,real,it_spmd(p),msgtyp,
     .              spmd_comm_world,status,ierror)
            xwl = xyzwl(1)
            ywl = xyzwl(2) 
            zwl = xyzwl(3) 
         END IF
       END IF
#endif
      RETURN