gtvargetattr.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	gtvargetattri (var, attrname, value, default)
subroutine	gtvargetattrr (var, attrname, value, default)
subroutine	gtvargetattrd (var, attrname, value, default)
subroutine	gtvargetattrip (var, name, value)
subroutine	gtvargetattrrp (var, name, value)
subroutine	gtvargetattrdp (var, name, value)
subroutine	gtvargetattria (var, name, value, default)
subroutine	gtvargetattrra (var, name, value, default)
subroutine	gtvargetattrda (var, name, value, default)

Function/Subroutine Documentation

gtvargetattrd()

subroutine gtvargetattrd	(	type(gt_variable), intent(in)	var,
		character(len = *), intent(in)	attrname,
		real(dp), intent(out)	value,
		real(dp), intent(in), optional	default
	)

Definition at line 133 of file gtvargetattr.f90.

References dc_types::dp, dc_error::gt_enotvar, dc_error::storeerror(), dc_types::string, and gtdata_internal_map::var_class().

  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: gd_mem_variable
  use dc_string, only: stod
  use dc_error, only: gt_enotvar, storeerror
  use dc_types, only: dp
  use netcdf, only: nf90_fill_double
  use dc_types, only: string
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: attrname
  real(DP), intent(out):: value
  real(DP), intent(in), optional:: default
  integer:: stat
  real(DP):: buffer(1)
  character(STRING):: cbuffer
  integer:: class, cid
  logical:: err
continue
  call var_class(var, class, cid)
  select case(class)
  case (vtb_class_netcdf)
    call get_attr(gd_nc_variable(cid), attrname, value=buffer, &
      & stat=stat, default=default)
    if (stat >= 1) then
      value = buffer(1)
      return
    end if
  case (vtb_class_memory)
    call get_attr(gd_mem_variable(cid), attrname, cbuffer, err)
    if (.not. err) then
      value = stod(cbuffer)
      return
    endif
  case default
    call storeerror(gt_enotvar, "GTVarGetAttrR")
  end select
  value = nf90_fill_double
  if (present(default)) value = default

Here is the call graph for this function:

gtvargetattrda()

subroutine gtvargetattrda	(	type(gt_variable), intent(in)	var,
		character(len = *), intent(in)	name,
		real(dp), dimension(:), intent(out)	value,
		real(dp), intent(in)	default
	)

Definition at line 374 of file gtvargetattr.f90.

References dc_types::dp, dc_error::gt_enotvar, dc_error::storeerror(), and gtdata_internal_map::var_class().

  use gtdata_types, only: gt_variable
  use gtdata_generic, only: friend => get_attr
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_types, only: dp
  use dc_error, only: gt_enotvar, storeerror
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  real(DP), intent(out):: value(:)
  real(DP), intent(in):: default
  real(DP), pointer:: ptr(:)
  integer:: n, stat, class, cid
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(gd_nc_variable(cid), name, value, stat, default)
  else if (class == vtb_class_memory) then
    call friend(var, name, ptr)
    if (.not. associated(ptr)) then
      value(:) = default
    else
      n = min(size(ptr), size(value))
      value(1:n) = ptr(1:n)
      if (n < size(ptr)) value(n+1: ) = default
      deallocate(ptr)
    endif
  else
    call storeerror(gt_enotvar, "GTVarGetAttrRA")
  endif

Here is the call graph for this function:

gtvargetattrdp()

subroutine gtvargetattrdp	(	type(gt_variable), intent(in)	var,
		character(len = *), intent(in)	name,
		real(dp), dimension(:), pointer	value
	)

Definition at line 263 of file gtvargetattr.f90.

References dc_types::dp, dc_error::gt_enotvar, dc_error::storeerror(), dc_types::string, and gtdata_internal_map::var_class().

  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: gd_mem_variable
  use dc_types, only: dp
  use dc_error, only: gt_enotvar, storeerror
  use dc_string, only: get_array
  use dc_types, only: string
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  real(DP), pointer:: value(:) !(out)
  integer:: stat, class, cid
  character(STRING):: cbuffer
  logical:: err
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    allocate(value(1))
    call get_attr(gd_nc_variable(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(gd_nc_variable(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else if (class == vtb_class_memory) then
    call get_attr(gd_mem_variable(cid), name, cbuffer, err)
    if (err) then
      nullify(value)
      return
    endif
    call get_array(value, cbuffer)
    cbuffer = ""
  else
    call storeerror(gt_enotvar, "GTVarGetAttrRP")
  endif

Here is the call graph for this function:

gtvargetattri()

subroutine gtvargetattri	(	type(gt_variable), intent(in)	var,
		character(len = *), intent(in)	attrname,
		integer, intent(out)	value,
		integer, intent(in), optional	default
	)

Definition at line 19 of file gtvargetattr.f90.

References dc_error::gt_enotvar, dc_error::storeerror(), dc_types::string, and gtdata_internal_map::var_class().

  !
  !== 属性の入力
  !
  ! 変数 *var* に付加されている属性 *name* の値を返します。
  ! *Get_Attr* は複数のサブルーチンの総称名なので、
  ! *value* には様々な型の変数 (ポインタも可能)
  ! を与えることが可能です。
  ! 以下のサブルーチンを参照してください。
  !
  ! 属性の値が正常に取得できず、且つ *default* が与えられて
  ! いた場合、その値が返ります。
  ! *default* が与えられない場合のデフォルトの値はそれぞれ以下の
  ! 通りです。
  !
  ! character :: "" (空文字)
  ! real      :: netcdf_f77#NF90_FILL_REAL
  ! real(DP)  :: netcdf_f77#NF90_FILL_DOUBLE
  ! integer   :: netcdf_f77#NF90_FILL_INT
  !
  ! *value* がポインタの場合は、型に依らず空状態が返ります。
  !
  ! *value* にポインタを与えた場合、属性の値に応じて自動的に
  ! 割り付けが行われます。そのため、必ず空状態にしてから与えてください。
  !
  ! *value* に固定長配列を用意する場合 *default* が必須になりますが、
  ! これは Fortran の言語仕様上ポインタ方式と引用仕様が同じであっては
  ! ならないからです。
  !
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: gd_mem_variable
  use netcdf, only: nf90_fill_int
  use dc_string, only: stoi
  use dc_error, only: gt_enotvar, storeerror
  use dc_types, only: string
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: attrname
  integer, intent(out):: value
  integer, intent(in), optional:: default
  integer:: stat, buffer(1), class, cid
  character(STRING):: cbuffer
  logical:: err
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(gd_nc_variable(cid), attrname, buffer, stat, default)
    if (stat >= 1) then
      value = buffer(1)
      return
    end if
  else if (class == vtb_class_memory) then
    call get_attr(gd_mem_variable(cid), attrname, cbuffer, err)
    if (.not. err) then
      value = stoi(cbuffer)
      return
    endif
  else
    call storeerror(gt_enotvar, "GTVarGetAttrI")
  endif
  value = nf90_fill_int
  if (present(default)) value = default

Here is the call graph for this function:

gtvargetattria()

subroutine gtvargetattria	(	type(gt_variable), intent(in)	var,
		character(len = *), intent(in)	name,
		integer, dimension(:), intent(out)	value,
		integer, intent(in)	default
	)

Definition at line 308 of file gtvargetattr.f90.

References dc_error::gt_enotvar, dc_error::storeerror(), and gtdata_internal_map::var_class().

  use gtdata_types, only: gt_variable
  use gtdata_generic, only: friend => get_attr
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_error, only: gt_enotvar, storeerror
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  integer, intent(out):: value(:)
  integer, intent(in):: default
  integer, pointer:: ptr(:)
  integer:: n, stat, class, cid
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(gd_nc_variable(cid), name, value, stat, default)
  else if (class == vtb_class_memory) then
    call friend(var, name, ptr)
    if (.not. associated(ptr)) then
      value(:) = default
    else
      n = min(size(ptr), size(value))
      value(1:n) = ptr(1:n)
      if (n < size(ptr)) value(n+1: ) = default
      deallocate(ptr)
    endif
  else
    call storeerror(gt_enotvar, "GTVarGetAttrIA")
  endif

Here is the call graph for this function:

gtvargetattrip()

subroutine gtvargetattrip	(	type(gt_variable), intent(in)	var,
		character(len = *), intent(in)	name,
		integer, dimension(:), pointer	value
	)

Definition at line 182 of file gtvargetattr.f90.

References dc_error::gt_enotvar, dc_error::storeerror(), dc_types::string, and gtdata_internal_map::var_class().

  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: gd_mem_variable
  use dc_error, only: gt_enotvar, storeerror
  use dc_string, only: get_array
  use dc_types, only: string
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  integer, pointer:: value(:) !(out)
  integer:: stat, class, cid
  character(STRING):: cbuffer
  logical:: err
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    allocate(value(1))
    call get_attr(gd_nc_variable(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(gd_nc_variable(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else if (class == vtb_class_memory) then
    call get_attr(gd_mem_variable(cid), name, cbuffer, err)
    if (err) then
      nullify(value)
      return
    endif
    call get_array(value, cbuffer)
    cbuffer = ""
  else
    call storeerror(gt_enotvar, "GTVarGetAttrIP")
  endif

Here is the call graph for this function:

gtvargetattrr()

subroutine gtvargetattrr	(	type(gt_variable), intent(in)	var,
		character(len = *), intent(in)	attrname,
		real, intent(out)	value,
		real, intent(in), optional	default
	)

Definition at line 87 of file gtvargetattr.f90.

References dc_error::gt_ebadvar, dc_error::storeerror(), dc_types::string, and gtdata_internal_map::var_class().

  use gtdata_types, only: gt_variable
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: gd_mem_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use dc_error, only: gt_ebadvar, storeerror
  use dc_string, only: stod
  use netcdf, only: nf90_fill_float
  use dc_types, only: string
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: attrname
  real, intent(out):: value
  real, intent(in), optional:: default
  integer:: stat
  real:: buffer(1)
  character(STRING):: cbuffer
  integer:: class, cid
  logical:: err
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(gd_nc_variable(cid), attrname, value=buffer, &
      & stat=stat, default=default)
    if (stat >= 1) then
      value = buffer(1)
      return
    endif
  else if (class == vtb_class_memory) then
    call get_attr(gd_mem_variable(cid), attrname, cbuffer, err)
    if (.not. err) then
      value = stod(cbuffer)
      return
    endif
  else
    call storeerror(gt_ebadvar, "GTVarGetAttrR")
  endif
  if (present(default)) then
    value = default
  else
    value = nf90_fill_float
  endif

Here is the call graph for this function:

gtvargetattrra()

subroutine gtvargetattrra	(	type(gt_variable), intent(in)	var,
		character(len = *), intent(in)	name,
		real, dimension(:), intent(out)	value,
		real, intent(in)	default
	)

Definition at line 341 of file gtvargetattr.f90.

References dc_error::gt_enotvar, dc_error::storeerror(), and gtdata_internal_map::var_class().

  use gtdata_types, only: gt_variable
  use gtdata_generic, only: friend => get_attr
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_error, only: gt_enotvar, storeerror
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  real, intent(out):: value(:)
  real, intent(in):: default
  real, pointer:: ptr(:)
  integer:: n, class, cid, stat
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(gd_nc_variable(cid), name, value, stat, default)
  else if (class == vtb_class_memory) then
    call friend(var, name, ptr)
    if (.not. associated(ptr)) then
      value(:) = default
    else
      n = min(size(ptr), size(value))
      value(1:n) = ptr(1:n)
      if (n < size(ptr)) value(n+1: ) = default
      deallocate(ptr)
    endif
  else
    call storeerror(gt_enotvar, "GTVarGetAttrRA")
  endif

Here is the call graph for this function:

gtvargetattrrp()

subroutine gtvargetattrrp	(	type(gt_variable), intent(in)	var,
		character(len = *), intent(in)	name,
		real, dimension(:), pointer	value
	)

Definition at line 222 of file gtvargetattr.f90.

References dc_error::gt_enotvar, dc_error::storeerror(), dc_types::string, and gtdata_internal_map::var_class().

  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: gd_mem_variable
  use dc_string, only: get_array
  use dc_error, only: gt_enotvar, storeerror
  use dc_types, only: string
  implicit none
  type(gt_variable), intent(in):: var
  character(len = *), intent(in):: name
  real, pointer:: value(:) !(out)
  integer:: stat, class, cid
  character(STRING):: cbuffer
  logical:: err
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    allocate(value(1))
    call get_attr(gd_nc_variable(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(gd_nc_variable(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else if (class == vtb_class_memory) then
    call get_attr(gd_mem_variable(cid), name, cbuffer, err)
    if (err) then
      nullify(value)
      return
    endif
    call get_array(value, cbuffer)
    cbuffer = ""
  else
    nullify(value)
    call storeerror(gt_enotvar, "GTVarGetAttrRP")
  endif

Here is the call graph for this function: