anvarattrtrue.f90

Path: anvarattrtrue.f90
Last Update: Wed Jul 20 18:22:22 JST 2005

Copyright (C) GFD Dennou Club, 2000. All rights reserved. 真偽値の判定基準 … 偽の例を示す。例を lowercase にしたもの以外の値は全部真。

  数値 0, 0.0
  文字列 "0", "0.0", ".0", "0.", "0.0D0", "FALSE", ".FALSE.", "F"

Methods

Included Modules

an_types an_vartable an_generic an_file dc_types netcdf_f77 dc_error dc_string

Public Instance methods

Subroutine :
var :type(AN_VARIABLE), intent(in)
name :character(len = *), intent(in)
value :logical, intent(out)
default :logical, intent(in), optional

[Source]

subroutine ANVarGetAttrLogical(var, name, value, default)
    use an_types, only: AN_VARIABLE, an_variable_entry
    use an_vartable, only: vtable_lookup
    use an_generic, only: get_attr
    use an_file, only: inquire
    use dc_types, only: string
    use netcdf_f77
    use dc_error
    use dc_string
    implicit none
    type(AN_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    logical, intent(out):: value
    logical, intent(in), optional:: default
    type(an_variable_entry):: ent
    character(len = STRING):: cbuffer
    character(len = 7):: c_default
    character(len = NF_MAX_NAME):: aname
    real, allocatable:: rbuf(:)
    integer:: stat, xtype, attrlen
    integer:: varid
    stat = vtable_lookup(var, ent)
    if (stat /= NF_NOERR) goto 999
    ! 大域属性サポート
    call inquire(var, name, varid=varid, nf_attrname=aname)
    stat = nf_inq_att(ent%fileid, varid, aname, xtype=xtype, len=attrlen)
    if (stat /= NF_NOERR) goto 999
    if (xtype == NF_CHAR) then
        c_default = "0"
        if (present(default)) then
            if (default) c_default = "1"
        endif
        call get_attr(var, name, cbuffer, c_default, stat)
        ! もうちょっとましな方法があるべきだが。
        select case(cbuffer)
        case("", "0", "0.0", "0.", ".0", "FALSE", "false", ".FALSE.", ".false.", "F", "f", "0.0D0", "0.0d0")
            value = .FALSE.    
        case default
            value = .TRUE.
        end select
    else
        allocate(rbuf(attrlen))
        stat = nf_get_att_real(ent%fileid, varid, aname, rbuf)
        if (stat /= NF_NOERR) goto 999
        value = (abs(rbuf(1)) > tiny(0.0))
    endif
    return

999 continue
    value = .FALSE.
    if (present(default)) value = default
end subroutine

[Validate]