gdncvarattrcopy.f90

Go to the documentation of this file.

!> @file gdncvarattrcopy.f90
!>
!> @author GFD Dennou Club
!> @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 an attribute between netCDF variables
!> @enden
!>
!> @ja
!> @brief netCDF 変数間で属性をコピー
!> @endja
!>
 
!>
!> @en
!> @brief Copy a named attribute from one variable to another
!>
!> Copies an attribute from the source variable to the destination variable.
!> @enden
!>
!> @ja
!> @brief 指定された属性を変数間でコピー
!>
!> ソース変数からデスティネーション変数へ属性をコピーします。
!> @endja
!>
!> @param[in]  to       @en Destination variable handle @enden @ja コピー先変数ハンドル @endja
!> @param[in]  attrname @en Attribute name @enden @ja 属性名 @endja
!> @param[in]  from     @en Source variable handle @enden @ja コピー元変数ハンドル @endja
!> @param[out] stat     @en Status code @enden @ja ステータスコード @endja
!>
subroutine gdncvarattrcopy(to, attrname, from, stat)
  use gtdata_netcdf_types, only: gd_nc_variable, gd_nc_variable_entry
  use gtdata_netcdf_file_generic, only: gdncfiledefinemode
  use gtdata_netcdf_generic, only: inquireplus
  use gtdata_netcdf_internal, only: vtable_lookup
  use netcdf, only: nf90_noerr, nf90_max_name, nf90_copy_att
  use dc_error
  implicit none
  type(gd_nc_variable), intent(in):: to
  character(len = *), intent(in):: attrname
  type(gd_nc_variable), intent(in):: from
  integer, intent(out):: stat
  character(NF90_MAX_NAME):: nc_aname
  integer:: id_var_from, id_var_to
  logical:: myerr
  type(gd_nc_variable_entry):: to_ent, from_ent
  stat = vtable_lookup(to, to_ent)
  if (stat /= nf90_noerr) goto 999
  stat = vtable_lookup(from, from_ent)
  if (stat /= nf90_noerr) goto 999
  stat = gdncfiledefinemode(to_ent%fileid)
  if (stat /= nf90_noerr) goto 999
  call inquireplus(from, attrname, id_var_from, nc_aname)
  call inquireplus(to, attrname, id_var_to, nc_aname)
  stat = nf90_copy_att(from_ent%fileid, id_var_from, nc_aname, to_ent%fileid, id_var_to)
999 continue
  call storeerror(stat, "GDNcVarAttrCopy", myerr)
  return
end subroutine gdncvarattrcopy