comin_errhandler.F90

Go to the documentation of this file.

!> @file comin_errhandler.F90
!! @brief Utility functions for error handling.
!
!  @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_errhandler
 
  USE iso_c_binding,              ONLY: c_ptr, c_int, c_bool, c_char, c_null_char
  USE comin_c_utils,              ONLY: convert_c_string
  USE comin_state,                ONLY: comin_setup_get_verbosity_level, &
    &                                   comin_state_get_output_unit, &
    &                                   comin_state_get_lstdout
 
  IMPLICIT NONE
 
  PRIVATE
  PUBLIC :: comin_plugin_finish
  PUBLIC :: comin_message
  PUBLIC :: comin_error_get_string
  PUBLIC :: comin_error_get_category
  PUBLIC :: comin_error_check
  PUBLIC :: comin_error_get
  PUBLIC :: comin_error_set
  PUBLIC :: comin_error_set_errors_return
  PUBLIC :: comin_error_reset
 
#include "comin_global.inc"
 
  INTERFACE
    !> Retrieve the current ComIn error code.
    FUNCTION comin_error_get() BIND(C)
      IMPORT c_int
      INTEGER(c_int) :: comin_error_get
    END FUNCTION
 
    SUBROUTINE comin_error_reset() BIND(C)
    END SUBROUTINE
 
    TYPE(c_ptr) FUNCTION comin_error_get_string_c(error_code) &
        & BIND(C, name='comin_error_get_string')
      IMPORT c_int, c_ptr
      INTEGER(c_int), VALUE, INTENT(IN) :: error_code
    END FUNCTION comin_error_get_string_c
 
    TYPE(c_ptr) FUNCTION comin_error_get_category_c(error_code) &
        & BIND(C, name='comin_error_get_category')
      IMPORT c_int, c_ptr
      INTEGER(c_int), VALUE, INTENT(IN) :: error_code
    END FUNCTION comin_error_get_category_c
 
    SUBROUTINE comin_plugin_finish_c(routine, text) BIND(C, NAME="comin_plugin_finish")
      IMPORT c_char
      CHARACTER(kind=c_char) :: routine(*)
      CHARACTER(kind=c_char) :: text(*)
    END SUBROUTINE comin_plugin_finish_c
 
    !> @ingroup fortran_interface
    SUBROUTINE comin_error_check() BIND(C)
    END SUBROUTINE comin_error_check
 
    !> @ingroup fortran_interface
    SUBROUTINE comin_error_set(err_code) BIND(C)
      IMPORT c_int
      INTEGER(C_INT), VALUE, INTENT(IN) :: err_code
    END SUBROUTINE comin_error_set
 
    !> @ingroup fortran_interface
    SUBROUTINE comin_error_set_errors_return_c(errors_return) &
      BIND(C, NAME="comin_error_set_errors_return")
      IMPORT c_bool
      LOGICAL(C_BOOL), VALUE, INTENT(IN) :: errors_return
    END SUBROUTINE comin_error_set_errors_return_c
 
  END INTERFACE
 
CONTAINS
 
  !> Wrapper function for callback to ICON's "finish" routine.
  !! @ingroup fortran_interface
  SUBROUTINE comin_plugin_finish(routine, text)
    CHARACTER(LEN=*), INTENT(IN) :: routine
    CHARACTER(LEN=*), INTENT(IN) :: text
    CALL comin_plugin_finish_c(routine // c_null_char, text // c_null_char)
  END SUBROUTINE comin_plugin_finish
 
  !> Prints a message on rank 0 if the global verbosity level larger than lvl
  SUBROUTINE comin_message(message, lvl)
    CHARACTER(LEN=*), INTENT(IN) :: message
    INTEGER, INTENT(IN)   :: lvl
 
    INTEGER :: iverbosity
 
    iverbosity = comin_setup_get_verbosity_level()
 
    IF (lvl < 0) THEN
      CALL comin_plugin_finish("message", "ERROR: Message level must be non-negative.")
    END IF
 
    IF (comin_state_get_lstdout() .AND. (iverbosity > lvl)) THEN
      WRITE(comin_state_get_output_unit(), *) trim(message)
    END IF
  END SUBROUTINE comin_message
 
  !> C-wrapper for the `comin_message` subroutine.
  SUBROUTINE comin_message_c(msg, lvl) &
    &  BIND(C, name="comin_message")
    TYPE(c_ptr), VALUE, INTENT(IN) :: msg
    INTEGER(KIND=c_int), VALUE, INTENT(IN) :: lvl
    CALL comin_message(convert_c_string(msg), lvl)
  END SUBROUTINE comin_message_c
 
  !> Return the string description of the given error code.
  !! @ingroup fortran_interface
  FUNCTION comin_error_get_string(error_code) RESULT(string)
    INTEGER, INTENT(IN) :: error_code
    CHARACTER(LEN=COMIN_MAX_LEN_ERR_MESSAGE) :: string
 
    string = convert_c_string(comin_error_get_string_c(error_code))
  END FUNCTION
 
  !> Return the category of the given error code.
  !! @ingroup fortran_interface
  FUNCTION comin_error_get_category(error_code) RESULT(category)
    INTEGER, INTENT(IN) :: error_code
    CHARACTER(LEN=11) :: category
 
    category = convert_c_string(comin_error_get_category_c(error_code))
  END FUNCTION comin_error_get_category
 
  SUBROUTINE comin_error_set_errors_return(errors_return)
    LOGICAL, INTENT(IN) :: errors_return
    CALL comin_error_set_errors_return_c(LOGICAL(errors_return, c_bool))
  END SUBROUTINE comin_error_set_errors_return
 
END MODULE comin_errhandler