subroutine append_attrs(varname, attrs, history)
    !
    ! GT_HISTORY_ATTR 変数を history の varname 変数に
    ! 付加するためのサブルーチン. 公開用ではなく,
    ! HistoryCreate や HistoryAddVariable に GT_HISTORY_AXIS
    ! や GT_HISTORY_VARINFO が与えられた時に内部的に利用される.
    !
    use gtool_history_generic, only: HistoryAddAttr
    use gtdata_generic, only: Put_Attr
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    use dc_string     , only: StrHead, LChar, toChar
    use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
    implicit none
    character(*),     intent(in):: varname
    type(GT_HISTORY_ATTR),  intent(in):: attrs(:)
    type(GT_HISTORY), intent(inout), target, optional:: history

    type(GT_HISTORY), pointer:: hst =>null()
    integer                      :: i
    character(*), parameter:: subname = "append_attrs"
  continue
    call BeginSub(subname, 'varname=<%c>, size(attrs(:))=<%d>', c1=trim(varname), i=(/size(attrs(:))/))

    if (present(history)) then
      hst => history
    else
      hst => default
    endif

    ! attrs(:) のサイズ分だけループ
    do i = 1, size( attrs(:) )
      ! attrs(i)%attrtype の種別で与える変数を変える
      if ( StrHead( 'char', trim(LChar(attrs(i)%attrtype))) ) then
        call HistoryAddAttr( varname, attrs(i)%attrname, trim(attrs(i)%Charvalue), hst )

      elseif ( StrHead( 'int', trim(LChar(attrs(i)%attrtype))) ) then
        if ( attrs(i)%array ) then
          call DbgMessage('Intarray(:) is selected.')
          call HistoryAddAttr( varname, attrs(i)%attrname , attrs(i)%Intarray, hst       )
        else
          call DbgMessage('Intvalue is selected')
          call HistoryAddAttr( varname, attrs(i)%attrname , attrs(i)%Intvalue, hst      )
        endif

      elseif ( StrHead( 'real', trim(LChar(attrs(i)%attrtype))) ) then
        if ( attrs(i)%array ) then
          call DbgMessage('Realarray(:) is selected.')
          call HistoryAddAttr( varname, attrs(i)%attrname, attrs(i)%Realarray, hst)
        else
          call DbgMessage('Realvalue is selected')
          call HistoryAddAttr( varname, attrs(i)%attrname, attrs(i)%Realvalue, hst)
        endif

      elseif ( StrHead( 'double', trim(LChar(attrs(i)%attrtype))) ) then
        if ( attrs(i)%array ) then
          call DbgMessage('Doublearray(:) is selected.')
          call HistoryAddAttr( varname, attrs(i)%attrname, attrs(i)%Doublearray, hst)
        else
          call DbgMessage('Doublevalue is selected')
          call HistoryAddAttr( varname, attrs(i)%attrname, attrs(i)%Doublevalue, hst)
        endif

      elseif ( StrHead( 'logical', trim(LChar(attrs(i)%attrtype))) ) then
        call HistoryAddAttr( varname, attrs(i)%attrname, attrs(i)%Logicalvalue, hst)

      else
        call DbgMessage('attrtype=<%c>=<%c>is Invalid.'   , c1=trim(attrs(i)%attrtype)         , c2=trim(LChar(attrs(i)%attrtype))      )
      endif
    enddo
    call EndSub(subname)
  end subroutine append_attrs

  subroutine copy_attrs(from, to, err)
    !
    ! GT_HISTORY_ATTR 変数をコピーするためのサブルーチン
    ! このモジュール内部で利用されることを想定している.
    ! from と to の配列サイズは同じであることが想定されている.
    ! err を与えると, コピーの際何らかの不具合が生じると
    ! 終了せずに err が真になって返る.
    !
    use dc_string,only: LChar, StrHead
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    use dc_error, only: StoreError, GT_EARGSIZEMISMATCH, GT_EBADATTRNAME, DC_NOERR
    use dc_types, only: STRING, TOKEN
    use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
    implicit none
    type(GT_HISTORY_ATTR), intent(in)  :: from(:)
    type(GT_HISTORY_ATTR), intent(out) :: to(:)
    logical,               intent(out), optional :: err
    integer     :: i, stat
    character(STRING) :: cause_c
    character(STRING), parameter:: subname = "copy_attrs"
  continue

    call BeginSub(subname)
    stat = DC_NOERR
    cause_c = ''

    call DbgMessage('size(from)=<%d>, size(to)=<%d>, So copy <%d> times.', i=(/ size(from), size(to), min(size(from),size(to)) /) )

    if ( size(to) < size(from) ) then
      stat = GT_EARGSIZEMISMATCH
      cause_c = 'from is larger than to'
      goto 999
    end if


    ! from と to の小さい方に合わせてループ
    do i = 1, min( size(from), size(to) )
      ! attrname と attrtype と array はまずコピー
      to(i)%attrname       = from(i)%attrname
      to(i)%attrtype       = from(i)%attrtype
      to(i)%array          = from(i)%array

      ! from(i)%attrtype の種別でコピーする変数を変える.
      if ( StrHead( 'char', trim(LChar(from(i)%attrtype))) ) then
        to(i)%Charvalue      = from(i)%Charvalue

                          elseif ( StrHead( LChar('Int'), trim(LChar(from(i)%attrtype)))) then
        if ( from(i)%array ) then
          allocate(  to(i)%Intarray( size(from(i)%Intarray) )  )
          to(i)%Intarray = from(i)%Intarray
        else
          to(i)%Intvalue = from(i)%Intvalue
        endif
                    
      elseif ( StrHead( LChar('Real'), trim(LChar(from(i)%attrtype)))) then
        if ( from(i)%array ) then
          allocate(  to(i)%Realarray( size(from(i)%Realarray) )  )
          to(i)%Realarray = from(i)%Realarray
        else
          to(i)%Realvalue = from(i)%Realvalue
        endif
                    
      elseif ( StrHead( LChar('Double'), trim(LChar(from(i)%attrtype)))) then
        if ( from(i)%array ) then
          allocate(  to(i)%Doublearray( size(from(i)%Doublearray) )  )
          to(i)%Doublearray = from(i)%Doublearray
        else
          to(i)%Doublevalue = from(i)%Doublevalue
        endif
                    
      elseif ( StrHead( 'logical', trim(LChar(from(i)%attrtype))) ) then
        to(i)%Logicalvalue = from(i)%Logicalvalue

      else
        stat = GT_EBADATTRNAME
        cause_c = from(i)%attrtype
        goto 999
      endif
    enddo

999 continue
    call StoreError(stat, subname, err, cause_c=cause_c)
    call EndSub(subname)
  end subroutine copy_attrs

  subroutine gtmpi_axis_register(hst, err)
    !
    ! hst % mpi_gthr_info に情報の登録を行う. 
    !
    use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
    use gtdata_generic, only: Inquire
    use gtdata_types, only: GT_VARIABLE
    use dc_error, only: StoreError, DC_NOERR, HST_EMPINOAXISDATA
    use dc_message, only: MessageNotify
    use dc_url, only: UrlSplit
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    use dc_types, only: STRING, TOKEN, DP
    use mpi
    implicit none
    type(GT_HISTORY), intent(inout):: hst
    logical, intent(out), optional:: err
    integer:: i, j, k, ra, numdims
    integer:: err_mpi, st_mpi(MPI_STATUS_SIZE)
    integer, allocatable:: index_all_buf(:)
    character(STRING):: url, dimname
    real:: accuracy
    real(DP):: zero_limit
    logical:: flag_hit
    real(DP), pointer:: large =>null(), small =>null()
    integer:: stat
    character(STRING):: cause_c
    character(*), parameter:: subname = 'gtmpi_axis_register'
    character(*), parameter:: subnameup = 'HistoryPut'
  continue
    call BeginSub(subname)
    cause_c = ""
    stat = DC_NOERR

    numdims = size( hst % dimvars )
    accuracy = 1.0e-3
    zero_limit = 1.0e-6_DP
    allocate( hst % mpi_gthr_info(numdims) )

    ! 未登録の座標データ (時刻以外) がある場合にはエラー
    ! Error is occurred when non registered data of axes (excluding time)
    !
    do i = 1, numdims
      if ( hst % unlimited_index == i ) cycle
      if ( hst % time_nv_index == i ) cycle
      if ( hst % mpi_myrank == 0 ) then
        call Inquire( hst % dimvars(i), url = url )         ! (out)
        call UrlSplit( url, var = dimname )  ! (out)
        call MPI_Bcast( dimname, STRING, MPI_CHARACTER, 0, MPI_COMM_WORLD, err_mpi )
      else
        call MPI_Bcast( dimname, STRING, MPI_CHARACTER, 0, MPI_COMM_WORLD, err_mpi )
      end if

      if ( hst % mpi_myrank == 0 ) then
        if ( hst % mpi_dimdata_all(i) % length < 0 ) then
          call MessageNotify('W', subnameup, 'data of axis (%c) in whole area is lack. ' // 'Specify the data by "HistoryPutAxisMPI" explicitly.', c1 = trim(dimname) )
          stat = HST_EMPINOAXISDATA
          cause_c = dimname
          goto 999
        end if
      end if

      if ( hst % mpi_dimdata_each(i) % length < 0 ) then
        call MessageNotify('W', subnameup, 'data of axis (%c) on node (%d) is lack. ' // 'Specify the data by "HistoryPut" explicitly.', c1 = trim(dimname), i = (/ hst % mpi_myrank /) )
        stat = HST_EMPINOAXISDATA
        cause_c = dimname
        goto 999
      end if
    end do

    ! mpi_gthr_info へ情報を登録
    ! Register information to "mpi_gthr_info"
    !
    do i = 1, numdims
      if ( hst % unlimited_index == i ) cycle
      if ( hst % time_nv_index == i ) cycle
      allocate( hst % mpi_gthr_info(i) % length( 0: hst % mpi_nprocs - 1 ) )
      allocate( hst % mpi_gthr_info(i) % index_all( 0: hst % mpi_nprocs - 1, hst % mpi_dimdata_all(i) % length ) )
      hst % mpi_gthr_info(i) % index_all(:,:) = -1
      hst % mpi_gthr_info(i) % length( hst % mpi_myrank ) = hst % mpi_dimdata_each(i) % length

      k = 1
      do j = 1, hst % mpi_dimdata_all(i) % length
        flag_hit = .false.

        if ( abs( hst % mpi_dimdata_all(i) % a_Axis(j) ) > abs( hst % mpi_dimdata_each(i) % a_Axis(k) ) ) then
          large => hst % mpi_dimdata_all(i) % a_Axis(j)
          small => hst % mpi_dimdata_each(i) % a_Axis(k)
        else
          large => hst % mpi_dimdata_each(i) % a_Axis(k)
          small => hst % mpi_dimdata_all(i) % a_Axis(j)
        end if

        if (      large > 0.0_DP .and. small < 0.0_DP .or. large < 0.0_DP .and. small > 0.0_DP ) then
          cycle
        end if

        if ( abs( large ) < zero_limit .and. abs( small ) < zero_limit ) then
          flag_hit = .true.
        end if

        if ( .not. flag_hit .and. abs( ( large / small ) - 1.0_DP ) < accuracy ) then
          flag_hit = .true.
        end if

        if ( flag_hit ) then
          hst % mpi_gthr_info(i) % index_all ( hst % mpi_myrank, k ) = j
          k = k + 1
        end if

        if ( k > hst % mpi_gthr_info(i) % length( hst % mpi_myrank ) ) exit
      end do

    end do

    ! rank == 0 で情報を受け取る. 
    ! Receive information by rank == 0
    !
    if ( hst % mpi_myrank == 0 ) then
      do i = 1, numdims
        if ( hst % unlimited_index == i ) cycle
        if ( hst % time_nv_index == i ) cycle
        allocate( index_all_buf( hst % mpi_dimdata_all(i) % length ) )
        do ra = 1, hst % mpi_nprocs - 1
          call MPI_Recv( index_all_buf, hst % mpi_dimdata_all(i) % length, MPI_INTEGER, ra, 0, MPI_COMM_WORLD, st_mpi, err_mpi )
          hst % mpi_gthr_info(i) % index_all (ra,:) = index_all_buf(:)
        end do
        deallocate( index_all_buf )
        do ra = 1, hst % mpi_nprocs - 1
          call MPI_Recv( hst % mpi_gthr_info(i) % length (ra), 1, MPI_INTEGER, ra, 0, MPI_COMM_WORLD, st_mpi, err_mpi )
        end do
      end do
    else
      do i = 1, numdims
        if ( hst % unlimited_index == i ) cycle
        if ( hst % time_nv_index == i ) cycle
        allocate( index_all_buf( hst % mpi_dimdata_all(i) % length ) )
        index_all_buf(:) = hst % mpi_gthr_info(i) % index_all (hst % mpi_myrank,:)
        call MPI_Send( index_all_buf, hst % mpi_dimdata_all(i) % length, MPI_INTEGER, 0, 0, MPI_COMM_WORLD, err_mpi )
        deallocate( index_all_buf )
        call MPI_Send( hst % mpi_gthr_info(i) % length (hst % mpi_myrank), 1, MPI_INTEGER, 0, 0, MPI_COMM_WORLD, err_mpi )
      end do
    end if

    ! 情報に不足が無いかチェック
    ! Check lack of information
    !
    if ( hst % mpi_myrank == 0 ) then
      do ra = 0, hst % mpi_nprocs - 1
        do i = 1, numdims
          if ( hst % unlimited_index == i ) cycle
          if ( hst % time_nv_index == i ) cycle
        end do
      end do
      do ra = 0, hst % mpi_nprocs - 1
        do i = 1, numdims
          if ( hst % unlimited_index == i ) cycle
          if ( hst % time_nv_index == i ) cycle
          do j = 1, hst % mpi_gthr_info(i) % length (ra)
            if ( hst % mpi_gthr_info(i) % index_all (ra,j) < 1 ) then
              call Inquire( hst % dimvars(i), url = url )         ! (out)
              call UrlSplit( url, var = dimname )  ! (out)
              call MessageNotify('W', subnameup, 'data of axis (%c) on node (%d) or ' // 'in whole area are lack. ' // 'Specify the data by "HistoryPut" or "HistoryPutAxisMPI" explicitly.', c1 = trim(dimname), i = (/ ra /) )
              stat = HST_EMPINOAXISDATA
              cause_c = dimname
              goto 999
            end if
          end do
        end do
      end do
    end if

999 continue
    call StoreError(stat, subname, err, cause_c)
    call EndSub(subname)
  end subroutine gtmpi_axis_register

  subroutine gtmpi_vars_mkindex(hst, v_ord, err)
    !
    ! hst % mpi_vars_index に配列添字情報の登録を行う. 
    !
    use gtool_history_types, only: GT_HISTORY, GT_HISTORY_AXIS, GT_HISTORY_VARINFO, GT_HISTORY_ATTR
    use gtool_history_generic, only: HistoryVarinfoInquire
    use gtdata_generic, only: Inquire
    use gtdata_types, only: GT_VARIABLE
    use dc_error, only: StoreError, DC_NOERR, HST_EMPINOAXISDATA
    use dc_message, only: MessageNotify
    use dc_url, only: UrlSplit
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    use dc_types, only: STRING, TOKEN, DP
    use mpi
    implicit none
    type(GT_HISTORY), intent(inout):: hst
    integer, intent(in):: v_ord ! 変数 ID
    logical, intent(out), optional:: err
    character(TOKEN), pointer:: dims(:) =>null(), dims_space(:) =>null()
    integer, pointer:: dimsizes_each(:,:) =>null(), dimsizes_all(:) =>null()
    type(GT_VARIABLE):: dimvar
    integer:: i, j, ra, numdims, time_dimord
    integer, pointer:: dimord(:) =>null()
    integer:: each_index
    integer, pointer:: idx(:) =>null()
    integer:: moveup
    integer:: check_dimsizes_all, check_dimsizes_each
    character(STRING):: check_varname
    integer:: err_mpi
    integer:: stat
    character(STRING):: cause_c
    character(*), parameter:: subname = 'gtmpi_vars_mkindex'
    character(*), parameter:: subnameup = 'HistoryPut'
  continue
    call BeginSub(subname)
    cause_c = ""
    stat = DC_NOERR

    ! rank/=0 は何もせずに終了. 
    ! Finish without actions if rank/=0
    !
    ! * 以降の割り付け動作をプロセス 0 でのみ行うと, 
    !   なぜか Cray XT 上で並列計算する際に
    !   「異常な数値を ALLOCATE しようとしている」
    !   というエラーが生じるため, (無駄だが) 全プロセスで以降の
    !   割り付け動作を行う. 
    !
    !!! if ( hst % mpi_myrank /= 0 ) goto 999

    ! 変数が依存する座標軸情報を取得
    ! Information of axes depended from the variable
    !
    call HistoryVarinfoInquire( hst % mpi_varinfo( v_ord ), dims = dims )                 ! (out)

    ! 時刻次元の排除
    ! Ignore time dimension
    !
    numdims = size( dims )
    time_dimord = -1
    allocate( dimord(1) )
    if ( hst % unlimited_index > 0 ) then
      do i = 1, numdims
        if ( hst % mpi_myrank == 0 ) then
          dimvar = lookup_dimension( hst, dims(i), dimord(1) )
        end if
        call MPI_Bcast( dimord(1), 1, MPI_INTEGER, 0, MPI_COMM_WORLD, err_mpi )
        if ( hst % unlimited_index == dimord(1) ) time_dimord = i
      end do
    end if
    if ( time_dimord > 0 ) then
      allocate( dims_space(numdims - 1) )
      j = 1
      do i = 1, numdims
        if ( i == time_dimord ) cycle
        dims_space(j) = dims(i)
        j = j + 1
      end do
      numdims = numdims - 1
      deallocate( dims )
    else
      dims_space => dims
      nullify( dims )
    end if
    deallocate( dimord )

    ! スカラーの場合は例外処理
    ! Exception handling for scalar value
    !
    if ( numdims < 1 ) then
      allocate( hst % mpi_vars_index(v_ord) % each2all( 0: hst % mpi_nprocs - 1, 1 ) )
      allocate( hst % mpi_vars_index(v_ord) % allcount( 0: hst % mpi_nprocs - 1 ) )

      hst % mpi_vars_index(v_ord) % each2all(:,:) = 1
      hst % mpi_vars_index(v_ord) % allcount(:) = 1
      goto 999
    end if

    ! 配列の割付
    ! Allocate array
    !
    allocate( dimord( numdims ) )
    allocate( dimsizes_all( numdims ) )
    allocate( dimsizes_each( 0:hst % mpi_nprocs - 1, numdims ) )

    ! 個々の次元のサイズの取得
    ! Get size of each dimension
    !
    do i = 1, numdims
      if ( hst % mpi_myrank == 0 ) then
        dimvar = lookup_dimension( hst, dims_space(i), dimord(i) )
      end if
      call MPI_Bcast( dimord(i), 1, MPI_INTEGER, 0, MPI_COMM_WORLD, err_mpi )
      dimsizes_all(i)  = hst % mpi_dimdata_all ( dimord(i) ) % length
      do ra = 0, hst % mpi_nprocs - 1
        dimsizes_each(ra, i) = hst % mpi_gthr_info( dimord(i) ) % length( ra )
      end do
    end do

    allocate( hst % mpi_vars_index(v_ord) % each2all( 0: hst % mpi_nprocs - 1, product(dimsizes_all) ) )
    allocate( hst % mpi_vars_index(v_ord) % allcount( 0: hst % mpi_nprocs - 1 ) )
    hst % mpi_vars_index(v_ord) % each2all(:,:) = -1

    do ra = 0, hst % mpi_nprocs - 1
      hst % mpi_vars_index(v_ord) % allcount(ra) = product( dimsizes_each(ra,:) )
    end do

    hst % mpi_vars_index(v_ord) % allcount_all = product( dimsizes_all(:) )

    ! rank/=0 はこの時点で終了
    ! Finish at this point if rank/=0
    !
    if ( hst % mpi_myrank /= 0 ) goto 999

    allocate( idx(numdims) )

    do ra = 0, hst % mpi_nprocs - 1
      idx(:) = 1
      idx(1) = 0
      do i = 1, product( dimsizes_each(ra, :) )
        idx(1) = idx(1) + 1
        moveup = 0
        do j = 1, numdims
          if ( moveup > 0 ) then
            idx(j) = idx(j) + moveup
            moveup = 0
          end if
          if ( idx(j) > dimsizes_each(ra,j) ) then
            idx(j) = 1
            moveup = 1
          end if
        end do

        each_index = hst % mpi_gthr_info(dimord(1)) % index_all (ra,idx(1))

        do j = 2, numdims
          each_index = each_index + ( hst % mpi_gthr_info(dimord(j)) % index_all (ra,idx(j)) - 1 ) * product( dimsizes_all(1:j-1) )
        end do

        hst % mpi_vars_index(v_ord) % each2all(ra, i) = each_index

      end do
    end do

    deallocate( idx )

    ! 不足データが無いかチェック
    ! Check lack of data
    !
    check_dimsizes_all = product( dimsizes_all(:) )
    check_dimsizes_each = sum( hst % mpi_vars_index(v_ord) % allcount(:) )
    if ( check_dimsizes_all > check_dimsizes_each ) then
      call Inquire( hst % vars(v_ord), name = check_varname ) ! (out)
      call MessageNotify('W', subnameup, 'collected data (%c) from each node is lack. ' // 'collected data size=<%d>, but needed whole data size=<%d>.', c1 = trim(check_varname), i = (/ check_dimsizes_each, check_dimsizes_all /) )
    end if

999 continue
    call StoreError(stat, subname, err, cause_c)
    call EndSub(subname)
  end subroutine gtmpi_vars_mkindex

  type(GT_VARIABLE) function lookup_dimension(history, dimname, ord) result(result)
    !
    ! history 内の dimname という変数名を持つ次元の GT_VARIABLE
    ! 変数を返す. dimname 末尾の空白は無視される.
    !
    use gtdata_generic, only: Inquire
    use dc_types, only: STRING
    use dc_error, only: StoreError, GT_EBADDIMNAME, DC_NOERR
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    implicit none
    type(GT_HISTORY), intent(in):: history
    character(len = *), intent(in):: dimname
    integer, intent(out), optional:: ord
    integer:: ordwork
    character(len = STRING):: name, cause_c
    integer:: i, stat
    character(len = *), parameter:: subname = 'lookup_dimension'
  continue
    call BeginSub(subname, 'dimname=%c', c1=trim(dimname))
    stat = DC_NOERR
    if (present(ord)) ord = 0
    ordwork = 0
    if (associated(history % dimvars)) then
      do, i = 1, size(history % dimvars)
        call Inquire(history % dimvars(i), name=name)
        if (name == trim(dimname)) then
          result = history % dimvars(i)
          if (present(ord)) ord = i
          stat = DC_NOERR
          cause_c = ""
          goto 999
        endif
      enddo
    endif
    if (present(ord)) then
      ord = 0
    else
      stat = GT_EBADDIMNAME
      cause_c = dimname
    endif
999 continue
    call StoreError(stat, subname, cause_c=cause_c)
    if (present(ord)) ordwork = ord
    call EndSub(subname, 'ord=%d (0:not found)', i=(/ordwork/))
  end function

  subroutine lookup_var_or_dim(history, name, var, err)
    !
    ! history 内から, name という名前の次元または変数を探査し,
    ! var に GT_VARIABLE 変数を返す. 見つかって正常に
    ! var が返る場合は stat には DC_NOERR が返り,
    ! history 内から name が発見されない場合には, stat に
    ! NF_ENOTVAR が返る.
    !
    use dc_error, only: StoreError, DC_NOERR, NF_ENOTVAR
    use dc_types, only: STRING
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    implicit none
    type(GT_HISTORY), intent(in):: history
    character(len = *), intent(in):: name
    type(GT_VARIABLE), intent(out):: var
    logical, intent(out):: err
    integer:: stat, ord
    character(STRING) :: cause_c
    character(len = *), parameter:: subname = 'lookup_var_or_dim'

  continue
    call BeginSub(subname, 'name=<%c>', c1=trim(name))
    cause_c = ""
    stat = DC_NOERR
    var = lookup_variable(history, name, ord)
    if (ord /= 0) then
      stat = DC_NOERR
      goto 999
    endif
    var = lookup_dimension(history, name, ord)
    if (ord /= 0) then
      stat = DC_NOERR
      goto 999
    endif
    stat = NF_ENOTVAR
    cause_c = "Any vars and dims are not found"
999 continue
    call StoreError(stat, subname, err, cause_c)
    call EndSub(subname, 'ord=%d (0:not found)', i=(/ord/))
  end subroutine lookup_var_or_dim

  type(GT_VARIABLE) function lookup_variable(history, varname, ord) result(result)
    !
    !  history 内での変数 varname の ID を取得
    !    ID を取得できた場合, 返り値 result と ord にそれぞれ
    !    その ID が返される。
    !    ID を取得できない場合、ord が渡されていなければその場で終了
    !    ord が渡されている場合は ord に 0 が返される。
    !
    use dc_types, only: STRING
    use dc_error, only: StoreError, NF_ENOTVAR, DC_NOERR
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    implicit none
    type(GT_HISTORY), intent(in):: history
    character(len = *), intent(in):: varname
    character(len = STRING) :: cause_c
    integer, intent(out), optional:: ord
    integer:: ordwork
    integer:: i, stat
    character(len = *), parameter:: subname = 'lookup_variable'
  continue
    call BeginSub(subname, '%c', c1=trim(varname))
    stat = DC_NOERR
    cause_c = ''
    if (present(ord)) ord = 0
    ordwork = 0
    i = lookup_variable_ord(history, varname)
    if (i > 0) then
      result = history % vars(i)
      if (present(ord)) ord = i
      goto 999
    endif
    if (present(ord)) then
      ord = 0
    else
      stat = NF_ENOTVAR
      cause_c = varname
      i = 0
    endif
999 continue
    call StoreError(stat, subname, cause_c=cause_c)
    if (present(ord)) ordwork = ord
    call EndSub(subname, "ord=%d (0: not found)", i=(/ordwork/))
  end function

  integer function lookup_variable_ord(history, varname) result(result)
    !
    ! history 内の varname 変数の変数番号を返す.
    ! 現在, 明示的に history 変数を与えない場合の変数番号の
    ! 検索は出来ない.
    !
    use dc_types, only: STRING
    use gtdata_generic, only: inquire
    use dc_trace, only: BeginSub, EndSub, DbgMessage
    implicit none
    type(GT_HISTORY), intent(in):: history
    character(len = *), intent(in):: varname
    character(len = string):: name
    character(len = *), parameter:: subname = 'lookup_variable_ord'
  continue
    call BeginSub(subname, 'var=%c', c1 = trim(varname))
    if (associated(history % vars)) then
      do, result = 1, size(history % vars)
        call Inquire(history % vars(result), name=name)
        if (name == varname) goto 999
        call DbgMessage('no match <%c> <%c>', c1=trim(name), c2=trim(varname))
      enddo
    endif
    result = 0
999 continue
    call EndSub(subname, "result=%d", i=(/result/))
  end function

  subroutine set_fake_dim_value(history, dimord)
    !
    ! 次元 history % dimvars(dimord) に値が設定されていない場合、
    ! 「とりあえず」値を設定する。ただし、無制限次元 (時間次元)
    ! に関しては history % origin, history % interval, history % count
    ! から「まっとうな」値が設定される。
    !
    use gtdata_generic, only: Inquire, Slice, Put
    use dc_error, only: DumpError
!    use dc_calendar, only: DCCalConvertByUnit
!    use dc_date, only: EvalByUnit
    type(GT_HISTORY), intent(inout):: history
    integer, intent(in):: dimord
    integer:: length, i
    real, allocatable:: value(:)
    logical:: err
  continue
    if (dimord == history % unlimited_index) then
      if (.not. associated(history % count)) return
      length = maxval(history % count(:))
    else
      call Inquire(history % dimvars(dimord), size=length)
    endif
    if (length == 0) return
    allocate(value(length))
    if (dimord == history % unlimited_index) then
      value(:) = (/(real(i), i = 1, length)/)
      value(:) = history % origin + (value(:) - 1.0) * history % interval

!!$      value(:) =   &
!!$        &   EvalByUnit( history % origin, '', history % unlimited_units_symbol ) &
!!$        & + (value(:) - 1.0) &
!!$        &   * EvalByUnit( history % interval, '', history % unlimited_units_symbol )
      call Slice(history % dimvars(dimord), 1, start=1, count=length)
    else
      value(:) = (/(real(i), i = 1, length)/)
    endif

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