subroutine HistoryAutoCreate1( name, longname, units, file, aryshape, dims, axlongnames, axunits, axxtypes, domain_div, subdomfst )
      use dc_error, only: USR_EINT, 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(:)
      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_EINT, 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_EINT, 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_EINT, 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_EINT, subname, cause_c= 'end not within the index range for dim:',cause_i=i)
            if (hist%slstp(i)<=0) call StoreError(USR_EINT, subname, cause_c='step not positive for dim:', cause_i=i)
            if (hist%dimsizes(i)<=0) call StoreError(USR_EINT, 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 HistoryAutoCreate1

   subroutine add_ancilcrdvar(hst, var)
      implicit none
      type(HIST_EACHVAR),intent(inout)   :: hst
      type(GT4_NAMED_REALARY),intent(in)     :: var
      !
      integer     :: rank
      !
      rank = var%rank
      call HistoryAddVariable(var%name, var%dims(1:rank), end subroutine add_ancilcrdvar

   subroutine put_ancilcrdvar(hst, var)
      use dc_error, only: GT_ENOMATCHDIM, StoreError
      implicit none
      type(HIST_EACHVAR),intent(inout)   :: hst
      type(GT4_NAMED_REALARY),intent(in)     :: var
      !
      integer                      :: rank,i,j
      integer,allocatable          :: idx(:)
      real,pointer                 :: subset(:)
      character(len=*), parameter  :: subname = 'put_ancilcrdvar'
      !
      call BeginSub(subname)
      rank = var%rank
      allocate(idx(rank))
      loopi: do i=1,rank
	 do j=1,hst%sprank
	    if ( var%dims(i) == hst%dims(j) ) then
	       idx(i)=j
	       cycle loopi
	    endif
	 enddo
	 call StoreError(GT_ENOMATCHDIM, subname)
      enddo loopi

      subset => make_slice(var%ary, rank, (/hst%aryshape(idx)/), (/hst%slfst(idx)/), (/hst%sllst(idx)/), (/hst%slstp(idx)/))
      if (associated(subset)) then
	 call HistoryPut(var%name, subset, hst%h%hs)
      else
	 call HistoryPut(var%name, var%ary, hst%h%hs)
      endif
      deallocate(idx)
      call EndSub(subname)
   end subroutine put_ancilcrdvar

   subroutine HistoryAutoPut(name, vals, time)
      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, 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. 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, 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), hst%h%hs => hist
	       call HistoryAddVariable(name, hst%dims(1:rank), trim(hst%longname), trim(hst%units), 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), else
		     call HistoryPut(hst%dims(j), 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), !" ここで 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 HistoryAutoPut

   function HistoryAutoWhetherPutNow( name, time ) result(result)
      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, if (put_now) then
	    result = .true.
	    exit
	 endif
      enddo
      call EndSub(subname)
   end function HistoryAutoWhetherPutNow

   function whether_to_put_now( time_now, time_last, time_to_start, put_interval, dt ) result(result)
      implicit none
      logical           :: result
      real, intent(in)  :: time_now
      real, intent(in)  :: time_last
      real, intent(in)  :: time_to_start
      real, intent(in)  :: put_interval
      real, intent(in)  :: dt
      !
      real     :: next_put_time
      real     :: eps
      character(len = *), parameter:: subname = 'whether_to_put_now'

      call BeginSub(subname)
      eps = dt * 1e-3         ! allowable error in time in float

      if (time_now < time_to_start - eps) then
	 result = .false.
	 return
      end if

      next_put_time = time_last + put_interval  ! initially very small because
                                                ! of the init val of time_last

      if ( time_now >= (next_put_time - eps) ) then
	 result = .true.
      else
	 result = .false.
      endif
      call EndSub(subname)
   end function whether_to_put_now

   subroutine HistoryAutoCopyCreate( name, longname, units, file )
      ! use the result of the latest call of HistoryAutoCreate
      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 HistoryAutoSetRunInfo( conventions, gt_version  )
      use dc_error, only: USR_EINT, 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

   subroutine HistoryAutoSetGrid( grid_label, aryshape, dims, axlongnames, axunits, axxtypes, subdomfst )
      use dc_error, only: USR_EINT, 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

   ! Create a history using a grid data set with a previous call of
   ! HistoryAutoSetGrid. 
   subroutine HistoryAutoCreate2( name, longname, units, file, grid_label, use dc_error, only: USR_ECHAR, USR_EINT, 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_ECHAR, subname, endif
      
      call HistoryAutoCreate1( name, longname, units, file, hist%aryshape(1:hist%sprank), hist%domain_div, hist%subdomfst )

      call EndSub(subname)
   end subroutine HistoryAutoCreate2

   subroutine add_gt4_attribute(hst, attr)
      implicit none
      type(HIST_EACHVAR),intent(inout)   :: hst
      type(GT4_ATTRIBUTE),intent(in)         :: attr
      !
      if( hst%name /= "" ) then
	 if(associated(attr%rval)) then
	    call HistoryAddAttr(hst%name, attr%name, attr%rval, hst%h%hs)
	 else if(associated(attr%rval)) then
	    call HistoryAddAttr(hst%name, attr%name, attr%ival, hst%h%hs)
	 else
	    call HistoryAddAttr(hst%name, attr%name, trim(attr%cval), hst%h%hs)
	 endif
      endif
   end subroutine add_gt4_attribute

   function histpl_find(histpl, name,ith,hist) result(result)
      implicit none
      logical                        :: result   ! .true. if found
      type(HIST_LINK),pointer        :: histpl ! intent(in)
      character(len=*), intent(in)   :: name
      integer, intent(inout)         :: ith   ! ith+=1 when return (to iterate)
      type(HIST_EACHVAR),pointer     :: hist
      !
      type(HIST_LINK),pointer,save :: hp
      integer,save :: cnt=1
      character(len=TOKEN),save   :: name_save = ''
      !
      if(name/=name_save .or. ith<cnt) then
	 cnt = 1
	 hp => histpl
      endif
      do while (associated(hp))
	 !!print *,trim(name),ith,cnt,trim(hp%name)
	 if (hp%name == name) then
	    if(cnt==ith) then
	       !!print *,' ...found'
	       hist => hp%hist
	       result = .true.      ! found
	       name_save = name     !    save the name found
	       ith = ith+1          !    stepped forward for the next search
	       cnt = cnt + 1        !    stepped forward for the next search
	       hp => hp%next        !    stepped forward for the next search
	       return
	    endif
	    cnt = cnt + 1
	 endif
	 hp => hp%next
      end do
      !!print *,'    ...not found'
      result = .false.     ! not found
      name_save = ''       !     initialize
      cnt = 1              !     initialize
   end function histpl_find

   function histpl_last(histpl) result(result)
      implicit none
      type(HIST_EACHVAR),pointer         :: result
      type(HIST_LINK),pointer        :: histpl ! intent(in)
      !
      type(HIST_LINK),pointer            :: hp
      hp => histpl_to_the_end(histpl)
      result => hp%hist
   end function histpl_last

   subroutine histpl_push(histpl, hist)
      implicit none
      type(HIST_LINK),pointer        :: histpl ! intent(in)
      type(HIST_EACHVAR),intent(in)        :: hist
      !
      type(HIST_LINK),pointer               :: hp, nxt
      hp => histpl_to_the_end(histpl)
      if ( .not. associated(hp) ) then
         ! must be the first time
	 allocate(hp)   ! always new allocation
	 histpl => hp
      else
	 allocate(nxt)
	 hp%next => nxt
	 hp => nxt
      endif
      hp%hist = hist
      hp%name = hist%name
   end subroutine histpl_push

   function histpl_to_the_end(histpl) result(result)
      type(HIST_LINK),pointer            :: result
      type(HIST_LINK),pointer        :: histpl ! intent(in)
      result => histpl
      do while (associated(result))
	 if (associated(result%next)) then
	    result => result%next
	 else
	    exit
	 endif
      end do
   end function histpl_to_the_end

   function make_slice(vals, rank, aryshape, slfst, sllst, slstp) implicit none
      real,pointer,dimension(:)          :: result
      real,intent(in)                    :: vals(:)
      integer,intent(in)                 :: rank
      integer,intent(in)                 :: aryshape(*)
      integer,intent(in)                 :: slfst(*)
      integer,intent(in)                 :: sllst(*)
      integer,intent(in)                 :: slstp(*)
      !
      integer  :: i,slsize
      logical  :: slicing_needed
      real,pointer :: v1(:),v2(:,:),v3(:,:,:)
      character(len = *), parameter:: subname = 'make_slice'
      !
      call BeginSub(subname)
      nullify(result)
      !
      slicing_needed = .false.
      do i=1,rank
	 if (slfst(i)/=1)           slicing_needed = .true.
	 if (sllst(i)/=aryshape(i)) slicing_needed = .true.
	 if (slstp(i)/=1)           slicing_needed = .true.
      enddo

      slsize = 1
      do i=1,rank
	 slsize = slsize * ( (sllst(i)-slfst(i))/slstp(i) + 1 )
      enddo


      if(.not.slicing_needed) then
	 nullify(result)
      else
	 if(associated(result)) deallocate(result)
	 allocate(result(slsize))
	 select case(rank)
	 case (1)
	    if(associated(v1)) deallocate(v1)
	    allocate(v1(aryshape(1)))
	    v1 = reshape(vals,(/aryshape(1:1)/))
	    result = v1(slfst(1):sllst(1):slstp(1))
	 case (2)
	    if(associated(v2)) deallocate(v2)
	    allocate(v2(aryshape(1),aryshape(2)))
	    v2 = reshape(vals,(/aryshape(1:2)/))
	    result = reshape( v2(slfst(1):sllst(1):slstp(1), slfst(2):sllst(2):slstp(2)), case (3)
	    if(associated(v3)) deallocate(v3)
	    allocate(v3(aryshape(1),aryshape(2),aryshape(3)))
	    v3 = reshape(vals,(/aryshape(1:3)/))
	    result = reshape( end select
      endif
      call EndSub(subname)
   end function make_slice

   function merge_file_proc_time(file,proc,time) result(result)
      implicit none
      character(len=STRING)         :: result
      character(len=*), intent(in)  :: file
      character(len=*), intent(in)  :: proc
      real, intent(in), optional    :: time
      !
      integer                       :: idx
      character(len=TOKEN)          :: ctime
      character(len=10)             :: fmt
      !
      if(.not.present(time)) then
	 ctime = ""
      else
	 if (aint(time) == time) then
	    fmt = "(I)"
	    write(ctime,fmt=fmt) nint(time)
	    idx = index(ctime, '.')
	    if (idx>0) ctime = ctime(1:idx-1)
	 else
	    write(ctime,*) time
	 endif
	 ctime = '_t'//adjustl(ctime)//'-'
      endif
      !
      if (proc == "") then
	 result = file
      else
	 idx = index(file, '.nc', .true.)  ! tru -> search the right-most match
	 if (idx == 0) then
	    result = trim(file) // trim(adjustl(proc))
	 else if (idx /= 1) then
	    result = file(1:idx-1) // trim(adjustl(proc)) // '.nc'
	 else
	    result = trim(adjustl(proc)) // '.nc'
	 endif
      endif
      if (ctime == "") then
	 ! do nothing
      else
	 idx = index(result, '.nc', .true.)  !tru-> search the right-most match
	 if (idx == 0) then
	    result = trim(result) // trim(adjustl(ctime))
	 else if (idx /= 1) then
	    result = result(1:idx-1) // trim(adjustl(ctime)) // '.nc'
	 else
	    result = trim(adjustl(ctime)) // '.nc'
	 endif
      endif
   end function merge_file_proc_time

   function present_and_not_empty(arg) result(result)
      logical :: result
      character(len=*),intent(in),optional :: arg
      if(present(arg)) then
         if(arg/="") then
            result=.true.
         else
            result=.false.
         endif
      else
         result=.false.
      endif
   end function present_and_not_empty