subroutine HistoryAutoCopyCreate( name, longname, units, file )
    !
    ! use the result of the latest call of HistoryAutoCreate
    !
    ! 直前の HistoryAutoCreate を使って, 格子及び出力の空間・時間
    ! サンプリングが同じ出力を定義する. file を省略すれば
    ! 同じファイルを使う.
    !
    character(len=*), intent(in)          :: name
    character(len=*), intent(in)          :: longname
    character(len=*), intent(in)          :: units
    character(len=*), intent(in),optional :: file
    !
    type(HIST_EACHVAR)              :: hist
    type(HIST_EACHVAR),pointer      :: histpt
    character(len = *), parameter:: subname = 'HistoryAutoCopyCreate'
    !
    call BeginSub(subname)
    histpt => histpl_last(HISTPOOL)
    hist = histpt         ! copy the contents
    if(present_and_not_empty(file)) then
      hist%file = file
      allocate(hist%h)       ! always new allocation
      nullify(hist%h%hs)
    else
      hist%h => histpt%h
    endif
    hist%name = name
    hist%longname = longname
    hist%units = units
    call histpl_push(HISTPOOL, hist)
    call EndSub(subname)
  end subroutine HistoryAutoCopyCreate

  subroutine HistoryAutoCreateH1( 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, domain_div, subdomfst )
    !
    ! ヒストリファイル初期化情報の設定. 実際のファイル初期化は
    ! 必要に応じて HistoryAutoPut が行う (時分割するときは適宜
    ! クローズと初期化を繰り返さないとならないので, そういう
    ! 構造になる). なお, 一つのファイルへの出力に対して
    ! このサブルーチンを 2 回以上呼んではならない. 複数の
    ! 変数を一つのファイルに出したい場合は, HistoryAutoCopyCreate
    ! を利用せよ.
    ! 時・空間に自由にサンプリングを設定できる.
    ! 但し, いずれも等間隔. 長い時間積分によって, ファイルが
    ! 大きくなり過ぎることに対応するため, 一定の時間間隔で
    ! 分割することが可能. また, 並列化を念頭に各ノードを特定する
    ! 文字列を挿入することができる.
    !
    use dc_error, only: USR_ERRNO, StoreError
    implicit none
    character(len=*), intent(in)     :: name
    character(len=*), intent(in)     :: longname
    character(len=*), intent(in)     :: units
    character(len=*), intent(in)     :: file
    integer, intent(in)              :: slfst(*)     ! size == sprank
                              ! 空間データのスライス (開始点の指定. 
                              ! 指定はデータの値ではなく, 格子点添字)
    integer, intent(in)              :: sllst(*)     ! size == sprank
                              ! 空間データのスライス (終了点の指定. 
                              ! 指定はデータの値ではなく, 格子点添字). 
                              ! 0 を指定する場合には, データの最後尾を
                              ! 終了点とする. 
    integer, intent(in)              :: slstp(*)     ! size == sprank
                              ! 空間データのスライス (刻み幅の指定. 
                              ! 指定はデータの値ではなく, 格子点添字). 
    real,             intent(in)     :: time_to_start
                              ! 出力開始時刻
    real,             intent(in)     :: put_interval
                              ! データ出力間隔
    real,             intent(in)     :: dt
                              ! モデルのΔt (時刻を自動で進めるためではなく, 
                              ! 時刻の許容誤差を測るためのもの). 
    real, intent(in)                 :: newfile_interval
                              ! ファイルを分割する時間間隔. 
                              ! 負の値を与えると分割を行わない. 
    type(GT4_ATTRIBUTE),intent(in),optional  :: attrs(:)
    integer, intent(in)              :: aryshape(:) ! size <= 3 (--> sprank)
                              ! 次元サイズの指定
    character(len=*), intent(in)     :: dims(*)           !size == sprank+1
    character(len=*), intent(in)     :: axlongnames(*)    !size == sprank+1
    character(len=*), intent(in)     :: axunits(*)        !size == sprank+1
    character(len=*), intent(in)     :: axxtypes(*)
    type(GT4_REAL1D), intent(in)         :: spcoordvars(*)    ! size == sprank
    type(GT4_NAMED_REALARY),intent(in),optional  :: ancilcrdvars(:)
    character(len=*), intent(in),optional  :: proc
    character(len=*), intent(in),optional  :: title, source, institution
    character(len=*), intent(in),optional  :: conventions, gt_version
    logical, intent(in),optional :: domain_div
    integer, intent(in),optional :: subdomfst(*) ! For domain-dividing comp.
    ! first indx relative in the whole dom. (size == sprank)
    !
    type(HIST_EACHVAR)            :: hist
    integer                       :: sprank,i,slf
    character(len = *),parameter  :: subname = "HistoryAutoCreate1"
    
    call BeginSub(subname)
    
    !< initialize hist except hist%h -- actual creation is deferred >
    
    hist%time_last = -1e35 ! time_last_inival
    allocate(hist%h)       ! always new allocation
    nullify(hist%h%hs)
    
    hist%name = name
    hist%longname = longname
    hist%units = units
    
    sprank = min( size(aryshape), 3 )
    hist%sprank = sprank
    
    
    if ( present_and_true(domain_div) ) then
      hist%domain_div = .true.
      if (.not. present(subdomfst)) call StoreError(USR_ERRNO, subname, cause_c='When domain_div is present and true, subdomfst '// 'must also be present.')
    else
      hist%domain_div = .false.
    end if
    
    if (hist%domain_div .and. (minval(slfst(1:sprank)).le.0 .or. minval(sllst(1:sprank)).lt.0) ) then
      call StoreError(USR_ERRNO, subname, cause_c='When the domain is divided, output-domain '// 'limiting from the end by using negative indices is not '// 'available, since the whole domain size is not known. '// 'Use a postive number (or zero for sllst to express the'// ' last grid point).')
    endif
    
    hist%size = 1
    hist%out_of_domain = .false.   ! Init. May be true in domain division.
    
    do i=1,sprank
      hist%aryshape(i) = aryshape(i)
      if(slstp(i) > 0) then
        hist%slstp(i) = slstp(i)
      else
        hist%slstp(i) = 1
      endif
      if (.not.hist%domain_div) then
        if(slfst(i) > 0) then
          hist%slfst(i) = slfst(i)
        else
          hist%slfst(i) = slfst(i) + aryshape(i)
        endif
        if(sllst(i) > 0) then
          hist%sllst(i) = sllst(i)
        else
          hist%sllst(i) = sllst(i) + aryshape(i)
        endif
      else
        slf = slfst(i) - subdomfst(i) + 1
        if (slf.le.0) then
          slf = modulo(slf-1,hist%slstp(i)) + 1
        else if(slf.gt.aryshape(i)) then
          hist%out_of_domain = .true.
        endif
        hist%slfst(i) = slf
        if (sllst(i).eq.0) then
          hist%sllst(i) = aryshape(i)
        else
          hist%sllst(i) = min( sllst(i) - subdomfst(i) + 1, aryshape(i) )
          if (hist%sllst(i).le.0) then
            hist%out_of_domain = .true.
          endif
        endif
      endif
      hist%dimsizes(i) = (hist%sllst(i)-hist%slfst(i))/hist%slstp(i) + 1
      if (.not.hist%domain_div) then
        if (hist%slfst(i)<=0 .or. hist%slfst(i)>aryshape(i)) call StoreError(USR_ERRNO, subname, cause_c= 'str not within the index range for dim:',cause_i=i)
        if (hist%sllst(i)<=0 .or. hist%sllst(i)>aryshape(i)) call StoreError(USR_ERRNO, subname, cause_c= 'end not within the index range for dim:',cause_i=i)
        if (hist%slstp(i)<=0) call StoreError(USR_ERRNO, subname, cause_c='step not positive for dim:', cause_i=i)
        if (hist%dimsizes(i)<=0) call StoreError(USR_ERRNO, subname, cause_c='negative dimsize for dim:', cause_i=i)
      endif
      hist%size = hist%size * hist%dimsizes(i)
    enddo
    hist%dimsizes(sprank+1) = 0   ! unlimited dimension
    
    hist%file = file
    hist%newfile_interval = newfile_interval
    hist%dims(1:sprank+1) = dims(1:sprank+1)
    hist%axlongnames(1:sprank+1) = axlongnames(1:sprank+1)
    hist%axunits(1:sprank+1) = axunits(1:sprank+1)
    hist%time_to_start = time_to_start
    hist%put_interval = put_interval
    hist%dt = dt
    hist%axxtypes(1:sprank+1) = axxtypes(1:sprank+1)
    if(present(title)) then
      hist%title = title
    else
      hist%title = com_title
    endif
    if(present(source)) then
      hist%source = source
    else
      hist%source = com_source
    endif
    if(present(institution)) then
      hist%institution = institution
    else
      hist%institution = com_institution
    endif
    if(present(conventions)) then
      hist%conventions = conventions
    else
      hist%conventions = com_conventions
    endif
    if(present(gt_version)) then
      hist%gt_version = gt_version
    else
      hist%gt_version = com_gt_version
    endif
    if(present(proc)) then
      hist%proc = proc
    else
      hist%proc = com_proc
    endif
    
    hist%spcoordvars(1:sprank) = spcoordvars(1:sprank)
    if(.not. present(ancilcrdvars)) then
      nullify(hist%ancilcrdvars)
    else if ( size(ancilcrdvars)==0 )then
      nullify(hist%ancilcrdvars)
    else
      allocate(hist%ancilcrdvars(size(ancilcrdvars))) ! always new alloc
      hist%ancilcrdvars = ancilcrdvars
    endif
    
    if(.not. present(attrs)) then
      nullify(hist%attrs)
    else if ( size(attrs)==0 )then
      nullify(hist%attrs)
    else
      allocate(hist%attrs(size(attrs))) ! always new alloc
      hist%attrs = attrs
    endif
    
    call histpl_push(HISTPOOL, hist)
    
    call EndSub(subname)
  end subroutine HistoryAutoCreateH1

  subroutine HistoryAutoCreateH2( 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 )
    use dc_error, only: USR_ERRNO, USR_ERRNO, StoreError
    implicit none
    character(len=*), intent(in)     :: name
    character(len=*), intent(in)     :: longname
    character(len=*), intent(in)     :: units
    character(len=*), intent(in)     :: file
    integer, intent(in)              :: slfst(*)     ! size == sprank
    integer, intent(in)              :: sllst(*)     ! size == sprank
    integer, intent(in)              :: slstp(*)     ! size == sprank
    real,             intent(in)     :: time_to_start, put_interval, dt
    real, intent(in)                 :: newfile_interval
    type(GT4_ATTRIBUTE),intent(in),optional  :: attrs(:)
    character(len=*), intent(in)     :: grid_label  ! <-- HistoryAutoSetGrid
    character(len=*), intent(in),optional  :: proc
    character(len=*), intent(in),optional  :: title, source, institution
    character(len=*), intent(in),optional  :: conventions, gt_version
    !
    type(HIST_EACHVAR),pointer    :: hist
    integer                       :: ith
    character(len = *),parameter  :: subname = "HistoryAutoCreate2"
    
    call BeginSub(subname)
    ith = 1
    if (.not.histpl_find(HISTGRIDPOOL, grid_label, ith, hist)) then
      call StoreError(USR_ERRNO, subname, cause_c='grid '//trim(subname)//' not found')
    endif
    
    call HistoryAutoCreate1( name, longname, units, file, slfst, sllst, slstp, time_to_start, put_interval, dt, newfile_interval, attrs, hist%aryshape(1:hist%sprank), hist%dims(1:hist%sprank+1), hist%axlongnames(1:hist%sprank+1), hist%axunits(1:hist%sprank+1), hist%axxtypes(1:hist%sprank+1), hist%spcoordvars, hist%ancilcrdvars, title, source, institution, conventions, gt_version, proc, hist%domain_div, hist%subdomfst )
    
    call EndSub(subname)
  end subroutine HistoryAutoCreateH2

  subroutine HistoryAutoPutH0(name, vals, time)
    !
    ! 変数の出力を行う. タイミングは内部で制御するので, 全タイム
    ! ステップで呼べば良い. なお, 下記の HistoryAutoWhetherPutNow
    ! を使って呼ぶタイミングを制御しても良い.
    !
    implicit none
    character(len=*), intent(in)     :: name
    real                             :: vals(*)
    real                             :: time
    !
    type(HIST_EACHVAR),pointer      :: hst
    integer                         :: ith, j, rank
    character(len=STRING)           :: file_actual
    real                            :: eps=3e-7, newest
    type(GT_HISTORY),pointer        :: hist
    logical                         :: put_now
    integer                         :: arysize
    real,pointer                    :: subset(:)
    character(len = *), parameter:: subname = 'HistoryAutoPut'
    !
    call BeginSub(subname, 'name=<%c>, time=<%r>', c1=trim(name), r=(/time/))
    ith = 1
    do while( histpl_find(HISTPOOL, name, ith, hst) )
      put_now = whether_to_put_now( time, hst%time_last, hst%time_to_start, hst%put_interval, hst%dt )
      if ( put_now .and. .not.hst%out_of_domain ) then
        if ( associated(hst%h%hs) ) then
          call HistoryInquire(hst%h%hs, newest=newest)
          if ( hst%newfile_interval > 0 .and. time >= hst%time_to_start+hst%newfile_interval*(1.0-eps) .and. newest < time) then
            ! to make a new file
            hst%time_to_start = hst%time_to_start + hst%newfile_interval
            call HistoryClose(hst%h%hs)
            nullify(hst%h%hs)
          endif
        endif
        if (.not.associated(hst%h%hs)) then
          if (hst%newfile_interval > 0) then
            file_actual = merge_file_proc_time(hst%file,hst%proc, hst%time_to_start)
          else
            file_actual = merge_file_proc_time(hst%file,hst%proc)
          endif
          rank = hst%sprank + 1
          allocate(hist)   ! always new allocataion
          call HistoryCreate( file_actual, trim(hst%title), trim(hst%source), trim(hst%institution), hst%dims(1:rank), hst%dimsizes(1:rank), hst%axlongnames(1:rank), hst%axunits(1:rank), hst%time_to_start, hst%put_interval, hst%axxtypes(1:rank), hist, trim(hst%conventions),  trim(hst%gt_version))
          hst%h%hs => hist
          call HistoryAddVariable(name, hst%dims(1:rank), trim(hst%longname), trim(hst%units), history=hst%h%hs)
          if (associated(hst%attrs)) then
            do j=1,size(hst%attrs)
              call add_gt4_attribute(hst, hst%attrs(j))
            enddo
          endif
          if (associated(hst%ancilcrdvars)) then
            do j=1,size(hst%ancilcrdvars)
              call add_ancilcrdvar(hst, hst%ancilcrdvars(j))
            enddo
          endif
          do j=1,hst%sprank
            subset => make_slice(hst%spcoordvars(j)%ary, 1, (/hst%aryshape(j)/), (/hst%slfst(j)/), (/hst%sllst(j)/), (/hst%slstp(j)/) )
            if (associated(subset)) then
              call HistoryPut(hst%dims(j), subset, hst%h%hs)
            else
              call HistoryPut(hst%dims(j), hst%spcoordvars(j)%ary, hst%h%hs)
            endif
          enddo
          if (associated(hst%ancilcrdvars)) then
            do j=1,size(hst%ancilcrdvars)
              call put_ancilcrdvar(hst, hst%ancilcrdvars(j))
            enddo
          endif
          
          call HistorySetTime(time, hst%h%hs)
        else
          rank = hst%sprank + 1
          if ( .not. HistoryHasVariable(hst%h%hs, name) ) then
            call HistoryAddVariable(name, hst%dims(1:rank), trim(hst%longname), trim(hst%units), history=hst%h%hs)
            !" ここで HistorySetTime すると問題が起きるので前回に従う
            if (associated(hst%attrs)) then
              do j=1,size(hst%attrs)
                call add_gt4_attribute(hst, hst%attrs(j))
              enddo
            endif
          else
            call HistorySetTime(time, hst%h%hs)
          endif
        endif
        
        arysize = product(hst%aryshape(1:hst%sprank))
        subset => make_slice(vals(1:arysize), hst%sprank, (/hst%aryshape/), (/hst%slfst/), (/hst%sllst/), (/hst%slstp/))
        if (associated(subset)) then
          call HistoryPut(name, subset, hst%h%hs)
        else
          call HistoryPut(name, vals(1:hst%size), hst%h%hs)
        endif
        hst%time_last = time
        
      endif
    enddo
    call EndSub(subname)
  end subroutine HistoryAutoPutH0

  subroutine HistoryAutoSetGrid( grid_label, aryshape, dims, axlongnames, axunits, axxtypes, coord1, coord2, coord3, ancilcrdvars, subdomfst )
    use dc_error, only: USR_ERRNO, StoreError
    implicit none
    character(len=*), intent(in)     :: grid_label
    integer, intent(in)              :: aryshape(:) ! size <= 3 (--> sprank)
    character(len=*), intent(in)     :: dims(:)           !size == sprank+1
    character(len=*), intent(in)     :: axlongnames(:)    !size == sprank+1
    character(len=*), intent(in)     :: axunits(:)        !size == sprank+1
    character(len=*), intent(in)     :: axxtypes(:)
    real, intent(in),optional        :: coord1(:) ! must present if sprank>=1
    real, intent(in),optional        :: coord2(:) ! must present if sprank>=2
    real, intent(in),optional        :: coord3(:) ! must present if sprank>=3
    type(GT4_NAMED_REALARY),intent(in),optional  :: ancilcrdvars(:)
    integer, intent(in),optional :: subdomfst(:) ! For domain-dividing comp.
    ! first indx relative in the whole dom. (size == sprank)
    !
    type(HIST_EACHVAR)            :: hist
    integer                       :: sprank
    character(len = *),parameter  :: subname = "HistoryAutoSetGrid"
    continue
    call BeginSub(subname)
    
    sprank = min( size(aryshape), 3 )
    
    hist%sprank = sprank
    hist%name = grid_label
    hist%aryshape(1:sprank) = aryshape(1:sprank)
    hist%dims(1:sprank+1) = dims(1:sprank+1)
    hist%axlongnames(1:sprank+1) = axlongnames(1:sprank+1)
    hist%axunits(1:sprank+1) = axunits(1:sprank+1)
    hist%axxtypes(1:sprank+1) = axxtypes(1:sprank+1)
    if (present(subdomfst)) then
      hist%domain_div = .true.
      hist%subdomfst(1:sprank) = subdomfst(1:sprank)
    else
      hist%domain_div = .false.
    endif
    
    if (sprank >= 1) hist%spcoordvars(1) = init_gt4_real1d( coord1 )
    if (sprank >= 2) hist%spcoordvars(2) = init_gt4_real1d( coord2 )
    if (sprank >= 3) hist%spcoordvars(3) = init_gt4_real1d( coord3 )
    
    if(.not. present(ancilcrdvars)) then
      nullify(hist%ancilcrdvars)
    else if ( size(ancilcrdvars)==0 )then
      nullify(hist%ancilcrdvars)
    else
      allocate(hist%ancilcrdvars(size(ancilcrdvars))) ! always new alloc
      hist%ancilcrdvars = ancilcrdvars
    endif
    
    call histpl_push(HISTGRIDPOOL, hist)
    call EndSub(subname)
  end subroutine HistoryAutoSetGrid

  subroutine HistoryAutoSetRunInfo( title, source, institution, proc, conventions, gt_version  )
    use dc_error, only: USR_ERRNO, StoreError
    implicit none
    character(len=*), intent(in), optional     :: title, source, institution
    character(len=*), intent(in), optional     :: proc
    character(len=*), intent(in), optional     :: conventions, gt_version
    !
    character(len = *),parameter  :: subname = "HistoryAutoSetRunInfo"
    continue
    call BeginSub(subname)
    
    if (present(title)) com_title = title
    if (present(source)) com_source = source
    if (present(institution)) com_institution = institution
    if (present(proc)) com_proc = proc
    if (present(conventions)) com_conventions = conventions
    if (present(gt_version)) com_gt_version = gt_version
    
    call EndSub(subname)
  end subroutine HistoryAutoSetRunInfo

  function HistoryAutoWhetherPutNow( name, time ) result(result)
    !
    ! name の名を持つ出力項目に関し, 現在がファイルに出力するタイミ
    ! ングかどうかを返す. 同名で複数の出力をする場合, どれか一つでも
    ! 出力するタイミングなら .true. を返す. 出力のために特別に計算を
    ! を要するようなケースに使うと良い. (ほとんどのステップで無駄に
    ! なる計算をするのを避けられる)
    !
    implicit none
    logical                         :: result
    character(len=*), intent(in)    :: name
    real, intent(in)                :: time
    !
    integer                      :: ith
    type(HIST_EACHVAR),pointer   :: hst
    character(len = *), parameter:: subname = 'HistoryAutoWhetherPutNow'
    logical                      :: put_now
    !
    call BeginSub(subname)
    result = .false.
    ith = 1
    do while( histpl_find(HISTPOOL, name, ith, hst) )
      put_now = whether_to_put_now( time, hst%time_last, hst%time_to_start, hst%put_interval, hst%dt )
      if (put_now) then
        result = .true.
        exit
      endif
    enddo
    call EndSub(subname)
  end function HistoryAutoWhetherPutNow

  function init_gt4_attribute(name,rval,ival,cval) result(result)
    !
    ! ATTRIBUTEのコンストラクター. 
    ! 名前 & (実数配列 or 整数配列 or 文字列) を与える
    !
    implicit none
    type(GT4_ATTRIBUTE)                       :: result
    character(len=*),intent(in)           :: name
    real,intent(in),optional              :: rval(:)
    integer,intent(in),optional           :: ival(:)
    character(len=*),intent(in),optional  :: cval
    result%name = name
    if(present(rval)) then
      allocate(result%rval(size(rval)))
      result%rval = rval
      nullify(result%ival)
    else if (present(ival)) then
      allocate(result%ival(size(ival)))
      result%ival = ival
      nullify(result%rval)
    else if (present(cval)) then
      nullify(result%rval)
      nullify(result%ival)
      result%cval = cval
    endif
  end function init_gt4_attribute

  function init_gt4_named_realary(name,rank,dims,length,ary,longname,units) result(result)
    ! GT4_NAMED_REALARYのコンストラクター. 
    use dc_error, only: USR_ERRNO, StoreError
    implicit none
    type(GT4_NAMED_REALARY)            :: result
    !
    character(len=*),intent(in)    :: name
    integer,intent(in)             :: rank
    character(len = *),intent(in)  :: dims(rank)
    integer,intent(in)             :: length
    real,intent(in)                :: ary(length)
    character(len=*),intent(in)    :: longname
    character(len=*),intent(in)    :: units
    !
    character(len = *), parameter:: subname = 'init_gt4_named_realary'
    !
    call BeginSub(subname)
    if(rank>3 .or. rank<0) call StoreError(USR_ERRNO, subname, cause_c='rank must be <= 3 and >=1')
    result%rank = rank
    result%name = name
    result%dims(1:rank) = dims(1:rank)
    allocate(result%ary(length))     ! always new allocation
    result%ary(1:length) = ary(1:length)
    result%longname = longname
    result%units = units
    call EndSub(subname)
  end function init_gt4_named_realary

  function init_gt4_real1d(ary) result(result)
    !
    ! REAL1Dのコンストラクター. 
    !
    implicit none
    type(GT4_REAL1D)      :: result
    real,intent(in)   :: ary(:)
    if(associated(result%ary)) deallocate(result%ary)
    allocate(result%ary(size(ary)))
    result%ary = ary
  end function init_gt4_real1d