Path: | gtvargetattr.f90 |
Last Update: | Sun Jan 15 16:10:30 JST 2006 |
Authors: | Eizi TOYODA, Yasuhiro MORIKAWA |
Version: | $Id: gtvargetattr.f90,v 1.3 2006/01/15 07:10:30 morikawa Exp $ |
Tag Name: | $Name: gt4f90io-20060618 $ |
Copyright: | Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. |
License: | See COPYRIGHT |
以下のサブルーチン, 関数は gtdata_generic から提供されます。
Subroutine : | |
var : | type(GT_VARIABLE), intent(in) |
attrname : | character(len = *), intent(in) |
value : | real(DP), intent(out) |
default : | real(DP), intent(in), optional |
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: VSTRING, assignment(=), stod use dc_error, only: GT_ENOTVAR, StoreError use dc_types, only: DP use netcdf_f77, only: NF_FILL_REAL 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) type(VSTRING):: 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
Subroutine : | |
var : | type(GT_VARIABLE), intent(in) |
name : | character(len = *), intent(in) |
value(:) : | real(DP), intent(out) |
default : | real(DP), intent(in) |
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
Subroutine : | |||
var : | type(GT_VARIABLE), intent(in) | ||
name : | character(len = *), intent(in) | ||
value(:) : | real(DP), pointer
|
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: VSTRING, get_array, assignment(=) implicit none type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name real(DP), pointer:: value(:) !(out) integer:: stat, class, cid type(VSTRING):: 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
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 の言語仕様上ポインタ方式と引用仕様が同じであっては ならないからです。
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: VSTRING, assignment(=), stoi use dc_error, only: GT_ENOTVAR, StoreError 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 type(VSTRING):: 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
Subroutine : | |
var : | type(GT_VARIABLE), intent(in) |
name : | character(len = *), intent(in) |
value(:) : | integer, intent(out) |
stat : | integer |
default : | integer, intent(in) |
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
Subroutine : | |||
var : | type(GT_VARIABLE), intent(in) | ||
name : | character(len = *), intent(in) | ||
value(:) : | integer, pointer
|
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: VSTRING, get_array, assignment(=) implicit none type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name integer, pointer:: value(:) !(out) integer:: stat, class, cid type(VSTRING):: 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
Subroutine : | |
var : | type(GT_VARIABLE), intent(in) |
attrname : | character(len = *), intent(in) |
value : | real, intent(out) |
default : | real, intent(in), optional |
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: VSTRING, assignment(=), stod use netcdf_f77, only: NF_FILL_REAL 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) type(VSTRING):: 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
Subroutine : | |
var : | type(GT_VARIABLE), intent(in) |
name : | character(len = *), intent(in) |
value(:) : | real, intent(out) |
default : | real, intent(in) |
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
Subroutine : | |||
var : | type(GT_VARIABLE), intent(in) | ||
name : | character(len = *), intent(in) | ||
value(:) : | real, pointer
|
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: VSTRING, assignment(=), get_array use dc_error, only: GT_ENOTVAR, StoreError implicit none type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name real, pointer:: value(:) !(out) integer:: stat, class, cid type(VSTRING):: 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