gdncattrgetnum.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	gdncattrgetint (var, name, value, stat, default)
subroutine	gdncattrgetreal (var, name, value, stat, default)
subroutine	gdncattrgetdouble (var, name, value, stat, default)

Function/Subroutine Documentation

gdncattrgetdouble()

subroutine gdncattrgetdouble	(	type(gd_nc_variable), intent(in)	var,
		character(len = *), intent(in)	name,
		real(dp), dimension(:), intent(out)	value,
		integer, intent(out)	stat,
		real(dp), intent(in), optional	default
	)

Definition at line 200 of file gdncattrgetnum.f90.

References dc_types::dp, dc_url::gt_plus, dc_types::string, and gtdata_netcdf_internal::vtable_lookup().

  use gtdata_netcdf_types,   only: gd_nc_variable, gd_nc_variable_entry
  use gtdata_netcdf_internal,only: vtable_lookup
  use netcdf, only: &
    & nf90_noerr, &
    & nf90_global, &
    & nf90_char, &
    & nf90_enomem, &
    & nf90_inquire_attribute, &
    & nf90_get_att
  use dc_url,     only: gt_plus
  use gtdata_netcdf_generic, only: get_attr
  use dc_types,   only: string, dp
  use dc_string
  implicit none
  type(gd_nc_variable),       intent(in) :: var
  character(len = *),      intent(in) :: name
  integer,            intent(out):: stat
  real(DP), intent(out):: value(:)
  real(DP),  intent(in), optional:: default
  real(DP),  allocatable:: rbuffer(:)
  character(STRING)      :: cbuffer
  character(STRING), pointer :: lbuffer(:)
  integer           :: attrlen, xtype, i, xferend, iname, varid
  type(gd_nc_variable_entry):: ent
  continue
  stat = vtable_lookup(var, ent)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 型と長さを取得
  if (name(1:1) == gt_plus) then
    iname = 2
    varid = nf90_global
  else
    iname = 1
    varid = ent%varid
  endif
  stat = nf90_inquire_attribute(ent%fileid, varid, &
    name = name(iname:), xtype = xtype, len = attrlen)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 文字型の場合は長さをコンマで分解した語数と読み替える
  if (xtype == nf90_char) then
    call get_attr(var, name, cbuffer, "", stat)
    if (stat /= 0) return
    call split(cbuffer, lbuffer, ", ")
    attrlen = size(lbuffer)
  endif
  ! 結果を入れるところがなければ長さだけを伝え終了
  if (size(value) == 0) then
    if (xtype == nf90_char) deallocate(lbuffer)
    stat = attrlen
    return
  endif
  ! 型に応じて要求されただけ値を転送
  xferend = min(size(value), attrlen)
  if (present(default)) value(xferend+1: ) = default
  if (xtype == nf90_char) then
    do, i = 1, xferend
      value(i) = stod(lbuffer(i))
    enddo
    deallocate(lbuffer)
    stat = attrlen
    return
  else
    allocate(rbuffer(attrlen), stat=stat)
    if (stat /= 0) then
      stat = nf90_enomem
      return
    endif
    stat = nf90_get_att(ent%fileid, varid, name(iname:), rbuffer)
    if (stat == nf90_noerr) then
      value(1:xferend) = rbuffer(1:xferend)
      stat = attrlen
    endif
    deallocate(rbuffer)
    return
  endif

Here is the call graph for this function:

gdncattrgetint()

subroutine gdncattrgetint	(	type(gd_nc_variable), intent(in)	var,
		character(len = *), intent(in)	name,
		integer, dimension(:), intent(out)	value,
		integer, intent(out)	stat,
		integer, intent(in), optional	default
	)

Definition at line 32 of file gdncattrgetnum.f90.

References dc_url::gt_plus, dc_types::string, and gtdata_netcdf_internal::vtable_lookup().

  use gtdata_netcdf_types,   only: gd_nc_variable, gd_nc_variable_entry
  use gtdata_netcdf_internal,only: vtable_lookup
  use netcdf, only: &
    & nf90_noerr, &
    & nf90_global, &
    & nf90_char, &
    & nf90_enomem, &
    & nf90_inquire_attribute, &
    & nf90_get_att
  use dc_url,     only: gt_plus
  use gtdata_netcdf_generic, only: get_attr
  use dc_types,   only: string
  use dc_string
  implicit none
  type(gd_nc_variable),       intent(in) :: var
  character(len = *),      intent(in) :: name
  integer,            intent(out):: stat
  integer, intent(out):: value(:)
  integer,  intent(in), optional:: default
  integer,  allocatable:: rbuffer(:)
  character(STRING)      :: cbuffer
  character(STRING), pointer :: lbuffer(:)
  integer           :: attrlen, xtype, i, xferend, iname, varid
  type(gd_nc_variable_entry):: ent
  continue
  stat = vtable_lookup(var, ent)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 型と長さを取得
  if (name(1:1) == gt_plus) then
    iname = 2
    varid = nf90_global
  else
    iname = 1
    varid = ent%varid
  endif
  stat = nf90_inquire_attribute(ent%fileid, varid, &
    name = name(iname:), xtype = xtype, len = attrlen)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 文字型の場合は長さをコンマで分解した語数と読み替える
  if (xtype == nf90_char) then
    call get_attr(var, name, cbuffer, "", stat)
    if (stat /= 0) return
    call split(cbuffer, lbuffer, ", ")
    attrlen = size(lbuffer)
  endif
  ! 結果を入れるところがなければ長さだけを伝え終了
  if (size(value) == 0) then
    if (xtype == nf90_char) deallocate(lbuffer)
    stat = attrlen
    return
  endif
  ! 型に応じて要求されただけ値を転送
  xferend = min(size(value), attrlen)
  if (present(default)) value(xferend+1: ) = default
  if (xtype == nf90_char) then
    do, i = 1, xferend
      value(i) = stod(lbuffer(i))
    enddo
    deallocate(lbuffer)
    stat = attrlen
    return
  else
    allocate(rbuffer(attrlen), stat=stat)
    if (stat /= 0) then
      stat = nf90_enomem
      return
    endif
    stat = nf90_get_att(ent%fileid, varid, name(iname:), rbuffer)
    if (stat == nf90_noerr) then
      value(1:xferend) = rbuffer(1:xferend)
      stat = attrlen
    endif
    deallocate(rbuffer)
    return
  endif

Here is the call graph for this function:

gdncattrgetreal()

subroutine gdncattrgetreal	(	type(gd_nc_variable), intent(in)	var,
		character(len = *), intent(in)	name,
		real(sp), dimension(:), intent(out)	value,
		integer, intent(out)	stat,
		real(sp), intent(in), optional	default
	)

Definition at line 116 of file gdncattrgetnum.f90.

References dc_url::gt_plus, dc_types::sp, dc_types::string, and gtdata_netcdf_internal::vtable_lookup().

  use gtdata_netcdf_types,   only: gd_nc_variable, gd_nc_variable_entry
  use gtdata_netcdf_internal,only: vtable_lookup
  use netcdf, only: &
    & nf90_noerr, &
    & nf90_global, &
    & nf90_char, &
    & nf90_enomem, &
    & nf90_inquire_attribute, &
    & nf90_get_att
  use dc_url,     only: gt_plus
  use gtdata_netcdf_generic, only: get_attr
  use dc_types,   only: string, sp
  use dc_string
  implicit none
  type(gd_nc_variable),       intent(in) :: var
  character(len = *),      intent(in) :: name
  integer,            intent(out):: stat
  real(SP), intent(out):: value(:)
  real(SP),  intent(in), optional:: default
  real(SP),  allocatable:: rbuffer(:)
  character(STRING)      :: cbuffer
  character(STRING), pointer :: lbuffer(:)
  integer           :: attrlen, xtype, i, xferend, iname, varid
  type(gd_nc_variable_entry):: ent
  continue
  stat = vtable_lookup(var, ent)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 型と長さを取得
  if (name(1:1) == gt_plus) then
    iname = 2
    varid = nf90_global
  else
    iname = 1
    varid = ent%varid
  endif
  stat = nf90_inquire_attribute(ent%fileid, varid, &
    name = name(iname:), xtype = xtype, len = attrlen)
  if (stat /= nf90_noerr) then
    if (present(default)) value(:) = default
    return
  endif
  ! 文字型の場合は長さをコンマで分解した語数と読み替える
  if (xtype == nf90_char) then
    call get_attr(var, name, cbuffer, "", stat)
    if (stat /= 0) return
    call split(cbuffer, lbuffer, ", ")
    attrlen = size(lbuffer)
  endif
  ! 結果を入れるところがなければ長さだけを伝え終了
  if (size(value) == 0) then
    if (xtype == nf90_char) deallocate(lbuffer)
    stat = attrlen
    return
  endif
  ! 型に応じて要求されただけ値を転送
  xferend = min(size(value), attrlen)
  if (present(default)) value(xferend+1: ) = default
  if (xtype == nf90_char) then
    do, i = 1, xferend
      value(i) = stod(lbuffer(i))
    enddo
    deallocate(lbuffer)
    stat = attrlen
    return
  else
    allocate(rbuffer(attrlen), stat=stat)
    if (stat /= 0) then
      stat = nf90_enomem
      return
    endif
    stat = nf90_get_att(ent%fileid, varid, name(iname:), rbuffer)
    if (stat == nf90_noerr) then
      value(1:xferend) = rbuffer(1:xferend)
      stat = attrlen
    endif
    deallocate(rbuffer)
    return
  endif

Here is the call graph for this function: