comin_descrdata.F90

Go to the documentation of this file.

!> @file comin_descrdata.F90
!! @brief Accessor functions for ComIn descriptive data structures.
!
!  @authors 10/2021 :: ICON Community Interface  <comin@icon-model.org>
!
!  SPDX-License-Identifier: BSD-3-Clause
!
!  See LICENSES for license information.
!  Where software is supplied by third parties, it is indicated in the
!  headers of the routines.
!
MODULE comin_descrdata
 
  use, INTRINSIC :: iso_c_binding, only: c_int, c_ptr, c_loc, c_null_char, c_loc, c_signed_char
  USE comin_setup_constants, ONLY: wp
  USE comin_state,           ONLY: state
  USE comin_descrdata_types, ONLY: t_comin_descrdata_global_data,       &
    &                              t_comin_descrdata_domain_data,       &
    &                              t_comin_descrdata_simulation_interval
  USE comin_errhandler,      ONLY: comin_error_set
  USE comin_c_utils,         ONLY: convert_c_string
  USE comin_errhandler_types, ONLY: comin_error_index_out_of_bounds
 
  IMPLICIT NONE
 
  PRIVATE
 
  PUBLIC :: comin_descrdata_set_global
  PUBLIC :: comin_descrdata_set_domain
  PUBLIC :: comin_descrdata_set_simulation_interval, comin_descrdata_get_simulation_interval
  PUBLIC :: comin_descrdata_finalize
  PUBLIC :: comin_descrdata_get_index, comin_descrdata_get_block
  PUBLIC :: comin_descrdata_get_cell_block_limits, comin_descrdata_get_cell_indices
  PUBLIC :: comin_descrdata_get_edge_block_limits, comin_descrdata_get_edge_indices
  PUBLIC :: comin_descrdata_get_vert_block_limits, comin_descrdata_get_vert_indices
  PUBLIC :: comin_descrdata_get_cell_npromz, comin_descrdata_get_edge_npromz, comin_descrdata_get_vert_npromz
  PUBLIC :: comin_descrdata_index_lookup_glb2loc_cell
  PUBLIC :: comin_descrdata_index_lookup_glb2loc_edge
  PUBLIC :: comin_descrdata_index_lookup_glb2loc_vert
  PUBLIC :: comin_current_get_datetime
  PUBLIC :: comin_current_set_datetime
  PUBLIC :: comin_descrdata_set_timesteplength, comin_descrdata_get_timesteplength
 
  PUBLIC :: comin_descrdata_to_c
 
#include "comin_global.inc"
 
  INTERFACE is_in_bounds
    MODULE PROCEDURE is_in_bounds_int
    MODULE PROCEDURE is_in_bounds_ddd
  END INTERFACE is_in_bounds
 
  INTERFACE comin_descrdata_to_c
    MODULE PROCEDURE comin_descrdata_to_c_signed_char_1
    MODULE PROCEDURE comin_descrdata_to_c_string
    MODULE PROCEDURE comin_descrdata_to_c_int_1
    MODULE PROCEDURE comin_descrdata_to_c_int_2
    MODULE PROCEDURE comin_descrdata_to_c_int_3
    MODULE PROCEDURE comin_descrdata_to_c_real_1
    MODULE PROCEDURE comin_descrdata_to_c_real_2
    MODULE PROCEDURE comin_descrdata_to_c_real_3
    MODULE PROCEDURE comin_descrdata_to_c_real_4
  END INTERFACE comin_descrdata_to_c
 
  INTERFACE
    SUBROUTINE comin_current_set_datetime_c(datetime_c) BIND(C, NAME="comin_current_set_datetime")
      USE iso_c_binding, ONLY: c_char
      CHARACTER(kind=c_char), DIMENSION(*), INTENT(IN) :: datetime_c
    END SUBROUTINE comin_current_set_datetime_c
 
    FUNCTION comin_current_get_datetime_c() &
         & result(datetime) &
         & BIND(C, NAME="comin_current_get_datetime")
      USE iso_c_binding, ONLY: c_ptr
      TYPE(C_PTR) :: datetime
    END FUNCTION comin_current_get_datetime_c
 
    !> Conversion of global cell index to MPI-process local index.
    !! @ingroup fortran_interface
    INTEGER(C_INT) FUNCTION comin_descrdata_index_lookup_glb2loc_cell(jg, global_idx) &
      & result(loc) BIND(C)
      IMPORT :: c_int
      INTEGER(kind=C_INT), INTENT(IN), VALUE :: jg          !< domain index
      INTEGER(kind=C_INT), INTENT(IN), VALUE :: global_idx  !< global cell index
    END FUNCTION comin_descrdata_index_lookup_glb2loc_cell
 
    !> Conversion of global edge index to MPI-process local index.
    !! @ingroup fortran_interface
    INTEGER(C_INT) FUNCTION comin_descrdata_index_lookup_glb2loc_edge(jg, global_idx) &
      & result(loc) BIND(C)
      IMPORT :: c_int
      INTEGER(kind=C_INT), INTENT(IN), VALUE :: jg          !< domain index
      INTEGER(kind=C_INT), INTENT(IN), VALUE :: global_idx  !< global edge index
    END FUNCTION comin_descrdata_index_lookup_glb2loc_edge
 
    !> Conversion of global vert index to MPI-process local index.
    !! @ingroup fortran_interface
    INTEGER(C_INT) FUNCTION comin_descrdata_index_lookup_glb2loc_vert(jg, global_idx) &
      & result(loc) BIND(C)
      IMPORT :: c_int
      INTEGER(kind=C_INT), INTENT(IN), VALUE :: jg          !< domain index
      INTEGER(kind=C_INT), INTENT(IN), VALUE :: global_idx  !< global vert index
    END FUNCTION comin_descrdata_index_lookup_glb2loc_vert
 
    TYPE(c_ptr) function comin_descrdata_get_simulation_interval_exp_start() &
         & RESULT(exp_start) &
         & BIND(C)
      use, INTRINSIC :: iso_c_binding, only: c_ptr
    END FUNCTION comin_descrdata_get_simulation_interval_exp_start
 
    TYPE(c_ptr) function comin_descrdata_get_simulation_interval_exp_stop() &
         & RESULT(exp_stop) &
         & BIND(C)
      use, INTRINSIC :: iso_c_binding, only: c_ptr
    END FUNCTION comin_descrdata_get_simulation_interval_exp_stop
 
    TYPE(c_ptr) function comin_descrdata_get_simulation_interval_run_start() &
         & RESULT(run_start) &
         & BIND(C)
      use, INTRINSIC :: iso_c_binding, only: c_ptr
    END FUNCTION comin_descrdata_get_simulation_interval_run_start
 
    TYPE(c_ptr) function comin_descrdata_get_simulation_interval_run_stop() &
         & RESULT(run_stop) &
         & BIND(C)
      use, INTRINSIC :: iso_c_binding, only: c_ptr
    END FUNCTION comin_descrdata_get_simulation_interval_run_stop
 
    !> Receive pointer on array storing timestep information for all domains
    !! @ingroup fortran_interface
    FUNCTION comin_descrdata_get_timesteplength(jg) BIND(C)
      use, INTRINSIC :: iso_c_binding, only: c_double, c_int
      REAL(c_double) :: comin_descrdata_get_timesteplength
      INTEGER(C_INT), INTENT(IN), VALUE :: jg
    END FUNCTION comin_descrdata_get_timesteplength
 
    !> Fill array with timestep.
    SUBROUTINE comin_descrdata_set_timesteplength(jg, dt_current) BIND(C)
      use, INTRINSIC :: iso_c_binding, only: c_int, c_double
      INTEGER(C_INT), INTENT(IN), VALUE  :: jg
      REAL(C_DOUBLE), INTENT(IN), VALUE  :: dt_current
    END SUBROUTINE comin_descrdata_set_timesteplength
 
    SUBROUTINE comin_state_set_simulation_interval(exp_start, exp_stop, run_start, run_stop) &
      BIND(C)
      use, INTRINSIC :: iso_c_binding, only: c_char
      CHARACTER(KIND=C_CHAR, LEN=1), DIMENSION(*), INTENT(IN) :: exp_start, exp_stop, run_start, run_stop
    END SUBROUTINE comin_state_set_simulation_interval
 
  END INTERFACE
 
CONTAINS
 
  !> Fill global data.
  SUBROUTINE comin_descrdata_set_global(comin_global_info)
    TYPE(t_comin_descrdata_global_data), INTENT(IN)  :: comin_global_info
    state%comin_descrdata_global_data = comin_global_info
  END SUBROUTINE comin_descrdata_set_global
 
  !> Set up data type for grid data.
  SUBROUTINE comin_descrdata_set_domain(comin_domain_info)
    TYPE(t_comin_descrdata_domain_data), INTENT(IN)  :: comin_domain_info(:)
    ALLOCATE(state%comin_descrdata_domain_data, source=comin_domain_info)
  END SUBROUTINE comin_descrdata_set_domain
 
  !> Fill time stamp info.
  SUBROUTINE comin_descrdata_set_simulation_interval(exp_start, exp_stop, run_start, run_stop)
    CHARACTER(LEN=*), INTENT(IN)  :: exp_start, exp_stop, run_start, run_stop
 
    CALL comin_state_set_simulation_interval( &
      trim(exp_start) // c_null_char, &
      trim(exp_stop) // c_null_char, &
      trim(run_start) // c_null_char, &
      trim(run_stop) // c_null_char)
  END SUBROUTINE comin_descrdata_set_simulation_interval
 
  !> Retrieve time stamp info, current time information
  !! @ingroup fortran_interface
  SUBROUTINE comin_current_get_datetime(sim_time_current)
    CHARACTER(LEN=:), ALLOCATABLE, INTENT(OUT) :: sim_time_current
    !
    TYPE(c_ptr) :: datetime_c
    datetime_c = comin_current_get_datetime_c()
    sim_time_current = convert_c_string(datetime_c)
  END SUBROUTINE comin_current_get_datetime
 
  !> Update time stamp info, current time information.
  SUBROUTINE comin_current_set_datetime(sim_time_current)
    CHARACTER(LEN=*),  INTENT(IN) :: sim_time_current
    CALL comin_current_set_datetime_c(trim(sim_time_current)//c_null_char)
  END SUBROUTINE comin_current_set_datetime
 
  !> request a pointer to simulation status
  !! @ingroup fortran_interface
  FUNCTION comin_descrdata_get_simulation_interval()
    TYPE(t_comin_descrdata_simulation_interval) :: comin_descrdata_get_simulation_interval
 
    comin_descrdata_get_simulation_interval%exp_start = &
      convert_c_string(comin_descrdata_get_simulation_interval_exp_start())
    comin_descrdata_get_simulation_interval%exp_stop = &
      convert_c_string(comin_descrdata_get_simulation_interval_exp_stop())
    comin_descrdata_get_simulation_interval%run_start = &
      convert_c_string(comin_descrdata_get_simulation_interval_run_start())
    comin_descrdata_get_simulation_interval%run_stop = &
      convert_c_string(comin_descrdata_get_simulation_interval_run_stop())
  END FUNCTION comin_descrdata_get_simulation_interval
 
  !> Clean descriptive data structure in ComIn
  !> currently no content but keep for future use
  SUBROUTINE comin_descrdata_finalize()
 
  END SUBROUTINE comin_descrdata_finalize
 
  !!
  !> auxiliary functions taken from ICON, version 2.6.5
  !!
 
  !> from mo_parallel_config
  !> names of routines in ICON are: blk_no, idx_no
  !-------------------------------------------------------------------------
  ! The following two functions are for conversion of 1D to 2D indices and vice versa
  !
  ! Treatment of 0 (important for empty domains) and negative numbers:
  !
  ! Converting 1D => 2D:
  !
  ! 0 always is mapped to blk_no = 1, idx_no = 0
  ! negative numbers: Convert usings ABS(j) and negate idx_no
  !
  ! Thus: blk_no >= 1 always!
  !       idx_no > 0  for j > 0
  !       idx_no = 0  for j = 0
  !       idx_no < 0  for j < 0
  !
  ! This mimics mostly the behaviour of reshape_idx in mo_model_domimp_patches
  ! with a difference for nproma=1 and j=0 (where reshape_idx returns blk_no=0, idx_no=1)
  !
  ! The consistent treatment of 0 in the above way is very important for empty domains
  ! where start_index=1, end_index=0
  !
  ! Converting 2D => 1D:
  ! Trying to invert the above and catching cases with blk_no < 1
  !-------------------------------------------------------------------------
 
  !> Auxiliary function: conversion of 1D to 2D indices.
  !! @ingroup fortran_interface
  INTEGER(c_int) FUNCTION comin_descrdata_get_block(idx1D) BIND(C, name="comin_descrdata_get_block")
    INTEGER(c_int), INTENT(IN), VALUE :: idx1d
    ! i.e. also 1 for idx1D=0, nproma=1
    comin_descrdata_get_block = max((abs(idx1d)-1)/state%comin_descrdata_global_data%nproma + 1, 1)
  END FUNCTION comin_descrdata_get_block
 
  !> Auxiliary function: conversion of 1D to 2D indices.
  !! @ingroup fortran_interface
  INTEGER(c_int) FUNCTION comin_descrdata_get_index(idx1D) BIND(C, name="comin_descrdata_get_index")
    INTEGER(c_int), INTENT(IN), VALUE :: idx1d
    IF(idx1d==0) THEN
      comin_descrdata_get_index = 0
    ELSE
      comin_descrdata_get_index = sign(mod(abs(idx1d)-1,state%comin_descrdata_global_data%nproma)+1, idx1d)
    ENDIF
  END FUNCTION comin_descrdata_get_index
 
  !> Computes the start and end block indices for loops over cell-based variables.
  !! @ingroup fortran_interface
  !!
  SUBROUTINE comin_descrdata_get_cell_block_limits(jg, irl_start, irl_end, i_startblk, i_endblk) &
    & BIND(C, NAME="comin_descrdata_get_cell_block_limits")
 
    INTEGER(c_int), INTENT(IN), VALUE :: jg !< Patch index for comin_domain.
    INTEGER(c_int), INTENT(IN), VALUE :: irl_start !< `refin_ctrl` start block level.
    INTEGER(c_int), INTENT(IN), VALUE :: irl_end !< `refin_ctrl` end block level.
 
    INTEGER(c_int), INTENT(OUT) :: i_startblk !< Start index (jb loop)
    INTEGER(c_int), INTENT(OUT) :: i_endblk !< End index (jb loop)
 
    IF (is_in_bounds(jg, state%comin_descrdata_domain_data)) THEN
      IF ( &
        & is_in_bounds(irl_start, state%comin_descrdata_domain_data(jg)%cells%start_block) .AND. &
        & is_in_bounds(irl_end, state%comin_descrdata_domain_data(jg)%cells%end_block)) THEN
 
        i_startblk = state%comin_descrdata_domain_data(jg)%cells%start_block(irl_start)
        i_endblk = state%comin_descrdata_domain_data(jg)%cells%end_block(irl_end)
 
      ELSE
        i_startblk = 1
        i_endblk = 0
        CALL comin_error_set(comin_error_index_out_of_bounds)
      END IF
    ELSE
      i_startblk = 1
      i_endblk = 0
      CALL comin_error_set(comin_error_index_out_of_bounds)
    END IF
 
  END SUBROUTINE comin_descrdata_get_cell_block_limits
 
  !> Computes the start and end indices of do loops for cell-based variables.
  !! @ingroup fortran_interface
  !!
  !! From ICON's `mo_loopindices`; name of corresponding ICON routine: `get_indices_c`.
  !!
  SUBROUTINE comin_descrdata_get_cell_indices(jg, i_blk, i_startblk, i_endblk, i_startidx, &
       i_endidx, irl_start, irl_end) &
    &  BIND(C, NAME="comin_descrdata_get_cell_indices")
 
    INTEGER(c_int), INTENT(IN), VALUE :: jg         ! Patch index for comin_domain
    INTEGER(c_int), INTENT(IN), VALUE :: i_blk      ! Current block (variable jb in do loops)
    INTEGER(c_int), INTENT(IN), VALUE :: i_startblk ! Start block of do loop
    INTEGER(c_int), INTENT(IN), VALUE :: i_endblk   ! End block of do loop
    INTEGER(c_int), INTENT(IN), VALUE :: irl_start  ! refin_ctrl level where do loop starts
    INTEGER(c_int), INTENT(IN), VALUE :: irl_end    ! refin_ctrl level where do loop ends
 
    INTEGER(c_int), INTENT(OUT) :: i_startidx, i_endidx ! Start and end indices (jc loop)
 
    IF (i_blk == i_startblk) THEN
      IF (is_in_bounds(jg, state%comin_descrdata_domain_data)) THEN
        IF (is_in_bounds(irl_start, state%comin_descrdata_domain_data(jg)%cells%start_block)) THEN
          i_startidx = max(1,state%comin_descrdata_domain_data(jg)%cells%start_index(irl_start))
          i_endidx   = state%comin_descrdata_global_data%nproma
        ELSE
          i_startidx = 1
          i_endidx = 0
          CALL comin_error_set(comin_error_index_out_of_bounds)
        END IF
 
        IF (i_blk == i_endblk) THEN
          IF (is_in_bounds(irl_end, state%comin_descrdata_domain_data(jg)%cells%end_block)) THEN
            i_endidx = state%comin_descrdata_domain_data(jg)%cells%end_index(irl_end)
          ELSE
            i_startidx = 1
            i_endidx = 0
            CALL comin_error_set(comin_error_index_out_of_bounds)
          END IF
        END IF
      ELSE
        i_startidx = 1
        i_endidx = 0
        CALL comin_error_set(comin_error_index_out_of_bounds)
      END IF
    ELSE IF (i_blk == i_endblk) THEN
      IF (is_in_bounds(jg, state%comin_descrdata_domain_data)) THEN
        IF (is_in_bounds(irl_end, state%comin_descrdata_domain_data(jg)%cells%end_block)) THEN
          i_startidx = 1
          i_endidx   = state%comin_descrdata_domain_data(jg)%cells%end_index(irl_end)
        ELSE
          i_startidx = 1
          i_endidx = 0
          CALL comin_error_set(comin_error_index_out_of_bounds)
        END IF
      ELSE
        i_startidx = 1
        i_endidx = 0
        CALL comin_error_set(comin_error_index_out_of_bounds)
      END IF
    ELSE
      i_startidx = 1
      i_endidx = state%comin_descrdata_global_data%nproma
    ENDIF
 
  END SUBROUTINE comin_descrdata_get_cell_indices
 
  !> Computes the start and end block indices for loops over edge-based variables.
  !! @ingroup fortran_interface
  !!
  SUBROUTINE comin_descrdata_get_edge_block_limits(jg, irl_start, irl_end, i_startblk, i_endblk) &
    & BIND(C, NAME="comin_descrdata_get_edge_block_limits")
 
    INTEGER(c_int), INTENT(IN), VALUE :: jg !< Patch index for comin_domain.
    INTEGER(c_int), INTENT(IN), VALUE :: irl_start !< `refin_ctrl` start block level.
    INTEGER(c_int), INTENT(IN), VALUE :: irl_end !< `refin_ctrl` end block level.
 
    INTEGER(c_int), INTENT(OUT) :: i_startblk !< Start index (jb loop)
    INTEGER(c_int), INTENT(OUT) :: i_endblk !< End index (jb loop)
 
    IF (is_in_bounds(jg, state%comin_descrdata_domain_data)) THEN
      IF ( &
        & is_in_bounds(irl_start, state%comin_descrdata_domain_data(jg)%edges%start_block) .AND. &
        & is_in_bounds(irl_end, state%comin_descrdata_domain_data(jg)%edges%end_block)) THEN
 
        i_startblk = state%comin_descrdata_domain_data(jg)%edges%start_block(irl_start)
        i_endblk = state%comin_descrdata_domain_data(jg)%edges%end_block(irl_end)
 
      ELSE
        i_startblk = 1
        i_endblk = 0
        CALL comin_error_set(comin_error_index_out_of_bounds)
      END IF
    ELSE
      i_startblk = 1
      i_endblk = 0
      CALL comin_error_set(comin_error_index_out_of_bounds)
    END IF
 
  END SUBROUTINE comin_descrdata_get_edge_block_limits
 
  !> Computes the start and end indices of do loops for edge-based variables.
  !! @ingroup fortran_interface
  !!
  !! From ICON's `mo_loopindices`; name of corresponding ICON routine: `get_indices_e`.
  !!
  SUBROUTINE comin_descrdata_get_edge_indices(jg, i_blk, i_startblk, i_endblk, i_startidx, &
       i_endidx, irl_start, irl_end) &
    &  BIND(C, NAME="comin_descrdata_get_edge_indices")
 
    INTEGER(c_int), INTENT(IN), VALUE :: jg         ! Patch index for comin_domain
    INTEGER(c_int), INTENT(IN), VALUE :: i_blk      ! Current block (variable jb in do loops)
    INTEGER(c_int), INTENT(IN), VALUE :: i_startblk ! Start block of do loop
    INTEGER(c_int), INTENT(IN), VALUE :: i_endblk   ! End block of do loop
    INTEGER(c_int), INTENT(IN), VALUE :: irl_start  ! refin_ctrl level where do loop starts
    INTEGER(c_int), INTENT(IN), VALUE :: irl_end    ! refin_ctrl level where do loop ends
 
    INTEGER(c_int), INTENT(OUT) :: i_startidx, i_endidx ! Start and end indices (jc loop)
 
    IF (i_blk == i_startblk) THEN
      IF (is_in_bounds(jg, state%comin_descrdata_domain_data)) THEN
        IF (is_in_bounds(irl_start, state%comin_descrdata_domain_data(jg)%edges%start_block)) THEN
          i_startidx = max(1,state%comin_descrdata_domain_data(jg)%edges%start_index(irl_start))
          i_endidx   = state%comin_descrdata_global_data%nproma
        ELSE
          i_startidx = 1
          i_endidx = 0
          CALL comin_error_set(comin_error_index_out_of_bounds)
        END IF
 
        IF (i_blk == i_endblk) THEN
          IF (is_in_bounds(irl_end, state%comin_descrdata_domain_data(jg)%edges%end_block)) THEN
            i_endidx = state%comin_descrdata_domain_data(jg)%edges%end_index(irl_end)
          ELSE
            i_startidx = 1
            i_endidx = 0
            CALL comin_error_set(comin_error_index_out_of_bounds)
          END IF
        END IF
      ELSE
        i_startidx = 1
        i_endidx = 0
        CALL comin_error_set(comin_error_index_out_of_bounds)
      END IF
    ELSE IF (i_blk == i_endblk) THEN
      IF (is_in_bounds(jg, state%comin_descrdata_domain_data)) THEN
        IF (is_in_bounds(irl_end, state%comin_descrdata_domain_data(jg)%edges%end_block)) THEN
          i_startidx = 1
          i_endidx   = state%comin_descrdata_domain_data(jg)%edges%end_index(irl_end)
        ELSE
          i_startidx = 1
          i_endidx = 0
          CALL comin_error_set(comin_error_index_out_of_bounds)
        END IF
      ELSE
        i_startidx = 1
        i_endidx = 0
        CALL comin_error_set(comin_error_index_out_of_bounds)
      END IF
    ELSE
      i_startidx = 1
      i_endidx = state%comin_descrdata_global_data%nproma
    ENDIF
 
  END SUBROUTINE comin_descrdata_get_edge_indices
 
  !> Computes the start and end block indices for loops over vertex-based variables.
  !! @ingroup fortran_interface
  !!
  SUBROUTINE comin_descrdata_get_vert_block_limits(jg, irl_start, irl_end, i_startblk, i_endblk) &
    & BIND(C, NAME="comin_descrdata_get_vert_block_limits")
 
    INTEGER(c_int), INTENT(IN), VALUE :: jg !< Patch index for comin_domain.
    INTEGER(c_int), INTENT(IN), VALUE :: irl_start !< `refin_ctrl` start block level.
    INTEGER(c_int), INTENT(IN), VALUE :: irl_end !< `refin_ctrl` end block level.
 
    INTEGER(c_int), INTENT(OUT) :: i_startblk !< Start index (jb loop)
    INTEGER(c_int), INTENT(OUT) :: i_endblk !< End index (jb loop)
 
    IF (is_in_bounds(jg, state%comin_descrdata_domain_data)) THEN
      IF ( &
        & is_in_bounds(irl_start, state%comin_descrdata_domain_data(jg)%verts%start_block) .AND. &
        & is_in_bounds(irl_end, state%comin_descrdata_domain_data(jg)%verts%end_block)) THEN
 
        i_startblk = state%comin_descrdata_domain_data(jg)%verts%start_block(irl_start)
        i_endblk = state%comin_descrdata_domain_data(jg)%verts%end_block(irl_end)
 
      ELSE
        i_startblk = 1
        i_endblk = 0
        CALL comin_error_set(comin_error_index_out_of_bounds)
      END IF
    ELSE
      i_startblk = 1
      i_endblk = 0
      CALL comin_error_set(comin_error_index_out_of_bounds)
    END IF
 
  END SUBROUTINE comin_descrdata_get_vert_block_limits
 
  !> Computes the start and end indices of do loops for vertex-based variables.
  !! @ingroup fortran_interface
  !!
  !! From ICON's `mo_loopindices`; name of corresponding ICON routine: `get_indices_v`.
  !!
  SUBROUTINE comin_descrdata_get_vert_indices(jg, i_blk, i_startblk, i_endblk, i_startidx, &
       i_endidx, irl_start, irl_end) &
    &  BIND(C, NAME="comin_descrdata_get_vert_indices")
 
    INTEGER(c_int), INTENT(IN), VALUE :: jg         ! Patch index for comin_domain
    INTEGER(c_int), INTENT(IN), VALUE :: i_blk      ! Current block (variable jb in do loops)
    INTEGER(c_int), INTENT(IN), VALUE :: i_startblk ! Start block of do loop
    INTEGER(c_int), INTENT(IN), VALUE :: i_endblk   ! End block of do loop
    INTEGER(c_int), INTENT(IN), VALUE :: irl_start  ! refin_ctrl level where do loop starts
    INTEGER(c_int), INTENT(IN), VALUE :: irl_end    ! refin_ctrl level where do loop ends
 
    INTEGER(c_int), INTENT(OUT) :: i_startidx, i_endidx ! Start and end indices (jc loop)
 
    IF (i_blk == i_startblk) THEN
      IF (is_in_bounds(jg, state%comin_descrdata_domain_data)) THEN
        IF (is_in_bounds(irl_start, state%comin_descrdata_domain_data(jg)%verts%start_block)) THEN
          i_startidx = max(1,state%comin_descrdata_domain_data(jg)%verts%start_index(irl_start))
          i_endidx   = state%comin_descrdata_global_data%nproma
        ELSE
          i_startidx = 1
          i_endidx = 0
          CALL comin_error_set(comin_error_index_out_of_bounds)
        END IF
 
        IF (i_blk == i_endblk) THEN
          IF (is_in_bounds(irl_end, state%comin_descrdata_domain_data(jg)%verts%end_block)) THEN
            i_endidx = state%comin_descrdata_domain_data(jg)%verts%end_index(irl_end)
          ELSE
            i_startidx = 1
            i_endidx = 0
            CALL comin_error_set(comin_error_index_out_of_bounds)
          END IF
        END IF
      ELSE
        i_startidx = 1
        i_endidx = 0
        CALL comin_error_set(comin_error_index_out_of_bounds)
      END IF
    ELSE IF (i_blk == i_endblk) THEN
      IF (is_in_bounds(jg, state%comin_descrdata_domain_data)) THEN
        IF (is_in_bounds(irl_end, state%comin_descrdata_domain_data(jg)%verts%end_block)) THEN
          i_startidx = 1
          i_endidx   = state%comin_descrdata_domain_data(jg)%verts%end_index(irl_end)
        ELSE
          i_startidx = 1
          i_endidx = 0
          CALL comin_error_set(comin_error_index_out_of_bounds)
        END IF
      ELSE
        i_startidx = 1
        i_endidx = 0
        CALL comin_error_set(comin_error_index_out_of_bounds)
      END IF
    ELSE
      i_startidx = 1
      i_endidx = state%comin_descrdata_global_data%nproma
    ENDIF
 
  END SUBROUTINE comin_descrdata_get_vert_indices
 
  !> Calculate `npromz` value for the blocking, needed for patch allocation.
  !> ... for the cells
  !! @ingroup fortran_interface
  !!
  !! NB: Avoid the case nblks=0 for empty patches, this might cause troubles
  !! if a empty patch is used somewhere (and npromz gets wrong in the formulas below).
  !!
  !! from `mo_setup_subdivision`; name of ICON routine: `npromz_c`.
  INTEGER(c_int) FUNCTION comin_descrdata_get_cell_npromz(jg) BIND(C)
    INTEGER(c_int),  INTENT(IN), VALUE  :: jg     ! domain index for comin_domain
 
    comin_descrdata_get_cell_npromz = state%comin_descrdata_domain_data(jg)%cells%ncells - &
             &  (state%comin_descrdata_domain_data(jg)%cells%nblks-1)*state%comin_descrdata_global_data%nproma
  END FUNCTION comin_descrdata_get_cell_npromz
 
  !> Calculate `npromz` value for the blocking, needed for patch allocation.
  !> ... for the edges
  !! @ingroup fortran_interface
  !!
  !! NB: Avoid the case nblks=0 for empty patches, this might cause troubles
  !! if a empty patch is used somewhere (and npromz gets wrong in the formulas below).
  !!
  !! from `mo_setup_subdivision`; name of ICON routine: `npromz_e`.
  INTEGER(c_int) FUNCTION comin_descrdata_get_edge_npromz(jg) BIND(C)
    INTEGER(c_int),  INTENT(IN), VALUE  :: jg     ! domain index for comin_domain
 
    comin_descrdata_get_edge_npromz = state%comin_descrdata_domain_data(jg)%edges%nedges - &
             &  (state%comin_descrdata_domain_data(jg)%edges%nblks-1)*state%comin_descrdata_global_data%nproma
  END FUNCTION comin_descrdata_get_edge_npromz
 
  !> Calculate `npromz` value for the blocking, needed for patch allocation.
  !> ... for the vertices
  !! @ingroup fortran_interface
  !!
  !! NB: Avoid the case nblks=0 for empty patches, this might cause troubles
  !! if a empty patch is used somewhere (and npromz gets wrong in the formulas below).
  !!
  !! from `mo_setup_subdivision`; name of ICON routine: `npromz_v`.
  INTEGER(c_int) FUNCTION comin_descrdata_get_vert_npromz(jg) BIND(C)
    INTEGER(c_int),  INTENT(IN), VALUE  :: jg     ! domain index for comin_domain
 
    comin_descrdata_get_vert_npromz = state%comin_descrdata_domain_data(jg)%verts%nverts - &
             &  (state%comin_descrdata_domain_data(jg)%verts%nblks-1)*state%comin_descrdata_global_data%nproma
  END FUNCTION comin_descrdata_get_vert_npromz
 
  !> Check if index is in bounds for an array pointer.
  !! @internal
  LOGICAL FUNCTION is_in_bounds_int(idx, arr) RESULT(is_in_bounds)
    INTEGER, INTENT(IN) :: idx !< Array index.
    INTEGER, POINTER, INTENT(IN) :: arr(:) !< Array. Must be a pointer to preserve bounds.
 
    is_in_bounds = lbound(arr, dim=1) <= idx .AND. idx <= ubound(arr, dim=1)
  END FUNCTION is_in_bounds_int
 
  !> Check if index is in bounds for an array pointer.
  !! @internal
  LOGICAL FUNCTION is_in_bounds_ddd(idx, arr) RESULT(is_in_bounds)
    INTEGER, INTENT(IN) :: idx !< Array index.
    TYPE(t_comin_descrdata_domain_data), ALLOCATABLE, INTENT(IN) :: arr(:)
    !^ Array. Must be a pointer/allocatable to preserve bounds.
 
    is_in_bounds = lbound(arr, dim=1) <= idx .AND. idx <= ubound(arr, dim=1)
  END FUNCTION is_in_bounds_ddd
 
  SUBROUTINE comin_descrdata_to_c_signed_char_1(arr, ptr, arr_size)
    INTEGER(c_signed_char), POINTER, INTENT(IN) :: arr(:)
    TYPE(c_ptr), INTENT(OUT) :: ptr
    INTEGER(C_INT), INTENT(OUT) :: arr_size(1)
 
    ptr = c_loc(arr)
    arr_size = shape(arr)
  END SUBROUTINE comin_descrdata_to_c_signed_char_1
 
  SUBROUTINE comin_descrdata_to_c_string(arr, ptr, arr_size)
    CHARACTER(LEN=:), POINTER, INTENT(IN) :: arr
    TYPE(c_ptr), INTENT(OUT) :: ptr
    INTEGER(C_INT), INTENT(OUT) :: arr_size(1)
 
    ptr = c_loc(arr)
    arr_size = len_trim(arr)
  END SUBROUTINE comin_descrdata_to_c_string
 
  SUBROUTINE comin_descrdata_to_c_int_1(arr, ptr, arr_size)
    INTEGER(C_INT), POINTER, INTENT(IN) :: arr(:)
    TYPE(c_ptr), INTENT(OUT) :: ptr
    INTEGER(C_INT), INTENT(OUT) :: arr_size(1)
 
    ptr = c_loc(arr)
    arr_size = shape(arr)
  END SUBROUTINE comin_descrdata_to_c_int_1
 
  SUBROUTINE comin_descrdata_to_c_int_2(arr, ptr, arr_size)
    INTEGER(C_INT), POINTER, INTENT(IN) :: arr(:,:)
    TYPE(c_ptr), INTENT(OUT) :: ptr
    INTEGER(C_INT), INTENT(OUT) :: arr_size(2)
 
    ptr = c_loc(arr)
    arr_size = shape(arr)
  END SUBROUTINE comin_descrdata_to_c_int_2
 
  SUBROUTINE comin_descrdata_to_c_int_3(arr, ptr, arr_size)
    INTEGER(C_INT), POINTER, INTENT(IN) :: arr(:,:,:)
    TYPE(c_ptr), INTENT(OUT) :: ptr
    INTEGER(C_INT), INTENT(OUT) :: arr_size(3)
 
    ptr = c_loc(arr)
    arr_size = shape(arr)
  END SUBROUTINE comin_descrdata_to_c_int_3
 
  SUBROUTINE comin_descrdata_to_c_real_1(arr, ptr, arr_size)
    REAL(wp), POINTER, INTENT(IN) :: arr(:)
    TYPE(c_ptr), INTENT(OUT) :: ptr
    INTEGER(C_INT), INTENT(OUT) :: arr_size(1)
 
    ptr = c_loc(arr)
    arr_size = shape(arr)
  END SUBROUTINE comin_descrdata_to_c_real_1
 
  SUBROUTINE comin_descrdata_to_c_real_2(arr, ptr, arr_size)
    REAL(wp), POINTER, INTENT(IN) :: arr(:,:)
    TYPE(c_ptr), INTENT(OUT) :: ptr
    INTEGER(C_INT), INTENT(OUT) :: arr_size(2)
 
    ptr = c_loc(arr)
    arr_size = shape(arr)
  END SUBROUTINE comin_descrdata_to_c_real_2
 
  SUBROUTINE comin_descrdata_to_c_real_3(arr, ptr, arr_size)
    REAL(wp), POINTER, INTENT(IN) :: arr(:,:,:)
    TYPE(c_ptr), INTENT(OUT) :: ptr
    INTEGER(C_INT), INTENT(OUT) :: arr_size(3)
 
    ptr = c_loc(arr)
    arr_size = shape(arr)
  END SUBROUTINE comin_descrdata_to_c_real_3
 
  SUBROUTINE comin_descrdata_to_c_real_4(arr, ptr, arr_size)
    REAL(wp), POINTER, INTENT(IN) :: arr(:,:,:,:)
    TYPE(c_ptr), INTENT(OUT) :: ptr
    INTEGER(C_INT), INTENT(OUT) :: arr_size(4)
 
    ptr = c_loc(arr)
    arr_size = shape(arr)
  END SUBROUTINE comin_descrdata_to_c_real_4
 
END MODULE comin_descrdata