gtool_history.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
! Warning: This file was generated from gtool_history.f90.erb.
!          Do not edit this file.
!-------------------------------------------------------------------------------
module gtool_history
  !-----------------------------------------------------------------------------
  !
  !++ Used modules
  !
  use dc_log, only: &
     log, &
#if defined(__pgi) || defined(__es2)
     log_fid, &
#endif
     log_lmsg
  use dc_types, only: &
     sp, &
     dp
  use gtool_file_h, only: &
     file_hlong, &
     file_hshort, &
     file_hmid
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedures
  !
  public :: historyinit
  public :: historyaddvariable
  public :: historyputaxis
  public :: historyputassociatedcoordinates
  public :: historysettattr
  public :: historyquery
  public :: historyput
  public :: historywrite
  public :: historywriteall
  public :: historyget
  public :: historyoutputlist
  public :: historyfinalize

  interface historyputaxis
     module procedure historyputaxissp
     module procedure historyputaxisdp
  end interface historyputaxis

  interface historyputassociatedcoordinates
     module procedure historyput1dassociatedcoordinatessp
     module procedure historyput1dassociatedcoordinatesdp
     module procedure historyput2dassociatedcoordinatessp
     module procedure historyput2dassociatedcoordinatesdp
     module procedure historyput3dassociatedcoordinatessp
     module procedure historyput3dassociatedcoordinatesdp
     module procedure historyput4dassociatedcoordinatessp
     module procedure historyput4dassociatedcoordinatesdp
  end interface historyputassociatedcoordinates

  interface historyput
     module procedure historyput0dnamesp
     module procedure historyput0didsp
     module procedure historyput0dnamedp
     module procedure historyput0diddp
     module procedure historyput1dnamesp
     module procedure historyput1didsp
     module procedure historyput1dnamedp
     module procedure historyput1diddp
     module procedure historyput2dnamesp
     module procedure historyput2didsp
     module procedure historyput2dnamedp
     module procedure historyput2diddp
     module procedure historyput3dnamesp
     module procedure historyput3didsp
     module procedure historyput3dnamedp
     module procedure historyput3diddp
  end interface historyput

  interface historyget
     module procedure historyget1dsp
     module procedure historyget1ddp
     module procedure historyget2dsp
     module procedure historyget2ddp
     module procedure historyget3dsp
     module procedure historyget3ddp
  end interface historyget

  type axis
     character(len=File_HSHORT) :: name
     character(len=File_HLONG)  :: desc
     character(len=File_HSHORT) :: units
     character(len=File_HSHORT) :: dim
     integer                    :: type
     real(DP), pointer          :: var(:)
     logical                    :: down
  end type axis
  type assoc
     character(len=File_HSHORT) :: name
     character(len=File_HLONG)  :: desc
     character(len=File_HSHORT) :: units
     character(len=File_HSHORT) :: dims(4)
     integer                    :: ndims
     integer                    :: type
     real(DP), pointer          :: var(:)
  end type assoc

  !-----------------------------------------------------------------------------
  !
  !++ included parameters
  !
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  character(len=File_HMID)   :: history_title
  character(len=File_HMID)   :: history_source
  character(len=File_HMID)   :: history_institution
  character(len=File_HMID)   :: history_time_units
  character(len=File_HMID)   :: history_time_since
  real(DP)                   :: history_dtsec
  real(DP)                   :: history_startdaysec

  logical                    :: history_output_step0  = .false.
  real(DP)                   :: history_output_start  = 0.0_dp
  logical                    :: history_error_putmiss = .false.

  integer, parameter         :: history_req_limit = 1000
  character(len=File_HLONG)  :: history_req_basename(history_req_limit)
  character(len=File_HSHORT) :: history_req_item    (history_req_limit)
  real(DP)                   :: history_req_tintsec (history_req_limit)
  integer                    :: history_req_tintstep(history_req_limit)
  logical                    :: history_req_tavg    (history_req_limit)
  logical                    :: history_req_zinterp (history_req_limit)
  integer                    :: history_req_dtype   (history_req_limit)

  integer                                 :: history_req_nmax = 0
  integer                                 :: history_id_count = 0
  character(len=File_HSHORT), allocatable :: history_item    (:)
  integer,                    allocatable :: history_fid     (:)
  integer,                    allocatable :: history_vid     (:)
  real(DP),                   allocatable :: history_tintsec (:)
  integer,                    allocatable :: history_tintstep(:)
  logical,                    allocatable :: history_tavg    (:)
  logical,                    allocatable :: history_zinterp (:)
  real(DP),                   allocatable :: history_varsum  (:,:)
  integer,                    allocatable :: history_size    (:)
  real(DP),                   allocatable :: history_tstart  (:)
  integer,                    allocatable :: history_tstrstep(:)
  integer,                    allocatable :: history_tlststep(:)
  real(DP),                   allocatable :: history_tsumsec (:)


  real(DP), parameter  :: eps = 1.d-10
  integer              :: history_master
  integer              :: history_myrank
  integer, allocatable :: history_rankidx(:)

  integer, parameter :: history_axis_limit = 100
  integer            :: history_axis_count = 0;
  type(axis)         :: history_axis(history_axis_limit)

  integer, parameter :: history_assoc_limit = 20
  integer            :: history_assoc_count = 0;
  type(assoc)        :: history_assoc(history_assoc_limit)

  character(LEN=LOG_LMSG), private :: message

contains
  !-----------------------------------------------------------------------------
  subroutine historyinit( &
       title, source, institution,                         & ! (in)
       array_size,                                         & ! (in)
       master, myrank, rankidx,                            & ! (in)
       time_start, time_interval,                          & ! (in)
       time_units, time_since,                             & ! (in)
       default_basename,                                   & ! (in) optional
       default_tinterval, default_tunit, default_taverage, & ! (in) optional
       default_zinterp,                                    & ! (in) optional
       default_datatype,                                   & ! (in) optional
       namelist_filename, namelist_fid                     & ! (in) optional
       )
    use dc_calendar, only: &
       calendarymdhms2sec
    use gtool_file_h, only: &
       file_real4, &
       file_real8, &
       file_preclist
    implicit none

    character(len=*), intent(in)           :: title
    character(len=*), intent(in)           :: source
    character(len=*), intent(in)           :: institution
    integer,          intent(in)           :: array_size
    integer,          intent(in)           :: master
    integer,          intent(in)           :: myrank
    integer,          intent(in)           :: rankidx(:)
    real(DP),         intent(in)           :: time_start
    real(DP),         intent(in)           :: time_interval
    character(len=*), intent(in), optional :: time_units
    character(len=*), intent(in), optional :: time_since
    character(len=*), intent(in), optional :: default_basename
    real(DP),         intent(in), optional :: default_tinterval
    character(len=*), intent(in), optional :: default_tunit
    logical,          intent(in), optional :: default_taverage
    logical,          intent(in), optional :: default_zinterp
    character(len=*), intent(in), optional :: default_datatype
    character(len=*), intent(in), optional :: namelist_filename
    integer         , intent(in), optional :: namelist_fid

    character(len=File_HLONG)  :: HISTORY_DEFAULT_BASENAME  = ''
    real(DP)                   :: HISTORY_DEFAULT_TINTERVAL = 1.0_dp
    character(len=File_HSHORT) :: HISTORY_DEFAULT_TUNIT     = 'sec'
    logical                    :: HISTORY_DEFAULT_TAVERAGE  = .false.
    logical                    :: HISTORY_DEFAULT_ZINTERP   = .false.
    character(len=File_HSHORT) :: HISTORY_DEFAULT_DATATYPE  = 'REAL4'

    namelist / param_history / &
         history_title,             &
         history_source,            &
         history_institution,       &
         history_time_units,        &
         history_default_basename,  &
         history_default_tinterval, &
         history_default_tunit,     &
         history_default_taverage,  &
         history_default_zinterp,   &
         history_default_datatype,  &
         history_output_step0,      &
         history_output_start,      &
         history_error_putmiss

    character(len=File_HLONG)  :: BASENAME
    character(len=File_HSHORT) :: ITEM
    real(DP)                   :: TINTERVAL
    character(len=File_HSHORT) :: TUNIT
    logical                    :: TAVERAGE
    logical                    :: ZINTERP
    character(len=File_HSHORT) :: DATATYPE

    namelist / histitem / &
       basename,  &
       item,      &
       tinterval, &
       tunit,     &
       taverage,  &
       zinterp,   &
       datatype

    integer :: fid_conf

    integer :: ierr
    integer :: n, ni
    integer :: memsize
    intrinsic size
    !---------------------------------------------------------------------------

    call log('I', '')
    call log('I', '+++ Module[HISTORY]/Categ[IO]')

    !--- read namelist
    history_title       = title
    history_source      = source
    history_institution = institution
    history_startdaysec = time_start
    history_dtsec       = time_interval
    if ( present(time_units) ) then
       history_time_units  = time_units
    else
       history_time_units  = 'seconds'
    endif
    if ( present(time_since) ) then
       history_time_since = time_since
    else
       history_time_since = ''
    endif
    if ( present(default_basename) ) then
       history_default_basename = default_basename
    endif
    if ( present(default_tinterval) ) then
       history_default_tinterval = default_tinterval
       if ( present(default_tunit) ) then
          history_default_tunit = default_tunit
       endif
    endif
    if ( present(default_taverage) ) then
       history_default_taverage = default_taverage
    endif
    if ( present(default_zinterp) ) then
       history_default_zinterp = default_zinterp
    endif
    if ( present(default_datatype) ) then
       history_default_datatype = default_datatype
    endif

    if ( present(namelist_fid) ) then
       fid_conf = namelist_fid
       rewind(fid_conf)
    else if ( present(namelist_filename) ) then
       if ( namelist_filename /= '' ) then
          open( fid_conf, file = trim(namelist_filename), &
               form = 'formatted', status = 'old', iostat = ierr)
       else
          call log('I', '*** Brank namelist file was specified. Default used. ***')
          fid_conf = -1
       endif
    else
       call log('I', '*** No namelist was specified. Default used. ***')
       fid_conf = -1
    endif

    if ( fid_conf > 0 ) then
       read(fid_conf, nml=param_history, iostat=ierr)

       if( ierr < 0 ) then !--- missing
          call log('I', '*** Not found namelist. Default used.')
       elseif( ierr > 0 ) then !--- fatal error
          call log('E', 'xxx Not appropriate names in namelist PARAM_HISTORY. Check!')
       endif
#if defined(__PGI) || defined(__ES2)
       write(log_fid,nml=param_history)
#else
       write(message,nml=param_history)
       call log('I', message)
#endif
    endif

    ! listup history request
    history_req_nmax = 0
    if ( fid_conf > 0 ) then
       rewind( fid_conf )
       do n = 1, history_req_limit
          basename  = history_default_basename
          read(fid_conf, nml=histitem, iostat=ierr)
          if( ierr /= 0 ) exit
          if ( basename /= "" ) history_req_nmax = history_req_nmax + 1
       enddo
    endif

    if    ( history_req_nmax > history_req_limit ) then
       write(message,*) '*** request of history file is exceed! n >', history_req_limit
       call log('I', message)
    elseif( history_req_nmax == 0 ) then
       call log('I', '*** No history file specified.')
       return
    endif

    allocate( history_item(history_req_nmax) ); history_item(:) = ''
    allocate( history_fid(history_req_nmax) )
    allocate( history_vid(history_req_nmax) )
    allocate( history_tintsec(history_req_nmax) )
    allocate( history_tintstep(history_req_nmax) )
    allocate( history_tavg(history_req_nmax) )
    allocate( history_zinterp(history_req_nmax) )

    allocate( history_varsum(array_size,history_req_nmax) )
    allocate( history_size(history_req_nmax) )
    allocate( history_tstart(history_req_nmax) )
    allocate( history_tstrstep(history_req_nmax) )
    allocate( history_tlststep(history_req_nmax) )
    allocate( history_tsumsec(history_req_nmax) )

    if ( fid_conf > 0 ) rewind(fid_conf)
    memsize = 0
    ni = 0
    do n = 1, history_req_limit
       ! set default
       basename  = history_default_basename
       item      = 'unknown'
       tinterval = history_default_tinterval
       tunit     = history_default_tunit
       taverage  = history_default_taverage
       zinterp   = history_default_zinterp
       datatype  = history_default_datatype

       if ( fid_conf > 0 ) then
          read(fid_conf, nml=histitem,iostat=ierr)
          if( ierr /= 0 ) exit
       endif

       if ( basename == "" ) cycle
       ni = ni + 1

       history_req_item(ni) = item
       history_req_basename(ni) = basename
       call calendarymdhms2sec( history_req_tintsec(ni), tinterval, tunit )
       history_req_tintstep(ni) = int( history_req_tintsec(ni) / history_dtsec )

       history_req_tavg(ni) = taverage
       history_req_zinterp(ni) = zinterp

       if ( history_req_tintsec(ni) <= 0.d0 ) then
          write(message,*) 'xxx Not appropriate time interval. Check!', item, tinterval
          call log('E', message)
       endif

       if ( abs(history_req_tintsec(ni)-real(History_req_tintstep(ni),kind=dp)*history_dtsec) > eps ) then
          write(message,*) 'xxx time interval must be a multiple of delta t ', &
                           history_req_tintsec(ni), real(History_req_tintstep(ni),kind=dp)*history_dtsec
          call log('E', message)
       endif

       if    ( datatype == 'REAL4' ) then
          history_req_dtype(n) = file_real4
       elseif( datatype == 'REAL8' ) then
          history_req_dtype(n) = file_real8
       else
          write(message,*) 'xxx Not appropriate DATATYPE. Check!', datatype
          call log('E', message)
       endif

       memsize = memsize + array_size * file_preclist(history_req_dtype(ni))
    enddo

    write(message,*) '*** Number of requested history item             : ', history_req_nmax
    call log('I', message)
    write(message,*) '*** Output default data type                     : ', history_default_datatype
    call log('I', message)
    write(message,*) '*** Memory usage for history data buffer [Mbyte] : ', memsize/1024/1024
    call log('I', message)

    if ( (.not. present(namelist_fid)) ) then
       if ( fid_conf > 0 ) close(fid_conf)
    endif

    history_master = master
    history_myrank = myrank
    allocate( history_rankidx(size(rankidx)) )
    history_rankidx(:) = rankidx(:)

    return
  end subroutine historyinit

  !-----------------------------------------------------------------------------
  subroutine historyaddvariable( &
       varname,    &
       dims,       &
       desc,       &
       units,      &
       now_step,   &
       id,         &
       zinterp,    &
       existed,    &
       options     )
    use gtool_file, only: &
       filecreate,      &
       filesetoption,   &
       fileaddvariable, &
       filesettattr,    &
       fileputaxis,     &
       fileputassociatedcoordinates
    implicit none

    character(len=*), intent(in)  :: varname
    character(len=*), intent(in)  :: dims(:)
    character(len=*), intent(in)  :: desc
    character(len=*), intent(in)  :: units
    integer,          intent(in)  :: now_step
    integer,          intent(out) :: id
    logical,          intent(out) :: zinterp
    logical,          intent(out) :: existed
    character(len=*), intent(in), optional :: options ! 'filetype1:key1=val1&filetype2:key2=val2&...'

    character(len=File_HMID) :: tunits

    logical :: fileexisted
    integer :: nmax, reqid
    integer :: n, m
    integer :: ic, ie, is, lo

    intrinsic size
    !---------------------------------------------------------------------------

    existed = .false.

    !--- search existing item
    id = -1
    nmax = min( history_id_count, history_req_nmax )
    do n = 1, nmax
       if ( varname == history_item(n) ) then ! match existing item
          id      = n
          zinterp = history_zinterp(n)
          existed = .true.
          return
       endif
    enddo

    if ( id < 0 ) then ! request-register matching check

       ! new file registration
       if ( history_time_since == '' ) then
          tunits = history_time_units
       else
          tunits = trim(history_time_units)//' since '//trim(history_time_since)
       endif

       do n = 1, history_req_nmax
          if ( varname == history_req_item(n) ) then
             reqid = n
             if( history_req_basename(reqid) == '' ) exit
             history_id_count = history_id_count + 1
             id = history_id_count

             call filecreate( history_fid(id),                   & ! (out)
                              fileexisted,                       & ! (out)
                              trim(history_req_basename(reqid)), & ! (in)
                              history_title,                     & ! (in)
                              history_source,                    & ! (in)
                              history_institution,               & ! (in)
                              history_master,                    & ! (in)
                              history_myrank,                    & ! (in)
                              history_rankidx,                   & ! (in)
                              time_units = tunits                ) ! (in)

             if ( .not. fileexisted ) then

                if ( present(options) ) then
                   ic = -1 ! index of ':'
                   ie = -1 ! index of '='
                   is =  1 ! start index
                   lo = len_trim(options)
                   do m = 1, lo+1
                      if ( m == lo+1 .or. options(m:m) == '&' ) then
                         if ( ic == -1 .or. ie == -1 ) then
                            call log('E', 'xxx option is invalid: ' // trim(options))
                         endif
                         call filesetoption(history_fid(id),        & ! (in)
                              options(is:ic-1),                     & ! (in)
                              options(ic+1:ie-1), options(ie+1:m-1) ) ! (in)
                         ic = -1
                         ie = -1
                         is = m + 1
                      else if ( options(m:m) == ':' ) then
                         ic = m
                      else if ( options(m:m) == '=' ) then
                         ie = m
                      endif
                   enddo
                endif

                do m = 1, history_axis_count
                   call fileputaxis( history_fid(id),                             & ! (in)
                                     history_axis(m)%name,  history_axis(m)%desc, & ! (in)
                                     history_axis(m)%units, history_axis(m)%dim,  & ! (in)
                                     history_axis(m)%type,  history_axis(m)%var   ) ! (in)
                enddo

                do m = 1, history_assoc_count
                   call fileputassociatedcoordinates( history_fid(id),                                 & ! (in)
                                                      history_assoc(m)%name, history_assoc(m)%desc,    & ! (in)
                                                      history_assoc(m)%units,                          & ! (in)
                                                      history_assoc(m)%dims(1:history_assoc(m)%ndims), & ! (in)
                                                      history_assoc(m)%type, history_assoc(m)%var      ) ! (in)
                enddo

             endif

             history_item(id) = varname
             history_tintsec(id) = history_req_tintsec(reqid)
             history_tintstep(id) = history_req_tintstep(reqid)
             history_tavg(id) = history_req_tavg(reqid)
             history_zinterp(id) = history_req_zinterp(reqid)

             history_varsum(:,id) = 0.d0

             if ( history_output_step0 .and. now_step==1 ) then
                history_tstrstep(id) = 1 - history_tintstep(id)
             else
                history_tstrstep(id) = 1
             endif
             if ( history_output_start > 0.0_dp ) then
                history_tstart(id) = history_startdaysec + history_output_start
             else
                history_tstart(id) = history_startdaysec
             end if
             history_tlststep(id) = history_tstrstep(id)
             history_tsumsec(id) = 0.d0

             call fileaddvariable( history_vid(id),            & ! (out)
                                   history_fid(id),            & ! (in)
                                   varname, desc, units, dims, & ! (in)
                                   history_req_dtype(reqid),   & ! (in)
                                   history_tintsec(id),        & ! (in)
                                   history_tavg(id)         ) ! (in)

             if ( .not. fileexisted ) then
                do m = 1, history_axis_count
                   if ( history_axis(m)%down ) then
                      call filesettattr( history_fid(id), history_axis(m)%name, "positive", "down" )
                   endif
                enddo
             endif

             write(message,*) '*** [HIST] Item registration No.= ', id
             call log('I', message)
             write(message,*) '] Name                : ', trim(history_item(id))
             call log('I', message)
             write(message,*) '] Description         : ', trim(desc)
             call log('I', message)
             write(message,*) '] Unit                : ', trim(units)
             call log('I', message)
             write(message,*) '] Interval [sec]      : ', history_tintsec(id)
             call log('I', message)
             write(message,*) '] Interval [step]     : ', history_tintstep(id)
             call log('I', message)
             write(message,*) '] Time Average?       : ', history_tavg(id)
             call log('I', message)
             write(message,*) '] z* -> z conversion? : ', history_zinterp(id)
             call log('I', message)
             call log('I', '')

             zinterp = history_zinterp(id)

             exit
          endif
       enddo

    endif

    return
  end subroutine historyaddvariable

  !-----------------------------------------------------------------------------
  ! interface HistoryPutAxis
  !-----------------------------------------------------------------------------
  subroutine historyputaxissp( &
       name,  & ! (in)
       desc,  & ! (in)
       units, & ! (in)
       dim,   & ! (in)
       var,   & ! (in)
       dtype, & ! (in) optional
       down   & ! (in) optional
       )
    use gtool_file_h, only: &
       file_real4, &
       file_real8
    implicit none

    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: units
    character(len=*), intent(in) :: dim
    real(SP),         intent(in) :: var(:)
    character(len=*), intent(in), optional :: dtype
    logical,          intent(in), optional :: down

    integer :: type
    !---------------------------------------------------------------------------

    if ( present(dtype) ) then
       if ( dtype == 'REAL4' ) then
          type = file_real4
       else if ( dtype == 'REAL8' ) then
          type = file_real8
       else
          write(message,*) 'xxx Not appropriate dtype. Check!', dtype
          call log('E', message)
       endif
    else
       type = file_real4
    endif

    if ( history_axis_count < history_axis_limit ) then
       history_axis_count = history_axis_count + 1
       history_axis(history_axis_count)%name  = name
       history_axis(history_axis_count)%desc  = desc
       history_axis(history_axis_count)%units = units
       history_axis(history_axis_count)%dim   = dim
       history_axis(history_axis_count)%type  = type
       allocate(history_axis(history_axis_count)%var(size(var)))
       history_axis(history_axis_count)%var = var
       if ( present(down) ) then
          history_axis(history_axis_count)%down = down
       else
          history_axis(history_axis_count)%down = .false.
       endif
    else
       write(message,*) 'xxx Number of axis exceeds the limit.'
       call log('E', message)
    endif

    return
  end subroutine historyputaxissp
  subroutine historyputaxisdp( &
       name,  & ! (in)
       desc,  & ! (in)
       units, & ! (in)
       dim,   & ! (in)
       var,   & ! (in)
       dtype, & ! (in) optional
       down   & ! (in) optional
       )
    use gtool_file_h, only: &
       file_real4, &
       file_real8
    implicit none

    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: units
    character(len=*), intent(in) :: dim
    real(DP),         intent(in) :: var(:)
    character(len=*), intent(in), optional :: dtype
    logical,          intent(in), optional :: down

    integer :: type
    !---------------------------------------------------------------------------

    if ( present(dtype) ) then
       if ( dtype == 'REAL4' ) then
          type = file_real4
       else if ( dtype == 'REAL8' ) then
          type = file_real8
       else
          write(message,*) 'xxx Not appropriate dtype. Check!', dtype
          call log('E', message)
       endif
    else
       type = file_real8
    endif

    if ( history_axis_count < history_axis_limit ) then
       history_axis_count = history_axis_count + 1
       history_axis(history_axis_count)%name  = name
       history_axis(history_axis_count)%desc  = desc
       history_axis(history_axis_count)%units = units
       history_axis(history_axis_count)%dim   = dim
       history_axis(history_axis_count)%type  = type
       allocate(history_axis(history_axis_count)%var(size(var)))
       history_axis(history_axis_count)%var = var
       if ( present(down) ) then
          history_axis(history_axis_count)%down = down
       else
          history_axis(history_axis_count)%down = .false.
       endif
    else
       write(message,*) 'xxx Number of axis exceeds the limit.'
       call log('E', message)
    endif

    return
  end subroutine historyputaxisdp

  !-----------------------------------------------------------------------------
  ! interface HistoryPutAssociatedCoordinates
  !-----------------------------------------------------------------------------
  subroutine historyput1dassociatedcoordinatessp( &
       name,  & ! (in)
       desc,  & ! (in)
       units, & ! (in)
       dims,  & ! (in)
       var,   & ! (in)
       dtype  & ! (in) optional
       )
    use gtool_file_h, only: &
       file_real4, &
       file_real8
    implicit none

    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: units
    character(len=*), intent(in) :: dims(:)
    real(SP),         intent(in) :: var(:)
    character(len=*), intent(in), optional :: dtype

    integer :: type
    !---------------------------------------------------------------------------

    if ( present(dtype) ) then
       if ( dtype == 'REAL4' ) then
          type = file_real4
       else if ( dtype == 'REAL8' ) then
          type = file_real8
       else
          write(message,*) 'xxx Not appropriate dtype. Check!', dtype
          call log('E', message)
       endif
    else
       type = file_real4
    endif

    if ( history_assoc_count < history_assoc_limit ) then
       history_assoc_count = history_assoc_count + 1
       history_assoc(history_assoc_count)%name  = name
       history_assoc(history_assoc_count)%desc  = desc
       history_assoc(history_assoc_count)%units = units
       history_assoc(history_assoc_count)%dims(1:1) = dims
       history_assoc(history_assoc_count)%ndims = 1
       history_assoc(history_assoc_count)%type  = type
       allocate(history_assoc(history_assoc_count)%var(size(var)))
       history_assoc(history_assoc_count)%var = reshape(var, (/size(var)/))
    else
       write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
       call log('E', message)
    endif

    return
  end subroutine historyput1dassociatedcoordinatessp
  subroutine historyput1dassociatedcoordinatesdp( &
       name,  & ! (in)
       desc,  & ! (in)
       units, & ! (in)
       dims,  & ! (in)
       var,   & ! (in)
       dtype  & ! (in) optional
       )
    use gtool_file_h, only: &
       file_real4, &
       file_real8
    implicit none

    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: units
    character(len=*), intent(in) :: dims(:)
    real(DP),         intent(in) :: var(:)
    character(len=*), intent(in), optional :: dtype

    integer :: type
    !---------------------------------------------------------------------------

    if ( present(dtype) ) then
       if ( dtype == 'REAL4' ) then
          type = file_real4
       else if ( dtype == 'REAL8' ) then
          type = file_real8
       else
          write(message,*) 'xxx Not appropriate dtype. Check!', dtype
          call log('E', message)
       endif
    else
       type = file_real8
    endif

    if ( history_assoc_count < history_assoc_limit ) then
       history_assoc_count = history_assoc_count + 1
       history_assoc(history_assoc_count)%name  = name
       history_assoc(history_assoc_count)%desc  = desc
       history_assoc(history_assoc_count)%units = units
       history_assoc(history_assoc_count)%dims(1:1) = dims
       history_assoc(history_assoc_count)%ndims = 1
       history_assoc(history_assoc_count)%type  = type
       allocate(history_assoc(history_assoc_count)%var(size(var)))
       history_assoc(history_assoc_count)%var = reshape(var, (/size(var)/))
    else
       write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
       call log('E', message)
    endif

    return
  end subroutine historyput1dassociatedcoordinatesdp
  subroutine historyput2dassociatedcoordinatessp( &
       name,  & ! (in)
       desc,  & ! (in)
       units, & ! (in)
       dims,  & ! (in)
       var,   & ! (in)
       dtype  & ! (in) optional
       )
    use gtool_file_h, only: &
       file_real4, &
       file_real8
    implicit none

    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: units
    character(len=*), intent(in) :: dims(:)
    real(SP),         intent(in) :: var(:,:)
    character(len=*), intent(in), optional :: dtype

    integer :: type
    !---------------------------------------------------------------------------

    if ( present(dtype) ) then
       if ( dtype == 'REAL4' ) then
          type = file_real4
       else if ( dtype == 'REAL8' ) then
          type = file_real8
       else
          write(message,*) 'xxx Not appropriate dtype. Check!', dtype
          call log('E', message)
       endif
    else
       type = file_real4
    endif

    if ( history_assoc_count < history_assoc_limit ) then
       history_assoc_count = history_assoc_count + 1
       history_assoc(history_assoc_count)%name  = name
       history_assoc(history_assoc_count)%desc  = desc
       history_assoc(history_assoc_count)%units = units
       history_assoc(history_assoc_count)%dims(1:2) = dims
       history_assoc(history_assoc_count)%ndims = 2
       history_assoc(history_assoc_count)%type  = type
       allocate(history_assoc(history_assoc_count)%var(size(var)))
       history_assoc(history_assoc_count)%var = reshape(var, (/size(var)/))
    else
       write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
       call log('E', message)
    endif

    return
  end subroutine historyput2dassociatedcoordinatessp
  subroutine historyput2dassociatedcoordinatesdp( &
       name,  & ! (in)
       desc,  & ! (in)
       units, & ! (in)
       dims,  & ! (in)
       var,   & ! (in)
       dtype  & ! (in) optional
       )
    use gtool_file_h, only: &
       file_real4, &
       file_real8
    implicit none

    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: units
    character(len=*), intent(in) :: dims(:)
    real(DP),         intent(in) :: var(:,:)
    character(len=*), intent(in), optional :: dtype

    integer :: type
    !---------------------------------------------------------------------------

    if ( present(dtype) ) then
       if ( dtype == 'REAL4' ) then
          type = file_real4
       else if ( dtype == 'REAL8' ) then
          type = file_real8
       else
          write(message,*) 'xxx Not appropriate dtype. Check!', dtype
          call log('E', message)
       endif
    else
       type = file_real8
    endif

    if ( history_assoc_count < history_assoc_limit ) then
       history_assoc_count = history_assoc_count + 1
       history_assoc(history_assoc_count)%name  = name
       history_assoc(history_assoc_count)%desc  = desc
       history_assoc(history_assoc_count)%units = units
       history_assoc(history_assoc_count)%dims(1:2) = dims
       history_assoc(history_assoc_count)%ndims = 2
       history_assoc(history_assoc_count)%type  = type
       allocate(history_assoc(history_assoc_count)%var(size(var)))
       history_assoc(history_assoc_count)%var = reshape(var, (/size(var)/))
    else
       write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
       call log('E', message)
    endif

    return
  end subroutine historyput2dassociatedcoordinatesdp
  subroutine historyput3dassociatedcoordinatessp( &
       name,  & ! (in)
       desc,  & ! (in)
       units, & ! (in)
       dims,  & ! (in)
       var,   & ! (in)
       dtype  & ! (in) optional
       )
    use gtool_file_h, only: &
       file_real4, &
       file_real8
    implicit none

    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: units
    character(len=*), intent(in) :: dims(:)
    real(SP),         intent(in) :: var(:,:,:)
    character(len=*), intent(in), optional :: dtype

    integer :: type
    !---------------------------------------------------------------------------

    if ( present(dtype) ) then
       if ( dtype == 'REAL4' ) then
          type = file_real4
       else if ( dtype == 'REAL8' ) then
          type = file_real8
       else
          write(message,*) 'xxx Not appropriate dtype. Check!', dtype
          call log('E', message)
       endif
    else
       type = file_real4
    endif

    if ( history_assoc_count < history_assoc_limit ) then
       history_assoc_count = history_assoc_count + 1
       history_assoc(history_assoc_count)%name  = name
       history_assoc(history_assoc_count)%desc  = desc
       history_assoc(history_assoc_count)%units = units
       history_assoc(history_assoc_count)%dims(1:3) = dims
       history_assoc(history_assoc_count)%ndims = 3
       history_assoc(history_assoc_count)%type  = type
       allocate(history_assoc(history_assoc_count)%var(size(var)))
       history_assoc(history_assoc_count)%var = reshape(var, (/size(var)/))
    else
       write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
       call log('E', message)
    endif

    return
  end subroutine historyput3dassociatedcoordinatessp
  subroutine historyput3dassociatedcoordinatesdp( &
       name,  & ! (in)
       desc,  & ! (in)
       units, & ! (in)
       dims,  & ! (in)
       var,   & ! (in)
       dtype  & ! (in) optional
       )
    use gtool_file_h, only: &
       file_real4, &
       file_real8
    implicit none

    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: units
    character(len=*), intent(in) :: dims(:)
    real(DP),         intent(in) :: var(:,:,:)
    character(len=*), intent(in), optional :: dtype

    integer :: type
    !---------------------------------------------------------------------------

    if ( present(dtype) ) then
       if ( dtype == 'REAL4' ) then
          type = file_real4
       else if ( dtype == 'REAL8' ) then
          type = file_real8
       else
          write(message,*) 'xxx Not appropriate dtype. Check!', dtype
          call log('E', message)
       endif
    else
       type = file_real8
    endif

    if ( history_assoc_count < history_assoc_limit ) then
       history_assoc_count = history_assoc_count + 1
       history_assoc(history_assoc_count)%name  = name
       history_assoc(history_assoc_count)%desc  = desc
       history_assoc(history_assoc_count)%units = units
       history_assoc(history_assoc_count)%dims(1:3) = dims
       history_assoc(history_assoc_count)%ndims = 3
       history_assoc(history_assoc_count)%type  = type
       allocate(history_assoc(history_assoc_count)%var(size(var)))
       history_assoc(history_assoc_count)%var = reshape(var, (/size(var)/))
    else
       write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
       call log('E', message)
    endif

    return
  end subroutine historyput3dassociatedcoordinatesdp
  subroutine historyput4dassociatedcoordinatessp( &
       name,  & ! (in)
       desc,  & ! (in)
       units, & ! (in)
       dims,  & ! (in)
       var,   & ! (in)
       dtype  & ! (in) optional
       )
    use gtool_file_h, only: &
       file_real4, &
       file_real8
    implicit none

    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: units
    character(len=*), intent(in) :: dims(:)
    real(SP),         intent(in) :: var(:,:,:,:)
    character(len=*), intent(in), optional :: dtype

    integer :: type
    !---------------------------------------------------------------------------

    if ( present(dtype) ) then
       if ( dtype == 'REAL4' ) then
          type = file_real4
       else if ( dtype == 'REAL8' ) then
          type = file_real8
       else
          write(message,*) 'xxx Not appropriate dtype. Check!', dtype
          call log('E', message)
       endif
    else
       type = file_real4
    endif

    if ( history_assoc_count < history_assoc_limit ) then
       history_assoc_count = history_assoc_count + 1
       history_assoc(history_assoc_count)%name  = name
       history_assoc(history_assoc_count)%desc  = desc
       history_assoc(history_assoc_count)%units = units
       history_assoc(history_assoc_count)%dims(1:4) = dims
       history_assoc(history_assoc_count)%ndims = 4
       history_assoc(history_assoc_count)%type  = type
       allocate(history_assoc(history_assoc_count)%var(size(var)))
       history_assoc(history_assoc_count)%var = reshape(var, (/size(var)/))
    else
       write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
       call log('E', message)
    endif

    return
  end subroutine historyput4dassociatedcoordinatessp
  subroutine historyput4dassociatedcoordinatesdp( &
       name,  & ! (in)
       desc,  & ! (in)
       units, & ! (in)
       dims,  & ! (in)
       var,   & ! (in)
       dtype  & ! (in) optional
       )
    use gtool_file_h, only: &
       file_real4, &
       file_real8
    implicit none

    character(len=*), intent(in) :: name
    character(len=*), intent(in) :: desc
    character(len=*), intent(in) :: units
    character(len=*), intent(in) :: dims(:)
    real(DP),         intent(in) :: var(:,:,:,:)
    character(len=*), intent(in), optional :: dtype

    integer :: type
    !---------------------------------------------------------------------------

    if ( present(dtype) ) then
       if ( dtype == 'REAL4' ) then
          type = file_real4
       else if ( dtype == 'REAL8' ) then
          type = file_real8
       else
          write(message,*) 'xxx Not appropriate dtype. Check!', dtype
          call log('E', message)
       endif
    else
       type = file_real8
    endif

    if ( history_assoc_count < history_assoc_limit ) then
       history_assoc_count = history_assoc_count + 1
       history_assoc(history_assoc_count)%name  = name
       history_assoc(history_assoc_count)%desc  = desc
       history_assoc(history_assoc_count)%units = units
       history_assoc(history_assoc_count)%dims(1:4) = dims
       history_assoc(history_assoc_count)%ndims = 4
       history_assoc(history_assoc_count)%type  = type
       allocate(history_assoc(history_assoc_count)%var(size(var)))
       history_assoc(history_assoc_count)%var = reshape(var, (/size(var)/))
    else
       write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
       call log('E', message)
    endif

    return
  end subroutine historyput4dassociatedcoordinatesdp

  !-----------------------------------------------------------------------------
  ! HistorySetTAttr
  subroutine historysettattr( &
       varname, &
       key,     &
       val      )
    use gtool_file, only: &
       filesettattr
    implicit none

    character(len=*), intent(in) :: varname
    character(len=*), intent(in) :: key
    character(len=*), intent(in) :: val

    integer :: n
    !---------------------------------------------------------------------------

    do n = 1, history_id_count
       call filesettattr( history_fid(n), & ! (in)
                          varname,        & ! (in)
                          key,            & ! (in)
                          val             ) ! (in)
    enddo

  end subroutine historysettattr

  !-----------------------------------------------------------------------------
  ! HistoryQuery
  subroutine historyquery( &
       itemid,    &
       step_next, &
       answer     )
    implicit none

    integer, intent(in)  :: itemid
    integer, intent(in)  :: step_next
    logical, intent(out) :: answer
    !---------------------------------------------------------------------------

    answer = .false.

    if    ( history_tavg(itemid) ) then
       answer = .true.
    elseif( step_next == history_tstrstep(itemid) + history_tintstep(itemid) ) then
       answer = .true.
    endif

    return
  end subroutine historyquery

  !-----------------------------------------------------------------------------
  ! interface HistoryPut(by NAME)
  subroutine historyput0dnamesp( &
       varname,   &
       step_next, &
       var        )
    implicit none

    character(len=*), intent(in) :: varname
    integer,          intent(in) :: step_next
    real(SP),         intent(in) :: var

    integer :: itemid, n
    !---------------------------------------------------------------------------

    ! search item id
    itemid = -1
    do n = 1, history_id_count
       if ( varname == history_item(n) ) then
          itemid = n
          exit
       endif
    enddo

    call historyput0didsp(itemid, step_next, var)

    return
  end subroutine historyput0dnamesp

  !-----------------------------------------------------------------------------
  ! interface HistoryPut(by ID)
  subroutine historyput0didsp( &
       itemid,    &
       step_next, &
       var        )
    implicit none

    integer,  intent(in) :: itemid
    integer,  intent(in) :: step_next
    real(SP), intent(in) :: var

    real(DP) :: dt
    integer :: idx
    intrinsic shape
    !---------------------------------------------------------------------------

    if ( itemid < 0 ) return

    dt  = ( step_next - history_tlststep(itemid) ) * history_dtsec

    if ( dt < eps .AND. ( .NOT. history_tavg(itemid) ) ) then
       write(message,*) 'xxx History variable was put two times before output!: ', &
                        trim(history_item(itemid)), &
                        step_next, history_tlststep(itemid)
       call log('E', message)
    endif

    if ( history_tavg(itemid) ) then
          idx = 1
          history_varsum(idx,itemid) = history_varsum(idx,itemid) + var * dt
    else
          idx = 1
          history_varsum(idx,itemid) = var
    endif

    history_size(itemid) = idx
    history_tlststep(itemid) = step_next
    history_tsumsec(itemid) = history_tsumsec(itemid) + dt

    return
  end subroutine historyput0didsp
  subroutine historyput0dnamedp( &
       varname,   &
       step_next, &
       var        )
    implicit none

    character(len=*), intent(in) :: varname
    integer,          intent(in) :: step_next
    real(DP),         intent(in) :: var

    integer :: itemid, n
    !---------------------------------------------------------------------------

    ! search item id
    itemid = -1
    do n = 1, history_id_count
       if ( varname == history_item(n) ) then
          itemid = n
          exit
       endif
    enddo

    call historyput0diddp(itemid, step_next, var)

    return
  end subroutine historyput0dnamedp

  !-----------------------------------------------------------------------------
  ! interface HistoryPut(by ID)
  subroutine historyput0diddp( &
       itemid,    &
       step_next, &
       var        )
    implicit none

    integer,  intent(in) :: itemid
    integer,  intent(in) :: step_next
    real(DP), intent(in) :: var

    real(DP) :: dt
    integer :: idx
    intrinsic shape
    !---------------------------------------------------------------------------

    if ( itemid < 0 ) return

    dt  = ( step_next - history_tlststep(itemid) ) * history_dtsec

    if ( dt < eps .AND. ( .NOT. history_tavg(itemid) ) ) then
       write(message,*) 'xxx History variable was put two times before output!: ', &
                        trim(history_item(itemid)), &
                        step_next, history_tlststep(itemid)
       call log('E', message)
    endif

    if ( history_tavg(itemid) ) then
          idx = 1
          history_varsum(idx,itemid) = history_varsum(idx,itemid) + var * dt
    else
          idx = 1
          history_varsum(idx,itemid) = var
    endif

    history_size(itemid) = idx
    history_tlststep(itemid) = step_next
    history_tsumsec(itemid) = history_tsumsec(itemid) + dt

    return
  end subroutine historyput0diddp
  subroutine historyput1dnamesp( &
       varname,   &
       step_next, &
       var        )
    implicit none

    character(len=*), intent(in) :: varname
    integer,          intent(in) :: step_next
    real(SP),         intent(in) :: var(:)

    integer :: itemid, n
    !---------------------------------------------------------------------------

    ! search item id
    itemid = -1
    do n = 1, history_id_count
       if ( varname == history_item(n) ) then
          itemid = n
          exit
       endif
    enddo

    call historyput1didsp(itemid, step_next, var)

    return
  end subroutine historyput1dnamesp

  !-----------------------------------------------------------------------------
  ! interface HistoryPut(by ID)
  subroutine historyput1didsp( &
       itemid,    &
       step_next, &
       var        )
    implicit none

    integer,  intent(in) :: itemid
    integer,  intent(in) :: step_next
    real(SP), intent(in) :: var(:)

    real(DP) :: dt
    integer :: idx
    integer  :: ijk(1)
    integer  :: i
    intrinsic shape
    !---------------------------------------------------------------------------

    if ( itemid < 0 ) return

    ijk = shape(var)
    dt  = ( step_next - history_tlststep(itemid) ) * history_dtsec

    if ( dt < eps .AND. ( .NOT. history_tavg(itemid) ) ) then
       write(message,*) 'xxx History variable was put two times before output!: ', &
                        trim(history_item(itemid)), &
                        step_next, history_tlststep(itemid)
       call log('E', message)
    endif

    if ( history_tavg(itemid) ) then
       do i = 1, ijk(1)
          idx = i
          history_varsum(idx,itemid) = history_varsum(idx,itemid) +  var(i) * dt
       enddo
    else
       do i = 1, ijk(1)
          idx = i
          history_varsum(idx,itemid) =  var(i)
       enddo
    endif

    history_size(itemid) = idx
    history_tlststep(itemid) = step_next
    history_tsumsec(itemid) = history_tsumsec(itemid) + dt

    return
  end subroutine historyput1didsp
  subroutine historyput1dnamedp( &
       varname,   &
       step_next, &
       var        )
    implicit none

    character(len=*), intent(in) :: varname
    integer,          intent(in) :: step_next
    real(DP),         intent(in) :: var(:)

    integer :: itemid, n
    !---------------------------------------------------------------------------

    ! search item id
    itemid = -1
    do n = 1, history_id_count
       if ( varname == history_item(n) ) then
          itemid = n
          exit
       endif
    enddo

    call historyput1diddp(itemid, step_next, var)

    return
  end subroutine historyput1dnamedp

  !-----------------------------------------------------------------------------
  ! interface HistoryPut(by ID)
  subroutine historyput1diddp( &
       itemid,    &
       step_next, &
       var        )
    implicit none

    integer,  intent(in) :: itemid
    integer,  intent(in) :: step_next
    real(DP), intent(in) :: var(:)

    real(DP) :: dt
    integer :: idx
    integer  :: ijk(1)
    integer  :: i
    intrinsic shape
    !---------------------------------------------------------------------------

    if ( itemid < 0 ) return

    ijk = shape(var)
    dt  = ( step_next - history_tlststep(itemid) ) * history_dtsec

    if ( dt < eps .AND. ( .NOT. history_tavg(itemid) ) ) then
       write(message,*) 'xxx History variable was put two times before output!: ', &
                        trim(history_item(itemid)), &
                        step_next, history_tlststep(itemid)
       call log('E', message)
    endif

    if ( history_tavg(itemid) ) then
       do i = 1, ijk(1)
          idx = i
          history_varsum(idx,itemid) = history_varsum(idx,itemid) +  var(i) * dt
       enddo
    else
       do i = 1, ijk(1)
          idx = i
          history_varsum(idx,itemid) =  var(i)
       enddo
    endif

    history_size(itemid) = idx
    history_tlststep(itemid) = step_next
    history_tsumsec(itemid) = history_tsumsec(itemid) + dt

    return
  end subroutine historyput1diddp
  subroutine historyput2dnamesp( &
       varname,   &
       step_next, &
       var        )
    implicit none

    character(len=*), intent(in) :: varname
    integer,          intent(in) :: step_next
    real(SP),         intent(in) :: var(:,:)

    integer :: itemid, n
    !---------------------------------------------------------------------------

    ! search item id
    itemid = -1
    do n = 1, history_id_count
       if ( varname == history_item(n) ) then
          itemid = n
          exit
       endif
    enddo

    call historyput2didsp(itemid, step_next, var)

    return
  end subroutine historyput2dnamesp

  !-----------------------------------------------------------------------------
  ! interface HistoryPut(by ID)
  subroutine historyput2didsp( &
       itemid,    &
       step_next, &
       var        )
    implicit none

    integer,  intent(in) :: itemid
    integer,  intent(in) :: step_next
    real(SP), intent(in) :: var(:,:)

    real(DP) :: dt
    integer :: idx
    integer  :: ijk(2)
    integer  :: i, j
    intrinsic shape
    !---------------------------------------------------------------------------

    if ( itemid < 0 ) return

    ijk = shape(var)
    dt  = ( step_next - history_tlststep(itemid) ) * history_dtsec

    if ( dt < eps .AND. ( .NOT. history_tavg(itemid) ) ) then
       write(message,*) 'xxx History variable was put two times before output!: ', &
                        trim(history_item(itemid)), &
                        step_next, history_tlststep(itemid)
       call log('E', message)
    endif

    if ( history_tavg(itemid) ) then
       do j = 1, ijk(2)
       do i = 1, ijk(1)
          idx = j*ijk(i)+i
          history_varsum(idx,itemid) = history_varsum(idx,itemid) +  var(i,j) * dt
       enddo
       enddo
    else
       do j = 1, ijk(2)
       do i = 1, ijk(1)
          idx = j*ijk(i)+i
          history_varsum(idx,itemid) =  var(i,j)
       enddo
       enddo
    endif

    history_size(itemid) = idx
    history_tlststep(itemid) = step_next
    history_tsumsec(itemid) = history_tsumsec(itemid) + dt

    return
  end subroutine historyput2didsp
  subroutine historyput2dnamedp( &
       varname,   &
       step_next, &
       var        )
    implicit none

    character(len=*), intent(in) :: varname
    integer,          intent(in) :: step_next
    real(DP),         intent(in) :: var(:,:)

    integer :: itemid, n
    !---------------------------------------------------------------------------

    ! search item id
    itemid = -1
    do n = 1, history_id_count
       if ( varname == history_item(n) ) then
          itemid = n
          exit
       endif
    enddo

    call historyput2diddp(itemid, step_next, var)

    return
  end subroutine historyput2dnamedp

  !-----------------------------------------------------------------------------
  ! interface HistoryPut(by ID)
  subroutine historyput2diddp( &
       itemid,    &
       step_next, &
       var        )
    implicit none

    integer,  intent(in) :: itemid
    integer,  intent(in) :: step_next
    real(DP), intent(in) :: var(:,:)

    real(DP) :: dt
    integer :: idx
    integer  :: ijk(2)
    integer  :: i, j
    intrinsic shape
    !---------------------------------------------------------------------------

    if ( itemid < 0 ) return

    ijk = shape(var)
    dt  = ( step_next - history_tlststep(itemid) ) * history_dtsec

    if ( dt < eps .AND. ( .NOT. history_tavg(itemid) ) ) then
       write(message,*) 'xxx History variable was put two times before output!: ', &
                        trim(history_item(itemid)), &
                        step_next, history_tlststep(itemid)
       call log('E', message)
    endif

    if ( history_tavg(itemid) ) then
       do j = 1, ijk(2)
       do i = 1, ijk(1)
          idx = j*ijk(i)+i
          history_varsum(idx,itemid) = history_varsum(idx,itemid) +  var(i,j) * dt
       enddo
       enddo
    else
       do j = 1, ijk(2)
       do i = 1, ijk(1)
          idx = j*ijk(i)+i
          history_varsum(idx,itemid) =  var(i,j)
       enddo
       enddo
    endif

    history_size(itemid) = idx
    history_tlststep(itemid) = step_next
    history_tsumsec(itemid) = history_tsumsec(itemid) + dt

    return
  end subroutine historyput2diddp
  subroutine historyput3dnamesp( &
       varname,   &
       step_next, &
       var        )
    implicit none

    character(len=*), intent(in) :: varname
    integer,          intent(in) :: step_next
    real(SP),         intent(in) :: var(:,:,:)

    integer :: itemid, n
    !---------------------------------------------------------------------------

    ! search item id
    itemid = -1
    do n = 1, history_id_count
       if ( varname == history_item(n) ) then
          itemid = n
          exit
       endif
    enddo

    call historyput3didsp(itemid, step_next, var)

    return
  end subroutine historyput3dnamesp

  !-----------------------------------------------------------------------------
  ! interface HistoryPut(by ID)
  subroutine historyput3didsp( &
       itemid,    &
       step_next, &
       var        )
    implicit none

    integer,  intent(in) :: itemid
    integer,  intent(in) :: step_next
    real(SP), intent(in) :: var(:,:,:)

    real(DP) :: dt
    integer :: idx
    integer  :: ijk(3)
    integer  :: i, j, k
    intrinsic shape
    !---------------------------------------------------------------------------

    if ( itemid < 0 ) return

    ijk = shape(var)
    dt  = ( step_next - history_tlststep(itemid) ) * history_dtsec

    if ( dt < eps .AND. ( .NOT. history_tavg(itemid) ) ) then
       write(message,*) 'xxx History variable was put two times before output!: ', &
                        trim(history_item(itemid)), &
                        step_next, history_tlststep(itemid)
       call log('E', message)
    endif

    if ( history_tavg(itemid) ) then
       do k = 1, ijk(3)
       do j = 1, ijk(2)
       do i = 1, ijk(1)
          idx = (k*ijk(2)+j)*ijk(1)+i
          history_varsum(idx,itemid) = history_varsum(idx,itemid) +  var(i,j,k) * dt
       enddo
       enddo
       enddo
    else
       do k = 1, ijk(3)
       do j = 1, ijk(2)
       do i = 1, ijk(1)
          idx = (k*ijk(2)+j)*ijk(1)+i
          history_varsum(idx,itemid) =  var(i,j,k)
       enddo
       enddo
       enddo
    endif

    history_size(itemid) = idx
    history_tlststep(itemid) = step_next
    history_tsumsec(itemid) = history_tsumsec(itemid) + dt

    return
  end subroutine historyput3didsp
  subroutine historyput3dnamedp( &
       varname,   &
       step_next, &
       var        )
    implicit none

    character(len=*), intent(in) :: varname
    integer,          intent(in) :: step_next
    real(DP),         intent(in) :: var(:,:,:)

    integer :: itemid, n
    !---------------------------------------------------------------------------

    ! search item id
    itemid = -1
    do n = 1, history_id_count
       if ( varname == history_item(n) ) then
          itemid = n
          exit
       endif
    enddo

    call historyput3diddp(itemid, step_next, var)

    return
  end subroutine historyput3dnamedp

  !-----------------------------------------------------------------------------
  ! interface HistoryPut(by ID)
  subroutine historyput3diddp( &
       itemid,    &
       step_next, &
       var        )
    implicit none

    integer,  intent(in) :: itemid
    integer,  intent(in) :: step_next
    real(DP), intent(in) :: var(:,:,:)

    real(DP) :: dt
    integer :: idx
    integer  :: ijk(3)
    integer  :: i, j, k
    intrinsic shape
    !---------------------------------------------------------------------------

    if ( itemid < 0 ) return

    ijk = shape(var)
    dt  = ( step_next - history_tlststep(itemid) ) * history_dtsec

    if ( dt < eps .AND. ( .NOT. history_tavg(itemid) ) ) then
       write(message,*) 'xxx History variable was put two times before output!: ', &
                        trim(history_item(itemid)), &
                        step_next, history_tlststep(itemid)
       call log('E', message)
    endif

    if ( history_tavg(itemid) ) then
       do k = 1, ijk(3)
       do j = 1, ijk(2)
       do i = 1, ijk(1)
          idx = (k*ijk(2)+j)*ijk(1)+i
          history_varsum(idx,itemid) = history_varsum(idx,itemid) +  var(i,j,k) * dt
       enddo
       enddo
       enddo
    else
       do k = 1, ijk(3)
       do j = 1, ijk(2)
       do i = 1, ijk(1)
          idx = (k*ijk(2)+j)*ijk(1)+i
          history_varsum(idx,itemid) =  var(i,j,k)
       enddo
       enddo
       enddo
    endif

    history_size(itemid) = idx
    history_tlststep(itemid) = step_next
    history_tsumsec(itemid) = history_tsumsec(itemid) + dt

    return
  end subroutine historyput3diddp

  !-----------------------------------------------------------------------------
  ! HistoryWrite
  subroutine historywrite( &
       itemid,  &
       step_now )
    use dc_calendar, only: &
       calendarsec2ymdhms
    use gtool_file, only: &
       filewrite
    implicit none

    integer, intent(in) :: itemid
    integer, intent(in) :: step_now

    integer  :: isize
    real(DP) :: time_str, time_end
    real(DP) :: sec_str,  sec_end

    real(DP), save :: sec_end_last = -1.0_dp
    logical,  save :: firsttime    = .true.
    !---------------------------------------------------------------------------

    if( history_id_count == 0 ) return

    if ( step_now < history_tstrstep(itemid) + history_tintstep(itemid) ) then
       return
    endif

    if ( history_tlststep(itemid) == history_tstrstep(itemid) ) then
       write(message,*) 'xxx History variable was never put after the last output!: ', &
                        trim(history_item(itemid))
       if ( history_error_putmiss ) then
          call log('E', message)
       else
          call log('I', message)
       endif
    endif

    isize = history_size(itemid)

    if ( history_tavg(itemid) ) then
       history_varsum(1:isize,itemid) = history_varsum(1:isize,itemid) / history_tsumsec(itemid)
    endif

    if ( firsttime ) then
       firsttime = .false.
       call historyoutputlist
    endif

    sec_str = history_startdaysec + real(History_tstrstep(itemid)-1,kind=DP) * HISTORY_DTSEC
    sec_end = history_startdaysec + real(step_now-1                ,kind=DP) * HISTORY_DTSEC

    ! convert time units
    call calendarsec2ymdhms( time_str, sec_str, history_time_units )
    call calendarsec2ymdhms( time_end, sec_end, history_time_units )

    if ( sec_end .ge.  history_tstart(itemid) ) then
       if ( sec_end_last < sec_end ) then
          write(message,'(A)') '*** Output History'
          call log('I', message)
       endif

       call filewrite( history_fid(itemid),         & ! file id
                       history_vid(itemid),         & ! variable id
                       history_varsum(1:isize,itemid), & ! data
                       time_str,                       & ! start time
                       time_end                        ) ! end   time
    else
       if ( sec_end_last < sec_end ) then
          write(message,'(A,2F15.3)') '*** Output History: Suppressed ', sec_end, history_tstart(itemid)
          call log('I', message)
       endif
    endif

    history_varsum(:,itemid) = 0.0_dp
    history_tstrstep(itemid) = step_now
    history_tlststep(itemid) = step_now
    history_tsumsec(itemid) = 0.0_dp

    sec_end_last = sec_end

    return
  end subroutine historywrite

  !-----------------------------------------------------------------------------
  ! HistoryWritaAll
  subroutine historywriteall( &
       step_now )
    implicit none

    integer, intent(in) :: step_now

    integer :: n
    !---------------------------------------------------------------------------

    do n = 1, history_id_count
       call historywrite( n, step_now )
    enddo

    return
  end subroutine historywriteall

  !-----------------------------------------------------------------------------
  ! interface HistoryGet
  subroutine historyget1ddp( &
       var,           &
       basename,      &
       varname,       &
       step,          &
       allow_missing, &
       single         )
    use gtool_file, only: &
       fileread
    implicit none

    real(DP),         intent(out) :: var(:)
    character(len=*), intent(in)  :: basename
    character(len=*), intent(in)  :: varname
    integer,          intent(in)  :: step
    logical,          intent(in), optional :: allow_missing
    logical,          intent(in), optional :: single
    !---------------------------------------------------------------------------

    call fileread( var,            & ! [OUT]
                   basename,       & ! [IN]
                   varname,        & ! [IN]
                   step,           & ! [IN]
                   history_myrank, & ! [IN]
                   allow_missing,  & ! [IN]
                   single          ) ! [IN]

    return
  end subroutine historyget1ddp
  subroutine historyget1dsp( &
       var,           &
       basename,      &
       varname,       &
       step,          &
       allow_missing, &
       single         )
    use gtool_file, only: &
       fileread
    implicit none

    real(SP),         intent(out) :: var(:)
    character(len=*), intent(in)  :: basename
    character(len=*), intent(in)  :: varname
    integer,          intent(in)  :: step
    logical,          intent(in), optional :: allow_missing
    logical,          intent(in), optional :: single
    !---------------------------------------------------------------------------

    call fileread( var,            & ! [OUT]
                   basename,       & ! [IN]
                   varname,        & ! [IN]
                   step,           & ! [IN]
                   history_myrank, & ! [IN]
                   allow_missing,  & ! [IN]
                   single          ) ! [IN]

    return
  end subroutine historyget1dsp
  subroutine historyget2ddp( &
       var,           &
       basename,      &
       varname,       &
       step,          &
       allow_missing, &
       single         )
    use gtool_file, only: &
       fileread
    implicit none

    real(DP),         intent(out) :: var(:,:)
    character(len=*), intent(in)  :: basename
    character(len=*), intent(in)  :: varname
    integer,          intent(in)  :: step
    logical,          intent(in), optional :: allow_missing
    logical,          intent(in), optional :: single
    !---------------------------------------------------------------------------

    call fileread( var,            & ! [OUT]
                   basename,       & ! [IN]
                   varname,        & ! [IN]
                   step,           & ! [IN]
                   history_myrank, & ! [IN]
                   allow_missing,  & ! [IN]
                   single          ) ! [IN]

    return
  end subroutine historyget2ddp
  subroutine historyget2dsp( &
       var,           &
       basename,      &
       varname,       &
       step,          &
       allow_missing, &
       single         )
    use gtool_file, only: &
       fileread
    implicit none

    real(SP),         intent(out) :: var(:,:)
    character(len=*), intent(in)  :: basename
    character(len=*), intent(in)  :: varname
    integer,          intent(in)  :: step
    logical,          intent(in), optional :: allow_missing
    logical,          intent(in), optional :: single
    !---------------------------------------------------------------------------

    call fileread( var,            & ! [OUT]
                   basename,       & ! [IN]
                   varname,        & ! [IN]
                   step,           & ! [IN]
                   history_myrank, & ! [IN]
                   allow_missing,  & ! [IN]
                   single          ) ! [IN]

    return
  end subroutine historyget2dsp
  subroutine historyget3ddp( &
       var,           &
       basename,      &
       varname,       &
       step,          &
       allow_missing, &
       single         )
    use gtool_file, only: &
       fileread
    implicit none

    real(DP),         intent(out) :: var(:,:,:)
    character(len=*), intent(in)  :: basename
    character(len=*), intent(in)  :: varname
    integer,          intent(in)  :: step
    logical,          intent(in), optional :: allow_missing
    logical,          intent(in), optional :: single
    !---------------------------------------------------------------------------

    call fileread( var,            & ! [OUT]
                   basename,       & ! [IN]
                   varname,        & ! [IN]
                   step,           & ! [IN]
                   history_myrank, & ! [IN]
                   allow_missing,  & ! [IN]
                   single          ) ! [IN]

    return
  end subroutine historyget3ddp
  subroutine historyget3dsp( &
       var,           &
       basename,      &
       varname,       &
       step,          &
       allow_missing, &
       single         )
    use gtool_file, only: &
       fileread
    implicit none

    real(SP),         intent(out) :: var(:,:,:)
    character(len=*), intent(in)  :: basename
    character(len=*), intent(in)  :: varname
    integer,          intent(in)  :: step
    logical,          intent(in), optional :: allow_missing
    logical,          intent(in), optional :: single
    !---------------------------------------------------------------------------

    call fileread( var,            & ! [OUT]
                   basename,       & ! [IN]
                   varname,        & ! [IN]
                   step,           & ! [IN]
                   history_myrank, & ! [IN]
                   allow_missing,  & ! [IN]
                   single          ) ! [IN]

    return
  end subroutine historyget3dsp

  !-----------------------------------------------------------------------------
  subroutine historyoutputlist
    implicit none

    integer :: n
    !---------------------------------------------------------------------------

    call log('I', '')
    write(message,*) '*** [HIST] Output item list '
    call log('I', message)
    write(message,*) '*** Number of history item :', history_req_nmax
    call log('I', message)
    write(message,*) 'NAME            :size    :interval[sec]:  [step]:timeavg?:zinterp?'
    call log('I', message)
    write(message,*) '============================================================================'
    call log('I', message)

    do n = 1, history_id_count
       write(message,'(1x,A,1x,I8,1x,f13.3,1x,I8,1x,L8,1x,L8)') &
                     history_item(n), history_size(n), history_tintsec(n), history_tintstep(n), history_tavg(n), history_zinterp(n)
       call log('I', message)
    enddo

    write(message,*) '============================================================================'
    call log('I', message)
    call log('I', '')

    return
  end subroutine historyoutputlist

  !-----------------------------------------------------------------------------
  subroutine historyfinalize
    use gtool_file, only: &
       fileclose
    implicit none

    integer :: n
    !---------------------------------------------------------------------------

    do n = 1, history_id_count
       call fileclose( history_fid(n) )
    enddo

    return
  end subroutine historyfinalize

end module gtool_history
!-------------------------------------------------------------------------------



!--
! vi:set readonly sw=4 ts=8
!
!Local Variables:
!mode: f90
!buffer-read-only:t
!End:
!
!++