Subroutine : |
|
file : | character(*), intent(in)
: | 出力するファイルの名前. Name of output file
|
|
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)
となります. (gtool_history
では時間の次元に対して無制限次元を 用いることを想定しています). ただし, 1
つの NetCDF ファイル (バージョン 3) は最大で 1
つの無制限次元しか持てないので, 2 ヶ所以上に ‘0’
を指定しないでください. その場合, 正しく gtool4 データが出力されません.
Lengths of dimensions specified with "dims".
Length of this array must be same as length of "dim". If
‘0’ (zero) is specified, the dimension is treated as unlimited
dimension. (In "gtool_history",
unlimited dimension is expected to be used as time). Note that one NetCDF
file (version 3) can not have two or more unlimited dimensions, so that do
not specify ‘0’ to two or more places. In that case, gtoo4 data
is not output currently
|
|
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.
|
|
origin : | real, intent(in), optional
: | 時間の原点.
これは HistoryPut により変数を最初に 出力するときの時間となります.
省略した場合, 時間の原点には 自動的に 0.0 が設定されます.
Origin of time.
This time is used as time when first output is done by
"HistoryPut".
If this argument is omitted, 0.0 is specified automatically.
|
|
interval : | real, intent(in), optional
: | 出力時間間隔.
同じ変数に対して HistoryPut が複数回 呼ばれた時に, 自動的に時間変数がこの値
だけ増やされて出力されます. なお, 各々の出力ファイルにつき HistorySetTime
を一度でも用いた場合, この値は無効に なるので注意してください.
省略した場合, 自動的に 1.0 が設定されます.
Interval of output time.
When "HistoryPut" is called two or more times for the same
variable, time is increased as this value and output automatically. Note
that this value becomes invalid when "HistorySetTime" is used for
each output file even once.
If this argument is omitted, 1.0 is specified automatically.
|
|
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.
|
|
history : | type(GT_HISTORY), intent(out), optional, target
: | 出力ファイルの設定に関する情報を 格納した構造体.
1 つのプログラムで複数のファイル に gtool データを出力する
場合に利用します. (単独のファイルに書き出す場合は 指定する必要はありません)
Derived type that stores information about output files.
If multiple gtool4 data files are output from one program, use this
argument. (If onlye one file is output, this argument is not needed).
|
|
origind : | real(DP), intent(in), optional
: | 時間の原点. (倍精度実数)
time と同様です.
Origin of time. (Double precision)
This is same as time.
|
|
intervald : | real(DP), intent(in), optional
: | 出力時間間隔. (倍精度実数)
interval と同様です.
Interval of output time. (Double precision)
This is same as interval.
|
|
conventions : | character(*), intent(in), optional
|
gt_version : | character(*), intent(in), optional
: | gtool4 netCDF 規約のバージョン
省略した場合, gt_version 属性に 規約の最新版のバージョンナンバー
gtool4_netCDF_version が与えられます. (ただし, 引数 conventions に gtool_history_internal#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, gtool_history_internal#gtool4_netCDF_Conventions
is not given to an argument "conventions", attribute
"gt_version" is not created).
|
|
overwrite : | logical, intent(in), optional
: | 上書き可否
この引数に .false. を渡すと, 既存のファイルを上書きしません.
デフォルトは上書きします.
Whether or not to overwrite.
If .false. is specified to this argument, an existing file is not
overwritten. By default, existing file is overwritten.
|
|
quiet : | logical, intent(in), optional
: | .true. を与えた場合, メッセージ出力が抑制されます. デフォルトは .false.
です.
If ".true." is given, messages are suppressed. Default value is
".false.".
|
|
flag_mpi_gather : | logical, intent(in), optional
: | MPI 使用時に, 各ノードで HistoryPut
に与えたデータを一つのファイルに統合して出力 する場合には .true.
を与えてください. デフォルトは .false. です.
.true. を与えた場合, HistoryPutAxisMPI に全体の軸データを与えてください.
When MPI is used, if ".true." is given, data given to
"HistoryPut" on each node is integrated and output to one file.
Default value is ".false.".
If .true. is given, give data of axes in whole area to
"HistoryPutAxisMPI"
|
|
flag_mpi_split : | logical, intent(in), optional
: | MPI 使用時にこの引数に .true. を与えると, 各ノードごとに file
引数に "_rankXXXXXX" (X は [0-9] の数値で, ノード番号を指す)
を付加したファイルを出力します. 例えば, file に
"output.nc" を与えた場合. ノード 0 では
"output_rank000000.nc", ノード 12 では
"output_rank000012.nc" を出力します. デフォルトは .false. です.
When MPI is used, if ".true." is given, files that have names
with suffixes "_rankXXXXXX" (X is [0-9] that indicates node
number) are output on each node. For example, "output.nc" is
given to file, "output_rank000000.nc",
"output_rank000012.nc" are output on node 0 and node 12. Default
value is ".false.".
|
|
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.
|
|
このサブルーチンは、gtool4 データ出力の初期設定を行います。
HistoryAddVariable、 HistoryCopyVariable、 HistoryPut、 HistoryAddAttr、
HistoryClose、 HistorySetTime を用いるためには、HistoryCreate
による初期設定が必要です。
なお、プログラム内で HistoryCreate を呼び出した場合、
プログラムを終了する前に必ず、 HistoryClose を呼び出して
終了処理を行なって下さい。
subroutine HistoryCreate1( file, title, source, institution, dims, dimsizes, longnames, units, origin, interval, xtypes, history, origind, intervald, conventions, gt_version, overwrite, quiet, flag_mpi_gather, flag_mpi_split, err )
!
!== gtool4 データ出力用初期設定
!
! このサブルーチンは、gtool4 データ出力の初期設定を行います。
! HistoryAddVariable、 HistoryCopyVariable、 HistoryPut、
! HistoryAddAttr、 HistoryClose、 HistorySetTime
! を用いるためには、HistoryCreate による初期設定が必要です。
!
! なお、プログラム内で HistoryCreate を呼び出した場合、
! プログラムを終了する前に必ず、 HistoryClose を呼び出して
! 終了処理を行なって下さい。
!
! *HistoryCreate* というサブルーチン名は 2 つの別々の
! サブルーチンの総称名です。上記のサブルーチンも参照ください。
!
!
! Two specific subroutines shares common part:
!
! Both two ones initializes a dataset *file*.
! The result of type GT_HISTORY will be returned by *history*
! or managed internally if omitted.
! Mandatory global attributes are defined by arguments
! *title*, *source*, and *institution*;
! they are all declared as ((character(len = *))).
! Spatial axis definitions have two different forms:
! a primitive one uses several arrays of various types:
! *dims*, *dimsizes*, *longnames*, *units*, and *xtypes*.
! Another sophisticated one has only array of type GT_HISTORY_AXIS,
! *axes*.
! Temporal definition is done without *origin*, *interval*.
!
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_internal, only: default, gtool4_netCDF_Conventions, gtool4_netCDF_version
use gtool_history_generic, only: HistoryAxisCreate
use gtdata_generic,only: Create, put_attr, Get_Attr
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_error, only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH, DC_EALREADYINIT
use dc_string, only: JoinChar, toChar, StoA, CPrintf, LChar
use dc_url, only: UrlMerge
use dc_present, only: present_and_not_empty, present_and_false, present_and_true
use dc_types, only: STRING, TOKEN, DP
use dc_message, only: MessageNotify
use dc_calendar, only: DC_CAL, DC_CAL_DATE, DCCalCreate, DCCalDateCurrent, DCCalDateInquire
use dc_date_types, only: DC_DATETIME, DC_DIFFTIME, UNIT_SYMBOL_ERR, UNIT_SYMBOL_SEC
use dc_date, only: DCDateTimeCreate, toChar, DCDiffTimeCreate, EvalByUnit, ParseTimeUnits
use sysdep, only: SysdepEnvGet
#ifdef LIB_MPI
use mpi
#endif
implicit none
character(*), intent(in):: file
! 出力するファイルの名前.
! Name of output file
character(*), intent(in):: title
! データ全体の表題.
! Title of entire data
character(*), intent(in):: source
! データを作成する際の手段.
! Source of data file
character(*), intent(in):: institution
! ファイルを最終的に変更した組織/個人.
! Institution or person that changes files for the last time
character(*), intent(in):: dims(:)
! 次元の名前.
!
! 配列の大きさに制限はありません.
! 個々の次元の文字数は dc_types#TOKEN まで.
! 配列内の文字数は
! 全て同じでなければなりません.
! 足りない文字分は空白で
! 補ってください.
!
! Names of dimensions.
!
! Length of array is unlimited.
! Limits of numbers of characters of each
! dimensions are "dc_types#TOKEN".
! Numbers of characters in this array
! must be same.
! Make up a deficit with blanks.
!
integer, intent(in):: dimsizes (:)
! dims で指定したそれぞれの次元大きさ.
!
! 配列の大きさは dims の大きさと等しい
! 必要があります. '0' (数字のゼロ) を指定
! するとその次元は 無制限次元 (unlimited
! dimension) となります. (gtool_history
! では時間の次元に対して無制限次元を
! 用いることを想定しています). ただし,
! 1 つの NetCDF ファイル (バージョン 3)
! は最大で 1 つの無制限次元しか持てないので,
! 2 ヶ所以上に '0' を指定しないでください.
! その場合, 正しく gtool4 データが出力されません.
!
! Lengths of dimensions specified with "dims".
!
! Length of this array must be same as
! length of "dim". If '0' (zero) is
! specified, the dimension is treated as
! unlimited dimension.
! (In "gtool_history", unlimited dimension is
! expected to be used as time).
! Note that one NetCDF file (version 3)
! can not have two or more unlimited
! dimensions, so that do not specify '0'
! to two or more places. In that case,
! gtoo4 data is not output currently
!
character(*), intent(in):: longnames (:)
! dims で指定したそれぞれの次元の名前.
!
! 配列の大きさは dims の大きさ
! と等しい必要があります. 文字数
! は dc_types#STRING まで.
! 配列内の文字数は
! 全て同じでなければなりません.
! 足りない文字分は空白で補います.
!
! Names of dimensions specified with "dims".
!
! Length of this array must be same as
! length of "dim".
! Limits of numbers of characters are
! "dc_types#STRING".
! Numbers of characters in this array
! must be same.
! Make up a deficit with blanks.
!
character(*), intent(in):: units(:)
! dims で指定したそれぞれの次元の単位.
!
! 配列の大きさは dims の大きさ
! と等しい必要があります. 文字数
! は dc_types#STRING まで.
! 配列内の文字数は
! 全て同じでなければなりません.
! 足りない文字分は空白で補います.
!
! Units of dimensions specified with "dims".
!
! Length of this array must be same as
! length of "dim".
! Limits of numbers of characters are
! "dc_types#STRING".
! Numbers of characters in this array
! must be same.
! Make up a deficit with blanks.
!
real, intent(in), optional:: origin
! 時間の原点.
!
! これは HistoryPut により変数を最初に
! 出力するときの時間となります.
!
! 省略した場合, 時間の原点には
! 自動的に 0.0 が設定されます.
!
! Origin of time.
!
! This time is used as time
! when first output is done by "HistoryPut".
!
! If this argument is omitted,
! 0.0 is specified automatically.
!
real, intent(in), optional:: interval
! 出力時間間隔.
!
! 同じ変数に対して HistoryPut が複数回
! 呼ばれた時に, 自動的に時間変数がこの値
! だけ増やされて出力されます. なお,
! 各々の出力ファイルにつき HistorySetTime
! を一度でも用いた場合, この値は無効に
! なるので注意してください.
!
! 省略した場合, 自動的に 1.0 が設定されます.
!
! Interval of output time.
!
! When "HistoryPut" is called two or
! more times for the same variable, time
! is increased as this value and
! output automatically.
! Note that this value becomes
! invalid when "HistorySetTime" is
! used for each output file even once.
!
! If this argument is omitted,
! 1.0 is specified automatically.
!
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.
!
type(GT_HISTORY), intent(out), optional, target:: history
! 出力ファイルの設定に関する情報を
! 格納した構造体.
!
! 1 つのプログラムで複数のファイル
! に gtool データを出力する
! 場合に利用します.
! (単独のファイルに書き出す場合は
! 指定する必要はありません)
!
! Derived type that
! stores information about output files.
!
! If multiple gtool4 data files are
! output from one program, use this
! argument.
! (If onlye one file is output,
! this argument is not needed).
!
real(DP), intent(in), optional:: origind
! 時間の原点. (倍精度実数)
!
! *time* と同様です.
!
! Origin of time. (Double precision)
!
! This is same as *time*.
!
real(DP), intent(in), optional:: intervald
! 出力時間間隔. (倍精度実数)
!
! *interval* と同様です.
!
! Interval of output time. (Double precision)
!
! This is same as *interval*.
!
character(*), intent(in), optional:: conventions
! 出力するファイルの netCDF
! 規約
!
! 省略した場合,
! もしくは空文字を与えた場合,
! 出力する netCDF 規約の
! Conventions 属性に値
! gtool_history_internal#gtool4_netCDF_Conventions
! が自動的に与えられます.
!
! NetCDF conventions of output file.
!
! If this argument is omitted or,
! blanks are given,
! gtool_history_internal#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 に
! gtool_history_internal#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, gtool_history_internal#gtool4_netCDF_Conventions is
! not given to an argument "conventions",
! attribute "gt_version" is not created).
!
logical, intent(in), optional:: overwrite
! 上書き可否
!
! この引数に .false. を渡すと,
! 既存のファイルを上書きしません.
! デフォルトは上書きします.
!
! Whether or not to overwrite.
!
! If .false. is specified to this
! argument, an existing file is not
! overwritten.
! By default, existing file is overwritten.
!
logical, intent(in), optional:: quiet
! .true. を与えた場合,
! メッセージ出力が抑制されます.
! デフォルトは .false. です.
!
! If ".true." is given,
! messages are suppressed.
! Default value is ".false.".
!
logical, intent(in), optional:: flag_mpi_gather
! MPI 使用時に, 各ノードで HistoryPut
! に与えたデータを一つのファイルに統合して出力
! する場合には .true. を与えてください.
! デフォルトは .false. です.
!
! .true. を与えた場合, HistoryPutAxisMPI
! に全体の軸データを与えてください.
!
! When MPI is used, if ".true." is given,
! data given to "HistoryPut" on each node
! is integrated and output to one file.
! Default value is ".false.".
!
! If .true. is given, give data of axes in
! whole area to "HistoryPutAxisMPI"
!
logical, intent(in), optional:: flag_mpi_split
! MPI 使用時にこの引数に .true. を与えると,
! 各ノードごとに
! *file* 引数に "_rankXXXXXX"
! (X は [0-9] の数値で, ノード番号を指す)
! を付加したファイルを出力します.
! 例えば, *file* に "output.nc" を与えた場合.
! ノード 0 では "output_rank000000.nc",
! ノード 12 では "output_rank000012.nc"
! を出力します.
! デフォルトは .false. です.
!
! When MPI is used, if ".true." is given,
! files that have names with suffixes
! "_rankXXXXXX"
! (X is [0-9] that indicates node number)
! are output on each node.
! For example, "output.nc" is given to *file*,
! "output_rank000000.nc", "output_rank000012.nc"
! are output on node 0 and node 12.
! Default value is ".false.".
!
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.
integer:: numdims, i, stat, blank_index
type(GT_HISTORY), pointer:: hst =>null()
character(TOKEN):: my_xtype, origin_str!, interval_str
character(STRING):: file_work, url, x_inst, x_conv, x_gtver, nc_history
character(STRING):: cause_c
logical:: gtver_add, overwrite_required
character(TOKEN):: username
type(DC_CAL):: cal_standard
type(DC_CAL_DATE):: now_date
character(TOKEN):: now_date_str
#ifdef LIB_MPI
integer:: err_mpi, index_nc_mpi
character(STRING):: file_mpi
character(TOKEN):: myrank_str_mpi, nc_suffix_mpi
#endif
character(*), parameter:: subname = "HistoryCreate1"
character(*), parameter:: version = '$Name: gtool5-20101228-1 $' // '$Id: historycreate.F90,v 1.5 2010-06-22 14:13:46 morikawa Exp $'
continue
call BeginSub(subname, 'file=%c ndims=%d', c1=trim(file), i=(/size(dims)/), version=version)
stat = DC_NOERR
cause_c = ""
call DbgMessage( 'dims(:)=%a, dimsizes(:)=%a, longnames(:)=%a, units(:)=%a', ca=StoA(JoinChar(dims), toChar(dimsizes), JoinChar(longnames), JoinChar(units)))
if (present(history)) then
hst => history
else
hst => default
endif
! 初期設定のチェック
! Check initialization
!
if ( hst % initialized ) then
stat = DC_EALREADYINIT
cause_c = 'GT_HISTORY'
goto 999
end if
! dims, dimsizes, longnames, units の整合性チェック
! Check consistency about "dims", "dimsizes", "longnames", "units"
!
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
! 次元変数表作成.
! Create table of dimensional variables
!
allocate(hst % dimvars(numdims))
allocate(hst % dim_value_written(numdims))
hst % dim_value_written(:) = .false.
hst % unlimited_index = 0
! ユーザ名の取得
! Get user name
!
call SysdepEnvGet('USER', username)
if (trim(username) == '') username = 'unknown'
! 現在時刻の取得
! Get current time
!
call DCCalDateCurrent( now_date )
call DCCalCreate( 'gregorian', cal_standard )
call DCCalDateInquire( now_date_str, date = now_date, cal = cal_standard )
! call DCDateTimeCreate(now_time)
nc_history = trim(now_date_str) // ' ' // trim(username) // '> gtool_history: HistoryCreate' // achar(10)
! MPI に関連する情報の初期設定
! Initialize information about MPI
!
#ifdef LIB_MPI
hst % mpi_gather = present_and_true( flag_mpi_gather )
hst % mpi_split = present_and_true( flag_mpi_split )
allocate( hst % mpi_fileinfo )
allocate( hst % mpi_fileinfo % axes(numdims) )
allocate( hst % mpi_dimdata_all(numdims) )
allocate( hst % mpi_dimdata_each(numdims) )
if ( hst % unlimited_index /= 0 ) then
hst % mpi_dimdata_all( hst % unlimited_index ) % length = 0
hst % mpi_dimdata_each( hst % unlimited_index ) % length = 0
end if
#else
hst % mpi_gather = .false.
hst % mpi_split = .false.
#endif
! MPI 使用時のファイル名の扱い
! Treat file names when MPI is used
!
#ifndef LIB_MPI
file_work = file
#else
file_work = file
if ( hst % mpi_gather .or. hst % mpi_split ) then
call MPI_Comm_Rank(MPI_COMM_WORLD, hst % mpi_myrank, err_mpi)
call MPI_Comm_Size(MPI_COMM_WORLD, hst % mpi_nprocs, err_mpi)
end if
if ( hst % mpi_split ) then
file_mpi = file
myrank_str_mpi = CPrintf( '_rank%06d', i = (/ hst % mpi_myrank /) )
index_nc_mpi = index( LChar(file_mpi), '.nc' )
if ( index_nc_mpi > 1 ) then
nc_suffix_mpi = file_mpi(index_nc_mpi:)
file_mpi = file_mpi(:index_nc_mpi-1) // trim( myrank_str_mpi ) // trim( nc_suffix_mpi )
elseif ( index_nc_mpi > 0 ) then
file_mpi = trim( myrank_str_mpi ) // trim( file_mpi )
else
file_mpi = trim( file_mpi ) // trim( myrank_str_mpi )
end if
file_work = file_mpi
end if
#endif
! 変数 URL (出力ファイル) の作成
! Create variable URL (output file)
!
do, i = 1, numdims
my_xtype = ""
if ( present(xtypes) ) then
if ( size(xtypes) >= i ) then
my_xtype = xtypes(i)
end if
end if
#ifndef LIB_MPI
url = UrlMerge(file=file, var=dims(i))
#else
if ( hst % mpi_split ) then
url = UrlMerge(file=file_mpi, var=dims(i))
else
url = UrlMerge(file=file, var=dims(i))
end if
#endif
overwrite_required = .true.
if (present_and_false(overwrite)) overwrite_required = .false.
#ifdef LIB_MPI
if ( .not. hst % mpi_gather ) then
#endif
call Create( hst % dimvars(i), trim(url), dimsizes(i), xtype=trim(my_xtype), overwrite=overwrite_required)
! conventions が存在しない場合はデフォルトの値を
! 属性 Conventions に付加。
if ( present_and_not_empty(conventions) ) then
x_conv = conventions
else
x_conv = gtool4_netCDF_Conventions
endif
! 1) gt_version がある場合、それを gt_version 属性に渡す。
! 2) gt_version が無い場合、conventions も無いか、または
! gtool4 netCDF 規約が入っていれば最新版を gt_version
! に与える。そうでない場合は gt_version 属性を与えない。
if (present_and_not_empty(gt_version)) then
x_gtver = gt_version
gtver_add = .TRUE.
else
if ( present_and_not_empty(conventions) .and. .not. x_conv == gtool4_netCDF_Conventions ) then
gtver_add = .FALSE.
else
x_gtver = gtool4_netCDF_version
gtver_add = .TRUE.
endif
endif
if (trim(institution) /= "") then
x_inst = institution
else
x_inst = "a gtool_history (by GFD Dennou Club) user"
endif
call Put_Attr(hst % dimvars(i), '+Conventions', trim(x_conv))
if (gtver_add) then
call Put_Attr(hst % dimvars(i), '+gt_version', trim(x_gtver))
endif
! title, source, institution, history, long_name, units 属性の付加
call Put_Attr(hst % dimvars(i), '+title', title)
call Put_Attr(hst % dimvars(i), '+source', source)
call Put_Attr(hst % dimvars(i), '+institution', trim(x_inst))
call Put_Attr(hst % dimvars(i), '+history', trim(nc_history))
call Put_Attr(hst % dimvars(i), 'long_name', trim(longnames(i)))
call Put_Attr(hst % dimvars(i), 'units', trim(units(i)))
#ifdef LIB_MPI
else
my_xtype = ""
if ( present(xtypes) ) then
if ( size(xtypes) >= i ) then
my_xtype = xtypes(i)
end if
end if
call HistoryAxisCreate( hst % mpi_fileinfo % axes(i), dims(i), dimsizes(i), longnames(i), units(i), my_xtype )
hst % mpi_fileinfo % file = file
hst % mpi_fileinfo % title = title
hst % mpi_fileinfo % source = source
hst % mpi_fileinfo % overwrite = .true.
if (present_and_false(overwrite)) hst % mpi_fileinfo % overwrite = .false.
if ( present_and_not_empty(conventions) ) then
hst % mpi_fileinfo % conventions = conventions
else
hst % mpi_fileinfo % conventions = gtool4_netCDF_Conventions
endif
if (present_and_not_empty(gt_version)) then
hst % mpi_fileinfo % gt_version = gt_version
hst % mpi_fileinfo % gtver_add = .TRUE.
else
if ( present_and_not_empty(conventions) .and. .not. hst % mpi_fileinfo % conventions == gtool4_netCDF_Conventions ) then
hst % mpi_fileinfo % gtver_add = .FALSE.
else
hst % mpi_fileinfo % gt_version = gtool4_netCDF_version
hst % mpi_fileinfo % gtver_add = .TRUE.
endif
endif
if (trim(institution) /= "") then
hst % mpi_fileinfo % institution = institution
else
hst % mpi_fileinfo % institution = "a gtool_history (by GFD Dennou Club) user"
endif
hst % mpi_fileinfo % quiet = .false.
hst % mpi_fileinfo % quiet = present_and_true(quiet)
hst % mpi_fileinfo % nc_history = nc_history
end if
#endif
if (dimsizes(i) == 0) then
hst % unlimited_index = i
hst % unlimited_units = units(i)
end if
enddo
! 従属変数表の初期化
! Initialize table of dependent variables
!
nullify(hst % vars, hst % growable_indices, hst % count)
! 時刻の単位
!
if ( hst % unlimited_index == 0 ) then
hst % unlimited_units_symbol = UNIT_SYMBOL_SEC
else
blank_index = index( trim( adjustl(hst % unlimited_units) ), ' ' )
if ( blank_index > 1 ) then
hst % unlimited_units = hst % unlimited_units(1:blank_index-1)
end if
hst % unlimited_units_symbol = ParseTimeUnits( hst % unlimited_units )
if ( hst % unlimited_units_symbol == UNIT_SYMBOL_ERR ) then
call MessageNotify('W', subname, 'units of time (%c) can not be recognized as units of time. ' // 'This units is treated as (%c)', c1 = trim(hst % unlimited_units), c2 = 'sec')
hst % unlimited_units_symbol = UNIT_SYMBOL_SEC
end if
end if
! 時間カウンタ
!
if ( present(interval) ) then
hst % interval = interval
elseif ( present(intervald) ) then
hst % interval = intervald
else
hst % interval = 1.0
end if
if ( present (origin) ) then
hst % origin = origin
hst % origin_setting = .true.
elseif( present(origind) ) then
hst % origin = origind
hst % origin_setting = .true.
else
hst % origin = 0.0
hst % origin_setting = .false.
end if
origin_str = trim( toChar( hst % origin ) ) // ' [' // trim( hst % unlimited_units ) // ']'
hst % newest = hst % origin
hst % oldest = hst % origin
! 時間平均値出力に関するデフォルト設定
! Default settings for time-averaged value output
!
hst % time_bnds = hst % origin
hst % time_bnds_output_count = 0
! メッセージ出力
! Output messages
!
#ifdef LIB_MPI
if ( .not. hst % mpi_gather ) then
#endif
if ( .not. present_and_true(quiet) ) then
call MessageNotify('M', subname, '"%c" is created (origin=%c)', c1 = trim( file_work ), c2 = trim( origin_str ), rank_mpi = -1 )
end if
#ifdef LIB_MPI
end if
#endif
! 終了処理, 例外処理
! Termination and Exception handling
!
hst % initialized = .true.
999 continue
call StoreError(stat, subname, err, cause_c=cause_c)
call EndSub(subname, 'stat=%d', i = (/stat/) )
end subroutine HistoryCreate1