integer function ErrorCode() result(result)
    !
    ! 現在設定されているエラーコードを返します。
    !
    ! Return an error code specified currently.
    !
    result = errno
  end function ErrorCode

  subroutine GetErrorMessage(msg)
    !
    ! 現在設定されているエラーコードから対応するメッセージを返します。
    !
    ! Return messages corresponding to an error code specified currently.
    !
    use netcdf_f77, only: nf_strerror
    character(len = *), intent(out):: msg
    character(len = STRING):: message
    character(len = 20):: errno_c
    character(len = 20):: cause_int_c
  continue
    select case(errno)
    case(GT_EFAKE)
      msg = ' function not implemented'
      !
      ! -101 以下: データ構造のエラー
      ! -101 or less: Error of data structure
      !
    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 = ' arguments (' // trim(cause_string) //') 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'
    case(GT_EBADALLOCATESIZE)
      msg = ' invalid allocated size'
    case(GT_ERANKMISMATCH)
      msg = ' rank of data and argument are mismatch (' // trim(cause_string) // ')'
    case(GT_ENOTURL)
      msg = ' URL (' // trim(cause_string) // ') is not found'
    case(GT_EBADGT4COMMAGRAPHY)
      msg = ' (' // trim(cause_string) // ') is not gtool4 comma-graphy (ex. "time=100.0,x=10:20,y=^1:^5")'
      !
      ! -300 以下: GrADS 入出力のエラー
      ! -300 or less: Error of GrADS I/O
      !
    case(GR_ENOTGR)
      msg = ' invalid GrADS file'
      !
      ! -400 以下: DC ユーティリティのエラー
      ! -400 or less: Error of DC utilities
      !
    case(DC_ENOTINIT)
      msg = ' object (' // trim(cause_string) // ') is not initialized'
    case(DC_EALREADYINIT)
      msg = ' object (' // trim(cause_string) // ') is already initialized'
    case(DC_EBADUNIT)
      msg = ' unit (' // trim(cause_string) // ') is invalid'
    case(DC_EBADCALTYPE)
      write(message, '(" calendar type (", i4, ") is invalid")') cause_int
      msg = trim(message)
    case(DC_EBADTIMEZONE)
      msg = ' time zone (' // trim(cause_string) // ') is invalid'
    case(DC_EFILENAMEEMPTY)
      msg = ' filename is empty'
    case(DC_EBADFILEOPMODE)
      msg = ' file open mode (' // trim(cause_string) // ') is invalid'
    case(DC_ENOUNITNUM)
      msg = ' available unit number is not found within (' // trim(cause_string) // ')'
    case(DC_ENOFILEEXIST)
      msg = ' file (' // trim(cause_string) // ') is not found'
    case(DC_ENOFILEREAD)
      msg = ' file (' // trim(cause_string) // ') is not readable'
    case(DC_ENOFILEWRITE)
      msg = ' file (' // trim(cause_string) // ') is not writable'
    case(DC_ENEGATIVE)
      msg = ' negative value is invalid for (' // trim(cause_string) // ')'
    case(DC_EARGLACK)
      msg = ' lack of arguments (' // trim(cause_string) // ')'
    case(DC_ENOASSOC)
      msg = ' argument (' // trim(cause_string) // ') is not associated'
    case(DC_ENOENTRY)
      msg = ' entry of (' // trim(cause_string) // ') is not found'
    case(DC_ENODIMTIME)
      msg = ' dimensional time can not be converted into nondimensional time'
    case(DC_EDIMTIME)
      msg = ' nondimensional time can not be converted into dimensional time'
    case(DC_ETOOLARGETIME)
      msg = ' number is too large for time'
      !
      ! -500 以下: データ入出力層のエラー
      ! -500 or less: Error of data I/O layer
      !
    case(HST_ENOTINDEFINE)
      msg = ' operation (' // trim(cause_string) // ') not allowed in data mode'
    case(HST_EINDEFINE)
      msg = ' operation (' // trim(cause_string) // ') not allowed in define mode'
    case(HST_EINTFILE)
      msg = ' different intervals are applied to a file (' // trim(cause_string) // ')'
    case(HST_EBADNAME)
      msg = ' name (' // trim(cause_string) // ') is invalid'
    case(HST_ENOTTERMGTHIST)
      msg = ' GT_HISTORY correspond to (' // trim(cause_string) // ') is not terminated'
    case(HST_ENODEPENDTIME)
      msg = ' (' // trim(cause_string) // ') does not depend on time'
    case(HST_EBADVARNAME)
      msg = ' variable name (' // trim(cause_string) // ') is invalid'
    case(HST_ENOTIMEDIM)
      msg = ' time dimension is not found'
    case(HST_ENOAXISNAME)
      msg = ' axis or weight (' // trim(cause_string) // ') is not found'
    case(HST_EVARINUSE)
      msg = ' variable name (' // trim(cause_string) // ') is already used'
    case(HST_EALREADYREGVARFIX)
      msg = ' already register of variables is fixed by (' // trim(cause_string) // ')'
    case(HST_EBADSLICE)
      msg = ' slice options are invalid (' // trim(cause_string) // ')'
    case(HST_EBADNEWFILEINT)
      msg = ' invalid newfile interval (' // trim(cause_string) // ')'
    case(HST_EMAXDIMSDEPENDED)
      write(message, '("(", i4, ")")') cause_int
      msg = trim(message)
      msg = ' variable (' // trim(cause_string) // ') depends on ' // trim(message) // ' dimensions'
    case(HST_EINDIVISIBLE)
      msg = ' (' // trim(cause_string) // ') can not be divided'
    case(HST_EBADTERMINUS)
      msg = ' terminus options are invalid (' // trim(cause_string) // ')'
    case(HST_EBADORIGIN)
      msg = ' origin options are invalid (' // trim(cause_string) // ')'
    case(HST_EMPINOAXISDATA)
      msg = ' data of axis (' // trim(cause_string) // ') for MPI is lack'

      !
      !
      ! -1000 以下: ユーザー定義
      ! -1000 or less: User-defined error
      !
    case(:USR_ERRNO)
      if (len(trim(adjustl(cause_string))) < 1) then
        cause_string = 'Unknown error'
      end if
      if (cause_int_valid) then
        write(cause_int_c, "(i8)") cause_int
        msg = trim(cause_string) // ' (' // trim(adjustl(cause_int_c)) // ')'
      else
        msg = trim(cause_string)
      end if
    case default
      goto 999
    end select
    write(errno_c, "(i8)") errno
    msg =  '*** ERROR (Code ' // trim(adjustl(errno_c))  // ') [' // trim(cause_location) // '] ***  ' // trim(msg)
    return

999 continue
    if (len(cause_string) > 0) then
      message = nf_strerror(errno)
      write(errno_c, "(i8)") errno
      msg =  '*** ERROR (Code ' // trim(adjustl(errno_c)) // ') [' // trim(cause_location)             // '('   // trim(cause_string) // ')] ***  ' // trim(message)
    else if (cause_int_valid) then
      message = nf_strerror(errno)
      write(errno_c, "(i8)") errno
      write(cause_int_c, "(i8)") cause_int
      msg =  '*** ERROR (Code ' // trim(adjustl(errno_c)) // ') [' // trim(cause_location)             // '('   // trim(adjustl(cause_int_c)) // ')] ***  ' // trim(message)
    else
      message = nf_strerror(errno)
      write(errno_c, "(i8)") errno
      msg =  '*** ERROR (Code ' // trim(adjustl(errno_c))  // ') [' // trim(cause_location) // '] ***  ' // trim(message)
    endif
  end subroutine GetErrorMessage

  subroutine StoreError(number, where, err, cause_c, cause_i)
    !
    !== 典型的ライブラリ手続のために作られたエラー処理サブルーチン
    !== Error handling subroutine for typical procedures of library
    !
    ! 必要な引数は2つであり、第1引数 *number* には整数型のエラーコード、
    ! 第2引数 *where* には文字型でエラーの発生した手続名を与えます。
    ! デフォルトでは以下の形式の文字列が標準出力に表示されてプログラム
    ! は終了します。 エラーメッセージ error_message
    ! はエラーコードから自動的に決まります。
    ! 対応表がエラーコード一覧にあるので参照してください。
    !
    ! Number of necessary arguments is two. Give integer error code 
    ! to first argument *number*, and procedure name where the error
    ! occurs to second argument *where*. By default, like a following 
    ! string is displayed to standard output, and the program aborts
    ! Error message <error_message> is determined by error code automatically.
    ! See error code list.
    !
    !     
    !     *** ERROR (Code number) [where] ***  error_message
    !     
    !     *** ERROR (Code number) [where(cause_c)] ***  error_message
    !
    ! なお、gtool5 のライブラリ外からユーザがエラー処理用ツール
    ! として StoreError を用いることを想定し、<b><tt>USR_ERRNO</tt></b> 
    ! 番より小さい
    ! エラーコードは空けてあります。<b><tt>USR_ERRNO</tt></b>
    ! より小さい値をエラーコードに与えると,
    ! StoreError は以下の形式の文字列を標準出力に出力してプログラムを
    ! 終了させます。より安易に使えるメッセージ出力およびエラー発生の
    ! ためのモジュールとして *dc_message* も用意してあるので
    ! そちらも参照してください。
    !
    ! In addition, for usage that users call StoreError as an error 
    ! handling tool from the outside of gtool5 library, 
    ! error codes smaller than <b><tt>USR_ERRNO</tt></b> is saved.
    ! When error codes smaller than <b><tt>USR_ERRNO</tt></b> is given,
    ! StoreError displays like a following string to standard output, 
    ! and stops the program.
    ! *dc_message* module is prepared too. This module can be used 
    ! more easily for message output and rise of error.
    !
    !     
    !     *** ERROR (Code number) [where] ***  cause_c
    !     
    !     *** ERROR (Code number) [where] ***  cause_c (cause_i)
    !
    !

    integer,            intent(in)            :: number
                              ! エラーコード。 
                              ! Error code
    character(len = *), intent(in)            :: where
                              ! エラー発生個所。 
                              ! Place where error occurs
    logical,            intent(out), optional :: err
                              ! 例外処理用フラグ。
                              ! デフォルトでは、*number* に非エラーコード
                              ! 以外の値が与えられた場合、エラーメッセージを
                              ! 表示してプログラムは強制終了します。
                              ! 引数 *err* が与えられる場合、
                              ! プログラムは強制終了せず、代わりに
                              ! *err* に .true. が代入されます。
                              !
                              ! Exception handling flag. 
                              ! By default, when error code (excluding 
                              ! non error code) is given to *number*, 
                              ! the program display error message and aborts. 
                              ! If this *err* argument is given, 
                              ! .true. is substituted to *err* and 
                              ! the program does not abort. 
    character(len = *), intent(in),  optional :: cause_c
                              ! 文字型メッセージ。 
                              ! Character message
    integer,            intent(in),  optional :: cause_i
                              ! 整数型メッセージ。 
                              ! Integer message
  continue
    if (present(err)) then
      err = (number /= DC_NOERR)
      return
    endif
    if (number == DC_NOERR) return
    errno = number
    cause_location = where
    if (present(cause_c)) then
      cause_string = trim(cause_c)
    else
      cause_string = ""
    endif
    if (present(cause_i)) then
      cause_int = cause_i
      cause_int_valid = .true.
    else
      cause_int_valid = .false.
    end if
    call DumpError
  end subroutine StoreError