ocean_fold_exchange_init Subroutine

public subroutine ocean_fold_exchange_init(decomp, nghost, north_fold, ierr)

Record the topology and, on a north-row rank of an east-west split folded grid, build the routing plan and map it to the device. Every rank may call it (it is not collective); a rank that does not fold, or a px = 1 run, keeps the exchange inactive.

Arguments

Type IntentOptional Attributes Name
type(decomp_t), intent(in) :: decomp

Domain decomposition.
integer, intent(in) :: nghost

Ghost width.
logical, intent(in) :: north_fold

This rank folds its north edge (bc%north_fold, rank-local).
integer, intent(out), optional :: ierr

OCEAN_STATUS_ERR_SETUP when the plan cannot be built (more tiles than fold-row columns); absent ⇒ error stop.

Calls

proc~~ocean_fold_exchange_init~~CallsGraph proc~ocean_fold_exchange_init ocean_fold_exchange_init proc~decomp_rank_from_coords decomp_rank_from_coords proc~ocean_fold_exchange_init->proc~decomp_rank_from_coords proc~fail fail proc~ocean_fold_exchange_init->proc~fail proc~fold_plan_build fold_plan_build proc~ocean_fold_exchange_init->proc~fold_plan_build proc~grow_buffers grow_buffers proc~ocean_fold_exchange_init->proc~grow_buffers proc~ocean_fold_exchange_destroy ocean_fold_exchange_destroy proc~ocean_fold_exchange_init->proc~ocean_fold_exchange_destroy to_string to_string proc~ocean_fold_exchange_init->to_string error error proc~fail->error proc~error_ring_push error_ring_push proc~fail->proc~error_ring_push proc~fold_receiver_entries fold_receiver_entries proc~fold_plan_build->proc~fold_receiver_entries proc~fold_tile_extent fold_tile_extent proc~fold_plan_build->proc~fold_tile_extent proc~fold_plan_destroy fold_plan_t%fold_plan_destroy proc~ocean_fold_exchange_destroy->proc~fold_plan_destroy proc~fold_receiver_entries->proc~fold_tile_extent proc~fold_tile_owner fold_tile_owner proc~fold_receiver_entries->proc~fold_tile_owner

Called by

proc~~ocean_fold_exchange_init~~CalledByGraph proc~ocean_fold_exchange_init ocean_fold_exchange_init proc~engine_setup engine_setup proc~engine_setup->proc~ocean_fold_exchange_init proc~complete_ocean_create complete_ocean_create proc~complete_ocean_create->proc~engine_setup proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_setup proc~driver_validate driver_validate proc~driver_validate->proc~engine_setup proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean 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

Variables

Type Visibility Attributes Name Initial
integer, private :: f
integer, private :: p
integer, private :: status

Source Code

   subroutine ocean_fold_exchange_init(decomp, nghost, north_fold, ierr)
      !! Record the topology and, on a north-row rank of an east-west split
      !! folded grid, build the routing plan and map it to the device.
      !! Every rank may call it (it is not collective); a rank that does
      !! not fold, or a `px = 1` run, keeps the exchange inactive.
      type(decomp_t), intent(in) :: decomp
         !! Domain decomposition.
      integer, intent(in) :: nghost
         !! Ghost width.
      logical, intent(in) :: north_fold
         !! This rank folds its north edge (`bc%north_fold`, rank-local).
      integer, intent(out), optional :: ierr
         !! `OCEAN_STATUS_ERR_SETUP` when the plan cannot be built (more
         !! tiles than fold-row columns); absent ⇒ `error stop`.

      integer :: status, p, f

      if (present(ierr)) ierr = OCEAN_STATUS_OK
      if (fx_initialised) call ocean_fold_exchange_destroy()

      fx_ng = nghost
      fx_nxl = decomp%nx_local
      fx_nyl = decomp%ny_local
      fx_px = decomp%px
      fx_ry = decomp%ry
      fx_active = north_fold .and. decomp%px > 1
      fx_initialised = .true.
      if (.not. fx_active) return

      call fold_plan_build(fx_plan, decomp%nx_global, decomp%px, nghost, decomp%rx, status)
      if (status /= FOLD_PLAN_OK) then
         call fail("ocean_fold_exchange_init: cannot build the fold plan for nx = "// &
                   to_string(decomp%nx_global)//", px = "//to_string(decomp%px)// &
                   ", nghost = "//to_string(nghost)//" (need nx >= px, nghost >= 1).", &
                   ierr, OCEAN_STATUS_ERR_SETUP)
         fx_active = .false.
         return
      end if

      fx_npeer = fx_plan%npeer
      fx_self = fx_plan%self_peer
      fx_nmax = max(fx_plan%nmax, 1)
      allocate (fx_peer_rank(fx_npeer))
      do p = 1, fx_npeer
         fx_peer_rank(p) = decomp_rank_from_coords(decomp%px, fx_plan%peer_rx(p), decomp%ry)
      end do
      allocate (fx_sn(fx_npeer, FOLD_NFAM), fx_rn(fx_npeer, FOLD_NFAM))
      fx_sn = fx_plan%send_n
      fx_rn = fx_plan%recv_n
      do f = 1, FOLD_NFAM
         fx_ns(f) = fx_plan%nsend(f)
         fx_nr(f) = fx_plan%nrecv(f)
         fx_s0(f) = 0
         fx_r0(f) = 0
         if (fx_npeer > 0) then
            fx_s0(f) = fx_plan%send_start(1, f)
            fx_r0(f) = fx_plan%recv_start(1, f)
         end if
      end do
      fx_scol = fx_plan%send_col
      fx_speer = fx_plan%send_peer
      fx_se = fx_plan%send_e
      fx_rcol = fx_plan%recv_col
      fx_rpeer = fx_plan%recv_peer
      fx_re = fx_plan%recv_e
      fx_rcls = fx_plan%recv_cls
      allocate (fx_reqs(2*max(fx_npeer, 1)), fx_stats(2*max(fx_npeer, 1)))
      !$acc enter data copyin(fx_sn, fx_rn, fx_scol, fx_speer, fx_se, &
      !$acc&                  fx_rcol, fx_rpeer, fx_re, fx_rcls)

      ! Base capacity: one field of the widest stagger, one layer.
      call grow_buffers(fx_ng + 1)
   end subroutine ocean_fold_exchange_init