Class dc_error
In: src/dc_error.f90

Methods

Included Modules

netcdf_f77 dc_string

Public Instance methods

[Source]

        subroutine DumpError()
        end subroutine
result :integer

[Source]


    integer function ErrorCode() result(result)
        result = errno
    end function
msg :character(len = *), intent(out)

[Source]


    subroutine GetErrorMessage(msg)

        character(len = *), intent(out):: msg
        character(len = 180):: message
    continue
        select case(errno)
        case(GT_EFAKE)
            msg = " function not implemented"
        !
        ! -101 以下: データ構造のエラー
        !
        case(GT_ENOMOREDIMS)
            write(message, "(': dimension number', i4, ' is out of range')") cause_int
            msg = trim(message)
        case(GT_EBADDIMNAME)
            msg = '(' // trim(cause_string) // '): unknown dimension name'
        case(GT_ENOTVAR)
            msg = " variable not opened"
        case(GT_ENOMEM)
            msg = " allocate/deallocate error"
        case(GT_EDIMNODIM)
            msg = " dimension variable has no dimension"
        case(GT_EDIMMULTIDIM)
            msg = " dimension variable has many dimensions"
        case(GT_EDIMOTHERDIM)
            msg = " dimension variable has another dimension"
        case(GT_EOTHERFILE)
            msg = " specified dimensional variable not on the same file"
        case(GT_EARGSIZEMISMATCH)
            msg = " argument array size mismatch"
        case(GT_ENOMATCHDIM)
            msg = " dimension matching failed"
        case(GT_ELIMITED)
            msg = " variable already limited"
        case(GT_EBADVAR)
            msg = " variable type not supported"
        case(GT_ECHARSHORT)
            msg = " character length not enough"
        case(GT_ENOUNLIMITDIM)
            msg = " NC_UNLIMITED dimension is not found"
        case(GT_EBADATTRNAME)
            msg = " invalid attribute name"
        !
        ! -200 以下: 可視化構造のエラー
        !
        case(GT_EFIGNOHAXIS)
            msg = " hozirontal axis is missing"
        case(GT_EFIGNOVAXIS)
            msg = " vertical axis is missing"
        case(GT_EBADLINK)
            msg = " bad variable reference"
        !
        ! -300 以下: GrADS 入出力のエラー
        !
        case(GR_ENOTGR)
            msg = " invalid GrADS file"
        !
        ! -1000 以下: ユーザー定義
        !
        case(USR_ECHAR)
            msg = trim(cause_string)
        case(USR_EINT)
            msg = trim(cause_string) // ' (' // trim(toChar(cause_int)) // ')'
        case default
            goto 1000
        end select
        msg =  '*** ERROR (Code ' // trim(toChar(errno))  //  ') [' // trim(cause_location) // '] ***  ' //  trim(msg)
        return

    1000 continue
        if (len(cause_string) > 0) then
            message = nf_strerror(errno)
            msg =  '*** ERROR (Code ' // trim(toChar(errno)) //  ') [' // trim(cause_location)             //  '('   // trim(cause_string) // ')] ***  ' //  trim(message)
        else if (cause_int /= 0) then
            message = nf_strerror(errno)
            msg =  '*** ERROR (Code ' // trim(toChar(errno)) //  ') [' // trim(cause_location)             //  '('   // trim(toChar(cause_int)) // ')] ***  ' //  trim(message)
        else
            message = nf_strerror(errno)
            msg =  '*** ERROR (Code ' // trim(toChar(errno))  //  ') [' // trim(cause_location) // '] ***  ' //  trim(message)
        endif
    end subroutine
number :integer, intent(in)
: エラーコード
where :character(len = *), intent(in)
: エラー発生個所
err :logical, intent(out), optional
cause_c :character(len = *), intent(in), optional
: 文字型メッセージ
cause_i :integer, intent(in), optional
: 整数型メッセージ

プログラムを終了する。

[Source]


    subroutine StoreError(number, where, err, cause_c, cause_i)

        integer,            intent(in)            :: number ! エラーコード
        character(len = *), intent(in)            :: where  ! エラー発生個所
        logical,            intent(out), optional :: err
        character(len = *), intent(in),  optional :: cause_c! 文字型メッセージ
        integer,            intent(in),  optional :: cause_i! 整数型メッセージ
    continue
        errno = number
        cause_location = where
        if (present(cause_c)) then
            cause_string = trim(cause_c)
        else
            cause_string = ""
        endif
        if (present(cause_i)) cause_int = cause_i
        if (present(err)) then
            err = (number /= DC_NOERR)
            return
        endif
        if (number == DC_NOERR) return
        call DumpError
    end subroutine

[Validate]