spmd_gather_nodal_scalar_mod Module Reference

Functions/Subroutines
subroutine	spmd_gather_nodal_scalar (v_glob, num, v, numnod, weight, nodglob)

Function/Subroutine Documentation

spmd_gather_nodal_scalar()

subroutine spmd_gather_nodal_scalar_mod::spmd_gather_nodal_scalar	(	real(kind=wp), dimension(num)	v_glob,
		integer	num,
		real(kind=wp), dimension(*)	v,
		integer, intent(in)	numnod,
		integer, dimension(*)	weight,
		integer, dimension(*)	nodglob )

Definition at line 47 of file spmd_gather_nodal_scalar.F.

! ----------------------------------------------------------------------------------------------------------------------
!                                                   Modules
! ----------------------------------------------------------------------------------------------------------------------
        use spmd_comm_world_mod, only : spmd_comm_world
        use precision_mod , only : wp
        use spmd_send_mod, only: spmd_send
        use spmd_recv_mod, only: spmd_recv
        use constant_mod , only : zero
! ----------------------------------------------------------------------------------------------------------------------
!                                                   Implicit none
! ----------------------------------------------------------------------------------------------------------------------
          implicit none
! ----------------------------------------------------------------------------------------------------------------------
!                                                   Included files
! ----------------------------------------------------------------------------------------------------------------------
#include "spmd.inc"
#include "com01_c.inc"
#include "spmd_c.inc"
#include "task_c.inc"
! ----------------------------------------------------------------------------------------------------------------------
!                                                   Arguments
! ----------------------------------------------------------------------------------------------------------------------
       real(kind=wp) :: v(*)
       INTEGER :: WEIGHT(*),NODGLOB(*),NUM
       integer,intent(in) :: numnod
       real(kind=wp) :: v_glob(num)
! ----------------------------------------------------------------------------------------------------------------------
!                                                   Local Variables
! ----------------------------------------------------------------------------------------------------------------------
#ifdef MPI
      INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF
      INTEGER SIZ,MSGTYP,I,K,NG,NREC,MSGOFF2
 
      DATA msgoff/7014/
      DATA msgoff2/7015/
      real(kind=wp), DIMENSION(:) , ALLOCATABLE :: bufsr
      INTEGER, DIMENSION(:) , ALLOCATABLE :: IBUF
! ----------------------------------------------------------------------------------------------------------------------
!                                                   Body
! ----------------------------------------------------------------------------------------------------------------------
       ALLOCATE(bufsr(numnodm), ibuf(numnodm))
       bufsr = zero
       IF (ispmd /= 0) THEN
         siz = 0
         DO i=1,numnod
           IF (weight(i)==1) THEN
             siz = siz + 1
             ibuf(siz) = nodglob(i)
             bufsr(siz) = v(i) 
           END IF
         END DO 
 
         msgtyp = msgoff2
         CALL spmd_send(ibuf,siz,it_spmd(1),msgtyp)
         msgtyp = msgoff 
         CALL spmd_send(bufsr,siz,it_spmd(1),msgtyp)
 
       ELSE
 
          siz = 0
          DO i=1,numnod
            IF (weight(i)==1) THEN 
              siz = siz +1
              ng = nodglob(i)
              v_glob(ng) = v(i)
            ENDIF
          ENDDO
 
          DO i=2,nspmd
            !--- Receiving the full buffer of NODGLOB addresses
            msgtyp = msgoff2
            CALL mpi_probe(it_spmd(i),msgtyp,spmd_comm_world,status,ierror)
            CALL mpi_get_count(status,mpi_integer,siz,ierror)
            CALL spmd_recv(ibuf,siz,it_spmd(i),msgtyp)
            !--- Receiving the floating buffer of NODGLOB addresses
            msgtyp = msgoff 
            CALL spmd_recv(bufsr,siz,it_spmd(i),msgtyp)
            nrec = siz
            DO k = 1, nrec
              ng = ibuf(k)
              v_glob(ng) = bufsr(k)
            ENDDO
          ENDDO
 
       ENDIF
       DEALLOCATE(bufsr,ibuf)
#endif