gtvarcopyattr.f90

Go to the documentation of this file.

!> @file gtvarcopyattr.f90
!>
!> @author Eizi TOYODA, Yasuhiro MORIKAWA
!> @copyright Copyright (C) GFD Dennou Club, 2000-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. See [COPYRIGHT](@ref COPYRIGHT) in detail
!>
!> @en
!> @brief Copy attribute
!>
!> This subroutine is provided as gtdata_generic#Copy_Attr
!> through gtdata_generic.
!> @enden
!>
!> @ja
!> @brief 属性のコピー
!>
!> このサブルーチンは gtdata_generic から gtdata_generic#Copy_Attr
!> として提供されます。
!> @endja
!>
 
!>
!> @en
!> @brief Copy single attribute from one variable to another
!>
!> Copies attribute attrname of variable from to variable to.
!> If an error occurs during copying, outputs a message and
!> terminates the program. If err is provided, returns .true.
!> in that argument and program does not terminate.
!>
!> Copy_Attr is a generic name for 2 subroutines; there is also
!> a method to copy all attributes of a variable at once.
!> @param[inout] to       Destination variable handle
!> @param[in]    attrname Attribute name to copy
!> @param[in]    from     Source variable handle
!> @param[out]   err      Error flag (optional)
!> @enden
!>
!> @ja
!> @brief 1つの属性を変数間でコピー
!>
!> 変数 from の属性 attrname を変数 to へコピーします。
!> 属性のコピー時にエラーが生じた場合、メッセージを出力
!> してプログラムは強制終了します。err を与えてある場合には
!> の引数に .true. が返り、プログラムは終了しません。
!>
!> Copy_Attr は 2 つのサブルーチンの総称名であり、
!> 他にも一括で変数の全ての属性をコピーする方法もあります。
!> @param[inout] to       コピー先の変数ハンドル
!> @param[in]    attrname コピーする属性名
!> @param[in]    from     コピー元の変数ハンドル
!> @param[out]   err      エラーフラグ (省略可能)
!> @endja
!>
subroutine gtvarcopyattr(to, attrname, from, err)
  use gtdata_types, only: gt_variable
  use gtdata_generic, only: get_attr, put_attr
  use gtdata_internal_map, only: var_class, vtb_class_netcdf
  use gtdata_netcdf_generic, only: copy_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_trace, only: beginsub, endsub
  use dc_error, only: storeerror, dc_noerr
  use dc_types, only: string
  implicit none
  type(gt_variable), intent(inout):: to
  character(len = *), intent(in):: attrname
  type(gt_variable), intent(in):: from
  logical, intent(out), optional:: err
  character(STRING):: svalue
  integer:: from_class, from_cid, to_class, to_cid, stat
continue
  if (present(err)) err = .false.
  call beginsub('gtvarcopyattr', 'mapid to=%d from=%d name=%c', &
    & i=(/to%mapid, from%mapid/), c1=attrname)
  call var_class(from, from_class, from_cid)
  call var_class(to, to_class, to_cid)
  if (from_class == vtb_class_netcdf .and. to_class == vtb_class_netcdf) then
    call copy_attr(gd_nc_variable(to_cid), attrname, &
      & gd_nc_variable(from_cid), stat)
  else
    ! とりあえず文字列で入出力しておく
    call get_attr(from, attrname, svalue, default='')
    call put_attr(to, attrname, svalue, '', err)
    stat = dc_noerr
  endif
  call storeerror(stat, "GTVarCopyAttr", err)
  call endsub('gtvarcopyattr', 'stat = %d', i=(/stat/))
end subroutine gtvarcopyattr