| Path: | gtool/gtool_historyauto/historyautoput.f90 |
| Last Update: | Sun May 31 23:36:32 +0900 2009 |
| Authors: | Yasuhiro MORIKAWA |
| Version: | $Id: historyautoput.f90,v 1.2 2009-05-31 14:36:32 morikawa Exp $ |
| Tag Name: | $Name: gtool5-20090704 $ |
| Copyright: | Copyright (C) GFD Dennou Club, 2008-2009. All rights reserved. |
| License: | See COPYRIGHT |
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| value : | real(DP), intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutDouble0( time, varname, value, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real(DP), intent(in), target:: value
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutDouble0"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
! array only
! 空間平均
! Spatial average
!
! array only
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, (/value/), difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, (/value/), history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutDouble0
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in)
| ||
| varname : | character(*), intent(in)
| ||
| array(:) : | real(DP), intent(in), target
| ||
| err : | logical, intent(out), optional
|
データの出力を行います. このサブルーチンを用いる前に, "HistoryAutoCreate" による初期設定が必要です.
varname は HistoryAutoAddVariable で指定されている必要があります.
HistoryAutoPut は複数のサブルーチンの総称名です. array には 0 〜 7 次元のデータを与えることが可能です. (下記のサブルーチンを参照ください). また, 整数, 単精度実数, 倍精度実数を与えることが可能です. ただし, 0 次元のデータを与える際の引数キーワードは value を用いてください.
Output data. Initialization by "HistoryAutoCreate" is needed before use of this subroutine.
"varname" must be specified by "HistoryAutoAddVariable".
"HistoryAutoPut" is a generic name of multiple subroutines. Then 0 — 7 dimensional data can be given to "array". (See bellow subroutines). And, integer, sinble or double precision can be given. However, if 0 dimensional data is given, use "value" as a keyword argument.
subroutine HistoryAutoPutDouble1( time, varname, array, err )
!
!
! データの出力を行います.
! このサブルーチンを用いる前に, "HistoryAutoCreate"
! による初期設定が必要です.
!
! *varname* は HistoryAutoAddVariable で指定されている必要があります.
!
! *HistoryAutoPut* は複数のサブルーチンの総称名です. *array* には
! 0 〜 7 次元のデータを与えることが可能です.
! (下記のサブルーチンを参照ください).
! また, 整数, 単精度実数, 倍精度実数を与えることが可能です.
! ただし, 0 次元のデータを与える際の引数キーワードは
! *value* を用いてください.
!
! Output data.
! Initialization by "HistoryAutoCreate" is needed
! before use of this subroutine.
!
! "varname" must be specified by "HistoryAutoAddVariable".
!
! "HistoryAutoPut" is a generic name of multiple subroutines.
! Then 0 -- 7 dimensional data can be given to "array".
! (See bellow subroutines).
! And, integer, sinble or double precision can be given.
! However, if 0 dimensional data is given, use "value" as a
! keyword argument.
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
! データの時刻.
! Time of data
character(*), intent(in):: varname
! 変数の名前.
!
! ただし, ここで指定するものは,
! HistoryAutoAddVariable の
! *varname* で既に指定されてい
! なければなりません.
!
! Name of a variable.
!
! This must be specified
! *varname* in "HistoryAutoAddVariable".
real(DP), intent(in), target:: array(:)
! 出力データ.
!
! データ型は整数, 単精度実数型,
! 倍精度実数型のどれでもかまいません.
! ただし, ファイルへ出力される際には,
! HistoryAutoAddVariable の *xtypes* で指定した
! データ型へ変換されます.
!
! Output data.
!
! Integer, single or double precision are
! acceptable as data type.
! Note that when this is output to a file,
! data type is converted into "xtype"
! specified in "HistoryAutoAddVariable"
!
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real(DP), pointer:: array_slice(:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real(DP), pointer:: array_avr(:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutDouble1"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutDouble1
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:) : | real(DP), intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutDouble2( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real(DP), intent(in), target:: array(:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real(DP), pointer:: array_slice(:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real(DP), pointer:: array_avr(:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutDouble2"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutDouble2
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:) : | real(DP), intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutDouble3( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real(DP), intent(in), target:: array(:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real(DP), pointer:: array_slice(:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real(DP), pointer:: array_avr(:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutDouble3"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutDouble3
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:) : | real(DP), intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutDouble4( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real(DP), intent(in), target:: array(:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real(DP), pointer:: array_slice(:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real(DP), pointer:: array_avr(:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutDouble4"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutDouble4
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:,:) : | real(DP), intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutDouble5( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real(DP), intent(in), target:: array(:,:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real(DP), pointer:: array_slice(:,:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real(DP), pointer:: array_avr(:,:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutDouble5"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
!!$ write(*,*) ' sv%st(5), sv%ed(5), sv%sd(5)=', sv%st(5), sv%ed(5), sv%sd(5)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) , sv%st(5):sv%ed(5):sv%sd(5) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , weight_vars(vnum) % wgt5( sv%st(5):sv%ed(5):sv%sd(5) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutDouble5
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:,:,:) : | real(DP), intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutDouble6( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real(DP), intent(in), target:: array(:,:,:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real(DP), pointer:: array_slice(:,:,:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real(DP), pointer:: array_avr(:,:,:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutDouble6"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
!!$ write(*,*) ' sv%st(5), sv%ed(5), sv%sd(5)=', sv%st(5), sv%ed(5), sv%sd(5)
!!$ write(*,*) ' sv%st(6), sv%ed(6), sv%sd(6)=', sv%st(6), sv%ed(6), sv%sd(6)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) , sv%st(5):sv%ed(5):sv%sd(5) , sv%st(6):sv%ed(6):sv%sd(6) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , weight_vars(vnum) % wgt5( sv%st(5):sv%ed(5):sv%sd(5) ) , weight_vars(vnum) % wgt6( sv%st(6):sv%ed(6):sv%sd(6) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutDouble6
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:,:,:,:) : | real(DP), intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutDouble7( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real(DP), intent(in), target:: array(:,:,:,:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real(DP), pointer:: array_slice(:,:,:,:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real(DP), pointer:: array_avr(:,:,:,:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutDouble7"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
!!$ write(*,*) ' sv%st(5), sv%ed(5), sv%sd(5)=', sv%st(5), sv%ed(5), sv%sd(5)
!!$ write(*,*) ' sv%st(6), sv%ed(6), sv%sd(6)=', sv%st(6), sv%ed(6), sv%sd(6)
!!$ write(*,*) ' sv%st(7), sv%ed(7), sv%sd(7)=', sv%st(7), sv%ed(7), sv%sd(7)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) , sv%st(5):sv%ed(5):sv%sd(5) , sv%st(6):sv%ed(6):sv%sd(6) , sv%st(7):sv%ed(7):sv%sd(7) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , weight_vars(vnum) % wgt5( sv%st(5):sv%ed(5):sv%sd(5) ) , weight_vars(vnum) % wgt6( sv%st(6):sv%ed(6):sv%sd(6) ) , weight_vars(vnum) % wgt7( sv%st(7):sv%ed(7):sv%sd(7) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutDouble7
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| value : | integer, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutInt0( time, varname, value, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
integer, intent(in), target:: value
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutInt0"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
! array only
! 空間平均
! Spatial average
!
! array only
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, (/value/), difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, (/value/), history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutInt0
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:) : | integer, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutInt1( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
integer, intent(in), target:: array(:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
integer, pointer:: array_slice(:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
integer, pointer:: array_avr(:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutInt1"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutInt1
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:) : | integer, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutInt2( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
integer, intent(in), target:: array(:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
integer, pointer:: array_slice(:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
integer, pointer:: array_avr(:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutInt2"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutInt2
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:) : | integer, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutInt3( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
integer, intent(in), target:: array(:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
integer, pointer:: array_slice(:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
integer, pointer:: array_avr(:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutInt3"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutInt3
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:) : | integer, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutInt4( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
integer, intent(in), target:: array(:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
integer, pointer:: array_slice(:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
integer, pointer:: array_avr(:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutInt4"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutInt4
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:,:) : | integer, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutInt5( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
integer, intent(in), target:: array(:,:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
integer, pointer:: array_slice(:,:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
integer, pointer:: array_avr(:,:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutInt5"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
!!$ write(*,*) ' sv%st(5), sv%ed(5), sv%sd(5)=', sv%st(5), sv%ed(5), sv%sd(5)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) , sv%st(5):sv%ed(5):sv%sd(5) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , weight_vars(vnum) % wgt5( sv%st(5):sv%ed(5):sv%sd(5) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutInt5
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:,:,:) : | integer, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutInt6( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
integer, intent(in), target:: array(:,:,:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
integer, pointer:: array_slice(:,:,:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
integer, pointer:: array_avr(:,:,:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutInt6"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
!!$ write(*,*) ' sv%st(5), sv%ed(5), sv%sd(5)=', sv%st(5), sv%ed(5), sv%sd(5)
!!$ write(*,*) ' sv%st(6), sv%ed(6), sv%sd(6)=', sv%st(6), sv%ed(6), sv%sd(6)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) , sv%st(5):sv%ed(5):sv%sd(5) , sv%st(6):sv%ed(6):sv%sd(6) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , weight_vars(vnum) % wgt5( sv%st(5):sv%ed(5):sv%sd(5) ) , weight_vars(vnum) % wgt6( sv%st(6):sv%ed(6):sv%sd(6) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutInt6
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:,:,:,:) : | integer, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutInt7( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
integer, intent(in), target:: array(:,:,:,:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
integer, pointer:: array_slice(:,:,:,:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
integer, pointer:: array_avr(:,:,:,:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutInt7"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
!!$ write(*,*) ' sv%st(5), sv%ed(5), sv%sd(5)=', sv%st(5), sv%ed(5), sv%sd(5)
!!$ write(*,*) ' sv%st(6), sv%ed(6), sv%sd(6)=', sv%st(6), sv%ed(6), sv%sd(6)
!!$ write(*,*) ' sv%st(7), sv%ed(7), sv%sd(7)=', sv%st(7), sv%ed(7), sv%sd(7)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) , sv%st(5):sv%ed(5):sv%sd(5) , sv%st(6):sv%ed(6):sv%sd(6) , sv%st(7):sv%ed(7):sv%sd(7) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , weight_vars(vnum) % wgt5( sv%st(5):sv%ed(5):sv%sd(5) ) , weight_vars(vnum) % wgt6( sv%st(6):sv%ed(6):sv%sd(6) ) , weight_vars(vnum) % wgt7( sv%st(7):sv%ed(7):sv%sd(7) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutInt7
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| value : | real, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutReal0( time, varname, value, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real, intent(in), target:: value
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutReal0"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
! array only
! 空間平均
! Spatial average
!
! array only
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, (/value/), difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, (/value/), history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutReal0
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:) : | real, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutReal1( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real, intent(in), target:: array(:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real, pointer:: array_slice(:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real, pointer:: array_avr(:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutReal1"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutReal1
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:) : | real, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutReal2( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real, intent(in), target:: array(:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real, pointer:: array_slice(:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real, pointer:: array_avr(:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutReal2"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutReal2
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:) : | real, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutReal3( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real, intent(in), target:: array(:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real, pointer:: array_slice(:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real, pointer:: array_avr(:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutReal3"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutReal3
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:) : | real, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutReal4( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real, intent(in), target:: array(:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real, pointer:: array_slice(:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real, pointer:: array_avr(:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutReal4"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutReal4
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:,:) : | real, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutReal5( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real, intent(in), target:: array(:,:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real, pointer:: array_slice(:,:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real, pointer:: array_avr(:,:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutReal5"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
!!$ write(*,*) ' sv%st(5), sv%ed(5), sv%sd(5)=', sv%st(5), sv%ed(5), sv%sd(5)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) , sv%st(5):sv%ed(5):sv%sd(5) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , weight_vars(vnum) % wgt5( sv%st(5):sv%ed(5):sv%sd(5) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutReal5
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:,:,:) : | real, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutReal6( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real, intent(in), target:: array(:,:,:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real, pointer:: array_slice(:,:,:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real, pointer:: array_avr(:,:,:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutReal6"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
!!$ write(*,*) ' sv%st(5), sv%ed(5), sv%sd(5)=', sv%st(5), sv%ed(5), sv%sd(5)
!!$ write(*,*) ' sv%st(6), sv%ed(6), sv%sd(6)=', sv%st(6), sv%ed(6), sv%sd(6)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) , sv%st(5):sv%ed(5):sv%sd(5) , sv%st(6):sv%ed(6):sv%sd(6) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , weight_vars(vnum) % wgt5( sv%st(5):sv%ed(5):sv%sd(5) ) , weight_vars(vnum) % wgt6( sv%st(6):sv%ed(6):sv%sd(6) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutReal6
| Subroutine : | |||
| time : | type(DC_DIFFTIME), intent(in) | ||
| varname : | character(*), intent(in) | ||
| array(:,:,:,:,:,:,:) : | real, intent(in), target | ||
| err : | logical, intent(out), optional
|
subroutine HistoryAutoPutReal7( time, varname, array, err )
!
!
use gtool_historyauto_internal, only: initialized, numdims, numvars, gthstnml, zero_time, create_timing_vars, close_timing_vars, histaddvar_vars, interval_time_vars, newfile_createtime_vars, output_timing_avr_vars, output_timing_vars, prev_outtime_vars, renew_timing_vars, varname_vars, gthst_history_vars, slice_vars, space_avr_vars, weight_vars
use gtool_historyauto_internal, only: HstVarsOutputCheck, HstFileCreate, AverageReduce
use gtool_historyauto_internal, only: SLICE_INFO
use gtool_history_nmlinfo_generic, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime
use dc_message, only: MessageNotify
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT, DC_ENEGATIVE
use dc_date_generic, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine
use dc_date_types, only: DC_DIFFTIME, DC_DATETIME
use dc_types, only: DP, STRING, TOKEN
implicit none
type(DC_DIFFTIME), intent(in):: time
character(*), intent(in):: varname
real, intent(in), target:: array(:,:,:,:,:,:,:)
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.
type(GT_HISTORY), pointer:: gthist =>null()
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
real, pointer:: array_slice(:,:,:,:,:,:,:) =>null()
type(SLICE_INFO), pointer:: sv =>null()
real, pointer:: array_avr(:,:,:,:,:,:,:) =>null()
integer:: stat, i
integer:: vnum
character(STRING):: cause_c
integer, save:: svnum = 1, svtstep
character(*), parameter:: subname = "HistoryAutoPutReal7"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! 初期設定チェック
! Check initialization
!
if ( .not. initialized ) then
stat = DC_ENOTINIT
cause_c = 'gtool_historyauto'
goto 999
end if
! 時刻に関するエラー処理
! Error handling for time
!
if ( time < zero_time ) then
cause_c = toChar( time )
call MessageNotify( 'W', subname, '"time=<%c>" must be positive value (varname=<%c>).', c1 = trim( cause_c ), c2 = trim( varname ) )
stat = DC_ENEGATIVE
cause_c = 'time'
goto 999
end if
! 変数 ID のサーチ
! Search variable ID
!
VarSearch: do
do i = svnum, numvars
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
do i = 1, svnum - 1
if ( trim( varname_vars(i) ) == trim(varname) ) then
vnum = i
exit VarSearch
end if
end do
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end do VarSearch
svnum = vnum
! 定義モードからデータモードへ
! Transit from define mode to data mode
!
if ( HstNmlInfoDefineMode( gthstnml ) ) then
call HstNmlInfoEndDefine( gthstnml ) ! (inout)
end if
! 出力タイミングのチェックとファイルの作成
! Check output timing and create files
!
call HstVarsOutputCheck( time = time, stime_index = svtstep ) ! (out)
! ファイルのオープン・クローズ・再オープン
! Open, close, reopen files
!
if ( create_timing_vars(vnum, svtstep) .and. .not. histaddvar_vars(vnum) ) then
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
histaddvar_vars(vnum) = .true.
prev_outtime_vars(vnum) = time
end if
if ( close_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
end if
if ( renew_timing_vars(vnum, svtstep) ) then
if ( HistoryInitialized( gthst_history_vars(vnum) % gthist ) ) then
call HistoryClose( gthst_history_vars(vnum) % gthist ) ! (inout)
end if
call HstFileCreate( gthst_history_vars(vnum) % gthist, varname_vars(vnum), time ) ! (in)
newfile_createtime_vars(vnum) = time
prev_outtime_vars(vnum) = time
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. output_timing_vars(vnum, svtstep) .and. .not. output_timing_avr_vars(vnum, svtstep) ) then
goto 999
end if
! GT_HISTORY 変数の取得
! Get "GT_HISTORY" variable
!
gthist => gthst_history_vars(vnum) % gthist
! 空間切り出し
! Slice of spaces
!
sv => slice_vars(vnum)
!!$ write(*,*) ' sv%st(1), sv%ed(1), sv%sd(1)=', sv%st(1), sv%ed(1), sv%sd(1)
!!$ write(*,*) ' sv%st(2), sv%ed(2), sv%sd(2)=', sv%st(2), sv%ed(2), sv%sd(2)
!!$ write(*,*) ' sv%st(3), sv%ed(3), sv%sd(3)=', sv%st(3), sv%ed(3), sv%sd(3)
!!$ write(*,*) ' sv%st(4), sv%ed(4), sv%sd(4)=', sv%st(4), sv%ed(4), sv%sd(4)
!!$ write(*,*) ' sv%st(5), sv%ed(5), sv%sd(5)=', sv%st(5), sv%ed(5), sv%sd(5)
!!$ write(*,*) ' sv%st(6), sv%ed(6), sv%sd(6)=', sv%st(6), sv%ed(6), sv%sd(6)
!!$ write(*,*) ' sv%st(7), sv%ed(7), sv%sd(7)=', sv%st(7), sv%ed(7), sv%sd(7)
array_slice => array(sv%st(1):sv%ed(1):sv%sd(1) , sv%st(2):sv%ed(2):sv%sd(2) , sv%st(3):sv%ed(3):sv%sd(3) , sv%st(4):sv%ed(4):sv%sd(4) , sv%st(5):sv%ed(5):sv%sd(5) , sv%st(6):sv%ed(6):sv%sd(6) , sv%st(7):sv%ed(7):sv%sd(7) )
! 空間平均
! Spatial average
!
if ( count(space_avr_vars(vnum) % avr) == 0 ) then
array_avr => array_slice
else
call AverageReduce( array_slice, space_avr_vars(vnum) % avr, weight_vars(vnum) % wgt1( sv%st(1):sv%ed(1):sv%sd(1) ) , weight_vars(vnum) % wgt2( sv%st(2):sv%ed(2):sv%sd(2) ) , weight_vars(vnum) % wgt3( sv%st(3):sv%ed(3):sv%sd(3) ) , weight_vars(vnum) % wgt4( sv%st(4):sv%ed(4):sv%sd(4) ) , weight_vars(vnum) % wgt5( sv%st(5):sv%ed(5):sv%sd(5) ) , weight_vars(vnum) % wgt6( sv%st(6):sv%ed(6):sv%sd(6) ) , weight_vars(vnum) % wgt7( sv%st(7):sv%ed(7):sv%sd(7) ) , array_avr ) ! (out)
end if
! 座標重みを取得 ; Get weights of axes
! 時刻設定
! Set time
!
if ( output_timing_vars(vnum, svtstep) ) then
call HistorySetTime( history = gthist, difftime = time ) ! (in) optional
end if
! 出力
! OutPut
!
if ( output_timing_avr_vars(vnum, svtstep) ) then
call HistoryPut( varname, array_avr, difftime = time, time_average_store = .not. output_timing_vars(vnum, svtstep), history = gthist ) ! (inout) optional
else
call HistoryPut( varname, array_avr, history = gthist ) ! (inout) optional
end if
! 最後に出力した時刻を保存
! Save last time of output
!
if ( output_timing_vars(vnum, svtstep) ) then
if ( .not. create_timing_vars(vnum, svtstep) .and. .not. renew_timing_vars(vnum, svtstep) ) then
if ( mod(time, interval_time_vars(vnum) ) == zero_time ) then
prev_outtime_vars(vnum) = time
else
prev_outtime_vars(vnum) = prev_outtime_vars(vnum) + interval_time_vars(vnum)
end if
end if
end if
! 結合解除
! Release associations
!
nullify( gthist )
nullify( array_avr, array_slice )
999 continue
call StoreError(stat, subname, cause_c = cause_c, err = err)
call EndSub(subname)
end subroutine HistoryAutoPutReal7