! Copyright (C) GFD Dennou Club, 2000. All rights reserved. ! 真偽値の判定基準 ... 偽の例を示す。例を lowercase にしたもの以外の値は全部真。 ! 数値 0, 0.0 ! 文字列 "0", "0.0", ".0", "0.", "0.0D0", "FALSE", ".FALSE.", "F" 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