Subroutine : |
|
number : | integer, intent(in)
|
where : | character(*), intent(in)
: | エラー発生個所. Place where error occurs
|
|
err : | logical, intent(out), optional
: | 例外処理用フラグ. デフォルトでは, 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.
|
|
cause_c : | character(*), intent(in), optional
: | 文字型メッセージ. Character message
|
|
cause_i : | integer, intent(in), optional
: | 整数型メッセージ. Integer message
|
|
subroutine StoreError( number, where, err, cause_c, cause_i )
!
!== dcpam 用エラー処理サブルーチン
!
! 基本的な使用方法は gt4f90io の dc_error モジュールの
! StoreError と同様です. このモジュールで提供される StoreError
! は dcpam 用のエラーコードを使用可能です.
!
!== Error handling subroutine for dcpam
!
! Usage is same as StoreError provided by dc_error module in
! gt4f90io library. This StoreError can treat error codes for
! dcpam.
!
use dc_error, only: StoreErrorOrg => StoreError
use dc_types, only: STRING
implicit none
integer, intent(in):: number
! エラーコード.
! Error code
character(*), 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(*), intent(in), optional:: cause_c
! 文字型メッセージ.
! Character message
integer, intent(in), optional:: cause_i
! 整数型メッセージ.
! Integer message
character(STRING):: cause_string, msg
integer:: cause_int
continue
if (present(cause_c)) then
cause_string = cause_c
else
cause_string = ''
end if
if (present(cause_i)) then
cause_int = cause_i
else
cause_int = 0
end if
select case(number)
case(DCPAM_ENEGATIVE)
msg = ' negative value is invalid for (' // trim(cause_string) // ')'
call StoreErrorOrg(number, where, err, cause_c=msg)
case(DCPAM_EARGLACK)
msg = ' lack of arguments (' // trim(cause_string) // ')'
call StoreErrorOrg(number, where, err, cause_c=msg)
case(DCPAM_EALREADYINIT)
msg = ' object (' // trim(cause_string) // ') is already initialized'
call StoreErrorOrg(number, where, err, cause_c=msg)
case(DCPAM_ENOTINIT)
msg = ' object (' // trim(cause_string) // ') is not initialized'
call StoreErrorOrg(number, where, err, cause_c=msg)
case(DCPAM_ENOVARDEF)
msg = ' variable (' // trim(cause_string) // ') is not defined'
call StoreErrorOrg(number, where, err, cause_c=msg)
case(DCPAM_EARGSIZEMISMATCH)
msg = ' arguments (' // trim(cause_string) // ') array size mismatch'
call StoreErrorOrg(number, where, err, cause_c=msg)
case(DCPAM_ELMAXMISMATCH)
msg = ' <all wavenum> - <zonal wavenum> is over the meridonal wavenum' // trim(cause_string) // ')'
call StoreErrorOrg(number, where, err, cause_c=msg)
case(DCPAM_ENMLARRAYINSUFF)
msg = ' size of array (' // trim(cause_string) // ') in NAMELIST group is insufficient'
call StoreErrorOrg(number, where, err, cause_c=msg)
case default
call StoreErrorOrg(number, where, err, cause_c, cause_i)
end select
end subroutine StoreError