41 use netcdf, only: nf90_noerr, nf90_global, nf90_inquire_attribute, nf90_char, nf90_get_att, &
42 & nf90_double, nf90_float
47 implicit none
48 type(GD_NC_VARIABLE), intent(in):: var
49 character(len = *), intent(in):: name
50 character(len = *), intent(out):: value
51 character(len = *), intent(in):: default
52 integer, intent(out):: stat
53 type(GD_NC_VARIABLE_ENTRY):: ent
54 character(len = 64):: buffer
55 double precision, allocatable:: dbuf(:)
56 integer, allocatable:: ibuf(:)
57 character, allocatable:: cbuf(:)
58 integer:: xtype, attrlen, i, iname, varid
59 character(len = *), parameter:: subname = "GDNcAttrGetChar"
60 continue
61 call beginsub(subname,
"var=%d name=%c default=%c", i=(/var%id/), &
62 & c1=trim(name), c2=trim(default))
64 if (stat /= nf90_noerr) goto 900
66 varid = nf90_global
67 iname = 2
68 else
69 varid = ent%varid
70 iname = 1
71 endif
72 stat = nf90_inquire_attribute(ent%fileid, varid, name(iname:), xtype=xtype, len=attrlen)
73 if (stat /= nf90_noerr) goto 900
74 if (xtype == nf90_char .and. attrlen <= len(buffer)) then
75 stat = nf90_get_att(ent%fileid, varid, name(iname:), buffer)
76 if (stat /= nf90_noerr) goto 900
77 value = buffer(1: attrlen)
79 else if (xtype == nf90_char) then
80
81
82 allocate(cbuf(attrlen))
83 stat = nf90_get_att(ent%fileid, varid, name(iname:), cbuf(1))
84 if (stat /= nf90_noerr) goto 900
85 do, i = 1, attrlen
86 value(i:i) = cbuf(i)
87 enddo
88 if (attrlen < len(value)) value(attrlen + 1: ) = ' '
90 deallocate(cbuf)
91 else if (xtype == nf90_double .or. xtype == nf90_float) then
92 allocate(dbuf(attrlen))
93 stat = nf90_get_att(ent%fileid, varid, name(iname:), dbuf)
94 if (stat /= nf90_noerr) goto 900
96 deallocate(dbuf)
97 else
98 allocate(ibuf(attrlen))
99 stat = nf90_get_att(ent%fileid, varid, name(iname:), ibuf)
100 if (stat /= nf90_noerr) goto 900
102 deallocate(ibuf)
103 endif
105 return
106
107900 continue
108 value = default
109 call endsub(subname,
"value := default")
110 return
integer, parameter, public gt_echarshort
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
character, parameter, public gt_plus
integer function, public vtable_lookup(var, entry)