Class | gtool_historyauto |
In: |
history/gtool_historyauto.f90
|
Note that Japanese and English are described in parallel.
gtool_historyauto モジュールは gtool_history モジュールの応用版であり, 多数の変数を出力する大規模な数値モデルを想定した, データ出力のための簡便なインターフェースを 提供します. このモジュールは以下のような特徴を持ちます.
"gtool_historyauto" module is an application of "gtool_history" module, and provides data output easy-to-use interfaces for large numerical models that output many variables. This module has following features.
HistoryAutoCreate : | 初期化 |
HistoryAutoAddVariable : | 変数追加 |
HistoryAutoPut : | データ出力 |
HistoryAutoClose : | 終了処理 |
HistoryAutoPutAxis : | 座標データ追加 |
HistoryAutoAddWeight : | 座標重み追加 |
HistoryAutoAddAttr : | 属性追加 |
HistoryAutoAllVarFix : | 登録変数の確定 |
HistoryAutoPutAxisMPI : | 領域全体の座標データ指定 (MPI 使用時のみ有効) |
——————— : | ——————— |
HistoryAutoCreate : | Initialization |
HistoryAutoAddVariable : | Addition of variables |
HistoryAutoPut : | Output of data |
HistoryAutoClose : | Termination |
HistoryAutoPutAxis : | Addition of data of axes |
HistoryAutoAddWeight : | Addition of weights of axes |
HistoryAutoAddAttr : | Addition of attributes |
HistoryAutoAllVarFix : | Fix register of variables |
HistoryAutoPutAxisMPI : | Specify data of axes in whole area (This is valid when MPI is used) |
NAMELIST#gtool_historyauto_nml
Subroutine : | |||
varname : | character(*), intent(in)
| ||
attrname : | character(*), intent(in)
| ||
value : | character(*), intent(in)
|
座標変数および座標重み変数に属性を付加します. このサブルーチンを用いる前に, HistoryAutoCreate による初期設定が 必要です.
Add attributes axes or weights of axes. Initialization by "HistoryAutoCreate" is needed before use of this subroutine.
Alias for HistoryAutoAddAttrChar0
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value : | integer, intent(in) |
Alias for HistoryAutoAddAttrInt0
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value : | logical, intent(in) |
Alias for HistoryAutoAddAttrLogical0
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value : | real(DP), intent(in) |
Alias for HistoryAutoAddAttrDouble0
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value : | real, intent(in) |
Alias for HistoryAutoAddAttrReal0
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value(:) : | integer, intent(in) |
Alias for HistoryAutoAddAttrInt1
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value(:) : | real(DP), intent(in) |
Alias for HistoryAutoAddAttrDouble1
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value(:) : | real, intent(in) |
Alias for HistoryAutoAddAttrReal1
Subroutine : | |||
varname : | character(*), intent(in)
| ||
dims(:) : | character(*), intent(in)
| ||
longname : | character(*), intent(in)
| ||
units : | character(*), intent(in)
| ||
xtype : | character(*), intent(in), optional
| ||
time_units : | character(*), intent(in), optional
| ||
time_average : | logical, intent(in), optional
| ||
file : | character(*), intent(in), optional
| ||
origin : | type(DC_DIFFTIME), intent(in)
| ||
terminus : | type(DC_DIFFTIME), intent(in)
| ||
interval : | type(DC_DIFFTIME), intent(in), optional
| ||
slice_start(:) : | integer, intent(in), optional
| ||
slice_end(:) : | integer, intent(in), optional
| ||
slice_stride(:) : | integer, intent(in), optional
| ||
space_average(:) : | logical, intent(in), optional
| ||
newfile_interval : | integer, intent(in), optional
|
データ出力するための変数登録を行います.
HistoryAutoAllVarFix を呼ぶ前にこのサブルーチンを使用してください.
Register variables for history data output
Use this subroutine before "HistoryAutoAllVarFix" is called.
Alias for HistoryAutoAddVariable2
Subroutine : | |||
varname : | character(*), intent(in)
| ||
dims(:) : | character(*), intent(in)
| ||
longname : | character(*), intent(in)
| ||
units : | character(*), intent(in)
| ||
xtype : | character(*), intent(in), optional
| ||
time_units : | character(*), intent(in), optional
| ||
time_average : | logical, intent(in), optional
| ||
file : | character(*), intent(in), optional
| ||
origin : | real, intent(in), optional
| ||
terminus : | real, intent(in), optional
| ||
interval : | real, intent(in), optional
| ||
slice_start(:) : | integer, intent(in), optional
| ||
slice_end(:) : | integer, intent(in), optional
| ||
slice_stride(:) : | integer, intent(in), optional
| ||
space_average(:) : | logical, intent(in), optional
| ||
newfile_interval : | integer, intent(in), optional
|
データ出力するための変数登録を行います.
HistoryAutoAllVarFix を呼ぶ前にこのサブルーチンを使用してください.
Register variables for history data output
Use this subroutine before "HistoryAutoAllVarFix" is called.
Alias for HistoryAutoAddVariable1
Subroutine : | |||
dim : | character(*), intent(in)
| ||
weight(:) : | integer, intent(in)
| ||
units : | character(*), intent(in), optional
| ||
xtype : | character(*), intent(in), optional
|
座標の重みデータを設定します.
Set weights of axes.
Alias for HistoryAutoAddWeightInt
Subroutine : | |||
dim : | character(*), intent(in)
| ||
weight(:) : | real(DP), intent(in)
| ||
units : | character(*), intent(in), optional
| ||
xtype : | character(*), intent(in), optional
|
座標の重みデータを設定します.
Set weights of axes.
Alias for HistoryAutoAddWeightDouble
Subroutine : | |||
dim : | character(*), intent(in)
| ||
weight(:) : | real, intent(in)
| ||
units : | character(*), intent(in), optional
| ||
xtype : | character(*), intent(in), optional
|
座標の重みデータを設定します.
Set weights of axes.
Alias for HistoryAutoAddWeightReal
Subroutine : |
このサブルーチンは以下の動作を行います.
このサブルーチンを呼んだ後に HistoryAutoAddVariable を呼ぶと エラーを生じます.
This subroutine performs following acts.
If "HistoryAutoAddVariable" is called after this subroutine is called, an error is occurred.
subroutine HistoryAutoAllVarFix ! ! このサブルーチンは以下の動作を行います. ! ! * NAMELIST から読み込んだ変数名に無効なものが存在したかどうかをチェック. ! * HistoryAutoAddVariable で登録した変数名を印字. ! ! このサブルーチンを呼んだ後に HistoryAutoAddVariable を呼ぶと ! エラーを生じます. ! ! This subroutine performs following acts. ! ! * Check that invalid variable names are loaded from NAMELIST or not. ! * Print registered variable names by "HistoryAutoAddVariable". ! ! If "HistoryAutoAddVariable" is called after this subroutine is called, ! an error is occurred. ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_EBADVARNAME, DC_ENOTINIT use dc_message, only: MessageNotify use dc_date, only: operator(*), operator(+) use dc_string, only: JoinChar use gtool_history, only: HistoryVarinfoInquire use gtool_history_nmlinfo, only: HstNmlInfoAllNameValid implicit none logical:: allvar_invalid ! 無効な変数名のチェックフラグ. ! Check flag of invalid variable names. integer, parameter:: names_limit = 100 character(names_limit):: names_invalid ! 無効な変数名. ! Invalid variable names. character(STRING):: name, units, longname, var_info_str character(TOKEN), pointer:: dims(:) =>null() integer:: msnot_rank integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAllVarFix" continue call BeginSub(subname) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if ! 既に確定後であれば何もせずに終了. ! Nothing is done after fixed ! if ( flag_allvarfixed ) goto 999 ! 無効な変数名のチェック (初回のみ) ! Check invalid variable names (at only first time) ! call HstNmlInfoAllNameValid( gthstnml = gthstnml, invalid = allvar_invalid, names = names_invalid ) ! (out) if ( len_trim(names_invalid) > (names_limit - 5) ) then names_invalid = names_invalid(1:names_limit - 5) // ' ....' end if if ( allvar_invalid ) then stat = HST_EBADVARNAME cause_c = names_invalid call MessageNotify( 'W', subname, 'names "%c" from NAMELIST "gtool_historyauto_nml" are invalid.', c1 = trim(names_invalid) ) goto 999 end if ! 登録された変数の印字 (初回のみ) ! Print registered variables (at only first time) ! msnot_rank = -1 if ( save_mpi_gather ) msnot_rank = 0 call MessageNotify( 'M', sub_sname, '-------------------------------------------', rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, '----- Registered variables for output -----', rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, '-------------------------------------------', rank_mpi = msnot_rank ) do i = 1, numvars call HistoryVarinfoInquire( varinfo = gthst_vars(i), name = name, dims = dims, longname = longname, units = units ) ! (out) optional var_info_str = trim( longname ) // ' [' // trim( units ) // '] {' // trim( JoinChar( dims, ',' ) ) // '}' deallocate( dims ) call MessageNotify( 'M', sub_sname, ' %c (%c)', c1 = trim(name), c2 = trim(var_info_str), rank_mpi = msnot_rank ) end do call MessageNotify( 'M', sub_sname, '-----', rank_mpi = msnot_rank ) ! フラグの設定 ! Set a flag ! if ( .not. flag_allvarfixed ) flag_allvarfixed = .true. 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname, 'stat=%d', i = (/stat/) ) end subroutine HistoryAutoAllVarFix
Subroutine : |
HistoryAutoCreate で始まったデータ出力の終了処理を行います. プログラムを終了する前に必ずこのサブルーチンを呼んでください.
Terminates data output with "HistoryAutoCreate". Call this subroutine certainly before a progrem is finished.
Alias for HistoryAutoClose1
Subroutine : | |||
title : | character(*), intent(in)
| ||
source : | character(*), intent(in)
| ||
institution : | character(*), intent(in)
| ||
dims(:) : | character(*), intent(in)
| ||
dimsizes(:) : | integer, intent(in)
| ||
longnames(:) : | character(*), intent(in)
| ||
units(:) : | character(*), intent(in)
| ||
origin : | type(DC_DIFFTIME), intent(in)
| ||
terminus : | type(DC_DIFFTIME), intent(in)
| ||
xtypes(:) : | character(*), intent(in), optional
| ||
conventions : | character(*), intent(in), optional
| ||
gt_version : | character(*), intent(in), optional
| ||
all_output : | logical, intent(in), optional
| ||
file_prefix : | character(*), intent(in), optional
| ||
namelist_filename : | character(*), intent(in), optional
| ||
interval : | type(DC_DIFFTIME), intent(in), optional
| ||
slice_start(:) : | integer, intent(in), optional
| ||
slice_end(:) : | integer, intent(in), optional
| ||
slice_stride(:) : | integer, intent(in), optional
| ||
space_average(:) : | logical, intent(in), optional
| ||
time_average : | logical, intent(in), optional
| ||
newfile_interval : | integer, intent(in), optional
| ||
rank : | character(*), intent(in), optional
| ||
origin_date : | type(DC_DATETIME), intent(in), optional
| ||
origin_date_invalid : | logical, intent(in), optional
| ||
flag_mpi_gather : | logical, intent(in), optional
| ||
flag_mpi_split : | logical, intent(in), optional
|
複数のデータ出力を行うための初期化を行います.
この HistoryAutoCreate には, モデル内で出力する 変数が依存する座標や座標重みなどを全てを設定してください.
all_output に .true. を与えた場合や, namelist_filename を与えない (空文字を与える) 場合には, HistoryAutoAddVariable で登録される全ての変数が出力されます. 一方で namelist_filename に NAMELIST ファイル名を与える場合には, その NAMELIST ファイルから出力のオンオフや, 出力ファイル名, 出力間隔などを変更可能です. 変更可能な項目に関しては NAMELIST#gtool_historyauto_nml を参照して下さい.
interval, origin, terminus, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval などの設定はデフォルト値として使用されます. これらの設定値は HistoryAutoAddVariable および NAMELIST#gtool_historyauto_nml で上書きされます. (優先度が高いのは NAMELIST#gtool_historyauto_nml , HistoryAutoAddVariable の引数, HistoryAutoCreate の引数 の順です).
Initialization for multiple history data output
Set all axes and their weights depended by variables output from numerical models to this "HistoryAutoCreate".
All variables registered by "HistoryAutoAddVariable" are output if .true. is given to "all_output" or "namelist_filename" is not given (or blanks are given) On the other hand, if a filename of NAMELIST file is given to "namelist_filename", on/off of output, output filename and output interval, etc. can be changed from the NAMELIST file. For available items, see "NAMELIST#gtool_historyauto_nml".
Settings about "interval", "origin", "terminus", "slice_start", "slice_end", "slice_stride", "space_average", "time_average", "newfile_interval" etc. are used as default values. Their set values are overwritten by "HistoryAutoAddVariable" or "NAMELIST#gtool_historyauto_nml". ("NAMELIST#gtool_historyauto_nml" is high priority, arguments of "HistoryAutoAddVariable" are medium, arguments of "HistoryAutoCreate" are low).
This procedure input/output NAMELIST#gtool_historyauto_nml .
Alias for HistoryAutoCreate1
Subroutine : | |||
title : | character(*), intent(in)
| ||
source : | character(*), intent(in)
| ||
institution : | character(*), intent(in)
| ||
dims(:) : | character(*), intent(in)
| ||
dimsizes(:) : | integer, intent(in)
| ||
longnames(:) : | character(*), intent(in)
| ||
units(:) : | character(*), intent(in)
| ||
xtypes(:) : | character(*), intent(in), optional
| ||
conventions : | character(*), intent(in), optional
| ||
gt_version : | character(*), intent(in), optional
| ||
all_output : | logical, intent(in), optional
| ||
file_prefix : | character(*), intent(in), optional
| ||
namelist_filename : | character(*), intent(in), optional
| ||
interval : | real, intent(in), optional
| ||
origin : | real, intent(in), optional
| ||
terminus : | real, intent(in), optional
| ||
slice_start(:) : | integer, intent(in), optional
| ||
slice_end(:) : | integer, intent(in), optional
| ||
slice_stride(:) : | integer, intent(in), optional
| ||
space_average(:) : | logical, intent(in), optional
| ||
time_average : | logical, intent(in), optional
| ||
newfile_interval : | integer, intent(in), optional
| ||
rank : | character(*), intent(in), optional
| ||
origin_date : | type(DC_DATETIME), intent(in), optional
| ||
origin_date_invalid : | logical, intent(in), optional
| ||
flag_mpi_gather : | logical, intent(in), optional
| ||
flag_mpi_split : | logical, intent(in), optional
|
複数のヒストリデータ出力を行うための初期化を行います.
この HistoryAutoCreate には, モデル内で出力する 変数が依存する座標や座標重みなどを全てを設定してください.
all_output に .true. を与えた場合や, namelist_filename を与えない (空文字を与える) 場合には, HistoryAutoAddVariable で登録される全ての変数が出力されます. 一方で namelist_filename に NAMELIST ファイル名を与える場合には, その NAMELIST ファイルから出力のオンオフや, 出力ファイル名, 出力間隔などを変更可能です. 変更可能な項目に関しては NAMELIST#gtool_historyauto_nml を参照して下さい.
interval, origin, terminus, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval などの設定はデフォルト値として使用されます. これらの設定値は HistoryAutoAddVariable および NAMELIST#gtool_historyauto_nml で上書きされます. (優先度が高いのは NAMELIST#gtool_historyauto_nml , HistoryAutoAddVariable の引数, HistoryAutoCreate の引数 の順です).
Initialization for multiple history data output
Set all axes and their weights depended by variables output from numerical models to this "HistoryAutoCreate".
All variables registered by "HistoryAutoAddVariable" are output if .true. is given to "all_output" or "namelist_filename" is not given (or blanks are given) On the other hand, if a filename of NAMELIST file is given to "namelist_filename", on/off of output, output filename and output interval, etc. can be changed from the NAMELIST file. For available items, see "NAMELIST#gtool_historyauto_nml".
Settings about "interval", "origin", "terminus", "slice_start", "slice_end", "slice_stride", "space_average", "time_average", "newfile_interval" etc. are used as default values. Their set values are overwritten by "HistoryAutoAddVariable" or "NAMELIST#gtool_historyauto_nml". ("NAMELIST#gtool_historyauto_nml" is high priority, arguments of "HistoryAutoAddVariable" are medium, arguments of "HistoryAutoCreate" are low).
Alias for HistoryAutoCreate2
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.
Alias for HistoryAutoPutDouble1
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:) : | integer, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutInt1
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:) : | real, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutReal1
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:) : | integer, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutInt2
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:) : | real(DP), intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutDouble2
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:) : | real, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutReal2
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:) : | integer, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutInt3
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:) : | real(DP), intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutDouble3
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:) : | real, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutReal3
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:) : | integer, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutInt4
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:) : | real(DP), intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutDouble4
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:) : | real, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutReal4
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:,:) : | integer, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutInt5
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:,:) : | real(DP), intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutDouble5
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:,:) : | real, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutReal5
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:,:,:) : | integer, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutInt6
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:,:,:) : | real(DP), intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutDouble6
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:,:,:) : | real, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutReal6
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:,:,:,:) : | integer, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutInt7
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:,:,:,:) : | real(DP), intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutDouble7
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
array(:,:,:,:,:,:,:) : | real, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutReal7
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
value : | integer, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutInt0
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
value : | real(DP), intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutDouble0
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in) | ||
varname : | character(*), intent(in) | ||
value : | real, intent(in), target | ||
err : | logical, intent(out), optional
|
Alias for HistoryAutoPutReal0
Subroutine : | |||
dim : | character(*), intent(in)
| ||
array(:) : | integer, intent(in)
|
座標データを設定します.
Set data of an axis.
Alias for HistoryAutoPutAxisInt
Subroutine : | |||
dim : | character(*), intent(in)
| ||
array(:) : | real(DP), intent(in)
|
座標データを設定します.
Set data of an axis.
Alias for HistoryAutoPutAxisDouble
Subroutine : | |||
dim : | character(*), intent(in)
| ||
array(:) : | real, intent(in)
|
座標データを設定します.
Set data of an axis.
Alias for HistoryAutoPutAxisReal
Subroutine : | |||
dim : | character(*), intent(in)
| ||
array(:) : | real(DP), intent(in)
|
MPI 使用時に, 各々のノード上のデータを単一ファイルに 集約して出力する場合には, このサブルーチンに領域全体の座標データを与えてください. また, HistoryAutoCreate のオプショナル論理型引数 flag_mpi_gather に .true. を与えてください.
When MPI is used, if data on each node is integrated and output to one file, give data of axes in whole area to this subroutine. And give .true. to optional logical argument flag_mpi_gather in "HistoryAutoCreate".
Alias for HistoryAutoPutAxisMPIDouble
Subroutine : | |
dim : | character(*), intent(in) |
array(:) : | integer, intent(in) |
MPI 使用時に, 各々のノード上のデータを単一ファイルに 集約して出力する場合には, このサブルーチンに領域全体の座標データを与えてください. また, HistoryAutoCreate のオプショナル論理型引数 flag_mpi_gather に .true. を与えてください.
When MPI is used, if data on each node is integrated and output to one file, give data of axes in whole area to this subroutine. And give .true. to optional logical argument flag_mpi_gather in "HistoryAutoCreate".
Alias for HistoryAutoPutAxisMPIInt
Subroutine : | |
dim : | character(*), intent(in) |
array(:) : | real, intent(in) |
MPI 使用時に, 各々のノード上のデータを単一ファイルに 集約して出力する場合には, このサブルーチンに領域全体の座標データを与えてください. また, HistoryAutoCreate のオプショナル論理型引数 flag_mpi_gather に .true. を与えてください.
When MPI is used, if data on each node is integrated and output to one file, give data of axes in whole area to this subroutine. And give .true. to optional logical argument flag_mpi_gather in "HistoryAutoCreate".
Alias for HistoryAutoPutAxisMPIReal
Derived Type : | |
wgt1(:) =>null() : | real(DP), pointer |
wgt2(:) =>null() : | real(DP), pointer |
wgt3(:) =>null() : | real(DP), pointer |
wgt4(:) =>null() : | real(DP), pointer |
wgt5(:) =>null() : | real(DP), pointer |
wgt6(:) =>null() : | real(DP), pointer |
wgt7(:) =>null() : | real(DP), pointer |
座標重み情報管理用の構造型 Derived type for information of axes weight
Subroutine : | |||
array(:) : | real(DP), intent(in), target | ||
space_average(1) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
array_avr(:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble1( array, space_average, weight1, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real(DP), intent(in), target:: array(:) logical, intent(in):: space_average(1) real(DP), intent(in):: weight1(:) real(DP), pointer:: array_avr(:) ! (out) real(DP), pointer:: array_avr_work(:) real(DP), pointer:: array_avr_work1(:) integer:: array_shape(1) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) ) ) array_avr_work1 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1) = array_avr_work1(1) + array_avr_work(i) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if allocate( array_avr( array_shape(1) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) end subroutine AverageReduceDouble1
Subroutine : | |||
array(:,:) : | real(DP), intent(in), target | ||
space_average(2) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
array_avr(:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble2( array, space_average, weight1, weight2, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real(DP), intent(in), target:: array(:,:) logical, intent(in):: space_average(2) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), pointer:: array_avr(:,:) ! (out) real(DP), pointer:: array_avr_work(:,:) real(DP), pointer:: array_avr_work1(:,:) real(DP), pointer:: array_avr_work2(:,:) integer:: array_shape(2) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) ) ) array_avr_work1 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:) = array_avr_work1(1,:) + array_avr_work(i,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) ) ) array_avr_work2 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1) = array_avr_work2(:,1) + array_avr_work(:,i) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if allocate( array_avr( array_shape(1) , array_shape(2) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) end subroutine AverageReduceDouble2
Subroutine : | |||
array(:,:,:) : | real(DP), intent(in), target | ||
space_average(3) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
array_avr(:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble3( array, space_average, weight1, weight2, weight3, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real(DP), intent(in), target:: array(:,:,:) logical, intent(in):: space_average(3) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), pointer:: array_avr(:,:,:) ! (out) real(DP), pointer:: array_avr_work(:,:,:) real(DP), pointer:: array_avr_work1(:,:,:) real(DP), pointer:: array_avr_work2(:,:,:) real(DP), pointer:: array_avr_work3(:,:,:) integer:: array_shape(3) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr_work1 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:) = array_avr_work1(1,:,:) + array_avr_work(i,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr_work2 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:) = array_avr_work2(:,1,:) + array_avr_work(:,i,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr_work3 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1) = array_avr_work3(:,:,1) + array_avr_work(:,:,i) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) end subroutine AverageReduceDouble3
Subroutine : | |||
array(:,:,:,:) : | real(DP), intent(in), target | ||
space_average(4) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble4( array, space_average, weight1, weight2, weight3, weight4, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real(DP), intent(in), target:: array(:,:,:,:) logical, intent(in):: space_average(4) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) real(DP), pointer:: array_avr(:,:,:,:) ! (out) real(DP), pointer:: array_avr_work(:,:,:,:) real(DP), pointer:: array_avr_work1(:,:,:,:) real(DP), pointer:: array_avr_work2(:,:,:,:) real(DP), pointer:: array_avr_work3(:,:,:,:) real(DP), pointer:: array_avr_work4(:,:,:,:) integer:: array_shape(4) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work1 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:) = array_avr_work1(1,:,:,:) + array_avr_work(i,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work2 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:) = array_avr_work2(:,1,:,:) + array_avr_work(:,i,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work3 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:) = array_avr_work3(:,:,1,:) + array_avr_work(:,:,i,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work4 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1) = array_avr_work4(:,:,:,1) + array_avr_work(:,:,:,i) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) end subroutine AverageReduceDouble4
Subroutine : | |||
array(:,:,:,:,:) : | real(DP), intent(in), target | ||
space_average(5) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
weight5(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real(DP), intent(in), target:: array(:,:,:,:,:) logical, intent(in):: space_average(5) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) real(DP), intent(in):: weight5(:) real(DP), pointer:: array_avr(:,:,:,:,:) ! (out) real(DP), pointer:: array_avr_work(:,:,:,:,:) real(DP), pointer:: array_avr_work1(:,:,:,:,:) real(DP), pointer:: array_avr_work2(:,:,:,:,:) real(DP), pointer:: array_avr_work3(:,:,:,:,:) real(DP), pointer:: array_avr_work4(:,:,:,:,:) real(DP), pointer:: array_avr_work5(:,:,:,:,:) integer:: array_shape(5) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work1 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:,:) = array_avr_work1(1,:,:,:,:) + array_avr_work(i,:,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work2 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:,:) = array_avr_work2(:,1,:,:,:) + array_avr_work(:,i,:,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work3 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:,:) = array_avr_work3(:,:,1,:,:) + array_avr_work(:,:,i,:,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work4 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1,:) = array_avr_work4(:,:,:,1,:) + array_avr_work(:,:,:,i,:) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if if ( space_average(5) ) then dim_size = array_shape(5) array_shape(5) = 1 allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work5 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work5(:,:,:,:,1) = array_avr_work5(:,:,:,:,1) + array_avr_work(:,:,:,:,i) * weight5(i) weight_sum = weight_sum + weight5(i) end do array_avr_work5 = array_avr_work5 / weight_sum array_avr_work => array_avr_work5 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 ) end subroutine AverageReduceDouble5
Subroutine : | |||
array(:,:,:,:,:,:) : | real(DP), intent(in), target | ||
space_average(6) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
weight5(:) : | real(DP), intent(in) | ||
weight6(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real(DP), intent(in), target:: array(:,:,:,:,:,:) logical, intent(in):: space_average(6) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) real(DP), intent(in):: weight5(:) real(DP), intent(in):: weight6(:) real(DP), pointer:: array_avr(:,:,:,:,:,:) ! (out) real(DP), pointer:: array_avr_work(:,:,:,:,:,:) real(DP), pointer:: array_avr_work1(:,:,:,:,:,:) real(DP), pointer:: array_avr_work2(:,:,:,:,:,:) real(DP), pointer:: array_avr_work3(:,:,:,:,:,:) real(DP), pointer:: array_avr_work4(:,:,:,:,:,:) real(DP), pointer:: array_avr_work5(:,:,:,:,:,:) real(DP), pointer:: array_avr_work6(:,:,:,:,:,:) integer:: array_shape(6) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work1 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work2 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:,:,:) = array_avr_work2(:,1,:,:,:,:) + array_avr_work(:,i,:,:,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work3 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:,:,:) = array_avr_work3(:,:,1,:,:,:) + array_avr_work(:,:,i,:,:,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work4 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1,:,:) = array_avr_work4(:,:,:,1,:,:) + array_avr_work(:,:,:,i,:,:) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if if ( space_average(5) ) then dim_size = array_shape(5) array_shape(5) = 1 allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work5 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work5(:,:,:,:,1,:) = array_avr_work5(:,:,:,:,1,:) + array_avr_work(:,:,:,:,i,:) * weight5(i) weight_sum = weight_sum + weight5(i) end do array_avr_work5 = array_avr_work5 / weight_sum array_avr_work => array_avr_work5 end if if ( space_average(6) ) then dim_size = array_shape(6) array_shape(6) = 1 allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work6 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work6(:,:,:,:,:,1) = array_avr_work6(:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,i) * weight6(i) weight_sum = weight_sum + weight6(i) end do array_avr_work6 = array_avr_work6 / weight_sum array_avr_work => array_avr_work6 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 ) if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 ) end subroutine AverageReduceDouble6
Subroutine : | |||
array(:,:,:,:,:,:,:) : | real(DP), intent(in), target | ||
space_average(7) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
weight5(:) : | real(DP), intent(in) | ||
weight6(:) : | real(DP), intent(in) | ||
weight7(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real(DP), intent(in), target:: array(:,:,:,:,:,:,:) logical, intent(in):: space_average(7) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) real(DP), intent(in):: weight5(:) real(DP), intent(in):: weight6(:) real(DP), intent(in):: weight7(:) real(DP), pointer:: array_avr(:,:,:,:,:,:,:) ! (out) real(DP), pointer:: array_avr_work(:,:,:,:,:,:,:) real(DP), pointer:: array_avr_work1(:,:,:,:,:,:,:) real(DP), pointer:: array_avr_work2(:,:,:,:,:,:,:) real(DP), pointer:: array_avr_work3(:,:,:,:,:,:,:) real(DP), pointer:: array_avr_work4(:,:,:,:,:,:,:) real(DP), pointer:: array_avr_work5(:,:,:,:,:,:,:) real(DP), pointer:: array_avr_work6(:,:,:,:,:,:,:) real(DP), pointer:: array_avr_work7(:,:,:,:,:,:,:) integer:: array_shape(7) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work1 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work2 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:,:,:,:) = array_avr_work2(:,1,:,:,:,:,:) + array_avr_work(:,i,:,:,:,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work3 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:,:,:,:) = array_avr_work3(:,:,1,:,:,:,:) + array_avr_work(:,:,i,:,:,:,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work4 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1,:,:,:) = array_avr_work4(:,:,:,1,:,:,:) + array_avr_work(:,:,:,i,:,:,:) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if if ( space_average(5) ) then dim_size = array_shape(5) array_shape(5) = 1 allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work5 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work5(:,:,:,:,1,:,:) = array_avr_work5(:,:,:,:,1,:,:) + array_avr_work(:,:,:,:,i,:,:) * weight5(i) weight_sum = weight_sum + weight5(i) end do array_avr_work5 = array_avr_work5 / weight_sum array_avr_work => array_avr_work5 end if if ( space_average(6) ) then dim_size = array_shape(6) array_shape(6) = 1 allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work6 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work6(:,:,:,:,:,1,:) = array_avr_work6(:,:,:,:,:,1,:) + array_avr_work(:,:,:,:,:,i,:) * weight6(i) weight_sum = weight_sum + weight6(i) end do array_avr_work6 = array_avr_work6 / weight_sum array_avr_work => array_avr_work6 end if if ( space_average(7) ) then dim_size = array_shape(7) array_shape(7) = 1 allocate( array_avr_work7( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work7 = 0.0_DP weight_sum = 0.0_DP do i = 1, dim_size array_avr_work7(:,:,:,:,:,:,1) = array_avr_work7(:,:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,:,i) * weight7(i) weight_sum = weight_sum + weight7(i) end do array_avr_work7 = array_avr_work7 / weight_sum array_avr_work => array_avr_work7 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 ) if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 ) if ( associated( array_avr_work7 ) ) deallocate( array_avr_work7 ) end subroutine AverageReduceDouble7
Subroutine : | |||
array(:) : | integer, intent(in), target | ||
space_average(1) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
array_avr(:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt1( array, space_average, weight1, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none integer, intent(in), target:: array(:) logical, intent(in):: space_average(1) real(DP), intent(in):: weight1(:) integer, pointer:: array_avr(:) ! (out) integer, pointer:: array_avr_work(:) integer, pointer:: array_avr_work1(:) integer:: array_shape(1) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) ) ) array_avr_work1 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1) = array_avr_work1(1) + array_avr_work(i) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if allocate( array_avr( array_shape(1) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) end subroutine AverageReduceInt1
Subroutine : | |||
array(:,:) : | integer, intent(in), target | ||
space_average(2) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
array_avr(:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt2( array, space_average, weight1, weight2, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none integer, intent(in), target:: array(:,:) logical, intent(in):: space_average(2) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) integer, pointer:: array_avr(:,:) ! (out) integer, pointer:: array_avr_work(:,:) integer, pointer:: array_avr_work1(:,:) integer, pointer:: array_avr_work2(:,:) integer:: array_shape(2) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) ) ) array_avr_work1 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:) = array_avr_work1(1,:) + array_avr_work(i,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) ) ) array_avr_work2 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1) = array_avr_work2(:,1) + array_avr_work(:,i) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if allocate( array_avr( array_shape(1) , array_shape(2) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) end subroutine AverageReduceInt2
Subroutine : | |||
array(:,:,:) : | integer, intent(in), target | ||
space_average(3) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
array_avr(:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt3( array, space_average, weight1, weight2, weight3, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none integer, intent(in), target:: array(:,:,:) logical, intent(in):: space_average(3) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) integer, pointer:: array_avr(:,:,:) ! (out) integer, pointer:: array_avr_work(:,:,:) integer, pointer:: array_avr_work1(:,:,:) integer, pointer:: array_avr_work2(:,:,:) integer, pointer:: array_avr_work3(:,:,:) integer:: array_shape(3) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr_work1 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:) = array_avr_work1(1,:,:) + array_avr_work(i,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr_work2 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:) = array_avr_work2(:,1,:) + array_avr_work(:,i,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr_work3 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1) = array_avr_work3(:,:,1) + array_avr_work(:,:,i) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) end subroutine AverageReduceInt3
Subroutine : | |||
array(:,:,:,:) : | integer, intent(in), target | ||
space_average(4) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt4( array, space_average, weight1, weight2, weight3, weight4, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none integer, intent(in), target:: array(:,:,:,:) logical, intent(in):: space_average(4) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) integer, pointer:: array_avr(:,:,:,:) ! (out) integer, pointer:: array_avr_work(:,:,:,:) integer, pointer:: array_avr_work1(:,:,:,:) integer, pointer:: array_avr_work2(:,:,:,:) integer, pointer:: array_avr_work3(:,:,:,:) integer, pointer:: array_avr_work4(:,:,:,:) integer:: array_shape(4) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work1 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:) = array_avr_work1(1,:,:,:) + array_avr_work(i,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work2 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:) = array_avr_work2(:,1,:,:) + array_avr_work(:,i,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work3 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:) = array_avr_work3(:,:,1,:) + array_avr_work(:,:,i,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work4 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1) = array_avr_work4(:,:,:,1) + array_avr_work(:,:,:,i) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) end subroutine AverageReduceInt4
Subroutine : | |||
array(:,:,:,:,:) : | integer, intent(in), target | ||
space_average(5) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
weight5(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none integer, intent(in), target:: array(:,:,:,:,:) logical, intent(in):: space_average(5) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) real(DP), intent(in):: weight5(:) integer, pointer:: array_avr(:,:,:,:,:) ! (out) integer, pointer:: array_avr_work(:,:,:,:,:) integer, pointer:: array_avr_work1(:,:,:,:,:) integer, pointer:: array_avr_work2(:,:,:,:,:) integer, pointer:: array_avr_work3(:,:,:,:,:) integer, pointer:: array_avr_work4(:,:,:,:,:) integer, pointer:: array_avr_work5(:,:,:,:,:) integer:: array_shape(5) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work1 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:,:) = array_avr_work1(1,:,:,:,:) + array_avr_work(i,:,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work2 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:,:) = array_avr_work2(:,1,:,:,:) + array_avr_work(:,i,:,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work3 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:,:) = array_avr_work3(:,:,1,:,:) + array_avr_work(:,:,i,:,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work4 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1,:) = array_avr_work4(:,:,:,1,:) + array_avr_work(:,:,:,i,:) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if if ( space_average(5) ) then dim_size = array_shape(5) array_shape(5) = 1 allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work5 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work5(:,:,:,:,1) = array_avr_work5(:,:,:,:,1) + array_avr_work(:,:,:,:,i) * weight5(i) weight_sum = weight_sum + weight5(i) end do array_avr_work5 = array_avr_work5 / weight_sum array_avr_work => array_avr_work5 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 ) end subroutine AverageReduceInt5
Subroutine : | |||
array(:,:,:,:,:,:) : | integer, intent(in), target | ||
space_average(6) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
weight5(:) : | real(DP), intent(in) | ||
weight6(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none integer, intent(in), target:: array(:,:,:,:,:,:) logical, intent(in):: space_average(6) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) real(DP), intent(in):: weight5(:) real(DP), intent(in):: weight6(:) integer, pointer:: array_avr(:,:,:,:,:,:) ! (out) integer, pointer:: array_avr_work(:,:,:,:,:,:) integer, pointer:: array_avr_work1(:,:,:,:,:,:) integer, pointer:: array_avr_work2(:,:,:,:,:,:) integer, pointer:: array_avr_work3(:,:,:,:,:,:) integer, pointer:: array_avr_work4(:,:,:,:,:,:) integer, pointer:: array_avr_work5(:,:,:,:,:,:) integer, pointer:: array_avr_work6(:,:,:,:,:,:) integer:: array_shape(6) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work1 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work2 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:,:,:) = array_avr_work2(:,1,:,:,:,:) + array_avr_work(:,i,:,:,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work3 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:,:,:) = array_avr_work3(:,:,1,:,:,:) + array_avr_work(:,:,i,:,:,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work4 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1,:,:) = array_avr_work4(:,:,:,1,:,:) + array_avr_work(:,:,:,i,:,:) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if if ( space_average(5) ) then dim_size = array_shape(5) array_shape(5) = 1 allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work5 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work5(:,:,:,:,1,:) = array_avr_work5(:,:,:,:,1,:) + array_avr_work(:,:,:,:,i,:) * weight5(i) weight_sum = weight_sum + weight5(i) end do array_avr_work5 = array_avr_work5 / weight_sum array_avr_work => array_avr_work5 end if if ( space_average(6) ) then dim_size = array_shape(6) array_shape(6) = 1 allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work6 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work6(:,:,:,:,:,1) = array_avr_work6(:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,i) * weight6(i) weight_sum = weight_sum + weight6(i) end do array_avr_work6 = array_avr_work6 / weight_sum array_avr_work => array_avr_work6 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 ) if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 ) end subroutine AverageReduceInt6
Subroutine : | |||
array(:,:,:,:,:,:,:) : | integer, intent(in), target | ||
space_average(7) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
weight5(:) : | real(DP), intent(in) | ||
weight6(:) : | real(DP), intent(in) | ||
weight7(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none integer, intent(in), target:: array(:,:,:,:,:,:,:) logical, intent(in):: space_average(7) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) real(DP), intent(in):: weight5(:) real(DP), intent(in):: weight6(:) real(DP), intent(in):: weight7(:) integer, pointer:: array_avr(:,:,:,:,:,:,:) ! (out) integer, pointer:: array_avr_work(:,:,:,:,:,:,:) integer, pointer:: array_avr_work1(:,:,:,:,:,:,:) integer, pointer:: array_avr_work2(:,:,:,:,:,:,:) integer, pointer:: array_avr_work3(:,:,:,:,:,:,:) integer, pointer:: array_avr_work4(:,:,:,:,:,:,:) integer, pointer:: array_avr_work5(:,:,:,:,:,:,:) integer, pointer:: array_avr_work6(:,:,:,:,:,:,:) integer, pointer:: array_avr_work7(:,:,:,:,:,:,:) integer:: array_shape(7) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work1 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work2 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:,:,:,:) = array_avr_work2(:,1,:,:,:,:,:) + array_avr_work(:,i,:,:,:,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work3 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:,:,:,:) = array_avr_work3(:,:,1,:,:,:,:) + array_avr_work(:,:,i,:,:,:,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work4 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1,:,:,:) = array_avr_work4(:,:,:,1,:,:,:) + array_avr_work(:,:,:,i,:,:,:) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if if ( space_average(5) ) then dim_size = array_shape(5) array_shape(5) = 1 allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work5 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work5(:,:,:,:,1,:,:) = array_avr_work5(:,:,:,:,1,:,:) + array_avr_work(:,:,:,:,i,:,:) * weight5(i) weight_sum = weight_sum + weight5(i) end do array_avr_work5 = array_avr_work5 / weight_sum array_avr_work => array_avr_work5 end if if ( space_average(6) ) then dim_size = array_shape(6) array_shape(6) = 1 allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work6 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work6(:,:,:,:,:,1,:) = array_avr_work6(:,:,:,:,:,1,:) + array_avr_work(:,:,:,:,:,i,:) * weight6(i) weight_sum = weight_sum + weight6(i) end do array_avr_work6 = array_avr_work6 / weight_sum array_avr_work => array_avr_work6 end if if ( space_average(7) ) then dim_size = array_shape(7) array_shape(7) = 1 allocate( array_avr_work7( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work7 = 0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work7(:,:,:,:,:,:,1) = array_avr_work7(:,:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,:,i) * weight7(i) weight_sum = weight_sum + weight7(i) end do array_avr_work7 = array_avr_work7 / weight_sum array_avr_work => array_avr_work7 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 ) if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 ) if ( associated( array_avr_work7 ) ) deallocate( array_avr_work7 ) end subroutine AverageReduceInt7
Subroutine : | |||
array(:) : | real, intent(in), target | ||
space_average(1) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
array_avr(:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal1( array, space_average, weight1, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real, intent(in), target:: array(:) logical, intent(in):: space_average(1) real(DP), intent(in):: weight1(:) real, pointer:: array_avr(:) ! (out) real, pointer:: array_avr_work(:) real, pointer:: array_avr_work1(:) integer:: array_shape(1) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) ) ) array_avr_work1 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1) = array_avr_work1(1) + array_avr_work(i) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if allocate( array_avr( array_shape(1) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) end subroutine AverageReduceReal1
Subroutine : | |||
array(:,:) : | real, intent(in), target | ||
space_average(2) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
array_avr(:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal2( array, space_average, weight1, weight2, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real, intent(in), target:: array(:,:) logical, intent(in):: space_average(2) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real, pointer:: array_avr(:,:) ! (out) real, pointer:: array_avr_work(:,:) real, pointer:: array_avr_work1(:,:) real, pointer:: array_avr_work2(:,:) integer:: array_shape(2) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) ) ) array_avr_work1 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:) = array_avr_work1(1,:) + array_avr_work(i,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) ) ) array_avr_work2 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1) = array_avr_work2(:,1) + array_avr_work(:,i) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if allocate( array_avr( array_shape(1) , array_shape(2) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) end subroutine AverageReduceReal2
Subroutine : | |||
array(:,:,:) : | real, intent(in), target | ||
space_average(3) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
array_avr(:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal3( array, space_average, weight1, weight2, weight3, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real, intent(in), target:: array(:,:,:) logical, intent(in):: space_average(3) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real, pointer:: array_avr(:,:,:) ! (out) real, pointer:: array_avr_work(:,:,:) real, pointer:: array_avr_work1(:,:,:) real, pointer:: array_avr_work2(:,:,:) real, pointer:: array_avr_work3(:,:,:) integer:: array_shape(3) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr_work1 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:) = array_avr_work1(1,:,:) + array_avr_work(i,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr_work2 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:) = array_avr_work2(:,1,:) + array_avr_work(:,i,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr_work3 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1) = array_avr_work3(:,:,1) + array_avr_work(:,:,i) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) end subroutine AverageReduceReal3
Subroutine : | |||
array(:,:,:,:) : | real, intent(in), target | ||
space_average(4) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal4( array, space_average, weight1, weight2, weight3, weight4, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real, intent(in), target:: array(:,:,:,:) logical, intent(in):: space_average(4) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) real, pointer:: array_avr(:,:,:,:) ! (out) real, pointer:: array_avr_work(:,:,:,:) real, pointer:: array_avr_work1(:,:,:,:) real, pointer:: array_avr_work2(:,:,:,:) real, pointer:: array_avr_work3(:,:,:,:) real, pointer:: array_avr_work4(:,:,:,:) integer:: array_shape(4) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work1 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:) = array_avr_work1(1,:,:,:) + array_avr_work(i,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work2 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:) = array_avr_work2(:,1,:,:) + array_avr_work(:,i,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work3 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:) = array_avr_work3(:,:,1,:) + array_avr_work(:,:,i,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr_work4 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1) = array_avr_work4(:,:,:,1) + array_avr_work(:,:,:,i) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) end subroutine AverageReduceReal4
Subroutine : | |||
array(:,:,:,:,:) : | real, intent(in), target | ||
space_average(5) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
weight5(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real, intent(in), target:: array(:,:,:,:,:) logical, intent(in):: space_average(5) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) real(DP), intent(in):: weight5(:) real, pointer:: array_avr(:,:,:,:,:) ! (out) real, pointer:: array_avr_work(:,:,:,:,:) real, pointer:: array_avr_work1(:,:,:,:,:) real, pointer:: array_avr_work2(:,:,:,:,:) real, pointer:: array_avr_work3(:,:,:,:,:) real, pointer:: array_avr_work4(:,:,:,:,:) real, pointer:: array_avr_work5(:,:,:,:,:) integer:: array_shape(5) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work1 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:,:) = array_avr_work1(1,:,:,:,:) + array_avr_work(i,:,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work2 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:,:) = array_avr_work2(:,1,:,:,:) + array_avr_work(:,i,:,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work3 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:,:) = array_avr_work3(:,:,1,:,:) + array_avr_work(:,:,i,:,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work4 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1,:) = array_avr_work4(:,:,:,1,:) + array_avr_work(:,:,:,i,:) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if if ( space_average(5) ) then dim_size = array_shape(5) array_shape(5) = 1 allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr_work5 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work5(:,:,:,:,1) = array_avr_work5(:,:,:,:,1) + array_avr_work(:,:,:,:,i) * weight5(i) weight_sum = weight_sum + weight5(i) end do array_avr_work5 = array_avr_work5 / weight_sum array_avr_work => array_avr_work5 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 ) end subroutine AverageReduceReal5
Subroutine : | |||
array(:,:,:,:,:,:) : | real, intent(in), target | ||
space_average(6) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
weight5(:) : | real(DP), intent(in) | ||
weight6(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real, intent(in), target:: array(:,:,:,:,:,:) logical, intent(in):: space_average(6) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) real(DP), intent(in):: weight5(:) real(DP), intent(in):: weight6(:) real, pointer:: array_avr(:,:,:,:,:,:) ! (out) real, pointer:: array_avr_work(:,:,:,:,:,:) real, pointer:: array_avr_work1(:,:,:,:,:,:) real, pointer:: array_avr_work2(:,:,:,:,:,:) real, pointer:: array_avr_work3(:,:,:,:,:,:) real, pointer:: array_avr_work4(:,:,:,:,:,:) real, pointer:: array_avr_work5(:,:,:,:,:,:) real, pointer:: array_avr_work6(:,:,:,:,:,:) integer:: array_shape(6) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work1 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work2 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:,:,:) = array_avr_work2(:,1,:,:,:,:) + array_avr_work(:,i,:,:,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work3 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:,:,:) = array_avr_work3(:,:,1,:,:,:) + array_avr_work(:,:,i,:,:,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work4 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1,:,:) = array_avr_work4(:,:,:,1,:,:) + array_avr_work(:,:,:,i,:,:) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if if ( space_average(5) ) then dim_size = array_shape(5) array_shape(5) = 1 allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work5 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work5(:,:,:,:,1,:) = array_avr_work5(:,:,:,:,1,:) + array_avr_work(:,:,:,:,i,:) * weight5(i) weight_sum = weight_sum + weight5(i) end do array_avr_work5 = array_avr_work5 / weight_sum array_avr_work => array_avr_work5 end if if ( space_average(6) ) then dim_size = array_shape(6) array_shape(6) = 1 allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr_work6 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work6(:,:,:,:,:,1) = array_avr_work6(:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,i) * weight6(i) weight_sum = weight_sum + weight6(i) end do array_avr_work6 = array_avr_work6 / weight_sum array_avr_work => array_avr_work6 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 ) if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 ) end subroutine AverageReduceReal6
Subroutine : | |||
array(:,:,:,:,:,:,:) : | real, intent(in), target | ||
space_average(7) : | logical, intent(in) | ||
weight1(:) : | real(DP), intent(in) | ||
weight2(:) : | real(DP), intent(in) | ||
weight3(:) : | real(DP), intent(in) | ||
weight4(:) : | real(DP), intent(in) | ||
weight5(:) : | real(DP), intent(in) | ||
weight6(:) : | real(DP), intent(in) | ||
weight7(:) : | real(DP), intent(in) | ||
array_avr(:,:,:,:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr ) ! ! space_average で .true. に指定された次元に対して, ! array を平均化して array_avr に返します. ! 平均化には重み weight1 〜 weight7 が用いられます. ! array_avr の配列の次元そのものは減りません. その代わり, ! 平均化された次元の配列のサイズは 1 になります. ! implicit none real, intent(in), target:: array(:,:,:,:,:,:,:) logical, intent(in):: space_average(7) real(DP), intent(in):: weight1(:) real(DP), intent(in):: weight2(:) real(DP), intent(in):: weight3(:) real(DP), intent(in):: weight4(:) real(DP), intent(in):: weight5(:) real(DP), intent(in):: weight6(:) real(DP), intent(in):: weight7(:) real, pointer:: array_avr(:,:,:,:,:,:,:) ! (out) real, pointer:: array_avr_work(:,:,:,:,:,:,:) real, pointer:: array_avr_work1(:,:,:,:,:,:,:) real, pointer:: array_avr_work2(:,:,:,:,:,:,:) real, pointer:: array_avr_work3(:,:,:,:,:,:,:) real, pointer:: array_avr_work4(:,:,:,:,:,:,:) real, pointer:: array_avr_work5(:,:,:,:,:,:,:) real, pointer:: array_avr_work6(:,:,:,:,:,:,:) real, pointer:: array_avr_work7(:,:,:,:,:,:,:) integer:: array_shape(7) integer:: i, dim_size real(DP):: weight_sum continue array_shape = shape( array ) array_avr_work => array if ( space_average(1) ) then dim_size = array_shape(1) array_shape(1) = 1 allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work1 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work1(1,:,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:,:) * weight1(i) weight_sum = weight_sum + weight1(i) end do array_avr_work1 = array_avr_work1 / weight_sum array_avr_work => array_avr_work1 end if if ( space_average(2) ) then dim_size = array_shape(2) array_shape(2) = 1 allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work2 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work2(:,1,:,:,:,:,:) = array_avr_work2(:,1,:,:,:,:,:) + array_avr_work(:,i,:,:,:,:,:) * weight2(i) weight_sum = weight_sum + weight2(i) end do array_avr_work2 = array_avr_work2 / weight_sum array_avr_work => array_avr_work2 end if if ( space_average(3) ) then dim_size = array_shape(3) array_shape(3) = 1 allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work3 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work3(:,:,1,:,:,:,:) = array_avr_work3(:,:,1,:,:,:,:) + array_avr_work(:,:,i,:,:,:,:) * weight3(i) weight_sum = weight_sum + weight3(i) end do array_avr_work3 = array_avr_work3 / weight_sum array_avr_work => array_avr_work3 end if if ( space_average(4) ) then dim_size = array_shape(4) array_shape(4) = 1 allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work4 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work4(:,:,:,1,:,:,:) = array_avr_work4(:,:,:,1,:,:,:) + array_avr_work(:,:,:,i,:,:,:) * weight4(i) weight_sum = weight_sum + weight4(i) end do array_avr_work4 = array_avr_work4 / weight_sum array_avr_work => array_avr_work4 end if if ( space_average(5) ) then dim_size = array_shape(5) array_shape(5) = 1 allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work5 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work5(:,:,:,:,1,:,:) = array_avr_work5(:,:,:,:,1,:,:) + array_avr_work(:,:,:,:,i,:,:) * weight5(i) weight_sum = weight_sum + weight5(i) end do array_avr_work5 = array_avr_work5 / weight_sum array_avr_work => array_avr_work5 end if if ( space_average(6) ) then dim_size = array_shape(6) array_shape(6) = 1 allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work6 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work6(:,:,:,:,:,1,:) = array_avr_work6(:,:,:,:,:,1,:) + array_avr_work(:,:,:,:,:,i,:) * weight6(i) weight_sum = weight_sum + weight6(i) end do array_avr_work6 = array_avr_work6 / weight_sum array_avr_work => array_avr_work6 end if if ( space_average(7) ) then dim_size = array_shape(7) array_shape(7) = 1 allocate( array_avr_work7( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr_work7 = 0.0 weight_sum = 0.0_DP do i = 1, dim_size array_avr_work7(:,:,:,:,:,:,1) = array_avr_work7(:,:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,:,i) * weight7(i) weight_sum = weight_sum + weight7(i) end do array_avr_work7 = array_avr_work7 / weight_sum array_avr_work => array_avr_work7 end if allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) ) array_avr = array_avr_work nullify( array_avr_work ) if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 ) if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 ) if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 ) if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 ) if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 ) if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 ) if ( associated( array_avr_work7 ) ) deallocate( array_avr_work7 ) end subroutine AverageReduceReal7
Derived Type : | |
a_axis(:) =>null() : | real(DP), pointer |
座標軸データ用の構造型 Derived type for axes data
Derived Type : | |
gthist =>null() : | type(GT_HISTORY), pointer |
GT_HISTORY 型変数を指す構造体 Derived type for indication to "GT_HISTORY"
Subroutine : | |||
varname : | character(*), intent(in)
| ||
attrname : | character(*), intent(in)
| ||
value : | character(*), intent(in)
|
座標変数および座標重み変数に属性を付加します. このサブルーチンを用いる前に, HistoryAutoCreate による初期設定が 必要です.
Add attributes axes or weights of axes. Initialization by "HistoryAutoCreate" is needed before use of this subroutine.
subroutine HistoryAutoAddAttrChar0( varname, attrname, value ) ! ! ! 座標変数および座標重み変数に属性を付加します. ! このサブルーチンを用いる前に, HistoryAutoCreate による初期設定が ! 必要です. ! ! * 座標変数については, HistoryAutoCreate の "dims" に与えられた ! もののみ指定可能です. ! ! * 座標重み変数については, HistoryAutoAddWeight で与えられた ! もののみ指定可能です. ! ! * *HistoryAutoAddAttr* は複数のサブルーチンの総称名です. *value* ! にはいくつかの型を与えることが可能です. ! 下記のサブルーチンを参照ください. ! ! Add attributes axes or weights of axes. ! Initialization by "HistoryAutoCreate" is needed ! before use of this subroutine. ! ! * About axes, "dims" specified by "HistoryAutoCreate" can be ! specified. ! ! * About weights of axes, "dims" specified by "HistoryAutoAddWeight" ! can be specified. ! ! * "HistoryAutoAddAttr" is a generic name of multiple subroutines. ! Then some data type can be specified to "value". ! ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME, DC_ENOTINIT use dc_string, only: toChar use gtool_history, only: HistoryAxisAddAttr, HistoryAxisInquire, HistoryVarinfoAddAttr, HistoryVarinfoInquire implicit none character(*), intent(in):: varname ! 変数の名前. ! ! ここで指定するものは, ! HistoryAutoCreate の *dims* , ! または HistoryAutoAddWeight の ! *varname* で既に指定されてい ! なければなりません. ! ! Name of a variable. ! ! This must be specified with *dims* ! in HistoryAutoCreate, or ! *varname* in "HistoryAutoAddWeight". ! character(*), intent(in):: attrname ! 属性の名前. ! Name of an attribute. character(*), intent(in):: value ! 属性の値. ! Value of an attribute. character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddAttrChar0" continue call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(value)) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryAxisAddAttr( axis = gthst_axes(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do do i = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryVarinfoAddAttr( varinfo = gthst_weights(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = varname 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddAttrChar0
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value : | real(DP), intent(in) |
subroutine HistoryAutoAddAttrDouble0( varname, attrname, value ) ! ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME, DC_ENOTINIT use dc_string, only: toChar use gtool_history, only: HistoryAxisAddAttr, HistoryAxisInquire, HistoryVarinfoAddAttr, HistoryVarinfoInquire implicit none character(*), intent(in):: varname character(*), intent(in):: attrname real(DP), intent(in):: value character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddAttrDouble0" continue call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value))) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryAxisAddAttr( axis = gthst_axes(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do do i = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryVarinfoAddAttr( varinfo = gthst_weights(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = varname 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddAttrDouble0
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value(:) : | real(DP), intent(in) |
subroutine HistoryAutoAddAttrDouble1( varname, attrname, value ) ! ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME, DC_ENOTINIT use dc_string, only: toChar use gtool_history, only: HistoryAxisAddAttr, HistoryAxisInquire, HistoryVarinfoAddAttr, HistoryVarinfoInquire implicit none character(*), intent(in):: varname character(*), intent(in):: attrname real(DP), intent(in):: value(:) character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddAttrDouble1" continue call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value))) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryAxisAddAttr( axis = gthst_axes(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do do i = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryVarinfoAddAttr( varinfo = gthst_weights(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = varname 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddAttrDouble1
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value : | integer, intent(in) |
subroutine HistoryAutoAddAttrInt0( varname, attrname, value ) ! ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME, DC_ENOTINIT use dc_string, only: toChar use gtool_history, only: HistoryAxisAddAttr, HistoryAxisInquire, HistoryVarinfoAddAttr, HistoryVarinfoInquire implicit none character(*), intent(in):: varname character(*), intent(in):: attrname integer, intent(in):: value character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddAttrInt0" continue call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value))) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryAxisAddAttr( axis = gthst_axes(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do do i = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryVarinfoAddAttr( varinfo = gthst_weights(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = varname 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddAttrInt0
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value(:) : | integer, intent(in) |
subroutine HistoryAutoAddAttrInt1( varname, attrname, value ) ! ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME, DC_ENOTINIT use dc_string, only: toChar use gtool_history, only: HistoryAxisAddAttr, HistoryAxisInquire, HistoryVarinfoAddAttr, HistoryVarinfoInquire implicit none character(*), intent(in):: varname character(*), intent(in):: attrname integer, intent(in):: value(:) character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddAttrInt1" continue call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value))) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryAxisAddAttr( axis = gthst_axes(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do do i = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryVarinfoAddAttr( varinfo = gthst_weights(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = varname 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddAttrInt1
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value : | logical, intent(in) |
subroutine HistoryAutoAddAttrLogical0( varname, attrname, value ) ! ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME, DC_ENOTINIT use dc_string, only: toChar use gtool_history, only: HistoryAxisAddAttr, HistoryAxisInquire, HistoryVarinfoAddAttr, HistoryVarinfoInquire implicit none character(*), intent(in):: varname character(*), intent(in):: attrname logical, intent(in):: value character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddAttrLogical0" continue call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value))) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryAxisAddAttr( axis = gthst_axes(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do do i = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryVarinfoAddAttr( varinfo = gthst_weights(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = varname 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddAttrLogical0
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value : | real, intent(in) |
subroutine HistoryAutoAddAttrReal0( varname, attrname, value ) ! ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME, DC_ENOTINIT use dc_string, only: toChar use gtool_history, only: HistoryAxisAddAttr, HistoryAxisInquire, HistoryVarinfoAddAttr, HistoryVarinfoInquire implicit none character(*), intent(in):: varname character(*), intent(in):: attrname real, intent(in):: value character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddAttrReal0" continue call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value))) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryAxisAddAttr( axis = gthst_axes(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do do i = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryVarinfoAddAttr( varinfo = gthst_weights(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = varname 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddAttrReal0
Subroutine : | |
varname : | character(*), intent(in) |
attrname : | character(*), intent(in) |
value(:) : | real, intent(in) |
subroutine HistoryAutoAddAttrReal1( varname, attrname, value ) ! ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME, DC_ENOTINIT use dc_string, only: toChar use gtool_history, only: HistoryAxisAddAttr, HistoryAxisInquire, HistoryVarinfoAddAttr, HistoryVarinfoInquire implicit none character(*), intent(in):: varname character(*), intent(in):: attrname real, intent(in):: value(:) character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddAttrReal1" continue call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value))) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryAxisAddAttr( axis = gthst_axes(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do do i = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then call HistoryVarinfoAddAttr( varinfo = gthst_weights(i), attrname = attrname, value = value ) ! (in) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = varname 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddAttrReal1
Subroutine : | |||
varname : | character(*), intent(in)
| ||
dims(:) : | character(*), intent(in)
| ||
longname : | character(*), intent(in)
| ||
units : | character(*), intent(in)
| ||
xtype : | character(*), intent(in), optional
| ||
time_units : | character(*), intent(in), optional
| ||
time_average : | logical, intent(in), optional
| ||
file : | character(*), intent(in), optional
| ||
origin : | real, intent(in), optional
| ||
terminus : | real, intent(in), optional
| ||
interval : | real, intent(in), optional
| ||
slice_start(:) : | integer, intent(in), optional
| ||
slice_end(:) : | integer, intent(in), optional
| ||
slice_stride(:) : | integer, intent(in), optional
| ||
space_average(:) : | logical, intent(in), optional
| ||
newfile_interval : | integer, intent(in), optional
|
データ出力するための変数登録を行います.
HistoryAutoAllVarFix を呼ぶ前にこのサブルーチンを使用してください.
Register variables for history data output
Use this subroutine before "HistoryAutoAllVarFix" is called.
subroutine HistoryAutoAddVariable1( varname, dims, longname, units, xtype, time_units, time_average, file, origin, terminus, interval, slice_start, slice_end, slice_stride, space_average, newfile_interval ) ! ! データ出力するための変数登録を行います. ! ! HistoryAutoAllVarFix を呼ぶ前にこのサブルーチンを使用してください. ! ! Register variables for history data output ! ! Use this subroutine before "HistoryAutoAllVarFix" is called. ! ! モジュール引用 ; USE statements ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_EVARINUSE, HST_EALREADYREGVARFIX, DC_ENOTINIT, HST_EMAXDIMSDEPENDED, HST_EINDIVISIBLE use dc_message, only: MessageNotify use dc_string, only: StrInclude, JoinChar, toChar use dc_date, only: DCDiffTimeCreate, operator(/), mod, EvalSec, operator(-), EvalbyUnit use netcdf_f77, only: NF_EMAXVARS use gtool_history, only: HistoryVarinfoCreate, HistoryVarinfoInquire, HistoryAxisInquire use gtool_history_nmlinfo, only: HstNmlInfoSetValidName, HstNmlInfoDefineMode, HstNmlInfoReDefine, HstNmlInfoEndDefine, HstNmlInfoAdd, HstNmlInfoInquire, HstNmlInfoOutputValid, HstNmlInfoAssocGtHist ! 宣言文 ; Declaration statements ! implicit none character(*), intent(in):: varname ! 変数名. Variable name character(*), intent(in):: dims(:) ! 変数が依存する次元の名前. ! 時間の次元は配列の最後に指定すること. ! ! Names of dependency dimensions of a variable. ! Dimension of time must be specified ! to last of an array. character(*), intent(in):: longname ! 変数の記述的名称. ! ! Descriptive name of a variable character(*), intent(in):: units ! 変数の単位. ! ! Units of a variable character(*), intent(in), optional:: xtype ! ! 変数のデータ型 ! ! デフォルトは float (単精度実数型) であ ! る. 有効なのは, double (倍精度実数型), ! int (整数型) である. 指定しない 場合や, ! 無効な型を指定した場合には, float (単 ! 精度実数型) となる. ! ! Data types of dimensions specified ! with "dims". ! ! Default value is "float" (single precision). ! Other valid values are ! "double" (double precision), ! "int" (integer). ! If no value or invalid value is specified, ! "float" is applied. ! character(*), intent(in), optional:: time_units ! 時刻次元の単位. ! Units of time dimension. logical, intent(in), optional:: time_average ! ! 出力データを時間平均する場合には ! .true. を与えます. デフォルトは ! .false. です. ! ! If output data is averaged, specify ! ".true.". Default is ".false.". ! character(*), intent(in), optional:: file ! 出力ファイル名. ! Output file name. real, intent(in), optional:: origin ! 出力開始時刻. ! ! 省略した場合, 自動的に 0.0 [sec] が ! 設定されます. ! ! Start time of output. ! ! If this argument is omitted, ! 0.0 [sec] is specified ! automatically. ! real, intent(in), optional:: terminus ! 出力終了時刻. ! ! 省略した場合, 数値モデルの実行が終了するまで ! 出力を行います. ! ! End time of output. ! ! If this argument is omitted, ! output is continued until a numerical model ! is finished. ! real, intent(in), optional:: interval ! 出力時間間隔. ! ! 省略した場合, ! 自動的に 1.0 [sec] が設定されます. ! ! Interval of output time. ! ! If this argument is omitted, ! a value of 1.0 [sec] is specified ! automatically. ! integer, intent(in), optional:: slice_start(:) ! 空間方向の開始点. ! ! 省略した場合, 座標データの開始点が設定されます. ! ! Start points of spaces. ! ! If this argument is omitted, ! start points of dimensions are set. ! integer, intent(in), optional:: slice_end(:) ! 空間方向の終了点. ! ! 省略した場合, 座標データの終了点が設定されます. ! ! End points of spaces. ! ! If this argument is omitted, ! End points of dimensions are set. ! integer, intent(in), optional:: slice_stride(:) ! 空間方向の刻み幅. ! ! 省略した場合, 1 が設定されます. ! ! Strides of spaces ! ! If this argument is omitted, ! 1 is set. ! logical, intent(in), optional:: space_average(:) ! 平均化のフラグ. ! ! .true. が指定される座標に対して平均化を ! 行います. ! 省略した場合, .false. が設定されます. ! ! Flag of average. ! ! Axes specified .true. are averaged. ! If this argument is omitted, ! .false. is set. ! integer, intent(in), optional:: newfile_interval ! ファイル分割時間間隔. ! ! 省略した場合, ! 時間方向へのファイル分割を行いません. ! ! Interval of time of separation of a file. ! ! If this argument is omitted, ! a files is not separated in time direction. ! ! 作業変数 ! Work variables ! character(TOKEN):: interval_unit_work ! データの出力間隔の単位. ! Unit for interval of history data output character(TOKEN):: origin_unit_work ! 出力開始時刻の単位. ! Unit of start time of output. character(TOKEN):: terminus_unit_work ! 出力終了時刻の単位. ! Unit of end time of output. character(TOKEN):: newfile_intunit_work ! ファイル分割時間間隔の単位. ! Unit of interval of time of separation of a file. real:: interval_value ! データの出力間隔の数値. ! Numerical value for interval of history data output real:: origin_value ! データの出力開始時刻の数値. ! Numerical value for start time of history data output real:: terminus_value ! 出力終了時刻の数値. ! Numerical value for end time of output. integer:: newfile_intvalue ! ファイル分割時間間隔. ! Interval of time of separation of a file. character(TOKEN):: time_name ! 時刻次元の名称. ! Name of time dimension character(STRING), allocatable:: dims_work(:) ! 変数が依存する次元の名前. ! Names of dependency dimensions of a variable. character(TOKEN):: precision ! データの精度. ! Precision of history data logical:: time_average_work ! 出力データの時間平均フラグ. ! Flag for time average of output data logical:: space_average_work(1:numdims-1) integer:: slice_start_work(1:numdims-1) ! 空間方向の開始点. ! Start points of spaces. integer:: slice_end_work(1:numdims-1) ! 空間方向の終了点. ! End points of spaces. integer:: slice_stride_work(1:numdims-1) ! 空間方向の刻み幅. ! Strides of spaces logical:: define_mode, varname_not_found integer:: cause_i, stat, i, j, k, cnt, cnt2, dim_size character(TOKEN), pointer:: dims_noavr(:) =>null(), dims_avr(:) =>null() character(STRING):: longname_avrmsg character(STRING):: name, cause_c character(*), parameter:: subname = "HistoryAutoAddVariable1" continue call BeginSub(subname, 'varname=%c', c1 = trim(varname), version = version) stat = DC_NOERR cause_c = "" cause_i = 0 ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if ! 既に HistoryAutoAllVarFix が呼ばれていたらエラー ! Error is occurred if "HistoryAutoAllVarFix" is called already ! if ( flag_allvarfixed ) then call MessageNotify( 'W', subname, '"HistoryAutoAddVariable" (varname = %c) must be called before "HistoryAutoAllVarFix"', c1 = trim(varname) ) stat = HST_EALREADYREGVARFIX cause_c = 'HistoryAutoAllVarFix' goto 999 end if ! 重複のチェック ! Check duplication ! do i = 1, numvars call HistoryVarinfoInquire( varinfo = gthst_vars(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) then stat = HST_EVARINUSE cause_c = varname goto 999 end if end do ! 変数の数の限界チェック ! Check limit of number of variables ! if ( numvars + 1 > MAX_VARS ) then stat = NF_EMAXVARS goto 999 end if ! 時刻の次元に関する修正 ! Correction for time dimension ! call HistoryAxisInquire( axis = gthst_axes(numdims), name = time_name ) ! (out) if ( size(dims) > 0 ) then if ( StrInclude( dims, time_name ) ) then if ( trim( dims(size(dims)) ) == trim( time_name ) ) then allocate( dims_work(size(dims)) ) dims_work = dims else allocate( dims_work(size(dims)) ) cnt = 1 do i = 1, size(dims) if ( trim( dims(i) ) /= trim( time_name ) ) then dims_work( cnt ) = dims( i ) cnt = cnt + 1 end if end do dims_work(size(dims)) = time_name call MessageNotify( 'W', subname, 'last entity of "dims=<%c>" must be time dimension (varname=<%c>). ' // ' "dims" are resequenced forcibly => <%c>', c1 = trim( JoinChar(dims, ',') ), c2 = trim( varname ), c3 = trim( JoinChar(dims_work, ',') ) ) end if else allocate( dims_work(size(dims)+1) ) dims_work(1:size(dims)) = dims dims_work(size(dims)+1) = time_name call MessageNotify( 'W', subname, 'time dimension is not found in "dims=<%c>" (varname=<%c>). ' // ' time dimension "%c" is appended to "dims" forcibly.', c1 = trim( JoinChar(dims, ',') ), c2 = trim( varname ), c3 = trim( time_name ) ) end if else allocate( dims_work(1) ) dims_work(1) = time_name call MessageNotify( 'W', subname, 'time dimension is not found (varname=<%c>). ' // ' time dimension "%c" is appended to "dims" forcibly.', c1 = trim( varname ), c2 = trim( time_name ) ) end if ! 依存する次元の数の限界チェック ! Check limit of number of depended dimensions ! if ( size( dims_work ) - 1 > MAX_DIMS_DEPENDED_BY_VAR ) then call MessageNotify( 'W', subname, 'number of dimensions' // ' on which one variable depends must not be greater than %d (varname=<%c>, dims=<%c>). ', i = (/ 7 + 1 /), c1 = trim( varname ), c2 = trim( JoinChar(dims_work, ',') ) ) stat = HST_EMAXDIMSDEPENDED cause_i = size( dims_work ) cause_c = varname end if ! 全ての変数を出力する際には, ここで登録 ! Register here if all variables are output ! if ( all_output_save ) then call HstNmlInfoInquire( gthstnml = gthstnml, name = varname, err = varname_not_found ) ! (out) optional if ( varname_not_found ) then define_mode = HstNmlInfoDefineMode( gthstnml ) if ( .not. define_mode ) call HstNmlInfoReDefine( gthstnml ) ! (inout) call HstNmlInfoInquire( gthstnml = gthstnml, interval_unit = interval_unit_work, origin_unit = origin_unit_work , terminus_unit = terminus_unit_work, newfile_intunit = newfile_intunit_work ) ! (out) optional ! 時刻の単位を設定 ! Configure unit of time ! if ( present( interval ) ) then interval_unit_work = time_unit_bycreate if ( present(time_units) ) interval_unit_work = time_units end if if ( present( origin ) ) then origin_unit_work = time_unit_bycreate if ( present(time_units) ) origin_unit_work = time_units end if if ( present( terminus ) ) then terminus_unit_work = time_unit_bycreate if ( present(time_units) ) terminus_unit_work = time_units end if if ( present( newfile_interval ) ) then newfile_intunit_work = time_unit_bycreate if ( present(time_units) ) newfile_intunit_work = time_units end if call HstNmlInfoAdd( gthstnml = gthstnml, name = varname, file = file, precision = xtype, interval_value = interval, interval_unit = interval_unit_work, origin_value = origin, origin_unit = origin_unit_work, terminus_value = terminus, terminus_unit = terminus_unit_work, slice_start = slice_start, slice_end = slice_end, slice_stride = slice_stride, time_average = time_average, space_average = space_average, newfile_intvalue = newfile_interval, newfile_intunit = newfile_intunit_work ) ! (in) optional if ( .not. define_mode ) call HstNmlInfoEndDefine( gthstnml ) ! (inout) end if end if ! 平均化に伴う次元の縮退を反映した変数情報の作り直し ! Remake information of variables that reflects reduction of dimensions ! correspond to average ! call HstNmlInfoInquire( gthstnml = gthstnml, name = varname, precision = precision, time_average = time_average_work, space_average = space_average_work, slice_start = slice_start_work, slice_end = slice_end_work, slice_stride = slice_stride_work, err = varname_not_found ) ! (out) optional if ( varname_not_found ) then call HstNmlInfoInquire( gthstnml = gthstnml, name = '', precision = precision, time_average = time_average_work, space_average = space_average_work, slice_start = slice_start_work, slice_end = slice_end_work, slice_stride = slice_stride_work ) ! (out) end if if ( .not. associated( space_avr_vars(numvars + 1) % avr ) ) allocate( space_avr_vars(numvars + 1) % avr( size( dims_work ) - 1 ) ) space_avr_vars(numvars + 1) % avr = .false. do i = 1, size( dims_work ) - 1 do j = 1, numdims - 1 call HistoryAxisInquire( axis = gthst_axes(j), name = name ) ! (out) if ( trim(dims_work(i)) == trim(name) ) then space_avr_vars(numvars + 1) % avr( i ) = space_average_work( j ) exit end if end do end do allocate( dims_noavr ( size(dims_work) - count(space_avr_vars(numvars + 1) % avr) ) ) if ( count(space_avr_vars(numvars + 1) % avr) < 1 ) then dims_noavr = dims_work longname_avrmsg = '' else allocate( dims_avr( count(space_avr_vars(numvars + 1) % avr) ) ) cnt = 1 cnt2 = 1 do i = 1, size( dims_work ) - 1 if ( .not. space_avr_vars(numvars + 1) % avr(i) ) then dims_noavr( cnt ) = dims_work( i ) cnt = cnt + 1 else dims_avr( cnt2 ) = dims_work( i ) cnt2 = cnt2 + 1 end if end do dims_noavr( cnt ) = dims_work( size ( dims_work ) ) longname_avrmsg = ' averaged in ' // trim( JoinChar( dims_avr, ',' ) ) // '-direction' deallocate( dims_avr ) end if ! HistoryPut の際のデータの切り出し情報作成 ! Create information of slices of data for "HistoryPut" ! if ( .not. associated( slice_vars(numvars + 1) % st ) ) allocate( slice_vars(numvars + 1) % st( NF_MAX_DIMS ) ) if ( .not. associated( slice_vars(numvars + 1) % ed ) ) allocate( slice_vars(numvars + 1) % ed( NF_MAX_DIMS ) ) if ( .not. associated( slice_vars(numvars + 1) % sd ) ) allocate( slice_vars(numvars + 1) % sd( NF_MAX_DIMS ) ) slice_vars(numvars + 1) % st = 1 slice_vars(numvars + 1) % ed = 1 slice_vars(numvars + 1) % sd = 1 if ( size(dims_work) > 1 ) then slice_subscript_search: do i = 1, size( dims_work ) - 1 do j = 1, numdims - 1 call HistoryAxisInquire( axis = gthst_axes(j), name = name, size = dim_size ) ! (out) if ( slice_end_work(j) < 1 ) slice_end_work(j) = dim_size if ( trim(dims_work(i)) == trim(name) ) then slice_vars(numvars + 1) % st( i ) = slice_start_work( j ) slice_vars(numvars + 1) % ed( i ) = slice_end_work( j ) slice_vars(numvars + 1) % sd( i ) = slice_stride_work( j ) cycle slice_subscript_search end if end do end do slice_subscript_search end if ! HistoryPut の際の座標重み情報作成 ! Create information of axes weight for "HistoryPut" ! if ( .not. associated( weight_vars(numvars + 1) % wgt1 ) ) allocate( weight_vars(numvars + 1) % wgt1( 1 ) ) weight_vars(numvars + 1) % wgt1 = 1.0_DP if ( size(dims_work) >= 1 ) then do j = 1, numdims - 1 call HistoryAxisInquire( axis = gthst_axes(j), name = name, size = dim_size ) ! (out) if ( trim(dims_work(1)) == trim(name) ) then deallocate( weight_vars(numvars + 1) % wgt1 ) allocate( weight_vars(numvars + 1) % wgt1( dim_size ) ) weight_vars(numvars + 1) % wgt1 = 1.0_DP do k = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(k), name = name ) ! (out) if ( trim(dims_work(1)) // wgtsuf == trim(name) ) then weight_vars(numvars + 1) % wgt1 = data_weights( k ) % a_axis exit end if end do exit end if end do end if if ( .not. associated( weight_vars(numvars + 1) % wgt2 ) ) allocate( weight_vars(numvars + 1) % wgt2( 1 ) ) weight_vars(numvars + 1) % wgt2 = 1.0_DP if ( size(dims_work) >= 2 ) then do j = 1, numdims - 1 call HistoryAxisInquire( axis = gthst_axes(j), name = name, size = dim_size ) ! (out) if ( trim(dims_work(2)) == trim(name) ) then deallocate( weight_vars(numvars + 1) % wgt2 ) allocate( weight_vars(numvars + 1) % wgt2( dim_size ) ) weight_vars(numvars + 1) % wgt2 = 1.0_DP do k = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(k), name = name ) ! (out) if ( trim(dims_work(2)) // wgtsuf == trim(name) ) then weight_vars(numvars + 1) % wgt2 = data_weights( k ) % a_axis exit end if end do exit end if end do end if if ( .not. associated( weight_vars(numvars + 1) % wgt3 ) ) allocate( weight_vars(numvars + 1) % wgt3( 1 ) ) weight_vars(numvars + 1) % wgt3 = 1.0_DP if ( size(dims_work) >= 3 ) then do j = 1, numdims - 1 call HistoryAxisInquire( axis = gthst_axes(j), name = name, size = dim_size ) ! (out) if ( trim(dims_work(3)) == trim(name) ) then deallocate( weight_vars(numvars + 1) % wgt3 ) allocate( weight_vars(numvars + 1) % wgt3( dim_size ) ) weight_vars(numvars + 1) % wgt3 = 1.0_DP do k = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(k), name = name ) ! (out) if ( trim(dims_work(3)) // wgtsuf == trim(name) ) then weight_vars(numvars + 1) % wgt3 = data_weights( k ) % a_axis exit end if end do exit end if end do end if if ( .not. associated( weight_vars(numvars + 1) % wgt4 ) ) allocate( weight_vars(numvars + 1) % wgt4( 1 ) ) weight_vars(numvars + 1) % wgt4 = 1.0_DP if ( size(dims_work) >= 4 ) then do j = 1, numdims - 1 call HistoryAxisInquire( axis = gthst_axes(j), name = name, size = dim_size ) ! (out) if ( trim(dims_work(4)) == trim(name) ) then deallocate( weight_vars(numvars + 1) % wgt4 ) allocate( weight_vars(numvars + 1) % wgt4( dim_size ) ) weight_vars(numvars + 1) % wgt4 = 1.0_DP do k = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(k), name = name ) ! (out) if ( trim(dims_work(4)) // wgtsuf == trim(name) ) then weight_vars(numvars + 1) % wgt4 = data_weights( k ) % a_axis exit end if end do exit end if end do end if if ( .not. associated( weight_vars(numvars + 1) % wgt5 ) ) allocate( weight_vars(numvars + 1) % wgt5( 1 ) ) weight_vars(numvars + 1) % wgt5 = 1.0_DP if ( size(dims_work) >= 5 ) then do j = 1, numdims - 1 call HistoryAxisInquire( axis = gthst_axes(j), name = name, size = dim_size ) ! (out) if ( trim(dims_work(5)) == trim(name) ) then deallocate( weight_vars(numvars + 1) % wgt5 ) allocate( weight_vars(numvars + 1) % wgt5( dim_size ) ) weight_vars(numvars + 1) % wgt5 = 1.0_DP do k = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(k), name = name ) ! (out) if ( trim(dims_work(5)) // wgtsuf == trim(name) ) then weight_vars(numvars + 1) % wgt5 = data_weights( k ) % a_axis exit end if end do exit end if end do end if if ( .not. associated( weight_vars(numvars + 1) % wgt6 ) ) allocate( weight_vars(numvars + 1) % wgt6( 1 ) ) weight_vars(numvars + 1) % wgt6 = 1.0_DP if ( size(dims_work) >= 6 ) then do j = 1, numdims - 1 call HistoryAxisInquire( axis = gthst_axes(j), name = name, size = dim_size ) ! (out) if ( trim(dims_work(6)) == trim(name) ) then deallocate( weight_vars(numvars + 1) % wgt6 ) allocate( weight_vars(numvars + 1) % wgt6( dim_size ) ) weight_vars(numvars + 1) % wgt6 = 1.0_DP do k = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(k), name = name ) ! (out) if ( trim(dims_work(6)) // wgtsuf == trim(name) ) then weight_vars(numvars + 1) % wgt6 = data_weights( k ) % a_axis exit end if end do exit end if end do end if if ( .not. associated( weight_vars(numvars + 1) % wgt7 ) ) allocate( weight_vars(numvars + 1) % wgt7( 1 ) ) weight_vars(numvars + 1) % wgt7 = 1.0_DP if ( size(dims_work) >= 7 ) then do j = 1, numdims - 1 call HistoryAxisInquire( axis = gthst_axes(j), name = name, size = dim_size ) ! (out) if ( trim(dims_work(7)) == trim(name) ) then deallocate( weight_vars(numvars + 1) % wgt7 ) allocate( weight_vars(numvars + 1) % wgt7( dim_size ) ) weight_vars(numvars + 1) % wgt7 = 1.0_DP do k = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(k), name = name ) ! (out) if ( trim(dims_work(7)) // wgtsuf == trim(name) ) then weight_vars(numvars + 1) % wgt7 = data_weights( k ) % a_axis exit end if end do exit end if end do end if ! 変数名の有効性を設定 ! Set validation of the variable name ! call HstNmlInfoSetValidName( gthstnml = gthstnml, name = varname ) ! (in) ! 変数情報の登録 ! Register information of variable ! call HistoryVarinfoCreate( varinfo = gthst_vars(numvars + 1), name = varname, dims = dims_noavr, longname = trim(longname) // longname_avrmsg , units = units, xtype = precision, time_average = time_average_work ) ! (in) optional varname_vars(numvars + 1) = varname tavr_vars(numvars + 1) = time_average_work deallocate( dims_noavr ) deallocate( dims_work ) ! 出力の有効かどうかを確認する ! Confirm whether the output is effective ! output_valid_vars(numvars + 1) = HstNmlInfoOutputValid( gthstnml, varname ) ! 出力のタイミングを測るための情報の取得 ! Get information for measurement of output timing ! if ( output_valid_vars(numvars + 1) ) then ! NAMELIST から読み込まれた情報の取得 ! Get information loaded from NAMELIST ! call HstNmlInfoInquire( gthstnml = gthstnml, name = varname, interval_value = interval_value, interval_unit = interval_unit_work, origin_value = origin_value, origin_unit = origin_unit_work, terminus_value = terminus_value, terminus_unit = terminus_unit_work, newfile_intvalue = newfile_intvalue, newfile_intunit = newfile_intunit_work ) ! (out) ! 出力間隔ステップ数を算出する. ! Calculate number of step of interval of output ! call DCDiffTimeCreate( interval_time_vars(numvars + 1), interval_value, interval_unit_work ) ! (in) ! ファイルを作成するステップ数を算出する. ! Calculate number of step of interval of output ! call DCDiffTimeCreate( origin_time_vars(numvars + 1), origin_value, origin_unit_work ) ! (in) ! ファイルをクローズするステップ数を算出する. ! Calculate number of step of closure of file ! call DCDiffTimeCreate( terminus_time_vars(numvars + 1), terminus_value, terminus_unit_work ) ! (in) ! ファイルを新規に作り直すステップ数の算出 ! Calculate number of step of remake of file call DCDiffTimeCreate( newfile_inttime_vars(numvars + 1), newfile_intvalue, newfile_intunit_work ) ! (in) end if ! GT_HISTORY 変数の取得 ! Get "GT_HISTORY" variable ! if ( output_valid_vars(numvars + 1) ) then define_mode = HstNmlInfoDefineMode( gthstnml ) if ( define_mode ) call HstNmlInfoEndDefine( gthstnml ) ! (inout) call HstNmlInfoAssocGtHist( gthstnml = gthstnml, name = varname, history = gthst_history_vars(numvars + 1) % gthist ) ! (out) if ( define_mode ) call HstNmlInfoReDefine( gthstnml ) ! (inout) end if ! 登録変数の数を更新 ! Update number of registered variables ! numvars = numvars + 1 999 continue call StoreError(stat, subname, cause_c = cause_c, cause_i = cause_i) call EndSub(subname, 'stat=%d', i = (/stat/) ) end subroutine HistoryAutoAddVariable1
Subroutine : | |||
varname : | character(*), intent(in)
| ||
dims(:) : | character(*), intent(in)
| ||
longname : | character(*), intent(in)
| ||
units : | character(*), intent(in)
| ||
xtype : | character(*), intent(in), optional
| ||
time_units : | character(*), intent(in), optional
| ||
time_average : | logical, intent(in), optional
| ||
file : | character(*), intent(in), optional
| ||
origin : | type(DC_DIFFTIME), intent(in)
| ||
terminus : | type(DC_DIFFTIME), intent(in)
| ||
interval : | type(DC_DIFFTIME), intent(in), optional
| ||
slice_start(:) : | integer, intent(in), optional
| ||
slice_end(:) : | integer, intent(in), optional
| ||
slice_stride(:) : | integer, intent(in), optional
| ||
space_average(:) : | logical, intent(in), optional
| ||
newfile_interval : | integer, intent(in), optional
|
データ出力するための変数登録を行います.
HistoryAutoAllVarFix を呼ぶ前にこのサブルーチンを使用してください.
Register variables for history data output
Use this subroutine before "HistoryAutoAllVarFix" is called.
subroutine HistoryAutoAddVariable2( varname, dims, longname, units, xtype, time_units, time_average, file, origin, terminus, interval, slice_start, slice_end, slice_stride, space_average, newfile_interval ) ! ! データ出力するための変数登録を行います. ! ! HistoryAutoAllVarFix を呼ぶ前にこのサブルーチンを使用してください. ! ! Register variables for history data output ! ! Use this subroutine before "HistoryAutoAllVarFix" is called. ! ! モジュール引用 ; USE statements ! use dc_trace, only: BeginSub, EndSub, DbgMessage use dc_error, only: StoreError, DC_NOERR use dc_date, only: EvalbyUnit ! 宣言文 ; Declaration statements ! implicit none character(*), intent(in):: varname ! 変数名. Variable name character(*), intent(in):: dims(:) ! 変数が依存する次元の名前. ! 時間の次元は配列の最後に指定すること. ! ! Names of dependency dimensions of a variable. ! Dimension of time must be specified ! to last of an array. character(*), intent(in):: longname ! 変数の記述的名称. ! ! Descriptive name of a variable character(*), intent(in):: units ! 変数の単位. ! ! Units of a variable type(DC_DIFFTIME), intent(in):: origin ! 出力開始時刻. ! ! Start time of output. ! type(DC_DIFFTIME), intent(in):: terminus ! 出力終了時刻. ! ! End time of output. ! type(DC_DIFFTIME), intent(in), optional:: interval ! 出力時間間隔. ! ! 省略した場合, ! 自動的に 1.0 [sec] が設定されます. ! ! Interval of output time. ! ! If this argument is omitted, ! a value of 1.0 [sec] is specified ! automatically. ! character(*), intent(in), optional:: xtype ! ! 変数のデータ型 ! ! デフォルトは float (単精度実数型) であ ! る. 有効なのは, double (倍精度実数型), ! int (整数型) である. 指定しない 場合や, ! 無効な型を指定した場合には, float (単 ! 精度実数型) となる. ! ! Data types of dimensions specified ! with "dims". ! ! Default value is "float" (single precision). ! Other valid values are ! "double" (double precision), ! "int" (integer). ! If no value or invalid value is specified, ! "float" is applied. ! character(*), intent(in), optional:: time_units ! 時刻次元の単位. ! Units of time dimension. logical, intent(in), optional:: time_average ! ! 出力データを時間平均する場合には ! .true. を与えます. デフォルトは ! .false. です. ! ! If output data is averaged, specify ! ".true.". Default is ".false.". ! character(*), intent(in), optional:: file ! 出力ファイル名. ! Output file name. integer, intent(in), optional:: slice_start(:) ! 空間方向の開始点. ! ! 省略した場合, 座標データの開始点が設定されます. ! ! Start points of spaces. ! ! If this argument is omitted, ! start points of dimensions are set. ! integer, intent(in), optional:: slice_end(:) ! 空間方向の終了点. ! ! 省略した場合, 座標データの終了点が設定されます. ! ! End points of spaces. ! ! If this argument is omitted, ! End points of dimensions are set. ! integer, intent(in), optional:: slice_stride(:) ! 空間方向の刻み幅. ! ! 省略した場合, 1 が設定されます. ! ! Strides of spaces ! ! If this argument is omitted, ! 1 is set. ! logical, intent(in), optional:: space_average(:) ! 平均化のフラグ. ! ! .true. が指定される座標に対して平均化を ! 行います. ! 省略した場合, .false. が設定されます. ! ! Flag of average. ! ! Axes specified .true. are averaged. ! If this argument is omitted, ! .false. is set. ! integer, intent(in), optional:: newfile_interval ! ファイル分割時間間隔. ! ! 省略した場合, ! 時間方向へのファイル分割を行いません. ! ! Interval of time of separation of a file. ! ! If this argument is omitted, ! a files is not separated in time direction. ! ! 作業変数 ! Work variables ! real:: interval_value ! データの出力間隔の数値. ! Numerical value for interval of history data output real:: origin_value ! データの出力開始時刻の数値. ! Numerical value for start time of history data output real:: terminus_value ! 出力終了時刻の数値. ! Numerical value for end time of output. integer:: stat character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddVariable2" continue call BeginSub(subname, 'varname=%c', c1 = trim(varname), version = version) stat = DC_NOERR cause_c = "" if ( present(time_units) ) then origin_value = EvalByUnit( origin, time_units ) else origin_value = EvalByUnit( origin, time_unit_bycreate ) end if if ( present(time_units) ) then terminus_value = EvalByUnit( terminus, time_units ) else terminus_value = EvalByUnit( terminus, time_unit_bycreate ) end if if ( present(interval) ) then if ( present(time_units) ) then interval_value = EvalByUnit( interval, time_units ) else interval_value = EvalByUnit( interval, time_unit_bycreate ) end if else interval_value = 1.0 end if call DbgMessage('origin=%r, terminus=%r, interval=%r', r = (/ origin_value, terminus_value, interval_value /) ) call HistoryAutoAddVariable1( varname, dims, longname, units, xtype, time_units, time_average, file, origin_value, terminus_value, interval_value, slice_start, slice_end, slice_stride, space_average, newfile_interval ) ! (in) optional 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname, 'stat=%d', i = (/stat/) ) end subroutine HistoryAutoAddVariable2
Subroutine : | |||
dim : | character(*), intent(in)
| ||
weight(:) : | real(DP), intent(in)
| ||
units : | character(*), intent(in), optional
| ||
xtype : | character(*), intent(in), optional
|
座標の重みデータを設定します.
Set weights of axes.
subroutine HistoryAutoAddWeightDouble( dim, weight, units, xtype ) ! ! 座標の重みデータを設定します. ! ! Set weights of axes. ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_ENOAXISNAME, DC_ENOTINIT use gtool_history, only: HistoryAxisInquire, HistoryAxisAddAttr, HistoryVarinfoCreate implicit none character(*), intent(in):: dim ! 座標重みを設定する座標の名称. ! ! ただし, ここで指定するもの ! は, HistoryAutoCreate の *dims* ! 既に指定されていなければなりません. ! ! Name of axis to which "weight" are set. ! ! Note that this value must be set ! as "dims" of "HistoryAutoCreate". ! real(DP), intent(in):: weight(:) ! 座標重みデータ. ! ! データ型は整数, 単精度実数型, ! 倍精度実数型のどれでもかまいません. ! ただし, ファイルへ出力される際には, ! xtype もしくは座標データの型へと ! 変換されます. ! ! Weight of axis. ! ! 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" or ! type of the axis. ! character(*), intent(in), optional:: units ! 座標重みの単位. ! 省略した場合には, 座標の単位が ! 使用されます. ! ! Units of axis weight. ! If this argument is omitted, ! unit of the dimension is used. ! character(*), intent(in), optional:: xtype ! 座標重みのデータ型. ! 省略した場合には, 座標のデータ型が ! 使用されます. ! ! Data type of weight of the dimension. ! If this argument is omitted, ! data type of the dimension is used. ! character(STRING):: name, longname character(TOKEN):: dim_units, dim_xtype integer:: dim_size integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddWeightDouble" continue call BeginSub(subname, 'dim=<%c>', c1=trim(dim) ) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name, size = dim_size, longname = longname, units = dim_units, xtype = dim_xtype ) ! (out) if ( trim(dim) == trim(name) ) then if ( dim_size /= size(weight) ) then stat = GT_EARGSIZEMISMATCH cause_c = 'weight' end if if ( present(units) ) dim_units = units if ( present(xtype) ) dim_xtype = xtype call HistoryVarinfoCreate( varinfo = gthst_weights(numwgts + 1), name = trim(dim) // wgtsuf, dims = (/ dim /), longname = 'weight for integration or average in ' // trim(longname), units = dim_units, xtype = dim_xtype ) ! (in) call HistoryAxisAddAttr( axis = gthst_axes(i), attrname = 'gt_calc_weight', value = trim(dim) // wgtsuf ) ! (in) allocate( data_weights(numwgts + 1) % a_axis( dim_size ) ) data_weights(numwgts + 1) % a_axis = weight numwgts = numwgts + 1 goto 999 end if end do stat = HST_ENOAXISNAME cause_c = dim 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddWeightDouble
Subroutine : | |||
dim : | character(*), intent(in)
| ||
weight(:) : | integer, intent(in)
| ||
units : | character(*), intent(in), optional
| ||
xtype : | character(*), intent(in), optional
|
座標の重みデータを設定します.
Set weights of axes.
subroutine HistoryAutoAddWeightInt( dim, weight, units, xtype ) ! ! 座標の重みデータを設定します. ! ! Set weights of axes. ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_ENOAXISNAME, DC_ENOTINIT use gtool_history, only: HistoryAxisInquire, HistoryAxisAddAttr, HistoryVarinfoCreate implicit none character(*), intent(in):: dim ! 座標重みを設定する座標の名称. ! ! ただし, ここで指定するもの ! は, HistoryAutoCreate の *dims* ! 既に指定されていなければなりません. ! ! Name of axis to which "weight" are set. ! ! Note that this value must be set ! as "dims" of "HistoryAutoCreate". ! integer, intent(in):: weight(:) ! 座標重みデータ. ! ! データ型は整数, 単精度実数型, ! 倍精度実数型のどれでもかまいません. ! ただし, ファイルへ出力される際には, ! xtype もしくは座標データの型へと ! 変換されます. ! ! Weight of axis. ! ! 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" or ! type of the axis. ! character(*), intent(in), optional:: units ! 座標重みの単位. ! 省略した場合には, 座標の単位が ! 使用されます. ! ! Units of axis weight. ! If this argument is omitted, ! unit of the dimension is used. ! character(*), intent(in), optional:: xtype ! 座標重みのデータ型. ! 省略した場合には, 座標のデータ型が ! 使用されます. ! ! Data type of weight of the dimension. ! If this argument is omitted, ! data type of the dimension is used. ! character(STRING):: name, longname character(TOKEN):: dim_units, dim_xtype integer:: dim_size integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddWeightInt" continue call BeginSub(subname, 'dim=<%c>', c1=trim(dim) ) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name, size = dim_size, longname = longname, units = dim_units, xtype = dim_xtype ) ! (out) if ( trim(dim) == trim(name) ) then if ( dim_size /= size(weight) ) then stat = GT_EARGSIZEMISMATCH cause_c = 'weight' end if if ( present(units) ) dim_units = units if ( present(xtype) ) dim_xtype = xtype call HistoryVarinfoCreate( varinfo = gthst_weights(numwgts + 1), name = trim(dim) // wgtsuf, dims = (/ dim /), longname = 'weight for integration or average in ' // trim(longname), units = dim_units, xtype = dim_xtype ) ! (in) call HistoryAxisAddAttr( axis = gthst_axes(i), attrname = 'gt_calc_weight', value = trim(dim) // wgtsuf ) ! (in) allocate( data_weights(numwgts + 1) % a_axis( dim_size ) ) data_weights(numwgts + 1) % a_axis = weight numwgts = numwgts + 1 goto 999 end if end do stat = HST_ENOAXISNAME cause_c = dim 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddWeightInt
Subroutine : | |||
dim : | character(*), intent(in)
| ||
weight(:) : | real, intent(in)
| ||
units : | character(*), intent(in), optional
| ||
xtype : | character(*), intent(in), optional
|
座標の重みデータを設定します.
Set weights of axes.
subroutine HistoryAutoAddWeightReal( dim, weight, units, xtype ) ! ! 座標の重みデータを設定します. ! ! Set weights of axes. ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_ENOAXISNAME, DC_ENOTINIT use gtool_history, only: HistoryAxisInquire, HistoryAxisAddAttr, HistoryVarinfoCreate implicit none character(*), intent(in):: dim ! 座標重みを設定する座標の名称. ! ! ただし, ここで指定するもの ! は, HistoryAutoCreate の *dims* ! 既に指定されていなければなりません. ! ! Name of axis to which "weight" are set. ! ! Note that this value must be set ! as "dims" of "HistoryAutoCreate". ! real, intent(in):: weight(:) ! 座標重みデータ. ! ! データ型は整数, 単精度実数型, ! 倍精度実数型のどれでもかまいません. ! ただし, ファイルへ出力される際には, ! xtype もしくは座標データの型へと ! 変換されます. ! ! Weight of axis. ! ! 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" or ! type of the axis. ! character(*), intent(in), optional:: units ! 座標重みの単位. ! 省略した場合には, 座標の単位が ! 使用されます. ! ! Units of axis weight. ! If this argument is omitted, ! unit of the dimension is used. ! character(*), intent(in), optional:: xtype ! 座標重みのデータ型. ! 省略した場合には, 座標のデータ型が ! 使用されます. ! ! Data type of weight of the dimension. ! If this argument is omitted, ! data type of the dimension is used. ! character(STRING):: name, longname character(TOKEN):: dim_units, dim_xtype integer:: dim_size integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoAddWeightReal" continue call BeginSub(subname, 'dim=<%c>', c1=trim(dim) ) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name, size = dim_size, longname = longname, units = dim_units, xtype = dim_xtype ) ! (out) if ( trim(dim) == trim(name) ) then if ( dim_size /= size(weight) ) then stat = GT_EARGSIZEMISMATCH cause_c = 'weight' end if if ( present(units) ) dim_units = units if ( present(xtype) ) dim_xtype = xtype call HistoryVarinfoCreate( varinfo = gthst_weights(numwgts + 1), name = trim(dim) // wgtsuf, dims = (/ dim /), longname = 'weight for integration or average in ' // trim(longname), units = dim_units, xtype = dim_xtype ) ! (in) call HistoryAxisAddAttr( axis = gthst_axes(i), attrname = 'gt_calc_weight', value = trim(dim) // wgtsuf ) ! (in) allocate( data_weights(numwgts + 1) % a_axis( dim_size ) ) data_weights(numwgts + 1) % a_axis = weight numwgts = numwgts + 1 goto 999 end if end do stat = HST_ENOAXISNAME cause_c = dim 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoAddWeightReal
Subroutine : |
HistoryAutoCreate で始まったデータ出力の終了処理を行います. プログラムを終了する前に必ずこのサブルーチンを呼んでください.
Terminates data output with "HistoryAutoCreate". Call this subroutine certainly before a progrem is finished.
subroutine HistoryAutoClose1 ! ! HistoryAutoCreate で始まったデータ出力の終了処理を行います. ! プログラムを終了する前に必ずこのサブルーチンを呼んでください. ! ! Terminates data output with "HistoryAutoCreate". ! Call this subroutine certainly before a progrem is finished. ! use dc_trace, only: BeginSub, EndSub use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT use dc_date, only: DCDiffTimeCreate use gtool_history_nmlinfo, only: HstNmlInfoClose, HstNmlInfoGetNames, HstNmlInfoAssocGtHist, HstNmlInfoPutLine use gtool_history, only: GT_HISTORY, HistoryClose, HistoryInitialized, HistoryAxisClear, HistoryVarinfoClear ! ヒストリファイルへのデータ出力設定 ! Configure the settings for history data output ! character(STRING):: name = '' ! 変数名. Variable identifier character(TOKEN), pointer:: varnames_array(:) =>null() ! 変数名リスト配列. ! List of variables (array) integer:: i, vnmax type(GT_HISTORY), pointer:: gthist =>null() ! gtool_history モジュール用構造体. ! Derived type for "gtool_history" module ! 作業変数 ! Work variables ! integer:: stat character(STRING):: cause_c character(*), parameter:: subname = 'HistoryAutoClose1' continue call BeginSub( subname ) stat = DC_NOERR cause_c = '' ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if ! ヒストリファイルへのデータ出力の終了処理 ! Terminate the settings for history data output ! call HstNmlInfoGetNames( gthstnml, varnames_array ) ! (out) vnmax = size( varnames_array ) do i = 1, vnmax name = varnames_array(i) if ( trim( name ) == '' ) exit nullify( gthist ) call HstNmlInfoAssocGtHist( gthstnml = gthstnml, name = name, history = gthist ) ! (out) if ( HistoryInitialized( gthist ) ) then call HistoryClose( history = gthist ) ! (inout) end if end do ! ヒストリファイルへのデータ出力設定の割付解除 ! Deallocate the settings for history data output ! call HstNmlInfoClose( gthstnml ) ! (inout) ! 座標軸情報のクリア ! Create axes information ! do i = 1, numdims call HistoryAxisClear( gthst_axes(i) ) deallocate( data_axes(i) % a_axis ) end do numdims = 0 ! 座標重み情報のクリア ! Create axes weights information ! do i = 1, numwgts call HistoryVarinfoClear( gthst_weights(i) ) deallocate( data_weights(i) % a_axis ) end do numwgts = 0 ! 変数情報のクリア ! Create variables information ! do i = 1, numvars call HistoryVarinfoClear( gthst_vars(i) ) if ( associated( slice_vars(i) % st ) ) deallocate( slice_vars(i) % st ) if ( associated( slice_vars(i) % ed ) ) deallocate( slice_vars(i) % ed ) if ( associated( slice_vars(i) % sd ) ) deallocate( slice_vars(i) % sd ) if ( associated( weight_vars(i) % wgt1 ) ) deallocate( weight_vars(i) % wgt1 ) if ( associated( weight_vars(i) % wgt2 ) ) deallocate( weight_vars(i) % wgt2 ) if ( associated( weight_vars(i) % wgt3 ) ) deallocate( weight_vars(i) % wgt3 ) if ( associated( weight_vars(i) % wgt4 ) ) deallocate( weight_vars(i) % wgt4 ) if ( associated( weight_vars(i) % wgt5 ) ) deallocate( weight_vars(i) % wgt5 ) if ( associated( weight_vars(i) % wgt6 ) ) deallocate( weight_vars(i) % wgt6 ) if ( associated( weight_vars(i) % wgt7 ) ) deallocate( weight_vars(i) % wgt7 ) if ( associated( space_avr_vars(i) % avr ) ) deallocate( space_avr_vars(i) % avr ) varname_vars(i) = '' output_valid_vars(i) = .false. create_timing_vars(i,:) = .false. close_timing_vars(i,:) = .false. renew_timing_vars(i,:) = .false. output_timing_vars(i,:) = .false. output_timing_avr_vars(i,:) = .false. tavr_vars(i) = .false. call DCDiffTimeCreate( interval_time_vars(i), sec = 0.0_DP ) ! (in) call DCDiffTimeCreate( prev_outtime_vars(i), sec = 0.0_DP ) ! (in) call DCDiffTimeCreate( origin_time_vars(i), sec = 0.0_DP ) ! (in) call DCDiffTimeCreate( terminus_time_vars(i), sec = -1.0_DP ) ! (in) histaddvar_vars(i) = .false. call DCDiffTimeCreate( newfile_inttime_vars(i), sec = -1.0_DP ) ! (in) call DCDiffTimeCreate( newfile_createtime_vars(i), sec = 0.0_DP ) ! (in) end do numvars = 0 ! 時間ステップに関する情報のクリア ! Clear information about time steps ! checked_tstepnum = 0 checked_tstep_varnum = 0 saved_tstep = 1 ! MPI に関する情報のクリア ! Clear information about MPI ! save_mpi_split = .false. save_mpi_gather = .false. ! 終了処理, 例外処理 ! Termination and Exception handling ! initialized = .false. flag_allvarfixed = .false. all_output_save = .false. time_unit_bycreate = '' time_unit_suffix = '' 999 continue call StoreError( stat, subname, cause_c = cause_c ) call EndSub( subname ) end subroutine HistoryAutoClose1
Subroutine : | |||
title : | character(*), intent(in)
| ||
source : | character(*), intent(in)
| ||
institution : | character(*), intent(in)
| ||
dims(:) : | character(*), intent(in)
| ||
dimsizes(:) : | integer, intent(in)
| ||
longnames(:) : | character(*), intent(in)
| ||
units(:) : | character(*), intent(in)
| ||
origin : | type(DC_DIFFTIME), intent(in)
| ||
terminus : | type(DC_DIFFTIME), intent(in)
| ||
xtypes(:) : | character(*), intent(in), optional
| ||
conventions : | character(*), intent(in), optional
| ||
gt_version : | character(*), intent(in), optional
| ||
all_output : | logical, intent(in), optional
| ||
file_prefix : | character(*), intent(in), optional
| ||
namelist_filename : | character(*), intent(in), optional
| ||
interval : | type(DC_DIFFTIME), intent(in), optional
| ||
slice_start(:) : | integer, intent(in), optional
| ||
slice_end(:) : | integer, intent(in), optional
| ||
slice_stride(:) : | integer, intent(in), optional
| ||
space_average(:) : | logical, intent(in), optional
| ||
time_average : | logical, intent(in), optional
| ||
newfile_interval : | integer, intent(in), optional
| ||
rank : | character(*), intent(in), optional
| ||
origin_date : | type(DC_DATETIME), intent(in), optional
| ||
origin_date_invalid : | logical, intent(in), optional
| ||
flag_mpi_gather : | logical, intent(in), optional
| ||
flag_mpi_split : | logical, intent(in), optional
|
複数のデータ出力を行うための初期化を行います.
この HistoryAutoCreate には, モデル内で出力する 変数が依存する座標や座標重みなどを全てを設定してください.
all_output に .true. を与えた場合や, namelist_filename を与えない (空文字を与える) 場合には, HistoryAutoAddVariable で登録される全ての変数が出力されます. 一方で namelist_filename に NAMELIST ファイル名を与える場合には, その NAMELIST ファイルから出力のオンオフや, 出力ファイル名, 出力間隔などを変更可能です. 変更可能な項目に関しては NAMELIST#gtool_historyauto_nml を参照して下さい.
interval, origin, terminus, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval などの設定はデフォルト値として使用されます. これらの設定値は HistoryAutoAddVariable および NAMELIST#gtool_historyauto_nml で上書きされます. (優先度が高いのは NAMELIST#gtool_historyauto_nml , HistoryAutoAddVariable の引数, HistoryAutoCreate の引数 の順です).
Initialization for multiple history data output
Set all axes and their weights depended by variables output from numerical models to this "HistoryAutoCreate".
All variables registered by "HistoryAutoAddVariable" are output if .true. is given to "all_output" or "namelist_filename" is not given (or blanks are given) On the other hand, if a filename of NAMELIST file is given to "namelist_filename", on/off of output, output filename and output interval, etc. can be changed from the NAMELIST file. For available items, see "NAMELIST#gtool_historyauto_nml".
Settings about "interval", "origin", "terminus", "slice_start", "slice_end", "slice_stride", "space_average", "time_average", "newfile_interval" etc. are used as default values. Their set values are overwritten by "HistoryAutoAddVariable" or "NAMELIST#gtool_historyauto_nml". ("NAMELIST#gtool_historyauto_nml" is high priority, arguments of "HistoryAutoAddVariable" are medium, arguments of "HistoryAutoCreate" are low).
This procedure input/output NAMELIST#gtool_historyauto_nml .
subroutine HistoryAutoCreate1( title, source, institution, dims, dimsizes, longnames, units, origin, terminus, xtypes, conventions, gt_version, all_output, file_prefix, namelist_filename, interval, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval, rank, origin_date, origin_date_invalid, flag_mpi_gather, flag_mpi_split ) ! ! 複数のデータ出力を行うための初期化を行います. ! ! この HistoryAutoCreate には, モデル内で出力する ! 変数が依存する座標や座標重みなどを全てを設定してください. ! ! all_output に .true. を与えた場合や, ! namelist_filename を与えない (空文字を与える) 場合には, ! HistoryAutoAddVariable で登録される全ての変数が出力されます. ! 一方で namelist_filename に NAMELIST ファイル名を与える場合には, ! その NAMELIST ファイルから出力のオンオフや, ! 出力ファイル名, 出力間隔などを変更可能です. ! 変更可能な項目に関しては NAMELIST#gtool_historyauto_nml ! を参照して下さい. ! ! interval, origin, terminus, slice_start, slice_end, slice_stride, ! space_average, time_average, newfile_interval ! などの設定はデフォルト値として使用されます. ! これらの設定値は HistoryAutoAddVariable および ! NAMELIST#gtool_historyauto_nml で上書きされます. ! (優先度が高いのは NAMELIST#gtool_historyauto_nml , ! HistoryAutoAddVariable の引数, ! HistoryAutoCreate の引数 の順です). ! ! ! Initialization for multiple history data output ! ! Set all axes and their weights depended by variables ! output from numerical models to this "HistoryAutoCreate". ! ! All variables registered by "HistoryAutoAddVariable" ! are output if .true. is given to "all_output" or ! "namelist_filename" is not given (or blanks are given) ! On the other hand, if a filename of NAMELIST file is ! given to "namelist_filename", on/off of output, ! output filename and output interval, etc. can be changed ! from the NAMELIST file. ! For available items, see "NAMELIST#gtool_historyauto_nml". ! ! Settings about ! "interval", "origin", "terminus", "slice_start", "slice_end", "slice_stride", ! "space_average", "time_average", "newfile_interval" ! etc. are used as default values. ! Their set values are overwritten by ! "HistoryAutoAddVariable" or ! "NAMELIST#gtool_historyauto_nml". ! ("NAMELIST#gtool_historyauto_nml" is high priority, ! arguments of "HistoryAutoAddVariable" are medium, ! arguments of "HistoryAutoCreate" are low). ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, DC_EALREADYINIT, GT_EARGSIZEMISMATCH, HST_ENOTIMEDIM, DC_ENEGATIVE use netcdf_f77, only: NF_EMAXDIMS use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar use dc_present, only: present_and_not_empty, present_and_true, present_select use dc_date, only: DCDiffTimeCreate, EvalbyUnit, toChar, toCharCal, Eval use dc_message, only: MessageNotify use dc_iounit, only: FileOpen use gtool_history, only: HistoryAxisCreate, HistoryAxisAddAttr use gtool_history_nmlinfo, only: HstNmlInfoCreate, HstNmlInfoAdd, HstNmlInfoEndDefine, HstNmlInfoPutLine, HstNmlInfoAllNameValid, HstNmlInfoInquire implicit none character(*), intent(in):: title ! データ全体の表題. ! Title of entire data character(*), intent(in):: source ! データを作成する際の手段. ! Source of data file character(*), intent(in):: institution ! ファイルを最終的に変更した組織/個人. ! Institution or person that changes files for the last time character(*), intent(in):: dims(:) ! 次元の名前. ! ! 配列の大きさに制限はありません. ! 個々の次元の文字数は dc_types#TOKEN まで. ! 配列内の文字数は ! 全て同じでなければなりません. ! 足りない文字分は空白で ! 補ってください. ! ! Names of dimensions. ! ! Length of array is unlimited. ! Limits of numbers of characters of each ! dimensions are "dc_types#TOKEN". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! integer, intent(in):: dimsizes (:) ! dims で指定したそれぞれの次元大きさ. ! ! 配列の大きさは dims の大きさと等しい ! 必要があります. '0' (数字のゼロ) を指定 ! するとその次元は 無制限次元 (unlimited ! dimension) となります. (gtool_history ! では時間の次元に対して無制限次元を ! 用いることを想定しています). ただし, ! 1 つの NetCDF ファイル (バージョン 3) ! は最大で 1 つの無制限次元しか持てないので, ! 2 ヶ所以上に '0' を指定しないでください. ! その場合, 正しく gtool4 データが出力されません. ! ! Lengths of dimensions specified with "dims". ! ! Length of this array must be same as ! length of "dim". If '0' (zero) is ! specified, the dimension is treated as ! unlimited dimension. ! (In "gtool_history", unlimited dimension is ! expected to be used as time). ! Note that one NetCDF file (version 3) ! can not have two or more unlimited ! dimensions, so that do not specify '0' ! to two or more places. In that case, ! gtoo4 data is not output currently ! character(*), intent(in):: longnames (:) ! dims で指定したそれぞれの次元の名前. ! ! 配列の大きさは dims の大きさ ! と等しい必要があります. 文字数 ! は dc_types#STRING まで. ! 配列内の文字数は ! 全て同じでなければなりません. ! 足りない文字分は空白で補います. ! ! Names of dimensions specified with "dims". ! ! Length of this array must be same as ! length of "dim". ! Limits of numbers of characters are ! "dc_types#STRING". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! character(*), intent(in):: units(:) ! dims で指定したそれぞれの次元の単位. ! ! 配列の大きさは dims の大きさ ! と等しい必要があります. 文字数 ! は dc_types#STRING まで. ! 配列内の文字数は ! 全て同じでなければなりません. ! 足りない文字分は空白で補います. ! ! Units of dimensions specified with "dims". ! ! Length of this array must be same as ! length of "dim". ! Limits of numbers of characters are ! "dc_types#STRING". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! type(DC_DIFFTIME), intent(in):: origin ! 出力開始時刻. ! ! Start time of output. ! type(DC_DIFFTIME), intent(in):: terminus ! 出力終了時刻. ! ! End time of output. ! character(*), intent(in), optional:: xtypes(:) ! dims で指定したそれぞれの ! 次元のデータ型. ! ! デフォルトは float (単精度実数型) ! です. 有効なのは, ! double (倍精度実数型), ! int (整数型) です. 指定しない ! 場合や, 無効な型を指定した場合には, ! float となります. なお, 配列の大きさ ! は *dims* の大きさと等しい必要が ! あります. 配列内の文字数は全て ! 同じでなければなりません. ! 足りない文字分は空白で補います. ! ! Data types of dimensions specified ! with "dims". ! ! Default value is "float" (single precision). ! Other valid values are ! "double" (double precision), ! "int" (integer). ! If no value or invalid value is specified, ! "float" is applied. ! Length of this array must be same as ! length of "dim". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! character(*), intent(in), optional:: conventions ! 出力するファイルの netCDF ! 規約 ! ! 省略した場合, ! もしくは空文字を与えた場合, ! 出力する netCDF 規約の ! Conventions 属性に値 ! gtool4_netCDF_Conventions ! が自動的に与えられます. ! ! NetCDF conventions of output file. ! ! If this argument is omitted or, ! blanks are given, ! gtool4_netCDF_Conventions is given to ! attribute "Conventions" of an output file ! automatically. ! character(*), intent(in), optional:: gt_version ! gtool4 netCDF 規約のバージョン ! ! 省略した場合, gt_version 属性に ! 規約の最新版のバージョンナンバー ! gtool4_netCDF_version ! が与えられます. ! (ただし, 引数 conventions に ! gtool4_netCDF_Conventions ! 以外が与えられる場合は ! gt_version 属性を作成しません). ! ! Version of gtool4 netCDF Conventions. ! ! If this argument is omitted, ! latest version number of gtool4 netCDF ! Conventions is given to attribute ! "gt_version" of an output file ! (However, gtool4_netCDF_Conventions is ! not given to an argument "conventions", ! attribute "gt_version" is not created). ! logical, intent(in), optional:: all_output ! 登録変数を全て出力するためのフラグ. ! ! .true. を指定すると, ! HistoryAutoAddVariable で登録された ! 変数が全て出力されるようになります. ! ! *namelist_filename* が指定される場合 ! には, デフォルトは .false. となります. ! この場合には, ! *namelist_filename* に指定された ! NAMELIST ファイルから読み込まれる ! NAMELIST#gtool_historyauto_nml ! で指定された変数のみ出力されます. ! ! *namelist_filename* が指定されない場合 ! には, .true. となります. ! ! ! Flag for output all registered variables. ! ! When .true. is specified, ! all variables registered by ! "HistoryAutoAddVariable" are output. ! ! If *namelist_filename* is specified, ! default value becomes .false. . ! In this case, ! only variables specified in ! "NAMELIST#gtool_historyauto_nml" ! loaded from a NAMELIST file ! *namelist_filename*. ! ! If *namelist_filename* is not specified, ! this value becomes .true. . ! character(*), intent(in), optional:: file_prefix ! データのファイル名の接頭詞. ! Prefixes of history data filenames character(*), intent(in), optional:: namelist_filename ! NAMELIST ファイルの名称. ! ! 省略した場合, もしくは空白文字を与えた場合, ! NAMELIST ファイルは読み込みません. ! ! Name of NAMELIST file. ! ! If this argument is omitted, ! or blanks are specified, ! no NAMELIST file is loaded. ! type(DC_DIFFTIME), intent(in), optional:: interval ! 出力時間間隔. ! ! 省略した場合, ! 自動的に 1.0 [sec] が設定されます. ! ! Interval of output time. ! ! If this argument is omitted, ! 1.0 [sec] is specified ! automatically. ! integer, intent(in), optional:: slice_start(:) ! 空間方向の開始点. ! ! 省略した場合, 座標データの開始点が設定されます. ! ! Start points of spaces. ! ! If this argument is omitted, ! start points of dimensions are set. ! integer, intent(in), optional:: slice_end(:) ! 空間方向の終了点. ! ! 省略した場合, もしくは負の値が与えら得た場合, ! 座標データの終了点が設定されます. ! ! End points of spaces. ! ! If this argument is omitted or ! negative value is specified, ! end points of dimensions are set. ! integer, intent(in), optional:: slice_stride(:) ! 空間方向の刻み幅. ! ! 省略した場合, 1 が設定されます. ! ! Strides of spaces ! ! If this argument is omitted, ! 1 is set. ! logical, intent(in), optional:: space_average(:) ! 平均化のフラグ. ! ! .true. が指定される座標に対して平均化を ! 行います. ! 省略した場合, .false. が設定されます. ! ! Flag of average. ! ! Axes specified .true. are averaged. ! If this argument is omitted, ! .false. is set. ! logical, intent(in), optional:: time_average ! 出力データの時間平均フラグ. ! デフォルトは .false. ! Flag for time average of output data ! Default value is .false. integer, intent(in), optional:: newfile_interval ! ファイル分割時間間隔. ! ! 省略した場合, ! 時間方向へのファイル分割を行いません. ! ! Interval of time of separation of a file. ! ! If this argument is omitted, ! a files is not separated in time direction. ! character(*), intent(in), optional:: rank ! ランクの名称. ! ! Name of a rank. ! type(DC_DATETIME), intent(in), optional:: origin_date ! 出力開始日時. ! ! Start date of output. ! logical, intent(in), optional:: origin_date_invalid ! .true. を与えると, origin_date を無効にします. ! ! If ".true." is given, "origin_date" is ignored. logical, intent(in), optional:: flag_mpi_gather ! MPI 使用時に, 各ノードで HistoryPut ! に与えたデータを一つのファイルに統合して出力 ! する場合には .true. を与えてください. ! デフォルトは .false. です. ! ! .true. を与えた場合, HistoryPutAxisMPI ! に全体の軸データを与えてください. ! ! When MPI is used, if ".true." is given, ! data given to "HistoryPut" on each node ! is integrated and output to one file. ! Default value is ".false.". ! ! If .true. is given, give data of axes in ! whole area to "HistoryPutAxisMPI" ! logical, intent(in), optional:: flag_mpi_split ! MPI 使用時に, 各ノードで HistoryPut ! に与えたデータをそれぞれ別名のファイルに ! 出力する場合には .true. を与えてください. ! デフォルトは .false. です. ! ! When MPI is used, if ".true." is given, ! data given to "HistoryPut" on each node ! is split into discrete files. ! Default value is ".false.". ! ! NAMELIST 変数群 ; NAMELIST group of variables character(STRING):: Name ! 変数名. ! 空白の場合には, この他の設定値は ! gtool_historyauto モジュールにおいて ! 出力されるデータ全ての ! デフォルト値となります. ! ! "Data1,Data2" のようにカンマで区切って複数 ! の変数を指定することも可能です. ! ! Variable identifier. ! If blank is given, other values are ! used as default values of output data ! in "gtool_historyauto". ! ! Multiple variables can be specified ! as "Data1,Data2" too. Delimiter is comma. character(STRING):: File ! 出力ファイル名. ! これはデフォルト値としては使用されません. ! *Name* に値が設定されている時のみ有効です. ! ! Output file name. ! This is not used as default value. ! This value is valid only when *Name* is ! specified. real:: IntValue ! データの出力間隔の数値. ! 負の値を与えると, 出力を抑止します. ! Numerical value for interval of history data output ! Negative values suppresses output. character(TOKEN):: IntUnit ! データの出力間隔の単位. ! Unit for interval of history data output character(TOKEN):: Precision ! データの精度. ! デフォルトは float (単精度実数型) ! です. 有効なのは, ! double (倍精度実数型), ! int (整数型) です. 指定しない ! 場合や, 無効な型を指定した場合には, ! float となります. ! ! Precision of history data ! Default value is "float" (single precision). ! Other valid values are ! "double" (double precision), ! "int" (integer). ! If no value or invalid value is specified, ! "float" is applied. character(STRING):: FilePrefix ! データのファイル名の接頭詞. ! Prefixes of history data filenames logical:: TimeAverage ! 出力データの時間平均フラグ. ! ! ".true." を与えると, 時間平均値が出力されます. ! ! Flag for time average of output data ! ! If ".ture." is specified, ! time average values are output. ! logical:: AllOutput ! 登録変数を全て出力するためのフラグ. ! Flag for output all registered variables. real:: OriginValue ! 出力開始時刻. ! Start time of output. character(TOKEN):: OriginUnit ! 出力開始時刻の単位. ! Unit of start time of output. real:: TerminusValue ! 出力終了時刻. ! End time of output. character(TOKEN):: TerminusUnit ! 出力終了時刻の単位. ! Unit of end time of output. integer:: SliceStart(1:NF_MAX_DIMS) ! 空間方向の開始点. ! Start points of spaces. integer:: SliceEnd(1:NF_MAX_DIMS) ! 空間方向の終了点. ! ! 省略した場合, もしくは負の値が与えら得た場合, ! 座標データの終了点が設定されます. ! ! End points of spaces. ! ! If this argument is omitted or ! negative value is specified, ! end points of dimensions are set. ! integer:: SliceStride(1:NF_MAX_DIMS) ! 空間方向の刻み幅. ! Strides of spaces. logical:: SpaceAverage(1:NF_MAX_DIMS) ! 空間平均のフラグ. ! Flag of spatial average. integer:: NewFileIntValue ! ファイル分割時間間隔の数値. ! Numerical value for interval of time of separation of a file. character(TOKEN):: NewFileIntUnit ! ファイル分割時間間隔の単位. ! Unit of interval of time of separation of a file. namelist /gtool_historyauto_nml/ Name, File, IntValue, IntUnit, Precision, FilePrefix, TimeAverage, AllOutput, OriginValue, OriginUnit, TerminusValue, TerminusUnit, SliceStart, SliceEnd, SliceStride, SpaceAverage, NewFileIntValue, NewFileIntUnit ! gtool_historyauto モジュールのデータ用 ! NAMELIST 変数群名. ! ! gtool_historyauto#HistoryAutoCreate ! を使用する際に, オプショナル引数 *namelist_filename* ! へ NAMELIST ファイル名を指定することで, ! そのファイルからこの NAMELIST 変数群を ! 読み込みます. ! ! NAMELIST group name for ! history data of "gtool_historyauto" module. ! ! If a NAMELIST filename is specified to ! an optional argument *namelist_filename* when ! "gtool_historyauto#HistoryAutoCreate" ! is used, this NAMELIST group is ! loaded from the file. ! 作業変数 ; Work variables integer:: blank_index integer:: stat character(STRING):: cause_c integer:: unit_nml ! NAMELIST ファイルオープン用装置番号. ! Unit number for NAMELIST file open integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT. ! IOSTAT of NAMELIST read character(TOKEN):: pos_nml ! NAMELIST 読み込み時のファイル位置. ! File position of NAMELIST read integer:: i, j character(TOKEN):: my_xtype real:: interval_work, origin_work, terminus_work integer:: date_day real(DP):: date_sec integer:: msnot_rank character(*), parameter:: subname = "HistoryAutoCreate1" continue call BeginSub(subname, version = version) stat = DC_NOERR cause_c = "" ! このサブルーチンが 2 度呼ばれたらエラー ! Error is occurred when this subroutine is called twice ! if ( initialized ) then stat = DC_EALREADYINIT cause_c = 'gtool_historyauto' goto 999 end if ! ゼロ秒の作成. ! Create zero seconds ! call DCDiffTimeCreate( zero_time, sec = 0.0_DP ) ! (in) ! 次元の数に関するエラー処理 ! Error handling for number of dimensions ! numdims = size(dims) if ( size(dimsizes) /= numdims ) then cause_c = 'dimsizes, dims' elseif ( size(longnames) /= numdims ) then cause_c = 'longnames, dims' elseif ( size(units) /= numdims ) then cause_c = 'units, dims' endif if ( trim(cause_c) /= "" ) then stat = GT_EARGSIZEMISMATCH goto 999 end if if ( numdims > NF_MAX_DIMS ) then stat = NF_EMAXDIMS goto 999 end if ! 時刻次元に関するエラー処理 ! Error handling for time dimension ! if ( dimsizes(numdims) /= 0 ) then call MessageNotify( 'W', subname, 'time dimension must be specified to the last of "dims"' ) stat = HST_ENOTIMEDIM goto 999 end if ! 出力ファイルの基本メタデータの保管 ! Save basic meta data for output file ! title_save = title source_save = source institution_save = institution conventions_save = '' if ( present(conventions) ) conventions_save = conventions gt_version_save = '' if ( present(gt_version) ) gt_version_save = gt_version rank_save = '' if ( present(rank) ) rank_save = rank ! MPI に関する情報の保管 ! Save information about MPI ! save_mpi_split = present_and_true( flag_mpi_split ) save_mpi_gather = present_and_true( flag_mpi_gather ) msnot_rank = -1 if ( save_mpi_gather ) msnot_rank = 0 ! 時刻の単位のチェック ! Check units of time ! time_unit_bycreate = units(numdims) time_unit_suffix = '' blank_index = index( trim( adjustl(time_unit_bycreate) ), ' ' ) if ( blank_index > 1 ) then time_unit_suffix = time_unit_bycreate(blank_index+1:) time_unit_bycreate = time_unit_bycreate(1:blank_index-1) end if ! 座標軸データの保管 ! Save axes data ! do i = 1, numdims my_xtype = '' if ( present(xtypes) ) then if ( size(xtypes) >= i ) then my_xtype = xtypes(i) end if end if call HistoryAxisCreate( axis = gthst_axes(i), name = dims(i), size = dimsizes(i), longname = longnames(i), units = units(i), xtype = my_xtype ) ! (in) allocate( data_axes(i) % a_axis( dimsizes(i) ) ) data_axes(i) % a_axis = (/ ( real( j, DP ), j = 1, dimsizes(i) ) /) end do ! 日時の指定 ! Specify date ! if ( present(origin_date) .and. .not. present_and_true(origin_date_invalid) ) then call Eval( origin_date, day = date_day, sec = date_sec ) ! (out) if ( date_day /= 0 .or. date_sec /= 0.0 ) then time_unit_suffix = trim(time_unit_suffix) // ' since ' // toChar(origin_date) call HistoryAxisAddAttr( axis = gthst_axes(numdims), attrname = 'calendar', value = toCharCal(origin_date) ) ! (in) end if end if ! 登録変数を全て出力するためのフラグの保管 ! Save flag for output all registered variables ! if ( present(all_output) ) all_output_save = all_output if ( .not. present_and_not_empty(namelist_filename) ) all_output_save = .true. AllOutput = all_output_save ! 出力時間間隔のデフォルト値設定 ! Configure default interval of output time ! if ( all_output_save ) then if ( present(interval) ) then interval_work = EvalbyUnit( interval, time_unit_bycreate ) else interval_work = 1.0 end if else interval_work = - 1.0 end if ! 出力開始・終了時刻のデフォルト値設定 ! Configure default origin/terminus time of output ! origin_work = EvalbyUnit( origin, 'sec' ) terminus_work = EvalbyUnit( terminus, time_unit_bycreate ) ! gtool_historyauto_nml へデフォルト値の設定 ! Configure default values for "gtool_historyauto_nml" ! call HstNmlInfoCreate( gthstnml ) ! (out) call HstNmlInfoAdd( gthstnml = gthstnml, name = '', precision = 'float', fileprefix = file_prefix, interval_value = interval_work, interval_unit = time_unit_bycreate, origin_value = origin_work, origin_unit = 'sec', terminus_value = terminus_work, terminus_unit = time_unit_bycreate, time_average = time_average, slice_start = slice_start, slice_end = slice_end, slice_stride = slice_stride, space_average = space_average, newfile_intvalue = newfile_interval, newfile_intunit = time_unit_bycreate ) ! (in) optional ! NAMELIST ファイルの読み込み ! Load NAMELIST file ! if ( present_and_not_empty(namelist_filename) ) then call FileOpen( unit_nml, namelist_filename, mode = 'r' ) ! (in) iostat_nml = 0 pos_nml = '' call MessageNotify( 'M', sub_sname, '----- "gtool_historyauto_nml" is loaded from "%c" -----', c1 = trim(namelist_filename), rank_mpi = msnot_rank ) do while ( trim(pos_nml) /= 'APPEND' .and. iostat_nml == 0 ) Name = '' File = '' call HstNmlInfoInquire( gthstnml = gthstnml, interval_value = IntValue, interval_unit = IntUnit, precision = Precision, time_average = TimeAverage, origin_value = OriginValue, origin_unit = OriginUnit, terminus_value = TerminusValue, terminus_unit = TerminusUnit, slice_start = SliceStart, slice_end = SliceEnd, slice_stride = SliceStride, space_average = SpaceAverage, newfile_intvalue = NewFileIntValue, newfile_intunit = NewFileIntUnit, fileprefix = FilePrefix ) ! (out) optional read( unit = unit_nml, nml = gtool_historyauto_nml, iostat = iostat_nml ) ! (out) inquire( unit = unit_nml, position = pos_nml ) ! (out) if ( iostat_nml == 0 ) then ! NAMELIST から与えられた値が無効な場合, デフォルト値を使用 ! Default values are used when values from NAMELIST are invalid ! if ( .not. IntValue > 0.0 ) then IntValue = interval_work IntUnit = time_unit_bycreate end if if ( .not. OriginValue > 0.0 ) then OriginValue = origin_work OriginUnit = 'sec' end if if ( .not. TerminusValue > 0.0 ) then TerminusValue = terminus_work TerminusUnit = time_unit_bycreate end if ! 情報の登録 ! Register information ! call HstNmlInfoAdd( gthstnml = gthstnml, name = Name, file = File, interval_value = IntValue, interval_unit = IntUnit, precision = Precision, time_average = TimeAverage, origin_value = OriginValue, origin_unit = OriginUnit, terminus_value = TerminusValue, terminus_unit = TerminusUnit, slice_start = SliceStart, slice_end = SliceEnd, slice_stride = SliceStride, space_average = SpaceAverage, newfile_intvalue = NewFileIntValue, newfile_intunit = NewFileIntUnit, fileprefix = FilePrefix ) ! (in) optional ! 登録変数を全て出力するためのフラグの保管 ! Save flag for output all registered variables ! if ( trim(Name) == '' ) then all_output_save = AllOutput end if ! 印字 ; Print ! if ( trim(File) == '' ) File = trim(FilePrefix) // '<Name>.nc' if ( trim(Name) == '' ) then call MessageNotify( 'M', sub_sname, 'Global Settings:', rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' AllOutput = %b', l = (/ AllOutput /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' FilePrefix = %c', c1 = trim(FilePrefix ), rank_mpi = msnot_rank ) else call MessageNotify( 'M', sub_sname, 'Individual Settings:', rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' Name = %c', c1 = trim(Name ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' File = %c', c1 = trim(File ), rank_mpi = msnot_rank ) end if call MessageNotify( 'M', sub_sname, ' Interval = %r [%c]', r = (/ IntValue /), c1 = trim( IntUnit ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' Precision = %c', c1 = trim(Precision ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' TimeAverage = %b', l = (/ TimeAverage /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' Origin = %r [%c]', r = (/ OriginValue /), c1 = trim( OriginUnit ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' Terminus = %r [%c]', r = (/ TerminusValue /), c1 = trim( TerminusUnit ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' SliceStart = (/ %*d /)', i = SliceStart(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' SliceEnd = (/ %*d /)', i = SliceEnd(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' SliceStride = (/ %*d /)', i = SliceStride(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' SpaceAverage = (/ %*b /)', l = SpaceAverage(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' NewFileInterval = %d [%c]', i = (/ NewFileIntValue /), c1 = trim( NewFileIntUnit ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, '', rank_mpi = msnot_rank ) else call MessageNotify( 'M', sub_sname, '----- loading is finished (iostat=%d) -----', i = (/iostat_nml/), rank_mpi = msnot_rank ) end if end do close( unit_nml ) ! NAMELIST ファイルを読み込まない場合 ! NAMELIST file is not loaded ! else call MessageNotify( 'M', sub_sname, '----- "gtool_historyauto_nml" is not loaded" -----', rank_mpi = msnot_rank ) Name = '' File = '' call HstNmlInfoInquire( gthstnml = gthstnml, interval_value = IntValue, interval_unit = IntUnit, precision = Precision, time_average = TimeAverage, origin_value = OriginValue, origin_unit = OriginUnit, terminus_value = TerminusValue, terminus_unit = TerminusUnit, slice_start = SliceStart, slice_end = SliceEnd, slice_stride = SliceStride, space_average = SpaceAverage, newfile_intvalue = NewFileIntValue, newfile_intunit = NewFileIntUnit, fileprefix = FilePrefix ) ! (out) optional ! 印字 ; Print ! call MessageNotify( 'M', sub_sname, 'Global Settings:', rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' AllOutput = %b', l = (/ AllOutput /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' FilePrefix = %c', c1 = trim(FilePrefix ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' Interval = %r [%c]', r = (/ IntValue /), c1 = trim( IntUnit ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' Precision = %c', c1 = trim(Precision ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' TimeAverage = %b', l = (/ TimeAverage /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' Origin = %r [%c]', r = (/ OriginValue /), c1 = trim( OriginUnit ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' Terminus = %r [%c]', r = (/ TerminusValue /), c1 = trim( TerminusUnit ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' SliceStart = (/ %*d /)', i = SliceStart(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' SliceEnd = (/ %*d /)', i = SliceEnd(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' SliceStride = (/ %*d /)', i = SliceStride(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' SpaceAverage = (/ %*b /)', l = SpaceAverage(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, ' NewFileInterval = %d [%c]', i = (/ NewFileIntValue /), c1 = trim( NewFileIntUnit ), rank_mpi = msnot_rank ) call MessageNotify( 'M', sub_sname, '' , rank_mpi = msnot_rank) end if ! 終了処理, 例外処理 ! Termination and Exception handling ! initialized = .true. 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname, 'stat=%d', i = (/stat/) ) end subroutine HistoryAutoCreate1
Subroutine : | |||
title : | character(*), intent(in)
| ||
source : | character(*), intent(in)
| ||
institution : | character(*), intent(in)
| ||
dims(:) : | character(*), intent(in)
| ||
dimsizes(:) : | integer, intent(in)
| ||
longnames(:) : | character(*), intent(in)
| ||
units(:) : | character(*), intent(in)
| ||
xtypes(:) : | character(*), intent(in), optional
| ||
conventions : | character(*), intent(in), optional
| ||
gt_version : | character(*), intent(in), optional
| ||
all_output : | logical, intent(in), optional
| ||
file_prefix : | character(*), intent(in), optional
| ||
namelist_filename : | character(*), intent(in), optional
| ||
interval : | real, intent(in), optional
| ||
origin : | real, intent(in), optional
| ||
terminus : | real, intent(in), optional
| ||
slice_start(:) : | integer, intent(in), optional
| ||
slice_end(:) : | integer, intent(in), optional
| ||
slice_stride(:) : | integer, intent(in), optional
| ||
space_average(:) : | logical, intent(in), optional
| ||
time_average : | logical, intent(in), optional
| ||
newfile_interval : | integer, intent(in), optional
| ||
rank : | character(*), intent(in), optional
| ||
origin_date : | type(DC_DATETIME), intent(in), optional
| ||
origin_date_invalid : | logical, intent(in), optional
| ||
flag_mpi_gather : | logical, intent(in), optional
| ||
flag_mpi_split : | logical, intent(in), optional
|
複数のヒストリデータ出力を行うための初期化を行います.
この HistoryAutoCreate には, モデル内で出力する 変数が依存する座標や座標重みなどを全てを設定してください.
all_output に .true. を与えた場合や, namelist_filename を与えない (空文字を与える) 場合には, HistoryAutoAddVariable で登録される全ての変数が出力されます. 一方で namelist_filename に NAMELIST ファイル名を与える場合には, その NAMELIST ファイルから出力のオンオフや, 出力ファイル名, 出力間隔などを変更可能です. 変更可能な項目に関しては NAMELIST#gtool_historyauto_nml を参照して下さい.
interval, origin, terminus, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval などの設定はデフォルト値として使用されます. これらの設定値は HistoryAutoAddVariable および NAMELIST#gtool_historyauto_nml で上書きされます. (優先度が高いのは NAMELIST#gtool_historyauto_nml , HistoryAutoAddVariable の引数, HistoryAutoCreate の引数 の順です).
Initialization for multiple history data output
Set all axes and their weights depended by variables output from numerical models to this "HistoryAutoCreate".
All variables registered by "HistoryAutoAddVariable" are output if .true. is given to "all_output" or "namelist_filename" is not given (or blanks are given) On the other hand, if a filename of NAMELIST file is given to "namelist_filename", on/off of output, output filename and output interval, etc. can be changed from the NAMELIST file. For available items, see "NAMELIST#gtool_historyauto_nml".
Settings about "interval", "origin", "terminus", "slice_start", "slice_end", "slice_stride", "space_average", "time_average", "newfile_interval" etc. are used as default values. Their set values are overwritten by "HistoryAutoAddVariable" or "NAMELIST#gtool_historyauto_nml". ("NAMELIST#gtool_historyauto_nml" is high priority, arguments of "HistoryAutoAddVariable" are medium, arguments of "HistoryAutoCreate" are low).
subroutine HistoryAutoCreate2( title, source, institution, dims, dimsizes, longnames, units, xtypes, conventions, gt_version, all_output, file_prefix, namelist_filename, interval, origin, terminus, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval, rank, origin_date, origin_date_invalid, flag_mpi_gather, flag_mpi_split ) ! ! 複数のヒストリデータ出力を行うための初期化を行います. ! ! この HistoryAutoCreate には, モデル内で出力する ! 変数が依存する座標や座標重みなどを全てを設定してください. ! ! all_output に .true. を与えた場合や, ! namelist_filename を与えない (空文字を与える) 場合には, ! HistoryAutoAddVariable で登録される全ての変数が出力されます. ! 一方で namelist_filename に NAMELIST ファイル名を与える場合には, ! その NAMELIST ファイルから出力のオンオフや, ! 出力ファイル名, 出力間隔などを変更可能です. ! 変更可能な項目に関しては NAMELIST#gtool_historyauto_nml ! を参照して下さい. ! ! interval, origin, terminus, slice_start, slice_end, slice_stride, ! space_average, time_average, newfile_interval ! などの設定はデフォルト値として使用されます. ! これらの設定値は HistoryAutoAddVariable および ! NAMELIST#gtool_historyauto_nml で上書きされます. ! (優先度が高いのは NAMELIST#gtool_historyauto_nml , ! HistoryAutoAddVariable の引数, ! HistoryAutoCreate の引数 の順です). ! ! ! Initialization for multiple history data output ! ! Set all axes and their weights depended by variables ! output from numerical models to this "HistoryAutoCreate". ! ! All variables registered by "HistoryAutoAddVariable" ! are output if .true. is given to "all_output" or ! "namelist_filename" is not given (or blanks are given) ! On the other hand, if a filename of NAMELIST file is ! given to "namelist_filename", on/off of output, ! output filename and output interval, etc. can be changed ! from the NAMELIST file. ! For available items, see "NAMELIST#gtool_historyauto_nml". ! ! Settings about ! "interval", "origin", "terminus", "slice_start", "slice_end", "slice_stride", ! "space_average", "time_average", "newfile_interval" ! etc. are used as default values. ! Their set values are overwritten by ! "HistoryAutoAddVariable" or ! "NAMELIST#gtool_historyauto_nml". ! ("NAMELIST#gtool_historyauto_nml" is high priority, ! arguments of "HistoryAutoAddVariable" are medium, ! arguments of "HistoryAutoCreate" are low). ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, DC_EALREADYINIT, GT_EARGSIZEMISMATCH, HST_ENOTIMEDIM use netcdf_f77, only: NF_EMAXDIMS use dc_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar use dc_present, only: present_and_not_empty, present_and_true, present_select use dc_date, only: DCDiffTimeCreate, EvalbyUnit use dc_message, only: MessageNotify use dc_iounit, only: FileOpen use gtool_history, only: HistoryAxisCreate use gtool_history_nmlinfo, only: HstNmlInfoCreate, HstNmlInfoAdd, HstNmlInfoEndDefine, HstNmlInfoPutLine, HstNmlInfoAllNameValid, HstNmlInfoInquire implicit none character(*), intent(in):: title ! データ全体の表題. ! Title of entire data character(*), intent(in):: source ! データを作成する際の手段. ! Source of data file character(*), intent(in):: institution ! ファイルを最終的に変更した組織/個人. ! Institution or person that changes files for the last time character(*), intent(in):: dims(:) ! 次元の名前. ! ! 配列の大きさに制限はありません. ! 個々の次元の文字数は dc_types#TOKEN まで. ! 配列内の文字数は ! 全て同じでなければなりません. ! 足りない文字分は空白で ! 補ってください. ! ! Names of dimensions. ! ! Length of array is unlimited. ! Limits of numbers of characters of each ! dimensions are "dc_types#TOKEN". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! integer, intent(in):: dimsizes (:) ! dims で指定したそれぞれの次元大きさ. ! ! 配列の大きさは dims の大きさと等しい ! 必要があります. '0' (数字のゼロ) を指定 ! するとその次元は 無制限次元 (unlimited ! dimension) となります. (gtool_history ! では時間の次元に対して無制限次元を ! 用いることを想定しています). ただし, ! 1 つの NetCDF ファイル (バージョン 3) ! は最大で 1 つの無制限次元しか持てないので, ! 2 ヶ所以上に '0' を指定しないでください. ! その場合, 正しく gtool4 データが出力されません. ! ! Lengths of dimensions specified with "dims". ! ! Length of this array must be same as ! length of "dim". If '0' (zero) is ! specified, the dimension is treated as ! unlimited dimension. ! (In "gtool_history", unlimited dimension is ! expected to be used as time). ! Note that one NetCDF file (version 3) ! can not have two or more unlimited ! dimensions, so that do not specify '0' ! to two or more places. In that case, ! gtoo4 data is not output currently ! character(*), intent(in):: longnames (:) ! dims で指定したそれぞれの次元の名前. ! ! 配列の大きさは dims の大きさ ! と等しい必要があります. 文字数 ! は dc_types#STRING まで. ! 配列内の文字数は ! 全て同じでなければなりません. ! 足りない文字分は空白で補います. ! ! Names of dimensions specified with "dims". ! ! Length of this array must be same as ! length of "dim". ! Limits of numbers of characters are ! "dc_types#STRING". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! character(*), intent(in):: units(:) ! dims で指定したそれぞれの次元の単位. ! ! 配列の大きさは dims の大きさ ! と等しい必要があります. 文字数 ! は dc_types#STRING まで. ! 配列内の文字数は ! 全て同じでなければなりません. ! 足りない文字分は空白で補います. ! ! Units of dimensions specified with "dims". ! ! Length of this array must be same as ! length of "dim". ! Limits of numbers of characters are ! "dc_types#STRING". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! character(*), intent(in), optional:: xtypes(:) ! dims で指定したそれぞれの ! 次元のデータ型. ! ! デフォルトは float (単精度実数型) ! です. 有効なのは, ! double (倍精度実数型), ! int (整数型) です. 指定しない ! 場合や, 無効な型を指定した場合には, ! float となります. なお, 配列の大きさ ! は *dims* の大きさと等しい必要が ! あります. 配列内の文字数は全て ! 同じでなければなりません. ! 足りない文字分は空白で補います. ! ! Data types of dimensions specified ! with "dims". ! ! Default value is "float" (single precision). ! Other valid values are ! "double" (double precision), ! "int" (integer). ! If no value or invalid value is specified, ! "float" is applied. ! Length of this array must be same as ! length of "dim". ! Numbers of characters in this array ! must be same. ! Make up a deficit with blanks. ! character(*), intent(in), optional:: conventions ! 出力するファイルの netCDF ! 規約 ! ! 省略した場合, ! もしくは空文字を与えた場合, ! 出力する netCDF 規約の ! Conventions 属性に値 ! gtool4_netCDF_Conventions ! が自動的に与えられます. ! ! NetCDF conventions of output file. ! ! If this argument is omitted or, ! blanks are given, ! gtool4_netCDF_Conventions is given to ! attribute "Conventions" of an output file ! automatically. ! character(*), intent(in), optional:: gt_version ! gtool4 netCDF 規約のバージョン ! ! 省略した場合, gt_version 属性に ! 規約の最新版のバージョンナンバー ! gtool4_netCDF_version ! が与えられます. ! (ただし, 引数 conventions に ! gtool4_netCDF_Conventions ! 以外が与えられる場合は ! gt_version 属性を作成しません). ! ! Version of gtool4 netCDF Conventions. ! ! If this argument is omitted, ! latest version number of gtool4 netCDF ! Conventions is given to attribute ! "gt_version" of an output file ! (However, gtool4_netCDF_Conventions is ! not given to an argument "conventions", ! attribute "gt_version" is not created). ! logical, intent(in), optional:: all_output ! 登録変数を全て出力するためのフラグ. ! ! .true. を指定すると, ! HistoryAutoAddVariable で登録された ! 変数が全て出力されるようになります. ! ! *namelist_filename* が指定される場合 ! には, デフォルトは .false. となります. ! この場合には, ! *namelist_filename* に指定された ! NAMELIST ファイルから読み込まれる ! NAMELIST#gtool_historyauto_nml ! で指定された変数のみ出力されます. ! ! *namelist_filename* が指定されない場合 ! には, .true. となります. ! ! ! Flag for output all registered variables. ! ! When .true. is specified, ! all variables registered by ! "HistoryAutoAddVariable" are output. ! ! If *namelist_filename* is specified, ! default value becomes .false. . ! In this case, ! only variables specified in ! "NAMELIST#gtool_historyauto_nml" ! loaded from a NAMELIST file ! *namelist_filename*. ! ! If *namelist_filename* is not specified, ! this value becomes .true. . ! character(*), intent(in), optional:: file_prefix ! ヒストリデータのファイル名の接頭詞. ! Prefixes of history data filenames character(*), intent(in), optional:: namelist_filename ! NAMELIST ファイルの名称. ! ! 省略した場合, もしくは空白文字を与えた場合, ! NAMELIST ファイルは読み込みません. ! ! Name of NAMELIST file. ! ! If this argument is omitted, ! or blanks are specified, ! no NAMELIST file is loaded. ! real, intent(in), optional:: interval ! 出力時間間隔. ! ! 省略した場合, ! 自動的に 1.0 [sec] が設定されます. ! ! Interval of output time. ! ! If this argument is omitted, ! 1.0 [sec] is specified ! automatically. ! real, intent(in), optional:: origin ! 出力開始時刻. ! ! 省略した場合, 自動的に 0.0 [sec] が ! 設定されます. ! ! Start time of output. ! ! If this argument is omitted, ! 0.0 [sec] is specified ! automatically. ! real, intent(in), optional:: terminus ! 出力終了時刻. ! ! 省略した場合, 数値モデルの実行が終了するまで ! 出力を行います. ! ! End time of output. ! ! If this argument is omitted, ! output is continued until a numerical model ! is finished. ! integer, intent(in), optional:: slice_start(:) ! 空間方向の開始点. ! ! 省略した場合, 座標データの開始点が設定されます. ! ! Start points of spaces. ! ! If this argument is omitted, ! start points of dimensions are set. ! integer, intent(in), optional:: slice_end(:) ! 空間方向の終了点. ! ! 省略した場合, 座標データの終了点が設定されます. ! ! End points of spaces. ! ! If this argument is omitted, ! End points of dimensions are set. ! integer, intent(in), optional:: slice_stride(:) ! 空間方向の刻み幅. ! ! 省略した場合, 1 が設定されます. ! ! Strides of spaces ! ! If this argument is omitted, ! 1 is set. ! logical, intent(in), optional:: space_average(:) ! 平均化のフラグ. ! ! .true. が指定される座標に対して平均化を ! 行います. ! 省略した場合, .false. が設定されます. ! ! Flag of average. ! ! Axes specified .true. are averaged. ! If this argument is omitted, ! .false. is set. ! logical, intent(in), optional:: time_average ! 出力データの時間平均フラグ. ! デフォルトは .false. ! Flag for time average of output data ! Default value is .false. integer, intent(in), optional:: newfile_interval ! ファイル分割時間間隔. ! ! 省略した場合, ! 時間方向へのファイル分割を行いません. ! ! Interval of time of separation of a file. ! ! If this argument is omitted, ! a files is not separated in time direction. ! character(*), intent(in), optional:: rank ! ランクの名称. ! 空文字を与えた場合には無視されます. ! ! Name of a rank. ! If blank is given, this argument is ignored. ! type(DC_DATETIME), intent(in), optional:: origin_date ! 出力開始日時. ! ! Start date of output. ! logical, intent(in), optional:: origin_date_invalid ! .true. を与えると, origin_date を無効にします. ! ! If ".true." is given, "origin_date" is ignored. ! logical, intent(in), optional:: flag_mpi_gather ! MPI 使用時に, 各ノードで HistoryPut ! に与えたデータを一つのファイルに統合して出力 ! する場合には .true. を与えてください. ! デフォルトは .false. です. ! ! .true. を与えた場合, HistoryPutAxisMPI ! に全体の軸データを与えてください. ! ! When MPI is used, if ".true." is given, ! data given to "HistoryPut" on each node ! is integrated and output to one file. ! Default value is ".false.". ! ! If .true. is given, give data of axes in ! whole area to "HistoryPutAxisMPI" ! logical, intent(in), optional:: flag_mpi_split ! MPI 使用時に, 各ノードで HistoryPut ! に与えたデータをそれぞれ別名のファイルに ! 出力する場合には .true. を与えてください. ! デフォルトは .false. です. ! ! When MPI is used, if ".true." is given, ! data given to "HistoryPut" on each node ! is split into discrete files. ! Default value is ".false.". ! integer:: blank_index type(DC_DIFFTIME):: interval_difftime, origin_difftime, terminus_difftime integer:: stat character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoCreate2" continue call BeginSub(subname) stat = DC_NOERR cause_c = "" ! このサブルーチンが 2 度呼ばれたらエラー ! Error is occurred when this subroutine is called twice ! if ( initialized ) then stat = DC_EALREADYINIT cause_c = 'gtool_historyauto' goto 999 end if ! 次元の数に関するエラー処理 ! Error handling for number of dimensions ! numdims = size(dims) if ( size(dimsizes) /= numdims ) then cause_c = 'dimsizes, dims' elseif ( size(longnames) /= numdims ) then cause_c = 'longnames, dims' elseif ( size(units) /= numdims ) then cause_c = 'units, dims' endif if ( trim(cause_c) /= "" ) then stat = GT_EARGSIZEMISMATCH goto 999 end if if ( numdims > NF_MAX_DIMS ) then stat = NF_EMAXDIMS goto 999 end if ! 時刻次元に関するエラー処理 ! Error handling for time dimension ! if ( dimsizes(numdims) /= 0 ) then call MessageNotify( 'W', subname, 'time dimension must be specified to the last of "dims"' ) stat = HST_ENOTIMEDIM goto 999 end if ! 時刻の単位のチェック ! Check units of time ! time_unit_bycreate = units(numdims) time_unit_suffix = '' blank_index = index( trim( adjustl(time_unit_bycreate) ), ' ' ) if ( blank_index > 1 ) then time_unit_suffix = time_unit_bycreate(blank_index+1:) time_unit_bycreate = time_unit_bycreate(1:blank_index-1) end if ! 出力時間間隔のデフォルト値設定 ! Configure default interval of output time ! if ( present(interval) ) then call DCDiffTimeCreate( interval_difftime, interval, time_unit_bycreate ) ! (in) else call DCDiffTimeCreate( interval_difftime, 1.0, time_unit_bycreate ) ! (in) end if ! 出力開始・終了時刻のデフォルト値設定 ! Configure default origin/terminus time of output ! if ( present(origin) ) then call DCDiffTimeCreate( origin_difftime, origin, time_unit_bycreate ) ! (in) else call DCDiffTimeCreate( origin_difftime, 0.0, time_unit_bycreate ) ! (in) end if if ( present(terminus) ) then call DCDiffTimeCreate( terminus_difftime, terminus, time_unit_bycreate ) ! (in) else call DCDiffTimeCreate( terminus_difftime, -1.0, time_unit_bycreate ) ! (in) end if ! HistoryAutoCreate1 の呼び出し ! Call "HistoryAutoCreate1" ! call HistoryAutoCreate( title = title, source = source, institution = institution, dims = dims, dimsizes = dimsizes, longnames = longnames, units = units, origin = origin_difftime, terminus = terminus_difftime, xtypes = xtypes, conventions = conventions, gt_version = gt_version, all_output = all_output, file_prefix = file_prefix, namelist_filename = namelist_filename, interval = interval_difftime, slice_start = slice_start, slice_end = slice_end, slice_stride = slice_stride, space_average = space_average, time_average = time_average, newfile_interval = newfile_interval, rank = rank, origin_date = origin_date, origin_date_invalid = origin_date_invalid, flag_mpi_gather = flag_mpi_gather, flag_mpi_split = flag_mpi_split ) ! (in) optional 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoCreate2
Subroutine : | |||
dim : | character(*), intent(in)
| ||
array(:) : | real(DP), intent(in)
|
座標データを設定します.
Set data of an axis.
subroutine HistoryAutoPutAxisDouble( dim, array ) ! ! 座標データを設定します. ! ! Set data of an axis. ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_ENOAXISNAME, DC_ENOTINIT use gtool_history, only: HistoryAxisInquire, HistoryAxisAddAttr, HistoryVarinfoCreate implicit none character(*), intent(in):: dim ! 座標の名称. ! ! ただし, ここで指定するもの ! は, HistoryAutoCreate の *dims* ! 既に指定されていなければなりません. ! ! Name of axis. ! ! Note that this value must be set ! as "dims" of "HistoryAutoCreate". ! real(DP), intent(in):: array(:) ! 座標データ ! ! データ型は整数, 単精度実数型, ! 倍精度実数型のどれでもかまいません. ! ただし, ファイルへ出力される際には, ! HistoryAutoCreate の *xtypes* で指定した ! データ型へ変換されます. ! ! Data of axis ! ! Integer, single or double precision are ! acceptable as data type. ! Note that when this is output to a file, ! data type is converted into "xtypes" ! specified in "HistoryAutoCreate" ! character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoPutAxisDouble" continue call BeginSub(subname, 'dim=<%c>', c1=trim(dim) ) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(dim) == trim(name) ) then data_axes(i) % a_axis = array goto 999 end if end do stat = HST_ENOAXISNAME cause_c = dim 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoPutAxisDouble
Subroutine : | |||
dim : | character(*), intent(in)
| ||
array(:) : | integer, intent(in)
|
座標データを設定します.
Set data of an axis.
subroutine HistoryAutoPutAxisInt( dim, array ) ! ! 座標データを設定します. ! ! Set data of an axis. ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_ENOAXISNAME, DC_ENOTINIT use gtool_history, only: HistoryAxisInquire, HistoryAxisAddAttr, HistoryVarinfoCreate implicit none character(*), intent(in):: dim ! 座標の名称. ! ! ただし, ここで指定するもの ! は, HistoryAutoCreate の *dims* ! 既に指定されていなければなりません. ! ! Name of axis. ! ! Note that this value must be set ! as "dims" of "HistoryAutoCreate". ! integer, intent(in):: array(:) ! 座標データ ! ! データ型は整数, 単精度実数型, ! 倍精度実数型のどれでもかまいません. ! ただし, ファイルへ出力される際には, ! HistoryAutoCreate の *xtypes* で指定した ! データ型へ変換されます. ! ! Data of axis ! ! Integer, single or double precision are ! acceptable as data type. ! Note that when this is output to a file, ! data type is converted into "xtypes" ! specified in "HistoryAutoCreate" ! character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoPutAxisInt" continue call BeginSub(subname, 'dim=<%c>', c1=trim(dim) ) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(dim) == trim(name) ) then data_axes(i) % a_axis = array goto 999 end if end do stat = HST_ENOAXISNAME cause_c = dim 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoPutAxisInt
Subroutine : | |||
dim : | character(*), intent(in)
| ||
array(:) : | real(DP), intent(in)
|
MPI 使用時に, 各々のノード上のデータを単一ファイルに 集約して出力する場合には, このサブルーチンに領域全体の座標データを与えてください. また, HistoryAutoCreate のオプショナル論理型引数 flag_mpi_gather に .true. を与えてください.
When MPI is used, if data on each node is integrated and output to one file, give data of axes in whole area to this subroutine. And give .true. to optional logical argument flag_mpi_gather in "HistoryAutoCreate".
subroutine HistoryAutoPutAxisMPIDouble( dim, array ) ! ! MPI 使用時に, 各々のノード上のデータを単一ファイルに ! 集約して出力する場合には, ! このサブルーチンに領域全体の座標データを与えてください. ! また, HistoryAutoCreate のオプショナル論理型引数 *flag_mpi_gather* ! に .true. を与えてください. ! ! When MPI is used, if data on each node is integrated and ! output to one file, give data of axes in whole area to ! this subroutine. ! And give .true. to optional logical argument *flag_mpi_gather* ! in "HistoryAutoCreate". ! use gtool_history, only: HistoryAxisInquire use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, GT_EBADDIMNAME use dc_message, only: MessageNotify implicit none character(*), intent(in):: dim ! 座標変数の名称. ! ! ここで指定するものは, HistoryAutoCreate の ! 引数 *dims* で既に指定されてい ! なければなりません. ! ! Name of dimensional variable. ! ! This name must be specified by ! an argument *dims* in "HistoryAutoCreate". ! real(DP), intent(in):: array(:) ! 座標データ. ! ! Data of axes. integer:: i, dimsize character(STRING):: name integer:: stat character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoPutAxisMPIDouble" continue call BeginSub(subname, 'dim=%c', c1 = trim(dim) ) stat = DC_NOERR cause_c = "" do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(dim) == trim(name) ) then dimsize = size( array ) allocate( data_axes_whole(i) % a_axis( dimsize ) ) data_axes_whole(i) % a_axis(:) = array(:) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = dim ! 終了処理, 例外処理 ! Termination and Exception handling ! 999 continue call StoreError( stat, subname, cause_c = cause_c ) call EndSub(subname) end subroutine HistoryAutoPutAxisMPIDouble
Subroutine : | |
dim : | character(*), intent(in) |
array(:) : | integer, intent(in) |
MPI 使用時に, 各々のノード上のデータを単一ファイルに 集約して出力する場合には, このサブルーチンに領域全体の座標データを与えてください. また, HistoryAutoCreate のオプショナル論理型引数 flag_mpi_gather に .true. を与えてください.
When MPI is used, if data on each node is integrated and output to one file, give data of axes in whole area to this subroutine. And give .true. to optional logical argument flag_mpi_gather in "HistoryAutoCreate".
subroutine HistoryAutoPutAxisMPIInt( dim, array ) ! ! MPI 使用時に, 各々のノード上のデータを単一ファイルに ! 集約して出力する場合には, ! このサブルーチンに領域全体の座標データを与えてください. ! また, HistoryAutoCreate のオプショナル論理型引数 *flag_mpi_gather* ! に .true. を与えてください. ! ! When MPI is used, if data on each node is integrated and ! output to one file, give data of axes in whole area to ! this subroutine. ! And give .true. to optional logical argument *flag_mpi_gather* ! in "HistoryAutoCreate". ! use gtool_history, only: HistoryAxisInquire use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, GT_EBADDIMNAME use dc_message, only: MessageNotify implicit none character(*), intent(in):: dim integer, intent(in):: array(:) integer:: i, dimsize character(STRING):: name integer:: stat character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoPutAxisMPIInt" continue call BeginSub(subname, 'dim=%c', c1 = trim(dim) ) stat = DC_NOERR cause_c = "" do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(dim) == trim(name) ) then dimsize = size( array ) allocate( data_axes_whole(i) % a_axis( dimsize ) ) data_axes_whole(i) % a_axis(:) = array(:) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = dim ! 終了処理, 例外処理 ! Termination and Exception handling ! 999 continue call StoreError( stat, subname, cause_c = cause_c ) call EndSub(subname) end subroutine HistoryAutoPutAxisMPIInt
Subroutine : | |
dim : | character(*), intent(in) |
array(:) : | real, intent(in) |
MPI 使用時に, 各々のノード上のデータを単一ファイルに 集約して出力する場合には, このサブルーチンに領域全体の座標データを与えてください. また, HistoryAutoCreate のオプショナル論理型引数 flag_mpi_gather に .true. を与えてください.
When MPI is used, if data on each node is integrated and output to one file, give data of axes in whole area to this subroutine. And give .true. to optional logical argument flag_mpi_gather in "HistoryAutoCreate".
subroutine HistoryAutoPutAxisMPIReal( dim, array ) ! ! MPI 使用時に, 各々のノード上のデータを単一ファイルに ! 集約して出力する場合には, ! このサブルーチンに領域全体の座標データを与えてください. ! また, HistoryAutoCreate のオプショナル論理型引数 *flag_mpi_gather* ! に .true. を与えてください. ! ! When MPI is used, if data on each node is integrated and ! output to one file, give data of axes in whole area to ! this subroutine. ! And give .true. to optional logical argument *flag_mpi_gather* ! in "HistoryAutoCreate". ! use gtool_history, only: HistoryAxisInquire use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_ENOAXISNAME use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, GT_EBADDIMNAME use dc_message, only: MessageNotify implicit none character(*), intent(in):: dim real, intent(in):: array(:) integer:: i, dimsize character(STRING):: name integer:: stat character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoPutAxisMPIReal" continue call BeginSub(subname, 'dim=%c', c1 = trim(dim) ) stat = DC_NOERR cause_c = "" do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(dim) == trim(name) ) then dimsize = size( array ) allocate( data_axes_whole(i) % a_axis( dimsize ) ) data_axes_whole(i) % a_axis(:) = array(:) goto 999 end if end do stat = HST_ENOAXISNAME cause_c = dim ! 終了処理, 例外処理 ! Termination and Exception handling ! 999 continue call StoreError( stat, subname, cause_c = cause_c ) call EndSub(subname) end subroutine HistoryAutoPutAxisMPIReal
Subroutine : | |||
dim : | character(*), intent(in)
| ||
array(:) : | real, intent(in)
|
座標データを設定します.
Set data of an axis.
subroutine HistoryAutoPutAxisReal( dim, array ) ! ! 座標データを設定します. ! ! Set data of an axis. ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_ENOAXISNAME, DC_ENOTINIT use gtool_history, only: HistoryAxisInquire, HistoryAxisAddAttr, HistoryVarinfoCreate implicit none character(*), intent(in):: dim ! 座標の名称. ! ! ただし, ここで指定するもの ! は, HistoryAutoCreate の *dims* ! 既に指定されていなければなりません. ! ! Name of axis. ! ! Note that this value must be set ! as "dims" of "HistoryAutoCreate". ! real, intent(in):: array(:) ! 座標データ ! ! データ型は整数, 単精度実数型, ! 倍精度実数型のどれでもかまいません. ! ただし, ファイルへ出力される際には, ! HistoryAutoCreate の *xtypes* で指定した ! データ型へ変換されます. ! ! Data of axis ! ! Integer, single or double precision are ! acceptable as data type. ! Note that when this is output to a file, ! data type is converted into "xtypes" ! specified in "HistoryAutoCreate" ! character(STRING):: name integer:: stat, i character(STRING):: cause_c character(*), parameter:: subname = "HistoryAutoPutAxisReal" continue call BeginSub(subname, 'dim=<%c>', c1=trim(dim) ) stat = DC_NOERR cause_c = "" ! 初期設定チェック ! Check initialization ! if ( .not. initialized ) then stat = DC_ENOTINIT cause_c = 'gtool_historyauto' goto 999 end if do i = 1, numdims call HistoryAxisInquire( axis = gthst_axes(i), name = name ) ! (out) if ( trim(dim) == trim(name) ) then data_axes(i) % a_axis = array goto 999 end if end do stat = HST_ENOAXISNAME cause_c = dim 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HistoryAutoPutAxisReal
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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceDouble1( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceDouble2( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceDouble3( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceDouble4( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceDouble5( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceDouble6( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceDouble7( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceInt1( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceInt2( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceInt3( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceInt4( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceInt5( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceInt6( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceInt7( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceReal1( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceReal2( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceReal3( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceReal4( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceReal5( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceReal6( 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 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, only: operator(-), operator(+), operator(>), operator(<), mod, operator(==), toChar, EvalSec, DCDiffTimePutLine use gtool_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose, HistorySetTime use gtool_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode 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 AverageReduceReal7( 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
Subroutine : | |||
gthist : | type(GT_HISTORY), intent(inout)
| ||
varname : | character(*), intent(in)
| ||
time : | type(DC_DIFFTIME), intent(in)
|
ファイル作成用内部サブルーチン
Internal subroutine for creation of files
subroutine HstFileCreate( gthist, varname, time ) ! ! ファイル作成用内部サブルーチン ! ! Internal subroutine for creation of files ! use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, HST_EBADVARNAME, HST_EBADSLICE, HST_EMPINOAXISDATA use dc_date_types, only: DC_DIFFTIME use dc_date, only: DCDiffTimeCreate, EvalbyUnit use dc_string, only: CPrintf, StrInclude, toChar, JoinChar use dc_message, only: MessageNotify use gtool_history_nmlinfo, only: HstNmlInfoOutputValid, HstNmlInfoInquire, HstNmlInfoPutLine use gtool_history, only: GT_HISTORY, HistoryCreate, HistoryAddVariable, HistoryAddAttr, HistoryInitialized, HistoryPut, HistoryPutAxisMPI, HistoryAxisCreate, HistoryAxisInquire, HistoryAxisCopy, HistoryVarinfoInquire, HistoryVarinfoCreate, HistoryVarinfoCopy, HistoryVarinfoInitialized, HistoryVarinfoClear implicit none type(GT_HISTORY), intent(inout):: gthist ! gtool_history モジュール用構造体. ! Derived type for "gtool_history" module character(*), intent(in):: varname ! 変数の名前. ! Variable name type(DC_DIFFTIME), intent(in):: time ! 現在時刻. Current time character(TOKEN):: interval_unit ! データの出力間隔の単位. ! Unit for interval of history data output real:: origin_value ! データの出力開始時刻の数値. ! Numerical value for start time of history data output character(TOKEN):: origin_unit ! データの出力開始時刻の単位. ! Unit for start time of history data output type(DC_DIFFTIME):: origin_difftime integer:: newfile_intvalue ! ファイル分割時間間隔. ! Interval of time of separation of a file. character(TOKEN):: newfile_intunit ! ファイル分割時間間隔の単位. ! Unit of interval of time of separation of a file. character(STRING):: file, file_base, file_suffix, file_newfile_time, file_rank ! 出力ファイル名. ! Output file name. integer:: stat, i, j, k, vnum, numdims_slice, dim_size, cnt character(STRING):: name, units, longname, cause_c, wgt_name character(TOKEN):: xtype type(GT_HISTORY_AXIS):: gthst_axes_time type(GT_HISTORY_AXIS), pointer:: gthst_axes_slices(:) =>null() type(GT_HISTORY_AXIS_DATA), pointer:: data_axes_slices(:) =>null() type(GT_HISTORY_AXIS_DATA), pointer:: data_weights_slices(:) =>null() real(DP):: wgt_sum, wgt_sum_s logical:: slice_valid integer:: slice_start(1:numdims-1) ! 空間方向の開始点. ! Start points of spaces. integer:: slice_end(1:numdims-1) ! 空間方向の終了点. ! End points of spaces. integer:: slice_stride(1:numdims-1) ! 空間方向の刻み幅. ! Strides of spaces character(*), parameter:: subname = "HstFileCreate" continue call BeginSub(subname, 'varname=%c', c1 = trim(varname) ) stat = DC_NOERR cause_c = "" ! varname から変数情報の探査 ! Search information of a variable from "varname" ! vnum = 0 do i = 1, numvars call HistoryVarinfoInquire( varinfo = gthst_vars(i), name = name ) ! (out) if ( trim(varname) == trim(name) ) vnum = i end do if ( vnum == 0 ) then stat = HST_EBADVARNAME cause_c = varname goto 999 end if ! 出力が有効かどうかを確認する ! Confirm whether the output is effective ! if ( .not. HstNmlInfoOutputValid( gthstnml, varname ) ) then goto 999 end if ! 出力間隔の単位に応じて時間座標情報の作り直し ! Remake time axis information correspond to units of output interval ! call HstNmlInfoInquire( gthstnml = gthstnml, name = varname, file = file, interval_unit = interval_unit ) ! (out) call HistoryAxisCopy( gthst_axes_time, gthst_axes(numdims), units = trim(interval_unit) // ' ' // trim(time_unit_suffix) ) ! (in) ! 空間方向のスライスに対応して, 座標および座標重み情報の作り直し ! Remake axes and weights information correspond to spatial slices ! call HstNmlInfoInquire( gthstnml = gthstnml, name = varname, slice_start = slice_start, slice_end = slice_end, slice_stride = slice_stride ) ! (out) ! ファイルが未作成の場合は, まずファイル作成 ! At first, the file is created if the file is not created yet ! if ( .not. HistoryInitialized( gthist ) ) then if ( all( slice_start == (/ ( 1, i = 1, numdims -1 ) /) ) .and. all( slice_end < (/ ( 1, i = 1, numdims -1 ) /) ) .and. all( slice_stride == (/ ( 1, i = 1, numdims -1 ) /) ) ) then allocate( gthst_axes_slices (1:numdims) ) gthst_axes_slices(1:numdims-1) = gthst_axes(1:numdims-1) gthst_axes_slices(numdims:numdims) = gthst_axes_time data_axes_slices => data_axes data_weights_slices => data_weights slice_valid = .false. else allocate( gthst_axes_slices (1:numdims) ) allocate( data_axes_slices (1:numdims) ) allocate( data_weights_slices (1:numdims) ) do i = 1, numdims-1 ! スライス値の有効性をチェック ! Check validity of slices ! if ( slice_start(i) < 1 ) then stat = HST_EBADSLICE cause_c = CPrintf('slice_start=%d', i = (/ slice_start(i) /) ) goto 999 end if if ( slice_stride(i) < 1 ) then stat = HST_EBADSLICE cause_c = CPrintf('slice_stride=%d', i = (/ slice_stride(i) /) ) goto 999 end if ! 再生成の必要性をチェック ! Check necessity of remaking ! if ( ( slice_start(i) == 1 ) .and. ( slice_end(i) < 1 ) .and. ( slice_stride(i) == 1 ) ) then call HistoryAxisCopy( axis_dest = gthst_axes_slices(i) , axis_src = gthst_axes(i) ) ! (in) data_axes_slices (i) = data_axes (i) cycle end if ! 座標情報の再生成 ! Remake information of axis ! call HistoryAxisInquire( axis = gthst_axes(i), name = name, size = dim_size, longname = longname, units = units, xtype = xtype ) ! (out) ! 終点のスライス値の補正 ; Correct end points of slices if ( slice_end(i) < 1 ) slice_end(i) = dim_size if ( slice_end(i) > dim_size ) then call MessageNotify( 'W', subname, 'slice options to (%c) are undesirable ' // '(@slice_end=%d). @slice_end is corrected forcibly to (%d) ', c1 = trim(name), i = (/ slice_end(i), dim_size /) ) slice_end(i) = dim_size end if ! スライス値の有効性をチェック ; Check validity of slices if ( slice_start(i) > slice_end(i) ) then stat = HST_EBADSLICE cause_c = CPrintf('slice_start=%d, slice_end=%d', i = (/ slice_start(i), slice_end(i) /) ) goto 999 end if numdims_slice = int( ( slice_end(i) - slice_start(i) + 1 ) / slice_stride(i) ) ! スライス値の有効性をチェック ; Check validity of slices if ( numdims_slice < 1 ) then call MessageNotify( 'W', subname, 'slice options to (%c) are invalid. ' // '(@slice_start=%d @slice_end=%d @slice_stride=%d)', c1 = trim(name), i = (/ slice_start(i), slice_end(i), slice_stride(i) /) ) stat = HST_EBADSLICE cause_c = CPrintf('slice_start=%d, slice_end=%d, slice_stride=%d', i = (/ slice_start(i), slice_end(i), slice_stride(i) /) ) goto 999 end if call HistoryAxisCreate( axis = gthst_axes_slices(i), name = name, size = numdims_slice, longname = longname, units = units, xtype = xtype ) ! (in) ! 座標データの再生成 ! Regenerate data of axis ! allocate( data_axes_slices(i) % a_axis( numdims_slice ) ) cnt = 1 do j = slice_start(i), slice_end(i), slice_stride(i) data_axes_slices(i) % a_axis( cnt ) = data_axes(i) % a_axis( j ) cnt = cnt + 1 end do ! 座標重みデータの再生成 ! Remake information of axis data ! do j = 1, numwgts call HistoryVarinfoInquire( varinfo = gthst_weights(j), name = wgt_name ) ! (out) optional if ( trim(name) // wgtsuf == trim(wgt_name) ) then ! 座標重みの計算は結構いい加減... ! Calculation about axis weight is irresponsible... ! wgt_sum = sum( data_weights(j) % a_axis ) allocate( data_weights_slices(j) % a_axis( numdims_slice ) ) cnt = 1 do k = slice_start(i), slice_end(i), slice_stride(i) data_weights_slices(j) % a_axis( cnt ) = data_weights(j) % a_axis( k ) cnt = cnt + 1 end do wgt_sum_s = sum( data_weights_slices(j) % a_axis ) data_weights_slices(j) % a_axis = data_weights_slices(j) % a_axis * ( wgt_sum / wgt_sum_s ) end if end do end do ! 空間切り出しされていない座標に関する座標重みデータを作成 ! Make data of axis weight not sliced ! do i = 1, numwgts if ( .not. associated( data_weights_slices(i) % a_axis ) ) then allocate( data_weights_slices(i) % a_axis( size(data_weights(i) % a_axis ) ) ) data_weights_slices(i) % a_axis = data_weights (i) % a_axis end if end do ! 時刻次元のコピー ! Copy time dimension ! gthst_axes_slices(numdims) = gthst_axes_time slice_valid = .true. end if ! HistoryCreate のための設定値の取得 ! Get the settings for "HistoryCreate" ! call HstNmlInfoInquire( gthstnml = gthstnml, name = varname, file = file, origin_value = origin_value, origin_unit = origin_unit, interval_unit = interval_unit, newfile_intvalue = newfile_intvalue, newfile_intunit = newfile_intunit ) ! (out) ! データ出力時刻の設定 ! Configure data output time ! call DCDiffTimeCreate( origin_difftime, origin_value, origin_unit ) ! (in) if ( newfile_intvalue < 1 ) then origin_value = EvalbyUnit( origin_difftime, interval_unit ) else origin_value = EvalbyUnit( time, interval_unit ) end if ! ファイル名の設定 ! Configure file name ! if ( len_trim( file ) - index(file, '.nc', .true.) == 2 ) then file_base = file(1:len_trim( file ) - 3) file_suffix = '.nc' else file_base = file file_suffix = '' end if if ( trim(rank_save) == '' ) then file_rank = '' else file_rank = '_rank' // trim( adjustl(rank_save) ) end if if ( newfile_intvalue > 0 ) then file_newfile_time = CPrintf( '_time%08d', i = (/ int( EvalbyUnit( time, newfile_intunit ) ) /) ) else file_newfile_time = '' end if file = trim(file_base) // trim(file_rank) // trim(file_newfile_time) // trim(file_suffix) ! HistoryCreate によるファイル作成 ! Files are created by "HistoryCreate" ! call HistoryCreate( history = gthist, file = file, title = title_save, source = source_save, institution = institution_save, axes = gthst_axes_slices(1:numdims), origin = origin_value, flag_mpi_split = save_mpi_split, flag_mpi_gather = save_mpi_gather ) ! (in) ! 座標データを出力 ! Output axes data ! do i = 1, numdims - 1 call HistoryAxisInquire( axis = gthst_axes_slices(i), name = name ) ! (out) call HistoryPut( history = gthist, varname = name, array = data_axes_slices(i) % a_axis ) ! (in) end do ! MPI 用に領域全体の座標データを出力 ! Output axes data in whole area for MPI ! if ( save_mpi_gather ) then do i = 1, numdims - 1 call HistoryAxisInquire( axis = gthst_axes_slices(i), name = name ) ! (out) if ( .not. associated( data_axes_whole(i) % a_axis ) ) then call MessageNotify('W', subname, 'data of axis (%c) in whole area is lack. ' // 'Specify the data by "HistoryAutoPutAxisMPI" explicitly.', c1 = trim(name) ) stat = HST_EMPINOAXISDATA cause_c = name end if call HistoryPutAxisMPI( history = gthist, varname = name, array = data_axes_whole(i) % a_axis ) ! (in) end do end if ! 割付解除 ! Deallocation ! if ( slice_valid ) then deallocate( gthst_axes_slices ) deallocate( data_axes_slices ) else deallocate( gthst_axes_slices ) nullify( data_axes_slices ) end if ! 座標重みデータを追加 ! Add axes weights data ! do i = 1, numwgts call HistoryAddVariable( history = gthist, varinfo = gthst_weights(i) ) ! (in) call HistoryVarinfoInquire( varinfo = gthst_weights(i), name = name ) ! (out) call HistoryPut( history = gthist, varname = name, array = data_weights_slices(i) % a_axis ) ! (in) end do if ( slice_valid ) then deallocate( data_weights_slices ) else nullify( data_weights_slices ) end if ! ファイル作成おしまい; Creation of file is finished end if ! 変数情報を追加 ! Add information of variables ! call HistoryAddVariable( varinfo = gthst_vars(vnum), history = gthist ) ! (inout) optional 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HstFileCreate
Subroutine : | |||
time : | type(DC_DIFFTIME), intent(in)
| ||
stime_index : | integer, intent(out) |
与えられた時刻 time が各変数にとって出力のタイミングかどうかを 調査して output_timing_vars, output_timing_avr_vars, create_timing_vars, close_timing_vars, renew_timing_vars, へ反映し, time に対応する saved_time の配列添字を stime_index へ返します.
また, ファイルのオープンクローズのタイミングであれば, それらもこのサブルーチン内で行います.
It is investigated whether "time" is output timing for each variable, and the information is reflected to "output_timing_vars", "output_timing_avr_vars", "create_timing_vars", "close_timing_vars", "renew_timing_vars". And index of array "saved_time" is returned to "stime_index".
And if current time is timing of open/close of files, they are done in this subroutine.
subroutine HstVarsOutputCheck ( time, stime_index ) ! ! 与えられた時刻 *time* が各変数にとって出力のタイミングかどうかを ! 調査して output_timing_vars, output_timing_avr_vars, ! create_timing_vars, close_timing_vars, renew_timing_vars, ! へ反映し, *time* に対応する ! saved_time の配列添字を stime_index へ返します. ! ! また, ファイルのオープンクローズのタイミングであれば, ! それらもこのサブルーチン内で行います. ! ! It is investigated whether "time" is output timing for ! each variable, and the information is reflected to ! "output_timing_vars", "output_timing_avr_vars", ! "create_timing_vars", "close_timing_vars", "renew_timing_vars". ! And index of array "saved_time" is returned to "stime_index". ! ! And if current time is timing of open/close of files, ! they are done in this subroutine. ! use dc_trace, only: BeginSub, EndSub, DbgMessage use dc_error, only: StoreError, DC_NOERR use gtool_history, only: HistoryInitialized, HistoryClose use dc_date_types, only: DC_DIFFTIME use dc_date, only: operator(==), operator(>), operator(<), operator(>=), operator(<=), operator(-), DCDiffTimePutLine, EvalSec implicit none type(DC_DIFFTIME), intent(in):: time ! 現在時刻. Current time integer, intent(out):: stime_index integer:: tstep integer:: stat, i, startnum, endnum character(STRING):: cause_c character(*), parameter:: subname = "HstVarsOutputCheck" continue call BeginSub(subname) stat = DC_NOERR cause_c = "" ! 与えられた時刻がチェック済みかどうかを調べる ! Examine whether given time is already checked or not ! TimeStepSearch: do do i = saved_tstep, checked_tstepnum if ( saved_time(i) == time ) then tstep = i exit TimeStepSearch end if end do do i = 1, saved_tstep - 1 if ( saved_time(i) == time ) then tstep = i exit TimeStepSearch end if end do tstep = 0 exit TimeStepSearch end do TimeStepSearch saved_tstep = tstep if ( saved_tstep /= 0 .and. checked_tstep_varnum == numvars ) then ! * output_timing_vars(:,saved_tstep) を使う. ! * saved_tstep を stime_index として返す. stime_index = saved_tstep call DbgMessage( 'saved_tstep=<%d> is already checked.', i =(/ saved_tstep /) ) goto 999 end if ! チェックする時間ステップと, 変数 ID の設定 ! Configure checked time step, and variable ID ! if ( saved_tstep /= 0 ) then startnum = checked_tstep_varnum + 1 endnum = numvars stime_index = saved_tstep else startnum = 1 endnum = numvars if ( save_tstepnum < 2 ) then checked_tstepnum = 1 saved_time(checked_tstepnum) = time saved_tstep = checked_tstepnum stime_index = saved_tstep elseif ( .not. checked_tstepnum < save_tstepnum ) then create_timing_vars(:,1:checked_tstepnum-1) = create_timing_vars(:,2:checked_tstepnum) close_timing_vars(:,1:checked_tstepnum-1) = close_timing_vars(:,2:checked_tstepnum) renew_timing_vars(:,1:checked_tstepnum-1) = renew_timing_vars(:,2:checked_tstepnum) output_timing_vars(:,1:checked_tstepnum-1) = output_timing_vars(:,2:checked_tstepnum) output_timing_avr_vars(:,1:checked_tstepnum-1) = output_timing_avr_vars(:,2:checked_tstepnum) saved_time(1:checked_tstepnum-1) = saved_time(2:checked_tstepnum) saved_time(checked_tstepnum) = time saved_tstep = checked_tstepnum stime_index = saved_tstep else checked_tstepnum = checked_tstepnum + 1 saved_time(checked_tstepnum) = time saved_tstep = checked_tstepnum stime_index = saved_tstep end if end if call DbgMessage( 'numvar=<%d:%d> in saved_tstep=<%d> will be checked from now.', i =(/ startnum, endnum, saved_tstep /) ) ! * output_timing_vars(:,2:3) を output_timing_vars(:,1:2) へ ! * saved_time(2:3) を saved_time(1:2) へ ! * time を saved_time(3) へ ! * saved_tstep = checked_tstepnum とする. ! * stime_index = saved_tstep とする. ! * タイミングチェックして output_timing_vars(:,3) へ create_timing_vars(startnum:endnum, checked_tstepnum:checked_tstepnum) = .false. close_timing_vars(startnum:endnum, checked_tstepnum:checked_tstepnum) = .false. renew_timing_vars(startnum:endnum, checked_tstepnum:checked_tstepnum) = .false. output_timing_vars(startnum:endnum, checked_tstepnum:checked_tstepnum) = .false. output_timing_avr_vars(startnum:endnum, checked_tstepnum:checked_tstepnum) = .false. do i = startnum, endnum if ( .not. output_valid_vars(i) ) cycle if ( origin_time_vars(i) > time ) cycle if ( origin_time_vars(i) <= time .and. ( terminus_time_vars(i) < zero_time .or. terminus_time_vars(i) >= time ) .and. .not. histaddvar_vars(i) ) then create_timing_vars(i,checked_tstepnum) = .true. if ( newfile_inttime_vars(i) > zero_time ) then newfile_createtime_vars(i) = time end if output_timing_vars(i,checked_tstepnum) = .true. output_timing_avr_vars(i,checked_tstepnum) = tavr_vars(i) cycle end if if ( terminus_time_vars(i) > zero_time .and. terminus_time_vars(i) < time ) then close_timing_vars(i,checked_tstepnum) = .true. output_timing_vars(i,checked_tstepnum) = .false. output_timing_avr_vars(i,checked_tstepnum) = .false. cycle end if ! * newfile_inttime_vars だけでは, ぴったり一致しないとうまく行かない. ! * そこで... ! * 前回に出力した時刻を記憶しておく. ! * 前回の時刻と今回の時刻の差が newfile_inttime_vars ! よりも大きい場合には現ファイルを閉じ, 新ファイルを作成する. if ( newfile_inttime_vars(i) > zero_time ) then if ( time - newfile_createtime_vars(i) >= newfile_inttime_vars(i) ) then renew_timing_vars(i,checked_tstepnum) = .true. output_timing_vars(i,checked_tstepnum) = .true. output_timing_avr_vars(i,checked_tstepnum) = tavr_vars(i) cycle end if end if if ( time - prev_outtime_vars(i) >= interval_time_vars(i) ) then output_timing_vars(i,checked_tstepnum) = .true. output_timing_avr_vars(i,checked_tstepnum) = tavr_vars(i) cycle end if output_timing_vars(i,checked_tstepnum) = .false. output_timing_avr_vars(i,checked_tstepnum) = tavr_vars(i) end do checked_tstep_varnum = numvars 999 continue call StoreError(stat, subname, cause_c = cause_c) call EndSub(subname) end subroutine HstVarsOutputCheck
Constant : | |||
MAX_VARS = 256 : | integer, parameter
|
Derived Type : | |||
st(:) =>null() : | integer, pointer
| ||
ed(:) =>null() : | integer, pointer
| ||
sd(:) =>null() : | integer, pointer
|
空間切り出し情報管理用の構造型 Derived type for information of slice of space
Derived Type : | |||
avr(:) =>null() : | logical, pointer
|
空間平均情報管理用の構造型 Derived type for information of average in space direction
Variable : | |||
checked_tstep_varnum = 0 : | integer, save
|
Variable : | |||
checked_tstepnum = 0 : | integer, save
|
Variable : | |||
close_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. : | logical, save
|
Variable : | |||
create_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. : | logical, save
|
Variable : | |||
histaddvar_vars(1:MAX_VARS) = .false. : | logical, save
|
Variable : | |||
interval_time_vars(1:MAX_VARS) : | type(DC_DIFFTIME), save
|
Variable : | |||
newfile_createtime_vars(1:MAX_VARS) : | type(DC_DIFFTIME), save
|
Variable : | |||
newfile_inttime_vars(1:MAX_VARS) : | type(DC_DIFFTIME), save
|
Variable : | |||
origin_time_vars(1:MAX_VARS) : | type(DC_DIFFTIME), save
|
Variable : | |||
output_timing_avr_vars(1:MAX_VARS, 1:save_tstepnum) = .false. : | logical, save
|
Variable : | |||
output_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. : | logical, save
|
Variable : | |||
output_valid_vars(1:MAX_VARS) = .false. : | logical, save
|
Variable : | |||
prev_outtime_vars(1:MAX_VARS) : | type(DC_DIFFTIME), save
|
Variable : | |||
renew_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. : | logical, save
|
Constant : | |||
save_tstepnum = 1 : | integer, parameter
|
Variable : | |||
saved_tstep = 1 : | integer, save
|
Variable : | |||
tavr_vars(1:MAX_VARS) = .false. : | logical, save
|
Variable : | |||
terminus_time_vars(1:MAX_VARS) : | type(DC_DIFFTIME), save
|
Constant : | |
version = ’$Name: gtool5-20090324 $’ // ’$Id: gtool_historyauto.f90,v 1.1 2009-03-20 09:09:50 morikawa Exp $’ : | character(*), parameter |