MAPL_ErrorHandling.F90 Source File


This file depends on

sourcefile~~mapl_errorhandling.f90~~EfferentGraph sourcefile~mapl_errorhandling.f90 MAPL_ErrorHandling.F90 sourcefile~mapl_throw.f90 MAPL_Throw.F90 sourcefile~mapl_errorhandling.f90->sourcefile~mapl_throw.f90

Files dependent on this one

MAPL_ErrorHandling.F90wAbstractMeter.F90
w
wBW_Benchmark.F90
w
wBW_Benchmark.F90
w
wBW_BenchmarkSpec.F90
w
wcheckpoint_simulator.F90
w
wComboSpec.F90
w
wDecoratorComponent.F90
w
wdemo.F90
w
wDistributedMeter.F90
w
wdriver.F90
w
wdriver.F90
w
wdriver.F90
w
wFieldUtilities.F90
w
wGathervKernel.F90
w
wGathervKernel.F90
w
wGathervSpec.F90
w
wHorizontalFluxRegridder.F90
w
wMAPL_CubedSphereGridFactory.F90
w
wMAPL_EsmfRegridder.F90
w
wMAPL_ExceptionHandling.F90
w
wMAPL_ExternalGridFactory.F90
w
wMAPL_GeosatMaskMod.F90
w
wMAPL_GetLatLonCoord.F90
w
wMAPL_GridManager.F90
w
wMAPL_IdentityRegridder.F90
w
wMAPL_LatLonGridFactory.F90
w
wMAPL_LatLonToLatLonRegridder.F90
w
wMAPL_LocStreamFactoryMod.F90
w
wMAPL_LocstreamRegridder.F90
w
wMAPL_MemUtils.F90
w
wMAPL_OrbGridCompMod.F90
w
wMAPL_RegridderManager.F90
w
wMAPL_SphericalGeometry.F90
w
wMAPL_StationSamplerMod.F90
w
wMAPL_SwathGridFactory.F90
w
wMAPL_TilingRegridder.F90
w
wMAPL_TrajectoryMod_smod.F90
w
wMAPL_TransposeRegridder.F90
w
wMaplComponent.F90
w
wMaplGenericComponent.F90
w
wMaplGrid.F90
w
wMaplShared.F90
w
wmpi_demo.F90
w
wMpiMutex.F90
w
wMultiCommServer.F90
w
wMultiGroupServer.F90
w
wMultiLayerServer.F90
w
wNewRegridderManager.F90
w
wpfio_base.F90
w
wpfio_parallel_netcdf_reproducer.F90
w
wPlain_netCDF_Time.F90
w
wRegridderSpec.F90
w
wrestart_simulator.F90
w
wStateSpecification.F90
w
wStubComponent.F90
w
wUserComponent.F90
w
wVarConn.F90
w
wVarSpec.F90
w
wVarSpecType.F90
w
wVmstatMemoryGauge.F90
w

Source Code

module MAPL_ErrorHandlingMod
   use MAPL_ThrowMod
   use MPI
   implicit none
   private

   public :: MAPL_Assert
   public :: MAPL_Verify
   public :: MAPL_Return
   public :: MAPL_RTRN
   public :: MAPL_Vrfy
   public :: MAPL_ASRT
   public :: MAPL_abort


   public :: MAPL_SUCCESS

   public :: MAPL_UNKNOWN_ERROR
   public :: MAPL_NO_SUCH_PROPERTY
   public :: MAPL_NO_SUCH_VARIABLE
   public :: MAPL_TYPE_MISMATCH
   public :: MAPL_UNSUPPORTED_TYPE

   public :: MAPL_VALUE_NOT_SUPPORTED
   public :: MAPL_NO_DEFAULT_VALUE
   public :: MAPL_DUPLICATE_KEY
   public :: MAPL_STRING_TOO_SHORT

   enum, bind(c)
      enumerator :: MAPL_SUCCESS       = 0

      ! 001-005
      enumerator :: MAPL_UNKNOWN_ERROR
      enumerator :: MAPL_NO_SUCH_PROPERTY
      enumerator :: MAPL_NO_SUCH_VARIABLE
      enumerator :: MAPL_TYPE_MISMATCH
      enumerator :: MAPL_UNSUPPORTED_TYPE

      ! 006-010
      enumerator :: MAPL_VALUE_NOT_SUPPORTED
      enumerator :: MAPL_NO_DEFAULT_VALUE
      enumerator :: MAPL_DUPLICATE_KEY
      enumerator :: MAPL_STRING_TOO_SHORT
   end enum


   interface MAPL_Assert
      module procedure MAPL_Assert_condition
      module procedure MAPL_Assert_return_code
   end interface MAPL_Assert

   interface MAPL_VRFY
      module procedure MAPL_VRFY
      module procedure MAPL_VRFYt
   end interface MAPL_VRFY

   interface MAPL_ASRT
      module procedure MAPL_ASRT
      module procedure MAPL_ASRTt
   end interface MAPL_ASRT

   interface MAPL_RTRN
      module procedure MAPL_RTRN
      module procedure MAPL_RTRNt
   end interface MAPL_RTRN

contains


   logical function MAPL_Assert_condition(condition, message, return_code, filename, line, rc) result(fail)
      logical, intent(in) :: condition
      character(*), intent(in) :: message
      integer, intent(in) :: return_code
      character(*), intent(in) :: filename
      integer, intent(in) :: line
      integer, optional, intent(out) :: rc ! Not present in MAIN

      fail = .not. condition

      if (fail) then
         !$omp critical (MAPL_ErrorHandling1)
         call MAPL_throw_exception(filename, line, message=message)
         !$omp end critical (MAPL_ErrorHandling1)
         if (present(rc)) rc = return_code
      end if

   end function MAPL_Assert_Condition


   logical function MAPL_Assert_return_code(condition, return_code, filename, line, rc) result(fail)
      logical, intent(in) :: condition
      integer, intent(in) :: return_code
      character(*), intent(in) :: filename
      integer, intent(in) :: line
      integer, optional, intent(out) :: rc ! Not present in MAIN
      character(:), allocatable :: message

      fail = .not. condition

      if (fail) then
         message = get_error_message(return_code)
         !$omp critical (MAPL_ErrorHandling2)
         call MAPL_throw_exception(filename, line, message=message)
         !$omp end critical (MAPL_ErrorHandling2)
         if (present(rc)) rc = return_code
      end if

   end function MAPL_Assert_return_code


   logical function MAPL_Verify(status, filename, line, rc) result(fail)
      integer, intent(in) :: status
      character(*), intent(in) :: filename
      integer, intent(in) :: line
      integer, optional, intent(out) :: rc ! Not present in MAIN

      logical :: condition
      character(:), allocatable :: message
      character(16) :: status_string

      condition = (status == 0)
      fail = .not. condition

      if (fail) then
         write(status_string,'(i0)') status
         message = 'status=' // status_string
         !$omp critical (MAPL_ErrorHandling3)
         call MAPL_throw_exception(filename, line, message=message)
         !$omp end critical (MAPL_ErrorHandling3)
         if (present(rc)) rc = status
      end if

   end function MAPL_Verify


   subroutine MAPL_Return(status, filename, line, rc)
      integer, intent(in) :: status
      character(*), intent(in) :: filename
      integer, intent(in) :: line
      integer, intent(out), optional :: rc

      logical :: condition, fail
      character(:), allocatable :: message

      condition = (status == 0)
      fail = .not. condition

      if (fail) then
         message = get_error_message(status)
         !$omp critical (MAPL_ErrorHandling4)
         call MAPL_throw_exception(filename, line, message=message)
         !$omp end critical (MAPL_ErrorHandling4)
      end if
      ! Regardless of error:
      if (present(rc)) rc = status

   end subroutine MAPL_Return

   logical function MAPL_RTRN(A,iam,line,rc)
      integer,           intent(IN ) :: A
      character(len=*),  intent(IN ) :: iam
      integer,           intent(IN ) :: line
      integer, optional, intent(OUT) :: RC

        MAPL_RTRN = .true.
        !$omp critical (MAPL_ErrorHandling5)
        if(A/=0) print '(A40,I10)',Iam,line
        !$omp end critical (MAPL_ErrorHandling5)
        if(present(RC)) RC=A
   end function MAPL_RTRN

   logical function MAPL_VRFY(A,iam,line,rc)
      integer,           intent(IN ) :: A
      character(len=*),  intent(IN ) :: iam
      integer,           intent(IN ) :: line
      integer, optional, intent(OUT) :: RC
        MAPL_VRFY = A/=0
        if(MAPL_VRFY)then
          if(present(RC)) then
            !$omp critical (MAPL_ErrorHandling6)
            print '(A40,I10)',Iam,line
            !$omp end critical (MAPL_ErrorHandling6)
            RC=A
          endif
        endif
   end function MAPL_VRFY

   logical function MAPL_ASRT(A,iam,line,rc)
      logical,           intent(IN ) :: A
      character(len=*),  intent(IN ) :: iam
      integer,           intent(IN ) :: line
      integer, optional, intent(OUT) :: RC
        MAPL_ASRT = .not.A
        if(MAPL_ASRT)then
          if(present(RC))then
            !$omp critical (MAPL_ErrorHandling7)
            print '(A40,I10)',Iam,LINE
            !$omp end critical (MAPL_ErrorHandling7)
            RC=1
          endif
        endif
   end function MAPL_ASRT

   logical function MAPL_ASRTt(A,text,iam,line,rc)
      logical,           intent(IN ) :: A
      character(len=*),  intent(IN ) :: iam,text
      integer,           intent(IN ) :: line
      integer, optional, intent(OUT) :: RC
        MAPL_ASRTt =   MAPL_ASRT(A,iam,line,rc)
        !$omp critical (MAPL_ErrorHandling8)
        if(MAPL_ASRTt) print *, text
        !$omp end critical (MAPL_ErrorHandling8)
   end function MAPL_ASRTT

   logical function MAPL_RTRNt(A,text,iam,line,rc)
      integer,           intent(IN ) :: A
      character(len=*),  intent(IN ) :: text,iam
      integer,           intent(IN ) :: line
      integer, optional, intent(OUT) :: RC

        MAPL_RTRNt = .true.
        if(A/=0)then
           !$omp critical (MAPL_ErrorHandling9)
           print '(A40,I10)',Iam,line
           print *, text
           !$omp end critical (MAPL_ErrorHandling9)
        end if
        if(present(RC)) RC=A

   end function MAPL_RTRNT

   logical function MAPL_VRFYt(A,text,iam,line,rc)
      integer,           intent(IN ) :: A
      character(len=*),  intent(IN ) :: iam,text
      integer,           intent(IN ) :: line
      integer, optional, intent(OUT) :: RC
        MAPL_VRFYt =  MAPL_VRFY(A,iam,line,rc)
        !$omp critical (MAPL_ErrorHandling10)
        if(MAPL_VRFYt) print *, text
        !$omp end critical (MAPL_ErrorHandling10)
   end function MAPL_VRFYT

   subroutine MAPL_abort()
      integer :: status
      integer :: error_code = -1
      call MPI_Abort(MPI_COMM_WORLD,error_code,status)
  end subroutine MAPL_abort

  function get_error_message(error_code) result(description)
     use gFTL_IntegerStringMap
     character(:), allocatable :: description
     integer, intent(in) :: error_code

     type(IntegerStringMap), save :: error_messages
     logical, save :: initialized = .false.


     call initialize_err()

     if (error_messages%count(error_code) > 0) then
        description = error_messages%at(error_code)
     else
        description = error_messages%at(MAPL_UNKNOWN_ERROR)
     end if

  contains

     subroutine initialize_err()

        if (.not. initialized) then
           initialized = .true.
           call error_messages%insert(MAPL_UNKNOWN_ERROR, 'unknown error')
           call error_messages%insert(MAPL_SUCCESS, 'success')

           call error_messages%insert(MAPL_NO_SUCH_PROPERTY, 'no such property')
           call error_messages%insert(MAPL_NO_SUCH_VARIABLE, 'no such variable')
           call error_messages%insert(MAPL_TYPE_MISMATCH,    'passed argument does not match expected type')
           call error_messages%insert(MAPL_UNSUPPORTED_TYPE, 'provided data type is not supported by this subclass')
           call error_messages%insert(MAPL_VALUE_NOT_SUPPORTED, 'provided value is not supported by this subclass')

           call error_messages%insert(MAPL_NO_DEFAULT_VALUE, 'no default value has been provided for this property')
           call error_messages%insert(MAPL_DUPLICATE_KEY, 'map container already has the specified key')
           call error_messages%insert(MAPL_STRING_TOO_SHORT, 'fixed length string is not long enough to contain requested data')
        end if

     end subroutine initialize_err

  end function get_error_message

end module MAPL_ErrorHandlingMod