fstats_errors.f90 Source File


Contents

Source Code


Source Code

! A module providing a set of routines to handle errors for the FSTATS library.
module fstats_errors
    use ferror
    use iso_fortran_env, only : int32
    implicit none

! ******************************************************************************
! ERROR CODES
! ------------------------------------------------------------------------------
    integer(int32), parameter :: FS_NO_ERROR = 0
    integer(int32), parameter :: FS_ARRAY_SIZE_ERROR = 10000
    integer(int32), parameter :: FS_MATRIX_SIZE_ERROR = 10001
    integer(int32), parameter :: FS_INVALID_INPUT_ERROR = 10002
    integer(int32), parameter :: FS_MEMORY_ERROR = 10003
    integer(int32), parameter :: FS_UNDERDEFINED_PROBLEM_ERROR = 10004
    integer(int32), parameter :: FS_TOLERANCE_TOO_SMALL_ERROR = 10005
    integer(int32), parameter :: FS_TOO_FEW_ITERATION_ERROR = 10006
    integer(int32), parameter :: FS_INVALID_ARGUMENT_ERROR = 10007

! ------------------------------------------------------------------------------
    integer(int32), private, parameter :: MESSAGE_SIZE = 1024

contains
! ------------------------------------------------------------------------------
    subroutine report_memory_error(err, fname, code)
        !! Reports a memory allocation related error.
        class(errors), intent(inout) :: err
            !! The error handling object.
        character(len = *), intent(in) :: fname
            !! The name of the routine in which the error occurred.
        integer(int32), intent(in) :: code
            !! The error code returned by the allocation routine.

        ! Variables
        character(len = MESSAGE_SIZE) :: msg

        ! Process
        write(msg, 100) &
            "A memory allocation error occurred with code ", code, "."
        call err%report_error(fname, trim(msg), FS_MEMORY_ERROR)

        ! Formatting
100     format(A, I0, A)
    end subroutine

! ------------------------------------------------------------------------------
    subroutine report_array_size_error(err, fname, name, expect, actual)
        !! Reports an array size error.
        class(errors), intent(inout) :: err
            !! The error handling object.
        character(len = *), intent(in) :: fname
            !! The name of the routine in which the error occurred.
        character(len = *), intent(in) :: name
            !! The name of the array.
        integer(int32), intent(in) :: expect
            !! The expected size of the array.
        integer(int32), intent(in) :: actual
            !! The actual size of the array.

        ! Variables
        character(len = MESSAGE_SIZE) :: msg

        ! Process
        write(msg, 100) "Expected array " // name // " to be of length ", &
            expect, ", but found it to be of length ", actual, "."
        call err%report_error(fname, trim(msg), FS_ARRAY_SIZE_ERROR)

        ! Formatting
100     format(A, I0, A, I0, A)
    end subroutine

! ------------------------------------------------------------------------------
    subroutine report_matrix_size_error(err, fname, name, expect_rows, &
        expect_cols, actual_rows, actual_cols)
        !! Reports a matrix size error.
        class(errors), intent(inout) :: err
            !! The error handling object.
        character(len = *), intent(in) :: fname
            !! The name of the routine in which the error occurred.
        character(len = *), intent(in) :: name
            !! The name of the matrix.
        integer(int32), intent(in) :: expect_rows
            !! The expected number of rows.
        integer(int32), intent(in) :: expect_cols
            !! The expected number of columns.
        integer(int32), intent(in) :: actual_rows
            !! The actual number of rows.
        integer(int32), intent(in) :: actual_cols
            !! The actual number of columns.
        
        ! Variables
        character(len = MESSAGE_SIZE) :: msg

        ! Process
        write(msg, 100) "Expected matrix " // name // " to be of size (", &
            expect_rows, ", ", expect_cols, "), but found it to be of size (", &
            actual_rows, ", ", actual_cols, ")."
        call err%report_error(fname, trim(msg), FS_MATRIX_SIZE_ERROR)

        ! Formatting
100     format(A, I0, A, I0, A, I0, A, I0, A)
    end subroutine

! ------------------------------------------------------------------------------
    subroutine report_arrays_not_same_size_error(err, fname, name1, name2, &
        size1, size2)
        !! Reports an error relating to two arrays not being the same size
        !! when they should be the same size.
        class(errors), intent(inout) :: err
            !! The error handling object.
        character(len = *), intent(in) :: fname
            !! The name of the routine in which the error occurred.
        character(len = *), intent(in) :: name1
            !! The name of the first array.
        character(len = *), intent(in) :: name2
            !! The name of the second array.
        integer(int32), intent(in) :: size1
            !! The size of the first array.
        integer(int32), intent(in) :: size2
            !! The size of the second array.

        ! Local Variables
        character(len = MESSAGE_SIZE) :: msg

        ! Process
        write(msg, 100) "Array " // name1 // " and array " // name2 // &
            "were expected to be the same size, but instead were found " // &
            "to be sized ", size1, " and ", size2, " respectively."
        call err%report_error(fname, trim(msg), FS_ARRAY_SIZE_ERROR)

        ! Formatting
100     format(A, I0, A, I0, A)
    end subroutine

! ------------------------------------------------------------------------------
    subroutine report_underdefined_error(err, fname, expect, actual)
        !! Reports an underdefined problem error.
        class(errors), intent(inout) :: err
            !! The error handling object.
        character(len = *), intent(in) :: fname
            !! The name of the routine in which the error occurred.
        integer(int32), intent(in) :: expect
            !! The expected minimum number of equations.
        integer(int32), intent(in) :: actual
            !! The actual number of equations.

        ! Local Variables
        character(len = MESSAGE_SIZE) :: msg

        ! Process
        write(msg, 100) "The problem is underdefined.  The number of " // &
            "equations was found to be ", actual, &
            ", but must be at least equal to the number of unknowns ", &
            expect, "."
        call err%report_error(fname, trim(msg), FS_UNDERDEFINED_PROBLEM_ERROR)
        
        ! Formatting
100     format(A, I0, A, I0, A)
    end subroutine

! ------------------------------------------------------------------------------
    subroutine report_iteration_count_error(err, fname, msg, mincount)
        !! Reports an iteration count error.
        class(errors), intent(inout) :: err
            !! The error handling object.
        character(len = *) :: fname
            !! The name of the routine in which the error occurred.
        character(len = *) :: msg
            !! The error message.
        integer(int32), intent(in) :: mincount
            !! The minimum iteration count expected.

        ! Local Variables
        character(len = MESSAGE_SIZE) :: emsg

        ! Process
        write(emsg, 100) msg // "  A minimum of ", mincount, " is expected."
        call err%report_error(fname, trim(emsg), FS_TOO_FEW_ITERATION_ERROR)

        ! Formatting
100     format(A, I0, A)
    end subroutine

! ------------------------------------------------------------------------------
end module