comin_setup.F90

Go to the documentation of this file.

!> @file comin_setup.F90
!! @brief Routines to set up ComIn (except for callbacks).
!
!  @authors 08/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_setup
 
  USE iso_c_binding,         ONLY: c_int, c_char, c_bool, c_funptr, c_funloc
  USE comin_setup_constants, ONLY: wp
  USE comin_state,           ONLY: state, &
    &                              comin_state_set_output_unit, &
    &                              comin_state_set_lstdout, &
    &                              comin_state_is_host_errhandler_set, &
    &                              comin_state_set_host_errhandler_fct
  USE comin_c_utils,         ONLY: convert_f_string
  USE comin_parallel,        ONLY: comin_parallel_free_mpi_comms
  USE comin_plugin_types,    ONLY: t_comin_plugin_description
  USE comin_plugin_info,     ONLY: comin_severity_debug, comin_severity_info, &
    &                              comin_severity_warning, comin_severity_error
  USE comin_errhandler,      ONLY: comin_message, comin_error_set
  USE comin_errhandler_types,ONLY: comin_error_setup_errhandler_not_set,               &
    &                              comin_error_setup_precision_test_failed,            &
    &                              comin_error_setup_errhandler_not_associated,        &
    &                              comin_error_setup_comin_already_initialized,        &
    &                              comin_host_errhandler_fct
 
  IMPLICIT NONE
 
  PRIVATE
 
  PUBLIC :: comin_setup_check
  PUBLIC :: comin_plugin_primaryconstructor
  PUBLIC :: comin_setup_init
  PUBLIC :: comin_setup_finalize
  PUBLIC :: comin_setup_errhandler
  PUBLIC :: t_comin_setup_version_info, comin_setup_get_version
 
#include "comin_global.inc"
 
  !> The elements of this derived data type describe the current
  !! community interface.
  !! @ingroup fortran_interface
  TYPE, BIND(C) :: t_comin_setup_version_info
    !> ComIn versioning (major and minor version info)
    INTEGER(kind=c_int) :: version_no_major, version_no_minor, &
         & version_no_patch
  end TYPE t_comin_setup_version_info
 
  !> C-compatible version of the plugin info type.
  TYPE, BIND(C) :: t_comin_plugin_description_c
    CHARACTER(c_char), DIMENSION(COMIN_MAX_LEN_PLUGIN_NAME+1) :: name
    CHARACTER(c_char), DIMENSION(COMIN_MAX_LEN_PLUGIN_LIBRARY+1) :: plugin_library
    CHARACTER(c_char), DIMENSION(COMIN_MAX_LEN_PRIMARY_CONSTRUCTOR+1) :: primary_constructor
    CHARACTER(c_char), DIMENSION(COMIN_MAX_LEN_OPTIONS+1) :: options
    CHARACTER(c_char), DIMENSION(COMIN_MAX_LEN_COMM+1) :: comm
    INTEGER(c_int) :: log_severity
  END TYPE t_comin_plugin_description_c
 
  INTERFACE
    SUBROUTINE comin_plugin_primaryconstructor_c(plugin_list, len) &
        & bind(c, name='comin_plugin_primaryconstructor')
      IMPORT t_comin_plugin_description_c, c_int
      TYPE(t_comin_plugin_description_c), INTENT(IN) :: plugin_list(*)
      INTEGER(c_int), VALUE, INTENT(IN) :: len
    END SUBROUTINE comin_plugin_primaryconstructor_c
  END INTERFACE
 
#include "comin_version.inc"
 
CONTAINS
 
  !> Returns version info.
  !! @ingroup fortran_interface
  FUNCTION comin_setup_get_version()
    TYPE(t_comin_setup_version_info) :: comin_setup_get_version
    comin_setup_get_version%version_no_major = comin_version_major
    comin_setup_get_version%version_no_minor = comin_version_minor
    comin_setup_get_version%version_no_patch = comin_version_patch
  END FUNCTION comin_setup_get_version
 
  !> Execute primary constructors.
  SUBROUTINE comin_plugin_primaryconstructor(plugin_list)
    TYPE(t_comin_plugin_description), INTENT(IN) :: plugin_list(:)
 
    TYPE(t_comin_plugin_description_c) :: plugin_list_c(size(plugin_list))
    INTEGER :: i
 
    DO i = 1, SIZE(plugin_list)
      IF (plugin_list(i)%log_debug) THEN
        plugin_list_c(i)%log_severity = comin_severity_debug
      ELSE IF (plugin_list(i)%log_info) THEN
        plugin_list_c(i)%log_severity = comin_severity_info
      ELSE IF (plugin_list(i)%log_warning) THEN
        plugin_list_c(i)%log_severity = comin_severity_warning
      ELSE
        plugin_list_c(i)%log_severity = comin_severity_error
      END IF
 
      CALL convert_f_string(plugin_list(i)%name, plugin_list_c(i)%name)
      CALL convert_f_string(plugin_list(i)%options, plugin_list_c(i)%options)
      CALL convert_f_string(plugin_list(i)%plugin_library, plugin_list_c(i)%plugin_library)
      CALL convert_f_string(plugin_list(i)%primary_constructor, plugin_list_c(i)%primary_constructor)
      CALL convert_f_string(plugin_list(i)%comm, plugin_list_c(i)%comm)
    END DO
 
    CALL comin_plugin_primaryconstructor_c(plugin_list_c, SIZE(plugin_list))
 
  END SUBROUTINE comin_plugin_primaryconstructor
 
  !> Performs basic compatibility checks.
  SUBROUTINE comin_setup_check(plugin_str, wp_check)
    CHARACTER(LEN=*), INTENT(IN)  :: plugin_str !< plugin name
    INTEGER,          INTENT(IN)  :: wp_check !< KIND value for compatibility checks.
    !
 
    IF (.NOT. comin_state_is_host_errhandler_set()) THEN
      CALL comin_error_set(comin_error_setup_errhandler_not_set); RETURN
    END IF
 
    ! compare floating point precision
    IF (wp /= wp_check) THEN
      CALL comin_error_set(comin_error_setup_precision_test_failed); RETURN
    ELSE
      CALL comin_message("     " // plugin_str // ": working precision test successful.", 0)
    END IF
  END SUBROUTINE comin_setup_check
 
  !> Initialize the comin state
  !! This routine needs to be called by the host before any other comin call
  !!
  SUBROUTINE comin_setup_init(lstdout, output_unit)
    LOGICAL(KIND=C_BOOL), INTENT(IN) :: lstdout     !< do print on stdout or not
    INTEGER, INTENT(IN), OPTIONAL :: output_unit !< output unit to print messages to
    IF (ASSOCIATED(state)) THEN
      ! <! cant use comin_message due to circular dependencies
      CALL comin_error_set(comin_error_setup_comin_already_initialized); RETURN
    END IF
    ALLOCATE(state)
 
    CALL comin_state_set_lstdout(lstdout)
    IF(PRESENT(output_unit)) THEN
      CALL comin_state_set_output_unit(output_unit)
    END IF
  END SUBROUTINE comin_setup_init
 
  !> Destructor.
  SUBROUTINE comin_setup_finalize()
 
    CALL comin_parallel_free_mpi_comms()
 
    ! we don't call dlclose in the finalization because it has no
    ! advantages, while it would triggers some problems:
    !
    ! - NVHPC compilers for GPU try to unload the library again in at
    ! the end of the program resulting in a segfault. See
    ! https://gitlab.dkrz.de/icon-comin/comin/-/issues/210
    !
    ! - parallel HDF5 registers calls backs at `MPI_COMM_SELF` atexit
    ! handler, which also results in a segfault as the call gets
    ! unloaded in dlclose before the handler is called.
    ! See https://gitlab.dkrz.de/icon-comin/comin/-/issues/214
    !
  END SUBROUTINE comin_setup_finalize
 
  !> Sets the global error handler procedure pointer.
  !!
  !! To be called by the host application (ICON).
  !!
  !! Aborts with an error code if the error handler has already been
  !! set.
  SUBROUTINE comin_setup_errhandler(error_handler)
    PROCEDURE(comin_host_errhandler_fct) :: error_handler !< error handler
    !
    TYPE(c_funptr) :: fct_ptr
    fct_ptr = c_funloc(error_handler)
    CALL comin_state_set_host_errhandler_fct(fct_ptr)
    IF (.NOT. comin_state_is_host_errhandler_set()) THEN
      CALL comin_error_set(comin_error_setup_errhandler_not_associated); RETURN
    END IF
  END SUBROUTINE comin_setup_errhandler
 
END MODULE comin_setup