Path: | gtool/gtool_history/historycopy.F90 |
Last Update: | Mon May 25 18:45:20 +0900 2009 |
Authors: | Yasuhiro MORIKAWA |
Version: | $Id: historycopy.F90,v 1.2 2009-05-25 09:45:20 morikawa Exp $ |
Tag Name: | $Name: gtool5-20090729 $ |
Copyright: | Copyright (C) GFD Dennou Club, 2004-2009. All rights reserved. |
License: | See COPYRIGHT |
Subroutine : | |
hist_dest : | type(GT_HISTORY), intent(out), target |
file : | character(*), intent(in) |
hist_src : | type(GT_HISTORY), intent(in), optional, target |
title : | character(*), intent(in), optional |
source : | character(*), intent(in), optional |
institution : | character(*), intent(in), optional |
origin : | real, intent(in), optional |
interval : | real, intent(in), optional |
conventions : | character(*), intent(in), optional |
gt_version : | character(*), intent(in), optional |
引数 hist_src の内容にコピーし, hist_dest へ返します. hist_src が与えられない場合は, 引数 history を与えずに呼び出した HistoryCreate の設定内容が参照されます. HistoryCreate と同様に, 出力の初期設定を行います. file は必ず与えなければならず, hist_src と同じファイルへ出力 しようとする場合はエラーを生じます. HistoryAddVariable で設定される内容に関してはコピーされません.
それ以降の引数を与えることで, hist_src の設定を 上書きすることが可能です.
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 #ifdef LIB_MPI if ( .not. src % mpi_gather .or. ( src % mpi_gather .and. src % mpi_myrank == 0 ) ) then #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 = EvalByUnit( src % origin, '', src % unlimited_units_symbol ) end if 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) #ifdef LIB_MPI end if #endif call EndSub(subname) end subroutine HistoryCopy1
Subroutine : | |
hist_dest : | type(GT_HISTORY), intent(out), target |
file : | character(*), intent(in) |
hist_src : | type(GT_HISTORY), intent(in), optional, target |
title : | character(*), intent(in), optional |
source : | character(*), intent(in), optional |
institution : | character(*), intent(in), optional |
origin : | real, intent(in), optional |
interval : | real, intent(in), optional |
conventions : | character(*), intent(in), optional |
gt_version : | character(*), intent(in), optional |
使用方法は HistoryCopy と同様です.
Usage is same as "HistoryCopy".
subroutine HistoryCopy2(hist_dest, file, hist_src, title, source, institution, origin, interval, conventions, gt_version) ! ! 使用方法は HistoryCopy と同様です. ! ! Usage is same as "HistoryCopy". ! ! 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