historyvarinfocopy.f90

Go to the documentation of this file.

!> @file historyvarinfocopy.f90
!>
!> @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 a GT_HISTORY_VARINFO variable
!> @enden
!>
!> @ja
!> @brief GT_HISTORY_VARINFO 型変数コピー
!> @endja
 
!>
!> @en
!> @brief Copy a GT_HISTORY_VARINFO variable
!>
!> Copies varinfo_src to varinfo_dest.
!> varinfo_src must be initialized by HistoryVarinfoCreate.
!> Use HistoryVarinfoAddAttr to add further attributes.
!> If err is given, the program does not abort on error; instead err is set to .true.
!> Arguments after err are override values applied during the copy.
!> @param[out] varinfo_dest Destination GT_HISTORY_VARINFO variable
!> @param[in] varinfo_src Source GT_HISTORY_VARINFO variable
!> @param[out] err Exception handling flag (optional)
!> @param[in] name Variable name override (optional)
!> @param[in] dims Dependent dimensions override (optional)
!> @param[in] longname Descriptive name override (optional)
!> @param[in] units Units override (optional)
!> @param[in] xtype Type override (optional)
!> @enden
!>
!> @ja
!> @brief GT_HISTORY_VARINFO 型変数コピー
!>
!> GT_HISTORY_VARINFO 型の変数 varinfo_src を varinfo_dest にコピーします。
!> varinfo_src は HistoryVarinfoCreate によって初期設定されている必要があります。
!> さらに属性を付加する場合には HistoryVarinfoAddAttr を用いてください。
!> err を与えておくと、コピーの際何らかの不具合が生じても終了せずに err が真になって返ります。
!> err 以降の引数は、コピーの際に上書きする値です。
!> @param[out] varinfo_dest コピー先の GT_HISTORY_VARINFO 型変数
!> @param[in] varinfo_src コピー元の GT_HISTORY_VARINFO 型変数
!> @param[out] err 例外処理用フラグ (optional)
!> @param[in] name 次元変数名 (optional)
!> @param[in] dims 依存する次元 (optional)
!> @param[in] longname 次元変数の記述的名称 (optional)
!> @param[in] units 次元変数の単位 (optional)
!> @param[in] xtype 次元変数の型 (optional)
!> @endja
!>
  subroutine historyvarinfocopy1(varinfo_dest, varinfo_src, err, &
    & name, dims, longname, units, xtype )
    use gtool_history_types, only: gt_history_varinfo
    use gtool_history_internal, only: copy_attrs
    use dc_trace, only: beginsub, endsub, dbgmessage
    use dc_present,only: present_select
    use dc_string, only: joinchar
    use dc_error, only: storeerror, dc_noerr, dc_enotinit, dc_ealreadyinit
    use dc_types, only: string, token
    implicit none
    type(gt_history_varinfo),intent(out):: varinfo_dest
    type(gt_history_varinfo),intent(in):: varinfo_src
    logical, intent(out), optional:: err
    character(*) , intent(in), optional:: name     ! 次元変数名
    character(*) , intent(in), optional, target:: dims(:)  ! 依存する次元
    character(*) , intent(in), optional:: longname ! 次元変数の記述的名称
    character(*) , intent(in), optional:: units    ! 次元変数の単位
    character(*) , intent(in), optional:: xtype    ! 次元変数の型
 
    integer:: i, stat
    character(STRING):: cause_c
    character(TOKEN), pointer :: srcdims(:) =>null() ! 依存する次元
    character(STRING) :: name_tmp, xtype_tmp
    character(*), parameter:: subname = "HistoryVarinfoCopy1"
  continue
    call beginsub(subname)
    stat = dc_noerr
    cause_c = ''
 
    if ( .not. varinfo_src % initialized ) then
      stat = dc_enotinit
      cause_c = 'GT_HISTORY_VARINFO'
      goto 999
    end if
 
    if ( varinfo_dest % initialized ) then
      stat = dc_ealreadyinit
      cause_c = 'GT_HISTORY_VARINFO'
      goto 999
    end if
 
    name_tmp = present_select('', varinfo_src % name, name)
    varinfo_dest % name     = name_tmp(:len(varinfo_dest % name))
    varinfo_dest % longname = present_select('', varinfo_src % longname, longname)
    varinfo_dest % units    = present_select('', varinfo_src % units, units)
    xtype_tmp = present_select('', varinfo_src % xtype, xtype)
    varinfo_dest % xtype    = xtype_tmp(:len(varinfo_dest % xtype))
 
    if (present(dims)) then
      srcdims => dims
    else
      srcdims => varinfo_src % dims
    endif
 
    call dbgmessage('srcdims=<%c>', &
      & c1=trim(joinchar(srcdims)))
 
    allocate(  varinfo_dest % dims( size( srcdims ) )  )
    do i = 1, size(srcdims)
      varinfo_dest % dims(i) = srcdims(i)
    end do
 
    call dbgmessage('varinfo_dest %% dims=<%c>', &
      & c1=trim(joinchar(varinfo_dest % dims)))
 
    if (associated( varinfo_src % attrs ) ) then
      allocate(  varinfo_dest % attrs( size( varinfo_src % attrs) )  )
      call copy_attrs( from = varinfo_src % attrs, &
        &                to = varinfo_dest % attrs, err = err)
    end if
 
    varinfo_dest % initialized = .true.
999 continue
    call storeerror( stat, subname, err, cause_c )
    call endsub(subname)
  end subroutine historyvarinfocopy1
 
  subroutine historyvarinfocopy2(varinfo_dest, varinfo_src, err, &
    & name, dims, longname, units, xtype )
    !
    ! 使用方法は HistoryVarinfoCopy と同様です. 
    !
    ! Usage is same as "HistoryVarinfoCopy".
    !
    !--
    ! 総称名 Copy として提供するための関数です. 
    ! 機能は HistoryVarinfoCopy1 と同じです. 
    !++
    use gtool_history_types, only: gt_history_varinfo
    use gtool_history_generic, only: historyvarinfocopy
    use dc_trace, only: beginsub, endsub
    implicit none
    type(gt_history_varinfo),intent(out):: varinfo_dest
    type(gt_history_varinfo),intent(in):: varinfo_src
    logical, intent(out), optional:: err
    character(*) , intent(in), optional:: name     ! 次元変数名
    character(*) , intent(in), optional, target:: dims(:)  ! 依存する次元
    character(*) , intent(in), optional:: longname ! 次元変数の記述的名称
    character(*) , intent(in), optional:: units    ! 次元変数の単位
    character(*) , intent(in), optional:: xtype    ! 次元変数の型
 
    character(*), parameter:: subname = "HistoryVarinfoCopy2"
  continue
    call beginsub(subname)
    call historyvarinfocopy(varinfo_dest, varinfo_src, err, &
      & name, dims, longname, units, xtype )
    call endsub(subname)
  end subroutine historyvarinfocopy2