57 use netcdf, only: nf90_noerr, nf90_max_name, &
58 & nf90_inquire_variable, nf90_inquire_dimension, nf90_inquire
59 implicit none
60 type(GD_NC_VARIABLE), intent(in):: var
61 integer, intent(out), optional:: ndims
62 integer, intent(out), optional:: dimlen
63 logical, intent(out), optional:: growable
64 character(*), intent(out), optional:: name
65 character(*), intent(out), optional:: url
66 character(*), intent(out), optional:: xtype
67
68
69 type(GD_NC_VARIABLE_ENTRY):: ent
70 integer:: stat, length, i, i_xtype, idim_growable
71 character(len = *), parameter:: subname = 'GDNcVarInquire'
72 character(len = NF90_MAX_NAME):: buffer
73 character(len = NF90_MAX_NAME):: fbuffer
74continue
75 call beginsub(subname,
'var.id=%d', i=(/var%id/))
76
77
78 if (present(ndims)) ndims = -1
79 if (present(dimlen)) dimlen = -1
80
81
83 if (stat /= nf90_noerr) then
84 call endsub(subname,
'var not found')
85 return
86 endif
87
88
89
90 if (present(ndims)) then
91 if (associated(ent%dimids)) then
92 ndims = size(ent%dimids)
93 else
94 ndims = 0
95 endif
96 endif
97
98 if (present(dimlen)) then
99 dimlen = 1
100 if (ent%dimid > 0) then
101
102 stat = nf90_inquire_dimension(ent%fileid, ent%dimid, len = dimlen)
103 if (stat /= nf90_noerr) then
104 dimlen = -1
105 call endsub(subname,
'dimlen err')
106 return
107 endif
108 else
109
110 if (associated(ent%dimids)) then
111 do, i = 1, size(ent%dimids)
112 stat = nf90_inquire_dimension(ent%fileid, ent%dimids(i), len = length)
113 if (stat /= nf90_noerr) then
114 dimlen = -1
115 exit
116 endif
117 dimlen = dimlen * length
118 enddo
119 endif
120 endif
121 endif
122
123 if (present(xtype)) then
124 stat = nf90_inquire_variable(ent%fileid, ent%varid, xtype=i_xtype)
125 if (stat /= nf90_noerr) i_xtype = 0
127 endif
128
129 if (present(name)) then
131 name = buffer
132 endif
133
134 if (present(url)) then
136 call dbgmessage(
'ent%%fileid=%d', i=(/ent%fileid/))
138 url = trim(fbuffer) // '?' // buffer
139 endif
140
141 if (present(growable)) then
142 growable = .false.
144 if (stat /= nf90_noerr) return
145 stat = nf90_inquire(ent%fileid, unlimiteddimid = idim_growable)
146 if (stat /= nf90_noerr) return
147
148 if (ent%varid > 0) then
149 if (.not. associated(ent%dimids)) return
150 do, i = 1, size(ent%dimids)
151 if (ent%dimids(i) == idim_growable) growable = .true.
152 enddo
153 else
154 growable = (ent%dimid == idim_growable)
155 endif
156 endif
157
158
159 call endsub(subname,
'ok')
160 return
161
162contains
163
165 use netcdf, only: &
166 & nf90_inquire_dimension, nf90_inquire_variable, nf90_noerr
167 type(GD_NC_VARIABLE_ENTRY), intent(in):: ent
168 character(len = *), intent(out):: varname
169 if (ent%dimid > 0) then
170 stat = nf90_inquire_dimension(ent%fileid, ent%dimid, name = varname)
171 else
172 stat = nf90_inquire_variable(ent%fileid, ent%varid, name = varname)
173 endif
174 if (stat /= nf90_noerr) varname = ""
176
subroutine local_getname(ent, varname)
非公開なので gtdata_netcdf_generic には置かない
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
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)
integer function, public vtable_lookup(var, entry)