!== dc_message.f90 - メッセージの出力 ! ! Authors:: Yasuhiro MORIKAWA, Masatsugu ODAKA ! Version:: $Id: dc_message.f90,v 1.3 2006/06/03 16:58:32 morikawa Exp $ ! Tag Name:: $Name: gt4f90io-20060627 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. ! License:: See COPYRIGHT[link:../../COPYRIGHT] ! ! This file provides dc_message ! module dc_message 31,2 ! !== Overview ! !メッセージの出力を行うためのサブルーチン群を持つモジュールです。 !{dcl の MSGDMP.f}[http://www.gfd-dennou.org/arch/dcl/dcl-f77doc/rc1/math1/node26.html] !の上位互換としても利用することを想定しています。 !現在、出力装置は標準出力に固定されています。 ! ! !== Output Form ! ! 本モジュールのサブルーチンによって以下のような形式のメッセージ ! が出力されます。 ! ! ! *** MESSAGE [where] *** message ! ! *** WARNING [where] *** message ! ! *** ERROR (Code number) [where] *** message ! private public:: MessageNotify interface MessageNotify 34 module procedure MessageNotifyC module procedure MessageNotifyI end interface contains subroutine MessageNotifyC(level, where, message, & 1,8 & i, r, d, L, n, c1, c2, c3) ! !=== メッセージの出力およびエラーによる終了 ! ! メッセージを標準出力へ出力したい場合に用います。 ! ! 文字型変数 where にはプログラム名 (サブルーチン名) など、 ! プログラム内のどこでメッセージを出力するのかを示すものを与えます。 ! ! 文字型変数 message には、出力したい文字列を与えます。 ! オプション変数 i, r, d, L, s, n, c1, c2, c3 を付加する事も出来ます。 ! 詳細に関しては dc_string#CPrintf を参照して下さい。 ! ! 文字型変数 level は出力するメッセージの種類を決める引数で、 ! <b><tt>"W"</tt></b> (または<b><tt>"Warning"</tt></b> ! など <b><tt>"W"</tt></b> で始まる文字) ! を与える事で<b>警告</b>であることを、 ! <b><tt>"E"</tt></b> (または<b><tt>"Error"</tt></b> ! など <b><tt>"E"</tt></b> で始まる文字) を与える事で ! <b>エラー (メッセージ出力後プログラムを終了) </b>であることを、 ! それ以外の文字 (大抵は <b><tt>"M"</tt></b> ! を与えることを想定しています) ! を与える事で<b>通常のメッセージ</b>であることを指定します。 ! <b><tt>"E"</tt></b>を与えた場合はメッセージ出力後、プログラムを ! 強制終了させます。エラーコードは dc_error#USR_ECHAR となります。 ! use dc_types ,only: STRING, DP use dc_string ,only: UChar, StrHead, Printf, CPrintf use dc_error ,only: StoreError, USR_ECHAR implicit none character(*), intent(in) :: level ! "E", "W", "M" のどれかを与える。 character(*), intent(in) :: where ! プログラム名、手続き名 character(*), intent(in) :: message ! メッセージ integer , intent(in), optional:: i(:), n(:) real , intent(in), optional:: r(:) real(DP) , intent(in), optional:: d(:) logical , intent(in), optional:: L(:) character(*), intent(in), optional:: c1, c2, c3 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 subroutine MessageNotifyI(number, where, message, & 1,5 & i, r, d, L, n, c1, c2, c3) ! !=== メッセージの出力およびエラーによる終了 ! ! 基本的にもう一方の MessageNotify (または dc_message#MessageNotifyC) ! と同様ですが、こちらは第1引数に数値型変数 ! number をとります。この number はエラーコードとして、 ! そのまま dc_error#StoreError に引き渡されます。 ! エラーコードに関しては (dc_error を参照ください) ! use dc_types ,only: DP use dc_string ,only: CPrintf use dc_error ,only: StoreError, USR_ECHAR implicit none integer, intent(in) :: number ! エラーコード (dc_error 参照) character(*), intent(in) :: where character(*), intent(in), optional:: message integer , intent(in), optional:: i(:), n(:) real , intent(in), optional:: r(:) real(DP) , intent(in), optional:: d(:) logical , intent(in), optional:: L(:) character(*), intent(in), optional:: c1, c2, c3 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 end module dc_message