gtool4 データ入出力用 F90 インターフェース

  subroutine HistoryAxisCopy1(axis_dest, axis_src, err, name, length, longname, units, xtype)
    !
    !== GT_HISTORY_AXIS 型変数コピー
    !
    ! GT_HISTORY_AXIS 型の変数 *axis_src* を
    ! *axis_dest* にコピーします。
    ! *axis_src* は HistoryAxisCreate によって初期設定されている必要が
    ! あります。
    ! さらに属性を付加する場合には HistoryAxisAddAttr
    ! を用いてください。
    !
    ! *err* を与えておくと、コピーの際何らかの不具合が生じても
    ! 終了せずに err が真になって返ります。
    ! 
    ! *err* 以降の引数は、コピーの際に上書きする値です。
    !
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    use dc_present,only: present_select
    implicit none
    type(GT_HISTORY_AXIS),intent(out) :: axis_dest ! コピー先 GT_HISTORY_AXIS
    type(GT_HISTORY_AXIS),intent(in)  :: axis_src  ! コピー元 GT_HISTORY_AXIS
    logical, intent(out), optional :: err
    character(*) , intent(in), optional:: name     ! 次元変数名
    integer, intent(in), optional:: length         ! 次元長 (配列サイズ)
    character(*) , intent(in), optional:: longname ! 次元変数の記述的名称
    character(*) , intent(in), optional:: units    ! 次元変数の単位
    character(*) , intent(in), optional:: xtype    ! 次元変数の型
    character(STRING), parameter:: subname = "HistoryAxisCopy1"
  continue
    call BeginSub(subname)
    axis_dest % name     = present_select('', axis_src % name, name)
    axis_dest % length   = present_select(.false., axis_src % length, length)
    axis_dest % longname = present_select('', axis_src % longname, longname)
    axis_dest % units    = present_select('', axis_src % units, units)
    axis_dest % xtype    = present_select('', axis_src % xtype, xtype)

    if (associated( axis_src % attrs ) ) then
      allocate(  axis_dest % attrs( size( axis_src % attrs) )  )
      call HistoryAttrCopy( from = axis_src % attrs, to = axis_dest % attrs, err = err)
    end if
    call EndSub(subname)
  end subroutine HistoryAxisCopy1

  subroutine HistoryCopy1(hist_dest, file, hist_src, title, source, institution, origin, interval, conventions, gt_version)
    !
    ! hist_src の内容にコピーし, hist_dest へ返す.
    ! hist_src が与えられない場合は default が参照される.
    ! HistoryCreate と同様に, 出力の初期設定を行う. file
    ! は必ず与えなければならず, hist_src と同じファイルへ出力
    ! しようとする場合は下層でエラーを生じる.
    !
    ! それ以降の引数は hist_src の設定を上書きするためのものである.
    !
    use gtdata_generic, only: Inquire, Get_Attr, Copy_Attr, Get, Put
!      use dc_url,    only:
    use dc_error,   only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH
!      use dc_string, only:
    use dc_present, only: present_select
    use dc_types,   only: string, token
    implicit none
    type(GT_HISTORY), intent(out), target :: hist_dest
    character(*),     intent(in)          :: file
    type(GT_HISTORY), intent(in), optional, target:: hist_src
    character(*),     intent(in), optional:: title, source, institution

!!!$      type(GT_HISTORY_AXIS), intent(in),optional :: axes(:)
!!!$      type(GT_HISTORY_AXIS), intent(in),optional :: addaxes(:)
!!!$      character(*),     intent(in), optional:: dims(:)
!!!$      integer,          intent(in), optional:: dimsizes(:)
!!!$      character(*),     intent(in), optional:: longnames(:)
!!!$      character(*),     intent(in), optional:: units(:)
    real,             intent(in), optional:: origin, interval

!!!$      character(*),     intent(in), optional:: xtypes(:)
    character(*),     intent(in), optional:: conventions, gt_version

    ! Internal Work
    type(GT_HISTORY), pointer:: src =>null()
    character(STRING) :: title_src, source_src, institution_src
    character(STRING) :: conventions_src, gt_version_src
    character(STRING), pointer:: dims(:) => null()
    integer          , pointer:: dimsizes(:) => null()
    character(STRING), pointer:: longnames(:) => null()
    character(STRING), pointer:: units(:)  => null()
    character(STRING), pointer:: xtypes(:) => null()
    integer  :: i, numdims
    logical        :: err
    real(DP),pointer :: dimvalue(:) => null()
    character(len = *),parameter:: subname = "HistoryCopy1"
  continue
    call BeginSub(subname, 'file=<%c>', c1=trim(file))

    if (present(hist_src)) then
      src => hist_src
    else
      src => default
    endif
    numdims = size(src % dimvars)

    call HistoryInquire1(history=src, title=title_src, source=source_src, institution=institution_src, dims=dims, dimsizes=dimsizes, longnames=longnames, units=units, xtypes=xtypes, conventions=conventions_src, gt_version=gt_version_src)

    call HistoryCreate1(file=trim(file), title=trim(present_select('', title_src, title)), source=trim(present_select('', source_src, source)), institution=trim(present_select('', institution_src, institution)), dims=dims, dimsizes=dimsizes, longnames=longnames, units=units, origin=present_select(.false., src % origin, origin), interval=present_select(0.0, src % interval, interval), xtypes=xtypes, history=hist_dest, conventions=trim(present_select('', conventions_src, conventions)), gt_version=trim(present_select('', gt_version_src, gt_version)) )

    !
    ! 次元変数が属性を持っている場合のことも考え, 最後に直接
    ! hist_dst % dimvars へ copy_attr (gtvarcopyattrall) をかける.
    !
    do i = 1, numdims
      call Copy_Attr(hist_dest % dimvars(i), src % dimvars (i), global=.false.)
    end do

    ! dimvars を Get してみて, 値を持っているようならデータを与えてしまう.
    do i = 1, numdims
      if (dimsizes(i) == 0) cycle
      call Get(src % dimvars(i), dimvalue, err)
      if (err) cycle
      call HistoryPutDoubleEx(dims(i), dimvalue, size(dimvalue), hist_dest)
      deallocate(dimvalue)
    end do

    deallocate(dims, dimsizes, longnames, units, xtypes)

    call EndSub(subname)
  end subroutine HistoryCopy1

  subroutine HistoryVarinfoCopy1(varinfo_dest, varinfo_src, err, name, dims, longname, units, xtype)
    !
    !== GT_HISTORY_VARINFO 型変数コピー
    !
    ! GT_HISTORY_VARINFO 型の変数 *varinfo_src* を
    ! *varinfo_dest* にコピーします。
    ! *varinfo_src* は HistoryVarinfoCreate によって初期設定されている必要が
    ! あります。
    ! さらに属性を付加する場合には HistoryVarinfoAddAttr
    ! を用いてください。
    !
    ! *err* を与えておくと、コピーの際何らかの不具合が生じても
    ! 終了せずに err が真になって返ります。
    !
    ! *err* 以降の引数は、コピーの際に上書きする値です。
    !
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    use dc_present,only: present_select
    use dc_string, only: JoinChar
    implicit none
    type(GT_HISTORY_VARINFO),intent(out) :: varinfo_dest
    type(GT_HISTORY_VARINFO),intent(in)  :: varinfo_src

    logical,               intent(out), optional :: err
    character(*) , intent(in), optional:: name     ! 次元変数名
    character(*) , intent(in), optional, target:: dims(:)  ! 依存する次元
    character(*) , intent(in), optional:: longname ! 次元変数の記述的名称
    character(*) , intent(in), optional:: units    ! 次元変数の単位
    character(*) , intent(in), optional:: xtype    ! 次元変数の型
    integer                      :: i
    character(TOKEN), pointer :: srcdims(:) =>null() ! 依存する次元
    character(STRING), parameter:: subname = "HistoryVarinfoCopy1"
  continue
    call BeginSub(subname)
    varinfo_dest % name     = present_select('', varinfo_src % name, name)
    varinfo_dest % longname = present_select('', varinfo_src % longname, longname)
    varinfo_dest % units    = present_select('', varinfo_src % units, units)
    varinfo_dest % xtype    = present_select('', varinfo_src % xtype, xtype)

    if (present(dims)) then
      srcdims => dims
    else
      srcdims => varinfo_src % dims
    endif

    call DbgMessage('srcdims=<%c>', c1=trim(JoinChar(srcdims)))

    allocate(  varinfo_dest % dims( size( srcdims ) )  )
    do i = 1, size(srcdims)
      varinfo_dest % dims(i) = srcdims(i)
    end do

    call DbgMessage('varinfo_dest %% dims=<%c>', c1=trim(JoinChar(varinfo_dest % dims)))

    if (associated( varinfo_src % attrs ) ) then
      allocate(  varinfo_dest % attrs( size( varinfo_src % attrs) )  )
      call HistoryAttrCopy( from = varinfo_src % attrs, to = varinfo_dest % attrs, err = err)
    end if
    call EndSub(subname)
  end subroutine HistoryVarinfoCopy1

  subroutine HistoryAxisCreate1( axis, name, size, longname, units, xtype)
    !
    !== GT_HISTORY_AXIS 型変数作成
    !
    ! GT_HISTORY_AXIS 型変数を作成します。
    ! このサブルーチンによる設定の後、
    ! HistoryCreate の *axes* に与えます。
    ! さらに属性を付加する場合には HistoryAxisAddAttr
    ! を用いてください。
    !
    ! Constructor of GT_HISTORY_AXIS
    !
    use dc_types, only: STRING, TOKEN, DP
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    implicit none
    type(GT_HISTORY_AXIS),intent(out) :: axis
    character(*) , intent(in):: name     ! 次元変数名
    integer, intent(in):: size     ! 次元長 (配列サイズ)
    character(*) , intent(in):: longname ! 次元変数の記述的名称
    character(*) , intent(in):: units    ! 次元変数の単位
    character(*) , intent(in):: xtype    ! 次元変数の型
    character(len = *), parameter:: subname = "HistoryAxisCreate1"
  continue
    call BeginSub(subname)
    axis % name = name
    axis % length = size
    axis % longname = longname
    axis % units = units
    axis % xtype = xtype
    call EndSub(subname)
  end subroutine HistoryAxisCreate1

  subroutine HistoryVarinfoCreate1( varinfo, name, dims, longname, units, xtype)
    !
    !== GT_HISTORY_VARINFO 型変数作成
    !
    ! GT_HISTORY_VARINFO 型変数を作成します。
    ! このサブルーチンによる設定の後、
    ! HistoryAddVariable の *varinfo* に与えます。
    ! さらに属性を付加する場合には HistoryVarinfoAddAttr
    ! を用いてください。
    !
    ! Constructor of GT_HISTORY_VARINFO
    !
    use dc_types, only: STRING, TOKEN, DP
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    use dc_message, only: MessageNotify
    implicit none
    type(GT_HISTORY_VARINFO),intent(out) :: varinfo
    character(*) , intent(in):: name     ! 次元変数名
    character(*) , intent(in):: dims(:)  ! 依存する次元
    character(*) , intent(in):: longname ! 次元変数の記述的名称
    character(*) , intent(in):: units    ! 次元変数の単位
    character(*) , intent(in):: xtype    ! 次元変数の型

    ! Internal Work
    integer:: i, numdims
    character(len = *), parameter:: subname = "HistoryVarinfoCreate1"
  continue
    call BeginSub(subname)
    varinfo % name = name
    varinfo % longname = longname
    varinfo % units = units
    varinfo % xtype = xtype
    numdims = size(dims)
    allocate(varinfo % dims(numdims))
    do i = 1, numdims
      varinfo % dims(i) = dims(i)
      if (len(trim(dims(i))) > TOKEN) then
        call MessageNotify('W', subname, 'dimension name <%c> is trancated to <%c>', c1=trim(dims(i)), c2=trim(varinfo % dims(i)))
      end if
    end do
    call EndSub(subname)
  end subroutine HistoryVarinfoCreate1

  subroutine HistoryAddAttrChar0( varname, attrname, value, history)
    !
                        !
    !== gtool4 データ内の変数への属性付加
    !
    ! gtool4 データおよびそのデータ内の変数に属性を付加します。
    ! このサブルーチンを用いる前に、 HistoryCreate による初期設定が
    ! 必要です。
    !
    ! 属性名 *attrname* の先頭にプラス "<b><tt>+</tt></b>" を付加する
    ! 場合は、gtool4 データ自体の属性 (大域属性) として属性が付加されます
    ! この場合、*varname* は無視されますが、その場合でも *varname* へは
    ! 引数の解説にもある通り有効な値を与えてください。
    !
    ! *HistoryAddAttr* は複数のサブルーチンの総称名です。*value* には
    ! いくつかの型を与えることが可能です。
    ! 下記のサブルーチンを参照ください。
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string, only: toChar, JoinChar
    use dc_url, only: GT_PLUS
    use dc_error, only: DC_NOERR
    implicit none
    character(*), intent(in):: varname
                                                            ! 変数の名前。
                                        !
                                        ! ここで指定するものは、
                                        ! HistoryCreateの *dims* 、
                                        ! または HistoryAddVariable の
                                        ! *varname* で既に指定されてい
                                        ! なければなりません。
                                        ! 
                    
    character(*), intent(in):: attrname
                                                            ! 変数またはファイル全体に付
                                        ! 加する属性の名前
                                        !
                                        ! "<b><tt>+</tt></b>" (プラ
                                        ! ス) を属性名の先頭につける
                                        ! 場合には、ファイル全体に属
                                        ! 性を付加します。
                                        ! ファイル全体へ属性を付加
                                        ! する場合でも、 HistoryCreate
                                        ! の *dims* 、または
                                        ! HistoryAddVariable の
                                        ! *varname* で既に指定されてい
                                        ! る変数を *varname* に指定する
                                        ! 必要があります。
                                        ! 
                    
    character(*), intent(in):: value
                                                            ! 属性の値
                                        ! 
                    
    type(GT_HISTORY), target, optional:: history
                                                            ! 出力ファイルの設定に関する情報を
                                        ! 格納した構造体
                                        ! 
                                        ! ここに指定するものは、
                                        ! HistoryCreate によって初期設定
                                        ! されていなければなりません。
                                        ! 
                    
    type(GT_HISTORY), pointer:: hst =>null()
    type(GT_VARIABLE):: var
    integer:: v_ord
    logical:: err
    character(len = *), parameter:: subname = "HistoryAddAttrChar0"
  continue
    call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(value))
    ! 操作対象決定
    if (present(history)) then
      hst => history
    else
      hst => default
    endif

    if (varname == "") then
      ! とりあえず無駄だが大域属性を何度もつける
      do, v_ord = 1, size(hst%vars)
        call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, value)
      enddo
    else
      call lookup_var_or_dim(hst, varname, var, err)
      if (.not. err) then
        call Put_Attr(var, attrname, value)
      endif
    endif
    call EndSub(subname)
  end subroutine

  subroutine HistoryAddAttrInt0( varname, attrname, value, history)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string, only: toChar, JoinChar
    use dc_url, only: GT_PLUS
    use dc_error, only: DC_NOERR
    implicit none
    character(*), intent(in):: varname
                    
    character(*), intent(in):: attrname
                    
    integer, intent(in):: value
                    
    type(GT_HISTORY), target, optional:: history
                    
    type(GT_HISTORY), pointer:: hst =>null()
    type(GT_VARIABLE):: var
    integer:: v_ord
    logical:: err
    character(len = *), parameter:: subname = "HistoryAddAttrInt0"
  continue
    call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
    ! 操作対象決定
    if (present(history)) then
      hst => history
    else
      hst => default
    endif

    if (varname == "") then
      ! とりあえず無駄だが大域属性を何度もつける
      do, v_ord = 1, size(hst%vars)
        call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
      enddo
    else
      call lookup_var_or_dim(hst, varname, var, err)
      if (.not. err) then
        call Put_Attr(var, attrname, (/value/))
      endif
    endif
    call EndSub(subname)
  end subroutine

  subroutine HistoryAddAttrLogical0( varname, attrname, value, history)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string, only: toChar, JoinChar
    use dc_url, only: GT_PLUS
    use dc_error, only: DC_NOERR
    implicit none
    character(*), intent(in):: varname
                    
    character(*), intent(in):: attrname
                    
    logical, intent(in):: value
                    
    type(GT_HISTORY), target, optional:: history
                    
    type(GT_HISTORY), pointer:: hst =>null()
    type(GT_VARIABLE):: var
    integer:: v_ord
    logical:: err
    character(len = *), parameter:: subname = "HistoryAddAttrLogical0"
  continue
    call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
    ! 操作対象決定
    if (present(history)) then
      hst => history
    else
      hst => default
    endif

    if (varname == "") then
      ! とりあえず無駄だが大域属性を何度もつける
      do, v_ord = 1, size(hst%vars)
        call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, value)
      enddo
    else
      call lookup_var_or_dim(hst, varname, var, err)
      if (.not. err) then
        call Put_Attr(var, attrname, value)
      endif
    endif
    call EndSub(subname)
  end subroutine

  subroutine HistoryAddAttrDouble0( varname, attrname, value, history)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string, only: toChar, JoinChar
    use dc_url, only: GT_PLUS
    use dc_error, only: DC_NOERR
    implicit none
    character(*), intent(in):: varname
                    
    character(*), intent(in):: attrname
                    
    real(DP), intent(in):: value
                    
    type(GT_HISTORY), target, optional:: history
                    
    type(GT_HISTORY), pointer:: hst =>null()
    type(GT_VARIABLE):: var
    integer:: v_ord
    logical:: err
    character(len = *), parameter:: subname = "HistoryAddAttrDouble0"
  continue
    call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
    ! 操作対象決定
    if (present(history)) then
      hst => history
    else
      hst => default
    endif

    if (varname == "") then
      ! とりあえず無駄だが大域属性を何度もつける
      do, v_ord = 1, size(hst%vars)
        call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
      enddo
    else
      call lookup_var_or_dim(hst, varname, var, err)
      if (.not. err) then
        call Put_Attr(var, attrname, (/value/))
      endif
    endif
    call EndSub(subname)
  end subroutine

  subroutine HistoryAddAttrReal0( varname, attrname, value, history)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string, only: toChar, JoinChar
    use dc_url, only: GT_PLUS
    use dc_error, only: DC_NOERR
    implicit none
    character(*), intent(in):: varname
                    
    character(*), intent(in):: attrname
                    
    real, intent(in):: value
                    
    type(GT_HISTORY), target, optional:: history
                    
    type(GT_HISTORY), pointer:: hst =>null()
    type(GT_VARIABLE):: var
    integer:: v_ord
    logical:: err
    character(len = *), parameter:: subname = "HistoryAddAttrReal0"
  continue
    call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
    ! 操作対象決定
    if (present(history)) then
      hst => history
    else
      hst => default
    endif

    if (varname == "") then
      ! とりあえず無駄だが大域属性を何度もつける
      do, v_ord = 1, size(hst%vars)
        call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
      enddo
    else
      call lookup_var_or_dim(hst, varname, var, err)
      if (.not. err) then
        call Put_Attr(var, attrname, (/value/))
      endif
    endif
    call EndSub(subname)
  end subroutine

  subroutine HistoryAddAttrInt1( varname, attrname, value, history)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string, only: toChar, JoinChar
    use dc_url, only: GT_PLUS
    use dc_error, only: DC_NOERR
    implicit none
    character(*), intent(in):: varname
                    
    character(*), intent(in):: attrname
                    
    integer, intent(in):: value(:)
                    
    type(GT_HISTORY), target, optional:: history
                    
    type(GT_HISTORY), pointer:: hst =>null()
    type(GT_VARIABLE):: var
    integer:: v_ord
    logical:: err
    character(len = *), parameter:: subname = "HistoryAddAttrInt1"
  continue
    call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
    ! 操作対象決定
    if (present(history)) then
      hst => history
    else
      hst => default
    endif

    if (varname == "") then
      ! とりあえず無駄だが大域属性を何度もつける
      do, v_ord = 1, size(hst%vars)
        call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
      enddo
    else
      call lookup_var_or_dim(hst, varname, var, err)
      if (.not. err) then
        call Put_Attr(var, attrname, (/value/))
      endif
    endif
    call EndSub(subname)
  end subroutine

  subroutine HistoryAddAttrDouble1( varname, attrname, value, history)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string, only: toChar, JoinChar
    use dc_url, only: GT_PLUS
    use dc_error, only: DC_NOERR
    implicit none
    character(*), intent(in):: varname
                    
    character(*), intent(in):: attrname
                    
    real(DP), intent(in):: value(:)
                    
    type(GT_HISTORY), target, optional:: history
                    
    type(GT_HISTORY), pointer:: hst =>null()
    type(GT_VARIABLE):: var
    integer:: v_ord
    logical:: err
    character(len = *), parameter:: subname = "HistoryAddAttrDouble1"
  continue
    call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
    ! 操作対象決定
    if (present(history)) then
      hst => history
    else
      hst => default
    endif

    if (varname == "") then
      ! とりあえず無駄だが大域属性を何度もつける
      do, v_ord = 1, size(hst%vars)
        call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
      enddo
    else
      call lookup_var_or_dim(hst, varname, var, err)
      if (.not. err) then
        call Put_Attr(var, attrname, (/value/))
      endif
    endif
    call EndSub(subname)
  end subroutine

  subroutine HistoryAddAttrReal1( varname, attrname, value, history)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string, only: toChar, JoinChar
    use dc_url, only: GT_PLUS
    use dc_error, only: DC_NOERR
    implicit none
    character(*), intent(in):: varname
                    
    character(*), intent(in):: attrname
                    
    real, intent(in):: value(:)
                    
    type(GT_HISTORY), target, optional:: history
                    
    type(GT_HISTORY), pointer:: hst =>null()
    type(GT_VARIABLE):: var
    integer:: v_ord
    logical:: err
    character(len = *), parameter:: subname = "HistoryAddAttrReal1"
  continue
    call BeginSub(subname, 'varname=<%c> attrname=<%c>, value=<%c>', c1=trim(varname), c2=trim(attrname), c3=trim(toChar(value)))
    ! 操作対象決定
    if (present(history)) then
      hst => history
    else
      hst => default
    endif

    if (varname == "") then
      ! とりあえず無駄だが大域属性を何度もつける
      do, v_ord = 1, size(hst%vars)
        call Put_Attr(hst%vars(v_ord), GT_PLUS // attrname, (/value/))
      enddo
    else
      call lookup_var_or_dim(hst, varname, var, err)
      if (.not. err) then
        call Put_Attr(var, attrname, (/value/))
      endif
    endif
    call EndSub(subname)
  end subroutine

  subroutine HistoryAddVariable2(varinfo, history)
    !
    !== 変数定義
    !
    ! gtool4 データ内の変数の定義を行います。このサブルーチンを
    ! 用いる前に、 HistoryCreate による初期設定が必要です。
    !
    ! 既に gtool4 データが存在し、そのデータ内の変数と全く同じ
    ! 構造の変数を定義したい場合は HistoryCopyVariable を利用すると
    ! 便利です。
    !
    ! *HistoryAddVariable* というサブルーチン名は 2 つの別々の
    ! サブルーチンの総称名です。下記のサブルーチンも参照ください。
    !
    use dc_string, only: JoinChar
    implicit none
    type(GT_HISTORY_VARINFO), intent(in)             :: varinfo
                                        ! 変数情報を格納した構造体
                                        ! 
                                        ! ここに指定するものは、
                                        ! HistoryVarinfoCreate によって
                                        ! 初期設定されていなければなりません。
                                        ! 
    type(GT_HISTORY),         intent(inout), optional:: history
                                        ! 出力ファイルの設定に関する情報を
                                        ! 格納した構造体
                                        ! 
                                        ! ここに指定するものは、
                                        ! HistoryCreate によって初期設定
                                        ! されていなければなりません。
                                        ! 
    character(len = *), parameter:: subname = "HistoryAddVariable2"
  continue
    call BeginSub(subname, 'varname=<%c>, dims=<%c>, longname=<%c>', c1=trim(varinfo%name), c2=trim(JoinChar(varinfo%dims)), c3=trim(varinfo%longname)                               )
    call HistoryAddVariable1(trim(varinfo%name), varinfo%dims, trim(varinfo%longname), trim(varinfo%units), trim(varinfo%xtype), history)
    if (associated( varinfo % attrs )) then
      call HistoryAttrAdd( varinfo % name, varinfo % attrs, history )
    end if
    call EndSub(subname)
  end subroutine HistoryAddVariable2

  subroutine HistoryAddVariable1(varname, dims, longname, units, xtype, history)
    !
    !== 変数定義
    !
    ! gtool4 データ内の変数の定義を行います。このサブルーチンを
    ! 用いる前に、 HistoryCreate による初期設定が必要です。
    !
    ! 既に gtool4 データが存在し、そのデータ内の変数と全く同じ
    ! 構造の変数を定義したい場合は HistoryCopyVariable を利用すると便
    ! 利です。
    !
    ! *HistoryAddVariable* というサブルーチン名は 2 つの別々の
    ! サブルーチンの総称名です。上記のサブルーチンも参照ください。
    !
    use netcdf_f77, only: NF_EBADDIM
    use dc_error, only: StoreError, DC_NOERR
    use dc_string, only: CPrintf, JoinChar, StoA
    use gtdata_generic, only: Inquire, Create, Slice, Put_Attr
    use dc_url, only: GT_ATMARK, UrlResolve
    use dc_types, only: STRING
    implicit none
    character(len = *), intent(in):: varname
                                        ! 定義する変数の名前
                                        ! 
                                        ! 最大文字数は dc_type#TOKEN
                                        ! 
    character(len = *), intent(in):: dims(:)
                                        ! 変数が依存する次元の名前
                                        !
                                        ! 時間の次元は配列の最後に指定
                                        ! しなければならない。
                                        ! ここで指定するものは、
                                        ! HistoryCreate にて dims で指定
                                        ! されていなければならない。
                                        !
                                        ! もしもスカラー変数を作成
                                        ! する場合には, サイズが 1 で
                                        ! 中身が空の文字型配列,
                                        ! すなわち <tt> (/''/) </tt>
                                        ! を与えること.
                                        ! 
    character(len = *), intent(in):: longname
                                        ! 変数の記述的名称
                                        !
                                        ! 最大文字数は dc_types#STRING
                                        ! 
    character(len = *), intent(in):: units
                                        ! 変数の単位
                                        ! 
                                        ! 最大文字数は dc_types#STRING
                                        ! 
    character(len = *), intent(in), optional:: xtype
                                        ! 変数のデータ型
                                        ! 
                                        ! デフォルトはfloat (単精度実数型)
                                        ! である。 有効なのは、
                                        ! double (倍精度実数型)、 int
                                        ! (整数型)である。 指定しない
                                        ! 場合や、無効な型を指定した
                                        ! 場合には、 float (単精度実数型)
                                        ! となる。
                                        ! 
    type(GT_HISTORY), intent(inout), optional, target:: history
                                        ! 出力ファイルの設定に関する情報を
                                        ! 格納した構造体
                                        ! 
                                        ! ここに指定するものは、
                                        ! HistoryCreate によって初期設定
                                        ! されていなければなりません。
                                        ! 
    type(GT_HISTORY), pointer:: hst =>null()
    type(GT_VARIABLE), pointer:: vwork(:) =>null(), dimvars(:) =>null()
    character(len = STRING):: fullname, url, cause_c
    integer, pointer:: count_work(:) =>null()
    integer:: nvars, numdims, i, dimord, stat
    character(len = *), parameter:: subname = "HistoryAddVariable1"
  continue
    call BeginSub(subname, 'name=<%a>, dims=<%a>, longname=<%a>, units=<%a>', ca=StoA(varname, JoinChar(dims), longname, units))
    stat = DC_NOERR
    !----- 操作対象決定 -----
    if (present(history)) then
      hst => history
    else
      hst => default
    endif

    !----- 変数表拡張 -----
    if (associated(hst%vars)) then
      nvars = size(hst%vars(:))
      vwork => hst%vars
      count_work => hst%count
      nullify(hst%vars, hst%count)
      allocate(hst%vars(nvars + 1), hst%count(nvars + 1))
      hst%vars(1:nvars) = vwork(1:nvars)
      hst%count(1:nvars) = count_work(1:nvars)
      deallocate(vwork, count_work)
      count_work => hst%growable_indices
      nullify(hst%growable_indices)
      allocate(hst%growable_indices(nvars + 1))
      hst%growable_indices(1:nvars) = count_work(1:nvars)
      deallocate(count_work)
    else
      ! トリッキーだが、ここで count だけ 2 要素確保するのは、
      ! HistorySetTime による巻き戻しに備えるため。
      allocate(hst%vars(1), hst%count(2), hst%growable_indices(1))
      hst%count(2) = 0
    endif
    nvars = size(hst%vars(:))
    hst%growable_indices(nvars) = 0
    hst%count(nvars) = 0

    ! スカラー変数作成への対応
    if (size(dims) == 1 .and. trim(dims(1)) == '') then
      numdims = 0
      allocate(dimvars(numdims))
    else
      numdims = size(dims)
      allocate(dimvars(numdims))
    end if

    !----- 変数添字次元を決定 -----
    do, i = 1, numdims
      ! hst 内で, 次元変数名 dim(i) に当たる次元変数の ID である
      ! hst%dimvar(i) を dimvars(i) に, 添字を dimord に
      dimvars(i) = lookup_dimension(hst, dims(i), ord=dimord)
      if (dimord == 0) then
        stat = NF_EBADDIM
        cause_c = CPrintf('"%c" dimension is not found.', c1=trim(dims(i)))
        goto 999
      end if
      ! 無制限次元の添字と一致する場合に,
      ! その添字を hst%growable_indices(nvars) に
      if (dimord == hst%unlimited_index) then
        hst%growable_indices(nvars) = i
      endif
    enddo

    !----- 変数作成 -----
    call Inquire(hst%dimvars(1), url=url)
    fullname = UrlResolve((GT_ATMARK // trim(varname)), trim(url))
    call Create(hst%vars(nvars), trim(fullname), dimvars, xtype=xtype)
    ! 拡張可能次元があったらそれをサイズ 1 に拡張しておく
    if (hst%growable_indices(nvars) /= 0) then
      call Slice(hst%vars(nvars), hst%growable_indices(nvars), start=1, count=1, stride=1)
    endif
    call put_attr(hst%vars(nvars), 'long_name', longname)
    call put_attr(hst%vars(nvars), 'units', units)
    deallocate(dimvars)
999 continue
    call StoreError(stat, subname, cause_c=cause_c)
    call EndSub(subname)
  end subroutine HistoryAddVariable1

  subroutine HistoryAxisAddAttrChar0( axis, attrname, value)
    !
                        !
    !== GT_HISTORY_AXIS 型変数への属性付加
    !
    ! GT_HISTORY_AXIS 型の変数 *axis* へ属性を付加します。
    !
    ! *HistoryAxisAddAttr* は複数のサブルーチンの総称名です。
    ! value には様々な型の引数を与えることが可能です。
    ! 下記のサブルーチンを参照ください。
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string     , only: toChar, JoinChar
    use dc_url        , only: GT_PLUS
    implicit none
    type(GT_HISTORY_AXIS),intent(inout) :: axis
    character(*), intent(in):: attrname ! 属性の名前
    character(*), intent(in):: value
                                                            ! 属性に与えられる値
                                        ! 
                                        ! 配列の場合でも、数値型以外
                                        ! では配列の 1 つ目の要素のみ
                                        ! 値として付加されます。
                                        ! 
                    
    type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
    integer:: attrs_num
    character(STRING) :: name
    character(*), parameter:: subname = "HistoryAxisAddAttrChar0"
  continue
    call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(value))
    call HistoryAxisInquire1( axis, name )
    call DbgMessage('axis name=<%c>', c1=trim(name))

    ! これまでの属性を保持しつつ配列を1つ増やす
    if ( .not. associated(axis % attrs) ) then
      allocate( axis % attrs(1) )
      attrs_num = 1
    else
      attrs_num = size( axis % attrs ) + 1
      ! 配列データの領域確保
      allocate( attrs_tmp(attrs_num - 1) )
      call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
      deallocate( axis % attrs )
      allocate( axis % attrs(attrs_num) )
      call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
      deallocate( attrs_tmp )
    endif

    axis % attrs(attrs_num) % attrname  = attrname
    axis % attrs(attrs_num) % attrtype  = 'Char'
                        axis % attrs(attrs_num) % array     = .false.
    axis % attrs(attrs_num) % Charvalue = value
                    

    call EndSub(subname)
  end subroutine HistoryAxisAddAttrChar0

  subroutine HistoryAxisAddAttrInt0( axis, attrname, value)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string     , only: toChar, JoinChar
    use dc_url        , only: GT_PLUS
    implicit none
    type(GT_HISTORY_AXIS),intent(inout) :: axis
    character(*), intent(in):: attrname ! 属性の名前
    integer, intent(in):: value
                    
    type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
    integer:: attrs_num
    character(STRING) :: name
    character(*), parameter:: subname = "HistoryAxisAddAttrInt0"
  continue
    call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
    call HistoryAxisInquire1( axis, name )
    call DbgMessage('axis name=<%c>', c1=trim(name))

    ! これまでの属性を保持しつつ配列を1つ増やす
    if ( .not. associated(axis % attrs) ) then
      allocate( axis % attrs(1) )
      attrs_num = 1
    else
      attrs_num = size( axis % attrs ) + 1
      ! 配列データの領域確保
      allocate( attrs_tmp(attrs_num - 1) )
      call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
      deallocate( axis % attrs )
      allocate( axis % attrs(attrs_num) )
      call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
      deallocate( attrs_tmp )
    endif

    axis % attrs(attrs_num) % attrname  = attrname
    axis % attrs(attrs_num) % attrtype  = 'Int'
                        axis % attrs(attrs_num) % array     = .false.
    axis % attrs(attrs_num) % Intvalue = value
                    

    call EndSub(subname)
  end subroutine HistoryAxisAddAttrInt0

  subroutine HistoryAxisAddAttrLogical0( axis, attrname, value)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string     , only: toChar, JoinChar
    use dc_url        , only: GT_PLUS
    implicit none
    type(GT_HISTORY_AXIS),intent(inout) :: axis
    character(*), intent(in):: attrname ! 属性の名前
    logical, intent(in):: value
                    
    type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
    integer:: attrs_num
    character(STRING) :: name
    character(*), parameter:: subname = "HistoryAxisAddAttrLogical0"
  continue
    call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
    call HistoryAxisInquire1( axis, name )
    call DbgMessage('axis name=<%c>', c1=trim(name))

    ! これまでの属性を保持しつつ配列を1つ増やす
    if ( .not. associated(axis % attrs) ) then
      allocate( axis % attrs(1) )
      attrs_num = 1
    else
      attrs_num = size( axis % attrs ) + 1
      ! 配列データの領域確保
      allocate( attrs_tmp(attrs_num - 1) )
      call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
      deallocate( axis % attrs )
      allocate( axis % attrs(attrs_num) )
      call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
      deallocate( attrs_tmp )
    endif

    axis % attrs(attrs_num) % attrname  = attrname
    axis % attrs(attrs_num) % attrtype  = 'Logical'
                        axis % attrs(attrs_num) % array     = .false.
    axis % attrs(attrs_num) % Logicalvalue = value
                    

    call EndSub(subname)
  end subroutine HistoryAxisAddAttrLogical0

  subroutine HistoryAxisAddAttrDouble0( axis, attrname, value)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string     , only: toChar, JoinChar
    use dc_url        , only: GT_PLUS
    implicit none
    type(GT_HISTORY_AXIS),intent(inout) :: axis
    character(*), intent(in):: attrname ! 属性の名前
    real(DP), intent(in):: value
                    
    type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
    integer:: attrs_num
    character(STRING) :: name
    character(*), parameter:: subname = "HistoryAxisAddAttrDouble0"
  continue
    call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
    call HistoryAxisInquire1( axis, name )
    call DbgMessage('axis name=<%c>', c1=trim(name))

    ! これまでの属性を保持しつつ配列を1つ増やす
    if ( .not. associated(axis % attrs) ) then
      allocate( axis % attrs(1) )
      attrs_num = 1
    else
      attrs_num = size( axis % attrs ) + 1
      ! 配列データの領域確保
      allocate( attrs_tmp(attrs_num - 1) )
      call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
      deallocate( axis % attrs )
      allocate( axis % attrs(attrs_num) )
      call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
      deallocate( attrs_tmp )
    endif

    axis % attrs(attrs_num) % attrname  = attrname
    axis % attrs(attrs_num) % attrtype  = 'Double'
                        axis % attrs(attrs_num) % array     = .false.
    axis % attrs(attrs_num) % Doublevalue = value
                    

    call EndSub(subname)
  end subroutine HistoryAxisAddAttrDouble0

  subroutine HistoryAxisAddAttrReal0( axis, attrname, value)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string     , only: toChar, JoinChar
    use dc_url        , only: GT_PLUS
    implicit none
    type(GT_HISTORY_AXIS),intent(inout) :: axis
    character(*), intent(in):: attrname ! 属性の名前
    real, intent(in):: value
                    
    type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
    integer:: attrs_num
    character(STRING) :: name
    character(*), parameter:: subname = "HistoryAxisAddAttrReal0"
  continue
    call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
    call HistoryAxisInquire1( axis, name )
    call DbgMessage('axis name=<%c>', c1=trim(name))

    ! これまでの属性を保持しつつ配列を1つ増やす
    if ( .not. associated(axis % attrs) ) then
      allocate( axis % attrs(1) )
      attrs_num = 1
    else
      attrs_num = size( axis % attrs ) + 1
      ! 配列データの領域確保
      allocate( attrs_tmp(attrs_num - 1) )
      call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
      deallocate( axis % attrs )
      allocate( axis % attrs(attrs_num) )
      call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
      deallocate( attrs_tmp )
    endif

    axis % attrs(attrs_num) % attrname  = attrname
    axis % attrs(attrs_num) % attrtype  = 'Real'
                        axis % attrs(attrs_num) % array     = .false.
    axis % attrs(attrs_num) % Realvalue = value
                    

    call EndSub(subname)
  end subroutine HistoryAxisAddAttrReal0

  subroutine HistoryAxisAddAttrInt1( axis, attrname, value)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string     , only: toChar, JoinChar
    use dc_url        , only: GT_PLUS
    implicit none
    type(GT_HISTORY_AXIS),intent(inout) :: axis
    character(*), intent(in):: attrname ! 属性の名前
    integer, intent(in):: value(:)
                    
    type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
    integer:: attrs_num
    character(STRING) :: name
    character(*), parameter:: subname = "HistoryAxisAddAttrInt1"
  continue
    call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
    call HistoryAxisInquire1( axis, name )
    call DbgMessage('axis name=<%c>', c1=trim(name))

    ! これまでの属性を保持しつつ配列を1つ増やす
    if ( .not. associated(axis % attrs) ) then
      allocate( axis % attrs(1) )
      attrs_num = 1
    else
      attrs_num = size( axis % attrs ) + 1
      ! 配列データの領域確保
      allocate( attrs_tmp(attrs_num - 1) )
      call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
      deallocate( axis % attrs )
      allocate( axis % attrs(attrs_num) )
      call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
      deallocate( attrs_tmp )
    endif

    axis % attrs(attrs_num) % attrname  = attrname
    axis % attrs(attrs_num) % attrtype  = 'Int'
                        axis % attrs(attrs_num) % array                = .true.
    allocate(  axis % attrs(attrs_num) % Intarray( size(value) )  )
    axis % attrs(attrs_num) % Intarray    = value
                    

    call EndSub(subname)
  end subroutine HistoryAxisAddAttrInt1

  subroutine HistoryAxisAddAttrDouble1( axis, attrname, value)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string     , only: toChar, JoinChar
    use dc_url        , only: GT_PLUS
    implicit none
    type(GT_HISTORY_AXIS),intent(inout) :: axis
    character(*), intent(in):: attrname ! 属性の名前
    real(DP), intent(in):: value(:)
                    
    type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
    integer:: attrs_num
    character(STRING) :: name
    character(*), parameter:: subname = "HistoryAxisAddAttrDouble1"
  continue
    call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
    call HistoryAxisInquire1( axis, name )
    call DbgMessage('axis name=<%c>', c1=trim(name))

    ! これまでの属性を保持しつつ配列を1つ増やす
    if ( .not. associated(axis % attrs) ) then
      allocate( axis % attrs(1) )
      attrs_num = 1
    else
      attrs_num = size( axis % attrs ) + 1
      ! 配列データの領域確保
      allocate( attrs_tmp(attrs_num - 1) )
      call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
      deallocate( axis % attrs )
      allocate( axis % attrs(attrs_num) )
      call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
      deallocate( attrs_tmp )
    endif

    axis % attrs(attrs_num) % attrname  = attrname
    axis % attrs(attrs_num) % attrtype  = 'Double'
                        axis % attrs(attrs_num) % array                = .true.
    allocate(  axis % attrs(attrs_num) % Doublearray( size(value) )  )
    axis % attrs(attrs_num) % Doublearray    = value
                    

    call EndSub(subname)
  end subroutine HistoryAxisAddAttrDouble1

  subroutine HistoryAxisAddAttrReal1( axis, attrname, value)
    !
                    
    !
    use gtdata_generic, only: Put_Attr
    use dc_string     , only: toChar, JoinChar
    use dc_url        , only: GT_PLUS
    implicit none
    type(GT_HISTORY_AXIS),intent(inout) :: axis
    character(*), intent(in):: attrname ! 属性の名前
    real, intent(in):: value(:)
                    
    type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
    integer:: attrs_num
    character(STRING) :: name
    character(*), parameter:: subname = "HistoryAxisAddAttrReal1"
  continue
    call BeginSub(subname, 'attrname=<%c>, value=<%c>', c1=trim(attrname), c2=trim(toChar(value)))
    call HistoryAxisInquire1( axis, name )
    call DbgMessage('axis name=<%c>', c1=trim(name))

    ! これまでの属性を保持しつつ配列を1つ増やす
    if ( .not. associated(axis % attrs) ) then
      allocate( axis % attrs(1) )
      attrs_num = 1
    else
      attrs_num = size( axis % attrs ) + 1
      ! 配列データの領域確保
      allocate( attrs_tmp(attrs_num - 1) )
      call HistoryAttrCopy( from = axis % attrs(1:attrs_num - 1), to = attrs_tmp(1:attrs_num - 1))
      deallocate( axis % attrs )
      allocate( axis % attrs(attrs_num) )
      call HistoryAttrCopy( from = attrs_tmp(1:attrs_num - 1), to = axis % attrs(1:attrs_num - 1))
      deallocate( attrs_tmp )
    endif

    axis % attrs(attrs_num) % attrname  = attrname
    axis % attrs(attrs_num) % attrtype  = 'Real'
                        axis % attrs(attrs_num) % array                = .true.
    allocate(  axis % attrs(attrs_num) % Realarray( size(value) )  )
    axis % attrs(attrs_num) % Realarray    = value
                    

    call EndSub(subname)
  end subroutine HistoryAxisAddAttrReal1

  subroutine HistoryAxisClear(axis)
    !
    !== GT_HISTORY_AXIS 型変数初期化
    !
    ! *axis* で与えられた変数を HistoryAxisCreate による初期設定よりも
    ! さらに前の状態に初期化します。
    !
    ! Destructor of GT_HISTORY_AXIS
    !
    implicit none
    type(GT_HISTORY_AXIS),intent(inout) :: axis
    character(len = *), parameter:: subname = "HistoryAxisClear1"
    call BeginSub(subname)
    axis % name     = ""
    axis % length   = 0
    axis % longname = ""
    axis % units    = ""
    axis % xtype    = ""
    if (associated(axis % attrs)) then
      deallocate(axis % attrs)
    end if
    call EndSub(subname)
  end subroutine HistoryAxisClear

  subroutine HistoryAxisCopy1(axis_dest, axis_src, err, name, length, longname, units, xtype)
    !
    !== GT_HISTORY_AXIS 型変数コピー
    !
    ! GT_HISTORY_AXIS 型の変数 *axis_src* を
    ! *axis_dest* にコピーします。
    ! *axis_src* は HistoryAxisCreate によって初期設定されている必要が
    ! あります。
    ! さらに属性を付加する場合には HistoryAxisAddAttr
    ! を用いてください。
    !
    ! *err* を与えておくと、コピーの際何らかの不具合が生じても
    ! 終了せずに err が真になって返ります。
    ! 
    ! *err* 以降の引数は、コピーの際に上書きする値です。
    !
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    use dc_present,only: present_select
    implicit none
    type(GT_HISTORY_AXIS),intent(out) :: axis_dest ! コピー先 GT_HISTORY_AXIS
    type(GT_HISTORY_AXIS),intent(in)  :: axis_src  ! コピー元 GT_HISTORY_AXIS
    logical, intent(out), optional :: err
    character(*) , intent(in), optional:: name     ! 次元変数名
    integer, intent(in), optional:: length         ! 次元長 (配列サイズ)
    character(*) , intent(in), optional:: longname ! 次元変数の記述的名称
    character(*) , intent(in), optional:: units    ! 次元変数の単位
    character(*) , intent(in), optional:: xtype    ! 次元変数の型
    character(STRING), parameter:: subname = "HistoryAxisCopy1"
  continue
    call BeginSub(subname)
    axis_dest % name     = present_select('', axis_src % name, name)
    axis_dest % length   = present_select(.false., axis_src % length, length)
    axis_dest % longname = present_select('', axis_src % longname, longname)
    axis_dest % units    = present_select('', axis_src % units, units)
    axis_dest % xtype    = present_select('', axis_src % xtype, xtype)

    if (associated( axis_src % attrs ) ) then
      allocate(  axis_dest % attrs( size( axis_src % attrs) )  )
      call HistoryAttrCopy( from = axis_src % attrs, to = axis_dest % attrs, err = err)
    end if
    call EndSub(subname)
  end subroutine HistoryAxisCopy1

  subroutine HistoryAxisCreate1( axis, name, size, longname, units, xtype)
    !
    !== GT_HISTORY_AXIS 型変数作成
    !
    ! GT_HISTORY_AXIS 型変数を作成します。
    ! このサブルーチンによる設定の後、
    ! HistoryCreate の *axes* に与えます。
    ! さらに属性を付加する場合には HistoryAxisAddAttr
    ! を用いてください。
    !
    ! Constructor of GT_HISTORY_AXIS
    !
    use dc_types, only: STRING, TOKEN, DP
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    implicit none
    type(GT_HISTORY_AXIS),intent(out) :: axis
    character(*) , intent(in):: name     ! 次元変数名
    integer, intent(in):: size     ! 次元長 (配列サイズ)
    character(*) , intent(in):: longname ! 次元変数の記述的名称
    character(*) , intent(in):: units    ! 次元変数の単位
    character(*) , intent(in):: xtype    ! 次元変数の型
    character(len = *), parameter:: subname = "HistoryAxisCreate1"
  continue
    call BeginSub(subname)
    axis % name = name
    axis % length = size
    axis % longname = longname
    axis % units = units
    axis % xtype = xtype
    call EndSub(subname)
  end subroutine HistoryAxisCreate1

  subroutine HistoryAxisInquire1( axis, name, size, longname, units, xtype)
    !
    !== GT_HISTORY_AXIS 型変数への問い合わせ
    !
    ! GT_HISTORY_AXIS 型の変数内の各情報を参照します。
    !
    use dc_types, only: STRING, TOKEN, DP
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    implicit none
    type(GT_HISTORY_AXIS),intent(in) :: axis
    character(*) , intent(out), optional:: name     ! 次元変数名
    integer, intent(out), optional:: size     ! 次元長 (配列サイズ)
    character(*) , intent(out), optional:: longname ! 次元変数の記述的名称
    character(*) , intent(out), optional:: units    ! 次元変数の単位
    character(*) , intent(out), optional:: xtype    ! 次元変数の型
    character(len = *), parameter:: subname = "HistoryAxisInquire1"
  continue
    call BeginSub(subname)
    if (present(name)) then
      name     = axis % name
    end if
    if (present(size)) then
      size     = axis % length
    end if
    if (present(longname)) then
      longname = axis % longname
    end if
    if (present(units)) then
      units    = axis % units
    end if
    if (present(xtype)) then
      xtype    = axis % xtype
    end if
    call EndSub(subname)
  end subroutine HistoryAxisInquire1

  subroutine HistoryClose(history)
    !
    !== 終了処理
    !
    ! HistoryCreate で始まったデータ出力の終了処理をおこなうものです。
    ! プログラム内で HistoryCreate を用いた場合、プログラムを終了する
    ! 前に必ずこのサブルーチンを呼んで下さい。
    !
    use gtdata_generic, only: Close
    type(GT_HISTORY), intent(inout), optional, target:: history
                                        ! 出力ファイルの設定に関する情報を
                                        ! 格納した構造体
                                        ! 
                                        ! ここに指定するものは、
                                        ! HistoryCreate によって初期設定
                                        ! されていなければなりません。
                                        ! 
    type(GT_HISTORY), pointer:: hst =>null()
    integer:: i
    character(len = *), parameter:: subname = "HistoryClose"
  continue
    call BeginSub(subname)
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
    do, i = 1, size(hst%dimvars)
      if (.not. hst%dim_value_written(i)) call set_fake_dim_value(hst, i)
      call Close(hst%dimvars(i))
    enddo
    deallocate(hst%dimvars)
    do, i = 1, size(hst%vars)
      call Close(hst%vars(i))
    enddo
    if (associated(hst%vars)) deallocate(hst%vars)
    if (associated(hst%count)) deallocate(hst%count)
    call EndSub(subname)
  end subroutine HistoryClose

  subroutine HistoryCopy1(hist_dest, file, hist_src, title, source, institution, origin, interval, conventions, gt_version)
    !
    ! hist_src の内容にコピーし, hist_dest へ返す.
    ! hist_src が与えられない場合は default が参照される.
    ! HistoryCreate と同様に, 出力の初期設定を行う. file
    ! は必ず与えなければならず, hist_src と同じファイルへ出力
    ! しようとする場合は下層でエラーを生じる.
    !
    ! それ以降の引数は hist_src の設定を上書きするためのものである.
    !
    use gtdata_generic, only: Inquire, Get_Attr, Copy_Attr, Get, Put
!      use dc_url,    only:
    use dc_error,   only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH
!      use dc_string, only:
    use dc_present, only: present_select
    use dc_types,   only: string, token
    implicit none
    type(GT_HISTORY), intent(out), target :: hist_dest
    character(*),     intent(in)          :: file
    type(GT_HISTORY), intent(in), optional, target:: hist_src
    character(*),     intent(in), optional:: title, source, institution

!!!$      type(GT_HISTORY_AXIS), intent(in),optional :: axes(:)
!!!$      type(GT_HISTORY_AXIS), intent(in),optional :: addaxes(:)
!!!$      character(*),     intent(in), optional:: dims(:)
!!!$      integer,          intent(in), optional:: dimsizes(:)
!!!$      character(*),     intent(in), optional:: longnames(:)
!!!$      character(*),     intent(in), optional:: units(:)
    real,             intent(in), optional:: origin, interval

!!!$      character(*),     intent(in), optional:: xtypes(:)
    character(*),     intent(in), optional:: conventions, gt_version

    ! Internal Work
    type(GT_HISTORY), pointer:: src =>null()
    character(STRING) :: title_src, source_src, institution_src
    character(STRING) :: conventions_src, gt_version_src
    character(STRING), pointer:: dims(:) => null()
    integer          , pointer:: dimsizes(:) => null()
    character(STRING), pointer:: longnames(:) => null()
    character(STRING), pointer:: units(:)  => null()
    character(STRING), pointer:: xtypes(:) => null()
    integer  :: i, numdims
    logical        :: err
    real(DP),pointer :: dimvalue(:) => null()
    character(len = *),parameter:: subname = "HistoryCopy1"
  continue
    call BeginSub(subname, 'file=<%c>', c1=trim(file))

    if (present(hist_src)) then
      src => hist_src
    else
      src => default
    endif
    numdims = size(src % dimvars)

    call HistoryInquire1(history=src, title=title_src, source=source_src, institution=institution_src, dims=dims, dimsizes=dimsizes, longnames=longnames, units=units, xtypes=xtypes, conventions=conventions_src, gt_version=gt_version_src)

    call HistoryCreate1(file=trim(file), title=trim(present_select('', title_src, title)), source=trim(present_select('', source_src, source)), institution=trim(present_select('', institution_src, institution)), dims=dims, dimsizes=dimsizes, longnames=longnames, units=units, origin=present_select(.false., src % origin, origin), interval=present_select(0.0, src % interval, interval), xtypes=xtypes, history=hist_dest, conventions=trim(present_select('', conventions_src, conventions)), gt_version=trim(present_select('', gt_version_src, gt_version)) )

    !
    ! 次元変数が属性を持っている場合のことも考え, 最後に直接
    ! hist_dst % dimvars へ copy_attr (gtvarcopyattrall) をかける.
    !
    do i = 1, numdims
      call Copy_Attr(hist_dest % dimvars(i), src % dimvars (i), global=.false.)
    end do

    ! dimvars を Get してみて, 値を持っているようならデータを与えてしまう.
    do i = 1, numdims
      if (dimsizes(i) == 0) cycle
      call Get(src % dimvars(i), dimvalue, err)
      if (err) cycle
      call HistoryPutDoubleEx(dims(i), dimvalue, size(dimvalue), hist_dest)
      deallocate(dimvalue)
    end do

    deallocate(dims, dimsizes, longnames, units, xtypes)

    call EndSub(subname)
  end subroutine HistoryCopy1

  subroutine HistoryCopyVariable1(file, varname, history, overwrite)
    !
    !== 変数定義 (別ファイルの変数コピー)
    !
    ! gtool4 データ内の変数の定義を行います。 他の gtool4 データの
    ! ファイル名とその中の変数名を指定することで、 自動的のその変数の
    ! 構造や属性をコピーして変数定義します。このサブルーチンを
    ! 用いる前に、 HistoryCreate による初期設定が必要です。
    !
    ! 構造や属性を手動で設定する場合には HistoryAddVariable
    ! を用いて下さい。
    !
    use gtdata_generic, only: Create, Inquire, Open, Slice, Close
    use dc_present, only: present_and_false
    use dc_url, only: UrlMerge, GT_ATMARK, UrlResolve
    use dc_types, only: STRING
    implicit none
    character(len = *), intent(in)   :: file
                                        ! コピーしようとする変数が格納された
                                        ! netCDF ファイル名
                                        ! 
    character(len = *), intent(in)   :: varname
                                        ! コピー元となる変数の名前
                                        !
                                        ! 定義される変数名もこれと
                                        ! 同じになります。
                                        ! 最大文字数は dc_types#TOKEN 。
                                        !
                                        ! 依存する次元が存在しない
                                        ! 場合は自動的にその次元に関する
                                        ! 変数情報も元のファイルから
                                        ! コピーします。
                                        ! この場合に「同じ次元」と見
                                        ! なされるのは、(1) 無制限次
                                        ! 元 (自動的に「時間」と認識
                                        ! される)、
                                        ! (2) サイズと単位が同じ次元、
                                        ! です。
                                        ! 
    type(GT_HISTORY), intent(inout), optional, target :: history
                                        ! 出力ファイルの設定に関する情報を
                                        ! 格納した構造体
                                        ! 
                                        ! ここに指定するものは、
                                        ! HistoryCreate によって初期設定
                                        ! されていなければなりません。
                                        !
    logical, intent(in), optional:: overwrite
                                        ! 上書きの可否の設定
                                        !
                                        ! この引数に .false. を渡すと、
                                        ! 既存のファイルを上書きしません。
                                        ! デフォルトは上書きします。
                                        ! 

    type(GT_HISTORY),  pointer :: hst =>null()
    type(GT_VARIABLE), pointer :: vwork(:) =>null(), dimvars(:) =>null()
    type(GT_VARIABLE)          :: copyfrom
    character(len = STRING)    :: fullname, url, copyurl
    integer, pointer           :: count_work(:) =>null()
    integer                    :: nvars, numdims, i
    logical                    :: growable, overwrite_required
    character(*), parameter    :: subname = "HistoryCopyVariable"
  continue
    call BeginSub(subname, 'file=%c varname=%c', c1=trim(file), c2=trim(varname))
    !----- 操作対象決定 -----
    if (present(history)) then
      hst => history
    else
      hst => default
    endif

    !----- 変数表拡張 -----
    if (associated(hst%vars)) then
      nvars = size(hst%vars(:))
      vwork => hst%vars
      count_work => hst%count
      nullify(hst%vars, hst%count)
      allocate(hst%vars(nvars + 1), hst%count(nvars + 1))
      hst%vars(1:nvars) = vwork(1:nvars)
      hst%count(1:nvars) = count_work(1:nvars)
      deallocate(vwork, count_work)
      count_work => hst%growable_indices
      nullify(hst%growable_indices)
      allocate(hst%growable_indices(nvars + 1))
      hst%growable_indices(1:nvars) = count_work(1:nvars)
      deallocate(count_work)
    else
      ! トリッキーだが、ここで count だけ 2 要素確保するのは、
      ! HistorySetTime による巻き戻しに備えるため。
      allocate(hst%vars(1), hst%count(2), hst%growable_indices(1))
      hst%count(2) = 0
    endif
    nvars = size(hst%vars(:))
    hst%growable_indices(nvars) = 0
    hst%count(nvars) = 0

    !----- コピー元ファイルの変数 ID 取得 -----
    copyurl = UrlMerge(file, varname)
    call Open(copyfrom, copyurl)

    !----- 変数コピー -----
    call Inquire(hst%dimvars(1), url=url)
    fullname = UrlResolve((GT_ATMARK // trim(varname)), trim(url))
    overwrite_required = .true.
    if (present_and_false(overwrite)) overwrite_required = .false.
    call Create(hst%vars(nvars), trim(fullname), copyfrom, copyvalue=.FALSE., overwrite=overwrite_required)

    !----- 無制限次元の添字を探査 -----
    call Inquire(hst%vars(nvars), alldims=numdims)
    allocate(dimvars(numdims))
    ! 各次元毎に情報を取得し, growable == .TRUE. のもの (つまりは時間)
    ! の添字番号を取得する
    do, i = 1, numdims
      call Open(var=dimvars(i), source_var=hst%vars(nvars), dimord=i, count_compact=.TRUE.)
      ! 各次元変数の growable を調べる
      call Inquire(var=dimvars(i), growable=growable)
      if (growable) then
        hst%growable_indices(nvars) = i
      endif
    enddo

    !----- 拡張可能次元があったらそれをサイズ 1 に拡張しておく -----
    if (hst%growable_indices(nvars) /= 0) then
      call Slice(hst%vars(nvars), hst%growable_indices(nvars), start=1, count=1, stride=1)
    endif

    deallocate(dimvars)
    call Close(copyfrom)
    call EndSub(subname)

  end subroutine HistoryCopyVariable1

  subroutine HistoryCreate2(file, title, source, institution, axes, origin, interval, history, conventions, gt_version, overwrite)
    !
    !== 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*.
    !
    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:: history
    character(*), intent(in),  optional:: conventions, gt_version
    logical, intent(in), optional:: overwrite

    ! 構造体 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
    character(len = *), parameter:: subname = "HistoryCreate2"
  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 HistoryCreate1(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, conventions=conventions, gt_version=gt_version, overwrite=overwrite)

    ! Fujitsu Fortran や Intel Fortran 7 、 SunStudio 8 などなら
    ! 可能な方法。Intel 8 に対応するため、上記のように
    ! 書き換えてみた。 2004/11/27 morikawa
!        call HistoryCreate1(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, conventions=conventions,        &
!            & gt_version=gt_version)

    deallocate( axes_name )
    deallocate( axes_length )
    deallocate( axes_longname )
    deallocate( axes_units )
    deallocate( axes_xtype )

    do i = 1, ndims
      if (.not. associated( axes(i) % attrs ) ) cycle
      call HistoryAttrAdd( axes(i) % name, axes(i) % attrs, history )
    end do

    call EndSub(subname)
  end subroutine HistoryCreate2

  subroutine HistoryCreate1(file, title, source, institution, dims, dimsizes, longnames, units, origin, interval, xtypes, history, conventions, gt_version, overwrite)
    !
    !== 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
    use dc_error,   only: StoreError, DC_NOERR, GT_EARGSIZEMISMATCH
    use dc_string, only: JoinChar, toChar, StoA
    use dc_url, only: UrlMerge
    use dc_present, only: present_and_not_empty, present_and_false
    use dc_types,   only: STRING, TOKEN
    use dc_message, only: MessageNotify
    use sysdep,     only: SysdepEnvGet
    implicit none
    character(len=*), intent(in) :: file
                                        ! 出力するファイルの名前
    character(len=*), intent(in) :: title
                                        ! データ全体の表題
    character(len=*), intent(in) :: source
                                        ! データを作成する際の手段
    character(len=*), intent(in) :: institution
                                        ! ファイルを最終的に変更した人/組織
    character(len=*), intent(in) :: dims(:)
                                        ! 次元の名前
                                        ! 
                                        ! 配列の大きさに制限はありません.
                                        ! 文字数は dc_types#TOKEN まで.
                                        ! 配列内の文字数は
                                        ! 全て同じでなければなりません.
                                        ! 足りない文字分は空白で
                                        ! 補ってください.
                                        ! 
    integer,   intent (in)       :: dimsizes (:)
                                        ! dims で指定したそれぞれの次元
                                        ! 大きさ
                                        ! 
                                        ! 配列の大きさは dims の
                                        ! 大きさと等しい必要があります.
                                        ! '0' (数字のゼロ) を指定する
                                        ! とその次元は 無制限次元
                                        ! (unlimited dimension) となります.
                                        ! (gt4_history では時間の次元
                                        ! に対して無制限次元を用いるこ
                                        ! とを想定しています). ただし,
                                        ! 1 つの NetCDF ファイルは最大
                                        ! で 1 つの無制限次元しか持てな
                                        ! いので, 2 ヶ所以上に'0' を指
                                        ! 定しないでください. その場合,
                                        ! 正しく gtool4
                                        ! データが出力されません.
                                        ! 
    character(len=*), intent (in) :: longnames (:)
                                        ! dims で指定したそれぞれの次元
                                        ! の名前
                                        !
                                        ! 配列の大きさは dims の大きさ
                                        ! と等しい必要があります. 文字数
                                        ! は dc_types#STRING まで.
                                        ! 配列内の文字数は
                                        ! 全て同じでなければなりません.
                                        ! 足りない文字分は空白で補います.
                                        ! 
    character(len=*), intent(in) :: units(:)
                                        ! dims で指定したそれぞれの次元
                                        ! の単位
                                        !
                                        ! 配列の大きさは dims の大きさ
                                        ! と等しい必要があります. 文字数
                                        ! は dc_types#STRING まで.
                                        ! 配列内の文字数は
                                        ! 全て同じでなければなりません.
                                        ! 足りない文字分は空白で補います.
                                        ! 
    real, intent(in), optional   :: origin
                                        ! 時間の原点
                                        !
                                        ! これは HistoryPut により変数
                                        ! を最初に出力するときの時間と
                                        ! 一致します.
                                        ! 
                                        ! 省略した場合, 時間の原点には
                                        ! 0.0 が設定されます.
                                        ! 
    real, intent(in), optional   :: interval
                                        ! 出力時間間隔
                                        !
                                        ! 同じ変数に対して HistoryPut
                                        ! を再度呼んだときに自動的に時
                                        ! 間変数がこの値だけ増やされて
                                        ! 出力されます. なお, 各々の出
                                        ! 力ファイルにつき
                                        ! HistorySetTime を一度でも用い
                                        ! た場合, この値は無効になる
                                        ! ので注意してください.
                                        ! 
                                        ! 省略した場合, 1.0 が設定されます.
                                        ! 
    character(len=*), intent(in),  optional :: xtypes(:)
                                        ! dims で指定したそれぞれの
                                        ! 次元のデータ型
                                        !
                                        ! デフォルトは float (単精度実数型)
                                        ! です. 有効なのは,
                                        ! double (倍精度実数型), int
                                        ! (整数型) です. 指定しない
                                        ! 場合や, 無効な型を指定した場合には,
                                        ! float (単精度実数型)
                                        ! となります. なお, 配列の大きさ
                                        ! は *dims* の大きさと等しい必要が
                                        ! あります. 配列内の文字数は全て
                                        ! 同じでなければなりません.
                                        ! 足りない文字分は空白で補います.
                                        !
    type(GT_HISTORY), intent(out), optional, target:: history
                                        ! 出力ファイルの設定に関する情報を
                                        ! 格納した構造体
                                        !
                                        ! 1 つのプログラムで複数のファイル
                                        ! に gtool データを出力する
                                        ! 場合に利用します.
                                        ! (単独のファイルに書き出す場合は
                                        ! 指定する必要は無ありません)
                                        ! 
    character(len=*), intent(in), optional:: conventions
                                        ! 出力するファイルの netCDF
                                        ! 規約
                                        !
                                        ! 省略した場合,
                                        ! もしくは空文字を与えた場合,
                                        ! 出力する netCDF 規約の
                                        ! Conventions 属性に値
                                        ! gtool4_netCDF_Conventions
                                        ! が自動的に与えられます.
                                        ! 
    character(len=*), intent(in), optional:: gt_version
                                        ! gtool4 netCDF 規約のバージョン
                                        !
                                        ! 省略した場合, gt_version 属性に
                                        ! 規約の最新版のバージョンナンバー
                                        ! gtool4_netCDF_version
                                        ! が与えられます.
                                        ! (ただし, 引数 conventions に
                                        ! gtool4_netCDF_Conventions
                                        ! 以外が与えられる場合は
                                        ! gt_version 属性を作成しません).
                                        ! 
    logical, intent(in), optional:: overwrite
                                        ! 上書き可否の設定
                                        !
                                        ! この引数に .false. を渡すと,
                                        ! 既存のファイルを上書きしません.
                                        ! デフォルトは上書きします.
                                        ! 
    integer:: numdims, i, stat
    real:: origin_internal
    type(GT_HISTORY), pointer:: hst =>null()
    character(len = TOKEN):: my_xtype
    character(len = STRING):: merged, x_inst, x_conv, x_gtver, nc_history
    character(len = STRING):: cause_c
    logical                :: gtver_add, overwrite_required
    character(len = token) :: username
    character(len = *),      parameter:: subname = "HistoryCreate1"
  continue

    call BeginSub(subname, 'file=%c ndims=%d', c1=trim(file), i=(/size(dims)/), version=version)

    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
    numdims = size(dims)

    stat = DC_NOERR
    cause_c = ""
    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'
    else
      if (present(xtypes)) then
        if (size(xtypes) /= numdims) then
          cause_c = 'xtypes, dims'
        end if
      end if
    endif
    if ( trim(cause_c) /= "" ) then
      stat = GT_EARGSIZEMISMATCH
      goto 999
    end if

    ! 次元変数表作成
    allocate(hst % dimvars(numdims))
    allocate(hst % dim_value_written(numdims))
    hst % dim_value_written(:) = .false.
    hst % unlimited_index = 0

    call SysdepEnvGet('USER', username)
    if (trim(username) == '') username = 'unknown'

    nc_history = trim(TimeNow()) // ' ' // trim(username) // '> gt4_history: HistoryCreate' // achar(10)

    my_xtype = ""
    do, i = 1, numdims
      if (present(xtypes)) my_xtype = xtypes(i)
      merged = UrlMerge(file=file, var=dims(i))
      overwrite_required = .true.
      if (present_and_false(overwrite)) overwrite_required = .false.
      call Create( hst % dimvars(i), trim(merged), 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
      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)
      if (institution /= "") then
        x_inst = institution
      else
        x_inst = "a gt4_history (by GFD Dennou Club) user"
      endif
      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)))
      if (dimsizes(i) == 0) hst % unlimited_index = i
    enddo

    ! 変数表
    nullify(hst % vars, hst % growable_indices, hst % count)

    ! 時間カウンタ
    if (present(interval)) then
      hst % interval = interval
    else
      hst % interval = 1.0
      call MessageNotify('M', subname, 'interval=%r in output file <%c> (auto-setting)', c1=trim(file), r=(/hst % interval/))
    end if

    if (present(origin)) then
      origin_internal = origin
    else
      origin_internal = 0.0
      call MessageNotify('M', subname, 'origin=%r in output file <%c> (auto-setting)', c1=trim(file), r=(/origin_internal/))
    end if

    hst % origin = origin_internal
    hst % newest = origin_internal
    hst % oldest = origin_internal
    call EndSub(subname, 'std')
    return
999 continue
    call StoreError(stat, subname, cause_c=cause_c)
    call EndSub(subname, 'err')
  end subroutine HistoryCreate1

  subroutine HistoryInquire2(history, err, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, newest, oldest, conventions, gt_version, axes, varinfo )
    !
    !== GT_HISTORY 型変数への問い合わせ
    !
    ! HistoryCreate で *history* を指定しなかった場合はこちらの
    ! サブルーチンで問い合わせを行います。
    ! *history* には必ず "+default+" という文字列を与えてください。
    !
    ! *HistoryInquire* は 2 つのサブルーチンの総称名です。
    ! 各引数の情報に関しては下記のサブルーチンを参照してください。
    !
    !
    !
    use dc_error, only: StoreError, DC_NOERR, NF_EINVAL
    implicit none
    character(*), intent(in):: history
    logical, intent(out), optional :: err
    character(*), intent(out), optional:: file, title, source, institution
    real,intent(out), optional:: origin, interval, newest, oldest
    character(*), intent(out), optional:: conventions, gt_version
    character(*), pointer, optional:: dims(:) ! (out)
    integer,pointer, optional:: dimsizes(:) ! (out)
    character(*), pointer, optional:: longnames(:) ! (out)
    character(*), pointer, optional:: units(:) ! (out)
    character(*), pointer, optional:: xtypes(:) ! (out)
    type(GT_HISTORY_AXIS), pointer, optional :: axes(:) ! (out)
    type(GT_HISTORY_VARINFO), pointer, optional :: varinfo(:) ! (out)
    integer                  :: stat
    character(STRING)              :: cause_c
    character(*), parameter:: subname = "HistoryInquire2"
  continue
    call BeginSub(subname, "history=%c", c1=trim(history))
    stat = DC_NOERR
    cause_c = ''
    if (trim(history) /= 'default') then
      stat = NF_EINVAL
      cause_c = 'history="' // trim(history) // '"'
      goto 999
    end if
    call HistoryInquire1(default, err, file, title, source, dims, dimsizes, longnames, units, xtypes, institution, origin, interval, newest, oldest, conventions, gt_version, axes, varinfo )
999 continue
    call StoreError(stat, subname, cause_c=cause_c)
    call EndSub(subname)
  end subroutine HistoryInquire2