87 type(GD_NC_VARIABLE), intent(out):: var
88 type(GD_NC_VARIABLE_SEARCH), intent(in):: entry
89 type(GD_NC_VARIABLE_ENTRY), allocatable:: tmp_table(:)
90 integer:: i, n
91
92
93 if (.not. allocated(gdnctab)) then
94 allocate(gdnctab(gdnctab_init_size), stat=result)
95 if (result /= 0) goto 999
96 do, i = 1, gdnctab_init_size
97 gdnctab(i)%fileid = 0
98 gdnctab(i)%varid = 0
99 gdnctab(i)%dimid = 0
100 gdnctab(i)%attrid = 0
101 nullify(gdnctab(i)%dimids)
102 enddo
103 endif
104
105 do, i = 1, size(gdnctab)
106 if (gdnctab(i)%fileid == entry%fileid &
107 & .and. gdnctab(i)%varid == entry%varid &
108 & .and. gdnctab(i)%dimid == entry%dimid) then
109 var = gd_nc_variable(i)
110 result = nf90_noerr
111 call dbgmessage('gtdata_netcdf_internal.add: found %d', i=(/i/))
112 return
113 endif
114 enddo
115
116
117 var = gd_nc_variable(-1)
118 do, i = 1, size(gdnctab)
119 if (gdnctab(i)%fileid == 0) then
120 var = gd_nc_variable(i)
121 exit
122 endif
123 enddo
124 if (var%id == -1) then
125
126 n = size(gdnctab)
127 allocate(tmp_table(n), stat=result)
128 if (result /= 0) goto 999
129 tmp_table(:) = gdnctab(:)
130 deallocate(gdnctab, stat=result)
131 if (result /= 0) goto 999
132 allocate(gdnctab(n * 2), stat=result)
133 if (result /= 0) goto 999
134 gdnctab(1:n) = tmp_table(1:n)
135 deallocate(tmp_table, stat=result)
136 if (result /= 0) goto 999
137
138 gdnctab(n+2)%fileid = 0
139 gdnctab(n+2)%varid = 0
140 gdnctab(n+2)%dimid = 0
141 gdnctab(n+2)%attrid = 0
142 nullify(gdnctab(n+2)%dimids)
143 gdnctab(n+3: n*2) = gdnctab(n+2)
144
145 var = gd_nc_variable(n + 1)
146 endif
147 gdnctab(var%id)%fileid = entry%fileid
148 gdnctab(var%id)%varid = entry%varid
149 gdnctab(var%id)%dimid = entry%dimid
150
151
152 call internal_build_dimids(gdnctab(var%id), result)
153 if (result /= nf90_noerr) goto 999
154
155 result = nf90_noerr
156 call dbgmessage('gtdata_netcdf_internal.add: added %d', i=(/var%id/))
157 return
158
159999 continue
160 var = gd_nc_variable(-1)
161 result = nf90_enomem
162 return
163
164 contains
165
166 subroutine internal_build_dimids(ent, stat)
167
168
169 type(GD_NC_VARIABLE_ENTRY), intent(inout):: ent
170 integer, intent(out):: stat
171 integer:: ndims
172 if (ent%varid > 0) then
173 stat = nf90_inquire_variable(ent%fileid, ent%varid, ndims = ndims)
174 if (stat /= nf90_noerr) return
175 if ((ent%dimid > 0) .and. (ndims /= 1)) goto 100
176 if (ndims == 0) then
177 nullify(ent%dimids)
178 stat = nf90_noerr
179 return
180 endif
181 allocate(ent%dimids(ndims), stat=stat)
182 if (stat /= 0) then
183 stat = nf90_enomem
184 return
185 endif
186 stat = nf90_inquire_variable(ent%fileid, ent%varid, dimids = ent%dimids)
187 if (stat /= nf90_noerr) return
188 if ((ent%dimid > 0) .and. (ent%dimids(1) /= ent%dimid)) then
189 deallocate(ent%dimids)
190 goto 100
191 endif
192 else
193 allocate(ent%dimids(1), stat=stat)
194 if (stat /= 0) then
195 stat = nf90_enomem
196 return
197 endif
198 ent%dimids(1) = ent%dimid
199 endif
200 stat = nf90_noerr
201 return
202
203100 continue
204 ent%varid = 0
205 allocate(ent%dimids(1))
206 ent%dimids(1) = ent%dimid
207 end subroutine internal_build_dimids
208