| Class | gt4_history_nmlinfo |
| In: |
gt4_history_nmlinfo.f90
|
Note that Japanese and English are described in parallel.
比較的大規模な数値モデルにおいて, データ出力の情報管理を 支援するためのモジュールです. 個別のモジュールがそれぞれ独立にデータ出力を行うことと, NAMELIST を用いて出力ファイルや出力間隔などを変更すること 想定して設計されています. ただし, このモジュール自体の主目的は情報の管理であり, 実際のデータ出力には gt4_history モジュールを 使用することに注意してください.
This module supports information management of data output in a comparatively large-scale numerical model. This module is designed expecting that individual modules perform data output independently, and output filename or output interval is changed from NAMELIST. Note that the purpose of this module is information management, therefore actual data output is performed by "gt4_history" module.
| HstNmlInfoCreate : | GTHST_NMLINFO 型変数の初期設定 |
| HstNmlInfoClose : | GTHST_NMLINFO 型変数の終了処理 |
| HstNmlInfoPutLine : | GTHST_NMLINFO 型変数に格納されている情報の印字 |
| HstNmlInfoInitialized : | GTHST_NMLINFO 型変数が初期設定されているか否か |
| HstNmlInfoDefineMode : | 定義モードの場合に真を返す |
| HstNmlInfoEndDefine : | 変数情報定義モードから出力モードへ変更 |
| HstNmlInfoReDefine : | 出力モードから変数情報定義モードへ変更 |
| HstNmlInfoAdd : | 変数情報の追加 |
| HstNmlInfoDelete : | 変数情報の削除 |
| HstNmlInfoResetDefault : | デフォルト設定のみに戻す |
| HstNmlInfoInquire : | 変数情報の問い合わせ |
| HstNmlInfoAssocGtHist : | 変数に応じた gt4_history#GT_HISTORY 型変数を返す |
| HstNmlInfoOutputStepDisable : | output_step が常に .false. を返すよう設定する |
| HstNmlInfoOutputStep : | 出力の設定が有効である場合に真を返す |
| HstNmlInfoOutputValid : | 現在の時刻が出力のタイミングの場合に真を返す |
| HstNmlInfoNames : | 登録されている変数名リストを返す |
| HstNmlInfoAllVarIniCheck : | 初期設定されていない変数名のチェック |
| HstNmlInfoSetValidName : | 変数名の有効性を設定 |
| HstNmlInfoAllNameValid : | 無効な変数名のチェック |
| ———— : | ———— |
| HstNmlInfoCreate : | Constructor of "GTHST_NMLINFO" |
| HstNmlInfoClose : | Deconstructor of "GTHST_NMLINFO" |
| HstNmlInfoPutLine : | Print information of "GTHST_NMLINFO" |
| HstNmlInfoInitialized : | Check initialization of "GTHST_NMLINFO" |
| HstNmlInfoDefineMode : | True is returned if current state is define mode |
| HstNmlInfoEndDefine : | Transit define mode about information of variables to output mode |
| HstNmlInfoReDefine : | Transit output mode to define mode about information of variables |
| HstNmlInfoAdd : | Add information of variables |
| HstNmlInfoDelete : | Delete information of variables |
| HstNmlInfoResetDefault : | Reset to default settings |
| HstNmlInfoInquire : | Inquire information of variables |
| HstNmlInfoAssocGtHist : | "gt4_history#GT_HISTORY" correspond to variable is returned |
| HstNmlInfoOutputStepDisable : | Configure that "output_step" returns .false. already |
| HstNmlInfoOutputStep : | True is returned when a configuration of output is valid |
| HstNmlInfoOutputValid : | True is returned when current time is output timing |
| HstNmlInfoNames : | Return list of registerd variable identifiers |
| HstNmlInfoAllVarIniCheck : | Check uninitialized variable names |
| HstNmlInfoSetValidName : | Set validation to variable names |
| HstNmlInfoAllNameValid : | Check invalid variable names |
このモジュールは以下のような手順で用いてください.
このモジュールを使用したサンプル Fortran プログラム 作成スクリプトが www.gfd-dennou.org/library/dcpam/dcpam4/dcpam4_current/script/f90/dcmodel_f90sample_maker.rb から入手できます. Ruby で記述されており, 実行することで サンプルとなる Fortran プログラムが作成されます. 下記の解説のみでは実際の利用法やご利益が分かりにくいため, サンプル Fortran プログラムを実際に見てみることをオススメします.
それぞれの変数に関して, 出力設定が有効かどうかについては, HstNmlInfoOutputValid で知ることが可能です.
また, 時間積分中に gt4_history#HistoryPut を使用する際 に, 現在時刻が出力タイミングかどうかについては, HstNmlInfoOutputStep で知ることが可能です.
Use this module as follows.
Sample Fortran programs generator (Ruby script) is available from www.gfd-dennou.org/library/dcpam/dcpam4/dcpam4_current/script/f90/dcmodel_f90sample_maker.rb . Sample Fortran programs are created by executing this script. Because neither actual usage nor the profit are understood easily only from the following explanations, It is recommended to see sample Fortran programs actually.
It can know whether the output setting is effective for each variable with "output_valid".
Moreover, it can know time now to be whether output timing when "gt4_history#HistoryPut" is used while integrating time with "output_step".
| Derived Type : |
NAMELIST から取得したヒストリデータの出力情報 を格納するための構造データ型です. まず, HstNmlInfoCreate で "GTHST_NMLINFO" 型の変数を初期設定して下さい. 初期設定された "GTHST_NMLINFO" 型の変数を再度利用する際には, HstNmlInfoClose によって終了処理を行ってください.
This derived type is worked in order to store information about data output from NAMELIST. Initialize "GTHST_NMLINFO" variable by "HstNmlInfoCreate" before usage. If you reuse "GTHST_NMLINFO" variable again for another application, terminate by "HstNmlInfoClose".
| Subroutine : | recursive | ||
| gthstnml : | type(GTHST_NMLINFO), intent(inout) | ||
| name : | character(*), intent(in), optional
| ||
| file : | character(*), intent(in), optional
| ||
| interval_value : | real, intent(in), optional
| ||
| interval_unit : | character(*), intent(in), optional
| ||
| precision : | character(*), intent(in), optional
| ||
| time_average : | logical, intent(in), optional
| ||
| average : | logical, intent(in), optional
| ||
| fileprefix : | character(*), intent(in), optional
| ||
| origin_value : | real, intent(in), optional
| ||
| origin_unit : | character(*), intent(in), optional
| ||
| terminus_value : | real, intent(in), optional
| ||
| terminus_unit : | character(*), intent(in), optional
| ||
| slice_start(:) : | integer, intent(in), optional
| ||
| slice_end(:) : | integer, intent(in), optional
| ||
| slice_stride(:) : | integer, intent(in), optional
| ||
| space_average(:) : | logical, intent(in), optional
| ||
| newfile_intvalue : | integer, intent(in), optional
| ||
| newfile_intunit : | character(*), intent(in), optional
| ||
| err : | logical, intent(out), optional
|
変数の出力情報を加えます.
デフォルト値を設定するには, name を与えないか, または name に空白を与えてください. デフォルト値を与える場合, file に与えられる情報は無視されます. fileprefix はデフォルト値に与える場合のみ有効です.
name に変数名が指定され, その際に file が与えられない, または空白が与えられる場合, file には "<name に与えられた文字>.nc" が指定されます.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合, プログラムはエラーを発生させます.
Add output information of a variable.
In order to set default values, specify blank to name or do not specify name. When default values are specified, file is ignored. fileprefix is valid only when default values are specified.
When a variable identifier is specified to name and file is not specified or blanks are specified to file, "<string given to name>.nc" is specified to file.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
recursive subroutine HstNmlInfoAdd( gthstnml, name, file, interval_value, interval_unit, precision, time_average, average, fileprefix, origin_value, origin_unit, terminus_value, terminus_unit, slice_start, slice_end, slice_stride, space_average, newfile_intvalue, newfile_intunit, err )
!
! 変数の出力情報を加えます.
!
! デフォルト値を設定するには, *name* を与えないか, または
! *name* に空白を与えてください.
! デフォルト値を与える場合, *file* に与えられる情報は無視されます.
! *fileprefix* はデフォルト値に与える場合のみ有効です.
!
! *name* に変数名が指定され, その際に *file* が与えられない,
! または空白が与えられる場合, *file* には
! "<i><*name* に与えられた文字></i>.nc" が指定されます.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合, プログラムはエラーを発生させます.
!
! Add output information of a variable.
!
! In order to set default values, specify blank to *name* or
! do not specify *name*.
! When default values are specified, *file* is ignored.
! *fileprefix* is valid only when default values are specified.
!
! When a variable identifier is specified to *name* and
! *file* is not specified or blanks are specified to *file*,
! "<i><string given to *name*></i>.nc" is specified to *file*.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar, CPrintf
use dc_present, only: present_and_not_empty, present_and_true, present_select
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_date_types, only: DC_DIFFTIME
use dc_date, only: DCDiffTimeCreate, operator(>), operator(<)
use dc_message, only: MessageNotify
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, DC_EARGLACK, USR_ERRNO, HST_ENOTINDEFINE, HST_EBADNEWFILEINT
implicit none
type(GTHST_NMLINFO), intent(inout):: gthstnml
character(*), intent(in), optional:: name
! 変数名.
!
! 先頭の空白は無視されます.
!
! "Data1,Data2" のようにカンマで区切って複数
! の変数を指定することも可能です.
!
!
! Variable identifier.
!
! Blanks at the head of the name are ignored.
!
! Multiple variables can be specified
! as "Data1,Data2" too. Delimiter is comma.
!
!
character(*), intent(in), optional:: file
! ヒストリデータのファイル名.
! History data filenames
real, intent(in), optional:: interval_value
! ヒストリデータの出力間隔の数値.
! 負の値を与えると, 出力を抑止します.
!
! Numerical value for interval of history data output.
! Negative values suppresses output.
character(*), intent(in), optional:: interval_unit
! ヒストリデータの出力間隔の単位.
! Unit for interval of history data output
character(*), intent(in), optional:: precision
! ヒストリデータの精度.
! Precision of history data
logical, intent(in), optional:: time_average
! 出力データの時間平均化フラグ.
! Flag for time average of output data.
logical, intent(in), optional:: average
! time_average の旧版.
! Old version of "time_average"
character(*), intent(in), optional:: fileprefix
! ヒストリデータのファイル名の接頭詞.
! Prefixes of history data filenames
real, intent(in), optional:: origin_value
! 出力開始時刻.
! Start time of output.
character(*), intent(in), optional:: origin_unit
! 出力開始時刻の単位.
! Unit of start time of output.
real, intent(in), optional:: terminus_value
! 出力終了時刻.
! End time of output.
character(*), intent(in), optional:: terminus_unit
! 出力終了時刻の単位.
! Unit of end time of output.
integer, intent(in), optional:: slice_start(:)
! 空間方向の開始点.
! Start points of spaces.
integer, intent(in), optional:: slice_end(:)
! 空間方向の終了点.
! End points of spaces.
integer, intent(in), optional:: slice_stride(:)
! 空間方向の刻み幅.
! Strides of spaces.
logical, intent(in), optional:: space_average(:)
! 平均化のフラグ.
! Flag of average.
integer, intent(in), optional:: newfile_intvalue
! ファイル分割時間間隔.
! Interval of time of separation of a file.
character(*), intent(in), optional:: newfile_intunit
! ファイル分割時間間隔の単位.
! Unit of interval of time of separation of a file.
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
type(GTHST_NMLINFO_ENTRY), pointer:: hptr_last =>null()
type(DC_DIFFTIME):: interval_time, newfileint_time
character(TOKEN), pointer:: varnames_array(:) =>null()
integer:: i, vnmax, ary_size
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoAdd'
continue
call BeginSub( subname, fmt = '@name=%a @file=%a @interval_value=%r @interval_unit=%a @precision=%a @time_average=%y @fileprefix=%a', r = (/ present_select(.true., -1.0, interval_value) /), l = (/ present_and_true(time_average) /), ca = StoA( present_select(.true., '<no>', name), present_select(.true., '<no>', file), present_select(.true., '<no>', interval_unit), present_select(.true., '<no>', precision), present_select(.true., '<no>', fileprefix) ) )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
if ( .not. gthstnml % define_mode ) then
stat = HST_ENOTINDEFINE
cause_c = 'Add'
goto 999
end if
!-----------------------------------------------------------------
! 複数の変数を設定する場合
! Configure multiple variables
!-----------------------------------------------------------------
if ( present_and_not_empty(name) ) then
if ( index(name, name_delimiter) > 0 ) then
call DbgMessage( 'multiple entries (%c) will be created', c1 = trim(name) )
!!$ if ( present(file) ) call DbgMessage( 'argument @file=%c is ignored', c1 = trim(file) )
call Split( str = name, sep = name_delimiter, carray = varnames_array ) ! (out)
vnmax = size( varnames_array )
do i = 1, vnmax
call HstNmlInfoAdd( gthstnml = gthstnml, name = varnames_array(i), file = file, interval_value = interval_value, interval_unit = interval_unit, precision = precision, time_average = time_average, average = average, origin_value = origin_value, origin_unit = origin_unit, terminus_value = terminus_value, terminus_unit = terminus_unit, slice_start = slice_start, slice_end = slice_end, slice_stride = slice_stride, space_average = space_average, newfile_intvalue = newfile_intvalue, newfile_intunit = newfile_intunit, err = err ) ! (out)
if ( present_and_true( err ) ) then
deallocate( varnames_array )
stat = USR_ERRNO
goto 999
end if
end do
deallocate( varnames_array )
goto 999
end if
end if
!-----------------------------------------------------------------
! *gthstnml* へ情報を追加.
! Add information to *gthstnml*
!-----------------------------------------------------------------
if ( .not. present_and_not_empty(name) ) then
if ( present(interval_value) ) gthstnml % gthstnml_list % interval_value = interval_value
if ( present(interval_unit) ) gthstnml % gthstnml_list % interval_unit = interval_unit
if ( present(precision) ) gthstnml % gthstnml_list % precision = precision
if ( present(average) ) gthstnml % gthstnml_list % time_average = average
if ( present(time_average) ) gthstnml % gthstnml_list % time_average = time_average
if ( present(fileprefix) ) gthstnml % gthstnml_list % fileprefix = fileprefix
if ( present(origin_value ) ) gthstnml % gthstnml_list % origin_value = origin_value
if ( present(origin_unit ) ) gthstnml % gthstnml_list % origin_unit = origin_unit
if ( present(terminus_value ) ) gthstnml % gthstnml_list % terminus_value = terminus_value
if ( present(terminus_unit ) ) gthstnml % gthstnml_list % terminus_unit = terminus_unit
if ( present(slice_start ) ) then
ary_size = size(slice_start)
gthstnml % gthstnml_list % slice_start(1:ary_size) = slice_start
end if
if ( present(slice_end ) ) then
ary_size = size(slice_end)
gthstnml % gthstnml_list % slice_end(1:ary_size) = slice_end
end if
if ( present(slice_stride ) ) then
ary_size = size(slice_stride)
gthstnml % gthstnml_list % slice_stride(1:ary_size) = slice_stride
end if
if ( present(space_average ) ) then
ary_size = size(space_average)
gthstnml % gthstnml_list % space_average(1:ary_size) = space_average
end if
if ( present(newfile_intvalue) ) gthstnml % gthstnml_list % newfile_intvalue = newfile_intvalue
if ( present(newfile_intunit ) ) gthstnml % gthstnml_list % newfile_intunit = newfile_intunit
hptr => gthstnml % gthstnml_list
else
hptr => gthstnml % gthstnml_list
call ListSearch( gthstnml_list = hptr, name = name ) ! (in)
if ( .not. associated(hptr) ) then
call DbgMessage( 'new entry (%c) is created', c1 = trim( adjustl( name ) ) )
hptr_last => gthstnml % gthstnml_list
call ListLast( gthstnml_list = hptr_last ) ! (inout)
allocate( hptr )
nullify( hptr % next )
hptr % interval_value => gthstnml % gthstnml_list % interval_value
hptr % interval_unit => gthstnml % gthstnml_list % interval_unit
hptr % precision => gthstnml % gthstnml_list % precision
hptr % time_average => gthstnml % gthstnml_list % time_average
hptr % fileprefix => gthstnml % gthstnml_list % fileprefix
hptr % origin_value => gthstnml % gthstnml_list % origin_value
hptr % origin_unit => gthstnml % gthstnml_list % origin_unit
hptr % terminus_value => gthstnml % gthstnml_list % terminus_value
hptr % terminus_unit => gthstnml % gthstnml_list % terminus_unit
hptr % slice_start => gthstnml % gthstnml_list % slice_start
hptr % slice_end => gthstnml % gthstnml_list % slice_end
hptr % slice_stride => gthstnml % gthstnml_list % slice_stride
hptr % space_average => gthstnml % gthstnml_list % space_average
hptr % newfile_intvalue => gthstnml % gthstnml_list % newfile_intvalue
hptr % newfile_intunit => gthstnml % gthstnml_list % newfile_intunit
hptr_last % next => hptr
else
call DbgMessage( 'entry (%c) is overwritten', c1 = trim( adjustl( name ) ) )
end if
hptr % name = adjustl( name )
if ( present_and_not_empty(file) ) then
hptr % file = file
nullify( hptr % fileprefix )
allocate( hptr % fileprefix )
hptr % fileprefix = ''
else
hptr % file = trim( adjustl(name) ) // '.nc'
end if
if ( present(interval_value) ) then
nullify( hptr % interval_value )
allocate( hptr % interval_value )
hptr % interval_value = interval_value
end if
if ( present(interval_unit) ) then
nullify( hptr % interval_unit )
allocate( hptr % interval_unit )
hptr % interval_unit = interval_unit
end if
if ( present(precision) ) then
nullify( hptr % precision )
allocate( hptr % precision )
hptr % precision = precision
end if
if ( present(average) ) then
nullify( hptr % time_average )
allocate( hptr % time_average )
hptr % time_average = average
end if
if ( present(time_average) ) then
nullify( hptr % time_average )
allocate( hptr % time_average )
hptr % time_average = time_average
end if
if ( present(origin_value) ) then
nullify( hptr % origin_value )
allocate( hptr % origin_value )
hptr % origin_value = origin_value
end if
if ( present(origin_unit) ) then
nullify( hptr % origin_unit )
allocate( hptr % origin_unit )
hptr % origin_unit = origin_unit
end if
if ( present(terminus_value) ) then
nullify( hptr % terminus_value )
allocate( hptr % terminus_value )
hptr % terminus_value = terminus_value
end if
if ( present(terminus_unit) ) then
nullify( hptr % terminus_unit )
allocate( hptr % terminus_unit )
hptr % terminus_unit = terminus_unit
end if
if ( present(slice_start) ) then
ary_size = size( slice_start )
nullify( hptr % slice_start )
allocate( hptr % slice_start(1:NF_MAX_DIMS) )
hptr % slice_start = 1
hptr % slice_start(1:ary_size) = slice_start
end if
if ( present(slice_end) ) then
ary_size = size( slice_end )
nullify( hptr % slice_end )
allocate( hptr % slice_end(1:NF_MAX_DIMS) )
hptr % slice_end = -1
hptr % slice_end(1:ary_size) = slice_end
end if
if ( present(slice_stride) ) then
ary_size = size( slice_stride )
nullify( hptr % slice_stride )
allocate( hptr % slice_stride(1:NF_MAX_DIMS) )
hptr % slice_stride = 1
hptr % slice_stride(1:ary_size) = slice_stride
end if
if ( present(space_average) ) then
ary_size = size( space_average )
nullify( hptr % space_average )
allocate( hptr % space_average(1:NF_MAX_DIMS) )
hptr % space_average = .false.
hptr % space_average(1:ary_size) = space_average
end if
if ( present(newfile_intvalue) ) then
nullify( hptr % newfile_intvalue )
allocate( hptr % newfile_intvalue )
hptr % newfile_intvalue = newfile_intvalue
end if
if ( present(newfile_intunit) ) then
nullify( hptr % newfile_intunit )
allocate( hptr % newfile_intunit )
hptr % newfile_intunit = newfile_intunit
end if
end if
!---------------------------------------------------------------
! 時間の単位のチェック
! Check unit of time
!---------------------------------------------------------------
call DCDiffTimeCreate( diff = interval_time, value = hptr % interval_value, unit = hptr % interval_unit, err = err ) ! (out)
if ( present_and_true( err ) ) then
call HstNmlInfoDelete( gthstnml = gthstnml, name = name ) ! (in)
stat = USR_ERRNO
goto 999
end if
!---------------------------------------------------------------
! ファイル分割時間間隔のチェック
! Check interval of time of separation of a file
!---------------------------------------------------------------
call DCDiffTimeCreate( diff = newfileint_time, value = real( hptr % newfile_intvalue ), unit = hptr % newfile_intunit, err = err ) ! (out)
if ( present_and_true( err ) ) then
call HstNmlInfoDelete( gthstnml = gthstnml, name = name ) ! (in)
stat = USR_ERRNO
goto 999
end if
if ( ( hptr % newfile_intvalue > 0 ) .and. .not. ( newfileint_time > interval_time ) ) then
call MessageNotify( 'W', subname, 'newfile_int=%d [%c] must be greater than interval=%r [%c]', i = (/ hptr % newfile_intvalue /), r = (/ hptr % interval_value /), c1 = trim( hptr % newfile_intunit ), c2 = trim( hptr % interval_unit ) )
call HstNmlInfoDelete( gthstnml = gthstnml, name = name ) ! (in)
stat = HST_EBADNEWFILEINT
cause_c = CPrintf( '%d [%c]', i = (/ hptr % newfile_intvalue /), c1 = trim( hptr % newfile_intunit ) )
goto 999
end if
nullify( hptr )
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoAdd
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(in) | ||
| invalid : | logical, intent(out)
| ||
| names : | character(*), intent(out)
| ||
| err : | logical, intent(out), optional
|
無効な変数名のチェック
HstNmlInfoSetValidName によって, 有効性を設定されていない変数が ある場合, invalid に .true. を返し, names には無効な 変数名をカンマで区切った文字列を返します.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合, プログラムはエラーを発生させます.
Check invalid variable names
If variable names that are not set validation by "HstNmlInfoSetValidName" are exist, .true. is set to invalid, and invalid variable names are joined with comma, and set to names.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
subroutine HstNmlInfoAllNameValid( gthstnml, invalid, names, err )
!
! 無効な変数名のチェック
!
! HstNmlInfoSetValidName によって, 有効性を設定されていない変数が
! ある場合,
! *invalid* に .true. を返し, *names* には無効な
! 変数名をカンマで区切った文字列を返します.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合, プログラムはエラーを発生させます.
!
! Check invalid variable names
!
! If variable names that are not set validation by
! "HstNmlInfoSetValidName" are exist,
! .true. is set to *invalid*, and invalid variable names
! are joined with comma, and set to *names*.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_present, only: present_and_not_empty, present_and_true
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, DC_EARGLACK, DC_ENOENTRY
use gt4_history, only: HistoryInitialized
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
logical, intent(out):: invalid
! 無効な変数名が存在する
! 場合には .true. を返す.
!
! If invalid variable names are exist,
! .true. is returned.
!
character(*), intent(out):: names
! 無効な変数名のリスト.
!
! List of invalid variable names.
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoAllNameValid'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
names = ''
invalid = .false.
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
!-----------------------------------------------------------------
! *gthstnml* 内から, *name* に関する情報を探査.
! Search information correspond to *name* in *gthstnml*
!-----------------------------------------------------------------
hptr => gthstnml % gthstnml_list
do while ( associated( hptr % next ) )
call ListNext( gthstnml_list = hptr ) ! (inout)
if ( hptr % name_invalid ) then
invalid = .true.
if ( trim(names) /= '' ) names = trim(names) // name_delimiter
names = trim(names) // adjustl( hptr % name )
end if
end do
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname, fmt = '@invalid=%y @names=%c', l = (/ invalid /), c1 = trim(names) )
end subroutine HstNmlInfoAllNameValid
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(in) | ||
| invalid : | logical, intent(out)
| ||
| names : | character(*), intent(out)
| ||
| err : | logical, intent(out), optional
|
初期設定されていない変数名のチェック
初期設定されていない変数名がある場合, invalid に .true. を返し, names には初期設定されていない 変数名をカンマで区切った文字列を返します.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合, プログラムはエラーを発生させます.
Check uninitialized variable names
If uninitialized variable names are exist, .true. is set to invalid, and uninitialized variable names are joined with comma, and set to names.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
subroutine HstNmlInfoAllVarIniCheck( gthstnml, invalid, names, err )
!
! 初期設定されていない変数名のチェック
!
! 初期設定されていない変数名がある場合,
! *invalid* に .true. を返し, *names* には初期設定されていない
! 変数名をカンマで区切った文字列を返します.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合, プログラムはエラーを発生させます.
!
! Check uninitialized variable names
!
! If uninitialized variable names are exist,
! .true. is set to *invalid*, and uninitialized variable names
! are joined with comma, and set to *names*.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_present, only: present_and_not_empty, present_and_true
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, DC_EARGLACK, DC_ENOENTRY
use gt4_history, only: HistoryInitialized
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
logical, intent(out):: invalid
! 初期設定されていない変数名が存在する
! 場合には .true. を返す.
!
! If uninitialized variable names are exist,
! .true. is returned.
!
character(*), intent(out):: names
! 初期設定されていない変数名のリスト.
!
! List of uninitialized variable names.
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoAllVarIniCheck'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
names = ''
invalid = .false.
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
!-----------------------------------------------------------------
! *gthstnml* 内から, *name* に関する情報を探査.
! Search information correspond to *name* in *gthstnml*
!-----------------------------------------------------------------
hptr => gthstnml % gthstnml_list
do while ( associated( hptr % next ) )
call ListNext( gthstnml_list = hptr ) ! (inout)
if ( .not. HistoryInitialized( hptr % history ) ) then
invalid = .true.
if ( trim(names) /= '' ) names = trim(names) // name_delimiter
names = trim(names) // adjustl( hptr % name )
end if
end do
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname, fmt = '@invalid=%y @names=%c', l = (/ invalid /), c1 = trim(names) )
end subroutine HstNmlInfoAllVarIniCheck
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(in) | ||
| name : | character(*), intent(in)
| ||
| history : | type(GT_HISTORY), pointer
| ||
| err : | logical, intent(out), optional
|
与えられた gt4_history#GT_HISTORY 型のポインタ history に対し, gthstnml 内の name に関する gt4_history#GT_HISTORY 型変数を 結合します. 空状態の history を与えてください.
HstNmlInfoEndDefine で定義モードから出力モードに 移行した後に呼び出してください. HstNmlInfoEndDefine を呼ぶ前にこのサブルーチンを使用すると, プログラムはエラーを発生させます.
name に関する情報が見当たらない場合, プログラムはエラーを発生させます. name が空文字の場合にも, プログラムはエラーを発生させます.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合にも, プログラムはエラーを発生させます.
This subroutine associates given "gt4_history#GT_HISTORY" pointer history to "gt4_history#GT_HISTORY" correspond to name in gthstnml. Give null history.
Use after state is changed from define mode to output mode by "HstNmlInfoEndDefine". If this subroutine is used before "HstNmlInfoEndDefine" is used, error is occurred.
When data correspond to name is not found, error is occurred. When name is blank, error is occurred too.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
subroutine HstNmlInfoAssocGtHist( gthstnml, name, history, err )
!
! 与えられた gt4_history#GT_HISTORY 型のポインタ *history* に対し,
! *gthstnml* 内の *name* に関する gt4_history#GT_HISTORY 型変数を
! 結合します.
! 空状態の *history* を与えてください.
!
! HstNmlInfoEndDefine で定義モードから出力モードに
! 移行した後に呼び出してください.
! HstNmlInfoEndDefine を呼ぶ前にこのサブルーチンを使用すると,
! プログラムはエラーを発生させます.
!
! *name* に関する情報が見当たらない場合,
! プログラムはエラーを発生させます.
! *name* が空文字の場合にも,
! プログラムはエラーを発生させます.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合にも, プログラムはエラーを発生させます.
!
! This subroutine associates given "gt4_history#GT_HISTORY"
! pointer *history* to
! "gt4_history#GT_HISTORY" correspond to *name* in *gthstnml*.
! Give null *history*.
!
! Use after state is changed from define mode to
! output mode by "HstNmlInfoEndDefine".
! If this subroutine is used before
! "HstNmlInfoEndDefine" is used, error is occurred.
!
! When data correspond to *name* is not found,
! error is occurred.
! When *name* is blank,
! error is occurred too.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, DC_ENOENTRY, HST_EBADNAME, HST_EINDEFINE
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
character(*), intent(in):: name
! 変数名.
! 先頭の空白は無視されます.
!
! Variable identifier.
! Blanks at the head of the name are ignored.
type(GT_HISTORY), pointer:: history
! (out)
!
! gt4_history モジュール用構造体.
! Derived type for "gt4_history" module
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoAssocGtHist'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
if ( trim( name ) == '' ) then
stat = HST_EBADNAME
cause_c = ''
goto 999
end if
if ( gthstnml % define_mode ) then
stat = HST_EINDEFINE
cause_c = 'AssocGtHist'
goto 999
end if
!-----------------------------------------------------------------
! *gthstnml* 内から, *name* に関する history を探査.
! Search "history" correspond to *name* in *gthstnml*
!-----------------------------------------------------------------
hptr => gthstnml % gthstnml_list
call ListSearch( gthstnml_list = hptr, name = name ) ! (in)
if ( .not. associated( hptr ) ) then
stat = DC_ENOENTRY
cause_c = adjustl( name )
goto 999
end if
nullify( history )
history => hptr % history
nullify( hptr )
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoAssocGtHist
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(inout) | ||
| err : | logical, intent(out), optional
|
GTHST_NMLINFO 型の変数の終了処理を行います.
このサブルーチンを使用する前に, gthstnml に格納されている gt4_history#GT_HISTORY 型の全ての変数に対して, gt4_history#HistoryClose を用いて終了処理を行ってください. 終了処理されていないものがある場合, プログラムはエラーを発生させます.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合, プログラムはエラーを発生させます.
Deconstructor of "GTHST_NMLINFO".
Terminate all "gt4_history#GT_HISTORY" variables in gthstnml by "gt4_history#HistoryClose" before this subroutine is used. If unterminated variables remain, error is occurred.
Note that if gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
subroutine HstNmlInfoClose( gthstnml, err )
!
! GTHST_NMLINFO 型の変数の終了処理を行います.
!
! このサブルーチンを使用する前に, *gthstnml* に格納されている
! gt4_history#GT_HISTORY 型の全ての変数に対して,
! gt4_history#HistoryClose を用いて終了処理を行ってください.
! 終了処理されていないものがある場合,
! プログラムはエラーを発生させます.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合, プログラムはエラーを発生させます.
!
! Deconstructor of "GTHST_NMLINFO".
!
! Terminate all "gt4_history#GT_HISTORY" variables in *gthstnml*
! by "gt4_history#HistoryClose" before this subroutine is used.
! If unterminated variables remain,
! error is occurred.
!
! Note that if *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, HST_ENOTTERMGTHIST
use gt4_history, only: HistoryInitialized
implicit none
type(GTHST_NMLINFO), intent(inout):: gthstnml
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
type(GTHST_NMLINFO_ENTRY), pointer:: hptr_prev =>null()
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoClose'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
!-----------------------------------------------------------------
! "GTHST_NMLINFO" の設定の消去
! Clear the settings for "GTHST_NMLINFO"
!-----------------------------------------------------------------
do
hptr => gthstnml % gthstnml_list
call ListLast( gthstnml_list = hptr, previous = hptr_prev ) ! (out)
call DbgMessage( 'remove entry (%c)', c1 = trim(hptr % name) )
if ( trim( hptr % name ) == '' ) exit
if ( .not. gthstnml % define_mode ) then
if ( HistoryInitialized( hptr % history ) ) then
stat = HST_ENOTTERMGTHIST
cause_c = hptr % name
goto 999
end if
end if
deallocate( hptr )
nullify( hptr_prev % next )
end do
deallocate( gthstnml % gthstnml_list )
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
gthstnml % initialized = .false.
gthstnml % define_mode = .true.
999 continue
nullify( hptr )
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoClose
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(inout) | ||
| interval_value : | real, intent(in), optional
| ||
| interval_unit : | character(*), intent(in), optional
| ||
| precision : | character(*), intent(in), optional
| ||
| time_average : | logical, intent(in), optional
| ||
| average : | logical, intent(in), optional
| ||
| fileprefix : | character(*), intent(in), optional
| ||
| origin_value : | real, intent(in), optional
| ||
| origin_unit : | character(*), intent(in), optional
| ||
| terminus_value : | real, intent(in), optional
| ||
| terminus_unit : | character(*), intent(in), optional
| ||
| slice_start(:) : | integer, intent(in), optional
| ||
| slice_end(:) : | integer, intent(in), optional
| ||
| slice_stride(:) : | integer, intent(in), optional
| ||
| space_average(:) : | logical, intent(in), optional
| ||
| newfile_intvalue : | integer, intent(in), optional
| ||
| newfile_intunit : | character(*), intent(in), optional
| ||
| err : | logical, intent(out), optional
|
GTHST_NMLINFO 型の変数の初期設定を行います. 他のサブルーチンを使用する前に必ずこのサブルーチンによって GTHST_NMLINFO 型の変数を初期設定してください.
interval_value, interval_unit, precision, time_average (旧 average) などの変数 はデフォルト値として設定されます. fileprefix は各変数の出力ファイル名の接頭詞として 使用されます.
なお, 与えられた gthstnml が既に初期設定されている場合, プログラムはエラーを発生させます.
Constructor of "GTHST_NMLINFO". Initialize gthstnml by this subroutine, before other procedures are used,
interval_value, interval_unit, precision, time_average (now-defunct average), etc. are set as default values. fileprefix is used as prefixes of output filenames of each variable.
Note that if gthstnml is already initialized by this procedure, error is occurred.
subroutine HstNmlInfoCreate( gthstnml, interval_value, interval_unit, precision, time_average, average, fileprefix, origin_value, origin_unit, terminus_value, terminus_unit, slice_start, slice_end, slice_stride, space_average, newfile_intvalue, newfile_intunit, err )
!
! GTHST_NMLINFO 型の変数の初期設定を行います.
! 他のサブルーチンを使用する前に必ずこのサブルーチンによって
! GTHST_NMLINFO 型の変数を初期設定してください.
!
! *interval_value*,
! *interval_unit*,
! *precision*,
! *time_average* (旧 *average*) などの変数
! はデフォルト値として設定されます.
! *fileprefix* は各変数の出力ファイル名の接頭詞として
! 使用されます.
!
! なお, 与えられた *gthstnml* が既に初期設定されている場合,
! プログラムはエラーを発生させます.
!
! Constructor of "GTHST_NMLINFO".
! Initialize *gthstnml* by this subroutine,
! before other procedures are used,
!
! *interval_value*,
! *interval_unit*,
! *precision*,
! *time_average* (now-defunct *average*), etc.
! are set as default values.
! *fileprefix* is used as prefixes of output filenames of
! each variable.
!
! Note that if *gthstnml* is already initialized
! by this procedure, error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_present, only: present_and_not_empty, present_and_true, present_select
use dc_message, only: MessageNotify
use dc_error, only: StoreError, DC_NOERR, DC_EALREADYINIT, DC_EARGLACK, DC_ENEGATIVE, DC_ENOFILEREAD, USR_ERRNO
use dc_date_types, only: DC_DIFFTIME
use dc_date, only: DCDiffTimeCreate
implicit none
type(GTHST_NMLINFO), intent(inout):: gthstnml
real, intent(in), optional:: interval_value
! ヒストリデータの出力間隔の数値.
! 負の値を与えると, 出力を抑止します.
!
! Numerical value for interval of history data output.
! Negative values suppresses output.
character(*), intent(in), optional:: interval_unit
! ヒストリデータの出力間隔の単位.
! Unit for interval of history data output
character(*), intent(in), optional:: precision
! ヒストリデータの精度.
! Precision of history data
logical, intent(in), optional:: time_average
! 出力データの時間平均化フラグ.
! Flag for time average of output data.
logical, intent(in), optional:: average
! time_average の旧版.
! Old version of "time_average"
character(*), intent(in), optional:: fileprefix
! ヒストリデータのファイル名の接頭詞.
! Prefixes of history data filenames
real, intent(in), optional:: origin_value
! 出力開始時刻.
! Start time of output.
character(*), intent(in), optional:: origin_unit
! 出力開始時刻の単位.
! Unit of start time of output.
real, intent(in), optional:: terminus_value
! 出力終了時刻.
! End time of output.
character(*), intent(in), optional:: terminus_unit
! 出力終了時刻の単位.
! Unit of end time of output.
integer, intent(in), optional:: slice_start(:)
! 空間方向の開始点.
! Start points of spaces.
integer, intent(in), optional:: slice_end(:)
! 空間方向の終了点.
! End points of spaces.
integer, intent(in), optional:: slice_stride(:)
! 空間方向の刻み幅.
! Strides of spaces.
logical, intent(in), optional:: space_average(:)
! 平均化のフラグ.
! Flag of average.
integer, intent(in), optional:: newfile_intvalue
! ファイル分割時間間隔.
! Interval of time of separation of a file.
character(*), intent(in), optional:: newfile_intunit
! ファイル分割時間間隔の単位.
! Unit of interval of time of separation of a file.
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(DC_DIFFTIME):: interval_time
integer:: stat, ary_size
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoCreate'
continue
call BeginSub( subname, fmt = '@interval_value=%r @interval_unit=%c @precision=%c @time_average=%y @fileprefix=%c', r = (/ present_select(.true., -1.0, interval_value) /), c1 = trim( present_select(.true., '<no>', interval_unit) ), c2 = trim( present_select(.true., '<no>', precision) ), l = (/ present_and_true(time_average) /), c3 = trim( present_select(.true., '<no>', fileprefix) ), version = version )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( gthstnml % initialized ) then
stat = DC_EALREADYINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
!-----------------------------------------------------------------
! 割付
! Allocate
!-----------------------------------------------------------------
allocate( gthstnml % gthstnml_list )
nullify( gthstnml % gthstnml_list % next )
!-----------------------------------------------------------------
! デフォルト値の設定
! Configure default values
!-----------------------------------------------------------------
gthstnml % gthstnml_list % name = ''
gthstnml % gthstnml_list % file = ''
allocate( gthstnml % gthstnml_list % interval_value )
allocate( gthstnml % gthstnml_list % interval_unit )
allocate( gthstnml % gthstnml_list % precision )
allocate( gthstnml % gthstnml_list % time_average )
allocate( gthstnml % gthstnml_list % fileprefix )
allocate( gthstnml % gthstnml_list % origin_value )
allocate( gthstnml % gthstnml_list % origin_unit )
allocate( gthstnml % gthstnml_list % terminus_value )
allocate( gthstnml % gthstnml_list % terminus_unit )
allocate( gthstnml % gthstnml_list % slice_start (1:NF_MAX_DIMS) )
allocate( gthstnml % gthstnml_list % slice_end (1:NF_MAX_DIMS) )
allocate( gthstnml % gthstnml_list % slice_stride (1:NF_MAX_DIMS) )
allocate( gthstnml % gthstnml_list % space_average (1:NF_MAX_DIMS) )
allocate( gthstnml % gthstnml_list % newfile_intvalue )
allocate( gthstnml % gthstnml_list % newfile_intunit )
gthstnml % gthstnml_list % interval_value = -1.0
gthstnml % gthstnml_list % interval_unit = 'sec'
gthstnml % gthstnml_list % precision = 'float'
gthstnml % gthstnml_list % time_average = .false.
gthstnml % gthstnml_list % fileprefix = ''
gthstnml % gthstnml_list % origin_value = -1.0
gthstnml % gthstnml_list % origin_unit = 'sec'
gthstnml % gthstnml_list % terminus_value = -1.0
gthstnml % gthstnml_list % terminus_unit = 'sec'
gthstnml % gthstnml_list % slice_start = 1
gthstnml % gthstnml_list % slice_end = -1
gthstnml % gthstnml_list % slice_stride = 1
gthstnml % gthstnml_list % space_average = .false.
gthstnml % gthstnml_list % newfile_intvalue = -1
gthstnml % gthstnml_list % newfile_intunit = 'sec'
if ( present(interval_value) ) gthstnml % gthstnml_list % interval_value = interval_value
if ( present(interval_unit) ) gthstnml % gthstnml_list % interval_unit = interval_unit
if ( present(precision) ) gthstnml % gthstnml_list % precision = precision
if ( present(average) ) gthstnml % gthstnml_list % time_average = average
if ( present(time_average) ) gthstnml % gthstnml_list % time_average = time_average
if ( present(fileprefix) ) gthstnml % gthstnml_list % fileprefix = fileprefix
if ( present(origin_value ) ) gthstnml % gthstnml_list % origin_value = origin_value
if ( present(origin_unit ) ) gthstnml % gthstnml_list % origin_unit = origin_unit
if ( present(terminus_value ) ) gthstnml % gthstnml_list % terminus_value = terminus_value
if ( present(terminus_unit ) ) gthstnml % gthstnml_list % terminus_unit = terminus_unit
if ( present(slice_start ) ) then
ary_size = size(slice_start)
gthstnml % gthstnml_list % slice_start(1:ary_size) = slice_start
end if
if ( present(slice_end ) ) then
ary_size = size(slice_end)
gthstnml % gthstnml_list % slice_end(1:ary_size) = slice_end
end if
if ( present(slice_stride ) ) then
ary_size = size(slice_stride)
gthstnml % gthstnml_list % slice_stride(1:ary_size) = slice_stride
end if
if ( present(space_average ) ) then
ary_size = size(space_average)
gthstnml % gthstnml_list % space_average(1:ary_size) = space_average
end if
if ( present(newfile_intvalue) ) gthstnml % gthstnml_list % newfile_intvalue = newfile_intvalue
if ( present(newfile_intunit ) ) gthstnml % gthstnml_list % newfile_intunit = newfile_intunit
!-----------------------------------------------------------------
! 時間の単位のチェック
! Check unit of time
!-----------------------------------------------------------------
call DCDiffTimeCreate( diff = interval_time, value = real( gthstnml % gthstnml_list % interval_value, DP ), unit = gthstnml % gthstnml_list % interval_unit, err = err ) ! (out)
if ( present_and_true( err ) ) then
stat = USR_ERRNO
goto 999
end if
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
gthstnml % initialized = .true.
gthstnml % define_mode = .true.
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoCreate
| Function : | |
| result : | logical |
| gthstnml : | type(GTHST_NMLINFO), intent(in) |
gthstnml が定義モードであれば .true. が, 定義モードでなければ .false. が返ります.
If gthstnml is define mode, .true. is returned. If gthstnml is not define mode, .false. is returned.
logical function HstNmlInfoDefineMode( gthstnml ) result(result)
!
! *gthstnml* が定義モードであれば .true. が,
! 定義モードでなければ .false. が返ります.
!
! If *gthstnml* is define mode, .true. is returned.
! If *gthstnml* is not define mode, .false. is returned.
!
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
continue
result = gthstnml % define_mode
end function HstNmlInfoDefineMode
| Subroutine : | recursive | ||
| gthstnml : | type(GTHST_NMLINFO), intent(inout) | ||
| name : | character(*), intent(in)
| ||
| err : | logical, intent(out), optional
|
変数の出力情報を削除します.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合, プログラムはエラーを発生させます.
Delete output information of a variable.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
recursive subroutine HstNmlInfoDelete( gthstnml, name, err )
!
! 変数の出力情報を削除します.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合, プログラムはエラーを発生させます.
!
! Delete output information of a variable.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_present, only: present_and_not_empty, present_and_true
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, DC_EARGLACK, USR_ERRNO, HST_ENOTINDEFINE
implicit none
type(GTHST_NMLINFO), intent(inout):: gthstnml
character(*), intent(in):: name
! 変数名.
!
! 先頭の空白は無視されます.
!
! "Data1,Data2" のようにカンマで区切って複数
! の変数を指定することが可能です.
!
! Variable identifier.
!
! Blanks at the head of the name are ignored.
!
! Multiple variables can be specified
! as "Data1,Data2". Delimiter is comma.
!
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
type(GTHST_NMLINFO_ENTRY), pointer:: hptr_prev =>null()
type(GTHST_NMLINFO_ENTRY), pointer:: hptr_next =>null()
character(TOKEN), pointer:: varnames_array(:) =>null()
integer:: i, vnmax
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoDelete'
continue
call BeginSub( subname, fmt = '@name=%c', c1 = trim( name ) )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
if ( .not. gthstnml % define_mode ) then
stat = HST_ENOTINDEFINE
cause_c = 'Delete'
goto 999
end if
!-----------------------------------------------------------------
! 複数の変数を削除する場合
! Delete multiple variables
!-----------------------------------------------------------------
if ( present_and_not_empty(name) ) then
if ( index(name, name_delimiter) > 0 ) then
call DbgMessage( 'multiple entries (%c) will be deleted', c1 = trim(name) )
call Split( str = name, sep = name_delimiter, carray = varnames_array ) ! (out)
vnmax = size( varnames_array )
do i = 1, vnmax
call HstNmlInfoDelete( gthstnml = gthstnml, name = varnames_array(i), err = err ) ! (out)
if ( present_and_true( err ) ) then
deallocate( varnames_array )
stat = USR_ERRNO
goto 999
end if
end do
deallocate( varnames_array )
goto 999
end if
end if
!-----------------------------------------------------------------
! *gthstnml* の情報を削除.
! Delete information in *gthstnml*
!-----------------------------------------------------------------
hptr => gthstnml % gthstnml_list
call ListSearch( gthstnml_list = hptr, name = name, previous = hptr_prev, next = hptr_next ) ! (out)
if ( .not. associated( hptr ) ) goto 999
if ( ( trim(hptr % name) /= '' ) .and. associated( hptr_prev ) ) then
call DbgMessage( 'entry (%c) is deleted', c1 = trim( adjustl( name ) ) )
hptr_prev % next => hptr_next
deallocate( hptr )
end if
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoDelete
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(inout) | ||
| err : | logical, intent(out), optional
|
定義モードから出力モードに移行し, gthstnml に設定した情報を確定します. HstNmlInfoAssocGTHist サブルーチンを呼び出す前に, 必ずこのサブルーチンを呼び出してください. このサブルーチンを呼んだ後に HstNmlInfoAdd, HstNmlInfoDelete, HstNmlInfoResetDefault を呼ぶとプログラムはエラーを発生させます.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合にも, プログラムはエラーを発生させます.
Transit from define mode to output mode, and determine information configured in gthstnml. Use this subroutine before "HstNmlInfoAssocGTHist" is used. If "HstNmlInfoAdd", "HstNmlInfoDelete", "HstNmlInfoResetDefault" are used after this subroutine is used, error is occurred.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
subroutine HstNmlInfoEndDefine( gthstnml, err )
!
! 定義モードから出力モードに移行し,
! *gthstnml* に設定した情報を確定します.
! HstNmlInfoAssocGTHist サブルーチンを呼び出す前に,
! 必ずこのサブルーチンを呼び出してください.
! このサブルーチンを呼んだ後に
! HstNmlInfoAdd, HstNmlInfoDelete, HstNmlInfoResetDefault
! を呼ぶとプログラムはエラーを発生させます.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合にも, プログラムはエラーを発生させます.
!
! Transit from define mode to output mode,
! and determine information configured in *gthstnml*.
! Use this subroutine before "HstNmlInfoAssocGTHist" is used.
! If "HstNmlInfoAdd", "HstNmlInfoDelete", "HstNmlInfoResetDefault"
! are used after
! this subroutine is used, error is occurred.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_hash, only: HASH, DCHashPut, DCHashGet, DCHashRewind, DCHashNext, DCHashNumber
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, HST_ENOTINDEFINE, HST_EINTFILE
use dc_message, only: MessageNotify
implicit none
type(GTHST_NMLINFO), intent(inout):: gthstnml
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 複数の変数を一つのファイルへ出力するためのチェック用変数
! Variables for checking for output multiple variables to one file
character(STRING):: opname, opfile
logical:: end
!-----------------------------------
! 作業変数
! Work variables
character(STRING):: fullfilename
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
type(GTHST_NMLINFO_ENTRY), pointer:: hptr_prev =>null()
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoEndDefine'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
if ( .not. gthstnml % define_mode ) then
stat = HST_ENOTINDEFINE
cause_c = 'EndDefine'
goto 999
end if
!-----------------------------------------------------------------
! gt4_history#GT_HISTORY 変数の割付
! Allocate "gt4_history#GT_HISTORY" variables
!-----------------------------------------------------------------
hptr => gthstnml % gthstnml_list
if ( .not. associated( hptr % history ) ) then
allocate( hptr % history )
end if
WholeLoop : do while ( associated( hptr % next ) )
call ListNext( gthstnml_list = hptr ) ! (inout)
if ( trim(hptr % name) == '' .or. trim(hptr % file) == '' ) cycle WholeLoop
fullfilename = trim( hptr % fileprefix ) // hptr % file
!---------------------------------------------------------------
! 以前に同一ファイル名の gt4_history#GT_HISTORY 変数がある場合, そちらに結合
! If "gt4_history#GT_HISTORY" that has same filename exist already, associate to it
!---------------------------------------------------------------
nullify( hptr_prev )
call DCHashRewind(opened_files) ! (inout)
SearchLoop : do
call DCHashNext( opened_files, opname, opfile, end ) ! (out)
if ( end ) exit SearchLoop
if ( trim(opfile) /= trim(fullfilename) ) cycle SearchLoop
hptr_prev => gthstnml % gthstnml_list
call ListSearch( gthstnml_list = hptr_prev, name = opname ) ! (in)
if ( .not. associated( hptr_prev ) ) cycle SearchLoop
if ( trim(hptr % name) == trim(hptr_prev % name) ) cycle SearchLoop
! interval_value, interval_unit の同一性をチェック
! Check consistency of "interval_value", "interval_unit"
!
if ( hptr % interval_value /= hptr_prev % interval_value ) then
call MessageNotify( 'W', subname, '@interval_value=%r (var=%a) and @interval_value=%r (var=%a) are applied to a file "%a"', r = (/hptr % interval_value, hptr_prev % interval_value/), ca = StoA(hptr % name, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
elseif ( hptr % interval_unit /= hptr_prev % interval_unit ) then
call MessageNotify( 'W', subname, '@interval_unit=%a (var=%a) and @interval_unit=%a (var=%a) are applied to a file "%a"', ca = StoA(hptr % interval_unit, hptr % name, hptr_prev % interval_unit, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
end if
! origin_value, origin_unit の同一性をチェック
! Check consistency of "origin_value", "origin_unit"
!
if ( hptr % origin_value /= hptr_prev % origin_value ) then
call MessageNotify( 'W', subname, '@origin_value=%r (var=%a) and @origin_value=%r (var=%a) are applied to a file "%a"', r = (/hptr % origin_value, hptr_prev % origin_value/), ca = StoA(hptr % name, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
elseif ( hptr % origin_unit /= hptr_prev % origin_unit ) then
call MessageNotify( 'W', subname, '@origin_unit=%a (var=%a) and @origin_unit=%a (var=%a) are applied to a file "%a"', ca = StoA(hptr % origin_unit, hptr % name, hptr_prev % origin_unit, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
end if
! terminus_value, terminus_unit の同一性をチェック
! Check consistency of "terminus_value", "terminus_unit"
!
if ( hptr % terminus_value /= hptr_prev % terminus_value ) then
call MessageNotify( 'W', subname, '@terminus_value=%r (var=%a) and @terminus_value=%r (var=%a) are applied to a file "%a"', r = (/hptr % terminus_value, hptr_prev % terminus_value/), ca = StoA(hptr % name, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
elseif ( hptr % terminus_unit /= hptr_prev % terminus_unit ) then
call MessageNotify( 'W', subname, '@terminus_unit=%a (var=%a) and @terminus_unit=%a (var=%a) are applied to a file "%a"', ca = StoA(hptr % terminus_unit, hptr % name, hptr_prev % terminus_unit, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
end if
! newfile_intvalue が有効な場合はエラーを返す.
! Error is occurred when "newfile_intvalue" is valid
!
if ( ( hptr % newfile_intvalue > 0.0 ) .or. ( hptr_prev % newfile_intvalue > 0.0 ) ) then
call MessageNotify( 'W', subname, 'when @newfile_intvalue=%d (var=%a) > 0 or' // ' @newfile_intvalue=%d (var=%a) > 0, multiple variables can not be output to one file "%a"', i = (/hptr % newfile_intvalue, hptr_prev % newfile_intvalue/), ca = StoA(hptr % name, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
end if
! newfile_intvalue, newfile_intunit の同一性をチェック
! Check consistency of "newfile_intvalue", "newfile_intunit"
!
if ( hptr % newfile_intvalue /= hptr_prev % newfile_intvalue ) then
call MessageNotify( 'W', subname, '@newfile_intvalue=%d (var=%a) and @newfile_intvalue=%d (var=%a) are applied to a file "%a"', i = (/hptr % newfile_intvalue, hptr_prev % newfile_intvalue/), ca = StoA(hptr % name, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
elseif ( hptr % newfile_intunit /= hptr_prev % newfile_intunit ) then
call MessageNotify( 'W', subname, '@newfile_intunit=%a (var=%a) and @newfile_intunit=%a (var=%a) are applied to a file "%a"', ca = StoA(hptr % newfile_intunit, hptr % name, hptr_prev % newfile_intunit, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
end if
! slice_start, slice_end, slice_stride, space_average の同一性チェック
! Check consistency of "slice_start", "slice_end", "slice_stride", "space_average"
!
if ( any( hptr % slice_start /= hptr_prev % slice_start ) ) then
call MessageNotify( 'W', subname, '@slice_start=%*d (var=%a) and @slice_start=%*d (var=%a) are applied to a file "%a"', i = (/hptr % slice_start(1:10), hptr_prev % slice_start(1:10)/), n = (/10, 10/), ca = StoA(hptr % name, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
elseif ( any( hptr % slice_end /= hptr_prev % slice_end ) ) then
call MessageNotify( 'W', subname, '@slice_end=%*d (var=%a) and @slice_end=%*d (var=%a) are applied to a file "%a"', i = (/hptr % slice_end(1:10), hptr_prev % slice_end(1:10)/), n = (/10, 10/), ca = StoA(hptr % name, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
elseif ( any( hptr % slice_stride /= hptr_prev % slice_stride ) ) then
call MessageNotify( 'W', subname, '@slice_stride=%*d (var=%a) and @slice_stride=%*d (var=%a) are applied to a file "%a"', i = (/hptr % slice_stride(1:10), hptr_prev % slice_stride(1:10)/), n = (/10, 10/), ca = StoA(hptr % name, hptr_prev % name, fullfilename) )
stat = HST_EINTFILE
cause_c = fullfilename
goto 999
end if
!
! GT_HISTORY 変数の結合
! Associate "GT_HISTORY" variable
!
hptr % history => hptr_prev % history
exit SearchLoop
end do SearchLoop
!---------------------------------------------------------------
! 新規に割付
! Allocate newly
!---------------------------------------------------------------
if ( .not. associated( hptr % history ) ) then
allocate( hptr % history )
end if
!---------------------------------------------------------------
! 割り付けられた名前とファイル名を登録
! Regist allocated name and filename
!---------------------------------------------------------------
call DCHashPut( opened_files, hptr % name, fullfilename ) ! (in)
end do WholeLoop
nullify( hptr )
nullify( hptr_prev )
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
gthstnml % define_mode = .false.
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoEndDefine
| Function : | |
| result : | logical |
| gthstnml : | type(GTHST_NMLINFO), intent(in) |
gthstnml が初期設定されている場合には .true. が, 初期設定されていない場合には .false. が返ります.
If gthstnml is initialized, .true. is returned. If gthstnml is not initialized, .false. is returned.
logical function HstNmlInfoInitialized( gthstnml ) result(result)
!
! *gthstnml* が初期設定されている場合には .true. が,
! 初期設定されていない場合には .false. が返ります.
!
! If *gthstnml* is initialized, .true. is returned.
! If *gthstnml* is not initialized, .false. is returned.
!
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
continue
result = gthstnml % initialized
end function HstNmlInfoInitialized
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(in) | ||
| name : | character(*), intent(in), optional
| ||
| file : | character(*), intent(out), optional
| ||
| interval_value : | real, intent(out), optional
| ||
| interval_unit : | character(*), intent(out), optional
| ||
| precision : | character(*), intent(out), optional
| ||
| time_average : | logical, intent(out), optional
| ||
| average : | logical, intent(out), optional
| ||
| fileprefix : | character(*), intent(out), optional
| ||
| origin_value : | real, intent(out), optional
| ||
| origin_unit : | character(*), intent(out), optional
| ||
| terminus_value : | real, intent(out), optional
| ||
| terminus_unit : | character(*), intent(out), optional
| ||
| slice_start(:) : | integer, intent(out), optional
| ||
| slice_end(:) : | integer, intent(out), optional
| ||
| slice_stride(:) : | integer, intent(out), optional
| ||
| space_average(:) : | logical, intent(out), optional
| ||
| newfile_intvalue : | integer, intent(out), optional
| ||
| newfile_intunit : | character(*), intent(out), optional
| ||
| err : | logical, intent(out), optional
|
変数の出力情報を取得します.
デフォルト値を取得するには, name を与えないか, または name に空白を与えてください.
name に関するデータが存在しない場合, エラーを発生させます.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合, プログラムはエラーを発生させます.
Inquire output information of a variable.
If data correspond to name is not found, error is occurred.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
subroutine HstNmlInfoInquire( gthstnml, name, file, interval_value, interval_unit, precision, time_average, average, fileprefix, origin_value, origin_unit, terminus_value, terminus_unit, slice_start, slice_end, slice_stride, space_average, newfile_intvalue, newfile_intunit, err )
!
! 変数の出力情報を取得します.
!
! デフォルト値を取得するには, *name* を与えないか, または
! *name* に空白を与えてください.
!
! *name* に関するデータが存在しない場合, エラーを発生させます.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合, プログラムはエラーを発生させます.
!
! Inquire output information of a variable.
!
! If data correspond to *name* is not found,
! error is occurred.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_present, only: present_and_not_empty, present_and_true
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, DC_EARGLACK, DC_ENOENTRY
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
character(*), intent(in), optional:: name
! 変数名.
! 先頭の空白は無視されます.
!
! Variable identifier.
! Blanks at the head of the name are ignored.
character(*), intent(out), optional:: file
! ヒストリデータのファイル名.
! History data filenames
real, intent(out), optional:: interval_value
! ヒストリデータの出力間隔の数値.
! 負の値を与えると, 出力を抑止します.
!
! Numerical value for interval of history data output.
! Negative values suppresses output.
character(*), intent(out), optional:: interval_unit
! ヒストリデータの出力間隔の単位.
! Unit for interval of history data output
character(*), intent(out), optional:: precision
! ヒストリデータの精度.
! Precision of history data
logical, intent(out), optional:: time_average
! 出力データの時間平均化フラグ.
! Flag for time average of output data.
logical, intent(out), optional:: average
! time_average の旧版.
! Old version of "time_average"
character(*), intent(out), optional:: fileprefix
! ヒストリデータのファイル名の接頭詞.
! Prefixes of history data filenames
real, intent(out), optional:: origin_value
! 出力開始時刻.
! Start time of output.
character(*), intent(out), optional:: origin_unit
! 出力開始時刻の単位.
! Unit of start time of output.
real, intent(out), optional:: terminus_value
! 出力終了時刻.
! End time of output.
character(*), intent(out), optional:: terminus_unit
! 出力終了時刻の単位.
! Unit of end time of output.
integer, intent(out), optional:: slice_start(:)
! 空間方向の開始点.
! Start points of spaces.
integer, intent(out), optional:: slice_end(:)
! 空間方向の終了点.
! End points of spaces.
integer, intent(out), optional:: slice_stride(:)
! 空間方向の刻み幅.
! Strides of spaces.
logical, intent(out), optional:: space_average(:)
! 平均化のフラグ.
! Flag of average.
integer, intent(out), optional:: newfile_intvalue
! ファイル分割時間間隔.
! Interval of time of separation of a file.
character(*), intent(out), optional:: newfile_intunit
! ファイル分割時間間隔の単位.
! Unit of interval of time of separation of a file.
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
character(STRING):: name_work
integer:: stat, ary_size
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoInquire'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
!-----------------------------------------------------------------
! *gthstnml* 内から, *name* に関する情報を探査.
! Search information correspond to *name* in *gthstnml*
!-----------------------------------------------------------------
if ( present(name) ) then
name_work = name
else
name_work = ''
end if
hptr => gthstnml % gthstnml_list
call ListSearch( gthstnml_list = hptr, name = name_work ) ! (in)
if ( .not. associated( hptr ) ) then
stat = DC_ENOENTRY
cause_c = adjustl( name_work )
goto 999
end if
if ( hptr % name == '' ) then
if ( present(file) ) file = ''
else
if ( present(file) ) file = trim( hptr % fileprefix ) // hptr % file
end if
if ( present(interval_value) ) interval_value = hptr % interval_value
if ( present(interval_unit) ) interval_unit = hptr % interval_unit
if ( present(precision) ) precision = hptr % precision
if ( present(average) ) average = hptr % time_average
if ( present(time_average) ) time_average = hptr % time_average
if ( present(fileprefix) ) fileprefix = hptr % fileprefix
if ( present(origin_value ) ) origin_value = hptr % origin_value
if ( present(origin_unit ) ) origin_unit = hptr % origin_unit
if ( present(terminus_value ) ) terminus_value = hptr % terminus_value
if ( present(terminus_unit ) ) terminus_unit = hptr % terminus_unit
if ( present(slice_start ) ) then
ary_size = size(slice_start)
slice_start = hptr % slice_start(1:ary_size)
end if
if ( present(slice_end ) ) then
ary_size = size(slice_end)
slice_end = hptr % slice_end(1:ary_size)
end if
if ( present(slice_stride ) ) then
ary_size = size(slice_stride)
slice_stride = hptr % slice_stride(1:ary_size)
end if
if ( present(space_average ) ) then
ary_size = size(space_average)
space_average = hptr % space_average(1:ary_size)
end if
if ( present(newfile_intvalue) ) newfile_intvalue = hptr % newfile_intvalue
if ( present(newfile_intunit ) ) newfile_intunit = hptr % newfile_intunit
nullify( hptr )
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoInquire
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(in) | ||
| varnames_ary(:) : | character(TOKEN), pointer
| ||
| err : | logical, intent(out), optional
|
gthstnml が設定されている変数リストを文字型配列ポインタに 返します. varnames_ary は空状態にして与えてください.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合, プログラムはエラーを発生させます.
List of variables registered in gthstnml is returned to character array pointer. Nullify "varnames_ary" before it is given to this subroutine.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
subroutine HstNmlInfoNames( gthstnml, varnames_ary, err )
!
! *gthstnml* が設定されている変数リストを文字型配列ポインタに
! 返します. varnames_ary は空状態にして与えてください.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合, プログラムはエラーを発生させます.
!
! List of variables registered in *gthstnml* is returned to
! character array pointer.
! Nullify "varnames_ary" before it is given to this subroutine.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT
use netcdf_f77, only: NF_MAX_VARS
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
character(TOKEN), pointer:: varnames_ary(:) ! (out)
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
integer:: varnums, ary_size
character(TOKEN), allocatable:: varnames_ary_tmp1(:), varnames_ary_tmp2(:)
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoNames'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
varnums = 0
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
!-----------------------------------------------------------------
! 割り付け
! Allocate
!-----------------------------------------------------------------
if ( associated(varnames_ary) ) deallocate(varnames_ary)
allocate( varnames_ary_tmp1(1:NF_MAX_VARS) )
!-----------------------------------------------------------------
! 情報の取り出し
! Fetch information
!-----------------------------------------------------------------
hptr => gthstnml % gthstnml_list
do while ( associated( hptr % next ) )
call ListNext( gthstnml_list = hptr ) ! (inout)
varnums = varnums + 1
ary_size = size( varnames_ary_tmp1 )
if ( varnums > ary_size ) then
allocate( varnames_ary_tmp2(1:ary_size) )
varnames_ary_tmp2(1:ary_size) = varnames_ary_tmp1(1:ary_size)
deallocate( varnames_ary_tmp1 )
allocate( varnames_ary_tmp1(1:varnums*2) )
varnames_ary_tmp1(1:ary_size) = varnames_ary_tmp2(1:ary_size)
deallocate( varnames_ary_tmp2 )
end if
varnames_ary_tmp1(varnums) = adjustl( hptr % name )
end do
if ( varnums > 0 ) then
allocate( varnames_ary(1:varnums) )
varnames_ary(1:varnums) = varnames_ary_tmp1(1:varnums)
else
allocate( varnames_ary(1:1) )
varnames_ary = ''
end if
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
nullify( hptr )
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoNames
| Function : | |||
| result : | logical | ||
| gthstnml : | type(GTHST_NMLINFO), intent(in) | ||
| name : | character(*), intent(in)
| ||
| time : | type(DC_DIFFTIME), intent(in)
|
time が変数 name の出力されるタイミングであれば .true. を, そうでなければ .false. を返します. gthstnml が初期設定されていない場合にも .false. が返ります. name に関するデータが存在しない場合にも .false. が返ります.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合, プログラムはエラーを発生させます.
If time is the time that a variable name is output, .true. is returned, otherwise .false. is returned When gthstnml is not initialized, .false. is returned too. When data correspond to name is not found, .false. is returned too.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
logical function HstNmlInfoOutputStep( gthstnml, name, time ) result(result)
!
! *time* が変数 *name* の出力されるタイミングであれば
! .true. を, そうでなければ .false. を返します.
! *gthstnml* が初期設定されていない場合にも .false. が返ります.
! *name* に関するデータが存在しない場合にも .false. が返ります.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合, プログラムはエラーを発生させます.
!
! If *time* is the time that a variable *name* is output,
! .true. is returned, otherwise .false. is returned
! When *gthstnml* is not initialized, .false. is returned too.
! When data correspond to *name* is not found, .false. is returned too.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_present, only: present_and_not_empty, present_and_true
use dc_date_types, only: DC_DIFFTIME
use dc_date, only: DCDiffTimeCreate, mod, operator(==), toChar
use dc_types, only: DP, STRING, TOKEN, STDOUT
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
character(*), intent(in):: name
! 変数名.
! 先頭の空白は無視されます.
!
! Variable identifier.
! Blanks at the head of the name are ignored.
type(DC_DIFFTIME), intent(in):: time
! 現在時刻. Current time
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
type(DC_DIFFTIME):: interval_time
!!$ character(*), parameter:: subname = 'HstNmlInfoOutputStep'
continue
result = .false.
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) goto 999
!-----------------------------------------------------------------
! 情報格納変数への結合
! Associate a variable storing information
!-----------------------------------------------------------------
hptr => gthstnml % gthstnml_list
call ListSearch( gthstnml_list = hptr, name = name ) ! (in)
if ( .not. associated( hptr ) ) goto 999
if ( hptr % output_step_disable ) goto 999
!-----------------------------------------------------------------
! 時刻のチェック
! Check time
!-----------------------------------------------------------------
if ( .not. hptr % interval_value > 0.0 ) goto 999
call DCDiffTimeCreate( diff = interval_time, value = real( hptr % interval_value, DP ), unit = hptr % interval_unit ) ! (in)
if ( mod( time, interval_time ) == 0 ) then
result = .true.
end if
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
nullify( hptr )
end function HstNmlInfoOutputStep
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(in) | ||
| name : | character(*), intent(in)
| ||
| err : | logical, intent(out), optional
|
このサブルーチンを使用すると, name に関して, 以降は HstNmlInfoOutputStep が常に .false. を返すようになります.
データ出力間隔を出力の初期設定から変更し, データを出力するたびに時刻を明示的に指定する場合に利用することを 想定しています.
HstNmlInfoEndDefine で定義モードから出力モードに 移行した後に呼び出してください. HstNmlInfoEndDefine を呼ぶ前にこのサブルーチンを使用すると, プログラムはエラーを発生させます.
name に関する情報が見当たらない場合, プログラムはエラーを発生させます. name が空文字の場合にも, プログラムはエラーを発生させます.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合にも, プログラムはエラーを発生させます.
After this subroutine is used, "HstNmlInfoOutputStep" returns .false. already corresponding to the name.
This subroutine expected to use when interval of data output is changed from initialization of output, and time is specified explicitly whenever data is output.
Use after state is changed from define mode to output mode by "HstNmlInfoEndDefine". If this subroutine is used before "HstNmlInfoEndDefine" is used, error is occurred.
When data correspond to name is not found, error is occurred. When name is blank, error is occurred too.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
subroutine HstNmlInfoOutputStepDisable( gthstnml, name, err )
!
! このサブルーチンを使用すると, *name* に関して,
! 以降は HstNmlInfoOutputStep が常に .false. を返すようになります.
!
! データ出力間隔を出力の初期設定から変更し,
! データを出力するたびに時刻を明示的に指定する場合に利用することを
! 想定しています.
!
! HstNmlInfoEndDefine で定義モードから出力モードに
! 移行した後に呼び出してください.
! HstNmlInfoEndDefine を呼ぶ前にこのサブルーチンを使用すると,
! プログラムはエラーを発生させます.
!
! *name* に関する情報が見当たらない場合,
! プログラムはエラーを発生させます.
! *name* が空文字の場合にも,
! プログラムはエラーを発生させます.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合にも, プログラムはエラーを発生させます.
!
! After this subroutine is used,
! "HstNmlInfoOutputStep" returns .false. already
! corresponding to the *name*.
!
! This subroutine expected to use when
! interval of data output is changed from initialization of output,
! and time is specified explicitly whenever data is output.
!
! Use after state is changed from define mode to
! output mode by "HstNmlInfoEndDefine".
! If this subroutine is used before
! "HstNmlInfoEndDefine" is used, error is occurred.
!
! When data correspond to *name* is not found, error is occurred.
! When *name* is blank, error is occurred too.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, DC_ENOENTRY, HST_EBADNAME, HST_EINDEFINE
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
character(*), intent(in):: name
! 変数名.
! 先頭の空白は無視されます.
!
! Variable identifier.
! Blanks at the head of the name are ignored.
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoOutputStepDisable'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
if ( trim( name ) == '' ) then
stat = HST_EBADNAME
cause_c = ''
goto 999
end if
if ( gthstnml % define_mode ) then
stat = HST_EINDEFINE
cause_c = 'OutputStepDisable'
goto 999
end if
!-----------------------------------------------------------------
! *gthstnml* 内から, *name* に関する history を探査.
! Search "history" correspond to *name* in *gthstnml*
!-----------------------------------------------------------------
hptr => gthstnml % gthstnml_list
call ListSearch( gthstnml_list = hptr, name = name ) ! (in)
if ( .not. associated( hptr ) ) then
stat = DC_ENOENTRY
cause_c = adjustl( name )
goto 999
end if
hptr % output_step_disable = .true.
nullify( hptr )
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoOutputStepDisable
| Function : | |||
| result : | logical | ||
| gthstnml : | type(GTHST_NMLINFO), intent(in) | ||
| name : | character(*), intent(in)
|
変数 name の出力が有効であれば, .true. を, そうでなければ .false. を返します. 出力が有効であるかどうかは, 出力間隔 interval_value の 正負によって判定されます. 正の場合が有効, 負の場合が無効です. gthstnml が初期設定されていない場合にも .false. が返ります. name に関するデータが存在しない場合にも .false. が返ります.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合, プログラムはエラーを発生させます.
If output of a variable name is valid, .true. is returned, otherwise .false. is returned. Whether output is valid or not is judged with positive or negative of interval_value. Positive is valid, and negative is invalid. When gthstnml is not initialized, .false. is returned too. When data correspond to name is not found, .false. is returned too.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
logical function HstNmlInfoOutputValid( gthstnml, name ) result(result)
!
! 変数 *name* の出力が有効であれば,
! .true. を, そうでなければ .false. を返します.
! 出力が有効であるかどうかは, 出力間隔 *interval_value* の
! 正負によって判定されます. 正の場合が有効, 負の場合が無効です.
! *gthstnml* が初期設定されていない場合にも .false. が返ります.
! *name* に関するデータが存在しない場合にも .false. が返ります.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合, プログラムはエラーを発生させます.
!
! If output of a variable *name* is valid,
! .true. is returned, otherwise .false. is returned.
! Whether output is valid or not is judged with positive or negative
! of *interval_value*. Positive is valid, and negative is invalid.
! When *gthstnml* is not initialized, .false. is returned too.
! When data correspond to *name* is not found, .false. is returned too.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_present, only: present_and_not_empty, present_and_true
use dc_date_types, only: DC_DIFFTIME
use dc_types, only: DP, STRING, TOKEN, STDOUT
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
character(*), intent(in):: name
! 変数名.
! 先頭の空白は無視されます.
!
! Variable identifier.
! Blanks at the head of the name are ignored.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
!!$ character(*), parameter:: subname = 'HstNmlInfoOutputValid'
continue
result = .false.
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) goto 999
!-----------------------------------------------------------------
! 情報格納変数への結合
! Associate a variable storing information
!-----------------------------------------------------------------
hptr => gthstnml % gthstnml_list
call ListSearch( gthstnml_list = hptr, name = name ) ! (in)
if ( .not. associated( hptr ) ) goto 999
!-----------------------------------------------------------------
! 出力の有効性のチェック
! Check validity of output
!-----------------------------------------------------------------
if ( hptr % interval_value > 0.0 ) then
result = .true.
goto 999
end if
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
nullify( hptr )
end function HstNmlInfoOutputValid
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(in) | ||
| unit : | integer, intent(in), optional
| ||
| indent : | character(*), intent(in), optional
| ||
| err : | logical, intent(out), optional
|
引数 gthstnml に設定されている情報を印字します. デフォルトではメッセージは標準出力に出力されます. unit に装置番号を指定することで, 出力先を変更することが可能です.
Print information of gthstnml. By default messages are output to standard output. Unit number for output can be changed by unit argument.
subroutine HstNmlInfoPutLine( gthstnml, unit, indent, err )
!
! 引数 *gthstnml* に設定されている情報を印字します.
! デフォルトではメッセージは標準出力に出力されます.
! *unit* に装置番号を指定することで, 出力先を変更することが可能です.
!
! Print information of *gthstnml*.
! By default messages are output to standard output.
! Unit number for output can be changed by *unit* argument.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT
use gt4_history, only: HistoryPutLine
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
integer, intent(in), optional:: unit
! 出力先の装置番号.
! デフォルトの出力先は標準出力.
!
! Unit number for output.
! Default value is standard output.
character(*), intent(in), optional:: indent
! 表示されるメッセージの字下げ.
!
! Indent of displayed messages.
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
integer:: stat
character(STRING):: cause_c
integer:: out_unit
integer:: indent_len
character(STRING):: indent_str
character(*), parameter:: subname = 'HstNmlInfoPutLine'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( present(unit) ) then
out_unit = unit
else
out_unit = STDOUT
end if
indent_len = 0
indent_str = ''
if ( present(indent) ) then
if ( len(indent) /= 0 ) then
indent_len = len(indent)
indent_str(1:indent_len) = indent
end if
end if
!-----------------------------------------------------------------
! "GTHST_NMLINFO" の設定の印字
! Print the settings for "GTHST_NMLINFO"
!-----------------------------------------------------------------
if ( gthstnml % initialized ) then
call Printf( out_unit, indent_str(1:indent_len) // '#<GTHST_NMLINFO:: @initialized=%y define_mode=%y', l = (/gthstnml % initialized, gthstnml % define_mode/) )
hptr => gthstnml % gthstnml_list
do while ( associated( hptr ) )
call Printf( out_unit, indent_str(1:indent_len) // ' #<GTHST_NMLINFO_ENTRY:: @name=%c @file=%c', c1 = trim(hptr % name), c2 = trim(hptr % file) )
call Printf( out_unit, indent_str(1:indent_len) // ' @interval_value=%r @interval_unit=%c', r = (/hptr % interval_value/), c1 = trim(hptr % interval_unit) )
call Printf( out_unit, indent_str(1:indent_len) // ' @output_step_disable=%y', l = (/hptr % output_step_disable/) )
call Printf( out_unit, indent_str(1:indent_len) // ' @precision=%c @time_average=%y', c1 = trim(hptr % precision), l = (/ hptr % time_average /) )
call Printf( out_unit, indent_str(1:indent_len) // ' @fileprefix=%c', c1 = trim(hptr % fileprefix) )
call Printf( out_unit, indent_str(1:indent_len) // ' @origin_value=%r @origin_unit=%c', r = (/hptr % origin_value/), c1 = trim(hptr % origin_unit) )
call Printf( out_unit, indent_str(1:indent_len) // ' @terminus_value=%r @terminus_unit=%c', r = (/hptr % terminus_value/), c1 = trim(hptr % terminus_unit) )
call Printf( out_unit, indent_str(1:indent_len) // ' @slice_start=%*d ...', i = (/hptr % slice_start(1:10)/), n = (/ 10 /) )
call Printf( out_unit, indent_str(1:indent_len) // ' @slice_end=%*d ...', i = (/hptr % slice_end(1:10)/), n = (/ 10 /) )
call Printf( out_unit, indent_str(1:indent_len) // ' @slice_stride=%*d ...', i = (/hptr % slice_stride(1:10)/), n = (/ 10 /) )
call Printf( out_unit, indent_str(1:indent_len) // ' @space_average=%*b ...', l = (/hptr % space_average(1:10)/), n =(/ 10 /) )
call Printf( out_unit, indent_str(1:indent_len) // ' @newfile_intvalue=%d @newfile_intunit=%c', i = (/hptr % newfile_intvalue/), c1 = trim(hptr % newfile_intunit) )
if ( .not. gthstnml % define_mode ) then
call Printf( out_unit, indent_str(1:indent_len) // ' @history=' )
call HistoryPutLine( hptr % history, unit = out_unit, indent = indent_str(1:indent_len) // ' ' )
end if
call ListNext( gthstnml_list = hptr ) ! (inout)
end do
call Printf( out_unit, indent_str(1:indent_len) // ' >' )
call Printf( out_unit, indent_str(1:indent_len) // '>' )
else
call Printf( out_unit, indent_str(1:indent_len) // '#<GTHST_NMLINFO:: @initialized=%y>', l = (/gthstnml % initialized/) )
end if
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoPutLine
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(inout) | ||
| err : | logical, intent(out), optional
|
出力モードから定義モードに戻り, 再び情報を設定可能にします. HstNmlInfoAssocGTHist サブルーチンを呼び出す前には, 再度 HstNmlInfoEndDefine を呼び出して定義モードへと移行してください. このサブルーチンを呼んだ後でなら, 再度 HstNmlInfoAdd, HstNmlInfoDelete, HstNmlInfoResetDefault を呼ぶことが可能です.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合にも, プログラムはエラーを発生させます.
Return from output mode to define mode, information can be configured again. Use "HstNmlInfoEndDefine" again and transit from define mode to output mode, before "HstNmlInfoAssocGTHist" is used. "HstNmlInfoAdd", "HstNmlInfoDelete", "HstNmlInfoResetDefault" can be are used again after this subroutine is used.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
subroutine HstNmlInfoReDefine( gthstnml, err )
!
! 出力モードから定義モードに戻り,
! 再び情報を設定可能にします.
! HstNmlInfoAssocGTHist サブルーチンを呼び出す前には,
! 再度 HstNmlInfoEndDefine を呼び出して定義モードへと移行してください.
! このサブルーチンを呼んだ後でなら, 再度
! HstNmlInfoAdd, HstNmlInfoDelete, HstNmlInfoResetDefault
! を呼ぶことが可能です.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合にも, プログラムはエラーを発生させます.
!
! Return from output mode to define mode,
! information can be configured again.
! Use "HstNmlInfoEndDefine" again and
! transit from define mode to output mode,
! before "HstNmlInfoAssocGTHist" is used.
! "HstNmlInfoAdd", "HstNmlInfoDelete", "HstNmlInfoResetDefault"
! can be are used again after
! this subroutine is used.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_hash, only: HASH, DCHashPut, DCHashGet, DCHashRewind, DCHashNext, DCHashNumber
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, HST_ENOTINDEFINE, HST_EINTFILE, HST_EINDEFINE
use dc_message, only: MessageNotify
implicit none
type(GTHST_NMLINFO), intent(inout):: gthstnml
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoReDefine'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
if ( gthstnml % define_mode ) then
stat = HST_EINDEFINE
cause_c = 'ReDefine'
goto 999
end if
!-----------------------------------------------------------------
! 定義モードへと戻る
! Return to define mode
!-----------------------------------------------------------------
gthstnml % define_mode = .true.
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoReDefine
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(inout) | ||
| err : | logical, intent(out), optional
|
デフォルト値を残し, 登録したデータを削除します.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合, プログラムはエラーを発生させます.
Stored data is deleted without default settings.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
subroutine HstNmlInfoResetDefault( gthstnml, err )
!
! デフォルト値を残し, 登録したデータを削除します.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合, プログラムはエラーを発生させます.
!
! Stored data is deleted without default settings.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, HST_ENOTINDEFINE
implicit none
type(GTHST_NMLINFO), intent(inout):: gthstnml
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
character(TOKEN), pointer:: varnames_array(:) =>null()
integer:: i, vnmax
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoResetDefault'
continue
call BeginSub( subname )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
if ( .not. gthstnml % define_mode ) then
stat = HST_ENOTINDEFINE
cause_c = 'ResetDefault'
goto 999
end if
!-----------------------------------------------------------------
! 変数名リストの取得
! Get varnames list
!-----------------------------------------------------------------
call HstNmlInfoNames( gthstnml, varnames_array ) ! (out)
vnmax = size( varnames_array )
do i = 1, vnmax
call HstNmlInfoDelete( gthstnml = gthstnml, name = varnames_array(i) ) ! (in)
end do
deallocate( varnames_array )
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoResetDefault
| Subroutine : | |||
| gthstnml : | type(GTHST_NMLINFO), intent(in) | ||
| name : | character(*), intent(in)
| ||
| err : | logical, intent(out), optional
|
変数名の有効性を設定.
無効な変数名を検知するため, このサブルーチンで 有効な変数に対しては明示的に設定を行います.
なお, 与えられた gthstnml が HstNmlInfoCreate によって初期設定 されていない場合, プログラムはエラーを発生させます.
Set validation to variable names.
For detection of invalid variable names, Set validation to variable names explicitly by this subroutine.
If gthstnml is not initialized by "HstNmlInfoCreate" yet, error is occurred.
subroutine HstNmlInfoSetValidName( gthstnml, name, err )
!
! 変数名の有効性を設定.
!
! 無効な変数名を検知するため, このサブルーチンで
! 有効な変数に対しては明示的に設定を行います.
!
! なお, 与えられた *gthstnml* が HstNmlInfoCreate によって初期設定
! されていない場合, プログラムはエラーを発生させます.
!
! Set validation to variable names.
!
! For detection of invalid variable names,
! Set validation to variable names explicitly by this
! subroutine.
!
! If *gthstnml* is not initialized by "HstNmlInfoCreate" yet,
! error is occurred.
!
use dc_trace, only: BeginSub, EndSub
use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar
use dc_present, only: present_and_not_empty, present_and_true
use dc_types, only: DP, STRING, TOKEN, STDOUT
use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, DC_EARGLACK, DC_ENOENTRY
use gt4_history, only: HistoryInitialized
implicit none
type(GTHST_NMLINFO), intent(in):: gthstnml
character(*), intent(in):: name
! 有効であることを設定する変数名.
!
! "Data1,Data2" のようにカンマで区切って複数
! の変数を指定することも可能です.
!
! A variable name that is set validation.
!
! Multiple variables can be specified
! as "Data1,Data2" too. Delimiter is comma.
logical, intent(out), optional:: err
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
!-----------------------------------
! 作業変数
! Work variables
type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
character(TOKEN), pointer:: varnames_array(:) =>null()
integer:: i, vnmax
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = 'HstNmlInfoSetValidName'
continue
call BeginSub( subname, fmt = '@name=%c', c1 = trim(name) )
stat = DC_NOERR
cause_c = ''
!-----------------------------------------------------------------
! 初期設定のチェック
! Check initialization
!-----------------------------------------------------------------
if ( .not. gthstnml % initialized ) then
stat = DC_ENOTINIT
cause_c = 'GTHST_NMLINFO'
goto 999
end if
!-----------------------------------------------------------------
! 複数の変数名の取り扱い
! Handle multiple variables
!-----------------------------------------------------------------
call Split( str = name, sep = name_delimiter, carray = varnames_array ) ! (out)
vnmax = size( varnames_array )
!-----------------------------------------------------------------
! *gthstnml* 内から, *name* に関する情報を探査.
! Search information correspond to *name* in *gthstnml*
!-----------------------------------------------------------------
do i = 1, vnmax
hptr => gthstnml % gthstnml_list
call ListSearch( gthstnml_list = hptr, name = varnames_array(i) ) ! (in)
if ( associated( hptr ) ) then
hptr % name_invalid = .false.
end if
end do
!-----------------------------------------------------------------
! 終了処理, 例外処理
! Termination and Exception handling
!-----------------------------------------------------------------
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
end subroutine HstNmlInfoSetValidName