! gtool_history.f90 - traditional interface for `history' output
! vi: set sw=4 ts=8: 
! Copyright (C) GFD Dennou Club, 2000.  All rights reserved.

!=begin
!= module gtool_history
!a sequential output interface for gtool4 netCDF dataset.
!
!== Description
!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.
!=end

module gtool_history

    !=begin
    !== Dependency
    !* ((<module gtdata_types|URL:gtdata_types.html>)) for internal data access
    !* ((<module dc_types|URL:dc_types.html>)) for constants STRING and TOKEN
    !* ((<module dc_trace|URL:dc_trace.html>)) for error trace function
    !=end

    use gtdata_types
    use dc_types, only: string, token
    use dc_trace, only: beginsub, endsub, message
    implicit none

    private
    public:: GT_HISTORY
    public:: HistoryCreate, HistoryAddVariable, HistoryClose
    public:: HistoryPutEx, HistoryPut, HistoryAddAttr, GT_HISTORY_AXIS
    public:: HistorySetTime, GT_HISTORY_VARINFO

    interface HistoryCreate
        module procedure HistoryCreate1, HistoryCreate2
    end interface

    interface HistoryAddVariable
        module procedure HistoryAddVariable1, HistoryAddVariable2
    end interface

    interface HistoryPut
        module procedure HistoryPut1, HistoryPut2, HistoryPut3, HistoryPut0
        module procedure HistoryPutDouble1, HistoryPutDouble2
        module procedure HistoryPutDouble3, HistoryPutDouble0
    end interface

    interface HistoryAddAttr
        module procedure HistoryAddAttrC, HistoryAddAttrS
        module procedure HistoryAddAttrL
        module procedure HistoryAddAttrR, HistoryAddAttrRA
        module procedure HistoryAddAttrD, HistoryAddAttrDA
        module procedure HistoryAddAttrI, HistoryAddAttrIA
    end interface

    !=begin
    !== Derived Types
    !=== type GT_HISTORY
    !Data entity of this type represents a netCDF dataset controlled by
    !gtool4 library.
    !It must be initialized by ((<HistoryOpen>)),
    !then used in many subroutines, and must be finalized by ((<HistoryClose>)).
    !Note that the resultant file is undefined if you forget to finalize it. 
    !
    !Users are recommended to retain the object of this type
    !returned by ((<HistoryOpen>)),
    !to use it as the last argument (called ((|history|))) for
    !all following subroutine calls.
    !However, it is not mandatory.
    !When you are going to write ((*ONLY*)) one dataset,
    !argument ((|history|)) of all subroutine calls can be omitted, and
    !the history entity will be internally managed within this module.
    !=end

    type GT_HISTORY
        type(GT_VARIABLE), pointer:: dimvars(:)
        logical, pointer:: dim_value_written(:)
        !
        ! NOTE: it is index of dimvars(:), not that of vars(:).
        integer:: unlimited_index
        real:: origin, interval, newest, oldest
        type(GT_VARIABLE), pointer:: vars(:)
        integer, pointer:: growable_indices(:)
        integer, pointer:: count(:)
    end type

    type(GT_HISTORY), save, target:: default

!=begin
!=== type GT_HISTORY_AXIS
!This type may be used as a argument ((|axes|)) of ((<HistoryCreate>))
!to define features of axes of a history dataset.
!Typically, a constant array of this type will be used for
!fixed specification.
!=end

    !=begin
    type GT_HISTORY_AXIS
        character(len = token):: name
        integer:: length
        character(len = string):: longname, units
        character(len = token):: xtype
    end type
    !=end

!=begin
!=== type GT_HISTORY_VARINFO
!This type may be used as a argument ((|varinfo|)) of ((<HistoryAddVariable>))
!to define features of variable of a history dataset.
!=end

    type GT_HISTORY_VARINFO
        character(len = token):: name
        character(len = token), pointer:: dims(:)
        character(len = string):: longname, units
        character(len = token):: xtype
    end type

contains

    !=begin
    !== Procedure Interface
    !=end

    !=begin
    !=== HistoryCreate subroutines
    !Two specific subroutines shares common part:
    !
    !(({call HistoryCreate(}))((|file|)), ((|title|)), ((|source|)),
    !((|institution|)), ..., ((|origin|)), ((|interval|)),
    ![((|history|))](({)}))
    !
    !Both two ones initializes a dataset ((|file|)).
    !The result of ((<type GT_HISTORY>)) will be returned by ((|history|))
    !or managed internally if omitted.
    !Mandatory global attributes are defined by arguments
    !((|title|)), ((|source|)), and ((|institution|));
    !they are all declared as (({character(len = *)})).
    !Spatial axis definitions have two different forms:
    !a primitive one uses several arrays of various types:
    !((|dims|)), ((|dimsizes|)), ((|longnames|)), ((|units|)), and ((|xtypes|)).
    !Another sophisticated one has only array of ((<type GT_HISTORY_AXIS>)),
    !((|axes|)).
    !Temporal definition is done without ((|origin|)), ((|interval|)).
    !=end

    !=begin
    subroutine HistoryCreate2(file, title, source, institution, &
        & axes, origin, interval, history)
    implicit none
        character(len=*), intent(in):: file
        character(len=*), intent(in):: title, source, institution
        type(GT_HISTORY_AXIS), intent(in):: axes(:)
        real, intent(in):: origin, interval
        type(GT_HISTORY), intent(out), optional:: history
    !=end
    continue
        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)
    end subroutine

    !=begin
    subroutine HistoryCreate1(file, title, source, institution, &
        & dims, dimsizes, longnames, units, origin, interval, &
        & xtypes, history)
        use gtdata_generic
        use dc_url
        use dc_error
        use dc_string
        use dc_types, only: string, token
    implicit none
        character(len=*), intent(in):: file
        character(len=*), intent(in):: title, source, institution
        character(len=*), intent(in):: dims(:)
        integer, 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
    !=end
        integer:: numdims, i
        type(GT_HISTORY), pointer:: hst
        character(len = token):: my_xtype
        character(len = string):: merged, x_inst, nc_history
    continue
        call beginsub('history-create', 'file=%c ndims=%d', &
            & c1=trim(file), i=(/size(dims)/))
        if (present(history)) then
            hst => history
        else
            hst => default
        endif
        numdims = size(dims)
        if (size(dimsizes) /= numdims .or. size(longnames) /= numdims .or. &
            & size(units) /= numdims) then
            call StoreError(GT_EARGSIZEMISMATCH, "HistoryCreate")
            call endsub('history-create', 'err')
            return
        endif

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

        nc_history = 'unknown unknown> gtool_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.)
            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 gtool_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('history-create', 'std')
    end subroutine

    !
    ! --- 属性の設定 ---
    !

    subroutine HistoryAddAttrC(varname, attrname, value, history)
        use gtdata_generic, only: Put_Attr
        implicit none
        character(len = *), intent(in):: varname
        character(len = *), intent(in):: attrname
        character(len = *), intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst
        type(GT_VARIABLE):: var
        integer:: v_ord, stat
        character(len = *), parameter:: subname = "HistoryAddAttrC"
    continue
        call beginsub(subname)
        ! 操作対象決定
        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), "+" // attrname, value)
            enddo
        else
            call lookup_var_or_dim(hst, varname, var, stat)
            if (stat == 0) then
                call Put_Attr(var, attrname, value)
            endif
        endif
        call endsub(subname)
     end subroutine

    subroutine HistoryAddAttrS(varname, attrname, value, history)
        use dc_string, only: VSTRING    
        use gtdata_generic, only: Put_Attr
        implicit none
        character(len = *), intent(in):: varname
        character(len = *), intent(in):: attrname
        type(VSTRING), intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst
        type(GT_VARIABLE):: var
        integer:: v_ord, stat
        character(len = *), parameter:: subname = "HistoryAddAttrS"
    continue
        call beginsub(subname)
        ! 操作対象決定
        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), "+" // attrname, value)
            enddo
        else
            call lookup_var_or_dim(hst, varname, var, stat)
            if (stat == 0) then
                call Put_Attr(var, attrname, value)
            endif
        endif
        call endsub(subname)
     end subroutine

    subroutine HistoryAddAttrL(varname, attrname, value, history)
        use gtdata_generic, only: Put_Attr
        implicit none
        character(len = *), intent(in):: varname
        character(len = *), intent(in):: attrname
        logical, intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst
        type(GT_VARIABLE):: var
        integer:: v_ord, stat
        character(len = *), parameter:: subname = "HistoryAddAttrL"
    continue
        call beginsub(subname)
        ! 操作対象決定
        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), "+" // attrname, value)
            enddo
        else
            call lookup_var_or_dim(hst, varname, var, stat)
            if (stat == 0) then
                call Put_Attr(var, attrname, value)
            endif
        endif
        call endsub(subname)
     end subroutine

    subroutine HistoryAddAttrR(varname, attrname, value, history)
        use gtdata_generic, only: Put_Attr
        implicit none
        character(len = *), intent(in):: varname
        character(len = *), intent(in):: attrname
        real, intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst
        type(GT_VARIABLE):: var
        integer:: v_ord, stat
        character(len = *), parameter:: subname = "HistoryAddAttrR"
    continue
        call beginsub(subname)
        ! 操作対象決定
        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), "+" // attrname, (/value/))
            enddo
        else
            call lookup_var_or_dim(hst, varname, var, stat)
            if (stat == 0) then
                call Put_Attr(var, attrname, (/value/))
            endif
        endif
        call endsub(subname)
     end subroutine

    subroutine HistoryAddAttrRA(varname, attrname, value, history)
        use gtdata_generic, only: Put_Attr
        implicit none
        character(len = *), intent(in):: varname
        character(len = *), intent(in):: attrname
        real, intent(in):: value(:)
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst
        type(GT_VARIABLE):: var
        integer:: v_ord, stat
    continue
         ! 操作対象決定
         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), "+" // attrname, value)
            enddo
        else
            call lookup_var_or_dim(hst, varname, var, stat)
            if (stat == 0) then
                call Put_Attr(var, attrname, value)
            endif
        endif
     end subroutine

    subroutine HistoryAddAttrD(varname, attrname, value, history)
        use gtdata_generic, only: Put_Attr
        implicit none
        character(len = *), intent(in):: varname
        character(len = *), intent(in):: attrname
        double precision, intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst
        type(GT_VARIABLE):: var
        integer:: v_ord, stat
    continue
         ! 操作対象決定
         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), "+" // attrname, (/value/))
            enddo
        else
            call lookup_var_or_dim(hst, varname, var, stat)
            if (stat == 0) then
                call Put_Attr(var, attrname, (/value/))
            endif
        endif
     end subroutine

    subroutine HistoryAddAttrDA(varname, attrname, value, history)
        use gtdata_generic, only: Put_Attr
        implicit none
        character(len = *), intent(in):: varname
        character(len = *), intent(in):: attrname
        double precision, intent(in):: value(:)
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst
        type(GT_VARIABLE):: var
        integer:: v_ord, stat
    continue
         ! 操作対象決定
         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), "+" // attrname, value)
            enddo
        else
            call lookup_var_or_dim(hst, varname, var, stat)
            if (stat == 0) then
                call Put_Attr(var, attrname, value)
            endif
        endif
     end subroutine

    subroutine HistoryAddAttrI(varname, attrname, value, history)
        use gtdata_generic, only: Put_Attr
        implicit none
        character(len = *), intent(in):: varname
        character(len = *), intent(in):: attrname
        integer, intent(in):: value
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst
        type(GT_VARIABLE):: var
        integer:: v_ord, stat
    continue
         ! 操作対象決定
         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), "+" // attrname, (/value/))
            enddo
        else
            call lookup_var_or_dim(hst, varname, var, stat)
            if (stat == 0) then
                call Put_Attr(var, attrname, (/value/))
            endif
        endif
     end subroutine

    subroutine HistoryAddAttrIA(varname, attrname, value, history)
        use gtdata_generic, only: Put_Attr
        implicit none
        character(len = *), intent(in):: varname
        character(len = *), intent(in):: attrname
        integer, intent(in):: value(:)
        type(GT_HISTORY), target, optional:: history
        type(GT_HISTORY), pointer:: hst
        type(GT_VARIABLE):: var
        integer:: stat, v_ord
    continue
        ! 操作対象決定
        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), "+" // attrname, value)
            enddo
        else
            call lookup_var_or_dim(hst, varname, var, stat)
            if (stat == 0) then
                call Put_Attr(var, attrname, value)
            endif
        endif
    end subroutine

    !
    ! --- 変数の追加 ---
    !

    subroutine HistoryAddVariable2(varinfo, history)
        type(GT_HISTORY_VARINFO), intent(in):: varinfo
        type(GT_HISTORY), intent(inout), optional:: history
    continue
        call HistoryAddVariable1(trim(varinfo%name), &
            & varinfo%dims, trim(varinfo%longname), &
            & trim(varinfo%units), trim(varinfo%xtype), history)
    end subroutine

    subroutine HistoryAddVariable1(varname, dims, longname, units, &
        & xtype, history)
        use dc_string
        use gtdata_generic
        use dc_url
        use dc_types, only: STRING
        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
        type(GT_VARIABLE), pointer:: vwork(:), dimvars(:)
        character(len = STRING):: fullname, url
        integer, pointer:: count_work(:)
        integer:: nvars, numdims, i, dimord
    continue
        ! 操作対象決定
        if (present(history)) then
            hst => history
        else
            hst => default
        endif
        call beginsub('history-add-variable', '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
            dimvars(i) = lookup_dimension(hst, dims(i), ord=dimord)
            if (dimord == hst%unlimited_index) then
                hst%growable_indices(nvars) = i
            endif
        enddo

        ! 変数作成
        call Inquire(hst%dimvars(1), url=url)
        fullname = UrlResolve(('@' // 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('history-add-variable')
    end subroutine

    ! 時刻を明示設定している状態で、巻き戻しを含めた時間設定。
    ! 前進している間は検索をしないようになっている。
    
    subroutine HistorySetTime(time, history)
        use gtdata_generic
    implicit none
        real, intent(in):: time
        type(GT_HISTORY), intent(inout), optional, target:: history
        type(GT_HISTORY), pointer:: hst
        type(GT_VARIABLE):: var
        real, pointer:: buffer(:)
        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

    ! デフォルトでは変数ごとにカウンタを設置し、呼んだ数だけ「時刻」
    ! 方向を進める。
    ! これに対し、時刻の変数に一度でもスカラ値を投入すると、
    ! 明示的にそれを設定したときにだけ時刻が進むようになる。
    ! このルーチンでは後退はできない。

    subroutine TimeGoAhead(varname, var, head, history)
        use gtdata_generic
        character(len = *), intent(in):: varname
        type(GT_VARIABLE), intent(out):: var
        real, intent(in):: head
        type(GT_HISTORY), intent(inout), optional, target:: history
        type(GT_HISTORY), pointer:: hst
        integer, pointer:: time
        integer:: v_ord, d_ord
    continue
        if (present(history)) then
            hst => history
        else
            hst => default
        endif
        var = lookup_variable(hst, varname, ord=v_ord)
        if (v_ord == 0) goto 1000
        if (hst%growable_indices(v_ord) == 0) return

        if (hst%dim_value_written(hst%unlimited_index)) then
            time => hst%count(1)
            call Slice(var, hst%growable_indices(v_ord), &
                & start=time, count=1)
        else
            time => hst%count(v_ord)
            time = time + 1
            call Slice(var, hst%growable_indices(v_ord), &
                & start=time, count=1)
        endif
        return

    1000 continue
        var = lookup_dimension(hst, varname, ord=d_ord)
        hst%dim_value_written(d_ord) = .TRUE.
        if (d_ord /= hst%unlimited_index) return

        ! ややトリッキーだが、count の2番目以降の要素にも時刻を入れて
        ! おくことで、HistorySetTime による巻き戻し後にも値を保持する。
        hst%count(:) = maxval(hst%count(:)) + 1
        hst%newest = max(hst%newest, head)
        hst%oldest = min(hst%oldest, head)
        call Slice(var, 1, start=hst%count(1), count=1)
        return

    end subroutine

    subroutine HistoryPutEx(varname, array, arraysize, history)
        use gtdata_generic
        character(len = *), intent(in):: varname
        integer, intent(in):: arraysize
        real, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), optional:: history
        type(GT_VARIABLE):: var
        logical:: err
        character(*), parameter:: subname = "HistoryPutEx"
    continue
        call beginsub(subname, '%c', c1=trim(varname))
        call TimeGoAhead(varname, var, array(1), history)
        call Put(var, array, arraysize, err)
        if (err) call DumpError()
	call GTVarSync(var)
        call endsub(subname)
    end subroutine

    subroutine HistoryPut0(varname, value, history)
        character(len = *), intent(in):: varname
        real, intent(in):: value
        type(GT_HISTORY), intent(inout), optional:: history
        character(len = *), parameter:: subname = "HistoryPut0"
    continue
        call beginsub(subname)
        call HistoryPutEx(varname, (/value/), 1, history)
        call endsub(subname)
    end subroutine

    subroutine HistoryPut1(varname, array, history)
        character(len = *), intent(in):: varname
        real, intent(in):: array(:)
        type(GT_HISTORY), intent(inout), optional:: history
        character(len = *), parameter:: subname = "HistoryPut1"
    continue
        call beginsub(subname)
        call HistoryPutEx(varname, array, size(array), history)
        call endsub(subname)
    end subroutine

    subroutine HistoryPut2(varname, array, history)
        character(len = *), intent(in):: varname
        real, intent(in):: array(:, :)
        type(GT_HISTORY), intent(inout), optional:: history
        character(len = *), parameter:: subname = "HistoryPut2"
    continue
        call beginsub(subname)
        call HistoryPutEx(varname, array, size(array), history)
        call endsub(subname)
    end subroutine

    subroutine HistoryPut3(varname, array, history)
        character(len = *), intent(in):: varname
        real, intent(in):: array(:, :, :)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(len = *), parameter:: subname = "HistoryPut3"
    continue
        call beginsub(subname)
        call HistoryPutEx(varname, array, size(array), history)
        call endsub(subname)
    end subroutine

    subroutine HistoryPutExDouble(varname, array, arraysize, history)
        use gtdata_generic
        character(len = *), intent(in):: varname
        integer, intent(in):: arraysize
        double precision, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), optional, target:: history
        type(GT_VARIABLE):: var
        logical:: err
        character(len = *), parameter:: subname = "HistoryPutExDouble"
    continue
        call beginsub(subname, '%c', c1=trim(varname))
        call TimeGoAhead(varname, var, real(array(1)), history)
        call Put(var, array, arraysize, err)
        if (err) call DumpError()
	call GTVarSync(var)
        call endsub(subname)
    end subroutine

    subroutine HistoryPutDouble0(varname, value, history)
        character(len = *), intent(in):: varname
        double precision, intent(in):: value
        type(GT_HISTORY), intent(inout), optional:: history
        character(len = *), parameter:: subname = "HistoryPutDouble0"
    continue
        call beginsub(subname)
        call HistoryPutExDouble(varname, (/value/), 1, history)
        call endsub(subname)
    end subroutine

    subroutine HistoryPutDouble1(varname, array, history)
        character(len = *), intent(in):: varname
        double precision, intent(in):: array(:)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(len = *), parameter:: subname = "HistoryPutDouble1"
    continue
        call beginsub(subname)
        call HistoryPutExDouble(varname, array, size(array), history)
        call endsub(subname)
    end subroutine

    subroutine HistoryPutDouble2(varname, array, history)
        character(len = *), intent(in):: varname
        double precision, intent(in):: array(:, :)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(len = *), parameter:: subname = "HistoryPutDouble2"
    continue
        call beginsub(subname)
        call HistoryPutExDouble(varname, array, size(array), history)
        call endsub(subname)
    end subroutine

    subroutine HistoryPutDouble3(varname, array, history)
        character(len = *), intent(in):: varname
        double precision, intent(in):: array(:, :, :)
        type(GT_HISTORY), intent(inout), optional, target:: history
        character(len = *), parameter:: subname = "HistoryPutDouble3"
    continue
        call beginsub(subname)
        call HistoryPutExDouble(varname, array, size(array), history)
        call endsub(subname)
    end subroutine

    subroutine HistoryClose(history)
        use gtdata_generic
        type(GT_HISTORY), intent(inout), optional, target:: history
        type(GT_HISTORY), pointer:: hst
        integer:: i
        character(len = *), parameter:: subname = "HistoryClose"
    continue
        call beginsub(subname)
        if (present(history)) then
            hst => history
        else
            hst => default
        endif
        do, i = 1, size(hst%dimvars)
            if (.not. hst%dim_value_written(i)) &
                call set_fake_dim_value(hst, i)
            call Close(hst%dimvars(i))
        enddo
        deallocate(hst%dimvars)
        do, i = 1, size(hst%vars)
            call Close(hst%vars(i))
        enddo
        if (associated(hst%vars)) deallocate(hst%vars)
        if (associated(hst%count)) deallocate(hst%count)
        call endsub(subname)
    end subroutine

    subroutine set_fake_dim_value(history, dimord)
        use gtdata_generic
        use dc_error
        type(GT_HISTORY), intent(inout):: history
        integer, intent(in):: dimord
        integer:: length, i
        real, allocatable:: value(:)
        logical:: err
    continue
        if (dimord == history%unlimited_index) then
            if (.not. associated(history%count)) return
            length = maxval(history%count(:))
        else
            call Inquire(history%dimvars(dimord), size=length)
        endif
        if (length == 0) return
        allocate(value(length))
        if (dimord == history%unlimited_index) then
            value(:) = (/(real(i), i = 1, length)/)
            value(:) = history%origin + (value(:) - 1.0) * history%interval
            call Slice(history%dimvars(dimord), 1, start=1, count=length)
        else
            value(:) = (/(real(i), i = 1, length)/)
        endif

        call Put(history%dimvars(dimord), value, size(value), err)
        if (err) call DumpError
        deallocate(value)
    end subroutine

    integer &
    function lookup_variable_ord(history, varname) result(result)
        use dc_types, only: string
        use gtdata_generic, only: inquire
        type(GT_HISTORY), intent(in):: history
        character(len = *):: varname
        character(len = string):: name
        character(len = *), parameter:: subname = 'lookup_variable_ord'
    continue
        call beginsub(subname)
        if (associated(history%vars)) then
            do, result = 1, size(history%vars)
                call Inquire(history%vars(result), name=name)
                if (name == varname) goto 999
                call message('no match <%c> <%c>', c1=trim(name), c2=trim(varname))
            enddo
        endif
        result = 0
    999 continue
        call endsub(subname, "result=%d", i=(/result/))
    end function

    type(GT_VARIABLE) &
    function lookup_variable(history, varname, ord) result(result)
        use gtdata_generic
        type(GT_HISTORY), intent(in):: history
        character(len = *):: varname
        integer, intent(out), optional:: ord
        integer:: i
        character(len = *), parameter:: subname = 'lookup_variable'
    continue
        call beginsub(subname, '%c', c1=trim(varname))
        i = lookup_variable_ord(history, varname)
        if (i > 0) then
            result = history%vars(i)
            if (present(ord)) ord = i
            call endsub(subname, "ord=%d", i=(/i/))
            return
        endif
        if (present(ord)) then
            ord = 0
        else
            print *, 'gtool_history: var lookup for ', varname, ' failed'
            stop
        endif
        call endsub(subname)
    end function

    type(GT_VARIABLE) &
    function lookup_dimension(history, dimname, ord) result(result)
        use gtdata_generic
        use dc_string
        use dc_types, only: STRING
        type(GT_HISTORY), intent(in):: history
        character(len = *), intent(in):: dimname
        integer, intent(out), optional:: ord
        character(len = STRING):: name
        integer:: i
        character(len = *), parameter:: subname = 'lookup_dimension'
    continue
        call beginsub(subname)
        if (associated(history%dimvars)) then
            do, i = 1, size(history%dimvars)
                call Inquire(history%dimvars(i), name=name)
                if (name == dimname) then
                    result = history%dimvars(i)
                    if (present(ord)) ord = i
                    call endsub(subname, "ord=%d", i=(/i/))
                    return
                endif
            enddo
        endif
        if (present(ord)) then
            ord = 0
        else
            print *, 'gtool_history: dim lookup for ', dimname, ' failed'
            stop
        endif
        call endsub(subname, 'ord=0 (not found)')
    end function

    subroutine lookup_var_or_dim(history, name, var, stat)
        type(GT_HISTORY), intent(in):: history
        character(len = *), intent(in):: name
        type(GT_VARIABLE), intent(out):: var
        integer, intent(out):: stat
        integer:: ord
    continue
        var = lookup_variable(history, name, ord)
        if (ord /= 0) then
            stat = 0
            return
        endif
        var = lookup_dimension(history, name, ord)
        if (ord /= 0) then
            stat = 0
            return
        endif
        stat = 1
    end subroutine

end module
