historycreate.f90

Go to the documentation of this file.

!--
! *** Caution!! ***
!
! This file is generated from "historycreate.rb2f90" by Ruby 3.3.8.
! Please do not edit this file directly.
!
! [JAPANESE]
!
! ※※※ 注意!!! ※※※
!
! このファイルは "historycreate.rb2f90" から Ruby 3.3.8
! によって自動生成されたファイルです.
! このファイルを直接編集しませんようお願い致します.
!
!
!++
  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 )
    !
    !
    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, cprintft, 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
    use mpi
    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
    integer:: err_mpi, index_nc_mpi
    character(STRING):: file_mpi
    character(TOKEN):: myrank_str_mpi, nc_suffix_mpi
    character(*), parameter:: subname = "HistoryCreate1"
    character(*), parameter:: version = &
      & '$Name:  $' // &
      & '$Id: historycreate.rb2f90,v 1.4 2009-11-03 05:22: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
    !
    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
    ! MPI 使用時のファイル名の扱い
    ! Treat file names when MPI is used
    !
    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 = cprintft( '_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
    ! 変数 URL (出力ファイル) の作成
    ! Create variable URL (output file)
    !
    do, i = 1, numdims
      my_xtype = ""
      if ( present(xtypes) ) then
        if ( size(xtypes) >= i ) then
          my_xtype = cprintft('%c', c1=xtypes(i))
        end if
      end if
      if ( hst % mpi_split ) then
        url = urlmerge(file=file_mpi, var=dims(i))
      else
        url = urlmerge(file=file, var=dims(i))
      end if
      overwrite_required = .true.
      if (present_and_false(overwrite)) overwrite_required = .false.
      if ( .not. hst % mpi_gather ) then
      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)))
      else
        my_xtype = ""
        if ( present(xtypes) ) then
          if ( size(xtypes) >= i ) then
            my_xtype = cprintft('%c', c1=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 = cprintft('%c', c1=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 = cprintft('%c', c1=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
      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
    !
    if ( .not. hst % mpi_gather ) then
    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
    end if
    ! 終了処理, 例外処理
    ! 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 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 )
    !
    !
    use dc_trace, only: beginsub, endsub
    use dc_error,   only: storeerror, dc_noerr
    use dc_types,   only: string, token, dp
    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
    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:  $' // &
      & '$Id: historycreate.rb2f90,v 1.4 2009-11-03 05:22: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
    call storeerror(stat, subname, cause_c=cause_c)
    call endsub(subname, 'stat=%d', i = (/stat/) )
  end subroutine historycreate2
  !-------------------------------------------------------------------
  subroutine historycreate3(file, title, source, institution, &
    & axes, origin, interval, history, origind, intervald, conventions, gt_version, &
    & overwrite, quiet, flag_mpi_gather, flag_mpi_split, err )
    !
    !
    use dc_types,   only: string, 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
    type(gt_history), pointer:: hst =>null()
    integer:: attr_size
    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 )
    if ( .not. present_and_true( flag_mpi_gather ) ) then
    do i = 1, ndims
      if ( .not. associated( axes(i) % attrs ) ) cycle
      call append_attrs( axes(i) % name, axes(i) % attrs, history )
    end do
    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
    call endsub(subname)
  end subroutine historycreate3
!--
! vi:set readonly sw=4 ts=8:
!
!Local Variables:
!mode: f90
!buffer-read-only: t
!End:
!
!++