build_message_layout Subroutine

private subroutine build_message_layout(idimmin, idimmax)

Uses

  • proc~~build_message_layout~~UsesGraph proc~build_message_layout build_message_layout module~mod_comm_lib mod_comm_lib proc~build_message_layout->module~mod_comm_lib module~mod_global_parameters mod_global_parameters proc~build_message_layout->module~mod_global_parameters module~mod_msg_layout mod_msg_layout proc~build_message_layout->module~mod_msg_layout 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

Enumerate every chunk this rank sends and receives, and lay each peer's chunks out as one contiguous run of the exchange buffer. Fills snd_igrid / snd_ibuf / snd_group for the pack kernels, ibuf_offset for fix_conserve, and the send_pe_ / recv_pe_ runs for the MPI calls.

Arguments

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

Calls

proc~~build_message_layout~~CallsGraph proc~build_message_layout build_message_layout proc~layout_runs layout_runs proc~build_message_layout->proc~layout_runs proc~mpistop mpistop proc~build_message_layout->proc~mpistop proc~rank_keys rank_keys proc~layout_runs->proc~rank_keys mpi_abort mpi_abort proc~mpistop->mpi_abort

Called by

proc~~build_message_layout~~CalledByGraph proc~build_message_layout build_message_layout proc~init_comm_fix_conserve init_comm_fix_conserve proc~init_comm_fix_conserve->proc~build_message_layout proc~advect advect proc~advect->proc~init_comm_fix_conserve proc~recalculateb recalculateB proc~recalculateb->proc~init_comm_fix_conserve proc~advance advance proc~advance->proc~advect proc~improve_initial_condition improve_initial_condition proc~improve_initial_condition->proc~recalculateb 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 build_message_layout(idimmin,idimmax)
     use mod_global_parameters
     use mod_comm_lib, only: mpistop
     use mod_msg_layout, only: layout_runs

     integer, intent(in) :: idimmin,idimmax

     integer :: iigrid, igrid, idims, iside, i1,i2,i3, ic1,ic2,ic3
     integer :: inc1,inc2,inc3, ineighbor, ipe_neighbor, n, m, k

     ! Outgoing: this rank's fine blocks that face a coarse neighbour
     ! elsewhere.  The key is built from the *receiver's* block index, which is
     ! what neighbor() holds, so it matches the key the receiver derives from
     ! its own igrid below.
     n = 0
     snd_ngroup = 0
     do iigrid=1,igridstail; igrid=igrids(iigrid);
       do idims=idimmin,idimmax
         do iside=1,2
           i1=kr(1,idims)*(2*iside-3);i2=kr(2,idims)*(2*iside-3)
           i3=kr(3,idims)*(2*iside-3);
           if (neighbor_pole(i1,i2,i3,igrid)/=0) cycle
           if (neighbor_type(i1,i2,i3,igrid)/=neighbor_coarse) cycle
           ineighbor   =neighbor(1,i1,i2,i3,igrid)
           ipe_neighbor=neighbor(2,i1,i2,i3,igrid)
           if (ipe_neighbor==mype) cycle
           ic1=1+modulo(node(pig1_,igrid)-1,2)
           ic2=1+modulo(node(pig2_,igrid)-1,2)
           ic3=1+modulo(node(pig3_,igrid)-1,2);
           inc1=-2*i1+ic1;inc2=-2*i2+ic2;inc3=-2*i3+ic3;
           n = n + 1
           if (n > nsend) call mpistop(&
              "build_message_layout: more sends than nsend_fc counted")
           snd_igrid(n) = igrid
           snd_dest(n)  = ipe_neighbor
           snd_dims(n)  = idims
           snd_key(n)   = 4**3*(ineighbor-1)+inc1+4*inc2+16*inc3
           snd_ngroup(iside,idims) = snd_ngroup(iside,idims) + 1
           snd_group(snd_ngroup(iside,idims),iside,idims) = n
         end do
       end do
     end do
     if (n /= nsend) call mpistop(&
        "build_message_layout: fewer sends than nsend_fc counted")

     ! the key fixes the chunk's size: inc_d lies in {1,2} exactly when i_d is
     ! zero, so the one direction with inc_d in {0,3} is idims - but the walk
     ! above already carried idims along, so hand layout_runs the sizes directly
     call layout_runs(n, snd_dest, snd_key, isize(snd_dims(1:n)), snd_ibuf,&
        n_send_pe, send_pe, send_pe_off, send_pe_len)
     

     ! Incoming: this rank's coarse blocks that face fine children elsewhere.
     m = 0
     do iigrid=1,igridstail; igrid=igrids(iigrid);
       do idims=idimmin,idimmax
         do iside=1,2
           i1=kr(1,idims)*(2*iside-3);i2=kr(2,idims)*(2*iside-3)
           i3=kr(3,idims)*(2*iside-3);
           if (neighbor_pole(i1,i2,i3,igrid)/=0) cycle
           if (neighbor_type(i1,i2,i3,igrid)/=neighbor_fine) cycle
           do ic3=1+int((1-i3)/2),2-int((1+i3)/2)
             inc3=2*i3+ic3
           do ic2=1+int((1-i2)/2),2-int((1+i2)/2)
             inc2=2*i2+ic2
           do ic1=1+int((1-i1)/2),2-int((1+i1)/2)
             inc1=2*i1+ic1
             ipe_neighbor=neighbor_child(2,inc1,inc2,inc3,igrid)
             if (ipe_neighbor==mype) cycle
             m = m + 1
             if (m > nrecv) call mpistop(&
                "build_message_layout: more receives than nrecv_fc counted")
             rcv_src(m)  = ipe_neighbor
             rcv_dims(m) = idims
             rcv_key(m)  = 4**3*(igrid-1)+inc1+4*inc2+16*inc3
           end do
           end do
           end do
         end do
       end do
     end do
     if (m /= nrecv) call mpistop(&
        "build_message_layout: fewer receives than nrecv_fc counted")

     call layout_runs(m, rcv_src, rcv_key, isize(rcv_dims(1:m)), rcv_off,&
        n_recv_pe, recv_pe, recv_pe_off, recv_pe_len)

     ! Scatter into the key -> offset table fix_conserve reads.  Entries for
     ! keys not in this exchange keep whatever they held; nothing reads them.
     do k = 1, m
       ibuf_offset(rcv_key(k)+1) = rcv_off(k)
     end do
     

   end subroutine build_message_layout