!== 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