Module gt4_historyauto

module gt4_historyauto

        ! Uses
    use dc_types, only: STRING, TOKEN
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    use gt4_history, only: GT_HISTORY, HistoryCreate, HistoryPut,  HistoryClose, HistoryAddVariable, HistorySetTime,  HistoryAddAttr, HistoryInquire, Inquire, GT_HISTORY_VARINFO

        ! Types
    public type GT4_ATTRIBUTE
    public type GT4_REAL1D
    public type GT4_NAMED_REALARY
    private type GTHP
    private type HIST_EACHVAR
    private type HIST_LINK

        ! Variables
    type (HIST_LINK), private, save, pointer :: HISTPOOL => NULL ()
    type (HIST_LINK), private, save, pointer :: HISTGRIDPOOL => NULL ()
    integer, private, parameter :: max_char_len = 200
    character (len=max_char_len), private :: com_proc = ''
    character (len=max_char_len), private :: com_title = ''
    character (len=max_char_len), private :: com_source = ''
    character (len=max_char_len), private :: com_institution = ''
    character (len=max_char_len), private :: com_conventions = ''
    character (len=max_char_len), private :: com_gt_version = '4.2'

        ! Interfaces
    public interface HistoryAutoCreate

        ! Subroutines and functions
    private logical function HistoryHasVariable (history, varname)
    public function init_gt4_attribute (name, rval, ival, cval) result (result)
    public function init_gt4_real1d (ary) result (result)
    public function init_gt4_named_realary (name, rank, dims, length, ary, longname, units) result (result)
    private function make_slice (vals, rank, aryshape, slfst, sllst, slstp) result (result)
    private subroutine add_gt4_attribute (hst, attr)
    private subroutine add_ancilcrdvar (hst, var)
    private subroutine put_ancilcrdvar (hst, var)
    public subroutine HistoryAutoPut (name, vals, time)
    public function HistoryAutoWhetherPutNow (name, time) result (result)
    private function whether_to_put_now (time_now, time_last, time_to_start, put_interval, dt) result (result)
    public subroutine HistoryAutoCopyCreate (name, longname, units, file)
    public subroutine HistoryAutoSetRunInfo (title, source, institution, proc, conventions, gt_version)
    public subroutine HistoryAutoSetGrid (grid_label, aryshape, dims, axlongnames, axunits, axxtypes, coord1, coord2, coord3, ancilcrdvars)
    private subroutine HistoryAutoCreate2 (name, longname, units, file, slfst, sllst, slstp, time_to_start, put_interval, dt, newfile_interval, attrs, grid_label, title, source, institution, conventions, gt_version, proc)
    private subroutine HistoryAutoCreate1 (name, longname, units, file, slfst, sllst, slstp, time_to_start, put_interval, dt, newfile_interval, attrs, aryshape, dims, axlongnames, axunits, axxtypes, spcoordvars, ancilcrdvars, title, source, institution, conventions, gt_version, proc)
    private function histpl_find (histpl, name, ith, hist) result (result)
    private function histpl_to_the_end (histpl) result (result)
    private function histpl_last (histpl) result (result)
    private subroutine histpl_push (histpl, hist)
    private function merge_file_proc_time (file, proc, time) result (result)
    private function present_and_not_empty (arg) result (result)

end module gt4_historyauto

Description of Types

public type GT4_ATTRIBUTE
    character (len=TOKEN) :: name
    real, pointer, dimension (:) :: rval => null ()
    integer, pointer, dimension (:) :: ival => null ()
    character (len=STRING) :: cval
end type GT4_ATTRIBUTE

public type GT4_REAL1D
    real, pointer, dimension (:) :: ary => null ()
end type GT4_REAL1D

public type GT4_NAMED_REALARY
    integer :: rank
    character (len=TOKEN) :: name
    character (len=TOKEN), dimension (3) :: dims
    character (len=STRING) :: longname
    character (len=STRING) :: units
    real, pointer, dimension (:) :: ary => null ()
end type GT4_NAMED_REALARY

private type GTHP
    type (GT_HISTORY), pointer :: hs => null ()
end type GTHP

private type HIST_EACHVAR
    character (len=TOKEN) :: name
    type (GTHP), pointer :: h => null ()
    character (len=STRING) :: longname
    character (len=STRING) :: units
    integer :: size
    integer, dimension (3) :: aryshape
    integer, dimension (3) :: slfst
    integer, dimension (3) :: sllst
    integer, dimension (3) :: slstp
    character (len=STRING) :: file
    character (len=TOKEN) :: proc
    real :: newfile_interval
    character (len=STRING) :: title
    character (len=STRING) :: source
    character (len=STRING) :: institution
    integer :: sprank
    character (len=TOKEN), dimension (4) :: dims
    integer, dimension (4) :: dimsizes
    character (len=STRING), dimension (4) :: axlongnames
    character (len=STRING), dimension (4) :: axunits
    character (len=TOKEN), dimension (4) :: axxtypes
    real :: time_last
    real :: time_to_start
    real :: put_interval
    real :: dt
    character (len=STRING) :: conventions
    character (len=TOKEN) :: gt_version
    type (GT4_REAL1D), dimension (3) :: spcoordvars
    type (GT4_NAMED_REALARY), pointer, dimension (:) :: ancilcrdvars => null ()
    type (GT4_ATTRIBUTE), pointer, dimension (:) :: attrs => null ()
end type HIST_EACHVAR

private type HIST_LINK
    character (len=TOKEN) :: name
    type (HIST_EACHVAR) :: hist
    type (HIST_LINK), pointer :: next => null ()
end type HIST_LINK

Description of Variables

type (HIST_LINK), private, save, pointer :: HISTPOOL => NULL ()

type (HIST_LINK), private, save, pointer :: HISTGRIDPOOL => NULL ()

integer, private, parameter :: max_char_len = 200

character (len=max_char_len), private :: com_proc = ''

character (len=max_char_len), private :: com_title = ''

character (len=max_char_len), private :: com_source = ''

character (len=max_char_len), private :: com_institution = ''

character (len=max_char_len), private :: com_conventions = ''

character (len=max_char_len), private :: com_gt_version = '4.2'

Description of Interfaces

public interface HistoryAutoCreate
    module procedure HistoryAutoCreate1
    module procedure HistoryAutoCreate2
end interface HistoryAutoCreate

Description of Subroutines and Functions

private function HistoryHasVariable (history, varname) result (result)
    type (GT_HISTORY), intent(in) :: history
    character (len=*) :: varname
    logical :: result
    ! Calls: Inquire
end function HistoryHasVariable

public function init_gt4_attribute (name, rval, ival, cval) result (result)
    character (len=*), intent(in) :: name
    real, optional, intent(in), dimension (:) :: rval
    integer, optional, intent(in), dimension (:) :: ival
    character (len=*), optional, intent(in) :: cval
    type (GT4_ATTRIBUTE) :: result
end function init_gt4_attribute

public function init_gt4_real1d (ary) result (result)
    real, intent(in), dimension (:) :: ary
    type (GT4_REAL1D) :: result
end function init_gt4_real1d

public function init_gt4_named_realary (name, rank, dims, length, ary, longname, units) result (result)
    character (len=*), intent(in) :: name
    integer, intent(in) :: rank
    character (len=*), intent(in), dimension (rank) :: dims
    integer, intent(in) :: length
    real, intent(in), dimension (length) :: ary
    character (len=*), intent(in) :: longname
    character (len=*), intent(in) :: units
    type (GT4_NAMED_REALARY) :: result
    ! Calls: BeginSub, EndSub, StoreError
end function init_gt4_named_realary

private function make_slice (vals, rank, aryshape, slfst, sllst, slstp) result (result)
    real, intent(in), dimension (:) :: vals
    integer, intent(in) :: rank
    integer, intent(in), dimension (*) :: aryshape
    integer, intent(in), dimension (*) :: slfst
    integer, intent(in), dimension (*) :: sllst
    integer, intent(in), dimension (*) :: slstp
    real, pointer, dimension(:) :: result
    ! Calls: BeginSub, EndSub
end function make_slice

private subroutine add_gt4_attribute (hst, attr)
    type (HIST_EACHVAR), intent(inout) :: hst
    type (GT4_ATTRIBUTE), intent(in) :: attr
    ! Calls: HistoryAddAttr
end subroutine add_gt4_attribute

private subroutine add_ancilcrdvar (hst, var)
    type (HIST_EACHVAR), intent(inout) :: hst
    type (GT4_NAMED_REALARY), intent(in) :: var
    ! Calls: HistoryAddVariable
end subroutine add_ancilcrdvar

private subroutine put_ancilcrdvar (hst, var)
    type (HIST_EACHVAR), intent(inout) :: hst
    type (GT4_NAMED_REALARY), intent(in) :: var
    ! Calls: BeginSub, EndSub, HistoryPut, StoreError
end subroutine put_ancilcrdvar

public subroutine HistoryAutoPut (name, vals, time)
    character (len=*), intent(in) :: name
    real, dimension (*) :: vals
    real :: time
    ! Calls: BeginSub, EndSub, HistoryAddVariable, HistoryClose, HistoryCreate, HistoryInquire, HistoryPut, HistorySetTime, add_ancilcrdvar, add_gt4_attribute, put_ancilcrdvar
end subroutine HistoryAutoPut

public function HistoryAutoWhetherPutNow (name, time) result (result)
    character (len=*), intent(in) :: name
    real, intent(in) :: time
    logical :: result
    ! Calls: BeginSub, EndSub
end function HistoryAutoWhetherPutNow

private function whether_to_put_now (time_now, time_last, time_to_start, put_interval, dt) result (result)
    real, intent(in) :: time_now
    real, intent(in) :: time_last
    real, intent(in) :: time_to_start
    real, intent(in) :: put_interval
    real, intent(in) :: dt
    logical :: result
    ! Calls: BeginSub, EndSub
end function whether_to_put_now

public subroutine HistoryAutoCopyCreate (name, longname, units, file)
    character (len=*), intent(in) :: name
    character (len=*), intent(in) :: longname
    character (len=*), intent(in) :: units
    character (len=*), optional, intent(in) :: file
    ! Calls: BeginSub, EndSub, histpl_push
end subroutine HistoryAutoCopyCreate

public subroutine HistoryAutoSetRunInfo (title, source, institution, proc, conventions, gt_version)
    character (len=*), optional, intent(in) :: title
    character (len=*), optional, intent(in) :: source
    character (len=*), optional, intent(in) :: institution
    character (len=*), optional, intent(in) :: proc
    character (len=*), optional, intent(in) :: conventions
    character (len=*), optional, intent(in) :: gt_version
    ! Calls: BeginSub, EndSub
end subroutine HistoryAutoSetRunInfo

public subroutine HistoryAutoSetGrid (grid_label, aryshape, dims, axlongnames, axunits, axxtypes, coord1, coord2, coord3, ancilcrdvars)
    character (len=*), intent(in) :: grid_label
    integer, intent(in), dimension (:) :: aryshape
    character (len=*), intent(in), dimension (:) :: dims
    character (len=*), intent(in), dimension (:) :: axlongnames
    character (len=*), intent(in), dimension (:) :: axunits
    character (len=*), intent(in), dimension (:) :: axxtypes
    real, optional, intent(in), dimension (:) :: coord1
    real, optional, intent(in), dimension (:) :: coord2
    real, optional, intent(in), dimension (:) :: coord3
    type (GT4_NAMED_REALARY), optional, intent(in), dimension (:) :: ancilcrdvars
    ! Calls: BeginSub, EndSub, histpl_push
end subroutine HistoryAutoSetGrid

private subroutine HistoryAutoCreate2 (name, longname, units, file, slfst, sllst, slstp, time_to_start, put_interval, dt, newfile_interval, attrs, grid_label, title, source, institution, conventions, gt_version, proc)
    character (len=*), intent(in) :: name
    character (len=*), intent(in) :: longname
    character (len=*), intent(in) :: units
    character (len=*), intent(in) :: file
    integer, intent(in), dimension (*) :: slfst
    integer, intent(in), dimension (*) :: sllst
    integer, intent(in), dimension (*) :: slstp
    real, intent(in) :: time_to_start
    real, intent(in) :: put_interval
    real, intent(in) :: dt
    real, intent(in) :: newfile_interval
    type (GT4_ATTRIBUTE), optional, intent(in), dimension (:) :: attrs
    character (len=*), intent(in) :: grid_label
    character (len=*), optional, intent(in) :: title
    character (len=*), optional, intent(in) :: source
    character (len=*), optional, intent(in) :: institution
    character (len=*), optional, intent(in) :: conventions
    character (len=*), optional, intent(in) :: gt_version
    character (len=*), optional, intent(in) :: proc
    ! Calls: BeginSub, EndSub, HistoryAutoCreate1, StoreError
end subroutine HistoryAutoCreate2

private subroutine HistoryAutoCreate1 (name, longname, units, file, slfst, sllst, slstp, time_to_start, put_interval, dt, newfile_interval, attrs, aryshape, dims, axlongnames, axunits, axxtypes, spcoordvars, ancilcrdvars, title, source, institution, conventions, gt_version, proc)
    character (len=*), intent(in) :: name
    character (len=*), intent(in) :: longname
    character (len=*), intent(in) :: units
    character (len=*), intent(in) :: file
    integer, intent(in), dimension (*) :: slfst
    integer, intent(in), dimension (*) :: sllst
    integer, intent(in), dimension (*) :: slstp
    real, intent(in) :: time_to_start
    real, intent(in) :: put_interval
    real, intent(in) :: dt
    real, intent(in) :: newfile_interval
    type (GT4_ATTRIBUTE), optional, intent(in), dimension (:) :: attrs
    integer, intent(in), dimension (:) :: aryshape
    character (len=*), intent(in), dimension (*) :: dims
    character (len=*), intent(in), dimension (*) :: axlongnames
    character (len=*), intent(in), dimension (*) :: axunits
    character (len=*), intent(in), dimension (*) :: axxtypes
    type (GT4_REAL1D), intent(in), dimension (*) :: spcoordvars
    type (GT4_NAMED_REALARY), optional, intent(in), dimension (:) :: ancilcrdvars
    character (len=*), optional, intent(in) :: title
    character (len=*), optional, intent(in) :: source
    character (len=*), optional, intent(in) :: institution
    character (len=*), optional, intent(in) :: conventions
    character (len=*), optional, intent(in) :: gt_version
    character (len=*), optional, intent(in) :: proc
    ! Calls: BeginSub, EndSub, StoreError, histpl_push
end subroutine HistoryAutoCreate1

private function histpl_find (histpl, name, ith, hist) result (result)
    type (HIST_LINK), pointer :: histpl
    character (len=*), intent(in) :: name
    integer, intent(inout) :: ith
    type (HIST_EACHVAR), pointer :: hist
    logical :: result
end function histpl_find

private function histpl_to_the_end (histpl) result (result)
    type (HIST_LINK), pointer :: histpl
    type (HIST_LINK), pointer :: result
end function histpl_to_the_end

private function histpl_last (histpl) result (result)
    type (HIST_LINK), pointer :: histpl
    type (HIST_EACHVAR), pointer :: result
end function histpl_last

private subroutine histpl_push (histpl, hist)
    type (HIST_LINK), pointer :: histpl
    type (HIST_EACHVAR), intent(in) :: hist
end subroutine histpl_push

private function merge_file_proc_time (file, proc, time) result (result)
    character (len=*), intent(in) :: file
    character (len=*), intent(in) :: proc
    real, optional, intent(in) :: time
    character (len=STRING) :: result
end function merge_file_proc_time

private function present_and_not_empty (arg) result (result)
    character (len=*), optional, intent(in) :: arg
    logical :: result
end function present_and_not_empty