historycopy.f90

Go to the documentation of this file.

 
  subroutine historycopy1(hist_dest, file, hist_src, &
    & title, source, institution, &
    & origin, interval, &
    & conventions, gt_version)
    !
    use gtool_history_internal, only: default
    use gtool_history_generic, only: historyinquire, historycreate, historyput
    use gtdata_generic, only: copy_attr, get
    use dc_present, only: present_select
    use dc_types,   only: string, dp, dp_eps
    use dc_trace, only: beginsub, endsub
    use gtool_history_types, only: gt_history
    implicit none
    type(gt_history), intent(out), target:: hist_dest
    character(*), intent(in):: file
    type(gt_history), intent(in), optional, target:: hist_src
    character(*), intent(in), optional:: title, source, institution
    real, intent(in), optional:: origin, interval
    character(*), intent(in), optional:: conventions, gt_version
    ! Internal Work
    type(gt_history), pointer:: src =>null()
    character(STRING) :: title_src, source_src, institution_src
    character(STRING) :: conventions_src, gt_version_src
    character(STRING), pointer:: dims(:) => null()
    integer          , pointer:: dimsizes(:) => null()
    character(STRING), pointer:: longnames(:) => null()
    character(STRING), pointer:: units(:)  => null()
    character(STRING), pointer:: xtypes(:) => null()
    real(DP):: originw, intervalw
    integer  :: i, numdims
    logical        :: err
    real(DP),pointer :: dimvalue(:) => null()
    character(len = *),parameter:: subname = "HistoryCopy1"
  continue
    call beginsub(subname, 'file=<%c>', c1=trim(file))
    if (present(hist_src)) then
      src => hist_src
    else
      src => default
    endif
    if ( .not. src % mpi_gather &
      &  .or. ( src % mpi_gather .and. src % mpi_myrank == 0 ) ) then
    numdims = size(src % dimvars)
    call historyinquire(history=src, title=title_src, &
      & source=source_src, institution=institution_src, &
      & dims=dims, dimsizes=dimsizes, longnames=longnames, &
      & units=units, xtypes=xtypes, &
      & conventions=conventions_src, gt_version=gt_version_src)
    if ( present(origin) ) then
      originw = real(origin, kind(originw))
    else
      originw = real(src % origin, kind(originw))
!      originw = EvalByUnit( src % origin, '', src % unlimited_units_symbol )
    end if
    intervalw = src % interval
!    intervalw = EvalByUnit( src % interval, '', src % unlimited_units_symbol )
    if ( present(interval) ) then
      if ( abs(real(interval, kind(intervalw))) > dp_eps ) then
        intervalw = real(interval, kind(intervalw))
      end if
    end if
    call historycreate(file=trim(file), &
      & title=trim(present_select('', title_src, title)), &
      & source=trim(present_select('', source_src, source)), &
      & institution=trim(present_select('', institution_src, institution)), &
      & dims=dims, dimsizes=dimsizes, longnames=longnames, units=units, &
      & origind=originw, intervald=intervalw, &
      & xtypes=xtypes, &
      & history=hist_dest, &
      & conventions=trim(present_select('', conventions_src, conventions)), &
      & gt_version=trim(present_select('', gt_version_src, gt_version)) )
    !
    ! 次元変数が属性を持っている場合のことも考え, 最後に直接
    ! hist_dst % dimvars へ copy_attr (gtvarcopyattrall) をかける.
    !
    do i = 1, numdims
      call copy_attr(hist_dest % dimvars(i), src % dimvars (i), global=.false.)
    end do
    ! dimvars を Get してみて, 値を持っているようならデータを与えてしまう.
    do i = 1, numdims
      if (dimsizes(i) == 0) cycle
      call get(src % dimvars(i), dimvalue, err)
      if (err) cycle
      call historyput(dims(i), dimvalue, hist_dest)
      deallocate(dimvalue)
    end do
    deallocate(dims, dimsizes, longnames, units, xtypes)
      end if
    call endsub(subname)
  end subroutine historycopy1
  !-------------------------------------------------------------------
  subroutine historycopy2(hist_dest, file, hist_src, &
    & title, source, institution, &
    & origin, interval, &
    & conventions, gt_version)
    use dc_trace, only: beginsub, endsub
    use gtool_history_types, only: gt_history
    use gtool_history_generic, only: historycopy
    implicit none
    type(gt_history), intent(out), target:: hist_dest
    character(*), intent(in):: file
    type(gt_history), intent(in), optional, target:: hist_src
    character(*), intent(in), optional:: title, source, institution
    real, intent(in), optional:: origin, interval
    character(*), intent(in), optional:: conventions, gt_version
    ! Internal Work
    character(len = *),parameter:: subname = "HistoryCopy2"
  continue
    call beginsub(subname, 'file=<%c>', c1=trim(file))
    call historycopy(hist_dest, file, hist_src, &
      & title, source, institution, &
      & origin, interval, &
      & conventions, gt_version)
    call endsub(subname)
  end subroutine historycopy2