Class gt4_historyauto
In: gt4_historyauto.f90

gtool4 netCDF データの入出力インターフェース (大規模モデル用)

Interface of Input/Output of gtool4 netCDF data (For large models)

Note that Japanese and English are described in parallel.

gt4_historyauto モジュールは gt4_history モジュールの応用版であり, 出力変数が 10 を超えるような大規模な数値モデルを想定した, データ出力のための簡便なインターフェースを 提供します. このモジュールは以下のような特徴を持ちます.

  • 複数のファイルへの出力を行う場合, gt4_history モジュールではファイルごとに gt4_history#HistoryCreate を何度も 呼び出す必要がありましたが, このモジュールでは HistoryAutoCreate をモデル内で一度呼び出すだけで済みます.
  • 個別の変数について, 出力ファイルや出力間隔を手軽に変更可能です. 実際には, HistoryAutoAddVariable の引数もしくは, NAMELIST#gt4_historyauto_nml によって変更することが可能です.
  • gt4_history#GT_HISTORY 構造体を直接使用することなく 出力を行うことが可能となっています.

"gt4_historyauto" module is an application of "gt4_history" module, and provides data output easy-to-use interfaces for large numerical models that output 10 or more variables. This module has following features.

Procedures list

HistoryAutoCreate :初期化
HistoryAutoAddVariable :変数追加
HistoryAutoPut :データ出力
HistoryAutoProgress :時刻進行
HistoryAutoClose :終了処理
HistoryAutoPutAxis :座標データ追加
HistoryAutoAddWeight :座標重み追加
HistoryAutoAddAttr :属性追加
——————— :———————
HistoryAutoCreate :Initialization
HistoryAutoAddVariable :Addition of variables
HistoryAutoPut :Output of data
HistoryAutoProgress :Progression of time
HistoryAutoClose :Termination
HistoryAutoPutAxis :Addition of data of axes
HistoryAutoAddWeight :Addition of weights of axes
HistoryAutoAddAttr :Addition of attributes

NAMELIST

NAMELIST#gt4_historyauto_nml

Acknowledgment

Methods

AXES_WEIGHT   AverageReduceDouble1   AverageReduceDouble2   AverageReduceDouble3   AverageReduceDouble4   AverageReduceDouble5   AverageReduceDouble6   AverageReduceDouble7   AverageReduceInt1   AverageReduceInt2   AverageReduceInt3   AverageReduceInt4   AverageReduceInt5   AverageReduceInt6   AverageReduceInt7   AverageReduceReal1   AverageReduceReal2   AverageReduceReal3   AverageReduceReal4   AverageReduceReal5   AverageReduceReal6   AverageReduceReal7   GT_HISTORY_AXIS_DATA   GT_HISTORY_DUMMY   HistoryAutoAddAttr   HistoryAutoAddAttr   HistoryAutoAddAttr   HistoryAutoAddAttr   HistoryAutoAddAttr   HistoryAutoAddAttr   HistoryAutoAddAttr   HistoryAutoAddAttr   HistoryAutoAddAttrChar0   HistoryAutoAddAttrDouble0   HistoryAutoAddAttrDouble1   HistoryAutoAddAttrInt0   HistoryAutoAddAttrInt1   HistoryAutoAddAttrLogical0   HistoryAutoAddAttrReal0   HistoryAutoAddAttrReal1   HistoryAutoAddVariable   HistoryAutoAddVariable1   HistoryAutoAddWeight   HistoryAutoAddWeight   HistoryAutoAddWeight   HistoryAutoAddWeightDouble   HistoryAutoAddWeightInt   HistoryAutoAddWeightReal   HistoryAutoClose   HistoryAutoClose1   HistoryAutoCreate   HistoryAutoCreate1   HistoryAutoProgress   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPut   HistoryAutoPutAxis   HistoryAutoPutAxis   HistoryAutoPutAxis   HistoryAutoPutAxisDouble   HistoryAutoPutAxisInt   HistoryAutoPutAxisReal   HistoryAutoPutDouble0   HistoryAutoPutDouble1   HistoryAutoPutDouble2   HistoryAutoPutDouble3   HistoryAutoPutDouble4   HistoryAutoPutDouble5   HistoryAutoPutDouble6   HistoryAutoPutDouble7   HistoryAutoPutInt0   HistoryAutoPutInt1   HistoryAutoPutInt2   HistoryAutoPutInt3   HistoryAutoPutInt4   HistoryAutoPutInt5   HistoryAutoPutInt6   HistoryAutoPutInt7   HistoryAutoPutReal0   HistoryAutoPutReal1   HistoryAutoPutReal2   HistoryAutoPutReal3   HistoryAutoPutReal4   HistoryAutoPutReal5   HistoryAutoPutReal6   HistoryAutoPutReal7   HstFileCreate   HstVarsOutputCheck   MAX_DIMS_DEPENDED_BY_VAR   Nstep   SLICE_INFO   SPACE_AVR_INFO   all_output_save   conventions_save   current_difftime   data_axes   data_weights   delta_difftime   deltime_value_vars   gt_version_save   gthst_axes   gthst_history_vars   gthst_vars   gthst_weights   gthstnml   initialized   institution_save   intstep_vars   max_remainder_range   newfile_intstep_vars   numdims   numvars   numwgts   once_progressed   origin_value_vars   originstep_vars   output_timing_vars   output_valid_vars   rank_save   slice_vars   source_save   space_avr_vars   start_difftime   sub_sname   tavr_vars   terminusstep_vars   time_unit_bycreate   title_save   varname_vars   version   weight_vars   wgtsuf  

Included Modules

gt4_history gt4_history_nmlinfo netcdf_f77 dc_date_types dc_types dc_trace dc_error dc_string dc_present dc_date dc_message dc_iounit

Public Instance methods

HistoryAutoAddAttr( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
: 変数の名前.

ここで指定するものは, HistoryAutoCreate の dims , または HistoryAutoAddWeight の varname で既に指定されてい なければなりません.

Name of a variable.

This must be specified with dims in HistoryAutoCreate, or varname in "HistoryAutoAddWeight".

attrname :character(*), intent(in)
: 属性の名前. Name of an attribute.
value :character(*), intent(in)
: 属性の値. Value of an attribute.

座標変数および座標重み変数に属性を付加します. このサブルーチンを用いる前に, HistoryAutoCreate による初期設定が 必要です.

  • 座標変数については, HistoryAutoCreate の "dims" に与えられた もののみ指定可能です.
  • 座標重み変数については, HistoryAutoAddWeight で与えられた もののみ指定可能です.
  • HistoryAutoAddAttr は複数のサブルーチンの総称名です. value にはいくつかの型を与えることが可能です. 下記のサブルーチンを参照ください.

Add attributes axes or weights of axes. Initialization by "HistoryAutoCreate" is needed before use of this subroutine.

Alias for HistoryAutoAddAttrChar0

HistoryAutoAddAttr( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :integer, intent(in)

Alias for HistoryAutoAddAttrInt0

HistoryAutoAddAttr( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :logical, intent(in)

Alias for HistoryAutoAddAttrLogical0

HistoryAutoAddAttr( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :real(DP), intent(in)

Alias for HistoryAutoAddAttrDouble0

HistoryAutoAddAttr( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :real, intent(in)

Alias for HistoryAutoAddAttrReal0

HistoryAutoAddAttr( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :integer, intent(in)

Alias for HistoryAutoAddAttrInt1

HistoryAutoAddAttr( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :real(DP), intent(in)

Alias for HistoryAutoAddAttrDouble1

HistoryAutoAddAttr( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :real, intent(in)

Alias for HistoryAutoAddAttrReal1

HistoryAutoAddVariable( varname, dims, longname, units, [xtype], [time_units], [time_average], [file], [origin], [terminus], [interval], [slice_start], [slice_end], [slice_stride], [space_average], [newfile_interval] )
Subroutine :
varname :character(*), intent(in)
: 変数名. Variable name
dims(:) :character(*), intent(in)
: 変数が依存する次元の名前. 時間の次元は配列の最後に指定すること.

Names of dependency dimensions of a variable. Dimension of time must be specified to last of an array.

longname :character(*), intent(in)
: 変数の記述的名称.

Descriptive name of a variable

units :character(*), intent(in)
: 変数の単位.

Units of a variable

xtype :character(*), intent(in), optional
: 変数のデータ型

デフォルトは 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.

time_units :character(*), intent(in), optional
: 時刻次元の単位. Units of time dimension.
time_average :logical, intent(in), optional
: 出力データを時間平均する場合には .true. を与えます. デフォルトは .false. です.

If output data is averaged, specify ".true.". Default is ".false.".

file :character(*), intent(in), optional
: 出力ファイル名. Output file name.
origin :real, intent(in), optional
: 出力開始時刻.

省略した場合, 自動的に current_time の値が 設定されます.

Start time of output.

If this argument is omitted, a value of "current_time" is specified automatically.

terminus :real, intent(in), optional
: 出力終了時刻.

省略した場合, 数値モデルの実行が終了するまで 出力を行います.

End time of output.

If this argument is omitted, output is continued until a numerical model is finished.

interval :real, intent(in), optional
: 出力時間間隔.

省略した場合, 自動的に delta_time の値が設定されます.

Interval of output time.

If this argument is omitted, a value of "delta_time" is specified automatically.

slice_start(:) :integer, intent(in), optional
: 空間方向の開始点.

省略した場合, 座標データの開始点が設定されます.

Start points of spaces.

If this argument is omitted, start points of dimensions are set.

slice_end(:) :integer, intent(in), optional
: 空間方向の終了点.

省略した場合, 座標データの終了点が設定されます.

End points of spaces.

If this argument is omitted, End points of dimensions are set.

slice_stride(:) :integer, intent(in), optional
: 空間方向の刻み幅.

省略した場合, 1 が設定されます.

Strides of spaces

If this argument is omitted, 1 is set.

space_average(:) :logical, intent(in), optional
: 平均化のフラグ.

.true. が指定される座標に対して平均化を 行います. 省略した場合, .false. が設定されます.

Flag of average.

Axes specified .true. are averaged. If this argument is omitted, .false. is set.

newfile_interval :integer, intent(in), optional
: ファイル分割時間間隔.

省略した場合, 時間方向へのファイル分割を行いません.

Interval of time of separation of a file.

If this argument is omitted, a files is not separated in time direction.

ヒストリデータ出力するための変数登録を行います.

HistoryAutoProgress を呼ぶ前にこのサブルーチンを使用してください.

Register variables for history data output

Use this subroutine before "HistoryAutoProgress" is called.

Alias for HistoryAutoAddVariable1

HistoryAutoAddWeight( dim, weight, [units], [xtype] )
Subroutine :
dim :character(*), intent(in)
: 座標重みを設定する座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis to which "weight" are set.

Note that this value must be set as "dims" of "HistoryAutoCreate".

weight(:) :integer, intent(in)
: 座標重みデータ.

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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.

units :character(*), intent(in), optional
: 座標重みの単位. 省略した場合には, 座標の単位が 使用されます.

Units of axis weight. If this argument is omitted, unit of the dimension is used.

xtype :character(*), intent(in), optional
: 座標重みのデータ型. 省略した場合には, 座標のデータ型が 使用されます.

Data type of weight of the dimension. If this argument is omitted, data type of the dimension is used.

座標の重みデータを設定します.

Set weights of axes.

Alias for HistoryAutoAddWeightInt

HistoryAutoAddWeight( dim, weight, [units], [xtype] )
Subroutine :
dim :character(*), intent(in)
: 座標重みを設定する座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis to which "weight" are set.

Note that this value must be set as "dims" of "HistoryAutoCreate".

weight(:) :real(DP), intent(in)
: 座標重みデータ.

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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.

units :character(*), intent(in), optional
: 座標重みの単位. 省略した場合には, 座標の単位が 使用されます.

Units of axis weight. If this argument is omitted, unit of the dimension is used.

xtype :character(*), intent(in), optional
: 座標重みのデータ型. 省略した場合には, 座標のデータ型が 使用されます.

Data type of weight of the dimension. If this argument is omitted, data type of the dimension is used.

座標の重みデータを設定します.

Set weights of axes.

Alias for HistoryAutoAddWeightDouble

HistoryAutoAddWeight( dim, weight, [units], [xtype] )
Subroutine :
dim :character(*), intent(in)
: 座標重みを設定する座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis to which "weight" are set.

Note that this value must be set as "dims" of "HistoryAutoCreate".

weight(:) :real, intent(in)
: 座標重みデータ.

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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.

units :character(*), intent(in), optional
: 座標重みの単位. 省略した場合には, 座標の単位が 使用されます.

Units of axis weight. If this argument is omitted, unit of the dimension is used.

xtype :character(*), intent(in), optional
: 座標重みのデータ型. 省略した場合には, 座標のデータ型が 使用されます.

Data type of weight of the dimension. If this argument is omitted, data type of the dimension is used.

座標の重みデータを設定します.

Set weights of axes.

Alias for HistoryAutoAddWeightReal

HistoryAutoClose( )
Subroutine :

HistoryAutoCreate で始まったデータ出力の終了処理を行います. プログラムを終了する前に必ずこのサブルーチンを呼んでください.

Terminates data output with "HistoryAutoCreate". Call this subroutine certainly before a progrem is finished.

Alias for HistoryAutoClose1

HistoryAutoCreate( title, source, institution, dims, dimsizes, longnames, units, [xtypes], [conventions], [gt_version], [all_output], [file_prefix], [namelist_filename], [current_time], [delta_time], [interval], [origin], [terminus], [slice_start], [slice_end], [slice_stride], [space_average], [time_average], [newfile_interval], [rank] )
Subroutine :
title :character(*), intent(in)
: データ全体の表題. Title of entire data
source :character(*), intent(in)
: データを作成する際の手段. Source of data file
institution :character(*), intent(in)
: ファイルを最終的に変更した組織/個人. Institution or person that changes files for the last time
dims(:) :character(*), intent(in)
: 次元の名前.

配列の大きさに制限はありません. 個々の次元の文字数は 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.

dimsizes(:) :integer, intent(in)
: dims で指定したそれぞれの次元大きさ.

配列の大きさは dims の大きさと等しい 必要があります. ‘0’ (数字のゼロ) を指定 するとその次元は 無制限次元 (unlimited dimension) となります. (gt4_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 "gt4_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

longnames(:) :character(*), intent(in)
: 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.

units(:) :character(*), intent(in)
: 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.

xtypes(:) :character(*), intent(in), optional
: 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.

conventions :character(*), intent(in), optional
: 出力するファイルの 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.

gt_version :character(*), intent(in), optional
: 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).

all_output :logical, intent(in), optional
: 登録変数を全て出力するためのフラグ.

.true. を指定すると, HistoryAutoAddVariable で登録された 変数が全て出力されるようになります.

namelist_filename が指定される場合 には, デフォルトは .false. となります. この場合には, namelist_filename に指定された NAMELIST ファイルから読み込まれる NAMELIST#gt4_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#gt4_historyauto_nml" loaded from a NAMELIST file namelist_filename.

If namelist_filename is not specified, this value becomes .true. .

file_prefix :character(*), intent(in), optional
: ヒストリデータのファイル名の接頭詞. Prefixes of history data filenames
namelist_filename :character(*), intent(in), optional
: NAMELIST ファイルの名称.

省略した場合, もしくは空白文字を与えた場合, NAMELIST ファイルは読み込みません.

Name of NAMELIST file.

If this argument is omitted, or blanks are specified, no NAMELIST file is loaded.

current_time :real, intent(in), optional
: 数値モデル内の現在時刻 (単位: 秒).

省略した場合, 自動的にゼロが設定されます.

Current time in a numerical model (unit: seconds).

If this argument is omitted, zero is set automatically.

delta_time :real, intent(in), optional
: 数値モデル内のタイムステップ (単位: 秒).

省略した場合, 自動的に 1.0 が設定されます.

Time step in a numerical model (unit: seconds).

If this argument is omitted, 1.0 is set automatically.

interval :real, intent(in), optional
: 出力時間間隔.

省略した場合, 自動的に delta_time の値が設定されます.

Interval of output time.

If this argument is omitted, a value of "delta_time" is specified automatically.

origin :real, intent(in), optional
: 出力開始時刻.

省略した場合, 自動的に current_time の値が 設定されます.

Start time of output.

If this argument is omitted, a value of "current_time" is specified automatically.

terminus :real, intent(in), optional
: 出力終了時刻.

省略した場合, 数値モデルの実行が終了するまで 出力を行います.

End time of output.

If this argument is omitted, output is continued until a numerical model is finished.

slice_start(:) :integer, intent(in), optional
: 空間方向の開始点.

省略した場合, 座標データの開始点が設定されます.

Start points of spaces.

If this argument is omitted, start points of dimensions are set.

slice_end(:) :integer, intent(in), optional
: 空間方向の終了点.

省略した場合, 座標データの終了点が設定されます.

End points of spaces.

If this argument is omitted, End points of dimensions are set.

slice_stride(:) :integer, intent(in), optional
: 空間方向の刻み幅.

省略した場合, 1 が設定されます.

Strides of spaces

If this argument is omitted, 1 is set.

space_average(:) :logical, intent(in), optional
: 平均化のフラグ.

.true. が指定される座標に対して平均化を 行います. 省略した場合, .false. が設定されます.

Flag of average.

Axes specified .true. are averaged. If this argument is omitted, .false. is set.

time_average :logical, intent(in), optional
: 出力データの時間平均フラグ. デフォルトは .false. Flag for time average of output data Default value is .false.
newfile_interval :integer, intent(in), optional
: ファイル分割時間間隔.

省略した場合, 時間方向へのファイル分割を行いません.

Interval of time of separation of a file.

If this argument is omitted, a files is not separated in time direction.

rank :character(*), intent(in), optional
: ランクの名称.

Name of a rank.

複数のヒストリデータ出力を行うための初期化を行います.

この HistoryAutoCreate には, モデル内で出力する 変数が依存する座標や座標重みなどを全てを設定してください.

all_output に .true. を与えた場合や, namelist_filename を与えない (空文字を与える) 場合には, HistoryAutoAddVariable で登録される全ての変数が出力されます. 一方で namelist_filename に NAMELIST ファイル名を与える場合には, その NAMELIST ファイルから出力のオンオフや, 出力ファイル名, 出力間隔などを変更可能です. 変更可能な項目に関しては NAMELIST#gt4_historyauto_nml を参照して下さい.

interval, origin, terminus, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval などの設定はデフォルト値として使用されます. これらの設定値は HistoryAutoAddVariable および NAMELIST#gt4_historyauto_nml で上書きされます. (優先度が高いのは NAMELIST#gt4_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#gt4_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#gt4_historyauto_nml". ("NAMELIST#gt4_historyauto_nml" is high priority, arguments of "HistoryAutoAddVariable" are medium, arguments of "HistoryAutoCreate" are low).

This procedure input/output NAMELIST#gt4_historyauto_nml .

Alias for HistoryAutoCreate1

HistoryAutoProgress( )
Subroutine :

時刻を進めます.

時刻は HistoryAutoCreate の delta_time で指定された分 (省略した場合は 1.0) だけ進みます.

HistoryAutoAddVariable はサブルーチンを呼ぶ前に, 使用してください.

一度目に呼んだ際には, 以下の事を行います.

  • NAMELIST から読み込んだ値に無効なものが存在したかどうかをチェック
  • HistoryAutoAddVariable で登録した変数群を印字

Progress time.

Time is progressed to the extent that specified with "delta_time" of "HistoryAutoCreate" (1.0 when omitting "delta_time").

Use "HistoryAutoAddVariable" before this subroutine is called.

When this subroutine called at first, following things are done.

[Source]

  subroutine HistoryAutoProgress
    !
    ! 時刻を進めます. 
    ! 
    ! 時刻は HistoryAutoCreate の delta_time で指定された分
    ! (省略した場合は 1.0) だけ進みます. 
    !
    ! HistoryAutoAddVariable はサブルーチンを呼ぶ前に, 
    ! 使用してください. 
    !
    ! 一度目に呼んだ際には, 以下の事を行います. 
    ! 
    ! * NAMELIST から読み込んだ値に無効なものが存在したかどうかをチェック
    ! * HistoryAutoAddVariable で登録した変数群を印字
    !
    !
    ! Progress time. 
    !
    ! Time is progressed to the extent that specified with
    ! "delta_time" of "HistoryAutoCreate" (1.0 when omitting
    ! "delta_time").
    !
    ! Use "HistoryAutoAddVariable" before this subroutine is called. 
    !
    ! When this subroutine called at first, following things are done.
    ! 
    ! * Check that invalid values are loaded from NAMELIST or not. 
    ! * Print registered variables by "HistoryAutoAddVariable"
    !
    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 gt4_history, only: HistoryVarinfoInquire
    use gt4_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:: stat, i
    character(STRING):: cause_c
    character(*), parameter:: subname = "HistoryAutoProgress"
  continue
    call BeginSub(subname)
    stat = DC_NOERR
    cause_c = ""

    ! 初期設定チェック
    ! Check initialization
    !
    if ( .not. initialized ) then
      stat = DC_ENOTINIT
      cause_c = 'gt4_historyauto'
      goto 999
    end if

    ! 無効な変数名のチェック (初回のみ)
    ! Check invalid variable names (at only first time)
    !
    if ( Nstep == 0 ) then
      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 "gt4_historyauto_nml" are invalid.', c1 = trim(names_invalid) )
        goto 999
      end if

    end if

    ! 登録された変数の印字 (初回のみ)
    ! Print registered variables (at only first time)
    !
    if ( Nstep == 0 ) then
      call MessageNotify( 'M', sub_sname, '-------------------------------------------' )
      call MessageNotify( 'M', sub_sname, '----- Registered variables for output -----' )
      call MessageNotify( 'M', sub_sname, '-------------------------------------------' )

      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) )

      end do
      call MessageNotify( 'M', sub_sname, '-----' )
    end if

    ! 時刻を進める
    ! Progress time
    !
    Nstep = Nstep + 1
    current_difftime = start_difftime + delta_difftime * Nstep

    if ( .not. once_progressed ) once_progressed = .true.

    ! 出力タイミングのチェックとファイルの作成
    ! Check output timing and create files
    !
    call HstVarsOutputCheck

999 continue
    call StoreError(stat, subname, cause_c = cause_c)
    call EndSub(subname, 'stat=%d', i = (/stat/) )
  end subroutine HistoryAutoProgress
HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
: 変数の名前.

ただし, ここで指定するものは, HistoryAutoAddVariable の varname で既に指定されてい なければなりません.

Name of a variable.

This must be specified varname in "HistoryAutoAddVariable".

array(:) :real(DP), intent(in), target
: 出力データ.

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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"

err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

データの出力を行います. このサブルーチンを用いる前に, "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

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutInt1

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutReal1

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutInt2

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutDouble2

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutReal2

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutInt3

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutDouble3

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutReal3

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutInt4

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutDouble4

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutReal4

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutInt5

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutDouble5

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutReal5

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutInt6

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutDouble6

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutReal6

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutInt7

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutDouble7

HistoryAutoPut( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutReal7

HistoryAutoPut( varname, value, [err] )
Subroutine :
varname :character(*), intent(in)
value :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutInt0

HistoryAutoPut( varname, value, [err] )
Subroutine :
varname :character(*), intent(in)
value :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutDouble0

HistoryAutoPut( varname, value, [err] )
Subroutine :
varname :character(*), intent(in)
value :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

Alias for HistoryAutoPutReal0

HistoryAutoPutAxis( dim, array )
Subroutine :
dim :character(*), intent(in)
: 座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis.

Note that this value must be set as "dims" of "HistoryAutoCreate".

array(:) :integer, intent(in)
: 座標データ

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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"

座標データを設定します.

Set data of an axis.

Alias for HistoryAutoPutAxisInt

HistoryAutoPutAxis( dim, array )
Subroutine :
dim :character(*), intent(in)
: 座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis.

Note that this value must be set as "dims" of "HistoryAutoCreate".

array(:) :real(DP), intent(in)
: 座標データ

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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"

座標データを設定します.

Set data of an axis.

Alias for HistoryAutoPutAxisDouble

HistoryAutoPutAxis( dim, array )
Subroutine :
dim :character(*), intent(in)
: 座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis.

Note that this value must be set as "dims" of "HistoryAutoCreate".

array(:) :real, intent(in)
: 座標データ

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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"

座標データを設定します.

Set data of an axis.

Alias for HistoryAutoPutAxisReal

Private Instance methods

AXES_WEIGHT
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

AverageReduceDouble1( array, space_average, weight1, array_avr )
Subroutine :
array(:) :real(DP), intent(in), target
space_average(1) :logical, intent(in)
weight1(:) :real(DP), intent(in)
array_avr(:) :real(DP), pointer
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble2( array, space_average, weight1, weight2, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble3( array, space_average, weight1, weight2, weight3, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble4( array, space_average, weight1, weight2, weight3, weight4, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt1( array, space_average, weight1, array_avr )
Subroutine :
array(:) :integer, intent(in), target
space_average(1) :logical, intent(in)
weight1(:) :real(DP), intent(in)
array_avr(:) :integer, pointer
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt2( array, space_average, weight1, weight2, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt3( array, space_average, weight1, weight2, weight3, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt4( array, space_average, weight1, weight2, weight3, weight4, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal1( array, space_average, weight1, array_avr )
Subroutine :
array(:) :real, intent(in), target
space_average(1) :logical, intent(in)
weight1(:) :real(DP), intent(in)
array_avr(:) :real, pointer
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal2( array, space_average, weight1, weight2, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal3( array, space_average, weight1, weight2, weight3, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal4( array, space_average, weight1, weight2, weight3, weight4, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
GT_HISTORY_AXIS_DATA
Derived Type :
a_axis(:) =>null() :real(DP), pointer

座標軸データ用の構造型 Derived type for axes data

GT_HISTORY_DUMMY
Derived Type :
gthist =>null() :type(GT_HISTORY), pointer

GT_HISTORY 型変数を指す構造体 Derived type for indication to "GT_HISTORY"

HistoryAutoAddAttrChar0( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
: 変数の名前.

ここで指定するものは, HistoryAutoCreate の dims , または HistoryAutoAddWeight の varname で既に指定されてい なければなりません.

Name of a variable.

This must be specified with dims in HistoryAutoCreate, or varname in "HistoryAutoAddWeight".

attrname :character(*), intent(in)
: 属性の名前. Name of an attribute.
value :character(*), intent(in)
: 属性の値. Value of an attribute.

座標変数および座標重み変数に属性を付加します. このサブルーチンを用いる前に, HistoryAutoCreate による初期設定が 必要です.

  • 座標変数については, HistoryAutoCreate の "dims" に与えられた もののみ指定可能です.
  • 座標重み変数については, HistoryAutoAddWeight で与えられた もののみ指定可能です.
  • HistoryAutoAddAttr は複数のサブルーチンの総称名です. value にはいくつかの型を与えることが可能です. 下記のサブルーチンを参照ください.

Add attributes axes or weights of axes. Initialization by "HistoryAutoCreate" is needed before use of this subroutine.

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoAddAttrDouble0( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :real(DP), intent(in)

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoAddAttrDouble1( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :real(DP), intent(in)

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoAddAttrInt0( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :integer, intent(in)

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoAddAttrInt1( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :integer, intent(in)

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoAddAttrLogical0( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :logical, intent(in)

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoAddAttrReal0( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :real, intent(in)

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoAddAttrReal1( varname, attrname, value )
Subroutine :
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :real, intent(in)

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoAddVariable1( varname, dims, longname, units, [xtype], [time_units], [time_average], [file], [origin], [terminus], [interval], [slice_start], [slice_end], [slice_stride], [space_average], [newfile_interval] )
Subroutine :
varname :character(*), intent(in)
: 変数名. Variable name
dims(:) :character(*), intent(in)
: 変数が依存する次元の名前. 時間の次元は配列の最後に指定すること.

Names of dependency dimensions of a variable. Dimension of time must be specified to last of an array.

longname :character(*), intent(in)
: 変数の記述的名称.

Descriptive name of a variable

units :character(*), intent(in)
: 変数の単位.

Units of a variable

xtype :character(*), intent(in), optional
: 変数のデータ型

デフォルトは 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.

time_units :character(*), intent(in), optional
: 時刻次元の単位. Units of time dimension.
time_average :logical, intent(in), optional
: 出力データを時間平均する場合には .true. を与えます. デフォルトは .false. です.

If output data is averaged, specify ".true.". Default is ".false.".

file :character(*), intent(in), optional
: 出力ファイル名. Output file name.
origin :real, intent(in), optional
: 出力開始時刻.

省略した場合, 自動的に current_time の値が 設定されます.

Start time of output.

If this argument is omitted, a value of "current_time" is specified automatically.

terminus :real, intent(in), optional
: 出力終了時刻.

省略した場合, 数値モデルの実行が終了するまで 出力を行います.

End time of output.

If this argument is omitted, output is continued until a numerical model is finished.

interval :real, intent(in), optional
: 出力時間間隔.

省略した場合, 自動的に delta_time の値が設定されます.

Interval of output time.

If this argument is omitted, a value of "delta_time" is specified automatically.

slice_start(:) :integer, intent(in), optional
: 空間方向の開始点.

省略した場合, 座標データの開始点が設定されます.

Start points of spaces.

If this argument is omitted, start points of dimensions are set.

slice_end(:) :integer, intent(in), optional
: 空間方向の終了点.

省略した場合, 座標データの終了点が設定されます.

End points of spaces.

If this argument is omitted, End points of dimensions are set.

slice_stride(:) :integer, intent(in), optional
: 空間方向の刻み幅.

省略した場合, 1 が設定されます.

Strides of spaces

If this argument is omitted, 1 is set.

space_average(:) :logical, intent(in), optional
: 平均化のフラグ.

.true. が指定される座標に対して平均化を 行います. 省略した場合, .false. が設定されます.

Flag of average.

Axes specified .true. are averaged. If this argument is omitted, .false. is set.

newfile_interval :integer, intent(in), optional
: ファイル分割時間間隔.

省略した場合, 時間方向へのファイル分割を行いません.

Interval of time of separation of a file.

If this argument is omitted, a files is not separated in time direction.

ヒストリデータ出力するための変数登録を行います.

HistoryAutoProgress を呼ぶ前にこのサブルーチンを使用してください.

Register variables for history data output

Use this subroutine before "HistoryAutoProgress" is called.

[Source]

  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 )
    !
    ! ヒストリデータ出力するための変数登録を行います. 
    !
    ! HistoryAutoProgress を呼ぶ前にこのサブルーチンを使用してください. 
    !
    ! Register variables for history data output
    !
    ! Use this subroutine before "HistoryAutoProgress" is called. 
    !

    ! モジュール引用 ; USE statements
    !

    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, HST_EVARINUSE, HST_EALREADYPROGRESS, 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 gt4_history, only: HistoryVarinfoCreate, HistoryVarinfoInquire, HistoryAxisInquire
    use gt4_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
                              ! 出力開始時刻. 
                              !
                              ! 省略した場合, 自動的に current_time の値が
                              ! 設定されます.
                              ! 
                              ! Start time of output. 
                              !
                              ! If this argument is omitted, 
                              ! a value of "current_time" 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
                              ! 出力時間間隔. 
                              !
                              ! 省略した場合, 
                              ! 自動的に delta_time の値が設定されます.
                              !
                              ! Interval of output time. 
                              !
                              ! If this argument is omitted, 
                              ! a value of "delta_time" 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. 

    type(DC_DIFFTIME):: interval_difftime, origin_difftime, terminus_difftime, newfileint_difftime

    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 = 'gt4_historyauto'
      goto 999
    end if

    ! 既に HistoryAutoProgress が呼ばれていたらエラー
    ! Error is occurred if "HistoryAutoProgress" is called already
    !
    if ( once_progressed ) then
      call MessageNotify( 'W', subname, '"HistoryAutoAddVariable" (varname = %c) must be called before "HistoryAutoProgress"', c1 = trim(varname) )
      stat = HST_EALREADYPROGRESS
      cause_c = 'HistoryAutoProgress'
      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 > NF_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 dimensin "%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 dimensin "%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 )

    ! 各ステップ数を算出する. 
    ! Calculate number of each step
    !
    if ( output_valid_vars(numvars + 1) ) then
      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_difftime, interval_value, interval_unit_work ) ! (in)

      deltime_value_vars(numvars + 1) = EvalbyUnit( delta_difftime, interval_unit_work )
      intstep_vars(numvars + 1) = nint( interval_difftime / delta_difftime )
      if ( EvalSec( mod(interval_difftime, delta_difftime) ) > max_remainder_range ) then
        call MessageNotify( 'W', subname, 'interval=<%r [%c]> can not be divided by deltime=<%f [s]>', r = (/ interval_value /), d = (/ EvalSec(delta_difftime) /), c1 = trim(interval_unit_work) )
        stat = HST_EINDIVISIBLE
        cause_c = 'interval=' // trim(toChar(interval_value)) // ' [' // trim(interval_unit_work) // ']'
        goto 999
      end if

      ! ファイルを作成するステップ数を算出する. 
      ! Calculate number of step of interval of output
      !
      if ( origin_value > 0.0 ) then
        call DCDiffTimeCreate( origin_difftime, origin_value, origin_unit_work ) ! (in)

        origin_value_vars(numvars + 1) = EvalbyUnit( origin_difftime, interval_unit_work )
        originstep_vars(numvars + 1) = nint( ( origin_difftime - start_difftime ) / delta_difftime )
        if ( EvalSec( mod( ( origin_difftime - start_difftime ), delta_difftime ) ) > max_remainder_range ) then
          call MessageNotify( 'W', subname, 'origin=<%r [%c]> - start=<%d [%c]> can not be divided by deltime=<%f [s]>', r = (/ origin_value /), d = (/ EvalbyUnit(start_difftime, origin_unit_work), EvalSec(delta_difftime) /), c1 = trim(origin_unit_work), c2 = trim(origin_unit_work) )
          stat = HST_EINDIVISIBLE
          cause_c = 'origin=' // trim(toChar(origin_value)) // ' [' // trim(origin_unit_work) // ']'
          goto 999
        end if
      end if

      ! ファイルをクローズするステップ数を算出する. 
      ! Calculate number of step of closure of file
      !
      if ( terminus_value > 0.0 ) then
        call DCDiffTimeCreate( terminus_difftime, terminus_value, terminus_unit_work ) ! (in)

        terminusstep_vars(numvars + 1) = nint( ( terminus_difftime - start_difftime ) / delta_difftime ) + 1
        if ( EvalSec( mod( ( terminus_difftime - start_difftime ), delta_difftime ) ) > max_remainder_range ) then
          call MessageNotify( 'W', subname, 'terminus=<%r [%c]> - start=<%d [%c]> can not be divided by deltime=<%f [s]>', r = (/ terminus_value /), d = (/ EvalbyUnit(start_difftime, terminus_unit_work), EvalSec(delta_difftime) /), c1 = trim(terminus_unit_work), c2 = trim(terminus_unit_work) )
          stat = HST_EINDIVISIBLE
          cause_c = 'terminus=' // trim(toChar(terminus_value)) // ' [' // trim(terminus_unit_work) // ']'
          goto 999
        end if
      end if

      ! ファイルを新規に作り直すステップ数の算出
      ! Calculate number of step of remake of file
      if ( newfile_intvalue > 0.0 ) then
        call DCDiffTimeCreate( newfileint_difftime, real( newfile_intvalue ), newfile_intunit_work ) ! (in)

        newfile_intstep_vars(numvars + 1) = nint( ( newfileint_difftime ) / delta_difftime )

        if ( EvalSec( mod( newfileint_difftime, delta_difftime ) ) > max_remainder_range ) then
          call MessageNotify( 'W', subname, 'newfile_interval=<%d [%c]> can not be divided by deltime=<%f [s]>', i = (/ newfile_intvalue /), d = (/ EvalSec(delta_difftime) /), c1 = trim(newfile_intunit_work) )
          stat = HST_EINDIVISIBLE
          cause_c = 'newfile_interval=' // trim(toChar(newfile_intvalue)) // ' [' // trim(newfile_intunit_work) // ']'
          goto 999
        end if

        if ( EvalSec( mod( newfileint_difftime, interval_difftime ) ) > max_remainder_range ) then
          call MessageNotify( 'W', subname, 'newfile_interval=<%d [%c]> can not be divided by interval=<%r [%c]>', i = (/ newfile_intvalue /), r = (/ interval_value /), c1 = trim(newfile_intunit_work), c2 = trim(interval_unit_work) )
          stat = HST_EINDIVISIBLE
          cause_c = 'newfile_interval=' // trim(toChar(newfile_intvalue)) // ' [' // trim(newfile_intunit_work) // ']'
          goto 999
        end if

        if ( .not. newfile_intstep_vars(numvars + 1) > intstep_vars(numvars + 1) ) then
          call MessageNotify( 'W', subname, 'newfile_interval=<%d [%c]> must be greater than interval=<%r [%c]>', i = (/ newfile_intvalue /), r = (/ interval_value /), c1 = trim(newfile_intunit_work), c2 = trim(interval_unit_work) )
          stat = HST_EINDIVISIBLE
          cause_c = 'newfile_interval=' // trim(toChar(newfile_intvalue)) // ' [' // trim(newfile_intunit_work) // ']'
          goto 999
        end if

      end if

    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
HistoryAutoAddWeightDouble( dim, weight, [units], [xtype] )
Subroutine :
dim :character(*), intent(in)
: 座標重みを設定する座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis to which "weight" are set.

Note that this value must be set as "dims" of "HistoryAutoCreate".

weight(:) :real(DP), intent(in)
: 座標重みデータ.

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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.

units :character(*), intent(in), optional
: 座標重みの単位. 省略した場合には, 座標の単位が 使用されます.

Units of axis weight. If this argument is omitted, unit of the dimension is used.

xtype :character(*), intent(in), optional
: 座標重みのデータ型. 省略した場合には, 座標のデータ型が 使用されます.

Data type of weight of the dimension. If this argument is omitted, data type of the dimension is used.

座標の重みデータを設定します.

Set weights of axes.

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoAddWeightInt( dim, weight, [units], [xtype] )
Subroutine :
dim :character(*), intent(in)
: 座標重みを設定する座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis to which "weight" are set.

Note that this value must be set as "dims" of "HistoryAutoCreate".

weight(:) :integer, intent(in)
: 座標重みデータ.

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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.

units :character(*), intent(in), optional
: 座標重みの単位. 省略した場合には, 座標の単位が 使用されます.

Units of axis weight. If this argument is omitted, unit of the dimension is used.

xtype :character(*), intent(in), optional
: 座標重みのデータ型. 省略した場合には, 座標のデータ型が 使用されます.

Data type of weight of the dimension. If this argument is omitted, data type of the dimension is used.

座標の重みデータを設定します.

Set weights of axes.

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoAddWeightReal( dim, weight, [units], [xtype] )
Subroutine :
dim :character(*), intent(in)
: 座標重みを設定する座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis to which "weight" are set.

Note that this value must be set as "dims" of "HistoryAutoCreate".

weight(:) :real, intent(in)
: 座標重みデータ.

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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.

units :character(*), intent(in), optional
: 座標重みの単位. 省略した場合には, 座標の単位が 使用されます.

Units of axis weight. If this argument is omitted, unit of the dimension is used.

xtype :character(*), intent(in), optional
: 座標重みのデータ型. 省略した場合には, 座標のデータ型が 使用されます.

Data type of weight of the dimension. If this argument is omitted, data type of the dimension is used.

座標の重みデータを設定します.

Set weights of axes.

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoClose1( )
Subroutine :

HistoryAutoCreate で始まったデータ出力の終了処理を行います. プログラムを終了する前に必ずこのサブルーチンを呼んでください.

Terminates data output with "HistoryAutoCreate". Call this subroutine certainly before a progrem is finished.

[Source]

  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 gt4_history_nmlinfo, only: HstNmlInfoClose, HstNmlInfoNames, HstNmlInfoAssocGtHist, HstNmlInfoPutLine
    use gt4_history, only: GT_HISTORY, HistoryClose, HistoryInitialized, HistoryAxisClear, HistoryVarinfoClear

    ! ヒストリファイルへのデータ出力設定
    ! Configure the settings for history data output
    !
    character(STRING):: name = ''
                              ! 変数名. Variable identifier
    character(STRING):: varnames
                              ! 変数名リスト. 
                              ! List of variables
    character(TOKEN), pointer:: varnames_array(:) =>null()
                              ! 変数名リスト配列. 
                              ! List of variables (array) 
    integer:: i, vnmax
    type(GT_HISTORY), pointer:: gthist =>null()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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 = 'gt4_historyauto'
      goto 999
    end if

    ! ヒストリファイルへのデータ出力の終了処理
    ! Terminate the settings for history data output
    !
    varnames = HstNmlInfoNames( gthstnml )
    call Split( str = varnames, sep = ',', carray = 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.
      output_timing_vars(i)   = .false.
      intstep_vars(i)         = 1
      originstep_vars(i)      = 0
      terminusstep_vars(i)    = -1
      newfile_intstep_vars(i) = -1
      tavr_vars(i)            = .false.
      deltime_value_vars(i)   = 1.0
      origin_value_vars(i)    = 0.0

    end do
    numvars = 0

    ! 時刻データのクリア
    ! Clear time data
    !
    Nstep = 0

    ! 終了処理, 例外処理
    ! Termination and Exception handling
    !
    initialized = .false.
    once_progressed = .false.
    all_output_save = .false.

999 continue
    call StoreError( stat, subname, cause_c = cause_c )
    call EndSub( subname )
  end subroutine HistoryAutoClose1
HistoryAutoCreate1( title, source, institution, dims, dimsizes, longnames, units, [xtypes], [conventions], [gt_version], [all_output], [file_prefix], [namelist_filename], [current_time], [delta_time], [interval], [origin], [terminus], [slice_start], [slice_end], [slice_stride], [space_average], [time_average], [newfile_interval], [rank] )
Subroutine :
title :character(*), intent(in)
: データ全体の表題. Title of entire data
source :character(*), intent(in)
: データを作成する際の手段. Source of data file
institution :character(*), intent(in)
: ファイルを最終的に変更した組織/個人. Institution or person that changes files for the last time
dims(:) :character(*), intent(in)
: 次元の名前.

配列の大きさに制限はありません. 個々の次元の文字数は 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.

dimsizes(:) :integer, intent(in)
: dims で指定したそれぞれの次元大きさ.

配列の大きさは dims の大きさと等しい 必要があります. ‘0’ (数字のゼロ) を指定 するとその次元は 無制限次元 (unlimited dimension) となります. (gt4_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 "gt4_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

longnames(:) :character(*), intent(in)
: 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.

units(:) :character(*), intent(in)
: 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.

xtypes(:) :character(*), intent(in), optional
: 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.

conventions :character(*), intent(in), optional
: 出力するファイルの 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.

gt_version :character(*), intent(in), optional
: 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).

all_output :logical, intent(in), optional
: 登録変数を全て出力するためのフラグ.

.true. を指定すると, HistoryAutoAddVariable で登録された 変数が全て出力されるようになります.

namelist_filename が指定される場合 には, デフォルトは .false. となります. この場合には, namelist_filename に指定された NAMELIST ファイルから読み込まれる NAMELIST#gt4_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#gt4_historyauto_nml" loaded from a NAMELIST file namelist_filename.

If namelist_filename is not specified, this value becomes .true. .

file_prefix :character(*), intent(in), optional
: ヒストリデータのファイル名の接頭詞. Prefixes of history data filenames
namelist_filename :character(*), intent(in), optional
: NAMELIST ファイルの名称.

省略した場合, もしくは空白文字を与えた場合, NAMELIST ファイルは読み込みません.

Name of NAMELIST file.

If this argument is omitted, or blanks are specified, no NAMELIST file is loaded.

current_time :real, intent(in), optional
: 数値モデル内の現在時刻 (単位: 秒).

省略した場合, 自動的にゼロが設定されます.

Current time in a numerical model (unit: seconds).

If this argument is omitted, zero is set automatically.

delta_time :real, intent(in), optional
: 数値モデル内のタイムステップ (単位: 秒).

省略した場合, 自動的に 1.0 が設定されます.

Time step in a numerical model (unit: seconds).

If this argument is omitted, 1.0 is set automatically.

interval :real, intent(in), optional
: 出力時間間隔.

省略した場合, 自動的に delta_time の値が設定されます.

Interval of output time.

If this argument is omitted, a value of "delta_time" is specified automatically.

origin :real, intent(in), optional
: 出力開始時刻.

省略した場合, 自動的に current_time の値が 設定されます.

Start time of output.

If this argument is omitted, a value of "current_time" is specified automatically.

terminus :real, intent(in), optional
: 出力終了時刻.

省略した場合, 数値モデルの実行が終了するまで 出力を行います.

End time of output.

If this argument is omitted, output is continued until a numerical model is finished.

slice_start(:) :integer, intent(in), optional
: 空間方向の開始点.

省略した場合, 座標データの開始点が設定されます.

Start points of spaces.

If this argument is omitted, start points of dimensions are set.

slice_end(:) :integer, intent(in), optional
: 空間方向の終了点.

省略した場合, 座標データの終了点が設定されます.

End points of spaces.

If this argument is omitted, End points of dimensions are set.

slice_stride(:) :integer, intent(in), optional
: 空間方向の刻み幅.

省略した場合, 1 が設定されます.

Strides of spaces

If this argument is omitted, 1 is set.

space_average(:) :logical, intent(in), optional
: 平均化のフラグ.

.true. が指定される座標に対して平均化を 行います. 省略した場合, .false. が設定されます.

Flag of average.

Axes specified .true. are averaged. If this argument is omitted, .false. is set.

time_average :logical, intent(in), optional
: 出力データの時間平均フラグ. デフォルトは .false. Flag for time average of output data Default value is .false.
newfile_interval :integer, intent(in), optional
: ファイル分割時間間隔.

省略した場合, 時間方向へのファイル分割を行いません.

Interval of time of separation of a file.

If this argument is omitted, a files is not separated in time direction.

rank :character(*), intent(in), optional
: ランクの名称.

Name of a rank.

複数のヒストリデータ出力を行うための初期化を行います.

この HistoryAutoCreate には, モデル内で出力する 変数が依存する座標や座標重みなどを全てを設定してください.

all_output に .true. を与えた場合や, namelist_filename を与えない (空文字を与える) 場合には, HistoryAutoAddVariable で登録される全ての変数が出力されます. 一方で namelist_filename に NAMELIST ファイル名を与える場合には, その NAMELIST ファイルから出力のオンオフや, 出力ファイル名, 出力間隔などを変更可能です. 変更可能な項目に関しては NAMELIST#gt4_historyauto_nml を参照して下さい.

interval, origin, terminus, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval などの設定はデフォルト値として使用されます. これらの設定値は HistoryAutoAddVariable および NAMELIST#gt4_historyauto_nml で上書きされます. (優先度が高いのは NAMELIST#gt4_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#gt4_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#gt4_historyauto_nml". ("NAMELIST#gt4_historyauto_nml" is high priority, arguments of "HistoryAutoAddVariable" are medium, arguments of "HistoryAutoCreate" are low).

This procedure input/output NAMELIST#gt4_historyauto_nml .

[Source]

  subroutine HistoryAutoCreate1( title, source, institution, dims, dimsizes, longnames, units, xtypes, conventions, gt_version, all_output, file_prefix, namelist_filename, current_time, delta_time, interval, origin, terminus, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval, rank )
    !
    ! 複数のヒストリデータ出力を行うための初期化を行います. 
    !
    ! この HistoryAutoCreate には, モデル内で出力する
    ! 変数が依存する座標や座標重みなどを全てを設定してください. 
    !
    ! all_output に .true. を与えた場合や,
    ! namelist_filename を与えない (空文字を与える) 場合には, 
    ! HistoryAutoAddVariable で登録される全ての変数が出力されます. 
    ! 一方で namelist_filename に NAMELIST ファイル名を与える場合には, 
    ! その NAMELIST ファイルから出力のオンオフや, 
    ! 出力ファイル名, 出力間隔などを変更可能です. 
    ! 変更可能な項目に関しては NAMELIST#gt4_historyauto_nml 
    ! を参照して下さい. 
    !
    ! interval, origin, terminus, slice_start, slice_end, slice_stride,
    ! space_average, time_average, newfile_interval 
    ! などの設定はデフォルト値として使用されます. 
    ! これらの設定値は HistoryAutoAddVariable および
    ! NAMELIST#gt4_historyauto_nml で上書きされます. 
    ! (優先度が高いのは NAMELIST#gt4_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#gt4_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#gt4_historyauto_nml". 
    ! ("NAMELIST#gt4_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
    use dc_message, only: MessageNotify
    use dc_iounit, only: FileOpen
    use gt4_history, only: HistoryAxisCreate
    use gt4_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) となります. (gt4_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 "gt4_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#gt4_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#gt4_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:: current_time
                              ! 数値モデル内の現在時刻 (単位: 秒). 
                              !
                              ! 省略した場合, 自動的にゼロが設定されます. 
                              ! 
                              ! Current time in a numerical model
                              ! (unit: seconds). 
                              ! 
                              ! If this argument is omitted, 
                              ! zero is set automatically. 
                              ! 
    real, intent(in), optional:: delta_time
                              ! 数値モデル内のタイムステップ (単位: 秒). 
                              !
                              ! 省略した場合, 自動的に 1.0 が設定されます. 
                              ! 
                              ! Time step in a numerical model
                              ! (unit: seconds). 
                              ! 
                              ! If this argument is omitted, 
                              ! 1.0 is set automatically. 
                              ! 
    real, intent(in), optional:: interval
                              ! 出力時間間隔. 
                              !
                              ! 省略した場合, 
                              ! 自動的に delta_time の値が設定されます.
                              !
                              ! Interval of output time. 
                              !
                              ! If this argument is omitted, 
                              ! a value of "delta_time" is specified 
                              ! automatically. 
                              ! 
    real, intent(in), optional:: origin
                              ! 出力開始時刻. 
                              !
                              ! 省略した場合, 自動的に current_time の値が
                              ! 設定されます.
                              ! 
                              ! Start time of output. 
                              !
                              ! If this argument is omitted, 
                              ! a value of "current_time" 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. 
                              !

    ! NAMELIST 変数群 ; NAMELIST group of variables
    character(STRING):: Name
                              ! 変数名. 
                              ! 空白の場合には, この他の設定値は
                              ! gt4_historyauto モジュールにおいて
                              ! 出力されるデータ全ての
                              ! デフォルト値となります. 
                              ! 
                              ! "Data1,Data2" のようにカンマで区切って複数
                              ! の変数を指定することも可能です. 
                              ! 
                              ! Variable identifier. 
                              ! If blank is given, other values are 
                              ! used as default values of output data 
                              ! in "gt4_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
                              ! ヒストリデータの精度. 
                              ! Precision of history data
    character(STRING):: FilePrefix
                              ! ヒストリデータのファイル名の接頭詞. 
                              ! Prefixes of history data filenames
    logical:: TimeAverage
                              ! 出力データの時間平均フラグ. 
                              ! Flag for time average of output data
    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. 
    integer:: SliceStride(1:NF_MAX_DIMS)
                              ! 空間方向の刻み幅. 
                              ! Strides of spaces. 
    logical:: SpaceAverage(1:NF_MAX_DIMS)
                              ! 平均化のフラグ. 
                              ! Flag of average. 
    integer:: NewFileIntValue
                              ! ファイル分割時間間隔. 
                              ! Interval of time of separation of a file. 
    character(TOKEN):: NewFileIntUnit
                              ! ファイル分割時間間隔の単位. 
                              ! Unit of interval of time of separation of a file. 

    namelist /gt4_historyauto_nml/ Name, File, IntValue, IntUnit, Precision, FilePrefix, TimeAverage, AllOutput, OriginValue, OriginUnit, TerminusValue, TerminusUnit, SliceStart, SliceEnd, SliceStride, SpaceAverage, NewFileIntValue, NewFileIntUnit
                              ! gt4_historyauto モジュールのヒストリデータ用
                              ! NAMELIST 変数群名. 
                              !
                              ! gt4_historyauto#HistoryAutoCreate
                              ! を使用する際に, オプショナル引数 *namelist_filename* 
                              ! へ NAMELIST ファイル名を指定することで, 
                              ! そのファイルからこの NAMELIST 変数群を
                              ! 読み込みます. 
                              !
                              ! NAMELIST group name for 
                              ! history data of "gt4_historyauto" module. 
                              ! 
                              ! If a NAMELIST filename is specified to 
                              ! an optional argument *namelist_filename* when 
                              ! "gt4_historyauto#HistoryAutoCreate" 
                              ! is used, this NAMELIST group is 
                              ! loaded from the file. 


    ! 作業変数 ; Work variables
    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
    type(DC_DIFFTIME):: origin_difftime
    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 = 'gt4_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

    ! 現在時刻に関するエラー処理
    ! Error handling for current time
    !
    if ( present(current_time) ) then
      if ( current_time < 0.0 ) then
        call MessageNotify( 'W', subname, '"current_time=<%r>" must not be negative value.', r = (/ current_time /) )
        stat = DC_ENEGATIVE
        cause_c = 'current_time'
        goto 999
      end if
    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

    ! 座標軸データの保管
    ! Save axes data
    !
    time_unit_bycreate = units(numdims)
    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

    ! 登録変数を全て出力するためのフラグの保管
    ! 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 time data
    !
    if ( present(current_time ) ) then
      call DCDiffTimeCreate( start_difftime, current_time, 'sec' ) ! (in)
    else
      call DCDiffTimeCreate( start_difftime, 0.0, 'sec' )      ! (in)
    end if

    current_difftime = start_difftime

    if ( present(delta_time) ) then
      call DCDiffTimeCreate( delta_difftime, delta_time, 'sec' ) ! (in)
    else
      call DCDiffTimeCreate( delta_difftime, 1.0, 'sec' )      ! (in)
    end if

    ! 出力時間間隔のデフォルト値設定
    ! Configure default interval of output time
    !
    if ( all_output_save ) then
      if ( present(interval) ) then
        interval_work = interval
      else
        interval_work = EvalbyUnit( delta_difftime, units(numdims) )
      end if
    else
      interval_work = - 1.0
    end if

    ! 出力開始時刻のデフォルト値設定
    ! Configure default origin time of output
    !
    if ( present(origin) ) then
      call DCDiffTimeCreate( origin_difftime, origin, units(numdims) ) ! (in)
      origin_work = EvalbyUnit( origin_difftime, 'sec' )
    else
      origin_work = EvalbyUnit( current_difftime, 'sec' )
!!$      origin_work = EvalbyUnit( current_difftime, units(numdims) )
    end if

    ! gt4_historyauto_nml へデフォルト値の設定
    ! Configure default values for "gt4_historyauto_nml"
    !
    call HstNmlInfoCreate( gthstnml ) ! (out)

    call HstNmlInfoAdd( gthstnml = gthstnml, name = '', precision = 'float', fileprefix = file_prefix, interval_value = interval_work, interval_unit  = units(numdims), origin_value   = origin_work, origin_unit    = 'sec', terminus_value = terminus, terminus_unit  = units(numdims), 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 = units(numdims) )     ! (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, '----- "gt4_historyauto_nml" is loaded from "%c" -----', c1 = trim(namelist_filename) )

      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 = gt4_historyauto_nml, iostat = iostat_nml )           ! (out)
        inquire( unit = unit_nml, position = pos_nml )   ! (out)

        if ( iostat_nml == 0 ) then

          ! 情報の登録
          ! 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:' )
            call MessageNotify( 'M', sub_sname, '  AllOutput       = %b', l  = (/ AllOutput   /) )
            call MessageNotify( 'M', sub_sname, '  FilePrefix      = %c', c1 = trim(FilePrefix   ) )
          else
            call MessageNotify( 'M', sub_sname, 'Individual Settings:' )
            call MessageNotify( 'M', sub_sname, '  Name            = %c', c1 = trim(Name           ) )
            call MessageNotify( 'M', sub_sname, '  File            = %c', c1 = trim(File           ) )
          end if
          call MessageNotify( 'M', sub_sname, '  Interval        = %r [%c]', r = (/ IntValue /), c1 = trim( IntUnit ) )
          call MessageNotify( 'M', sub_sname, '  Precision       = %c', c1 = trim(Precision    ) )
          call MessageNotify( 'M', sub_sname, '  TimeAverage     = %b', l  = (/ TimeAverage   /) )
          call MessageNotify( 'M', sub_sname, '  Origin          = %r [%c]', r = (/ OriginValue /), c1 = trim( OriginUnit ) )
          call MessageNotify( 'M', sub_sname, '  Terminus        = %r [%c]', r = (/ TerminusValue /), c1 = trim( TerminusUnit ) )
          call MessageNotify( 'M', sub_sname, '  SliceStart      = (/ %*d /)', i = SliceStart(1:numdims-1), n = (/ numdims-1 /) )
          call MessageNotify( 'M', sub_sname, '  SliceEnd        = (/ %*d /)', i = SliceEnd(1:numdims-1), n = (/ numdims-1 /) )
          call MessageNotify( 'M', sub_sname, '  SliceStride     = (/ %*d /)', i = SliceStride(1:numdims-1), n = (/ numdims-1 /) )
          call MessageNotify( 'M', sub_sname, '  SpaceAverage    = (/ %*b /)', l = SpaceAverage(1:numdims-1), n = (/ numdims-1 /) )
          call MessageNotify( 'M', sub_sname, '  NewFileInterval = %d [%c]', i = (/ NewFileIntValue /), c1 = trim( NewFileIntUnit ) )
          call MessageNotify( 'M', sub_sname, '' )

        else
          call MessageNotify( 'M', sub_sname, '----- loading is finished (iostat=%d) -----', i = (/iostat_nml/) )
        end if
      end do

      close( unit_nml )


    ! NAMELIST ファイルを読み込まない場合
    ! NAMELIST file is not loaded
    !
    else
      call MessageNotify( 'M', sub_sname, '----- "gt4_historyauto_nml" is not loaded" -----' )
      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:' )
      call MessageNotify( 'M', sub_sname, '  AllOutput       = %b', l  = (/ AllOutput   /) )
      call MessageNotify( 'M', sub_sname, '  FilePrefix      = %c', c1 = trim(FilePrefix   ) )
      call MessageNotify( 'M', sub_sname, '  Interval        = %r [%c]', r = (/ IntValue /), c1 = trim( IntUnit ) )
      call MessageNotify( 'M', sub_sname, '  Precision       = %c', c1 = trim(Precision    ) )
      call MessageNotify( 'M', sub_sname, '  TimeAverage     = %b', l  = (/ TimeAverage   /) )
      call MessageNotify( 'M', sub_sname, '  Origin          = %r [%c]', r = (/ OriginValue /), c1 = trim( OriginUnit ) )
      call MessageNotify( 'M', sub_sname, '  Terminus        = %r [%c]', r = (/ TerminusValue /), c1 = trim( TerminusUnit ) )
      call MessageNotify( 'M', sub_sname, '  SliceStart      = (/ %*d /)', i = SliceStart(1:numdims-1), n = (/ numdims-1 /) )
      call MessageNotify( 'M', sub_sname, '  SliceEnd        = (/ %*d /)', i = SliceEnd(1:numdims-1), n = (/ numdims-1 /) )
      call MessageNotify( 'M', sub_sname, '  SliceStride     = (/ %*d /)', i = SliceStride(1:numdims-1), n = (/ numdims-1 /) )
      call MessageNotify( 'M', sub_sname, '  SpaceAverage    = (/ %*b /)', l = SpaceAverage(1:numdims-1), n = (/ numdims-1 /) )
      call MessageNotify( 'M', sub_sname, '  NewFileInterval = %d [%c]', i = (/ NewFileIntValue /), c1 = trim( NewFileIntUnit ) )
      call MessageNotify( 'M', sub_sname, '' )

    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
HistoryAutoPutAxisDouble( dim, array )
Subroutine :
dim :character(*), intent(in)
: 座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis.

Note that this value must be set as "dims" of "HistoryAutoCreate".

array(:) :real(DP), intent(in)
: 座標データ

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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"

座標データを設定します.

Set data of an axis.

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoPutAxisInt( dim, array )
Subroutine :
dim :character(*), intent(in)
: 座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis.

Note that this value must be set as "dims" of "HistoryAutoCreate".

array(:) :integer, intent(in)
: 座標データ

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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"

座標データを設定します.

Set data of an axis.

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoPutAxisReal( dim, array )
Subroutine :
dim :character(*), intent(in)
: 座標の名称.

ただし, ここで指定するもの は, HistoryAutoCreate の dims 既に指定されていなければなりません.

Name of axis.

Note that this value must be set as "dims" of "HistoryAutoCreate".

array(:) :real, intent(in)
: 座標データ

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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"

座標データを設定します.

Set data of an axis.

[Source]

  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 gt4_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 = 'gt4_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
HistoryAutoPutDouble0( varname, value, [err] )
Subroutine :
varname :character(*), intent(in)
value :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutDouble0( varname, value, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_history" module

                                        
    integer:: stat, i
    integer:: vnum
    character(STRING):: cause_c
    integer, save:: svnum = 1
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! GT_HISTORY 変数の取得
    ! Get "GT_HISTORY" variable
    !
    gthist => gthst_history_vars(vnum) % gthist


    ! 空間切り出し
    ! Slice of spaces
    !
                        ! array only
                    


    ! 空間平均
    ! Spatial average
    !
                        ! array only
                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, (/value/), time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, (/value/), history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                                        

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutDouble0
HistoryAutoPutDouble1( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
: 変数の名前.

ただし, ここで指定するものは, HistoryAutoAddVariable の varname で既に指定されてい なければなりません.

Name of a variable.

This must be specified varname in "HistoryAutoAddVariable".

array(:) :real(DP), intent(in), target
: 出力データ.

データ型は整数, 単精度実数型, 倍精度実数型のどれでもかまいません. ただし, ファイルへ出力される際には, 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"

err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

データの出力を行います. このサブルーチンを用いる前に, "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.

[Source]

  subroutine HistoryAutoPutDouble1( 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_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutDouble1
HistoryAutoPutDouble2( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutDouble2( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutDouble2
HistoryAutoPutDouble3( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutDouble3( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutDouble3
HistoryAutoPutDouble4( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutDouble4( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutDouble4
HistoryAutoPutDouble5( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutDouble5( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutDouble5
HistoryAutoPutDouble6( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutDouble6( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutDouble6
HistoryAutoPutDouble7( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(DP), intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutDouble7( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutDouble7
HistoryAutoPutInt0( varname, value, [err] )
Subroutine :
varname :character(*), intent(in)
value :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutInt0( varname, value, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_history" module

                                        
    integer:: stat, i
    integer:: vnum
    character(STRING):: cause_c
    integer, save:: svnum = 1
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! GT_HISTORY 変数の取得
    ! Get "GT_HISTORY" variable
    !
    gthist => gthst_history_vars(vnum) % gthist


    ! 空間切り出し
    ! Slice of spaces
    !
                        ! array only
                    


    ! 空間平均
    ! Spatial average
    !
                        ! array only
                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, (/value/), time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, (/value/), history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                                        

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutInt0
HistoryAutoPutInt1( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutInt1( varname, array, err )
    !
                                        
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutInt1
HistoryAutoPutInt2( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutInt2( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutInt2
HistoryAutoPutInt3( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutInt3( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutInt3
HistoryAutoPutInt4( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutInt4( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutInt4
HistoryAutoPutInt5( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutInt5( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutInt5
HistoryAutoPutInt6( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutInt6( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutInt6
HistoryAutoPutInt7( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :integer, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutInt7( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutInt7
HistoryAutoPutReal0( varname, value, [err] )
Subroutine :
varname :character(*), intent(in)
value :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutReal0( varname, value, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_history" module

                                        
    integer:: stat, i
    integer:: vnum
    character(STRING):: cause_c
    integer, save:: svnum = 1
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! GT_HISTORY 変数の取得
    ! Get "GT_HISTORY" variable
    !
    gthist => gthst_history_vars(vnum) % gthist


    ! 空間切り出し
    ! Slice of spaces
    !
                        ! array only
                    


    ! 空間平均
    ! Spatial average
    !
                        ! array only
                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, (/value/), time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, (/value/), history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                                        

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutReal0
HistoryAutoPutReal1( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutReal1( varname, array, err )
    !
                                        
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutReal1
HistoryAutoPutReal2( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutReal2( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutReal2
HistoryAutoPutReal3( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutReal3( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutReal3
HistoryAutoPutReal4( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutReal4( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutReal4
HistoryAutoPutReal5( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutReal5( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutReal5
HistoryAutoPutReal6( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutReal6( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutReal6
HistoryAutoPutReal7( varname, array, [err] )
Subroutine :
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real, intent(in), target
err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 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.

[Source]

  subroutine HistoryAutoPutReal7( varname, array, err )
    !
                    
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, HST_EBADVARNAME, DC_ENOTINIT
    use dc_date, only: DCDiffTimeCreate, EvalbyUnit, EvalSec, operator(-), operator(>), operator(<), mod, operator(==)
    use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized, HistoryAddVariable, HistoryInquire, HistoryVarinfoInquire, HistoryClose
    use gt4_history_nmlinfo, only: HstNmlInfoEndDefine, HstNmlInfoDefineMode
    implicit none
    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()
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_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
    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 = 'gt4_historyauto'
      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

    ! 初回のみ呼び出す. 
    ! Called at only first time
    !
    if ( Nstep == 0 ) then

      ! 定義モードからデータモードへ
      ! 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( vnum ) ! (in) optional

    end if

    ! 出力が有効かどうかを確認する
    ! Confirm whether the output is effective
    !
    if ( .not. output_timing_vars(vnum) ) goto 999

    ! 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

                    


    ! 出力
    ! OutPut
    !
    if ( tavr_vars(vnum) ) then
      call HistoryPut( varname, array_avr, time = ( Nstep - originstep_vars(vnum) ) * deltime_value_vars(vnum) + origin_value_vars(vnum), history = gthist )      ! (inout) optional
    else
      call HistoryPut( varname, array_avr, history = gthist )      ! (inout) optional
    end if

    nullify( gthist )

    ! 結合解除
    ! Release associations
    !
                        nullify( array_avr, array_slice )
                    

999 continue
    call StoreError(stat, subname, cause_c = cause_c, err = err)
    call EndSub(subname)
  end subroutine HistoryAutoPutReal7
HstFileCreate( gthist, varname )
Subroutine :
gthist :type(GT_HISTORY), intent(inout)
: gt4_history モジュール用構造体. Derived type for "gt4_history" module
varname :character(*), intent(in)
: 変数の名前. Variable name

ファイル作成用内部サブルーチン

Internal subroutine for creation of files

[Source]

  subroutine HstFileCreate( gthist, varname )
    !
    ! ファイル作成用内部サブルーチン
    !
    ! Internal subroutine for creation of files
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR, HST_EBADVARNAME, HST_EBADSLICE
    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 gt4_history_nmlinfo, only: HstNmlInfoOutputValid, HstNmlInfoInquire, HstNmlInfoPutLine
    use gt4_history, only: GT_HISTORY, HistoryCreate, HistoryAddVariable, HistoryAddAttr, HistoryInitialized, HistoryPut, HistoryAxisCreate, HistoryAxisInquire, HistoryAxisCopy, HistoryVarinfoInquire, HistoryVarinfoCreate, HistoryVarinfoCopy, HistoryVarinfoInitialized, HistoryVarinfoClear

    implicit none
    type(GT_HISTORY), intent(inout):: gthist
                              ! gt4_history モジュール用構造体. 
                              ! Derived type for "gt4_history" module
    character(*), intent(in):: varname
                              ! 変数の名前. 
                              ! Variable name

    real:: interval_value
                              ! ヒストリデータの出力間隔の数値. 
                              ! Numerical value for interval of history data output
    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. 
    character(TOKEN):: time_name
                              ! 時刻次元の名称. 
                              ! Name of time dimension
    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), 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 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

        gthst_axes_slices    => gthst_axes
        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(numdims)

        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_value = interval_value, interval_unit  = interval_unit, newfile_intvalue = newfile_intvalue, newfile_intunit = newfile_intunit )    ! (out)

      ! データ出力時刻の設定
      ! Configure data output time
      !
      if ( origin_value > 0.0 ) then
        call DCDiffTimeCreate( origin_difftime, origin_value, origin_unit )  ! (in)
      else
        origin_difftime = start_difftime
      end if

      if ( newfile_intvalue < 1 ) then
        origin_value = EvalbyUnit( origin_difftime, interval_unit )
      else
        origin_value = EvalbyUnit( current_difftime, 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( current_difftime, 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, interval = interval_value )                             ! (in)

      ! 時刻の単位を変更
      ! Change unit of time
      !
      call HistoryAxisInquire( axis = gthst_axes(numdims), name = time_name )            ! (out)

      call HistoryAddAttr( history = gthist, varname = time_name, attrname = 'units', value = interval_unit )                    ! (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

      if ( slice_valid ) then
        deallocate( gthst_axes_slices )
        deallocate( data_axes_slices )
      else
        nullify( 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
HstVarsOutputCheck( [vnum_op] )
Subroutine :
vnum_op :integer, intent(in), optional
: 変数 ID. Variable ID

現在が各変数にとって出力のタイミングかどうか, 調査して output_timing_vars へ反映する. vnum_op を与えた場合, その変数のみについて作業を行う.

また, ファイルのオープンクローズのタイミングであれば, それらもこのサブルーチン内で行う.

It is investigated whether current time is output timing for each variable, and the information is reflected to "output_timing_vars". If "vnum_op" is given, works are done for only the variable.

And if current time is timing of open/close of files, they are done in this subroutine.

[Source]

  subroutine HstVarsOutputCheck ( vnum_op )
    !
    ! 現在が各変数にとって出力のタイミングかどうか, 
    ! 調査して output_timing_vars へ反映する. 
    ! vnum_op を与えた場合, その変数のみについて作業を行う. 
    !
    ! また, ファイルのオープンクローズのタイミングであれば, 
    ! それらもこのサブルーチン内で行う. 
    !
    ! It is investigated whether current time is output timing for
    ! each variable, and the information is reflected to 
    ! "output_timing_vars". 
    ! If "vnum_op" is given, works are done for only the variable.
    !
    ! And if current time is timing of open/close of files, 
    ! they are done in this subroutine. 
    !
    use dc_trace, only: BeginSub, EndSub
    use dc_error, only: StoreError, DC_NOERR
    use gt4_history, only: HistoryInitialized, HistoryClose
    implicit none
    integer, intent(in), optional:: vnum_op
                              ! 変数 ID. Variable ID

    integer:: stat, i, startnum, endnum
    character(STRING):: cause_c
    character(*), parameter:: subname = "HstVarsOutputCheck"
  continue
    call BeginSub(subname)
    stat = DC_NOERR
    cause_c = ""

    startnum = 1
    endnum   = numvars

    if ( present(vnum_op) ) then
      startnum = vnum_op
      endnum   = vnum_op
    end if

    do i = startnum, endnum

      if ( .not. output_valid_vars(i) ) cycle

      if ( originstep_vars(i) > Nstep ) cycle

      if ( terminusstep_vars(i) > 0 .and. terminusstep_vars(i) < Nstep ) cycle

      if ( originstep_vars(i) == Nstep ) then
        call HstFileCreate( gthst_history_vars(i) % gthist, varname_vars(i) )                                 ! (in)

        output_timing_vars(i) = .true.
        cycle
      end if

      if ( terminusstep_vars(i) == Nstep ) then
        if ( HistoryInitialized( gthst_history_vars(i) % gthist ) ) then
          call HistoryClose( gthst_history_vars(i) % gthist )   ! (inout)
        end if
        output_timing_vars(i) = .false.
        cycle
      end if

      if ( newfile_intstep_vars(i) > 0 ) then
        if ( mod( Nstep, newfile_intstep_vars(i) ) == 0 ) then
          if (  HistoryInitialized( gthst_history_vars(i) % gthist ) ) then
            call HistoryClose( gthst_history_vars(i) % gthist )   ! (inout)
          end if
          call HstFileCreate( gthst_history_vars(i) % gthist, varname_vars(i) )                                 ! (in)
          output_timing_vars(i) = .true.
          cycle
        end if
      end if

      if ( tavr_vars(i) ) then
        output_timing_vars(i) = .true.
        cycle
      end if

      if ( mod( Nstep, intstep_vars(i) ) == 0 ) then
        output_timing_vars(i) = .true.
        cycle
      end if

      output_timing_vars(i) = .false.

    end do

999 continue
    call StoreError(stat, subname, cause_c = cause_c)
    call EndSub(subname)
  end subroutine HstVarsOutputCheck
MAX_DIMS_DEPENDED_BY_VAR
Constant :
MAX_DIMS_DEPENDED_BY_VAR = 7 :integer, parameter
Nstep
Variable :
Nstep = 0 :integer, save
SLICE_INFO
Derived Type :
st(:) =>null() :integer, pointer
: 空間方向の開始点. Start points of spaces.
ed(:) =>null() :integer, pointer
: 空間方向の終了点. End points of spaces.
sd(:) =>null() :integer, pointer
: 空間方向の刻み幅. Strides of spaces

空間切り出し情報管理用の構造型 Derived type for information of slice of space

SPACE_AVR_INFO
Derived Type :
avr(:) =>null() :logical, pointer
: 平均化のフラグ. Flag of average.

空間平均情報管理用の構造型 Derived type for information of average in space direction

all_output_save
Variable :
all_output_save = .false. :logical, save
conventions_save
Variable :
conventions_save :character(STRING), save
current_difftime
Variable :
current_difftime :type(DC_DIFFTIME), save
data_axes
Variable :
data_axes(1:NF_MAX_DIMS) :type(GT_HISTORY_AXIS_DATA), save, target
data_weights
Variable :
data_weights(1:NF_MAX_DIMS) :type(GT_HISTORY_AXIS_DATA), save, target
delta_difftime
Variable :
delta_difftime :type(DC_DIFFTIME), save
deltime_value_vars
Variable :
deltime_value_vars(1:NF_MAX_VARS) = 1.0 :real, save
: Δt. Delta t
gt_version_save
Variable :
gt_version_save :character(TOKEN), save
gthst_axes
Variable :
gthst_axes(1:NF_MAX_DIMS) :type(GT_HISTORY_AXIS), save, target
gthst_history_vars
Variable :
gthst_history_vars(1:NF_MAX_VARS) :type(GT_HISTORY_DUMMY), save
gthst_vars
Variable :
gthst_vars(1:NF_MAX_VARS) :type(GT_HISTORY_VARINFO), save
gthst_weights
Variable :
gthst_weights(1:NF_MAX_DIMS) :type(GT_HISTORY_VARINFO), save
gthstnml
Variable :
gthstnml :type(GTHST_NMLINFO), save
initialized
Variable :
initialized = .false. :logical, save
institution_save
Variable :
institution_save :character(STRING), save
intstep_vars
Variable :
intstep_vars(1:NF_MAX_VARS) = 1 :integer, save
: 出力間隔のステップ数. Number of step of interval of output.
max_remainder_range
Constant :
max_remainder_range = 1.0e-3_DP :real(DP), parameter
newfile_intstep_vars
Variable :
newfile_intstep_vars(1:NF_MAX_VARS) = -1 :integer, save
: ファイルを新規に作り直すステップ数. Number of step of remake of file
numdims
Variable :
numdims :integer, save
numvars
Variable :
numvars = 0 :integer, save
numwgts
Variable :
numwgts = 0 :integer, save
once_progressed
Variable :
once_progressed = .false. :logical, save
origin_value_vars
Variable :
origin_value_vars(1:NF_MAX_VARS) = 0.0 :real, save
: 出力開始時刻. Start time of output
originstep_vars
Variable :
originstep_vars(1:NF_MAX_VARS) = 0 :integer, save
: ファイルを作成するステップ数. Number of step of creation of file
output_timing_vars
Variable :
output_timing_vars(1:NF_MAX_VARS) = .false. :logical, save
: 現在のステップでは出力を行うか否か. Whether output is done or not at currrent step.
output_valid_vars
Variable :
output_valid_vars(1:NF_MAX_VARS) = .false. :logical, save
: 変数出力が有効か否か. Whether output of variables is valid or not.
rank_save
Variable :
rank_save :character(TOKEN), save
slice_vars
Variable :
slice_vars(1:NF_MAX_VARS) :type(SLICE_INFO), save, target
source_save
Variable :
source_save :character(STRING), save
space_avr_vars
Variable :
space_avr_vars(1:NF_MAX_VARS) :type(SPACE_AVR_INFO), save, target
start_difftime
Variable :
start_difftime :type(DC_DIFFTIME), save
sub_sname
Constant :
sub_sname = "HistAuto" :character(*), parameter
tavr_vars
Variable :
tavr_vars(1:NF_MAX_VARS) = .false. :logical, save
: 時間平均フラグ. Flag for time average
terminusstep_vars
Variable :
terminusstep_vars(1:NF_MAX_VARS) = -1 :integer, save
: ファイルをクローズするステップ数. Number of step of closure of file
time_unit_bycreate
Variable :
time_unit_bycreate :character(TOKEN)
title_save
Variable :
title_save :character(STRING), save
varname_vars
Variable :
varname_vars(1:NF_MAX_VARS) = ’’ :character(TOKEN), save
version
Constant :
version = ’$Name: gt4f90io-20080729 $’ // ’$Id: gt4_historyauto.f90,v 1.33 2008-07-29 18:27:16 morikawa Exp $’ :character(*), parameter
weight_vars
Variable :
weight_vars(1:NF_MAX_VARS) :type(AXES_WEIGHT), save, target
wgtsuf
Constant :
wgtsuf = ‘_weight‘ :character(*), parameter

[Validate]