historycopy.f90

Go to the documentation of this file.

!> @file historycopy.F
!>
!> @author Yasuhiro MORIKAWA
!> @copyright Copyright (C) GFD Dennou Club, 2004-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. See [COPYRIGHT](@ref COPYRIGHT) in detail
!>
!> @en
!> @brief Copy configurations of output
!> @enden
!>
!> @ja
!> @brief 出力設定のコピー
!> @endja
!>
!> @en
!> @brief Copy output configurations
!>
!> Copies the contents of hist_src and returns them in hist_dest.
!> If hist_src is not given, the settings of HistoryCreate called
!> without the history argument are referenced.
!> Like HistoryCreate, this performs initial output settings.
!> file must always be given; attempting to output to the same file
!> as hist_src causes an error.
!> Settings made by HistoryAddVariable are not copied.
!> Arguments after file can override settings from hist_src.
!> @param[out] hist_dest    Destination history structure
!> @param[in]  file         Output file name
!> @param[in]  hist_src     Source history structure (optional)
!> @param[in]  title        Title (optional, override)
!> @param[in]  source       Source (optional, override)
!> @param[in]  institution  Institution (optional, override)
!> @param[in]  origin       Origin time (optional, override)
!> @param[in]  interval     Output interval (optional, override)
!> @param[in]  conventions  Conventions (optional, override)
!> @param[in]  gt_version   gt_version (optional, override)
!> @enden
!>
!> @ja
!> @brief 出力設定のコピー
!>
!> 引数 hist_src の内容をコピーし、hist_dest へ返します。
!> hist_src が与えられない場合は、引数 history を与えずに呼び出した
!> HistoryCreate の設定内容が参照されます。
!> HistoryCreate と同様に、出力の初期設定を行います。
!> file は必ず与えなければならず、hist_src と同じファイルへ出力
!> しようとする場合はエラーを生じます。
!> HistoryAddVariable で設定される内容に関してはコピーされません。
!> それ以降の引数を与えることで、hist_src の設定を上書きできます。
!> @param[out] hist_dest    コピー先ヒストリー構造体
!> @param[in]  file         出力ファイル名
!> @param[in]  hist_src     コピー元ヒストリー構造体 (省略可能)
!> @param[in]  title        タイトル (省略可能, 上書き)
!> @param[in]  source       ソース (省略可能, 上書き)
!> @param[in]  institution  組織 (省略可能, 上書き)
!> @param[in]  origin       開始時間 (省略可能, 上書き)
!> @param[in]  interval     出力時間間隔 (省略可能, 上書き)
!> @param[in]  conventions  規約 (省略可能, 上書き)
!> @param[in]  gt_version   gtバージョン (省略可能, 上書き)
!> @endja
!>
  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
    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)
    call endsub(subname)
  end subroutine historycopy1
  !-------------------------------------------------------------------
!> @en
  !> @brief Copy output configurations (generic interface)
  !>
  !> Usage is same as HistoryCopy.
  !> @enden
  !> @ja
  !> @brief 出力設定のコピー (総称インターフェース)
  !>
  !> 使用方法は HistoryCopy と同様です。
  !> @endja
  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