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-20090729 $ |
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