rdb_ocean_get_diagnostic_ptr Function

public function rdb_ocean_get_diagnostic_ptr(c_handle, name, name_len, ptr, nx, ny, nz, gen) result(status) bind(c, name="rdb_ocean_get_diagnostic_ptr")

Raw output_buffer for the diagnostic named name (LAYER vgrid: (nx_total, ny_total, nz_ml) for a layered var, (nx_total, ny_total, 1) for a 2D var; a non-LAYER output_vgrid reports the remapped shape, e.g. nz z-levels). OCEAN_STATUS_ERR_NOT_FOUND if name is not currently REGISTERED on this instance (it may still be a legal name on one of the two static catalogs, just gated off or not selected — see rdb_ocean_get_diag_count/ rdb_ocean_list_diags to discover what IS registered).

Arguments

Type IntentOptional Attributes Name
type(c_ptr), intent(in), value :: c_handle
character(kind=c_char, len=1), intent(in) :: name(name_len)
integer(kind=c_int), intent(in), value :: name_len
type(c_ptr), intent(out) :: ptr
integer(kind=c_int), intent(out) :: nx
integer(kind=c_int), intent(out) :: ny
integer(kind=c_int), intent(out) :: nz
integer(kind=c_int), intent(out) :: gen

Return Value integer(kind=c_int)


Calls

proc~~rdb_ocean_get_diagnostic_ptr~~CallsGraph proc~rdb_ocean_get_diagnostic_ptr rdb_ocean_get_diagnostic_ptr proc~c_to_f_string c_to_f_string proc~rdb_ocean_get_diagnostic_ptr->proc~c_to_f_string proc~fail fail proc~rdb_ocean_get_diagnostic_ptr->proc~fail proc~resolve_ocean resolve_ocean proc~rdb_ocean_get_diagnostic_ptr->proc~resolve_ocean error error proc~fail->error proc~error_ring_push error_ring_push proc~fail->proc~error_ring_push proc~handle_check handle_check proc~resolve_ocean->proc~handle_check

Variables

Type Visibility Attributes Name Initial
character(len=:), private, allocatable :: fname
integer, private :: found
type(ocean_handle_t), private, pointer :: h
integer, private :: ierr_local
integer, private :: iv
real(kind=wp), private, pointer :: tmp(:,:,:)

Source Code

   function rdb_ocean_get_diagnostic_ptr(c_handle, name, name_len, ptr, &
                                         nx, ny, nz, gen) result(status) &
      bind(c, name="rdb_ocean_get_diagnostic_ptr")
      !! Raw `output_buffer` for the diagnostic named `name` (LAYER vgrid:
      !! `(nx_total, ny_total, nz_ml)` for a layered var, `(nx_total,
      !! ny_total, 1)` for a 2D var; a non-LAYER `output_vgrid` reports
      !! the remapped shape, e.g. `nz` z-levels). `OCEAN_STATUS_ERR_NOT_FOUND`
      !! if `name` is not currently REGISTERED on this instance (it may
      !! still be a legal name on one of the two static catalogs, just
      !! gated off or not selected — see `rdb_ocean_get_diag_count`/
      !! `rdb_ocean_list_diags` to discover what IS registered).
      type(c_ptr), intent(in), value :: c_handle
      integer(c_int), intent(in), value :: name_len
      character(kind=c_char), intent(in) :: name(name_len)
      type(c_ptr), intent(out) :: ptr
      integer(c_int), intent(out) :: nx, ny, nz, gen
      integer(c_int) :: status

      type(ocean_handle_t), pointer :: h
      real(wp), pointer :: tmp(:, :, :)
      character(len=:), allocatable :: fname
      integer :: iv, found, ierr_local

      ptr = c_null_ptr
      nx = 0
      ny = 0
      nz = 0
      gen = 0
      status = resolve_ocean(c_handle, h)
      if (status /= OCEAN_STATUS_OK) return

      call c_to_f_string(name, name_len, fname)
      found = 0
      do iv = 1, h%state%diag%nvars
         if (trim(h%state%diag%vars(iv)%name) == fname) then
            found = iv
            exit
         end if
      end do
      if (found == 0) then
         call fail("rdb_ocean_get_diagnostic_ptr: no diagnostic named '"//fname// &
                   "' is currently registered (see rdb_ocean_list_diags)", &
                   ierr_local, OCEAN_STATUS_ERR_NOT_FOUND)
         status = int(ierr_local, c_int)
         return
      end if
      if (.not. allocated(h%state%diag%vars(found)%output_buffer)) then
         call fail("rdb_ocean_get_diagnostic_ptr: '"//fname// &
                   "' has no output_buffer allocated", ierr_local, OCEAN_STATUS_ERR_NOT_FOUND)
         status = int(ierr_local, c_int)
         return
      end if
      tmp => h%state%diag%vars(found)%output_buffer
      ptr = c_loc(tmp(1, 1, 1))
      nx = int(size(tmp, 1), c_int)
      ny = int(size(tmp, 2), c_int)
      nz = int(size(tmp, 3), c_int)
      gen = int(h%state%diag%vars(found)%fire_count, c_int)
   end function rdb_ocean_get_diagnostic_ptr