gtvaraddmember.f90

Go to the documentation of this file.

!> @file gtvaraddmember.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 Add gt_structure_member attribute to structure variable
!>
!> This subroutine is provided as gtdata_generic#Add_Member
!> through gtdata_generic.
!> @enden
!>
!> @ja
!> @brief 構造型変数の gt_structure_member 属性の追加
!>
!> このサブルーチンは gtdata_generic から gtdata_generic#Add_Member
!> として提供されます。
!> @endja
!>
 
!>
!> @en
!> @brief Add member to structure variable
!>
!> Adds the variable name part of member_url to the gt_structure_member
!> attribute of variable var (see "4. Structure Variables" in
!> gtool4 netCDF Convention).
!> @param[inout] var        Variable handle
!> @param[in]    member_url URL of member variable to add
!> @param[in]    link_name  Link name (optional)
!> @enden
!>
!> @ja
!> @brief 構造型変数にメンバを追加
!>
!> 変数 var の gt_structure_member 属性 (gtool4 netCDF 規約の
!> 「4. 構造体変数」参照) に member_url の変数名部分を追加します。
!> @param[inout] var        変数ハンドル
!> @param[in]    member_url 追加するメンバ変数のURL
!> @param[in]    link_name  リンク名 (省略可能)
!> @endja
!>
subroutine gtvaraddmember(var, member_url, link_name)
  use gtdata_types, only: gt_variable
  use dc_types, only: string
  use dc_url, only: urlsplit
  use gtdata_generic, only: put_attr, get_attr
  use dc_error
  implicit none
  type(gt_variable), intent(inout):: var
  character(len = *), intent(in):: member_url
  character(len = *), intent(in), optional:: link_name
  character(len = string):: members, myshortname, conv
continue
  ! 短縮名称の決定
  ! 既存のメンバ名に重複しないものを選ぶ
  call get_attr(var, 'gt_structure_member', members)
  if (present(link_name)) then
    if (index(members, ' ' //link_name) == 0) then
      myshortname = link_name
      goto 1000
    endif
  endif
  conv = member_url
  call urlsplit(conv, var=myshortname)
  ! fake 判定
  if (index(members, trim(myshortname)) /= 0) then
    call storeerror(gt_efake, "GTVarAddMember(making unique name)")
  endif
1000 continue
  members = trim(members) // ' ' // trim(myshortname)
  call put_attr(var, 'gt_structure_member', trim(members))
  myshortname = 'gt_structure_link_' // trim(myshortname)
  call put_attr(var, myshortname, trim(member_url))
 
end subroutine gtvaraddmember