sendflux Subroutine

public subroutine sendflux(idimmin, idimmax)

Uses

  • proc~~sendflux~~UsesGraph proc~sendflux sendflux module~mod_global_parameters mod_global_parameters proc~sendflux->module~mod_global_parameters module~mod_basic_types mod_basic_types module~mod_global_parameters->module~mod_basic_types module~mod_connectivity mod_connectivity module~mod_global_parameters->module~mod_connectivity module~mod_constants mod_constants module~mod_global_parameters->module~mod_constants module~mod_physicaldata mod_physicaldata module~mod_global_parameters->module~mod_physicaldata module~mod_variables mod_variables module~mod_global_parameters->module~mod_variables mpi mpi module~mod_global_parameters->mpi module~mod_variables->module~mod_basic_types

Pack the outgoing flux chunks and post one message per peer. Where each chunk goes was decided by build_message_layout; nothing here walks the tree.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: idimmin
integer, intent(in) :: idimmax

Calls

proc~~sendflux~~CallsGraph proc~sendflux sendflux proc~mpi_isend_wrapper mpi_isend_wrapper proc~sendflux->proc~mpi_isend_wrapper mpi_isend mpi_isend proc~mpi_isend_wrapper->mpi_isend

Called by

proc~~sendflux~~CalledByGraph proc~sendflux sendflux proc~advect1 advect1 proc~advect1->proc~sendflux proc~recalculateb recalculateB proc~recalculateb->proc~sendflux proc~advect advect proc~advect->proc~advect1 proc~improve_initial_condition improve_initial_condition proc~improve_initial_condition->proc~recalculateb proc~advance advance proc~advance->proc~advect proc~main main proc~main->proc~improve_initial_condition proc~timeintegration timeintegration proc~main->proc~timeintegration proc~timeintegration->proc~advance program~agile agile program~agile->proc~main

Source Code

   subroutine sendflux(idimmin,idimmax)
     use mod_global_parameters

     integer, intent(in) :: idimmin,idimmax

     integer :: idims, iside, ix1,ix2,ix3, iw
     integer :: k, ng, imsg

     fc_sendreq = MPI_REQUEST_NULL

     ! One kernel per (iside, idims) group rather than one per chunk: pflux's
     ! slot is then loop-invariant, and a derived-type component holding an
     ! allocatable array cannot be selected by a device-side index.
     do idims = idimmin,idimmax
       do iside = 1,2
         ng = snd_ngroup(iside,idims)
         if (ng == 0) cycle
         select case (idims)
         case (1)
            
           do k = 1,ng
             imsg = snd_group(k,iside,1)
             
             do iw=1,nwflux_fc
               do ix3=1,nxCo_fc(3,1)
                 do ix2=1,nxCo_fc(2,1)
                   sendbuffer(snd_ibuf(imsg)+(ix2-1)+(ix3-1)*nxCo_fc(2,1) &
                      +(iw-1)*nxCo_fc(2,1)*nxCo_fc(3,1)) = &
                      pflux(iside,1)%flux(1,ix2,ix3,iw,snd_igrid(imsg))
                 end do
               end do
             end do
           end do
         case (2)
            
           do k = 1,ng
             imsg = snd_group(k,iside,2)
             
             do iw=1,nwflux_fc
               do ix3=1,nxCo_fc(3,2)
                 do ix1=1,nxCo_fc(1,2)
                   sendbuffer(snd_ibuf(imsg)+(ix1-1)+(ix3-1)*nxCo_fc(1,2) &
                      +(iw-1)*nxCo_fc(1,2)*nxCo_fc(3,2)) = &
                      pflux(iside,2)%flux(ix1,1,ix3,iw,snd_igrid(imsg))
                 end do
               end do
             end do
           end do
         case (3)
            
           do k = 1,ng
             imsg = snd_group(k,iside,3)
             
             do iw=1,nwflux_fc
               do ix2=1,nxCo_fc(2,3)
                 do ix1=1,nxCo_fc(1,3)
                   sendbuffer(snd_ibuf(imsg)+(ix1-1)+(ix2-1)*nxCo_fc(1,3) &
                      +(iw-1)*nxCo_fc(1,3)*nxCo_fc(2,3)) = &
                      pflux(iside,3)%flux(ix1,ix2,1,iw,snd_igrid(imsg))
                 end do
               end do
             end do
           end do
         end select
       end do
     end do

     ! One transfer for the whole buffer, then one Isend per peer.  Each peer's
     ! chunks are contiguous and in the order that peer expects them, so a
     ! single message carries all of them and the tag carries no block index.
#ifdef NOGPUDIRECT
     if (n_send_pe > 0) then
       ! sliced, not whole-array: the buffer is grown and not shrunk, so
       ! size(sendbuffer) can exceed what this exchange actually uses
       
     end if
#else
     
#endif
     itag=idimmin+4*idimmax
     do k = 1,n_send_pe
       call mpi_isend_wrapper(sendbuffer(send_pe_off(k)),send_pe_len(k),&
          MPI_DOUBLE_PRECISION,send_pe(k),itag,icomm,fc_sendreq(k),ierrmpi)
     end do
#ifndef NOGPUDIRECT
     
#endif

   end subroutine sendflux