!= dcpam エラー処理モジュール
!
!= dcpam error handling module
!
! Authors::   Yasuhiro MORIKAWA
! Version::   $Id: dcpam_error.f90,v 1.12 2008-04-21 16:59:23 morikawa Exp $
! Tag Name::  $Name: dcpam4-20080427 $
! Copyright:: Copyright (C) GFD Dennou Club, 2007. All rights reserved.
! License::   See COPYRIGHT[link:../../../COPYRIGHT]
!

module dcpam_error
  !
  != dcpam エラー処理モジュール
  !
  != dcpam error handling module
  !
  ! <b>Note that Japanese and English are described in parallel.</b>
  !
  ! dcpam におけるエラー処理を行うモジュールです.
  ! 基本的には gt4f90io ライブラリの dc_error 
  ! モジュールのかぶせものです.
  !
  ! This module handles error in dcpam.
  ! It is a wrapper of dc_error module of gt4f90io library in principle.
  !
  !== エラーコード一覧
  !== Error code list
  !
  ! gt4f90io の dc_error で自由に使用することを許可されている -3000 〜
  ! -3099 を使用します.
  !
  ! Code number -3000 -- -3099 are used. They are allowed to use freely
  ! in dc_error module of gt4f90io library.
  !
  !
  !=== 非エラーコード
  !=== Non error code
  !
  ! 以下の非エラーコードに関してはこの dcpam_error モジュールを引用することで
  ! 利用してください. (この非エラーコードは dc_error と共有されています).
  !
  ! Use following non error code by refering this dcpam_error module. 
  ! (This non error code is shared with dc_error).
  !
  ! <b>数値. Number</b> :: <b>  [ ニーモニック. Mnemonic ]</b>
  !
  ! 0       :: [ <b>DC_NOERR       </b> ]
  !
  !
  !=== dcpam 用エラーコード
  !=== Error codes for dcpam
  !
  ! 以下のエラーコードに関してはこの dcpam_error モジュールを
  ! 引用することで利用してください。
  !
  ! Use following error codes by refering this dcpam_error module. 
  !
  ! <b>数値. Number</b> :: <b>  [ ニーモニック. Mnemonic ] エラーメッセージ. Error message</b>
  !
  ! -3000    :: [ <b>DCPAM_ENEGATIVE          </b> ]
  !             <b></b> :: negative value is invalid for (<i>cause_c</i>)
  !
  ! -3001    :: [ <b>DCPAM_EARGLACK          </b> ]
  !             <b></b> :: lack of arguments (<i>cause_c</i>)
  !
  ! -3002    :: [ <b>DCPAM_EALREADYINIT      </b> ]
  !             <b></b> :: object (<i>cause_c</i>) is already initialized
  !
  ! -3003    :: [ <b>DCPAM_ENOTINIT      </b> ]
  !             <b></b> :: object (<i>cause_c</i>) is not initialized
  !
  ! -3004    :: [ <b>DCPAM_ENOVARDEF      </b> ]
  !             <b></b> :: variable (<i>cause_c</i>) is not defined.
  !
  ! -3005    :: [ <b>DCPAM_EARGSIZEMISMATCH      </b> ]
  !             <b></b> :: arguments (<i>cause_c</i>) array size mismatch
  !
  ! -3006    :: [ <b>DCPAM_ELMAXMISMATCH      </b> ]
  !             <b></b> :: <all wavenum> - <zonal wavenum> is over the meridonal wavenum (<i>cause_c</i>)
  !
  ! -3007    :: [ <b>DCPAM_ENMLARRAYINSUFF      </b> ]
  !             <b></b> :: size of array (<i>cause_c</i>) in NAMELIST group is insufficient
  ! -3008    :: [ <b>DCPAM_EBADPATTERN      </b> ]
  !             <b></b> :: pattern (<i>cause_c</i>) is invalid
  !
  ! -3009    :: [ <b>DCPAM_EBADNUMBER       </b> ]
  !             <b></b> :: (<i>cause_c</i>=<i>cause_i</i>) is invalid
  !
  ! -3010    :: [ <b>DCPAM_EAXISMISMATCH       </b> ]
  !             <b></b> :: axis (<i>cause_c</i>) is mismatched
  !
  ! -3011    :: [ <b>DCPAM_EFAILINIT       </b> ]
  !             <b></b> :: object (<i>cause_c</i>) can not be initialized
  !
  ! -3012    :: [ <b>DCPAM_EBADSCHEME      </b> ]
  !             <b></b> :: scheme (<i>cause_c</i>) is invalid
  !
  ! -3013    :: [ <b>DCPAM_EBADMATHFUNC      </b> ]
  !             <b></b> :: mathematical function (<i>cause_c</i>) is invalid
  !
  ! -3014    :: [ <b>DCPAM_ESMALLVAL            </b> ]
  !             <b></b> :: (<i>cause_c</i>) is too small. Valid range is more than (<i>cause_i</i>)
  !
  ! -3015    :: [ <b>DCPAM_ENOPLANET            </b> ]
  !             <b></b> :: (<i>cause_c</i>) is not supported planet
  !

  !---------------------------------------------------------
  !  汎用ユーティリティ
  !  Common utilities
  !---------------------------------------------------------
  use dc_error, only: DC_NOERR
  implicit none

  private
  public :: DC_NOERR
  public :: StoreError

  !---------------------------------------------------------
  ! -3000 以下: dcpam のエラーコード定義. 
  ! Below -3000: declaration of error codes of dcpam
  !---------------------------------------------------------
  integer, parameter, public:: DCPAM_ENEGATIVE = -3000
  integer, parameter, public:: DCPAM_EARGLACK = -3001
  integer, parameter, public:: DCPAM_EALREADYINIT = -3002
  integer, parameter, public:: DCPAM_ENOTINIT = -3003
  integer, parameter, public:: DCPAM_ENOVARDEF = -3004
  integer, parameter, public:: DCPAM_EARGSIZEMISMATCH = -3005
  integer, parameter, public:: DCPAM_ELMAXMISMATCH = -3006
  integer, parameter, public:: DCPAM_ENMLARRAYINSUFF = -3007
  integer, parameter, public:: DCPAM_EBADPATTERN = -3008
  integer, parameter, public:: DCPAM_EBADNUMBER = -3009
  integer, parameter, public:: DCPAM_EAXISMISMATCH = -3010
  integer, parameter, public:: DCPAM_EFAILINIT = -3011
  integer, parameter, public:: DCPAM_EBADSCHEME = -3012
  integer, parameter, public:: DCPAM_EBADMATHFUNC = -3013
  integer, parameter, public:: DCPAM_ESMALLVAL = -3014
  integer, parameter, public:: DCPAM_ENOPLANET = -3015

  character(*), parameter:: version = &
    & '$Name: dcpam4-20080427 $' // &
    & '$Id: dcpam_error.f90,v 1.12 2008-04-21 16:59:23 morikawa Exp $'

contains

  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
    character(80):: ibuf ! real/write 文のバッファ (整数型用)
    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(DCPAM_EBADPATTERN)
        msg = ' pattern (' // trim(cause_string) // ') is invalid'
        call StoreErrorOrg(number, where, err, cause_c=msg)
      case(DCPAM_EBADNUMBER)
        write(ibuf, "(i20)") cause_int
        msg = ' (' // trim(cause_string) // '=' // trim(adjustl(ibuf)) // &
          & ') is invalid'
        call StoreErrorOrg(number, where, err, cause_c=msg)
      case(DCPAM_EAXISMISMATCH)
        msg = ' axis (' // trim(cause_string) // ') is mismatched'
        call StoreErrorOrg(number, where, err, cause_c=msg)
      case(DCPAM_EFAILINIT)
        msg = ' object (' // trim(cause_string) // ') can not be initialized'
        call StoreErrorOrg(number, where, err, cause_c=msg)
      case(DCPAM_EBADSCHEME)
        msg = ' scheme (' // trim(cause_string) // ') is invalid'
        call StoreErrorOrg(number, where, err, cause_c=msg)
      case(DCPAM_EBADMATHFUNC)
        msg = ' mathematical function (' // trim(cause_string) // ') is invalid'
        call StoreErrorOrg(number, where, err, cause_c=msg)
      case(DCPAM_ESMALLVAL)
        write(ibuf, "(i20)") cause_int
        msg = ' (' // trim(cause_string) // ') is too small. Valid range is more than (' // trim(adjustl(ibuf)) // ')'
        call StoreErrorOrg(number, where, err, cause_c=msg)
      case(DCPAM_ENOPLANET)
        msg = ' (' // trim(cause_string) // ') is not supported planet'
        call StoreErrorOrg(number, where, err, cause_c=msg)
      case default
        call StoreErrorOrg(number, where, err, cause_c, cause_i)
    end select

  end subroutine StoreError

end module dcpam_error