!== dc_error.f90 - エラー処理
!
! Authors:: Eizi TOYODA, Yasuhiro MORIKAWA
! Version:: $Id: dc_error.f90,v 1.6 2006/01/15 21:43:14 morikawa Exp $
! Tag Name:: $Name: gt4f90io-20060121 $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License:: See COPYRIGHT[link:../../COPYRIGHT]
!
! This file provides dc_error
!
module dc_error
!
!= エラー処理用モジュール
!
!== 概要
!
! プログラムの部品は必ずエラーの取り扱いを明確に規定すべきものです。
! エラーとは当該部品への入力が不適切であるとか、
! 期待される動作をすることができないといった事態を指します。
!
! gt4f90io ライブラリがユーザに提供する手続
! (手続とはサブルーチンまたは関数の総称) はほとんどの場合、
! 以下の 2 つの方式のいずれかで呼び出し元にエラーを報告します。
!
! * エラーが発生すると適切なメッセージを表示してプログラム終了
! * 論理型の省略できる引数 err が与えられた場合は、
! エラー時にはそれを .true. にします。
! err が省略された場合は上に同じ。
!
! これらの処理はすべて dc_error モジュールの StoreError
! サブルーチンで行っています。引用仕様などに関しては StoreError
! を参照してください。
!
!
!== エラーコード一覧
!
! gt4f90io ライブラリにコードを追加するプログラマは適切な
! エラーコードで StoreError を呼び出すようにしなければなりません。
! そこで、 新しいエラーコードを定義する必要があるかどうかを
! 判定するために、 エラーコードの値と対応するメッセージを一覧します。
! エラーコードニーモニックを使用するためには、
! NF_E で始まる名前については netcdf_f77
! モジュールを引用するか include 'netcdf.inc' を行い(後者は推奨しません)、
! GT_E で始まる名前については dc_error
! モジュールを引用してください。
! また USR_E で始まる名前は各々のユーザが定義して
! 良いエラーコードです。
!
! エラーではない状態を表す非エラーコードは
! DC_NOERR (数値 0) です。
!
! エラーコードの数値の欄を設けたのは、新たなエラーコードを
! 割り当てる際の指針を示すためです。
! コードではエラーコードをニーモニックで与えるべきであり、
! 数値をハードコードすることは厳に慎んで下さい。
!
!=== 利用しないコード
!
! 正の整数値はエラーコードとして使用しません。
!
! NetCDF ライブラリは libc のエラーコード errno を返す可能性があり、
! errno の数値には移植性がないため、全ての正の整数値は errno
! の仕様のために予約されているべきだからです。
!
!=== 非エラーコード
!
! 以下の非エラーコードに関しては dc_error モジュールを引用することで
! 利用してください。
!
! 数値 :: [ ニーモニック ]
!
! 0 :: [ DC_NOERR ]
!
!
!=== netCDF に関するエラーコード
!
! 以下のエラーコードに関しては netcdf_f77 モジュールを引用することで
! 利用してください。
!
! 数値 :: [ ニーモニック ] エラーメッセージ
!
! 0 :: [ NF_NOERR ]
! :: No Error (非エラーコードです)
!
! -33 :: [ NF_EBADID ]
! :: Not a netCDF id:
!
! -34 :: [ NF_ENFILE ]
! :: Too many netCDF files open:
!
! -35 :: [ NF_EEXIST ]
! :: netCDF file exists && NC_NOCLOBBER:
!
! -36 :: [ NF_EINVAL ]
! :: Invalid argument:
!
! -37 :: [ NF_EPERM ]
! :: Write to read only:
!
! -38 :: [ NF_ENOTINDEFINE ]
! :: Operation not allowed in data mode
!
! -39 :: [ NF_EINDEFINE ]
! :: Operation not allowed in define mode
!
! -40 :: [ NF_EINVALCOORDS ]
! :: Index exceeds dimension bound
!
! -41 :: [ NF_EMAXDIMS ]
! :: NC_MAX_DIMS exceeded
!
! -42 :: [ NF_ENAMEINUSE ]
! :: String match to name in use
!
! -43 :: [ NF_ENOTATT ]
! :: Attribute not found
!
! -44 :: [ NF_EMAXATTS ]
! :: NC_MAX_ATTRS exceeded
!
! -45 :: [ NF_EBADTYPE ]
! :: Not a netCDF data type or _FillValue type mismatch
!
! -46 :: [ NF_EBADDIM ]
! :: Invalid dimension id or name
!
! -47 :: [ NF_EUNLIMPOS ]
! :: NC_UNLIMITED in the wrong index
!
! -48 :: [ NF_EMAXVARS ]
! :: NC_MAX_VARS exceeded
!
! -49 :: [ NF_ENOTVAR ]
! :: Variable not found
!
! -50 :: [ NF_EGLOBAL ]
! :: Action prohibited on NC_GLOBAL varid
!
! -51 :: [ NF_ENOTNC ]
! :: Not a netCDF file
!
! -52 :: [ NF_ESTS ]
! :: In Fortran, string too short
!
! -53 :: [ NF_EMAXNAME ]
! :: NC_MAX_NAME exceeded
!
! -54 :: [ NF_EUNLIMIT ]
! :: NC_UNLIMITED size already in use
!
! -55 :: [ NF_ENORECVARS ]
! :: NC_rec op when there are no record vars
!
! -56 :: [ NF_ECHAR ]
! :: Attempt to convert between text & numbers
!
! -57 :: [ NF_EEDGE ]
! :: Edge+start exceeds dimension bound
!
! -58 :: [ NF_ESTRIDE ]
! :: Illegal stride
!
! -59 :: [ NF_EBADNAME ]
! :: Attribute or variable name contains illegal characters
!
! -60 :: [ NF_ERANGE ]
! :: Numeric conversion not representable
!
! -61 :: [ NF_ENOMEM ]
! :: Memory allocation (malloc) failure
!
! -62〜-99::
! :: (将来の netCDF の拡張に備えた gtool4 の予約領域)
!
!
!=== gt4f90io のデータ構造に関するエラーコード
!
! 以下のエラーコードに関しては dc_error モジュールを引用することで
! 利用してください。
!
! 数値 :: [ ニーモニック ] エラーメッセージ
!
! -100 :: [ GT_EFAKE ]
! :: function not implemented
!
! -101 :: [ GT_ENOMOREDIMS ]
! :: dimension number %d is out of range
!
! -102 :: [ GT_EDIMNODIM ]
! :: dimension variable has no dimension
!
! -103 :: [ GT_EDIMMULTIDIM ]
! :: dimension variable has many dimensions
!
! -104 :: [ GT_EDIMOTHERDIM ]
! :: dimension variable has another dimension
!
! -105 :: [ GT_EBADDIMNAME ]
! :: string_c または string_s:
! unknown dimension name
!
! -106 :: [ GT_ENOTVAR ]
! :: variable not opened
!
! -107 :: [ GT_ENOMEM ]
! :: allocate/deallocate error
!
! -108 :: [ GT_EOTHERFILE ]
! :: specified dimensional variable not on the same file
!
! -109 :: [ GT_EARGSIZEMISMATCH ]
! :: arguments (string_c) array size mismatch
!
! -110 :: [ GT_ENOMATCHDIM ]
! :: dimension matching failed
!
! -111 :: [ GT_ELIMITED ]
! :: variable already limited
!
! -112 :: [ GT_EBADVAR ]
! :: variable type not supported
!
! -113 :: [ GT_ECHARSHORT ]
! :: character length not enough
!
! -114 :: [ GT_ENOUNLIMITDIM ]
! :: NC_UNLIMITED dimension is not found
!
! -115 :: [ GT_EBADATTRNAME ]
! :: invalid attribute name
!
! -116 :: [ GT_EBADHISTORY ]
! :: invalid GT_HISTORY variable
!
! -117 :: [ GT_EBADALLOCATESIZE ]
! :: invalid allocated size
!
! 〜-299 ::
! :: (将来の gtdata 層のエラーメッセージのため予約)
!
!=== GrADS 入出力に関するエラーコード
!
! 以下のエラーコードに関しては dc_error モジュールを引用することで
! 利用してください。
!
! 数値 :: [ ニーモニック ] エラーメッセージ
!
! -300 :: [ GR_ENOTGR ]
! :: invalid GrADS file
!
! 〜-399 ::
! :: (将来の GrADS インターフェース層の
! エラーメッセージのため予約)
!
!=== gt4f90io に関して予約してあるエラーコード
!
! 以下のエラーコードは今後の拡張も考えて予約してある部分です。
!
! 数値 :: [ ニーモニック ] エラーメッセージ
!
! -400〜-999 ::
! :: (将来の gt4f90io の内部の
! エラーメッセージのため予約)
!
!=== ユーザ定義用エラーコード
!
! 以下のエラーコードを含む -1000 よりも小さいエラーコードは、
! gt4f90io の上位のプログラムが利用するエラーコードとして空けてあります。
!
! 数値 :: [ ニーモニック ] エラーメッセージ
!
! -1000 :: [ USR_ECHAR ]
! :: string_c
!
! -1001 :: [ USR_EINT ]
! :: string_c (string_i)
!
!
use netcdf_f77, only: NF_ENOTVAR, NF_EINVAL
implicit none
private
public :: NF_ENOTVAR, NF_EINVAL
! エラー等を保持
integer, public, parameter :: DC_NOERR = 0
integer, private, save :: errno = DC_NOERR
integer, private, save :: cause_int = DC_NOERR
character(80), private, save :: cause_string = ""
character(80), private, save :: cause_location = ""
! 正のエラー番号は libc システムエラーメッセージのために
! あけてある。システム依存性が大きく、非常に大きな数値も
! 用いられるので空き領域を確保するのは困難である。
!
! 負のエラー番号は netCDF が使っている。少々の拡張も見込んで、
! -99 までは使わないで置く。
integer, parameter, public:: GT_EFAKE = -100
!
! -101 以下: データ構造のエラー
!
integer, parameter, public:: GT_ENOMOREDIMS = -101
integer, parameter, public:: GT_EDIMNODIM = -102
integer, parameter, public:: GT_EDIMMULTIDIM = -103
integer, parameter, public:: GT_EDIMOTHERDIM = -104
integer, parameter, public:: GT_EBADDIMNAME = -105
integer, parameter, public:: GT_ENOTVAR = -106
integer, parameter, public:: GT_ENOMEM = -107
integer, parameter, public:: GT_EOTHERFILE = -108
integer, parameter, public:: GT_EARGSIZEMISMATCH = -109
integer, parameter, public:: GT_ENOMATCHDIM = -110
integer, parameter, public:: GT_ELIMITED = -111
integer, parameter, public:: GT_EBADVAR = -112
integer, parameter, public:: GT_ECHARSHORT = -113
integer, parameter, public:: GT_ENOUNLIMITDIM = -114
integer, parameter, public:: GT_EBADATTRNAME = -115
integer, parameter, public:: GT_EBADHISTORY = -116
integer, parameter, public:: GT_EBADALLOCATESIZE = -117
!
! -300 以下: GrADS 入出力のエラー
!
integer, parameter, public:: GR_ENOTGR = -300
!
! -1000 以下: ユーザー定義
!
integer, parameter, public:: USR_ECHAR = -1000
integer, parameter, public:: USR_EINT = -1001
public:: StoreError, DumpError, GetErrorMessage, ErrorCode
!
! === 手続引用仕様 ===
!
! いずれ差し替えられるように外部関数にしておく。
interface
subroutine DumpError()
end subroutine DumpError
end interface
contains
integer function ErrorCode() result(result)
!
! 現在設定されているエラーコードを返します。
!
result = errno
end function ErrorCode
subroutine GetErrorMessage(msg)
!
! 現在設定されているエラーコードから対応するメッセージを返します。
!
use netcdf_f77, only: nf_strerror
use dc_string , only: toChar
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 = " 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"
!
! -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 999
end select
msg = '*** ERROR (Code ' // trim(toChar(errno)) // &
& ') [' // trim(cause_location) // '] *** ' // &
& trim(msg)
return
999 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 GetErrorMessage
subroutine StoreError(number, where, err, cause_c, cause_i)
!
!== 典型的ライブラリ関数のために作られたエラー処理関数
!
! 必要な引数は2つであり、第1引数 number は整数型のエラーコード、
! 第2引数 where は文字型でエラーの発生した手続名を与えます。
! デフォルトでは以下の形式の文字列が標準出力 に表示されてプログラム
! は終了します。 エラーメッセージ error_message
! はエラーコードから自動的に決まります。
! 対応表がエラーコード一覧にあるので参照してください。
!
!
! *** ERROR (Code number) [where] *** error_message
!
! *** ERROR (Code number) [where(cause_c)] *** error_message
!
! なお、gt4f90io の ライブラリ外 からユーザがエラー処理用ツール
! として StoreError を用いることを想定し、USR_ECHAR および USR_EINT
! を用意してあります。 このエラーコードを用いると、
! StoreError は以下の形式の文字列を装置 "*" に出力してプログラムを
! 終了させます。 なお、より安易に使えるラッパーとして
! dc_message モジュールを用意してあるのでそちらも参照してください。
!
!
! *** ERROR (Code USR_ECHAR) [where] *** cause_c
!
! *** ERROR (Code USR_EINT) [where] *** cause_c (cause_i)
!
!--
!== 開発者向け解説
!
! エラー番号 number を errno に格納する。同時に付随的情報
! where, cause_i を cause_location, cause_string,
! cause_int に格納する。
! err が与えられている場合、err は number が 0 の場合だけ偽になる。
! number が 0 ならば即復帰する。
! err が与えられていなければエラーメッセージを装置 * に出力して
! プログラムを終了する。
!++
use dc_string, only: assignment(=)
integer, intent(in) :: number ! エラーコード
character(len = *), intent(in) :: where ! エラー発生個所
logical, intent(out), optional :: err
! この論理型変数が与えられた場合は、
! エラー時にはそれを .true.
! にします。この変数が省略され、
! 且つエラーが発生する場合は
! メッセージを表示してプログラムを
! 終了します。
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 StoreError
end module dc_error
subroutine DumpError()
!
! GetErrorMessage からエラーメッセージを取得後、
! それを sysdep#AbortProgram に渡してプログラムを終了させます。
!
use dc_types, only: STRING
use dc_string, only: put_line
use dc_error, only: GetErrorMessage
use sysdep, only: AbortProgram
character(len = STRING):: message
continue
call GetErrorMessage(message)
call AbortProgram(message)
end subroutine DumpError