anattrgetchar.f90

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

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

Methods

Included Modules

an_types an_vartable netcdf_f77 dc_url dc_string dc_trace dc_error

Public Instance methods

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

[Source]

subroutine ANAttrGetChar(var, name, value, default, stat)
    use an_types, only: AN_VARIABLE, an_variable_entry
    use an_vartable, only: vtable_lookup
    use netcdf_f77
    use dc_url, only: GT_PLUS
    use dc_string, only: toChar
    use dc_trace, only: beginsub, endsub
    use dc_error
    implicit none
    type(AN_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    character(len = *), intent(out):: value
    character(len = *), intent(in):: default
    integer, intent(out):: stat
    type(an_variable_entry):: ent
    character(len = 64):: buffer
    double precision, allocatable:: dbuf(:)
    integer, allocatable:: ibuf(:)
    character, allocatable:: cbuf(:)
    integer:: xtype, attrlen, i, iname, varid
    character(len = *), parameter:: subname = "anattrgetchar"
continue
    call beginsub(subname, "var=%d name=%c default=%c", i=(/var%id/), c1=trim(name), c2=trim(default))
    stat = vtable_lookup(var, ent)
    if (stat /= NF_NOERR) goto 900
    if (name(1:1) == GT_PLUS) then
        varid = nf_global
        iname = 2
    else
        varid = ent%varid
        iname = 1
    endif
    stat = nf_inq_att(ent%fileid, varid, name(iname:), xtype=xtype, len=attrlen)
    if (stat /= NF_NOERR) goto 900
    if (xtype == NF_CHAR .and. attrlen <= len(buffer)) then
        stat = nf_get_att_text(ent%fileid, varid, name(iname:), buffer)
        if (stat /= NF_NOERR) goto 900
        value = buffer(1: attrlen)
        if (attrlen > len(value)) stat = GT_ECHARSHORT
    else if (xtype == NF_CHAR) then
        ! UNIDATA NetCDF ライブラリでは文字列引数の長さを
        ! まったく取得していないので先頭が結合していれば OK のはず
        allocate(cbuf(attrlen))
        stat = nf_get_att_text(ent%fileid, varid, name(iname:), cbuf(1))
        if (stat /= NF_NOERR) goto 900
        do, i = 1, attrlen
            value(i:i) = cbuf(i)
        enddo
        if (attrlen < len(value)) value(attrlen + 1: ) = ' '
        if (attrlen > len(value)) stat = GT_ECHARSHORT
        deallocate(cbuf)
    else if (xtype == NF_DOUBLE .or. xtype == NF_FLOAT) then
        allocate(dbuf(attrlen))
        stat = nf_get_att_double(ent%fileid, varid, name(iname:), dbuf)
        if (stat /= NF_NOERR) goto 900
        value = toChar(dbuf)
        deallocate(dbuf)
    else
        allocate(ibuf(attrlen))
        stat = nf_get_att_int(ent%fileid, varid, name(iname:), ibuf)
        if (stat /= NF_NOERR) goto 900
        value = toChar(ibuf)
        deallocate(ibuf)
    endif
    call endsub(subname)
    return
    ! デフォルト処理
900 continue
    value = default
    call endsub(subname, "value := default")
    return
end subroutine

[Validate]