spmd_h3d_getmsr.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 (fr_wall, x, msr, xwl, ywl, zwl, rwl)

Function/Subroutine Documentation

spmd_h3d_getmsr()

subroutine spmd_h3d_getmsr	(	integer, dimension(nspmd+2)	fr_wall,
			x,
		integer	msr,
			xwl,
			ywl,
			zwl,
			rwl )

Definition at line 31 of file spmd_h3d_getmsr.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
     .   x(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 = rwl(4) 
              ywl = rwl(5)
              zwl = rwl(6)
           ELSE
             xwl = x(1,msr)
             ywl = x(2,msr)
             zwl = x(3,msr)
           END IF
         END IF
       ELSE
         IF (p==ispmd+1) THEN
           IF (msr==0) THEN
             xwl = rwl(4) 
             ywl = rwl(5)
             zwl = rwl(6)
           ELSE
             xyzwl(1)= x(1,msr)
             xyzwl(2)= x(2,msr)
             xyzwl(3)= x(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