rdb_ocean_set_h Function

public function rdb_ocean_set_h(c_handle, h_data, nx_p, ny_p, nz_p) result(status) bind(c, name="rdb_ocean_set_h")

Overwrite h_layer on the physical interior (k=1 bed .. k=nz surface), narrow-push it, then recompute rho_layer from the new thickness against whatever T/S currently sit on device (pulling the recomputed density back to host so the host stays authoritative). No other prognostic slot is touched.

Arguments

Type IntentOptional Attributes Name
type(c_ptr), intent(in), value :: c_handle
real(kind=c_double), intent(in) :: h_data(nx_p,ny_p,nz_p)
integer(kind=c_int), intent(in), value :: nx_p
integer(kind=c_int), intent(in), value :: ny_p
integer(kind=c_int), intent(in), value :: nz_p

Return Value integer(kind=c_int)


Calls

proc~~rdb_ocean_set_h~~CallsGraph proc~rdb_ocean_set_h rdb_ocean_set_h proc~fail fail proc~rdb_ocean_set_h->proc~fail proc~ocean_eos_compute ocean_eos_compute proc~rdb_ocean_set_h->proc~ocean_eos_compute proc~resolve_ocean resolve_ocean proc~rdb_ocean_set_h->proc~resolve_ocean proc~shape_matches_interior shape_matches_interior proc~rdb_ocean_set_h->proc~shape_matches_interior error error proc~fail->error proc~error_ring_push error_ring_push proc~fail->proc~error_ring_push proc~eos_compute_arrays eos_compute_arrays proc~ocean_eos_compute->proc~eos_compute_arrays proc~handle_check handle_check proc~resolve_ocean->proc~handle_check proc~eos_linear_impl eos_linear_impl proc~eos_compute_arrays->proc~eos_linear_impl proc~eos_roquet_spv_impl eos_roquet_spv_impl proc~eos_compute_arrays->proc~eos_roquet_spv_impl proc~eos_wright_impl eos_wright_impl proc~eos_compute_arrays->proc~eos_wright_impl local local proc~eos_linear_impl->local proc~eos_roquet_spv_impl->local proc~roquet_spv_value roquet_spv_value proc~eos_roquet_spv_impl->proc~roquet_spv_value proc~eos_wright_impl->local rdb_roq_spv_p rdb_roq_spv_p proc~roquet_spv_value->rdb_roq_spv_p rdb_roq_ts_coeffs rdb_roq_ts_coeffs proc~roquet_spv_value->rdb_roq_ts_coeffs

Variables

Type Visibility Attributes Name Initial
type(ocean_handle_t), private, pointer :: h
integer, private :: i
integer, private :: ierr_local
integer, private :: j
integer, private :: k
integer, private :: ng

Source Code

   function rdb_ocean_set_h(c_handle, h_data, nx_p, ny_p, nz_p) result(status) &
      bind(c, name="rdb_ocean_set_h")
      !! Overwrite `h_layer` on the physical interior (k=1 bed .. k=nz
      !! surface), narrow-push it, then recompute `rho_layer` from the new
      !! thickness against whatever T/S currently sit on device (pulling
      !! the recomputed density back to host so the host stays
      !! authoritative). No other prognostic slot is touched.
      type(c_ptr), intent(in), value :: c_handle
      integer(c_int), intent(in), value :: nx_p, ny_p, nz_p
      real(c_double), intent(in) :: h_data(nx_p, ny_p, nz_p)
      integer(c_int) :: status

      type(ocean_handle_t), pointer :: h
      integer :: ng, i, j, k, ierr_local

      status = resolve_ocean(c_handle, h)
      if (status /= OCEAN_STATUS_OK) return
      if (.not. shape_matches_interior(h, nx_p, ny_p, nz_p)) then
         call fail("rdb_ocean_set_h: shape mismatch against the physical interior", &
                   ierr_local, OCEAN_STATUS_ERR_BAD_SHAPE)
         status = int(ierr_local, c_int)
         return
      end if

      ng = h%grid%nghost
      associate (hl => h%state%multilayer%h_layer)
         do k = 1, nz_p
            do j = 1, ny_p
               do i = 1, nx_p
                  hl(ng + i, ng + j, k) = real(h_data(i, j, k), wp)
               end do
            end do
         end do
         !$acc update device(hl)
      end associate
      call ocean_eos_compute(h%state%eos, h%state%multilayer)
      associate (rl => h%state%multilayer%rho_layer)
         !$acc update self(rl)
      end associate
      status = int(OCEAN_STATUS_OK, c_int)
   end function rdb_ocean_set_h