! Copyright (C) GFD Dennou Club, 2000.  All rights reserved.

! 真偽値の判定基準 ... 偽の例を示す。例を lowercase にしたもの以外の値は全部真。
!   数値 0, 0.0
!   文字列 "0", "0.0", ".0", "0.", "0.0D0", "FALSE", ".FALSE.", "F"

! たぶん attr_true のほうがよく使うだろう。
logical function ANVarAttrTrue(var, name, default) result(result)
    use an_types, only: AN_VARIABLE
    use an_generic, only: get_attr
    use an_file, only: inquire
    use netcdf_f77
    use dc_error
    use dc_string
    implicit none
    type(AN_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    logical, intent(in), optional:: default
    type(VSTRING):: sbuffer
    character(len = 7):: c_default
    character(len = NF_MAX_NAME):: aname
    real, allocatable:: rbuf(:)
    integer:: stat, xtype, attrlen
    integer:: varid
    ! 大域属性サポート
    call inquire(var, name, &
        & varid=varid, nf_attrname=aname)
    stat = nf_inq_att(var%fileid, varid, aname, &
        & xtype=xtype, len=attrlen)
    if (stat /= NF_NOERR) goto 800
    if (xtype == NF_CHAR) then
        c_default = "0"
        if (present(default)) then
            if (default) c_default = "1"
        endif
        call get_attr(var, name, sbuffer, c_default)
        c_default = sbuffer
        ! もうちょっとましな方法があるべきだが。
        select case(c_default)
        case("", "0", "0.0", "0.", ".0", "FALSE", "false", ".FALSE.", ".false.", &
            "F", "f", "0.0D0", "0.0d0")
            result = .FALSE.    
        case default
            result = .TRUE.
        end select
    else
        allocate(rbuf(attrlen))
        stat = nf_get_att_real(var%fileid, varid, aname, rbuf)
        if (stat /= NF_NOERR) goto 800
        result = (rbuf(1) /= 0.0)
    endif
    return

    800 continue
    result = .FALSE.
    if (present(default)) result = default
end function

! get_attr として呼べるようにしたもの。attr_true と得られる情報は同じ
subroutine ANVarGetAttrLogical(var, name, value, default)
    use an_types, only: AN_VARIABLE
    use an_generic, only: attr_true
    type(AN_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    logical, intent(out):: value
    logical, intent(in), optional:: default
    value = attr_true(var, name, default)
end subroutine
