ocean_fold_exchange Subroutine

public subroutine ocean_fold_exchange(device_resident)

Move every packed message: one isend + irecv per non-self peer with a non-empty message, the self pair as a local copy, then waitall. Collective over the north rank row.

Arguments

Type IntentOptional Attributes Name
logical, intent(in), optional :: device_resident

.false. ⇒ host buffers; default device-resident.

Calls

proc~~ocean_fold_exchange~~CallsGraph proc~ocean_fold_exchange ocean_fold_exchange comm_irecv_real_sp_array_n comm_irecv_real_sp_array_n proc~ocean_fold_exchange->comm_irecv_real_sp_array_n comm_isend_real_sp_array_n comm_isend_real_sp_array_n proc~ocean_fold_exchange->comm_isend_real_sp_array_n proc~comm_env_compute_comm comm_env_compute_comm proc~ocean_fold_exchange->proc~comm_env_compute_comm waitall waitall proc~ocean_fold_exchange->waitall comm_world comm_world proc~comm_env_compute_comm->comm_world

Called by

proc~~ocean_fold_exchange~~CalledByGraph proc~ocean_fold_exchange ocean_fold_exchange proc~barotropic_substep_nonlinear barotropic_substep_nonlinear proc~barotropic_substep_nonlinear->proc~ocean_fold_exchange interface~ocean_fold_north_v_face ocean_fold_north_v_face proc~barotropic_substep_nonlinear->interface~ocean_fold_north_v_face proc~fold_centre_2d fold_centre_2d proc~fold_centre_2d->proc~ocean_fold_exchange proc~fold_centre_3d fold_centre_3d proc~fold_centre_3d->proc~ocean_fold_exchange proc~fold_corner_2d fold_corner_2d proc~fold_corner_2d->proc~ocean_fold_exchange proc~fold_u_2d fold_u_2d proc~fold_u_2d->proc~ocean_fold_exchange proc~fold_u_3d fold_u_3d proc~fold_u_3d->proc~ocean_fold_exchange proc~fold_v_2d fold_v_2d proc~fold_v_2d->proc~ocean_fold_exchange proc~fold_v_3d fold_v_3d proc~fold_v_3d->proc~ocean_fold_exchange proc~ocean_fold_wrap_centre_3d_state ocean_fold_wrap_centre_3d_state proc~ocean_fold_wrap_centre_3d_state->proc~ocean_fold_exchange proc~ocean_fold_wrap_centre_flat ocean_fold_wrap_centre_flat proc~ocean_fold_wrap_centre_flat->proc~ocean_fold_exchange proc~ocean_fold_wrap_eta_2d ocean_fold_wrap_eta_2d proc~ocean_fold_wrap_eta_2d->proc~ocean_fold_exchange proc~ocean_fold_wrap_state ocean_fold_wrap_state proc~ocean_fold_wrap_state->proc~ocean_fold_exchange proc~ocean_fold_wrap_stress ocean_fold_wrap_stress proc~ocean_fold_wrap_stress->proc~ocean_fold_exchange proc~ocean_fold_wrap_time_means ocean_fold_wrap_time_means proc~ocean_fold_wrap_time_means->proc~ocean_fold_exchange proc~ocean_fold_wrap_visc_rem ocean_fold_wrap_visc_rem proc~ocean_fold_wrap_visc_rem->proc~ocean_fold_exchange interface~ocean_fold_north_centre ocean_fold_north_centre interface~ocean_fold_north_centre->proc~fold_centre_2d interface~ocean_fold_north_centre->proc~fold_centre_3d interface~ocean_fold_north_corner ocean_fold_north_corner interface~ocean_fold_north_corner->proc~fold_corner_2d interface~ocean_fold_north_u_face ocean_fold_north_u_face interface~ocean_fold_north_u_face->proc~fold_u_2d interface~ocean_fold_north_u_face->proc~fold_u_3d interface~ocean_fold_north_v_face->proc~fold_v_2d interface~ocean_fold_north_v_face->proc~fold_v_3d proc~barotropic_substep_nonlinear_interior barotropic_substep_nonlinear_interior proc~barotropic_substep_nonlinear_interior->proc~barotropic_substep_nonlinear proc~bt_wide_substep bt_wide_substep proc~bt_wide_substep->proc~barotropic_substep_nonlinear proc~configure_ocean_land_mask configure_ocean_land_mask proc~configure_ocean_land_mask->proc~ocean_fold_wrap_eta_2d proc~continuity_gm_apply continuity_gm_apply proc~continuity_gm_apply->proc~ocean_fold_wrap_centre_3d_state proc~continuity_gm_apply->interface~ocean_fold_north_v_face proc~continuity_tracer_step_split continuity_tracer_step_split proc~continuity_tracer_step_split->proc~ocean_fold_wrap_centre_3d_state proc~continuity_tracer_step_split->interface~ocean_fold_north_v_face proc~engine_setup engine_setup proc~engine_setup->proc~ocean_fold_wrap_eta_2d proc~engine_setup->proc~ocean_fold_wrap_state proc~engine_setup->interface~ocean_fold_north_corner proc~engine_setup->proc~configure_ocean_land_mask proc~ocean_halo_exchange_ice_state ocean_halo_exchange_ice_state proc~engine_setup->proc~ocean_halo_exchange_ice_state proc~configure_ocean_forcing configure_ocean_forcing proc~engine_setup->proc~configure_ocean_forcing proc~ocean_data_forcing_configure ocean_data_forcing_configure proc~engine_setup->proc~ocean_data_forcing_configure proc~ocean_halo_exchange_ice_fluxes ocean_halo_exchange_ice_fluxes proc~ocean_halo_exchange_ice_fluxes->proc~ocean_fold_wrap_centre_flat proc~ocean_halo_exchange_ice_state->proc~ocean_fold_wrap_centre_flat proc~ocean_halo_exchange_ice_transport ocean_halo_exchange_ice_transport proc~ocean_halo_exchange_ice_transport->proc~ocean_fold_wrap_centre_flat proc~ocean_seam_refresh_surface_stress ocean_seam_refresh_surface_stress proc~ocean_seam_refresh_surface_stress->proc~ocean_fold_wrap_stress proc~rdb_ocean_set_bathymetry rdb_ocean_set_bathymetry proc~rdb_ocean_set_bathymetry->proc~ocean_fold_wrap_eta_2d proc~refresh_tracer_ghosts refresh_tracer_ghosts proc~refresh_tracer_ghosts->proc~ocean_fold_wrap_centre_3d_state proc~run_continuity_chain run_continuity_chain proc~run_continuity_chain->proc~ocean_fold_wrap_state proc~run_continuity_chain->proc~continuity_tracer_step_split proc~run_continuity_chain->proc~refresh_tracer_ghosts proc~run_gm_step run_gm_step proc~run_gm_step->proc~ocean_fold_wrap_state proc~run_gm_step->proc~continuity_gm_apply proc~run_stage_split run_stage_split proc~run_stage_split->proc~ocean_fold_wrap_state proc~run_stage_split->proc~ocean_fold_wrap_time_means proc~run_stage_split->proc~barotropic_substep_nonlinear_interior proc~run_stage_split->proc~bt_wide_substep proc~run_stage_split->proc~refresh_tracer_ghosts proc~run_stage_split->proc~run_continuity_chain proc~visc_rem_precompute visc_rem_precompute proc~run_stage_split->proc~visc_rem_precompute proc~vmix_apply_in_stage vmix_apply_in_stage proc~run_stage_split->proc~vmix_apply_in_stage proc~visc_rem_halo_refresh visc_rem_halo_refresh proc~visc_rem_halo_refresh->proc~ocean_fold_wrap_visc_rem proc~complete_ocean_create complete_ocean_create proc~complete_ocean_create->proc~engine_setup proc~configure_ocean_forcing->proc~ocean_seam_refresh_surface_stress proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_setup proc~engine_step_ice engine_step_ice proc~driver_run_ocean->proc~engine_step_ice proc~engine_step engine_step proc~driver_run_ocean->proc~engine_step proc~driver_validate driver_validate proc~driver_validate->proc~engine_setup proc~engine_step_ice->proc~ocean_halo_exchange_ice_fluxes proc~engine_step_ice->proc~ocean_halo_exchange_ice_state proc~ice_ocean_stress_flux ice_ocean_stress_flux proc~engine_step_ice->proc~ice_ocean_stress_flux proc~ice_transport_step ice_transport_step proc~engine_step_ice->proc~ice_transport_step proc~ice_ocean_stress_flux->proc~ocean_seam_refresh_surface_stress proc~ice_transport_step->proc~ocean_halo_exchange_ice_transport proc~ocean_data_forcing_apply ocean_data_forcing_apply proc~ocean_data_forcing_apply->proc~ocean_seam_refresh_surface_stress proc~ocean_data_forcing_configure->proc~ocean_seam_refresh_surface_stress proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~run_gm_step proc~ocean_dyn_step_split->proc~run_stage_split proc~run_stage run_stage proc~run_stage->proc~continuity_tracer_step_split proc~run_stage->proc~vmix_apply_in_stage proc~visc_rem_precompute->proc~visc_rem_halo_refresh proc~vmix_apply_in_stage->proc~visc_rem_halo_refresh proc~vmix_apply_in_stage->proc~visc_rem_precompute proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean proc~engine_step->proc~ocean_data_forcing_apply proc~engine_step->proc~ocean_dyn_step_split proc~ocean_dyn_step ocean_dyn_step proc~engine_step->proc~ocean_dyn_step proc~ocean_dyn_step->proc~run_stage proc~rdb_ocean_create_finalize rdb_ocean_create_finalize proc~rdb_ocean_create_finalize->proc~complete_ocean_create proc~rdb_ocean_create_from_string rdb_ocean_create_from_string proc~rdb_ocean_create_from_string->proc~complete_ocean_create proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step_ice proc~rdb_ocean_step->proc~engine_step

Variables

Type Visibility Attributes Name Initial
type(comm_t), private :: comm
integer, private :: i
integer, private :: n_r
integer, private :: n_s
integer, private :: nreq
integer, private :: o
logical, private :: on_device
integer, private :: p

Source Code

   subroutine ocean_fold_exchange(device_resident)
      !! Move every packed message: one isend + irecv per non-self peer
      !! with a non-empty message, the self pair as a local copy, then
      !! `waitall`.  Collective over the north rank row.
      logical, intent(in), optional :: device_resident
         !! `.false.` ⇒ host buffers; default device-resident.

      integer :: p, n_s, n_r, o, nreq, i
      logical :: on_device
      type(comm_t) :: comm

      if (.not. fx_active) return
      if (.not. fx_open .or. fx_sent) then
         error stop "rdb_ocean_fold_exchange: ocean_fold_exchange outside an open, unsent group"
      end if
      on_device = .true.
      if (present(device_resident)) on_device = device_resident
      comm = comm_env_compute_comm()

      nreq = 0
      do p = 1, fx_npeer
         n_s = fx_poff(FOLD_FAM_T)*fx_sn(p, FOLD_FAM_T) + fx_poff(FOLD_FAM_U)*fx_sn(p, FOLD_FAM_U)
         n_r = fx_poff(FOLD_FAM_T)*fx_rn(p, FOLD_FAM_T) + fx_poff(FOLD_FAM_U)*fx_rn(p, FOLD_FAM_U)
         o = (p - 1)*fx_cap
         if (p == fx_self) then
            ! Self pair: the receive region is the send region (same list).
            if (on_device) then
               !$acc parallel loop present(fx_sbuf, fx_rbuf)
               do i = o + 1, o + n_s
                  fx_rbuf(i) = fx_sbuf(i)
               end do
            else
               fx_rbuf(o + 1:o + n_s) = fx_sbuf(o + 1:o + n_s)
            end if
            cycle
         end if
         if (on_device) then
            !$acc host_data use_device(fx_sbuf, fx_rbuf)
            if (n_r > 0) then
               nreq = nreq + 1
               call FOLD_IRECV_N(comm, fx_rbuf(o + 1:o + n_r), n_r, fx_peer_rank(p), &
                                 TAG_OC_FOLD, fx_reqs(nreq))
            end if
            if (n_s > 0) then
               nreq = nreq + 1
               call FOLD_ISEND_N(comm, fx_sbuf(o + 1:o + n_s), n_s, fx_peer_rank(p), &
                                 TAG_OC_FOLD, fx_reqs(nreq))
            end if
            !$acc end host_data
         else
            if (n_r > 0) then
               nreq = nreq + 1
               call FOLD_IRECV_N(comm, fx_rbuf(o + 1:o + n_r), n_r, fx_peer_rank(p), &
                                 TAG_OC_FOLD, fx_reqs(nreq))
            end if
            if (n_s > 0) then
               nreq = nreq + 1
               call FOLD_ISEND_N(comm, fx_sbuf(o + 1:o + n_s), n_s, fx_peer_rank(p), &
                                 TAG_OC_FOLD, fx_reqs(nreq))
            end if
         end if
      end do
      if (nreq > 0) call waitall(fx_reqs(1:nreq), fx_stats(1:nreq))
      fx_sent = .true.
   end subroutine ocean_fold_exchange