historycopyvariable.f90 File Reference

Copy definition of a variable . More...

Go to the source code of this file.

Functions/Subroutines
subroutine	historycopyvariable1 (file, varname, history, overwrite)

Detailed Description

Copy definition of a variable

.

Author

Yasuhiro MORIKAWA

Copyright

Copyright (C) GFD Dennou Club, 2004-2026. All rights reserved.
License is BSD-2-Clause. See COPYRIGHT in detail

Definition in file historycopyvariable.f90.

Function/Subroutine Documentation

historycopyvariable1()

subroutine historycopyvariable1	(	character(len = *), intent(in)	file,
		character(len = *), intent(in)	varname,
		type(gt_history), intent(inout), optional, target	history,
		logical, intent(in), optional	overwrite
	)

Copy a variable definition from another file

Defines a variable within gtool4 data by specifying a file name and variable name from another gtool4 data file, automatically copying the variable's structure and attributes. HistoryCreate must be called beforehand. Use HistoryAddVariable to set structure and attributes manually.

Parameters

[in]	file	netCDF file containing source variable
[in]	varname	name of source variable
[in,out]	history	history structure (optional)
[in]	overwrite	overwrite flag (optional)

Definition at line 48 of file historycopyvariable.f90.

    use gtool_history_types, only: gt_history, gt_history_avrdata
    use gtool_history_internal, only: default
    use gtdata_generic, only: create, inquire, open, slice, close
    use gtdata_types, only: gt_variable
    use dc_present, only: present_and_false
    use dc_url, only: urlmerge, gt_atmark, urlresolve
    use dc_types, only: string, dp
    use dc_trace, only: beginsub, endsub
    implicit none
    character(len = *), intent(in):: file
                              ! コピーしようとする変数が格納された
                              ! netCDF ファイル名
                              ! 
    character(len = *), intent(in):: varname
                              ! コピー元となる変数の名前
                              !
                              ! 定義される変数名もこれと
                              ! 同じになります。
                              ! 最大文字数は dc_types::TOKEN 。
                              !
                              ! 依存する次元が存在しない
                              ! 場合は自動的にその次元に関する
                              ! 変数情報も元のファイルから
                              ! コピーします。
                              ! この場合に「同じ次元」と見
                              ! なされるのは、(1) 無制限次
                              ! 元 (自動的に「時間」と認識
                              ! される)、
                              ! (2) サイズと単位が同じ次元、
                              ! です。
                              ! 
    type(GT_HISTORY), intent(inout), optional, target:: history
                              ! 出力ファイルの設定に関する情報を
                              ! 格納した構造体
                              ! 
                              ! ここに指定するものは、
                              ! HistoryCreate によって初期設定
                              ! されていなければなりません。
                              !
    logical, intent(in), optional:: overwrite
                              ! 上書きの可否の設定
                              !
                              ! この引数に .false. を渡すと、
                              ! 既存のファイルを上書きしません。
                              ! デフォルトは上書きします。
                              ! 
 
    type(GT_HISTORY),  pointer:: hst =>null()
    type(GT_VARIABLE), pointer:: vwork(:) =>null(), dimvars(:) =>null()
    type(GT_VARIABLE):: copyfrom
    character(STRING):: fullname, url, copyurl
    integer, pointer:: count_work(:) =>null()
    integer, pointer:: var_avr_count_work(:) =>null()
    integer:: var_avr_length
    logical, pointer:: var_avr_firstput_work(:) =>null()
    real(DP), pointer:: var_avr_coefsum_work(:) =>null()
    real(DP), pointer:: var_avr_baseint_work(:) =>null()
    real(DP), pointer:: var_avr_prevtime_work(:) =>null()
!!$    type(DC_DIFFTIME), pointer:: var_avr_baseint_work(:) =>null()
!!$    type(DC_DIFFTIME), pointer:: var_avr_prevtime_work(:) =>null()
    type(GT_HISTORY_AVRDATA), pointer:: var_avr_data_work(:) =>null()
    integer:: nvars, numdims, i
    logical:: growable, overwrite_required
    character(*), parameter:: subname = "HistoryCopyVariable1"
  continue
    call beginsub(subname, 'file=%c varname=%c', &
      & c1=trim(file), c2=trim(varname))
    !----- 操作対象決定 -----
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
 
    !----- 変数表拡張 -----
    if (associated(hst % vars)) then
      nvars = size(hst % vars(:))
      vwork => hst % vars
      count_work => hst % count
      nullify(hst % vars, hst % count)
      allocate(hst % vars(nvars + 1), hst % count(nvars + 1))
      hst % vars(1:nvars) = vwork(1:nvars)
      hst % count(1:nvars) = count_work(1:nvars)
      deallocate(vwork, count_work)
      count_work => hst % growable_indices
      nullify(hst % growable_indices)
      allocate(hst % growable_indices(nvars + 1))
      hst % growable_indices(1:nvars) = count_work(1:nvars)
      deallocate(count_work)
 
      !
      ! 平均値出力のための変数表コピー
      ! Copy table of variables for average value output
      !
      var_avr_count_work => hst % var_avr_count
      nullify( hst % var_avr_count )
      allocate( hst % var_avr_count(nvars + 1) )
      hst % var_avr_count(1:nvars) = var_avr_count_work(1:nvars)
      deallocate( var_avr_count_work )
 
      var_avr_data_work => hst % var_avr_data
      nullify(hst % var_avr_data)
      allocate(hst % var_avr_data(nvars + 1))
      do i = 1, nvars
        hst % var_avr_data(i) % length = var_avr_data_work(i) % length
        allocate(hst % var_avr_data(i) % &
          & a_dataavr(var_avr_data_work(i) % length))
        hst % var_avr_data(i) % a_DataAvr = var_avr_data_work(i) % a_DataAvr
      end do
      deallocate( var_avr_data_work )
 
      var_avr_firstput_work => hst % var_avr_firstput
      nullify( hst % var_avr_firstput )
      allocate( hst % var_avr_firstput(nvars + 1) )
      hst % var_avr_firstput(1:nvars) = var_avr_firstput_work(1:nvars)
      deallocate( var_avr_firstput_work )
 
      var_avr_coefsum_work => hst % var_avr_coefsum
      nullify( hst % var_avr_coefsum )
      allocate( hst % var_avr_coefsum(nvars + 1) )
      hst % var_avr_coefsum(1:nvars) = var_avr_coefsum_work(1:nvars)
      deallocate( var_avr_coefsum_work )
 
      var_avr_baseint_work => hst % var_avr_baseint
      nullify( hst % var_avr_baseint )
      allocate( hst % var_avr_baseint(nvars + 1) )
      hst % var_avr_baseint(1:nvars) = var_avr_baseint_work(1:nvars)
      deallocate( var_avr_baseint_work )
 
      var_avr_prevtime_work => hst % var_avr_prevtime
      nullify( hst % var_avr_prevtime )
      allocate( hst % var_avr_prevtime(nvars + 1) )
      hst % var_avr_prevtime(1:nvars) = var_avr_prevtime_work(1:nvars)
      deallocate( var_avr_prevtime_work )
    else
      ! トリッキーだが、ここで count だけ 2 要素確保するのは、
      ! HistorySetTime による巻き戻しに備えるため。
      allocate(hst % vars(1), hst % count(2), hst % growable_indices(1))
      hst % count(2) = 0
      allocate(hst % var_avr_count(1), hst % var_avr_data(1))
      allocate(hst % var_avr_firstput(1), hst % var_avr_coefsum(1))
      allocate(hst % var_avr_baseint(1), hst % var_avr_prevtime(1))
    endif
    nvars = size(hst % vars(:))
    hst % growable_indices(nvars) = 0
    hst % count(nvars) = 0
    hst % var_avr_count(nvars) = -1
    hst % var_avr_firstput = .true.
    hst % var_avr_coefsum(nvars) = 0.0_dp
    hst % var_avr_baseint(nvars) = 0.0_dp
!!$    call DCDiffTimeCreate( &
!!$      & hst % var_avr_baseint(nvars), & ! (out)
!!$      & sec = 0.0_DP )                   ! (in)
    hst % var_avr_prevtime(nvars) = hst % var_avr_baseint(nvars)
 
    !----- コピー元ファイルの変数 ID 取得 -----
    copyurl = urlmerge(file, varname)
    call open(copyfrom, copyurl)
 
    !----- 変数コピー -----
    call inquire(hst % dimvars(1), url=url)
    fullname = urlresolve((gt_atmark // trim(varname)), trim(url))
    overwrite_required = .true.
    if (present_and_false(overwrite)) overwrite_required = .false.
    call create(hst % vars(nvars), trim(fullname), copyfrom, &
      &      copyvalue=.false., overwrite=overwrite_required)
 
    !----- 無制限次元の添字を探査 -----
    call inquire(hst % vars(nvars), alldims=numdims)
    allocate(dimvars(numdims))
    ! 各次元毎に情報を取得し, growable == .TRUE. のもの (つまりは時間)
    ! の添字番号を取得する
    do, i = 1, numdims
      call open(var=dimvars(i), source_var=hst % vars(nvars), &
        &    dimord=i, count_compact=.true.)
      ! 各次元変数の growable を調べる
      call inquire(var=dimvars(i), growable=growable)
      if (growable) then
        hst % growable_indices(nvars) = i
      endif
    enddo
 
    !----- 拡張可能次元があったらそれをサイズ 1 に拡張しておく -----
    if (hst % growable_indices(nvars) /= 0) then
      call slice(hst % vars(nvars), hst % growable_indices(nvars), &
        & start=1, count=1, stride=1)
    endif
 
    deallocate(dimvars)
 
    call inquire( hst % vars(nvars), size = var_avr_length )
    allocate( hst % var_avr_data(nvars) % a_DataAvr(var_avr_length) )
    hst % var_avr_data(nvars) % length = var_avr_length
    hst % var_avr_data(nvars) % a_DataAvr = 0.0_dp
 
    call close(copyfrom)
    call endsub(subname)

References dc_trace::beginsub(), gtool_history_internal::default, dc_types::dp, dc_trace::endsub(), dc_url::gt_atmark, dc_present::present_and_false(), and dc_types::string.

Here is the call graph for this function: