EXCHANGE_DOUBLE.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	exchange_double (nsend, buff_send, nrecv, buff_recv, nproc, proc_send, proc_recv, comm, status, ierr, myid)
	Exchanges double between MPI processes.

Function/Subroutine Documentation

exchange_double()

subroutine exchange_double	(	integer*4	nsend,
		real*8, dimension(nsend)	buff_send,
		integer*4	nrecv,
		real*8, dimension(nrecv)	buff_recv,
		integer*4	nproc,
		integer*4, dimension(nproc)	proc_send,
		integer*4, dimension(nproc)	proc_recv,
		integer*4	comm,
		integer*4, dimension(speed_status_size)	status,
		integer*4	ierr,
		integer*4	myid
	)

Exchanges double between MPI processes.

Author

Ilario Mazzieri

Date

September, 2013

Version

1.0

Parameters

[in]	nsend	number of values to be sent
[in]	buff_send	buffer containing the values to be sent
[in]	nrecv	number of values to be received
[in]	buff_recv	buffer for the values to be received
[in]	nproc	number of processors
[in]	proc_send	vector containing the number of values to be sent to each proc.
[in]	proc_recv	vector containing the number of values to be received from each proc.
[in]	comm	MPI communicator
[in]	status	MPI status
[in]	ierr	MPI error tag
[in]	myid	MPI id

Definition at line 36 of file EXCHANGE_DOUBLE.f90.

     
     implicit none
     include 'SPEED.MPI'
     
     integer*4 :: nsend,nrecv,nproc,comm,ierr,tag,myid
     integer*4 :: ip,ir,is
     
     integer*4, dimension(nproc) :: proc_send,proc_recv
     integer*4, dimension(SPEED_STATUS_SIZE) :: status
     integer*4, dimension(nproc) :: request,requests
 
!     real*8, dimension(*) :: buff_send,buff_recv
     real*8, dimension(nsend) :: buff_send
     real*8, dimension(nrecv) :: buff_recv
    
     tag=2120
     
     is = 1
     do ip = 1, nproc
         if (proc_send(ip).gt.0) then
            call mpi_isend(buff_send(is:(is +proc_send(ip) -1)),&
                 proc_send(ip),speed_double,(ip -1),&
                tag,comm,requests(ip),ierr)
         endif
         is = is +proc_send(ip)
      enddo
 
      ir = 1
      do ip = 1, nproc
         if (proc_recv(ip).gt.0) then
            call mpi_irecv(buff_recv(ir:(ir +proc_recv(ip) -1)),&
                 proc_recv(ip),speed_double,(ip -1),&
                 mpi_any_tag,comm,request(ip),ierr)
         endif
         ir = ir +proc_recv(ip)
      enddo
    
     do ip = 1, nproc 
         if (proc_send(ip).gt.0) then 
            call mpi_wait(requests(ip),status,ierr)
         endif
     enddo 
     do ip = 1, nproc
        if (proc_recv(ip).gt.0) then
           call mpi_wait(request(ip),status,ierr)
        endif
     enddo
     
     speed_tag = speed_tag +1
     if (speed_tag.gt.speed_tag_max) speed_tag = speed_tag_min
     
     return
     

Referenced by compute_energy_error().

Here is the caller graph for this function: