!= エラー処理 ! != Error handling ! ! Authors:: Eizi TOYODA, Yasuhiro MORIKAWA ! Version:: $Id: dc_error.f90,v 1.27 2008-05-11 04:56:23 morikawa Exp $ ! Tag Name:: $Name: gt4f90io-20080602 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. ! License:: See COPYRIGHT[link:../../COPYRIGHT] ! module dc_error ! != エラー処理用モジュール ! != Error handling module ! ! Note that Japanese and English are described in parallel. ! ! プログラムの部品は必ずエラーの取り扱いを明確に規定すべきものです。 ! エラーとは当該部品への入力が不適切であるとか、 ! 期待される動作をすることができないといった事態を指します。 ! ! gt4f90io ライブラリがユーザに提供する手続 ! (手続とはサブルーチンまたは関数の総称) はほとんどの場合、 ! 以下の 2 つの方式のいずれかで呼び出し元にエラーを報告します。 ! ! * エラーが発生すると適切なメッセージを表示してプログラム終了 ! * 論理型の省略できる引数 *err* が与えられた場合は、 ! エラー時にはそれを .true. にします。 ! err が省略された場合は上に同じ。 ! ! これらの処理はすべて *dc_error* モジュールの *StoreError* ! サブルーチンで行っています。引用仕様などに関しては *StoreError* ! を参照してください。 ! ! ! Error handling about parts of programs should be regulated definitely. ! Error means that input to the part of program is invalid, or ! expected operation can not be done, etc. ! ! Procedures (procedures is generic name of subroutines and functions) ! provided to users by gt4f90io library almost report error to invoker ! in the following two manner. ! ! * When error occurs, the program display appropriate messages and ! aborts. ! * If logical optional argument *err* is given, the argument *err* become ! .true. when error occurs. If *err* is abbreviated, ! the operation is same as above. ! ! *StoreError* subroutine in *dc_error* module handle above all operations. ! See *StoreError* about the interfase of it. ! ! !== エラーコード一覧 !== Error code list ! ! gt4f90io ライブラリにコードを追加するプログラマは適切な ! エラーコードで *StoreError* を呼び出すようにしなければなりません。 ! そこで、 新しいエラーコードを定義する必要があるかどうかを ! 判定するために、 エラーコードの値と対応するメッセージを ! 以下に一覧します。 ! エラーコードニーモニックを使用するためには、 ! NF_E で始まる名前については netcdf_f77 ! モジュールを引用するか include 'netcdf.inc' を行い（後者は推奨しません）、 ! GT_E, DC_E, HST_E ! で始まる名前については dc_error モジュールを引用してください。 ! また USR_ERRNO 番より小さい値は、 ! 各々のユーザが適宜エラーコードを ! 定義して利用するために空けてあります。 ! ! エラーではない状態を表す非エラーコードは *DC_NOERR* です。 ! ! エラーコードの数値の欄を設けたのは、新たなエラーコードを ! 割り当てる際の指針を示すためです。 ! ソースコードにはエラーコードをニーモニックで与えるべきであり、 ! 数値をハードコードすることは厳に慎んで下さい。 ! ! ! Programmers who add codes to gt4f90io library must call ! *StoreError* with appropriate error code. ! And so values of error code and corresponding messages are listed ! as follows to figure out if a new error code is needed to declared. ! To use error codes mnemonic, ! require "netcdf_f77" module or include "netcdf.inc" (deprecated) ! about error codes with prefix NF_E, or ! require "dc_error" module ! about error codes with prefix GT_E and ! DC_E and HST_E. ! Error codes smaller than USR_ERRNO are saved ! as user-defined error codes. ! ! Non error code that indicates normal (error-free) situation is ! *DC_NOERR*. ! ! List of numerical values of error codes ! issues a guideline about declaration of new error codes. ! Give not numerical value but mnemonic of error code to source code. ! !=== 利用しないコード !=== Unused codes ! ! 正の整数値はエラーコードとして使用しません。 ! ! NetCDF ライブラリは libc のエラーコード errno を返す可能性があり、 ! errno の数値には移植性がないため、全ての正の整数値は errno ! の仕様のために予約されているべきだからです。 ! ! Positive integer is not used as error codes. ! ! NetCDF library might return "libc" error code "error". ! Numerical value of "errno" is no portable, so positive integer ! should be reserved for "errno". ! !=== 非エラーコード !=== Non error code ! ! 以下の非エラーコードに関しては dc_error モジュールを引用することで ! 利用してください。 ! ! Use following non error code by refering this "dc_error" module. ! ! 数値. Number :: [ ニーモニック. Mnemonic ] ! ! 0 :: [ DC_NOERR ] ! ! !=== netCDF に関するエラーコード !=== Error codes for netCDF ! ! 以下のエラーコードに関しては netcdf_f77 モジュールを引用することで ! 利用してください。 ! ! Use following error codes by refering this "netcdf_f77" module. ! ! 数値. Number :: [ ニーモニック. Mnemonic ] エラーメッセージ. Error message ! ! 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 の拡張のための gt4f90io の予約領域. ! Reserved area for future extensions of netCDF) ! !=== gt4f90io のデータ構造 (gtdata) に関するエラーコード !=== Error codes for data structure of gt4f90io (gtdata) ! ! 以下のエラーコードに関しては dc_error モジュールを引用することで ! 利用してください。 ! ! Use following error codes by refering this "dc_error" module. ! ! 数値. Number :: [ ニーモニック. Mnemonic ] エラーメッセージ. Error message ! ! -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 ] ! :: cause_c: 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 (cause_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 ! ! -118 :: [ GT_ERANKMISMATCH ] ! :: rank of data and argument is mismatch (cause_c) ! -119 :: [ GT_ENOTURL ] ! :: URL (cause_c) is not found ! ! -120 :: [ GT_EBADGT4COMMAGRAPHY ] ! :: (cause_c) is not gtool4 comma-graphy (ex. "time=100.0,x=10:20,y=^1:^5") ! ! ! 〜-299 :: ! :: (将来の gtdata 層の拡張のための予約. ! Reserved area for future extensions of gtdata layer) ! !=== GrADS データ入出力に関するエラーコード !=== Error codes for GrADS data I/O ! ! 以下のエラーコードに関しては dc_error モジュールを引用することで ! 利用してください。 ! ! Use following error codes by refering this "dc_error" module. ! ! 数値. Number :: [ ニーモニック. Mnemonic ] エラーメッセージ. Error message ! ! -300 :: [ GR_ENOTGR ] ! :: invalid GrADS file ! ! 〜-399 :: ! :: (将来の GrADS data 入出力層の拡張のための予約. ! Reserved area for future extensions of GrADS data I/O layer) ! !=== DC ユーティリティ用エラーコード !=== Error codes for DC utilities ! ! 以下のエラーコードに関しては dc_error モジュールを引用することで ! 利用してください。 ! ! Use following error codes by refering this "dc_error" module. ! ! 数値. Number :: [ ニーモニック. Mnemonic ] エラーメッセージ. Error message ! ! -400 :: [ DC_ENOTINIT ] ! :: object (cause_c) is not initialized ! ! -401 :: [ DC_EALREADYINIT ] ! :: object (cause_c) is already initialized ! ! -402 :: [ DC_EBADUNIT ] ! :: unit (cause_c) is invalid ! ! -403 :: [ DC_EBADCALTYPE ] ! :: calendar type (cause_i) is invalid ! ! -404 :: [ DC_EBADTIMEZONE ] ! :: time zone (cause_c) is invalid ! ! -405 :: [ DC_EFILENAMEEMPTY ] ! :: filename is empty ! ! -406 :: [ DC_EBADFILEOPMODE ] ! :: file open mode (cause_c) is invalid ! ! -407 :: [ DC_ENOUNITNUM ] ! :: available unit number is not found within (cause_c) ! ! -408 :: [ DC_ENOFILEEXIST ] ! :: file (cause_c) is not found ! ! -409 :: [ DC_ENOFILEREAD ] ! :: file (cause_c) is not readable ! ! -410 :: [ DC_ENOFILEWRITE ] ! :: file (cause_c) is not writable ! ! -411 :: [ DC_ENEGATIVE ] ! :: negative value is invalid for (cause_c) ! ! -412 :: [ DC_EARGLACK ] ! :: lack of arguments (cause_c) ! ! -413 :: [ DC_ENOASSOC ] ! :: argument (cause_c) is not associated ! ! -414 :: [ DC_ENOENTRY ] ! :: entry of (cause_c) is not found ! ! -414〜-499 :: ! :: (将来の DC ユーティリティの拡張のための予約. ! Reserved area for future extensions of DC utilities) ! !=== データ入出力層 (gt4_history, gt4_history_nmlinfo, gt4_historyauto) エラーコード !=== Error codes for data I/O layer (gt4_history, gt4_history_nmlinfo, gt4_historyauto) ! ! 以下のエラーコードに関しては dc_error モジュールを引用することで ! 利用してください。 ! ! Use following error codes by refering this "dc_error" module. ! ! 数値. Number :: [ ニーモニック. Mnemonic ] エラーメッセージ. Error message ! ! -500 :: [ HST_ENOTINDEFINE ] ! :: operation (cause_c) not allowed in data mode ! ! -501 :: [ HST_EINDEFINE ] ! :: operation (cause_c) not allowed in define mode ! ! -502 :: [ HST_EINTFILE ] ! :: different intervals are applied to a file (cause_c) ! -503 :: [ HST_EBADNAME ] ! :: name (cause_c) is invalid ! ! -504 :: [ HST_ENOTTERMGTHIST ] ! :: GT_HISTORY correspond to (cause_c) is not terminated ! ! -505 :: [ HST_ENODEPENDTIME ] ! :: (cause_c) does not depend on time ! ! -506 :: [ HST_EBADVARNAME ] ! :: variable name (cause_c) is invalid ! !=== gt4f90io の将来の拡張のために予約してあるエラーコード !=== Reserved error codes for future extensions of gt4f90io ! ! 以下のエラーコードは今後の拡張も考えて予約してある部分です。 ! ! Following error codes are reserved for future extensions. ! ! 数値. Number :: [ ニーモニック. Mnemonic ] エラーメッセージ. Error message ! ! -600〜-999 :: ! :: (将来の gt4f90io の拡張のための予約. ! Reserved area for future extensions of gt4f90io) ! !=== ユーザ定義用エラーコード !=== User-defined error codes ! ! -1000 よりも小さいエラーコードは、 ! gt4f90io の上位のプログラムが利用するエラーコードとして空けてあります。 ! ! Error codes smaller than -1000 are saved for as user-defined error codes ! used by upper programs. ! ! 数値. Number :: [ ニーモニック. Mnemonic ] エラーメッセージ. Error message ! ! -1000〜 :: [ USR_ERRNO ] ! :: cause_c (cause_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 logical, private, save :: cause_int_valid = .false. 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 integer, parameter, public:: GT_ERANKMISMATCH = -118 integer, parameter, public:: GT_ENOTURL = -119 integer, parameter, public:: GT_EBADGT4COMMAGRAPHY = -120 ! ! -300 以下: GrADS 入出力のエラー ! integer, parameter, public:: GR_ENOTGR = -300 ! ! -400 以下: dc ユーティリティのエラー ! integer, parameter, public:: DC_ENOTINIT = -400 integer, parameter, public:: DC_EALREADYINIT = -401 integer, parameter, public:: DC_EBADUNIT = -402 integer, parameter, public:: DC_EBADCALTYPE = -403 integer, parameter, public:: DC_EBADTIMEZONE = -404 integer, parameter, public:: DC_EFILENAMEEMPTY = -405 integer, parameter, public:: DC_EBADFILEOPMODE = -406 integer, parameter, public:: DC_ENOUNITNUM = -407 integer, parameter, public:: DC_ENOFILEEXIST = -408 integer, parameter, public:: DC_ENOFILEREAD = -409 integer, parameter, public:: DC_ENOFILEWRITE = -410 integer, parameter, public:: DC_ENEGATIVE = -411 integer, parameter, public:: DC_EARGLACK = -412 integer, parameter, public:: DC_ENOASSOC = -413 integer, parameter, public:: DC_ENOENTRY = -414 ! ! -500 以下: データ入出力層のエラー ! integer, parameter, public:: HST_ENOTINDEFINE = -500 integer, parameter, public:: HST_EINDEFINE = -501 integer, parameter, public:: HST_EINTFILE = -502 integer, parameter, public:: HST_EBADNAME = -503 integer, parameter, public:: HST_ENOTTERMGTHIST = -504 integer, parameter, public:: HST_ENODEPENDTIME = -505 integer, parameter, public:: HST_EBADVARNAME = -506 ! ! -1000 以下: ユーザー定義 ! integer, parameter, public:: USR_ERRNO = -1000 public:: StoreError, DumpError, GetErrorMessage, ErrorCode ! ! === 手続引用仕様 === ! ! いずれ差し替えられるように外部関数にしておく。 interface subroutine DumpError() end subroutine DumpError end interface contains 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 = 180):: 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' ! ! -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' ! ! ! -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 is determined by error code automatically. ! See error code list. ! ! ! *** ERROR (Code number) [where] *** error_message ! ! *** ERROR (Code number) [where(cause_c)] *** error_message ! ! なお、gt4f90io のライブラリ外からユーザがエラー処理用ツール ! として StoreError を用いることを想定し、USR_ERRNO ! 番より小さい ! エラーコードは空けてあります。USR_ERRNO ! より小さい値をエラーコードに与えると, ! StoreError は以下の形式の文字列を標準出力に出力してプログラムを ! 終了させます。より安易に使えるメッセージ出力およびエラー発生の ! ためのモジュールとして *dc_message* も用意してあるので ! そちらも参照してください。 ! ! In addition, for usage that users call StoreError as an error ! handling tool from the outside of gt4f90io library, ! error codes smaller than USR_ERRNO is saved. ! When error codes smaller than USR_ERRNO 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) ! !-- !== 開発者向け解説 ! ! エラー番号 number を errno に格納する。同時に付随的情報 ! where, cause_i を cause_location, cause_string, ! cause_int に格納する。 ! err が与えられている場合、err は number が DC_NOERR の場合だけ偽になる。 ! number が DC_NOERR ならば即復帰する。 ! err が与えられていなければエラーメッセージを装置 * に出力して ! プログラムを終了する。 !++ 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 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 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 に渡してプログラムを終了させます。 ! ! Get error messages from "GetErrorMessage", and put the messages ! to sysdep#AbortProgram, and stop the program. ! use dc_types, only: STRING use dc_error, only: GetErrorMessage use sysdep, only: AbortProgram character(len = STRING):: message continue call GetErrorMessage(message) call AbortProgram(message) end subroutine DumpError