File: gtvargetattr.f90

Public Instance methods

GTVarGetAttrD( var, attrname, value, [default] )

*Subroutine* :
`var` :	`type(GT_VARIABLE), intent(in)`
`attrname` :	`character(len = *), intent(in)`
`value` :	`real(DP), intent(out)`
`default` :	`real(DP), intent(in), optional`

[Source]

subroutine GTVarGetAttrD(var, attrname, value, default)
  use gtdata_types, only: GT_VARIABLE
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use an_generic, only: get_attr, an_variable
  use gt_mem, only: get_attr, mem_variable
  use dc_string, only: StoD
  use dc_error, only: GT_ENOTVAR, StoreError
  use dc_types, only: DP
  use netcdf_f77, only: NF_FILL_REAL
  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(an_variable(cid), attrname, value=buffer, stat=stat, default=default)
    value = buffer(1)
    if (stat >= 1) return
  case (vtb_class_memory)
    call get_attr(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 = NF_FILL_REAL
  if (present(default)) value = default
end subroutine

GTVarGetAttrDA( var, name, value, default )

*Subroutine* :
`var` :	`type(GT_VARIABLE), intent(in)`
`name` :	`character(len = *), intent(in)`
`value(:)` :	`real(DP), intent(out)`
`default` :	`real(DP), intent(in)`

[Source]

subroutine GTVarGetAttrDA(var, name, value, default)
  use gtdata_types, only: GT_VARIABLE
  use gtdata_generic, only: friend => get_attr
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use an_generic, only: get_attr, an_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(an_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
end subroutine GTVarGetAttrDA

GTVarGetAttrDP( var, name, value )

Subroutine :

var : type(GT_VARIABLE), intent(in)

name : character(len = *), intent(in)

value(:) :

real(DP), pointer

(out)

[Source]

subroutine GTVarGetAttrDP(var, name, value)
  use gtdata_types, only: GT_VARIABLE
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use an_generic, only: get_attr, an_variable
  use gt_mem, only: get_attr, 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(an_variable(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(an_variable(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else if (class == vtb_class_memory) then
    call get_attr(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
end subroutine GTVarGetAttrDP

GTVarGetAttrI( var, attrname, value, [default] )

*Subroutine* :
`var` :	`type(GT_VARIABLE), intent(in)`
`attrname` :	`character(len = *), intent(in)`
`value` :	`integer, intent(out)`
`default` :	`integer, intent(in), optional`

属性の入力

変数 var に付加されている属性 name の値を返します。 Get_Attr は複数のサブルーチンの総称名なので、 value には様々な型の変数 (ポインタも可能) を与えることが可能です。以下のサブルーチンを参照してください。

属性の値が正常に取得できず、且つ default が与えられていた場合、その値が返ります。 default が与えられない場合のデフォルトの値はそれぞれ以下の通りです。

character :	"" (空文字)
real :	netcdf_f77#NF_FILL_REAL
real(DP) :	netcdf_f77#NF_FILL_REAL
integer :	netcdf_f77#NF_FILL_INT

value がポインタの場合は、型に依らず空状態が返ります。

value にポインタを与えた場合、属性の値に応じて自動的に割り付けが行われます。そのため、必ず空状態にしてから与えてください。

value に固定長配列を用意する場合 default が必須になりますが、これは Fortran の言語仕様上ポインタ方式と引用仕様が同じであってはならないからです。

[Source]

subroutine GTVarGetAttrI(var, attrname, value, default)
  !
  !== 属性の入力
  !
  ! 変数 *var* に付加されている属性 *name* の値を返します。
  ! *Get_Attr* は複数のサブルーチンの総称名なので、
  ! *value* には様々な型の変数 (ポインタも可能)
  ! を与えることが可能です。
  ! 以下のサブルーチンを参照してください。
  !
  ! 属性の値が正常に取得できず、且つ *default* が与えられて
  ! いた場合、その値が返ります。
  ! *default* が与えられない場合のデフォルトの値はそれぞれ以下の
  ! 通りです。
  !
  ! character :: "" (空文字)
  ! real      :: netcdf_f77#NF_FILL_REAL
  ! real(DP)  :: netcdf_f77#NF_FILL_REAL
  ! integer   :: netcdf_f77#NF_FILL_INT
  !
  ! *value* がポインタの場合は、型に依らず空状態が返ります。
  !
  ! *value* にポインタを与えた場合、属性の値に応じて自動的に
  ! 割り付けが行われます。そのため、必ず空状態にしてから与えてください。
  !
  ! *value* に固定長配列を用意する場合 *default* が必須になりますが、
  ! これは Fortran の言語仕様上ポインタ方式と引用仕様が同じであっては
  ! ならないからです。
  !
  use gtdata_types, only: GT_VARIABLE
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use an_generic, only: get_attr, an_variable
  use gt_mem, only: get_attr, mem_variable
  use netcdf_f77, only: NF_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(an_variable(cid), attrname, buffer, stat, default)
    value = buffer(1)
    if (stat >= 1) return
  else if (class == vtb_class_memory) then
    call get_attr(mem_variable(cid), attrname, cbuffer, err)
    if (.not. err) then
      value = StoI(cbuffer)
      return
    endif
  else
    call StoreError(GT_ENOTVAR, "GTVarGetAttrI")
  endif
  value = NF_FILL_INT
  if (present(default)) value = default
end subroutine GTVarGetAttrI

GTVarGetAttrIA( var, name, value, stat, default )

*Subroutine* :
`var` :	`type(GT_VARIABLE), intent(in)`
`name` :	`character(len = *), intent(in)`
`value(:)` :	`integer, intent(out)`
`stat` :	`integer`
`default` :	`integer, intent(in)`

[Source]

subroutine GTVarGetAttrIA(var, name, value, stat, default)
  use gtdata_types, only: GT_VARIABLE
  use gtdata_generic, only: friend => get_attr
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use an_generic, only: get_attr, an_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(an_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
end subroutine GTVarGetAttrIA

GTVarGetAttrIP( var, name, value )

Subroutine :

var : type(GT_VARIABLE), intent(in)

name : character(len = *), intent(in)

value(:) :

integer, pointer

(out)

[Source]

subroutine GTVarGetAttrIP(var, name, value)
  use gtdata_types, only: GT_VARIABLE
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use an_generic, only: get_attr, an_variable
  use gt_mem, only: get_attr, 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(an_variable(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(an_variable(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else if (class == vtb_class_memory) then
    call get_attr(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
end subroutine GTVarGetAttrIP

GTVarGetAttrR( var, attrname, value, [default] )

*Subroutine* :
`var` :	`type(GT_VARIABLE), intent(in)`
`attrname` :	`character(len = *), intent(in)`
`value` :	`real, intent(out)`
`default` :	`real, intent(in), optional`

[Source]

subroutine GTVarGetAttrR(var, attrname, value, default)
  use gtdata_types, only: GT_VARIABLE
  use an_generic, only: get_attr, an_variable
  use gt_mem, only: get_attr, mem_variable
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use dc_error, only: GT_EBADVAR, StoreError
  use dc_string, only: StoD
  use netcdf_f77, only: NF_FILL_REAL
  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(an_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(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 = NF_FILL_REAL
  endif
end subroutine GTVarGetAttrR

GTVarGetAttrRA( var, name, value, default )

*Subroutine* :
`var` :	`type(GT_VARIABLE), intent(in)`
`name` :	`character(len = *), intent(in)`
`value(:)` :	`real, intent(out)`
`default` :	`real, intent(in)`

[Source]

subroutine GTVarGetAttrRA(var, name, value, default)
  use gtdata_types, only: GT_VARIABLE
  use gtdata_generic, only: friend => get_attr
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use an_generic, only: get_attr, an_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(an_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
end subroutine GTVarGetAttrRA

GTVarGetAttrRP( var, name, value )

Subroutine :

var : type(GT_VARIABLE), intent(in)

name : character(len = *), intent(in)

value(:) :

real, pointer

(out)

[Source]

subroutine GTVarGetAttrRP(var, name, value)
  use gtdata_types, only: GT_VARIABLE
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use an_generic, only: get_attr, an_variable
  use gt_mem, only: get_attr, 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(an_variable(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(an_variable(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else if (class == vtb_class_memory) then
    call get_attr(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
end subroutine GTVarGetAttrRP

Authors:	Eizi TOYODA, Yasuhiro MORIKAWA
Version:	$Id: gtvargetattr.f90,v 1.4 2006/07/17 15:46:47 morikawa Exp $
Tag Name:	$Name: gt4f90io-20070101 $
Copyright:	Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
License:	See COPYRIGHT

gtvargetattr.f90

数値型属性の入力

Required files

Methods

Included Modules

Public Instance methods

属性の入力