historycopyvariable.f90 File Reference

Go to the source code of this file.

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

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
	)

Definition at line 11 of file historycopyvariable.f90.

References dc_types::dp, dc_url::gt_atmark, dc_types::string, and dc_types::token.

    !
    !== 変数定義 (別ファイルの変数コピー)
    !
    ! gtool4 データ内の変数の定義を行います。 他の gtool4 データの
    ! ファイル名とその中の変数名を指定することで、 自動的のその変数の
    ! 構造や属性をコピーして変数定義します。このサブルーチンを
    ! 用いる前に、 HistoryCreate による初期設定が必要です。
    !
    ! 構造や属性を手動で設定する場合には HistoryAddVariable
    ! を用いて下さい。
    !
    use gtool_history_types, only: gt_history, gt_history_axis, gt_history_varinfo, gt_history_attr, 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_date, only: dcdifftimecreate
    use dc_date_types, only: dc_difftime
    use dc_types, only: string, token, dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    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)