api_handle_error.f

Go to the documentation of this file.

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      MODULE api_handle_error

      IMPLICIT NONE
      INTEGER, PARAMETER :: error_len = 50
      INTEGER, PARAMETER :: error_mess_len = 250
      ! ERROR HANDLING FLAGS
      INTEGER, PARAMETER :: no_error=0
      INTEGER, PARAMETER :: unallocated_array_error=1
      INTEGER, PARAMETER :: file_not_found_error=2
      INTEGER, PARAMETER :: call_position_error=3
      INTEGER, PARAMETER :: overtime_error=4
      INTEGER, PARAMETER :: max_instance_error=5
      INTEGER, PARAMETER :: invalid_instance_num_error=6
      INTEGER, PARAMETER :: unused_instance_error=7
      INTEGER, PARAMETER :: unknown_var_error=8
      INTEGER, PARAMETER :: increase_nb_var_t2d_error=9
      INTEGER, PARAMETER :: increase_nb_var_t3d_error=10
      INTEGER, PARAMETER :: increase_nb_var_art_error=11
      INTEGER, PARAMETER :: increase_nb_var_wac_error=12
      INTEGER, PARAMETER :: increase_nb_var_sis_error=13
      INTEGER, PARAMETER :: index_block_missing=14
      INTEGER, PARAMETER :: unknown_module=15
!
      ! POSITION FOR A CALL FUNCTION
      INTEGER, PARAMETER :: no_position=-1
      INTEGER, PARAMETER :: run_set_config_pos=0
      INTEGER, PARAMETER :: run_read_case_pos=1
      INTEGER, PARAMETER :: run_allocation_pos=2
      INTEGER, PARAMETER :: run_init_pos=3
      INTEGER, PARAMETER :: run_timestep_pos=4
      INTEGER, PARAMETER :: run_finalize_pos=5
      CHARACTER(LEN=32) :: pos_name(6)
      parameter( pos_name = (/
     &            'RUN_SET_CONFIG                  ',
     &            'RUN_READ_CASE                   ',
     &            'RUN_ALLOCATION                  ',
     &            'RUN_INIT                        ',
     &            'RUN_TIMESTEP                    ',
     &            'RUN_FINALIZE                    ' /) )
      CHARACTER(LEN=ERROR_MESS_LEN) :: err_mess
!
      CONTAINS
        !
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE check_call_position
     &     (call_position,fname,prev_pos,next_pos,ierr)
        INTEGER :: call_position
        CHARACTER(*), INTENT(IN) :: FNAME
        INTEGER, INTENT(IN) :: PREV_POS, NEXT_POS
        INTEGER, INTENT(OUT) :: IERR
!
        ierr = 0
!
        IF((next_pos.NE.no_position).AND.
     &     (call_position.GT.next_pos)) THEN
          ierr = call_position_error
          err_mess = "THE FUNCTION :'"//trim(fname)//
     &      "' MUST BE CALLED BEFORE "//pos_name(next_pos+1)
        ENDIF
        IF((prev_pos.NE.no_position).AND.
     &     (call_position.LT.prev_pos)) THEN
          ierr = call_position_error
          err_mess = "THE FUNCTION :'"//trim(fname)//
     &      "' MUST BE CALLED AFTER "//pos_name(prev_pos+1)
        ENDIF
      END SUBROUTINE check_call_position
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE get_error_type(IERR,MESSAGE)
        INTEGER, INTENT(IN) :: IERR
        CHARACTER(*), INTENT(OUT) :: MESSAGE
!
        IF(ierr.EQ.unallocated_array_error) THEN
          message = 'ERROR OF TYPE: UNALLOCATED_ARRAY_ERROR'
        ELSE IF(ierr.EQ.file_not_found_error) THEN
          message = 'ERROR OF TYPE: FILE_NOT_FOUND_ERROR'
        ELSE IF(ierr.EQ.call_position_error) THEN
          message = 'ERROR OF TYPE: CALL_POSITION_ERROR'
        ELSE IF(ierr.EQ.max_instance_error) THEN
          message = 'ERROR OF TYPE: MAX_INSTANCE_ERROR'
        ELSE IF(ierr.EQ.invalid_instance_num_error) THEN
          message = 'ERROR OF TYPE: INVALID_INSTANCE_NUM_ERROR'
        ELSE IF(ierr.EQ.unused_instance_error) THEN
          message = 'ERROR OF TYPE: UNUSED_INSTANCE_ERROR'
        ELSE IF(ierr.EQ.unknown_var_error) THEN
          message = 'ERROR OF TYPE: UNKNOWN_VAR_ERROR'
        ELSE IF(ierr.EQ.index_block_missing) THEN
          message = 'ERROR OF TYPE: INDEX_BLOCK_MISSING'
        ELSE IF(ierr.EQ.unknown_module) THEN
          message = 'MODULE GIVEN AS ARGUMENT IS UNKNOWN'
        ELSE
          message = 'ERROR OF UNKNOWN TYPE'
        ENDIF
      END SUBROUTINE get_error_type
!
      END MODULE api_handle_error