| Path: | gtool/gtool_history/historycreate.F90 |
| Last Update: | Tue Jun 22 23:13:46 +0900 2010 |
| Authors: | Yasuhiro MORIKAWA, Eizi TOYODA |
| Version: | $Id: historycreate.F90,v 1.5 2010-06-22 14:13:46 morikawa Exp $ |
| Tag Name: | $Name: gtool5-20101228-1 $ |
| Copyright: | Copyright (C) GFD Dennou Club, 2000-2009. All rights reserved. |
| License: | See COPYRIGHT |
| Subroutine : | |||
| file : | character(*), intent(in)
| ||
| title : | character(*), intent(in)
| ||
| source : | character(*), intent(in)
| ||
| institution : | character(*), intent(in)
| ||
| dims(:) : | character(*), intent(in)
| ||
| dimsizes(:) : | integer, intent(in)
| ||
| longnames(:) : | character(*), intent(in)
| ||
| units(:) : | character(*), intent(in)
| ||
| origin : | real, intent(in), optional
| ||
| interval : | real, intent(in), optional
| ||
| xtypes(:) : | character(*), intent(in), optional
| ||
| history : | type(GT_HISTORY), intent(out), optional, target
| ||
| origind : | real(DP), intent(in), optional
| ||
| intervald : | real(DP), intent(in), optional
| ||
| conventions : | character(*), intent(in), optional
| ||
| gt_version : | character(*), intent(in), optional
| ||
| overwrite : | logical, intent(in), optional
| ||
| quiet : | logical, intent(in), optional
| ||
| flag_mpi_gather : | logical, intent(in), optional
| ||
| flag_mpi_split : | logical, intent(in), optional
| ||
| err : | logical, intent(out), optional
|
このサブルーチンは、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.
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
| Subroutine : | |||
| file : | character(*), intent(in)
| ||
| title : | character(*), intent(in)
| ||
| source : | character(*), intent(in)
| ||
| institution : | character(*), intent(in)
| ||
| dims(:) : | character(*), intent(in)
| ||
| dimsizes(:) : | integer, intent(in)
| ||
| longnames(:) : | character(*), intent(in)
| ||
| units(:) : | character(*), intent(in)
| ||
| origin : | type(DC_DIFFTIME), intent(in)
| ||
| interval : | type(DC_DIFFTIME), intent(in), optional
| ||
| xtypes(:) : | character(*), intent(in), optional
| ||
| history : | type(GT_HISTORY), intent(out), optional, target
| ||
| conventions : | character(*), intent(in), optional
| ||
| gt_version : | character(*), intent(in), optional
| ||
| overwrite : | logical, intent(in), optional
| ||
| quiet : | logical, intent(in), optional
| ||
| flag_mpi_gather : | logical, intent(in), optional
| ||
| flag_mpi_split : | logical, intent(in), optional
| ||
| err : | logical, intent(out), optional
|
このサブルーチンは、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.
subroutine HistoryCreate2( file, title, source, institution, dims, dimsizes, longnames, units, origin, interval, xtypes, history, 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 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
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 sysdep, only: SysdepEnvGet
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 gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_internal, only: default
use gtool_history_generic, only: HistoryCreate
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.
!
type(DC_DIFFTIME), intent(in):: 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.
!
type(DC_DIFFTIME), 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).
!
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:: 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.
type(GT_HISTORY), pointer:: hst =>null()
real(DP):: origind, intervald
integer:: i, numdims, blank_index
character(TOKEN):: unlimited_units
integer:: unit_symbol
integer:: stat
character(STRING):: cause_c
character(*), parameter:: subname = "HistoryCreate2"
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 = ""
numdims = size(dims)
unlimited_units = 'sec'
do, i = 1, numdims
if (dimsizes(i) == 0) unlimited_units = units(i)
end do
blank_index = index( trim( adjustl(unlimited_units) ), ' ' )
if ( blank_index > 1 ) then
unlimited_units = unlimited_units(1:blank_index-1)
end if
unit_symbol = ParseTimeUnits( unlimited_units )
if ( unit_symbol == UNIT_SYMBOL_ERR ) unit_symbol = UNIT_SYMBOL_SEC
if (present(interval)) then
intervald = EvalByUnit( interval, '', unit_symbol )
else
intervald = 1.0_DP
end if
origind = EvalByUnit( origin, '', unit_symbol )
call HistoryCreate( file = file, title = title, source = source, institution = institution, dims = dims, dimsizes = dimsizes, longnames = longnames, units = units, xtypes = xtypes, history = history, origind = origind, intervald = intervald, conventions = conventions, gt_version = gt_version, overwrite = overwrite, quiet = quiet, flag_mpi_gather = flag_mpi_gather, flag_mpi_split = flag_mpi_split, err = err )
if (present(history)) then
hst => history
else
hst => default
endif
999 continue
call StoreError(stat, subname, cause_c=cause_c)
call EndSub(subname, 'stat=%d', i = (/stat/) )
end subroutine HistoryCreate2
| Subroutine : | |||
| file : | character(*), intent(in)
| ||
| title : | character(*), intent(in) | ||
| source : | character(*), intent(in) | ||
| institution : | character(*), intent(in) | ||
| axes(:) : | type(GT_HISTORY_AXIS), intent(in)
| ||
| origin : | real, intent(in), optional | ||
| interval : | real, intent(in), optional | ||
| history : | type(GT_HISTORY), intent(out), optional, target | ||
| origind : | real(DP), intent(in), optional | ||
| intervald : | real(DP), intent(in), optional | ||
| conventions : | character(*), intent(in), optional | ||
| gt_version : | character(*), intent(in), optional | ||
| overwrite : | logical, intent(in), optional | ||
| quiet : | logical, intent(in), optional
| ||
| flag_mpi_gather : | logical, intent(in), optional
| ||
| flag_mpi_split : | logical, intent(in), optional
| ||
| err : | logical, intent(out), optional
|
HistoryCreate というサブルーチン名は 2 つの別々の サブルーチンの総称名です。まずは HistoryCreate を参照ください。
もう 1 つのサブルーチンと異なる点は、座標軸の情報を dims, dimsizes, longnames, units, and xtypes といった 個別の引数で与えるのではなく、構造体 GT_HISTORY_AXIS 型の 引数 axes で与える点にあります。
GT_HISTORY_AXIS 型変数の生成 (constructer) は HistoryAxisCreate にて行います。
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.
subroutine HistoryCreate3(file, title, source, institution, axes, origin, interval, history, origind, intervald, conventions, gt_version, overwrite, quiet, flag_mpi_gather, flag_mpi_split, err )
!
!== gtool4 データ出力用初期設定
!
! *HistoryCreate* というサブルーチン名は 2 つの別々の
! サブルーチンの総称名です。まずは HistoryCreate を参照ください。
!
! もう 1 つのサブルーチンと異なる点は、座標軸の情報を
! *dims*, *dimsizes*, *longnames*, *units*, and *xtypes* といった
! 個別の引数で与えるのではなく、構造体 GT_HISTORY_AXIS 型の
! 引数 *axes* で与える点にあります。
!
! GT_HISTORY_AXIS 型変数の生成 (constructer) は
! HistoryAxisCreate にて行います。
!
!
! 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 dc_types, only: STRING, TOKEN, DP
use dc_present, only: present_and_true
use dc_trace, only: BeginSub, EndSub, DbgMessage
use gtool_history_generic, only: HistoryCreate
use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
use gtool_history_internal, only: default, copy_attrs, append_attrs
implicit none
character(*), intent(in):: file
! HistoryCreate 参照
! (以下 axes を除く引数も同様)
!
character(*), intent(in):: title, source, institution
type(GT_HISTORY_AXIS), intent(in):: axes(:)
! 次元情報を格納した構造型変数
!
! GT_HISTORY_AXIS 型変数の生成
! (constructer) は
! HistoryAxisCreate にて行いま
! す。配列の大きさに制限は
! ありません。
!
real, intent(in), optional:: origin, interval
type(GT_HISTORY), intent(out), optional, target:: history
real(DP), intent(in), optional:: origind, intervald
character(*), intent(in), optional:: conventions, gt_version
logical, intent(in), optional:: overwrite
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.
! 構造体 GT_HISTORY_AXIS のデータ蓄積用
character(STRING), allocatable:: axes_name(:)
integer , allocatable:: axes_length(:)
character(STRING), allocatable:: axes_longname(:)
character(STRING), allocatable:: axes_units(:)
character(STRING), allocatable:: axes_xtype(:)
integer:: i, ndims
#ifdef LIB_MPI
type(GT_HISTORY), pointer:: hst =>null()
integer:: attr_size
#endif
character(len = *), parameter:: subname = "HistoryCreate3"
continue
call BeginSub(subname, 'file=%c ndims=%d', c1=trim(file), i=(/size(axes)/) )
! 構造体 GT_HISTORY_AXIS の axes からのデータ取得
! (Fujitsu Fortran などなら axes(:)%name という表記で配列
! データをそのまま引き渡せるが、Intel Fortran 8 などだと
! その表記をまともに解釈してくれないので、美しくないけど
! いったん他の配列に情報を引き渡す)。2004/11/27 morikawa
ndims = size( axes(:) )
allocate( axes_name(ndims) )
allocate( axes_length(ndims) )
allocate( axes_longname(ndims) )
allocate( axes_units(ndims) )
allocate( axes_xtype(ndims) )
do i = 1, ndims
axes_name(i) = axes(i) % name
axes_length(i) = axes(i) % length
axes_longname(i) = axes(i) % longname
axes_units(i) = axes(i) % units
axes_xtype(i) = axes(i) % xtype
call DbgMessage('axes(%d):name=<%c>, length=<%d>, ' // 'longname=<%c>, units=<%c>' , i=(/i, axes(i) % length/) , c1=( trim(axes(i) % name) ) , c2=( trim(axes(i) % longname) ) , c3=( trim(axes(i) % units) ) )
enddo
call HistoryCreate(file, title, source, institution, dims = axes_name(:), dimsizes = axes_length(:), longnames = axes_longname(:), units = axes_units(:), xtypes = axes_xtype(:), origin = origin, interval = interval, history = history, origind = origind, intervald = intervald, conventions = conventions, gt_version = gt_version, overwrite = overwrite, quiet = quiet, flag_mpi_gather = flag_mpi_gather, flag_mpi_split = flag_mpi_split, err = err )
deallocate( axes_name )
deallocate( axes_length )
deallocate( axes_longname )
deallocate( axes_units )
deallocate( axes_xtype )
#ifdef LIB_MPI
if ( .not. present_and_true( flag_mpi_gather ) ) then
#endif
do i = 1, ndims
if ( .not. associated( axes(i) % attrs ) ) cycle
call append_attrs( axes(i) % name, axes(i) % attrs, history )
end do
#ifdef LIB_MPI
else
if (present(history)) then
hst => history
else
hst => default
endif
do i = 1, ndims
if ( .not. associated( axes(i) % attrs ) ) cycle
attr_size = size( axes(i) % attrs )
allocate( hst % mpi_dimdata_all(i) % attrs( attr_size ) )
call copy_attrs( from = axes(i) % attrs, to = hst % mpi_dimdata_all(i) % attrs )
end do
endif
#endif
call EndSub(subname)
end subroutine HistoryCreate3