comin_state.F90

Go to the documentation of this file.

!> @file comin_state.F90
!! @brief Data shared between host and plugins.
!
!  @authors 10/2023 :: 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_state
 
  USE iso_c_binding,         ONLY:  c_bool, c_int, c_ptr, c_funptr, c_funloc
  USE comin_parallel_types,  ONLY:  t_comin_parallel_info
  USE comin_descrdata_types, ONLY:  t_comin_descrdata_global_data,       &
    &                               t_comin_descrdata_domain_data,       &
    &                               comin_glb2loc_index_lookup_fct
 
  IMPLICIT NONE
 
  PRIVATE
  PUBLIC :: comin_state_set_num_plugins
  PUBLIC :: comin_state_get_num_plugins
  PUBLIC :: comin_setup_set_verbosity_level
  PUBLIC :: comin_setup_get_verbosity_level
  PUBLIC :: comin_current_get_ep
  PUBLIC :: comin_current_get_domain_id
  PUBLIC :: comin_current_set_plugin_id
  PUBLIC :: comin_current_get_plugin_id
  PUBLIC :: comin_state_is_primary_done
  PUBLIC :: comin_state_set_primary_done
  PUBLIC :: comin_state_get_error_code
  PUBLIC :: comin_state_set_error_code
  PUBLIC :: comin_state_get_output_unit
  PUBLIC :: comin_state_set_output_unit
  PUBLIC :: comin_state_get_lstdout
  PUBLIC :: comin_state_set_lstdout
  PUBLIC :: comin_state_get_var_list
  PUBLIC :: comin_descrdata_set_fct_glb2loc_cell
  PUBLIC :: comin_descrdata_set_fct_glb2loc_edge
  PUBLIC :: comin_descrdata_set_fct_glb2loc_vert
  PUBLIC :: comin_state_set_host_errhandler_fct
  PUBLIC :: comin_state_is_host_errhandler_set
 
#include "comin_global.inc"
 
  TYPE, PUBLIC :: t_comin_state
 
    ! (Non-public) data structure
    TYPE(t_comin_parallel_info) :: parallel_info
 
    !> Create descriptive data structures
    TYPE(t_comin_descrdata_global_data)                 :: comin_descrdata_global_data
    TYPE(t_comin_descrdata_domain_data), ALLOCATABLE    :: comin_descrdata_domain_data(:)
 
  END TYPE t_comin_state
 
  ! Global variable holding the ComIn state.
  ! The C++ part of the state is declared in comin_state.hpp.
  TYPE(t_comin_state), PUBLIC, POINTER :: state => null()
 
  INTERFACE
 
    SUBROUTINE comin_state_set_num_plugins(num_plugins) BIND(C)
      IMPORT c_int
      INTEGER(KIND=C_INT), INTENT(IN), VALUE :: num_plugins
    END SUBROUTINE comin_state_set_num_plugins
 
    FUNCTION comin_state_get_num_plugins() BIND(C)
      IMPORT c_int
      INTEGER(KIND=C_INT) :: comin_state_get_num_plugins
    END FUNCTION comin_state_get_num_plugins
 
    SUBROUTINE comin_setup_set_verbosity_level(iverbosity) BIND(C)
      IMPORT c_int
      INTEGER(KIND=C_INT), INTENT(IN), VALUE :: iverbosity
    END SUBROUTINE comin_setup_set_verbosity_level
 
    FUNCTION comin_setup_get_verbosity_level() BIND(C)
      IMPORT c_int
      INTEGER(KIND=C_INT) :: comin_setup_get_verbosity_level
    END FUNCTION comin_setup_get_verbosity_level
 
    SUBROUTINE comin_state_set_error_code(errcode) BIND(C)
      IMPORT c_int
      INTEGER(KIND=C_INT), INTENT(IN), VALUE :: errcode
    END SUBROUTINE comin_state_set_error_code
 
    FUNCTION comin_state_get_error_code() BIND(C)
      IMPORT c_int
      INTEGER(KIND=C_INT) :: comin_state_get_error_code
    END FUNCTION comin_state_get_error_code
 
    SUBROUTINE comin_state_set_lstdout(lstdout) BIND(C)
      IMPORT c_bool
      LOGICAL(KIND=C_BOOL), INTENT(IN), VALUE :: lstdout
    END SUBROUTINE comin_state_set_lstdout
 
    FUNCTION comin_state_get_lstdout() BIND(C)
      IMPORT c_bool
      LOGICAL(KIND=C_BOOL) :: comin_state_get_lstdout
    END FUNCTION comin_state_get_lstdout
 
    SUBROUTINE comin_state_set_output_unit(unit) BIND(C)
      IMPORT c_int
      INTEGER(KIND=C_INT), INTENT(IN), VALUE :: unit
    END SUBROUTINE comin_state_set_output_unit
 
    FUNCTION comin_state_get_output_unit() BIND(C)
      IMPORT c_int
      INTEGER(KIND=C_INT) :: comin_state_get_output_unit
    END FUNCTION comin_state_get_output_unit
 
    FUNCTION comin_state_get_var_list() BIND(C)
      IMPORT c_ptr
      TYPE(c_ptr) :: comin_state_get_var_list
    END FUNCTION comin_state_get_var_list
 
    !> Get current entry point
    !! @ingroup fortran_interface
    FUNCTION comin_current_get_ep()  BIND(C)
      IMPORT c_int
      INTEGER(c_int) :: comin_current_get_ep
    END FUNCTION comin_current_get_ep
 
    !> Returns the current domain ID if the entry point is called in a domain loop
    !! @see COMIN_DOMAIN_OUTSIDE_LOOP
    !! @ingroup fortran_interface
    FUNCTION comin_current_get_domain_id() BIND(C)
      IMPORT c_int
      INTEGER(c_int) :: comin_current_get_domain_id
    END FUNCTION comin_current_get_domain_id
 
    SUBROUTINE comin_current_set_plugin_id(plugin_id) BIND(C)
      IMPORT c_int
      INTEGER(c_int), VALUE :: plugin_id
    END SUBROUTINE comin_current_set_plugin_id
 
    FUNCTION comin_current_get_plugin_id() BIND(C)
      IMPORT c_int
      INTEGER(c_int) :: comin_current_get_plugin_id
    END FUNCTION comin_current_get_plugin_id
 
    FUNCTION comin_state_is_primary_done() BIND(C)
      IMPORT c_bool
      LOGICAL(c_bool) :: comin_state_is_primary_done
    END FUNCTION comin_state_is_primary_done
 
    SUBROUTINE comin_state_set_primary_done() BIND(C)
    END SUBROUTINE comin_state_set_primary_done
 
    SUBROUTINE comin_descrdata_set_fct_glb2loc_cell_c(fct_ptr) bind(C, NAME='comin_descrdata_set_fct_glb2loc_cell')
      IMPORT :: c_funptr
      TYPE(c_funptr), VALUE, INTENT(IN) :: fct_ptr
    END SUBROUTINE comin_descrdata_set_fct_glb2loc_cell_c
 
    SUBROUTINE comin_descrdata_set_fct_glb2loc_edge_c(fct_ptr) bind(C, NAME='comin_descrdata_set_fct_glb2loc_edge')
      IMPORT :: c_funptr
      TYPE(c_funptr), VALUE, INTENT(IN) :: fct_ptr
    END SUBROUTINE comin_descrdata_set_fct_glb2loc_edge_c
 
    SUBROUTINE comin_descrdata_set_fct_glb2loc_vert_c(fct_ptr) bind(C, NAME='comin_descrdata_set_fct_glb2loc_vert')
      IMPORT :: c_funptr
      TYPE(c_funptr), VALUE, INTENT(IN) :: fct_ptr
    END SUBROUTINE comin_descrdata_set_fct_glb2loc_vert_c
 
    SUBROUTINE comin_state_set_host_errhandler_fct(fct_ptr) bind(C, NAME='comin_state_set_host_errhandler_fct')
      IMPORT :: c_funptr
      TYPE(c_funptr), VALUE, INTENT(IN) :: fct_ptr
    END SUBROUTINE comin_state_set_host_errhandler_fct
 
    FUNCTION comin_state_is_host_errhandler_set() BIND(C)
      IMPORT c_bool
      LOGICAL(c_bool) :: comin_state_is_host_errhandler_set
    END FUNCTION comin_state_is_host_errhandler_set
 
  END INTERFACE
 
CONTAINS
 
  !> Sets the "global-to-local" index lookup function.
  SUBROUTINE comin_descrdata_set_fct_glb2loc_cell(fct)
    PROCEDURE(comin_glb2loc_index_lookup_fct) :: fct !< index lookup function
    TYPE(c_funptr) :: fct_ptr
    fct_ptr = c_funloc(fct)
    CALL comin_descrdata_set_fct_glb2loc_cell_c(fct_ptr)
  END SUBROUTINE comin_descrdata_set_fct_glb2loc_cell
 
  SUBROUTINE comin_descrdata_set_fct_glb2loc_edge(fct)
    PROCEDURE(comin_glb2loc_index_lookup_fct) :: fct !< index lookup function
    TYPE(c_funptr) :: fct_ptr
    fct_ptr = c_funloc(fct)
    CALL comin_descrdata_set_fct_glb2loc_edge_c(fct_ptr)
  END SUBROUTINE comin_descrdata_set_fct_glb2loc_edge
 
  SUBROUTINE comin_descrdata_set_fct_glb2loc_vert(fct)
    PROCEDURE(comin_glb2loc_index_lookup_fct) :: fct !< index lookup function
    TYPE(c_funptr) :: fct_ptr
    fct_ptr = c_funloc(fct)
    CALL comin_descrdata_set_fct_glb2loc_vert_c(fct_ptr)
  END SUBROUTINE comin_descrdata_set_fct_glb2loc_vert
 
END MODULE comin_state