gtvargetattr.f90

Path: src/gtvargetattr.f90
Last Update: Fri Aug 05 00:58:56 JST 2005

gtvargetattr.f90 - 数値型属性の入力 Copyright (C) GFD Dennou Club, 2000. All rights reserved.

Methods

GTVarGetAttrD   GTVarGetAttrDA   GTVarGetAttrDP   GTVarGetAttrI   GTVarGetAttrIA   GTVarGetAttrIP   GTVarGetAttrR   GTVarGetAttrRA   GTVarGetAttrRP  

Included Modules

gtdata_types an_generic gt_mem gt_map dc_error dc_string netcdf_f77 gtdata_generic

Public Instance methods

GTVarGetAttrD(var, attrname, value, default)
var :type(GT_VARIABLE), intent(in)
attrname :character(len = *), intent(in)
value :double precision, intent(out)
default :double precision, intent(in), optional

スカラで受け取るのが一番簡単。解釈可能な値がとられ、残りは捨てられる。

[Source]



subroutine GTVarGetAttrD(var, attrname, value, default)

    implicit none
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: attrname
    double precision, intent(out):: value
    double precision, intent(in), optional:: default
    integer:: stat
    double precision:: 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
GTVarGetAttrDA(var, name, value, default)
var :type(GT_VARIABLE), intent(in)
name :character(len = *), intent(in)
value(:) :double precision, intent(out)
default :double precision, intent(in)

場合は属性長があまっている場合には切り捨てられ、 属性長が足りない場合は default 値 (ポインタと違い必須) を埋める。

[Source]



subroutine GTVarGetAttrDA(var, name, value, default)

    implicit none
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    double precision, intent(out):: value(:)
    double precision, intent(in):: default
    double precision, 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
GTVarGetAttrDP(var, name, value)
var :type(GT_VARIABLE), intent(in)
name :character(len = *), intent(in)
value(:) :double precision, pointer

ポインタ配列を使って受け取る場合は解釈可能な数だけ実体が割り付けられる。

[Source]



subroutine GTVarGetAttrDP(var, name, value)

    implicit none
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    double precision, pointer:: value(:)
    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
GTVarGetAttrI(var, attrname, value, default)
var :type(GT_VARIABLE), intent(in)
attrname :character(len = *), intent(in)
value :integer, intent(out)
default :integer, intent(in), optional

スカラで受け取るのが一番簡単。解釈可能な値がとられ、残りは捨てられる。

[Source]



subroutine GTVarGetAttrI(var, attrname, value, default)

    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
GTVarGetAttrIA(var, name, value, stat, default)
var :type(GT_VARIABLE), intent(in)
name :character(len = *), intent(in)
value(:) :integer, intent(out)
stat :integer
default :integer, intent(in)

場合は属性長があまっている場合には切り捨てられ、 属性長が足りない場合は default 値 (ポインタと違い必須) を埋める。

[Source]



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

    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
GTVarGetAttrIP(var, name, value)
var :type(GT_VARIABLE), intent(in)
name :character(len = *), intent(in)
value(:) :integer, pointer

ポインタ配列を使って受け取る場合は解釈可能な数だけ実体が割り付けられる。

[Source]



subroutine GTVarGetAttrIP(var, name, value)

    implicit none
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    integer, pointer:: value(:)
    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
GTVarGetAttrR(var, attrname, value, default)
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)

    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
GTVarGetAttrRA(var, name, value, default)
var :type(GT_VARIABLE), intent(in)
name :character(len = *), intent(in)
value(:) :real, intent(out)
default :real, intent(in)

場合は属性長があまっている場合には切り捨てられ、 属性長が足りない場合は default 値 (ポインタと違い必須) を埋める。

[Source]


subroutine GTVarGetAttrRA(var, name, value, default)

    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
GTVarGetAttrRP(var, name, value)
var :type(GT_VARIABLE), intent(in)
name :character(len = *), intent(in)
value(:) :real, pointer

ポインタ配列を使って受け取る場合は解釈可能な数だけ実体が割り付けられる。

[Source]


subroutine GTVarGetAttrRP(var, name, value)

    implicit none
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    real, pointer:: value(:)
    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

[Validate]