!---------------------------------------------------------------------
!     Copyright (C) GFD Dennou Club, 2004. All rights reserved.
!---------------------------------------------------------------------
!=begin
!= Module dc_message
!
!   * Editor: Morikawa Yasuhiro, Odaka Masatsugu.
!   * Last Update: 2004/12/25
!   * Created: 2004/12/23
!
!== Overview
!
!エラー処理も含めたメッセージ・警告の出力を行なう。
!((<dcl の MSGDMP.f|URL:http://www.gfd-dennou.org/arch/dcl/dcl-f77doc/rc1/math1/node26.html>))
!の上位互換としても利用できるようにしてある (つもり)。
!エラー処理自体は dc_error モジュールに依存。
!出力装置は標準出力に決め打ち。
!
!== Error Handling
!
!== Bugs
!
!== Note
!
!== Future Plans
!
!
!=end

module dc_message

  !=begin
  !== Public Interface
  private
  public:: MessageNotify ! subroutines
  !
  !=end

  !=begin
  !== Generic Procedure
  interface MessageNotify
     module procedure MessageNotifyC
     module procedure MessageNotifyI
  end interface
  !
  !=end

contains
  !=begin
  !== Procedure Interface
  !=end

  !=begin
  !=== メッセージ・警告・エラーの出力
  !
  !メッセージ・警告・エラーを出力したい場合に用います。
  !標準出力に出力されます。
  !
  !文字型変数 where にはプログラム名 (サブルーチン名) など、
  !プログラム内のどこでメッセージを出力するのかを示すものを与えます。
  !
  !文字型変数 message には、出力したい文字列を与えます。
  !オプション変数 i, r, d, L, s, n, c1, c2, c3 を付加する事も出来ます。
  !詳細に関しては dc_string モジュールの CPrintf を参照して下さい。
  !
  !文字型変数 level は出力するメッセージの種類を決める引数で、
  !((*'W'*)) (または((*'Warning'*))
  !など ((*'W'*)) で始まる文字) を与える事で((*警告*))を、
  !((*'E'*)) (または((*'Error'*))
  !など ((*'E'*)) で始まる文字) を与える事で
  !((*エラー (メッセージ出力後プログラムを終了) *))を、
  !それ以外の文字を与える事で((*通常のメッセージ*))を出力します。
  !なお、エラー出力する場合、エラーコード
  !は USR_ECHAR となります。
  !
  subroutine MessageNotifyC(level, where, message, &
       & i, r, d, L, n, c1, c2, c3)
  !
  !==== Dependency
  !
    use dc_types  ,only: string
    use dc_string ,only: UChar, StrHead, Printf, CPrintf
    use dc_error  ,only: StoreError, USR_ECHAR
  !
  !=end
    implicit none

    !=begin
    !==== Input
    !
    character(*), intent(in)          :: level
    character(*), intent(in)          :: where
    character(*), intent(in)          :: message
    integer     , intent(in), optional:: i(:), n(:)
    real        , intent(in), optional:: r(:)
    real(8)     , intent(in), optional:: d(:)
    logical     , intent(in), optional:: L(:)
    character(*), intent(in), optional:: c1, c2, c3
    !=end

    character(string)        :: msg
  continue

    if (   StrHead(  'ERROR', trim( UChar(level) )  )   ) then
       msg = Cprintf(message, &
            & i=i, r=r, d=d, L=L, n=n, c1=c1, c2=c2, c3=c3)
       call StoreError(USR_ECHAR, where, cause_c=msg)

    elseif (   StrHead(  'WARNING', trim( UChar(level) )  )   ) then
       msg = Cprintf(message, &
            & i=i, r=r, d=d, L=L, n=n, c1=c1, c2=c2, c3=c3)
       msg=' *** WARNING [' // trim(where) // '] ***  '// trim(msg)
       call Printf(fmt='%c', c1=msg)

    else
       msg = Cprintf(message, &
            & i=i, r=r, d=d, L=L, n=n, c1=c1, c2=c2, c3=c3)
       msg=' *** MESSAGE [' // trim(where) // '] ***  ' // trim(msg)
       call Printf(fmt='%c', c1=msg)

    endif

    return
  end subroutine MessageNotifyC

  !=begin
  !=== メッセージ・警告・エラーの出力
  !
  !原則的に MessageNotifyC と同様ですが、こちらは第１引数に数値型変数
  !number をとります。この number はそのまま StoreError に引き渡されます。
  !
  subroutine MessageNotifyI(number, where, message, &
       & i, r, d, L, n, c1, c2, c3)
  !
  !==== Dependency
  !
    use dc_string ,only: CPrintf
    use dc_error  ,only: StoreError, USR_ECHAR
  !
  !=end
    implicit none

    !=begin
    !==== Input
    !
    integer,      intent(in)          :: number
    character(*), intent(in)          :: where
    character(*), intent(in), optional:: message
    integer     , intent(in), optional:: i(:), n(:)
    real        , intent(in), optional:: r(:)
    real(8)     , intent(in), optional:: d(:)
    logical     , intent(in), optional:: L(:)
    character(*), intent(in), optional:: c1, c2, c3
    !=end
  continue

    if (.not. present(message)) then
       call StoreError(number, where)

    else
       call StoreError(number, where,  &
            & cause_c=CPrintf( message, &
            & i=i, r=r, d=d, L=L, n=n, c1=c1, c2=c2, c3=c3 )  )
    endif

    return
  end subroutine MessageNotifyI

  !=begin
  !== Output Form
  !  　
  !  *** MESSAGE [where] ***  message
  !  　
  !  *** WARNING [where] ***  message
  !  　
  !  *** ERROR (Code number) [where] *** message
  !
  !=end


end module dc_message