historycopy.f90

Go to the documentation of this file.

!= 出力設定のコピー
!= Copy configurations of output 
!
! Authors::   Yasuhiro MORIKAWA
! Version::   $Id: historycopy.F90,v 1.3 2009-10-10 08:01:52 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2004-2009. All rights reserved.
! License::   See COPYRIGHT[link:../../../COPYRIGHT]
!
  subroutine historycopy1(hist_dest, file, hist_src, &
    & title, source, institution, &
    & origin, interval, &
    & conventions, gt_version)
    !
    ! 引数 *hist_src* の内容にコピーし, *hist_dest* へ返します. *hist_src*
    ! が与えられない場合は, 引数 *history* を与えずに呼び出した
    ! HistoryCreate の設定内容が参照されます.
    ! HistoryCreate と同様に, 出力の初期設定を行います. *file*
    ! は必ず与えなければならず, *hist_src* と同じファイルへ出力
    ! しようとする場合はエラーを生じます.
    ! HistoryAddVariable で設定される内容に関してはコピーされません.
    !
    ! それ以降の引数を与えることで, hist_src の設定を
    ! 上書きすることが可能です.
    !
    use gtool_history_internal, only: default
    use gtool_history_generic, only: historyinquire, historycreate, historyput
    use gtdata_generic, only: inquire, get_attr, copy_attr, get, put
    use dc_error,   only: storeerror, dc_noerr, gt_eargsizemismatch
    use dc_present, only: present_select
    use dc_types,   only: string, token, dp
    use dc_date, only: evalbyunit
    use dc_trace, only: beginsub, endsub, dbgmessage
    use gtool_history_types, only: gt_history, gt_history_axis, gt_history_varinfo, gt_history_attr
    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:: 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 = origin
    else
      originw = src % origin
!      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 ( interval /= 0.0 ) then
        intervalw = interval
      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, &
      & origin=originw, interval=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

  !-------------------------------------------------------------------

  subroutine historycopy2(hist_dest, file, hist_src, &
    & title, source, institution, &
    & origin, interval, &
    & conventions, gt_version)
    !
    ! 使用方法は HistoryCopy と同様です. 
    !
    ! Usage is same as "HistoryCopy".
    !
    !--
    ! 総称名 Copy として提供するための関数です. 
    ! 機能は HistoryCopy1 と同じです. 
    !++
    use dc_trace, only: beginsub, endsub, dbgmessage
    use gtool_history_types, only: gt_history, gt_history_axis, gt_history_varinfo, gt_history_attr
    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