Class gt4_history
In: src/gt4_history.f90

This module is designed for output to gtool4 netCDF dataset sequentially along an axis (hereafter it will be called ‘time’). The name indicates that the module is originally intended to serve as the ‘history’ of atmospheric forecast models.

Methods

AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   AddAttr   Copy   Copy   Copy   Create   Create   Create   HistoryAddAttr   HistoryAddAttr   HistoryAddAttr   HistoryAddAttr   HistoryAddAttr   HistoryAddAttr   HistoryAddAttr   HistoryAddAttr   HistoryAddVariable   HistoryAddVariable   HistoryAxisAddAttr   HistoryAxisAddAttr   HistoryAxisAddAttr   HistoryAxisAddAttr   HistoryAxisAddAttr   HistoryAxisAddAttr   HistoryAxisAddAttr   HistoryAxisAddAttr   HistoryAxisCopy   HistoryAxisCreate   HistoryAxisInquire   HistoryCopy   HistoryCopyVariable   HistoryCreate   HistoryCreate   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGet   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryGetPointer   HistoryInquire   HistoryInquire   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistoryPut   HistorySetTime   HistoryVarinfoAddAttr   HistoryVarinfoAddAttr   HistoryVarinfoAddAttr   HistoryVarinfoAddAttr   HistoryVarinfoAddAttr   HistoryVarinfoAddAttr   HistoryVarinfoAddAttr   HistoryVarinfoAddAttr   HistoryVarinfoCopy   HistoryVarinfoCreate   HistoryVarinfoInquire   Inquire   Inquire   Inquire   Inquire   Put   Put   Put   Put   Put   Put   Put   Put   Put   Put   Put   Put   Put   Put   Put   Put  

Included Modules

gtdata_types dc_types dc_trace dc_date dc_string gtdata_generic dc_url dc_error dc_present dc_message regex

Public Instance methods

varname :character(*), intent(in)
attrname :character(*), intent(in)
value :integer(INTK), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrInt0(  varname, attrname, value, history)

        implicit none
        character(*), intent(in):: varname
        character(*), intent(in):: attrname
        integer(INTK), intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE):: var
        integer(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value :integer(INTK), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrInt0(  axis, attrname, value)

      implicit none
      type(GT_HISTORY_AXIS),intent(inout) :: axis
      character(*), intent(in):: attrname
      integer(INTK), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value :logical, intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrLogical0(  axis, attrname, value)

      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(INTK):: 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
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value :logical, intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrLogical0(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      logical, intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrLogical0"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrLogical0
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value :integer(INTK), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrInt0(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      integer(INTK), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrInt0"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrInt0
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :integer(INTK), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrInt1(  varname, attrname, value, history)

        implicit none
        character(*), intent(in):: varname
        character(*), intent(in):: attrname
        integer(INTK), intent(in):: value(:)
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE):: var
        integer(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value(:) :integer(INTK), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrInt1(  axis, attrname, value)

      implicit none
      type(GT_HISTORY_AXIS),intent(inout) :: axis
      character(*), intent(in):: attrname
      integer(INTK), intent(in):: value(:)
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: 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
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value(:) :integer(INTK), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrInt1(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      integer(INTK), intent(in):: value(:)
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrInt1"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrInt1
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :real(SP), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrReal0(  varname, attrname, value, history)

        implicit none
        character(*), intent(in):: varname
        character(*), intent(in):: attrname
        real(SP), intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE):: var
        integer(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value :real(SP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrReal0(  axis, attrname, value)

      implicit none
      type(GT_HISTORY_AXIS),intent(inout) :: axis
      character(*), intent(in):: attrname
      real(SP), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: 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
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :logical, intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrLogical0(  varname, attrname, value, history)

        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(INTK):: 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
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value :character(*), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrChar0(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      character(*), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrChar0"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(value))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrChar0
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value :character(*), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrChar0(  axis, attrname, value)

      implicit none
      type(GT_HISTORY_AXIS),intent(inout) :: axis
      character(*), intent(in):: attrname
      character(*), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: 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
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value :real(SP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrReal0(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      real(SP), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrReal0"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrReal0
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :character(*), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrChar0(  varname, attrname, value, history)

        implicit none
        character(*), intent(in):: varname
        character(*), intent(in):: attrname
        character(*), intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE):: var
        integer(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value(:) :real(SP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrReal1(  axis, attrname, value)

      implicit none
      type(GT_HISTORY_AXIS),intent(inout) :: axis
      character(*), intent(in):: attrname
      real(SP), intent(in):: value(:)
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: 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
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value(:) :real(SP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrReal1(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      real(SP), intent(in):: value(:)
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrReal1"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrReal1
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :real(DP), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrDouble0(  varname, attrname, value, history)

        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(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value :real(DP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrDouble0(  axis, attrname, value)

      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(INTK):: 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
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value :real(DP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrDouble0(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      real(DP), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble0"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrDouble0
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :real(DP), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrDouble1(  varname, attrname, value, history)

        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(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value(:) :real(DP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrDouble1(  axis, attrname, value)

      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(INTK):: 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
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value(:) :real(DP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrDouble1(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      real(DP), intent(in):: value(:)
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble1"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrDouble1
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :real(SP), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrReal1(  varname, attrname, value, history)

        implicit none
        character(*), intent(in):: varname
        character(*), intent(in):: attrname
        real(SP), intent(in):: value(:)
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE):: var
        integer(INTK):: 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
varinfo_dest :type(GT_HISTORY_VARINFO),intent(out)
varinfo_src :type(GT_HISTORY_VARINFO),intent(in)
err :logical, intent(out), optional
name :character(*) , intent(in), optional
: 次元変数名
dims(:) :character(*) , intent(in), optional, target
: 依存する次元
longname :character(*) , intent(in), optional
: 次元変数の記述的名称
units :character(*) , intent(in), optional
: 次元変数の単位
xtype :character(*) , intent(in), optional
: 次元変数の型

終了せずに err が真になって返る. それ以降の引数は, コピーの際に上書きするための値である.

[Source]

    subroutine HistoryVarinfoCopy1(varinfo_dest, varinfo_src, err,  name, dims, longname, units, xtype)

      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(INTK)                      :: 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

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

      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
axis_dest :type(GT_HISTORY_AXIS),intent(out)
axis_src :type(GT_HISTORY_AXIS),intent(in)
err :logical, intent(out), optional
name :character(*) , intent(in), optional
: 次元変数名
length :integer(INTK), intent(in), optional
: 次元長 (配列サイズ)
longname :character(*) , intent(in), optional
: 次元変数の記述的名称
units :character(*) , intent(in), optional
: 次元変数の単位
xtype :character(*) , intent(in), optional
: 次元変数の型

終了せずに err が真になって返る. それ以降の引数は, コピーの際に上書きするための値である.

[Source]

    subroutine HistoryAxisCopy1(axis_dest, axis_src, err,  name, length, longname, units, xtype)

      implicit none
      type(GT_HISTORY_AXIS),intent(out) :: axis_dest
      type(GT_HISTORY_AXIS),intent(in)  :: axis_src
      logical,               intent(out), optional :: err
      character(*) , intent(in), optional:: name     ! 次元変数名
      integer(INTK), 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
hist_dest :type(GT_HISTORY), intent(out), target
file :character(*), intent(in)
hist_src :type(GT_HISTORY), intent(in), optional, target
title :character(*), intent(in), optional
source :character(*), intent(in), optional
institution :character(*), intent(in), optional
origin :real, intent(in), optional
:
!!$ type(GT_HISTORY_AXIS), intent(in),optional :axes(:)
!!$ type(GT_HISTORY_AXIS), intent(in),optional :addaxes(:)
!!$ character(*), intent(in), optional:dims(:)
!!$ integer(INTK), intent(in), optional:dimsizes(:)
!!$ character(*), intent(in), optional:longnames(:)
!!$ character(*), intent(in), optional:units(:)
interval :real, intent(in), optional
:
!!$ type(GT_HISTORY_AXIS), intent(in),optional :axes(:)
!!$ type(GT_HISTORY_AXIS), intent(in),optional :addaxes(:)
!!$ character(*), intent(in), optional:dims(:)
!!$ integer(INTK), intent(in), optional:dimsizes(:)
!!$ character(*), intent(in), optional:longnames(:)
!!$ character(*), intent(in), optional:units(:)
conventions :character(*), intent(in), optional
:
!!$ character(*), intent(in), optional:xtypes(:)
gt_version :character(*), intent(in), optional
:
!!$ character(*), intent(in), optional:xtypes(:)

それ以降の引数は hist_src の設定を上書きするためのものである.

[Source]

    subroutine HistoryCopy1(hist_dest, file, hist_src,  title, source, institution,  origin, interval,  conventions, gt_version)

!      use dc_url,    only:

!      use dc_string, only:

    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(INTK),          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(INTK)          , pointer:: dimsizes(:) => null()
      character(STRING), pointer:: longnames(:) => null()
      character(STRING), pointer:: units(:)  => null()
      character(STRING), pointer:: xtypes(:) => null()
      integer(INTK)  :: 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
varinfo :type(GT_HISTORY_VARINFO),intent(out)
name :character(*) , intent(in)
: 次元変数名
dims(:) :character(*) , intent(in)
: 依存する次元
longname :character(*) , intent(in)
: 次元変数の記述的名称
units :character(*) , intent(in)
: 次元変数の単位
xtype :character(*) , intent(in)
: 次元変数の型

$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none

$ character(*) , intent(in):name ! 次元変数名
$ integer(INTK), intent(in):size ! 次元長 (配列サイズ)
$ character(*) , intent(in):longname ! 次元変数の記述的名称
$ character(*) , intent(in):units ! 次元変数の単位
$ character(*) , intent(in):xtype ! 次元変数の型
$ character(len = *), parameter:subname = "HistoryAxisCreate1"

$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1

[Source]




    subroutine HistoryVarinfoCreate1( varinfo,  name, dims, longname, units, xtype)

      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(INTK):: 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
file :character(len=*), intent(in)
title :character(len=*), intent(in)
source :character(len=*), intent(in)
institution :character(len=*), intent(in)
dims(:) :character(len=*), intent(in)
dimsizes(:) :integer(INTK), intent(in)
longnames(:) :character(len=*), intent(in)
units(:) :character(len=*), intent(in)
origin :real, intent(in)
interval :real, intent(in)
xtypes(:) :character(len=*), intent(in), optional
history :type(GT_HISTORY), intent(out), optional, target
conventions :character(len=*), intent(in), optional
gt_version :character(len=*), intent(in), optional

begin

[Source]

    subroutine HistoryCreate1(file, title, source, institution,  dims, dimsizes, longnames, units, origin, interval,    xtypes, history, conventions, gt_version)

    implicit none
        character(len=*), intent(in)          :: file
        character(len=*), intent(in)          :: title, source, institution
        character(len=*), intent(in)          :: dims(:)
        integer(INTK),          intent(in)          :: dimsizes(:)
        character(len=*), intent(in)          :: longnames(:)
        character(len=*), intent(in)          :: units(:)
        real,             intent(in)          :: origin, interval
        character(len=*), intent(in),  optional        :: xtypes(:)
        type(GT_HISTORY), intent(out), optional, target:: history
        character(len=*), intent(in), optional:: conventions, gt_version
    !=end
        integer(INTK):: numdims, i, stat
        type(GT_HISTORY), pointer:: hst =>null()
        character(len = token):: my_xtype
        character(len = string):: merged, x_inst, x_conv, x_gtver, nc_history
        ! gtool4 netCDF 規約の URL と最新バージョン (更新されたらここを変更)
        character(len = string), parameter::  gtool4_netCDF_Conventions =        "http://www.gfd-dennou.org/arch/gtool4/conventions/"
        character(len = string), parameter:: newest_version = "4.2"
        logical                           :: gtver_add
        character(len = *),      parameter:: subname = "HistoryCreate1"
    continue
        call BeginSub(subname, 'file=%c ndims=%d, %c',   c1=trim(file), i=(/size(dims)/),          c2='dims(:)=<'     // trim(JoinChar(dims(:), ','))// '>, ' //     'dimsizes(:)=<' // trim(toChar(dimsizes(:)))   // '>, ' //     'longnames(:)=<'// trim(JoinChar(longnames(:), '| ')) // '>, ' //     'units(:)=<'    // trim(JoinChar(units(:), '
 '))//  '>, ' )

        if (present(history)) then
            hst => history
        else
            hst => default
        endif
        numdims = size(dims)

        stat = DC_NOERR
        if (   size(dimsizes)  /= numdims .or.  size(longnames) /= numdims .or.  size(units)     /= numdims             ) then
            stat = GT_EARGSIZEMISMATCH
            goto 999
        endif

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

        nc_history = trim(TimeNow()) //        ' unknown> 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))
            call Create(  hst % dimvars(i), trim(merged),  dimsizes(i), xtype=trim(my_xtype), overwrite=.TRUE.)
            ! 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(gt_version)) then
               x_gtver = gt_version
               gtver_add = .TRUE.
            else
               if (present(conventions) .and.                     .not. x_conv == gtool4_netCDF_Conventions) then
                  gtver_add = .FALSE.
               else
                  x_gtver = newest_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)

        ! 時間カウンタ
        hst % origin = origin
        hst % interval = interval
        hst % newest = origin
        hst % oldest = origin
        call EndSub(subname, 'std')
        return
    999 continue
        call StoreError(stat, subname)
        call EndSub(subname, 'err')
    end subroutine
axis :type(GT_HISTORY_AXIS),intent(out)
name :character(*) , intent(in)
: 次元変数名
size :integer(INTK), intent(in)
: 次元長 (配列サイズ)
longname :character(*) , intent(in)
: 次元変数の記述的名称
units :character(*) , intent(in)
: 次元変数の単位
xtype :character(*) , intent(in)
: 次元変数の型

$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none

$ character(*) , intent(in):name ! 次元変数名
$ integer(INTK), intent(in):size ! 次元長 (配列サイズ)
$ character(*) , intent(in):longname ! 次元変数の記述的名称
$ character(*) , intent(in):units ! 次元変数の単位
$ character(*) , intent(in):xtype ! 次元変数の型
$ character(len = *), parameter:subname = "HistoryAxisCreate1"

$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1

[Source]


    subroutine HistoryAxisCreate1( axis,  name, size, longname, units, xtype)

      implicit none
      type(GT_HISTORY_AXIS),intent(out) :: axis
      character(*) , intent(in):: name     ! 次元変数名
      integer(INTK), 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
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :integer(INTK), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrInt0(  varname, attrname, value, history)

        implicit none
        character(*), intent(in):: varname
        character(*), intent(in):: attrname
        integer(INTK), intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE):: var
        integer(INTK):: 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
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :integer(INTK), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrInt1(  varname, attrname, value, history)

        implicit none
        character(*), intent(in):: varname
        character(*), intent(in):: attrname
        integer(INTK), intent(in):: value(:)
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE):: var
        integer(INTK):: 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
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :real(SP), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrReal0(  varname, attrname, value, history)

        implicit none
        character(*), intent(in):: varname
        character(*), intent(in):: attrname
        real(SP), intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE):: var
        integer(INTK):: 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
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :real(DP), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrDouble0(  varname, attrname, value, history)

        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(INTK):: 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
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :real(DP), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrDouble1(  varname, attrname, value, history)

        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(INTK):: 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
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :character(*), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrChar0(  varname, attrname, value, history)

        implicit none
        character(*), intent(in):: varname
        character(*), intent(in):: attrname
        character(*), intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE):: var
        integer(INTK):: 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
varname :character(*), intent(in)
attrname :character(*), intent(in)
value :logical, intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrLogical0(  varname, attrname, value, history)

        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(INTK):: 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
varname :character(*), intent(in)
attrname :character(*), intent(in)
value(:) :real(SP), intent(in)
history :type(GT_HISTORY), target, optional

— 属性の設定 —

[Source]

    subroutine HistoryAddAttrReal1(  varname, attrname, value, history)

        implicit none
        character(*), intent(in):: varname
        character(*), intent(in):: attrname
        real(SP), intent(in):: value(:)
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE):: var
        integer(INTK):: 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
varinfo :type(GT_HISTORY_VARINFO), intent(in)
history :type(GT_HISTORY), intent(inout), optional

[Source]

    subroutine HistoryAddVariable2(varinfo, history)

        implicit none
        type(GT_HISTORY_VARINFO), intent(in)             :: varinfo
        type(GT_HISTORY),         intent(inout), optional:: history
        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
varname :character(len = *), intent(in)
dims(:) :character(len = *), intent(in)
longname :character(len = *), intent(in)
units :character(len = *), intent(in)
xtype :character(len = *), intent(in), optional
history :type(GT_HISTORY), intent(inout), optional, target

各情報を直接引数として与える HistoryAddVariable

[Source]

    subroutine HistoryAddVariable1(varname, dims, longname, units,  xtype, history)

        implicit none
        character(len = *), intent(in):: varname
        character(len = *), intent(in):: dims(:)
        character(len = *), intent(in):: longname, units
        character(len = *), intent(in), optional:: xtype
        type(GT_HISTORY), intent(inout), optional, target:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE), pointer:: vwork(:) =>null(), dimvars(:) =>null()
        character(len = STRING):: fullname, url
        integer(INTK), pointer:: count_work(:) =>null()
        integer(INTK):: nvars, numdims, i, dimord
        character(len = *), parameter:: subname = "HistoryAddVariable1"
    continue
        !----- 操作対象決定 -----
        if (present(history)) then
            hst => history
        else
            hst => default
        endif
        call BeginSub(subname, 'name=%c', c1=varname)

        !----- 変数表拡張 -----
        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

        !----- 変数添字次元を決定 -----
        numdims = size(dims(:))
        allocate(dimvars(numdims))
        do, i = 1, numdims
           ! hst 内で, 次元変数名 dim(i) に当たる次元変数の ID である
           ! hst%dimvar(i) を dimvars(i) に, 添字を dimord に
           dimvars(i) = lookup_dimension(hst, dims(i), ord=dimord)
           ! 無制限次元の添字と一致する場合に,
           ! その添字を 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)
        call EndSub(subname)
    end subroutine
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value :logical, intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrLogical0(  axis, attrname, value)

      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(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value(:) :real(SP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrReal1(  axis, attrname, value)

      implicit none
      type(GT_HISTORY_AXIS),intent(inout) :: axis
      character(*), intent(in):: attrname
      real(SP), intent(in):: value(:)
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value :real(SP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrReal0(  axis, attrname, value)

      implicit none
      type(GT_HISTORY_AXIS),intent(inout) :: axis
      character(*), intent(in):: attrname
      real(SP), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value :character(*), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrChar0(  axis, attrname, value)

      implicit none
      type(GT_HISTORY_AXIS),intent(inout) :: axis
      character(*), intent(in):: attrname
      character(*), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value(:) :real(DP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrDouble1(  axis, attrname, value)

      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(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value(:) :integer(INTK), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrInt1(  axis, attrname, value)

      implicit none
      type(GT_HISTORY_AXIS),intent(inout) :: axis
      character(*), intent(in):: attrname
      integer(INTK), intent(in):: value(:)
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value :integer(INTK), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrInt0(  axis, attrname, value)

      implicit none
      type(GT_HISTORY_AXIS),intent(inout) :: axis
      character(*), intent(in):: attrname
      integer(INTK), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: 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
axis :type(GT_HISTORY_AXIS),intent(inout)
attrname :character(*), intent(in)
value :real(DP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryAxisAddAttrDouble0(  axis, attrname, value)

      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(INTK):: 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
axis_dest :type(GT_HISTORY_AXIS),intent(out)
axis_src :type(GT_HISTORY_AXIS),intent(in)
err :logical, intent(out), optional
name :character(*) , intent(in), optional
: 次元変数名
length :integer(INTK), intent(in), optional
: 次元長 (配列サイズ)
longname :character(*) , intent(in), optional
: 次元変数の記述的名称
units :character(*) , intent(in), optional
: 次元変数の単位
xtype :character(*) , intent(in), optional
: 次元変数の型

終了せずに err が真になって返る. それ以降の引数は, コピーの際に上書きするための値である.

[Source]

    subroutine HistoryAxisCopy1(axis_dest, axis_src, err,  name, length, longname, units, xtype)

      implicit none
      type(GT_HISTORY_AXIS),intent(out) :: axis_dest
      type(GT_HISTORY_AXIS),intent(in)  :: axis_src
      logical,               intent(out), optional :: err
      character(*) , intent(in), optional:: name     ! 次元変数名
      integer(INTK), 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
axis :type(GT_HISTORY_AXIS),intent(out)
name :character(*) , intent(in)
: 次元変数名
size :integer(INTK), intent(in)
: 次元長 (配列サイズ)
longname :character(*) , intent(in)
: 次元変数の記述的名称
units :character(*) , intent(in)
: 次元変数の単位
xtype :character(*) , intent(in)
: 次元変数の型

$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none

$ character(*) , intent(in):name ! 次元変数名
$ integer(INTK), intent(in):size ! 次元長 (配列サイズ)
$ character(*) , intent(in):longname ! 次元変数の記述的名称
$ character(*) , intent(in):units ! 次元変数の単位
$ character(*) , intent(in):xtype ! 次元変数の型
$ character(len = *), parameter:subname = "HistoryAxisCreate1"

$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1

[Source]


    subroutine HistoryAxisCreate1( axis,  name, size, longname, units, xtype)

      implicit none
      type(GT_HISTORY_AXIS),intent(out) :: axis
      character(*) , intent(in):: name     ! 次元変数名
      integer(INTK), 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
axis :type(GT_HISTORY_AXIS),intent(in)
name :character(*) , intent(out), optional
: 次元変数名
size :integer(INTK), intent(out), optional
: 次元長 (配列サイズ)
longname :character(*) , intent(out), optional
: 次元変数の記述的名称
units :character(*) , intent(out), optional
: 次元変数の単位
xtype :character(*) , intent(out), optional
: 次元変数の型

$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none

$ character(*) , intent(in):name ! 次元変数名
$ integer(INTK), intent(in):size ! 次元長 (配列サイズ)
$ character(*) , intent(in):longname ! 次元変数の記述的名称
$ character(*) , intent(in):units ! 次元変数の単位
$ character(*) , intent(in):xtype ! 次元変数の型
$ character(len = *), parameter:subname = "HistoryAxisCreate1"

$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1

[Source]




    subroutine HistoryAxisInquire1( axis,  name, size, longname, units, xtype)

      implicit none
      type(GT_HISTORY_AXIS),intent(in) :: axis
      character(*) , intent(out), optional:: name     ! 次元変数名
      integer(INTK), 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
hist_dest :type(GT_HISTORY), intent(out), target
file :character(*), intent(in)
hist_src :type(GT_HISTORY), intent(in), optional, target
title :character(*), intent(in), optional
source :character(*), intent(in), optional
institution :character(*), intent(in), optional
origin :real, intent(in), optional
:
!!$ type(GT_HISTORY_AXIS), intent(in),optional :axes(:)
!!$ type(GT_HISTORY_AXIS), intent(in),optional :addaxes(:)
!!$ character(*), intent(in), optional:dims(:)
!!$ integer(INTK), intent(in), optional:dimsizes(:)
!!$ character(*), intent(in), optional:longnames(:)
!!$ character(*), intent(in), optional:units(:)
interval :real, intent(in), optional
:
!!$ type(GT_HISTORY_AXIS), intent(in),optional :axes(:)
!!$ type(GT_HISTORY_AXIS), intent(in),optional :addaxes(:)
!!$ character(*), intent(in), optional:dims(:)
!!$ integer(INTK), intent(in), optional:dimsizes(:)
!!$ character(*), intent(in), optional:longnames(:)
!!$ character(*), intent(in), optional:units(:)
conventions :character(*), intent(in), optional
:
!!$ character(*), intent(in), optional:xtypes(:)
gt_version :character(*), intent(in), optional
:
!!$ character(*), intent(in), optional:xtypes(:)

それ以降の引数は hist_src の設定を上書きするためのものである.

[Source]

    subroutine HistoryCopy1(hist_dest, file, hist_src,  title, source, institution,  origin, interval,  conventions, gt_version)

!      use dc_url,    only:

!      use dc_string, only:

    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(INTK),          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(INTK)          , pointer:: dimsizes(:) => null()
      character(STRING), pointer:: longnames(:) => null()
      character(STRING), pointer:: units(:)  => null()
      character(STRING), pointer:: xtypes(:) => null()
      integer(INTK)  :: 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
file :character(len = *), intent(in)
: ファイル名
varname :character(len = *), intent(in)
: 変数名 (元と先で共有)
history :type(GT_HISTORY), intent(inout), optional, target

 変数のコピー
 (基本的に HistoryAddVariables と一緒)

[Source]

    subroutine HistoryCopyVariable1(file, varname, history)

        implicit none
        character(len = *), intent(in)   :: file    ! ファイル名
        character(len = *), intent(in)   :: varname ! 変数名 (元と先で共有)
        type(GT_HISTORY), intent(inout), optional, target :: history
                                                            ! 出力先
        ! 作業変数
        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(INTK), pointer           :: count_work(:) =>null()
        integer(INTK)                    :: nvars, numdims, i
        logical                    :: growable
        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))
        call Create(hst%vars(nvars), trim(fullname), copyfrom,       copyvalue=.FALSE., overwrite=.TRUE.)

        !----- 無制限次元の添字を探査 -----
        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
file :character(len=*), intent(in)
title :character(len=*), intent(in)
source :character(len=*), intent(in)
institution :character(len=*), intent(in)
dims(:) :character(len=*), intent(in)
dimsizes(:) :integer(INTK), intent(in)
longnames(:) :character(len=*), intent(in)
units(:) :character(len=*), intent(in)
origin :real, intent(in)
interval :real, intent(in)
xtypes(:) :character(len=*), intent(in), optional
history :type(GT_HISTORY), intent(out), optional, target
conventions :character(len=*), intent(in), optional
gt_version :character(len=*), intent(in), optional

begin

[Source]

    subroutine HistoryCreate1(file, title, source, institution,  dims, dimsizes, longnames, units, origin, interval,    xtypes, history, conventions, gt_version)

    implicit none
        character(len=*), intent(in)          :: file
        character(len=*), intent(in)          :: title, source, institution
        character(len=*), intent(in)          :: dims(:)
        integer(INTK),          intent(in)          :: dimsizes(:)
        character(len=*), intent(in)          :: longnames(:)
        character(len=*), intent(in)          :: units(:)
        real,             intent(in)          :: origin, interval
        character(len=*), intent(in),  optional        :: xtypes(:)
        type(GT_HISTORY), intent(out), optional, target:: history
        character(len=*), intent(in), optional:: conventions, gt_version
    !=end
        integer(INTK):: numdims, i, stat
        type(GT_HISTORY), pointer:: hst =>null()
        character(len = token):: my_xtype
        character(len = string):: merged, x_inst, x_conv, x_gtver, nc_history
        ! gtool4 netCDF 規約の URL と最新バージョン (更新されたらここを変更)
        character(len = string), parameter::  gtool4_netCDF_Conventions =        "http://www.gfd-dennou.org/arch/gtool4/conventions/"
        character(len = string), parameter:: newest_version = "4.2"
        logical                           :: gtver_add
        character(len = *),      parameter:: subname = "HistoryCreate1"
    continue
        call BeginSub(subname, 'file=%c ndims=%d, %c',   c1=trim(file), i=(/size(dims)/),          c2='dims(:)=<'     // trim(JoinChar(dims(:), ','))// '>, ' //     'dimsizes(:)=<' // trim(toChar(dimsizes(:)))   // '>, ' //     'longnames(:)=<'// trim(JoinChar(longnames(:), '| ')) // '>, ' //     'units(:)=<'    // trim(JoinChar(units(:), '
 '))//  '>, ' )

        if (present(history)) then
            hst => history
        else
            hst => default
        endif
        numdims = size(dims)

        stat = DC_NOERR
        if (   size(dimsizes)  /= numdims .or.  size(longnames) /= numdims .or.  size(units)     /= numdims             ) then
            stat = GT_EARGSIZEMISMATCH
            goto 999
        endif

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

        nc_history = trim(TimeNow()) //        ' unknown> 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))
            call Create(  hst % dimvars(i), trim(merged),  dimsizes(i), xtype=trim(my_xtype), overwrite=.TRUE.)
            ! 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(gt_version)) then
               x_gtver = gt_version
               gtver_add = .TRUE.
            else
               if (present(conventions) .and.                     .not. x_conv == gtool4_netCDF_Conventions) then
                  gtver_add = .FALSE.
               else
                  x_gtver = newest_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)

        ! 時間カウンタ
        hst % origin = origin
        hst % interval = interval
        hst % newest = origin
        hst % oldest = origin
        call EndSub(subname, 'std')
        return
    999 continue
        call StoreError(stat, subname)
        call EndSub(subname, 'err')
    end subroutine
file :character(*), intent(in)
title :character(*), intent(in)
source :character(*), intent(in)
institution :character(*), intent(in)
axes(:) :type(GT_HISTORY_AXIS), intent(in)
origin :real(SP), intent(in)
interval :real(SP), intent(in)
history :type(GT_HISTORY), intent(out), optional
conventions :character(*), intent(in), optional
gt_version :character(*), intent(in), optional

[Source]

    subroutine HistoryCreate2(file, title, source, institution,  axes, origin, interval, history, conventions, gt_version)

    implicit none
        character(*), intent(in)           :: file
        character(*), intent(in)           :: title, source, institution
        type(GT_HISTORY_AXIS), intent(in)      :: axes(:)
        real(SP),             intent(in)           :: origin, interval
        type(GT_HISTORY), intent(out), optional:: history
        character(*), intent(in),  optional:: conventions, gt_version

        ! 構造体 GT_HISTORY_AXIS のデータ蓄積用
        character(STRING), allocatable     :: axes_name(:)
        integer(INTK)    , allocatable     :: axes_length(:)
        character(STRING), allocatable     :: axes_longname(:)
        character(STRING), allocatable     :: axes_units(:)
        character(STRING), allocatable     :: axes_xtype(:)

        integer(INTK)                      :: 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)

        ! 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
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(SP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal0TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), intent(out) :: array
        real(SP) :: array_tmp(1)
        character(*), parameter :: subname = "HistoryGetReal0TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array_tmp, slice=toChar(time))
        call EndSub(subname)
        array = array_tmp(1)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(SP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal5TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal5TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(SP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetReal6(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), intent(out) :: array(:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal6"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetRealEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(SP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetReal0(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), intent(out) :: array
        real(SP) :: array_tmp(1)
        character(*), parameter :: subname = "HistoryGetReal0"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetRealEx(file=file, varname=varname,  array=array_tmp, slice=slice)
        else
           call HistoryGetRealEx(file=file, varname=varname, array=array_tmp)
        end if
        array = array_tmp(1)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(SP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal0TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(SP), intent(out) :: array
        real(SP) :: array_tmp(1)
        character(*), parameter :: subname = "HistoryGetReal0TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array_tmp, slice=toChar(time))
        call EndSub(subname)
        array = array_tmp(1)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(SP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal5TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal5TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(SP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetReal5(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), intent(out) :: array(:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal5"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetRealEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(SP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetReal1(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), intent(out) :: array(:)
        character(*), parameter :: subname = "HistoryGetReal1"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetRealEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(SP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal1TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(SP), intent(out) :: array(:)
        character(*), parameter :: subname = "HistoryGetReal1TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(SP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal1TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), intent(out) :: array(:)
        character(*), parameter :: subname = "HistoryGetReal1TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(SP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetReal2(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), intent(out) :: array(:,:)
        character(*), parameter :: subname = "HistoryGetReal2"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetRealEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(SP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal2TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:)
        character(*), parameter :: subname = "HistoryGetReal2TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(SP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal2TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:)
        character(*), parameter :: subname = "HistoryGetReal2TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(SP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetReal3(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), intent(out) :: array(:,:,:)
        character(*), parameter :: subname = "HistoryGetReal3"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetRealEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(SP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal3TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:,:)
        character(*), parameter :: subname = "HistoryGetReal3TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(SP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal3TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:,:)
        character(*), parameter :: subname = "HistoryGetReal3TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(DP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetDouble0(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), intent(out) :: array
        real(DP) :: array_tmp(1)
        character(*), parameter :: subname = "HistoryGetDouble0"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetDoubleEx(file=file, varname=varname,  array=array_tmp, slice=slice)
        else
           call HistoryGetDoubleEx(file=file, varname=varname, array=array_tmp)
        end if
        array = array_tmp(1)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(DP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble0TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(DP), intent(out) :: array
        real(DP) :: array_tmp(1)
        character(*), parameter :: subname = "HistoryGetDouble0TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array_tmp, slice=toChar(time))
        call EndSub(subname)
        array = array_tmp(1)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(DP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble0TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), intent(out) :: array
        real(DP) :: array_tmp(1)
        character(*), parameter :: subname = "HistoryGetDouble0TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array_tmp, slice=toChar(time))
        call EndSub(subname)
        array = array_tmp(1)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(DP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetDouble1(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), intent(out) :: array(:)
        character(*), parameter :: subname = "HistoryGetDouble1"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetDoubleEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(DP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble1TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(DP), intent(out) :: array(:)
        character(*), parameter :: subname = "HistoryGetDouble1TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(DP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble1TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), intent(out) :: array(:)
        character(*), parameter :: subname = "HistoryGetDouble1TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(DP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetDouble2(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), intent(out) :: array(:,:)
        character(*), parameter :: subname = "HistoryGetDouble2"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetDoubleEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(DP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble2TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:)
        character(*), parameter :: subname = "HistoryGetDouble2TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(DP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble2TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:)
        character(*), parameter :: subname = "HistoryGetDouble2TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(DP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetDouble3(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), intent(out) :: array(:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble3"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetDoubleEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(DP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble3TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble3TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(DP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble3TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble3TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(DP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetDouble4(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), intent(out) :: array(:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble4"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetDoubleEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(DP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble4TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble4TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(DP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble4TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble4TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(DP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetDouble5(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), intent(out) :: array(:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble5"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetDoubleEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(DP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble5TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble5TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(SP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetReal4(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), intent(out) :: array(:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal4"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetRealEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(SP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal4TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal4TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(DP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble5TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble5TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(DP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetDouble6(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), intent(out) :: array(:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble6"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetDoubleEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(DP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble6TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble6TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(DP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble6TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble6TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(DP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetDouble7(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), intent(out) :: array(:,:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble7"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetDoubleEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(DP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble7TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble7TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(DP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble7TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), intent(out) :: array(:,:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble7TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDoubleEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(SP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal7TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal7TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(SP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal7TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal7TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(SP), intent(out)
slice :character(*), intent(in), optional

入力先のデータの一部を切り出して入力を行うことが 可能である. なお, slice に数値のみが代入される場合, それは時刻の次元 (正確には netCDF の無制限次元) の値として 受け取られる.

[Source]

    subroutine HistoryGetReal7(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), intent(out) :: array(:,:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal7"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        if (present_and_not_empty(slice)) then
           call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=slice)
        else
           call HistoryGetRealEx(file=file, varname=varname, array=array)
        endif
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(SP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal6TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal6TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(SP), intent(out)
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal6TimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal6TimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(SP), intent(out)
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal4TimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), intent(out) :: array(:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal4TimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetRealEx(file=file, varname=varname,  array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(SP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetReal7Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), pointer :: array(:,:,:,:,:,:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetReal7Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(DP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble7PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), pointer :: array(:,:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble7PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble7Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(SP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetReal0Pointer(file, varname, array, slice)

        character(*), intent(in)           :: file, varname
        character(*), intent(in), optional :: slice
        real(SP), pointer :: array
        real(SP), target :: array_tmp(1)
        type(GT_VARIABLE)                    :: var
        character(STRING)                    :: url
        integer(INTK):: domain   ! 変数の入出力領域の大きさ
                           ! (= 変数が依存する各次元サイズの積)
        character(*), parameter :: subname = "HistoryGetReal0Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        allocate(array)
        ! いよいよデータ取得
        call Open(var, url)
        call Inquire(var=var, size=domain)
        call Get(var, array_tmp, domain)
        call Close(var)
        array = array_tmp(1)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(SP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal0PointerTimeR(file, varname, array, time)

        character(*), intent(in) :: file, varname
        real(SP), intent(in)               :: time
        real(SP), pointer :: array
        character(*), parameter :: subname = "HistoryGetReal0PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal0Pointer(file=file,  varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(SP), pointer
time :real(DP), intent(in)

将来廃止予定.

[Source]

    subroutine HistoryGetReal0PointerTimeD(file, varname, array, time)

        character(*), intent(in) :: file, varname
        real(DP), intent(in)               :: time
        real(SP), pointer :: array
        character(*), parameter :: subname = "HistoryGetReal0PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal0Pointer(file=file,  varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(SP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetReal1Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), pointer :: array(:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetReal1Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(SP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal1PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(SP), pointer :: array(:)
        character(*), parameter :: subname = "HistoryGetReal1PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal1Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(SP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal1PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), pointer :: array(:)
        character(*), parameter :: subname = "HistoryGetReal1PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal1Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(SP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetReal2Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), pointer :: array(:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetReal2Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(SP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal2PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(SP), pointer :: array(:,:)
        character(*), parameter :: subname = "HistoryGetReal2PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal2Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(SP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal2PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), pointer :: array(:,:)
        character(*), parameter :: subname = "HistoryGetReal2PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal2Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(SP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetReal3Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), pointer :: array(:,:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetReal3Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(SP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal3PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(SP), pointer :: array(:,:,:)
        character(*), parameter :: subname = "HistoryGetReal3PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal3Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(SP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal3PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), pointer :: array(:,:,:)
        character(*), parameter :: subname = "HistoryGetReal3PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal3Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(SP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetReal4Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), pointer :: array(:,:,:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetReal4Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(SP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal4PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(SP), pointer :: array(:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal4PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal4Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(SP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal4PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), pointer :: array(:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal4PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal4Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(SP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetReal5Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), pointer :: array(:,:,:,:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetReal5Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(SP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal5PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(SP), pointer :: array(:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal5PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal5Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(SP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal5PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), pointer :: array(:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal5PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal5Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(SP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetReal6Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(SP), pointer :: array(:,:,:,:,:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetReal6Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(SP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal6PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(SP), pointer :: array(:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal6PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal6Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(SP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal6PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), pointer :: array(:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal6PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal6Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(DP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetDouble7Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), pointer :: array(:,:,:,:,:,:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetDouble7Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(SP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal7PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(SP), pointer :: array(:,:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal7PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal7Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(SP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetReal7PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(SP), pointer :: array(:,:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetReal7PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetReal7Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(DP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetDouble0Pointer(file, varname, array, slice)

        character(*), intent(in)           :: file, varname
        character(*), intent(in), optional :: slice
        real(DP), pointer :: array
        real(DP), target :: array_tmp(1)
        type(GT_VARIABLE)                    :: var
        character(STRING)                    :: url
        integer(INTK):: domain   ! 変数の入出力領域の大きさ
                           ! (= 変数が依存する各次元サイズの積)
        character(*), parameter :: subname = "HistoryGetDouble0Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        allocate(array)
        ! いよいよデータ取得
        call Open(var, url)
        call Inquire(var=var, size=domain)
        call Get(var, array_tmp, domain)
        call Close(var)
        array = array_tmp(1)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(DP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble0PointerTimeR(file, varname, array, time)

        character(*), intent(in) :: file, varname
        real(SP), intent(in)               :: time
        real(DP), pointer :: array
        character(*), parameter :: subname = "HistoryGetDouble0PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble0Pointer(file=file,  varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array :real(DP), pointer
time :real(DP), intent(in)

将来廃止予定.

[Source]

    subroutine HistoryGetDouble0PointerTimeD(file, varname, array, time)

        character(*), intent(in) :: file, varname
        real(DP), intent(in)               :: time
        real(DP), pointer :: array
        character(*), parameter :: subname = "HistoryGetDouble0PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble0Pointer(file=file,  varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(DP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetDouble1Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), pointer :: array(:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetDouble1Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(DP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble1PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(DP), pointer :: array(:)
        character(*), parameter :: subname = "HistoryGetDouble1PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble1Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:) :real(DP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble1PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), pointer :: array(:)
        character(*), parameter :: subname = "HistoryGetDouble1PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble1Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(DP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetDouble2Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), pointer :: array(:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetDouble2Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(DP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble2PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(DP), pointer :: array(:,:)
        character(*), parameter :: subname = "HistoryGetDouble2PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble2Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:) :real(DP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble2PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), pointer :: array(:,:)
        character(*), parameter :: subname = "HistoryGetDouble2PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble2Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(DP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetDouble3Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), pointer :: array(:,:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetDouble3Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(DP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble3PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(DP), pointer :: array(:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble3PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble3Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:) :real(DP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble3PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), pointer :: array(:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble3PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble3Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(DP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetDouble4Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), pointer :: array(:,:,:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetDouble4Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(DP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble4PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(DP), pointer :: array(:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble4PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble4Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:) :real(DP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble4PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), pointer :: array(:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble4PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble4Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(DP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetDouble5Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), pointer :: array(:,:,:,:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetDouble5Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(DP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble5PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(DP), pointer :: array(:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble5PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble5Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:) :real(DP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble5PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), pointer :: array(:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble5PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble5Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(DP), pointer
slice :character(*), intent(in), optional

[Source]

    subroutine HistoryGetDouble6Pointer(file, varname, array, slice)

        character(*), intent(in):: file, varname
        character(*), intent(in), optional:: slice
        real(DP), pointer :: array(:,:,:,:,:,:)
        type(GT_VARIABLE)                  :: var
        character(STRING)                  :: url
        character(*), parameter :: subname = "HistoryGetDouble6Pointer"
    continue
        call BeginSub(subname, 'file=%c varname=%c slice=%c',  c1=trim(file), c2=trim(varname),  c3=trim(present_select('', 'no-slice', slice)))
        ! 必要な情報を gtool 変数化
        call lookup_growable_url(file, varname, url, slice)
        call DbgMessage('@ url =%c', c1=trim(url))
        ! いよいよデータ取得
        call Open(var, url)
        call Get(var, array)
        call Close(var)
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(DP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble6PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(DP), pointer :: array(:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble6PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble6Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(DP), pointer
time :real(DP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble6PointerTimeD(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(DP), intent(in)              :: time
        real(DP), pointer :: array(:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble6PointerTimeD"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble6Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
file :character(*), intent(in)
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(DP), pointer
time :real(SP), intent(in)

将来廃止予定

[Source]

    subroutine HistoryGetDouble7PointerTimeR(file, varname, array, time)

        character(*), intent(in):: file, varname
        real(SP), intent(in)    :: time
        real(DP), pointer :: array(:,:,:,:,:,:,:)
        character(*), parameter :: subname = "HistoryGetDouble7PointerTimeR"
    continue
        call BeginSub(subname, 'file=%c varname=%c time=%c',  c1=trim(file), c2=trim(varname), c3=toChar(time))
        call HistoryGetDouble7Pointer(  file=file, varname=varname, array=array, slice=toChar(time))
        call EndSub(subname)
    end subroutine
history :character(*), intent(in)
file :character(*), intent(out), optional
title :character(*), intent(out), optional
source :character(*), intent(out), optional
dims(:) :character(*), pointer, optional
dimsizes(:) :integer(INTK),pointer, optional
longnames(:) :character(*), pointer, optional
units(:) :character(*), pointer, optional
xtypes(:) :character(*), pointer, optional
institution :character(*), intent(out), optional
origin :real(SP),intent(out), optional
interval :real(SP),intent(out), optional
conventions :character(*), intent(out), optional
gt_version :character(*), intent(out), optional

[Source]

    subroutine HistoryInquire2(history, file, title, source,  dims, dimsizes, longnames, units, xtypes,  institution, origin, interval, conventions, gt_version )

      implicit none
      character(*), intent(in):: history
      character(*), intent(out), optional:: file, title, source, institution
      real(SP),intent(out), optional:: origin, interval
      character(*), intent(out), optional:: conventions, gt_version
      character(*), pointer, optional:: dims(:)
      integer(INTK),pointer, optional:: dimsizes(:)
      character(*), pointer, optional:: longnames(:)
      character(*), pointer, optional:: units(:)
      character(*), pointer, optional:: xtypes(:)
      integer(INTK)                  :: 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, file, title, source,  dims, dimsizes, longnames, units, xtypes,  institution, origin, interval, conventions, gt_version )
  999 continue
      call StoreError(stat, subname, cause_c=cause_c)
      call EndSub(subname)
    end subroutine HistoryInquire2
history :type(GT_HISTORY), intent(in)
file :character(*), intent(out), optional
title :character(*), intent(out), optional
source :character(*), intent(out), optional
dims(:) :character(*), pointer, optional
dimsizes(:) :integer(INTK),pointer, optional
longnames(:) :character(*), pointer, optional
units(:) :character(*), pointer, optional
xtypes(:) :character(*), pointer, optional
institution :character(*), intent(out), optional
origin :real(SP),intent(out), optional
interval :real(SP),intent(out), optional
conventions :character(*), intent(out), optional
gt_version :character(*), intent(out), optional

参照を行う. 現在, 情報を全て参照できるようにはなっていない.

[Source]

    subroutine HistoryInquire1(history, file, title, source,  dims, dimsizes, longnames, units, xtypes,  institution, origin, interval, conventions, gt_version  )

      implicit none
      type(GT_HISTORY), intent(in):: history
      character(*), intent(out), optional:: file, title, source, institution
      real(SP),intent(out), optional:: origin, interval
      character(*), intent(out), optional:: conventions, gt_version 
      character(*), pointer, optional:: dims(:)
      integer(INTK),pointer, optional:: dimsizes(:)
      character(*), pointer, optional:: longnames(:)
      character(*), pointer, optional:: units(:)
      character(*), pointer, optional:: xtypes(:)
!!!$      type(GT_HISTORY_AXIS), intent(out), optional :: axes(:)

      ! Internal Work
      character(STRING)      :: url
      integer(INTK)          :: i, numdims
      logical                :: growable
      character(*), parameter:: subname = "HistoryInquire1"
    continue
      call BeginSub(subname)
      if (present(file)) then
         call Inquire(history % dimvars(1), url=url)
         call UrlSplit(fullname=url, file=file)
      end if
      if (present(title)) then
         call Get_Attr(history % dimvars(1), '+title', title, 'unknown')
      end if
      if (present(source)) then
         call Get_Attr(history % dimvars(1), '+source', source, 'unknown')
      end if
      if (present(institution)) then
         call Get_Attr(history % dimvars(1), '+institution', institution, 'unknown')
      end if
      if (present(origin)) then
         origin = history % origin
      end if
      if (present(interval)) then
         interval = history % interval
      end if
      if (present(conventions)) then
         call Get_Attr(history % dimvars(1), '+Conventions', conventions, 'unknown')
      end if
      if (present(gt_version)) then
         call Get_Attr(history % dimvars(1), '+gt_version', gt_version, 'unknown')
      end if
      if (present(dims)) then
         numdims = size(history % dimvars)
         allocate(dims(numdims))
         do i = 1, numdims
            call Inquire(history % dimvars (i), name=dims(i))
         end do
      end if
      if (present(dimsizes)) then
         numdims = size(history % dimvars)
         allocate(dimsizes(numdims))
         do i = 1, numdims
            call Inquire(history % dimvars (i), size=dimsizes(i), growable=growable)
            if (growable) dimsizes(i) = 0
         end do
      end if
      if (present(longnames)) then
         numdims = size(history % dimvars)
         allocate(longnames(numdims))
         do i = 1, numdims
            call Get_attr(history % dimvars (i), 'long_name',  longnames(i), 'unknown')
         end do
      end if
      if (present(units)) then
         numdims = size(history % dimvars)
         allocate(units(numdims))
         do i = 1, numdims
            call Get_attr(history % dimvars (i), 'units',  units(i), 'unknown')
         end do
      end if
      if (present(xtypes)) then
         numdims = size(history % dimvars)
         allocate(xtypes(numdims))
         do i = 1, numdims
            call Inquire(history % dimvars (i), xtype=xtypes(i))
         end do
      end if
      call EndSub(subname)
    end subroutine HistoryInquire1
varname :character(*), intent(in)
array(:,:,:,:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal5(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal5"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble3(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble3"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble2(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble2"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
value :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble0(varname, value, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: value
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble0"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, (/value/), 1, history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal7(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:,:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal7"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal6(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal6"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble4(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble4"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal4(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal4"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal3(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal3"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal2(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal2"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal1(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal1"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
value :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal0(varname, value, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: value
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal0"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, (/value/), 1, history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble5(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble5"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble6(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble6"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble7(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:,:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble7"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble1(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble1"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
time :real, intent(in)
history :type(GT_HISTORY), intent(inout), optional, target
: hogehgoe

herohero

時刻を明示設定している状態で、巻き戻しを含めた時間設定。 前進している間は検索をしないようになっている。

[Source]

    subroutine HistorySetTime(time, history)

    implicit none
        real, intent(in):: time
        ! hogehgoe
        !
        ! herohero
        type(GT_HISTORY), intent(inout), optional, target:: history
        type(GT_HISTORY), pointer:: hst =>null()
        type(GT_VARIABLE):: var
        real, pointer:: buffer(:) =>null()
        logical:: err
    continue
        if (present(history)) then
            hst => history
        else
            hst => default
        endif
        if (hst%unlimited_index == 0) then
            return
        endif
        var = hst%dimvars(hst%unlimited_index)
        hst%dim_value_written(hst%unlimited_index) = .TRUE.
        if (time < hst%oldest .or. time > hst%newest .or. hst%count(2) == 0) then
            hst%count(:) = maxval(hst%count(:)) + 1
            hst%newest = max(hst%newest, time)
            hst%oldest = min(hst%oldest, time)
            call Slice(var, 1, start=hst%count(1), count=1)
            call Put(var, (/time/), 1, err)
            if (err) call DumpError()
            return
        endif
        call Slice(var, 1, start=1, count=hst%count(2))
        nullify(buffer)
        call Get(var, buffer, err)
        hst%count(1:1) = minloc(abs(buffer - time))
    end subroutine
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value :character(*), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrChar0(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      character(*), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrChar0"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(value))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrChar0
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value(:) :real(DP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrDouble1(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      real(DP), intent(in):: value(:)
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble1"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrDouble1
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value :real(DP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrDouble0(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      real(DP), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble0"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrDouble0
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value(:) :real(SP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrReal1(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      real(SP), intent(in):: value(:)
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrReal1"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrReal1
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value :real(SP), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrReal0(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      real(SP), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrReal0"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrReal0
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value(:) :integer(INTK), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrInt1(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      integer(INTK), intent(in):: value(:)
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrInt1"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrInt1
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value :integer(INTK), intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrInt0(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      integer(INTK), intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrInt0"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrInt0
varinfo :type(GT_HISTORY_VARINFO),intent(inout)
attrname :character(*), intent(in)
value :logical, intent(in)

配列の 1 つ目の要素のみ値として付与される.

[Source]

    subroutine HistoryVarinfoAddAttrLogical0(  varinfo, attrname, value)

      implicit none
      type(GT_HISTORY_VARINFO),intent(inout) :: varinfo
      character(*), intent(in):: attrname
      logical, intent(in):: value
      type(GT_HISTORY_ATTR), pointer:: attrs_tmp(:)
      integer(INTK):: attrs_num
      character(STRING) :: name
      character(*), parameter:: subname = "HistoryVarinfoAddAttrLogical0"
    continue
      call BeginSub(subname,  'attrname=<%c>, value=<%c>',  c1=trim(attrname), c2=trim(toChar(value)))
      call HistoryVarinfoInquire1( varinfo, name )
      call DbgMessage('varinfo name=<%c>', c1=trim(name))

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

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

      call EndSub(subname)
    end subroutine HistoryVarinfoAddAttrLogical0
varinfo_dest :type(GT_HISTORY_VARINFO),intent(out)
varinfo_src :type(GT_HISTORY_VARINFO),intent(in)
err :logical, intent(out), optional
name :character(*) , intent(in), optional
: 次元変数名
dims(:) :character(*) , intent(in), optional, target
: 依存する次元
longname :character(*) , intent(in), optional
: 次元変数の記述的名称
units :character(*) , intent(in), optional
: 次元変数の単位
xtype :character(*) , intent(in), optional
: 次元変数の型

終了せずに err が真になって返る. それ以降の引数は, コピーの際に上書きするための値である.

[Source]

    subroutine HistoryVarinfoCopy1(varinfo_dest, varinfo_src, err,  name, dims, longname, units, xtype)

      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(INTK)                      :: 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

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

      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
varinfo :type(GT_HISTORY_VARINFO),intent(out)
name :character(*) , intent(in)
: 次元変数名
dims(:) :character(*) , intent(in)
: 依存する次元
longname :character(*) , intent(in)
: 次元変数の記述的名称
units :character(*) , intent(in)
: 次元変数の単位
xtype :character(*) , intent(in)
: 次元変数の型

$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none

$ character(*) , intent(in):name ! 次元変数名
$ integer(INTK), intent(in):size ! 次元長 (配列サイズ)
$ character(*) , intent(in):longname ! 次元変数の記述的名称
$ character(*) , intent(in):units ! 次元変数の単位
$ character(*) , intent(in):xtype ! 次元変数の型
$ character(len = *), parameter:subname = "HistoryAxisCreate1"

$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1

[Source]




    subroutine HistoryVarinfoCreate1( varinfo,  name, dims, longname, units, xtype)

      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(INTK):: 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
varinfo :type(GT_HISTORY_VARINFO),intent(in)
name :character(*), intent(out), optional
: 次元変数名
dims(:) :character(*), pointer, optional
: 依存する次元
longname :character(*), intent(out), optional
: 次元変数の記述的名称
units :character(*), intent(out), optional
: 次元変数の単位
xtype :character(*), intent(out), optional
: 次元変数の型

$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none

$ character(*) , intent(in):name ! 次元変数名
$ integer(INTK), intent(in):size ! 次元長 (配列サイズ)
$ character(*) , intent(in):longname ! 次元変数の記述的名称
$ character(*) , intent(in):units ! 次元変数の単位
$ character(*) , intent(in):xtype ! 次元変数の型
$ character(len = *), parameter:subname = "HistoryAxisCreate1"

$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1

[Source]




    subroutine HistoryVarinfoInquire1( varinfo,  name, dims, longname, units, xtype)

      implicit none
      type(GT_HISTORY_VARINFO),intent(in) :: varinfo
      character(*), intent(out), optional:: name     ! 次元変数名
      character(*), pointer,     optional:: dims(:)  ! 依存する次元
      character(*), intent(out), optional:: longname ! 次元変数の記述的名称
      character(*), intent(out), optional:: units    ! 次元変数の単位
      character(*), intent(out), optional:: xtype    ! 次元変数の型
      ! Internal Work
      integer(INTK):: i, numdims
      character(*), parameter:: subname = "HistoryVarinfoInquire1"
      continue
      call BeginSub(subname)
      if (present(name)) then
         name     = varinfo % name
      end if
      if (present(dims)) then
         numdims = size(varinfo % dims)
         allocate(dims(numdims))
         do i = 1, numdims
            dims(i) = varinfo % dims(i)
         end do
      end if
      if (present(longname)) then
         longname = varinfo % longname
      end if
      if (present(units)) then
         units    = varinfo % units
      end if
      if (present(xtype)) then
         xtype    = varinfo % xtype
      end if
      call EndSub(subname)
    end subroutine HistoryVarinfoInquire1
history :type(GT_HISTORY), intent(in)
file :character(*), intent(out), optional
title :character(*), intent(out), optional
source :character(*), intent(out), optional
dims(:) :character(*), pointer, optional
dimsizes(:) :integer(INTK),pointer, optional
longnames(:) :character(*), pointer, optional
units(:) :character(*), pointer, optional
xtypes(:) :character(*), pointer, optional
institution :character(*), intent(out), optional
origin :real(SP),intent(out), optional
interval :real(SP),intent(out), optional
conventions :character(*), intent(out), optional
gt_version :character(*), intent(out), optional

参照を行う. 現在, 情報を全て参照できるようにはなっていない.

[Source]

    subroutine HistoryInquire1(history, file, title, source,  dims, dimsizes, longnames, units, xtypes,  institution, origin, interval, conventions, gt_version  )

      implicit none
      type(GT_HISTORY), intent(in):: history
      character(*), intent(out), optional:: file, title, source, institution
      real(SP),intent(out), optional:: origin, interval
      character(*), intent(out), optional:: conventions, gt_version 
      character(*), pointer, optional:: dims(:)
      integer(INTK),pointer, optional:: dimsizes(:)
      character(*), pointer, optional:: longnames(:)
      character(*), pointer, optional:: units(:)
      character(*), pointer, optional:: xtypes(:)
!!!$      type(GT_HISTORY_AXIS), intent(out), optional :: axes(:)

      ! Internal Work
      character(STRING)      :: url
      integer(INTK)          :: i, numdims
      logical                :: growable
      character(*), parameter:: subname = "HistoryInquire1"
    continue
      call BeginSub(subname)
      if (present(file)) then
         call Inquire(history % dimvars(1), url=url)
         call UrlSplit(fullname=url, file=file)
      end if
      if (present(title)) then
         call Get_Attr(history % dimvars(1), '+title', title, 'unknown')
      end if
      if (present(source)) then
         call Get_Attr(history % dimvars(1), '+source', source, 'unknown')
      end if
      if (present(institution)) then
         call Get_Attr(history % dimvars(1), '+institution', institution, 'unknown')
      end if
      if (present(origin)) then
         origin = history % origin
      end if
      if (present(interval)) then
         interval = history % interval
      end if
      if (present(conventions)) then
         call Get_Attr(history % dimvars(1), '+Conventions', conventions, 'unknown')
      end if
      if (present(gt_version)) then
         call Get_Attr(history % dimvars(1), '+gt_version', gt_version, 'unknown')
      end if
      if (present(dims)) then
         numdims = size(history % dimvars)
         allocate(dims(numdims))
         do i = 1, numdims
            call Inquire(history % dimvars (i), name=dims(i))
         end do
      end if
      if (present(dimsizes)) then
         numdims = size(history % dimvars)
         allocate(dimsizes(numdims))
         do i = 1, numdims
            call Inquire(history % dimvars (i), size=dimsizes(i), growable=growable)
            if (growable) dimsizes(i) = 0
         end do
      end if
      if (present(longnames)) then
         numdims = size(history % dimvars)
         allocate(longnames(numdims))
         do i = 1, numdims
            call Get_attr(history % dimvars (i), 'long_name',  longnames(i), 'unknown')
         end do
      end if
      if (present(units)) then
         numdims = size(history % dimvars)
         allocate(units(numdims))
         do i = 1, numdims
            call Get_attr(history % dimvars (i), 'units',  units(i), 'unknown')
         end do
      end if
      if (present(xtypes)) then
         numdims = size(history % dimvars)
         allocate(xtypes(numdims))
         do i = 1, numdims
            call Inquire(history % dimvars (i), xtype=xtypes(i))
         end do
      end if
      call EndSub(subname)
    end subroutine HistoryInquire1
history :character(*), intent(in)
file :character(*), intent(out), optional
title :character(*), intent(out), optional
source :character(*), intent(out), optional
dims(:) :character(*), pointer, optional
dimsizes(:) :integer(INTK),pointer, optional
longnames(:) :character(*), pointer, optional
units(:) :character(*), pointer, optional
xtypes(:) :character(*), pointer, optional
institution :character(*), intent(out), optional
origin :real(SP),intent(out), optional
interval :real(SP),intent(out), optional
conventions :character(*), intent(out), optional
gt_version :character(*), intent(out), optional

[Source]

    subroutine HistoryInquire2(history, file, title, source,  dims, dimsizes, longnames, units, xtypes,  institution, origin, interval, conventions, gt_version )

      implicit none
      character(*), intent(in):: history
      character(*), intent(out), optional:: file, title, source, institution
      real(SP),intent(out), optional:: origin, interval
      character(*), intent(out), optional:: conventions, gt_version
      character(*), pointer, optional:: dims(:)
      integer(INTK),pointer, optional:: dimsizes(:)
      character(*), pointer, optional:: longnames(:)
      character(*), pointer, optional:: units(:)
      character(*), pointer, optional:: xtypes(:)
      integer(INTK)                  :: 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, file, title, source,  dims, dimsizes, longnames, units, xtypes,  institution, origin, interval, conventions, gt_version )
  999 continue
      call StoreError(stat, subname, cause_c=cause_c)
      call EndSub(subname)
    end subroutine HistoryInquire2
axis :type(GT_HISTORY_AXIS),intent(in)
name :character(*) , intent(out), optional
: 次元変数名
size :integer(INTK), intent(out), optional
: 次元長 (配列サイズ)
longname :character(*) , intent(out), optional
: 次元変数の記述的名称
units :character(*) , intent(out), optional
: 次元変数の単位
xtype :character(*) , intent(out), optional
: 次元変数の型

$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none

$ character(*) , intent(in):name ! 次元変数名
$ integer(INTK), intent(in):size ! 次元長 (配列サイズ)
$ character(*) , intent(in):longname ! 次元変数の記述的名称
$ character(*) , intent(in):units ! 次元変数の単位
$ character(*) , intent(in):xtype ! 次元変数の型
$ character(len = *), parameter:subname = "HistoryAxisCreate1"

$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1

[Source]




    subroutine HistoryAxisInquire1( axis,  name, size, longname, units, xtype)

      implicit none
      type(GT_HISTORY_AXIS),intent(in) :: axis
      character(*) , intent(out), optional:: name     ! 次元変数名
      integer(INTK), 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
varinfo :type(GT_HISTORY_VARINFO),intent(in)
name :character(*), intent(out), optional
: 次元変数名
dims(:) :character(*), pointer, optional
: 依存する次元
longname :character(*), intent(out), optional
: 次元変数の記述的名称
units :character(*), intent(out), optional
: 次元変数の単位
xtype :character(*), intent(out), optional
: 次元変数の型

$ type(GT_HISTORY_AXIS) function HistoryAxisNew1( $ name, size, longname, units, xtype) result(result) $ use dc_types, only: STRING, TOKEN, DP, SP, INTK $ use dc_trace, only: BeginSub, EndSub, DbgMessage $ implicit none

$ character(*) , intent(in):name ! 次元変数名
$ integer(INTK), intent(in):size ! 次元長 (配列サイズ)
$ character(*) , intent(in):longname ! 次元変数の記述的名称
$ character(*) , intent(in):units ! 次元変数の単位
$ character(*) , intent(in):xtype ! 次元変数の型
$ character(len = *), parameter:subname = "HistoryAxisCreate1"

$ continue $ call BeginSub(subname) $ result % name = name $ result % length = size $ result % longname = longname $ result % units = units $ result % xtype = xtype $ call EndSub(subname) $ end function HistoryAxisNew1

[Source]




    subroutine HistoryVarinfoInquire1( varinfo,  name, dims, longname, units, xtype)

      implicit none
      type(GT_HISTORY_VARINFO),intent(in) :: varinfo
      character(*), intent(out), optional:: name     ! 次元変数名
      character(*), pointer,     optional:: dims(:)  ! 依存する次元
      character(*), intent(out), optional:: longname ! 次元変数の記述的名称
      character(*), intent(out), optional:: units    ! 次元変数の単位
      character(*), intent(out), optional:: xtype    ! 次元変数の型
      ! Internal Work
      integer(INTK):: i, numdims
      character(*), parameter:: subname = "HistoryVarinfoInquire1"
      continue
      call BeginSub(subname)
      if (present(name)) then
         name     = varinfo % name
      end if
      if (present(dims)) then
         numdims = size(varinfo % dims)
         allocate(dims(numdims))
         do i = 1, numdims
            dims(i) = varinfo % dims(i)
         end do
      end if
      if (present(longname)) then
         longname = varinfo % longname
      end if
      if (present(units)) then
         units    = varinfo % units
      end if
      if (present(xtype)) then
         xtype    = varinfo % xtype
      end if
      call EndSub(subname)
    end subroutine HistoryVarinfoInquire1
varname :character(*), intent(in)
array(:,:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal3(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal3"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal6(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal6"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal5(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal5"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal4(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal4"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble7(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:,:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble7"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal2(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal2"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal1(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal1"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
value :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal0(varname, value, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: value
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal0"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, (/value/), 1, history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:,:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble6(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble6"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
value :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble0(varname, value, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: value
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble0"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, (/value/), 1, history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble1(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble1"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble2(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble2"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble3(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble3"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble4(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble4"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:,:) :real(DP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutDouble5(varname, array, history)
        character(*), intent(in):: varname
        real(DP), intent(in):: array(:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutDouble5"
    continue
        call BeginSub(subname)
        call HistoryPutDoubleEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine
varname :character(*), intent(in)
array(:,:,:,:,:,:,:) :real(SP), intent(in)
history :type(GT_HISTORY), intent(inout), optional, target

なお、HistorySetTime で既に値が設定され、hst%count の値が 増やされる場合には、こちらでは hst%count の値を変更しない。 データも入力しない。

[Source]




    subroutine HistoryPutReal7(varname, array, history)
        character(*), intent(in):: varname
        real(SP), intent(in):: array(:,:,:,:,:,:,:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(*), parameter:: subname = "HistoryPutReal7"
    continue
        call BeginSub(subname)
        call HistoryPutRealEx(varname, array, size(array), history)
        call EndSub(subname)
    end subroutine

[Validate]