gdncvarputattrchar.f90

Go to the documentation of this file.

!> @file gdncvarputattrchar.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 Put character attribute to netCDF variable
!>
!> These subroutines and functions are provided as gtdata_netcdf_generic#Put_Attr
!> through gtdata_netcdf_generic.
!> @enden
!>
!> @ja
!> @brief netCDF 変数に文字属性を設定
!>
!> これらのサブルーチン、関数は gtdata_netcdf_generic から
!> gtdata_netcdf_generic#Put_Attr として提供されます。
!> @endja
!>
 
!>
!> @en
!> @brief Set character attribute value
!>
!> Sets a character attribute on a variable. If xtype is specified,
!> the value is converted to that numeric type before storage.
!> If name starts with '+', it is treated as a global attribute.
!> Empty value deletes the attribute.
!> @enden
!>
!> @ja
!> @brief 文字属性値を設定
!>
!> 変数に文字属性を設定します。xtype が指定された場合、
!> 値はその数値型に変換されてから格納されます。
!> name が '+' で始まる場合、グローバル属性として扱われます。
!> 空の value は属性を削除します。
!> @endja
!>
!> @param[in]  var   @en Variable handle @enden @ja 変数ハンドル @endja
!> @param[in]  name  @en Attribute name @enden @ja 属性名 @endja
!> @param[in]  val   @en Character value to set @enden @ja 設定する文字値 @endja
!> @param[in]  xtype @en Target type for conversion (optional) @enden
!>                   @ja 変換先の型 (省略可能) @endja
!> @param[out] err   @en Error flag (optional) @enden @ja エラーフラグ (省略可能) @endja
!>
subroutine gdncvarputattrchar(var, name, val, xtype, err)
  use gtdata_netcdf_types, only: gd_nc_variable, gd_nc_variable_entry
  use gtdata_netcdf_internal, only: vtable_lookup
  use gtdata_netcdf_file_generic, only: gdncfiledefinemode
  use netcdf, only: &
    & nf90_global, &
    & nf90_noerr, &
    & nf90_put_att, &
    & nf90_del_att
  use dc_url, only: gt_plus
  use dc_error
  use dc_string, only: get_array
  use gtdata_netcdf_generic, only: put_attr
  implicit none
  type(gd_nc_variable), intent(in):: var
  character(len = *), intent(in):: name
  character(len = *), intent(in):: val
  character(len = *), intent(in), optional:: xtype
  logical, intent(out), optional:: err
  integer, pointer:: ip(:)
  real, pointer:: rp(:)
  double precision, pointer:: dp(:)
  integer:: stat
  type(gd_nc_variable_entry):: ent
continue
  stat = vtable_lookup(var, ent)
  if (stat /= nf90_noerr) goto 999
  if (len(val) == 0) then
    if (name(1:1) == gt_plus) then
      stat = nf90_del_att(ent%fileid, nf90_global, name = name(2:))
    else
      stat = nf90_del_att(ent%fileid, ent%varid, name = name)
    endif
    goto 999
  endif
  if ( present(xtype) ) then
    select case(xtype)
    case("INTEGER", "integer", "int")
      goto 200
    case("REAL", "real", "float")
      goto 300
    case("DOUBLEPRECISION", "DOUBLE", "double")
      goto 400
    end select
  end if
 
  stat = gdncfiledefinemode( ent % fileid )
  if (stat /= nf90_noerr) goto 999
  if (name(1:1) == gt_plus) then
    stat = nf90_put_att(ent%fileid, nf90_global, name(2:), trim(val) )
  else
    stat = nf90_put_att(ent%fileid, ent%varid, name, trim(val) )
  endif
 
999 continue
  call storeerror(stat, 'GDNcVarPutAttrChar', err, cause_c=name)
  return
 
200 continue
  call get_array(ip, val)
  if (associated(ip)) then
    call put_attr(var, name, ip, err)
    deallocate(ip)
  endif
  return
 
300 continue
  call get_array(rp, val)
  if (associated(rp)) then
    call put_attr(var, name, rp, err)
    deallocate(rp)
  endif
  return
 
400 continue
  call get_array(dp, val)
  if (associated(dp)) then
    call put_attr(var, name, dp, err)
    deallocate(dp)
  endif
  return
end subroutine gdncvarputattrchar