Line |
Branch |
Exec |
Source |
1 |
|
|
! $Id$ |
2 |
|
|
module simple |
3 |
|
|
|
4 |
|
|
use handle_err_m, only: handle_err |
5 |
|
|
|
6 |
|
|
implicit none |
7 |
|
|
|
8 |
|
|
private handle_err |
9 |
|
|
|
10 |
|
|
contains |
11 |
|
|
|
12 |
|
✗ |
subroutine nf95_open(path, mode, ncid, chunksize, ncerr) |
13 |
|
|
|
14 |
|
|
use netcdf, only: nf90_open |
15 |
|
|
|
16 |
|
|
character(len=*), intent(in):: path |
17 |
|
|
integer, intent(in):: mode |
18 |
|
|
integer, intent(out):: ncid |
19 |
|
|
integer, intent(inout), optional:: chunksize |
20 |
|
|
integer, intent(out), optional:: ncerr |
21 |
|
|
|
22 |
|
|
! Variable local to the procedure: |
23 |
|
|
integer ncerr_not_opt |
24 |
|
|
|
25 |
|
|
!------------------- |
26 |
|
|
|
27 |
|
✗ |
ncerr_not_opt = nf90_open(path, mode, ncid, chunksize) |
28 |
|
✗ |
if (present(ncerr)) then |
29 |
|
✗ |
ncerr = ncerr_not_opt |
30 |
|
|
else |
31 |
|
✗ |
call handle_err("nf95_open " // path, ncerr_not_opt) |
32 |
|
|
end if |
33 |
|
|
|
34 |
|
✗ |
end subroutine nf95_open |
35 |
|
|
|
36 |
|
|
!************************ |
37 |
|
|
|
38 |
|
✗ |
subroutine nf95_inq_dimid(ncid, name, dimid, ncerr) |
39 |
|
|
|
40 |
|
|
use netcdf, only: nf90_inq_dimid |
41 |
|
|
|
42 |
|
|
integer, intent(in) :: ncid |
43 |
|
|
character (len = *), intent(in) :: name |
44 |
|
|
integer, intent(out) :: dimid |
45 |
|
|
integer, intent(out), optional:: ncerr |
46 |
|
|
|
47 |
|
|
! Variable local to the procedure: |
48 |
|
|
integer ncerr_not_opt |
49 |
|
|
|
50 |
|
|
!------------------- |
51 |
|
|
|
52 |
|
✗ |
ncerr_not_opt = nf90_inq_dimid(ncid, name, dimid) |
53 |
|
✗ |
if (present(ncerr)) then |
54 |
|
✗ |
ncerr = ncerr_not_opt |
55 |
|
|
else |
56 |
|
✗ |
call handle_err("nf95_inq_dimid " // name, ncerr_not_opt, ncid) |
57 |
|
|
end if |
58 |
|
|
|
59 |
|
✗ |
end subroutine nf95_inq_dimid |
60 |
|
|
|
61 |
|
|
!************************ |
62 |
|
|
|
63 |
|
✗ |
subroutine nf95_inquire_dimension(ncid, dimid, name, nclen, ncerr) |
64 |
|
|
|
65 |
|
|
use netcdf, only: nf90_inquire_dimension |
66 |
|
|
|
67 |
|
|
integer, intent( in) :: ncid, dimid |
68 |
|
|
character (len = *), optional, intent(out) :: name |
69 |
|
|
integer, optional, intent(out) :: nclen |
70 |
|
|
integer, intent(out), optional:: ncerr |
71 |
|
|
|
72 |
|
|
! Variable local to the procedure: |
73 |
|
|
integer ncerr_not_opt |
74 |
|
|
|
75 |
|
|
!------------------- |
76 |
|
|
|
77 |
|
✗ |
ncerr_not_opt = nf90_inquire_dimension(ncid, dimid, name, nclen) |
78 |
|
✗ |
if (present(ncerr)) then |
79 |
|
✗ |
ncerr = ncerr_not_opt |
80 |
|
|
else |
81 |
|
✗ |
call handle_err("nf95_inquire_dimension", ncerr_not_opt, ncid) |
82 |
|
|
end if |
83 |
|
|
|
84 |
|
✗ |
end subroutine nf95_inquire_dimension |
85 |
|
|
|
86 |
|
|
!************************ |
87 |
|
|
|
88 |
|
✗ |
subroutine nf95_inq_varid(ncid, name, varid, ncerr) |
89 |
|
|
|
90 |
|
|
use netcdf, only: nf90_inq_varid |
91 |
|
|
|
92 |
|
|
integer, intent(in) :: ncid |
93 |
|
|
character(len=*), intent(in):: name |
94 |
|
|
integer, intent(out) :: varid |
95 |
|
|
integer, intent(out), optional:: ncerr |
96 |
|
|
|
97 |
|
|
! Variable local to the procedure: |
98 |
|
|
integer ncerr_not_opt |
99 |
|
|
|
100 |
|
|
!------------------- |
101 |
|
|
|
102 |
|
✗ |
ncerr_not_opt = nf90_inq_varid(ncid, name, varid) |
103 |
|
✗ |
if (present(ncerr)) then |
104 |
|
✗ |
ncerr = ncerr_not_opt |
105 |
|
|
else |
106 |
|
✗ |
call handle_err("nf95_inq_varid, name = " // name, ncerr_not_opt, ncid) |
107 |
|
|
end if |
108 |
|
|
|
109 |
|
✗ |
end subroutine nf95_inq_varid |
110 |
|
|
|
111 |
|
|
!************************ |
112 |
|
|
|
113 |
|
✗ |
subroutine nf95_inquire_variable(ncid, varid, name, xtype, ndims, dimids, & |
114 |
|
|
nAtts, ncerr) |
115 |
|
|
|
116 |
|
|
! In "nf90_inquire_variable", "dimids" is an assumed-size array. |
117 |
|
|
! This is not optimal. |
118 |
|
|
! We are in the classical case of an array the size of which is |
119 |
|
|
! unknown in the calling procedure, before the call. |
120 |
|
|
! Here we use a better solution: a pointer argument array. |
121 |
|
|
! This procedure associates and defines "dimids" if it is present. |
122 |
|
|
|
123 |
|
|
use netcdf, only: nf90_inquire_variable, nf90_max_var_dims |
124 |
|
|
|
125 |
|
|
integer, intent(in):: ncid, varid |
126 |
|
|
character(len = *), optional, intent(out):: name |
127 |
|
|
integer, optional, intent(out) :: xtype, ndims |
128 |
|
|
integer, dimension(:), optional, pointer :: dimids |
129 |
|
|
integer, optional, intent(out) :: nAtts |
130 |
|
|
integer, intent(out), optional :: ncerr |
131 |
|
|
|
132 |
|
|
! Variable local to the procedure: |
133 |
|
|
integer ncerr_not_opt |
134 |
|
|
integer dimids_local(nf90_max_var_dims) |
135 |
|
|
integer ndims_not_opt |
136 |
|
|
|
137 |
|
|
!------------------- |
138 |
|
|
|
139 |
|
✗ |
if (present(dimids)) then |
140 |
|
|
ncerr_not_opt = nf90_inquire_variable(ncid, varid, name, xtype, & |
141 |
|
✗ |
ndims_not_opt, dimids_local, nAtts) |
142 |
|
✗ |
allocate(dimids(ndims_not_opt)) ! also works if ndims_not_opt == 0 |
143 |
|
✗ |
dimids = dimids_local(:ndims_not_opt) |
144 |
|
✗ |
if (present(ndims)) ndims = ndims_not_opt |
145 |
|
|
else |
146 |
|
|
ncerr_not_opt = nf90_inquire_variable(ncid, varid, name, xtype, ndims, & |
147 |
|
✗ |
nAtts=nAtts) |
148 |
|
|
end if |
149 |
|
|
|
150 |
|
✗ |
if (present(ncerr)) then |
151 |
|
✗ |
ncerr = ncerr_not_opt |
152 |
|
|
else |
153 |
|
✗ |
call handle_err("nf95_inquire_variable", ncerr_not_opt, ncid, varid) |
154 |
|
|
end if |
155 |
|
|
|
156 |
|
✗ |
end subroutine nf95_inquire_variable |
157 |
|
|
|
158 |
|
|
!************************ |
159 |
|
|
|
160 |
|
✗ |
subroutine nf95_create(path, cmode, ncid, initialsize, chunksize, ncerr) |
161 |
|
|
|
162 |
|
|
use netcdf, only: nf90_create |
163 |
|
|
|
164 |
|
|
character (len = *), intent(in ) :: path |
165 |
|
|
integer, intent(in ) :: cmode |
166 |
|
|
integer, intent( out) :: ncid |
167 |
|
|
integer, optional, intent(in ) :: initialsize |
168 |
|
|
integer, optional, intent(inout) :: chunksize |
169 |
|
|
integer, intent(out), optional :: ncerr |
170 |
|
|
|
171 |
|
|
! Variable local to the procedure: |
172 |
|
|
integer ncerr_not_opt |
173 |
|
|
|
174 |
|
|
!------------------- |
175 |
|
|
|
176 |
|
✗ |
ncerr_not_opt = nf90_create(path, cmode, ncid, initialsize, chunksize) |
177 |
|
✗ |
if (present(ncerr)) then |
178 |
|
✗ |
ncerr = ncerr_not_opt |
179 |
|
|
else |
180 |
|
✗ |
call handle_err("nf95_create " // path, ncerr_not_opt) |
181 |
|
|
end if |
182 |
|
|
|
183 |
|
✗ |
end subroutine nf95_create |
184 |
|
|
|
185 |
|
|
!************************ |
186 |
|
|
|
187 |
|
✗ |
subroutine nf95_def_dim(ncid, name, nclen, dimid, ncerr) |
188 |
|
|
|
189 |
|
|
use netcdf, only: nf90_def_dim |
190 |
|
|
|
191 |
|
|
integer, intent( in) :: ncid |
192 |
|
|
character (len = *), intent( in) :: name |
193 |
|
|
integer, intent( in) :: nclen |
194 |
|
|
integer, intent(out) :: dimid |
195 |
|
|
integer, intent(out), optional :: ncerr |
196 |
|
|
|
197 |
|
|
! Variable local to the procedure: |
198 |
|
|
integer ncerr_not_opt |
199 |
|
|
|
200 |
|
|
!------------------- |
201 |
|
|
|
202 |
|
✗ |
ncerr_not_opt = nf90_def_dim(ncid, name, nclen, dimid) |
203 |
|
✗ |
if (present(ncerr)) then |
204 |
|
✗ |
ncerr = ncerr_not_opt |
205 |
|
|
else |
206 |
|
✗ |
call handle_err("nf95_def_dim " // name, ncerr_not_opt, ncid) |
207 |
|
|
end if |
208 |
|
|
|
209 |
|
✗ |
end subroutine nf95_def_dim |
210 |
|
|
|
211 |
|
|
!*********************** |
212 |
|
|
|
213 |
|
✗ |
subroutine nf95_redef(ncid, ncerr) |
214 |
|
|
|
215 |
|
|
use netcdf, only: nf90_redef |
216 |
|
|
|
217 |
|
|
integer, intent( in) :: ncid |
218 |
|
|
integer, intent(out), optional :: ncerr |
219 |
|
|
|
220 |
|
|
! Variable local to the procedure: |
221 |
|
|
integer ncerr_not_opt |
222 |
|
|
|
223 |
|
|
!------------------- |
224 |
|
|
|
225 |
|
✗ |
ncerr_not_opt = nf90_redef(ncid) |
226 |
|
✗ |
if (present(ncerr)) then |
227 |
|
✗ |
ncerr = ncerr_not_opt |
228 |
|
|
else |
229 |
|
✗ |
call handle_err("nf95_redef", ncerr_not_opt, ncid) |
230 |
|
|
end if |
231 |
|
|
|
232 |
|
✗ |
end subroutine nf95_redef |
233 |
|
|
|
234 |
|
|
!*********************** |
235 |
|
|
|
236 |
|
✗ |
subroutine nf95_enddef(ncid, h_minfree, v_align, v_minfree, r_align, ncerr) |
237 |
|
|
|
238 |
|
|
use netcdf, only: nf90_enddef |
239 |
|
|
|
240 |
|
|
integer, intent( in) :: ncid |
241 |
|
|
integer, optional, intent( in) :: h_minfree, v_align, v_minfree, r_align |
242 |
|
|
integer, intent(out), optional :: ncerr |
243 |
|
|
|
244 |
|
|
! Variable local to the procedure: |
245 |
|
|
integer ncerr_not_opt |
246 |
|
|
|
247 |
|
|
!------------------- |
248 |
|
|
|
249 |
|
✗ |
ncerr_not_opt = nf90_enddef(ncid, h_minfree, v_align, v_minfree, r_align) |
250 |
|
✗ |
if (present(ncerr)) then |
251 |
|
✗ |
ncerr = ncerr_not_opt |
252 |
|
|
else |
253 |
|
✗ |
call handle_err("nf95_enddef", ncerr_not_opt, ncid) |
254 |
|
|
end if |
255 |
|
|
|
256 |
|
✗ |
end subroutine nf95_enddef |
257 |
|
|
|
258 |
|
|
!*********************** |
259 |
|
|
|
260 |
|
✗ |
subroutine nf95_close(ncid, ncerr) |
261 |
|
|
|
262 |
|
|
use netcdf, only: nf90_close |
263 |
|
|
|
264 |
|
|
integer, intent( in) :: ncid |
265 |
|
|
integer, intent(out), optional :: ncerr |
266 |
|
|
|
267 |
|
|
! Variable local to the procedure: |
268 |
|
|
integer ncerr_not_opt |
269 |
|
|
|
270 |
|
|
!------------------- |
271 |
|
|
|
272 |
|
✗ |
ncerr_not_opt = nf90_close(ncid) |
273 |
|
✗ |
if (present(ncerr)) then |
274 |
|
✗ |
ncerr = ncerr_not_opt |
275 |
|
|
else |
276 |
|
✗ |
call handle_err("nf95_close", ncerr_not_opt) |
277 |
|
|
end if |
278 |
|
|
|
279 |
|
✗ |
end subroutine nf95_close |
280 |
|
|
|
281 |
|
|
!*********************** |
282 |
|
|
|
283 |
|
✗ |
subroutine nf95_copy_att(ncid_in, varid_in, name, ncid_out, varid_out, ncerr) |
284 |
|
|
|
285 |
|
|
use netcdf, only: nf90_copy_att |
286 |
|
|
|
287 |
|
|
integer, intent( in):: ncid_in, varid_in |
288 |
|
|
character(len=*), intent( in):: name |
289 |
|
|
integer, intent( in):: ncid_out, varid_out |
290 |
|
|
integer, intent(out), optional:: ncerr |
291 |
|
|
|
292 |
|
|
! Variable local to the procedure: |
293 |
|
|
integer ncerr_not_opt |
294 |
|
|
|
295 |
|
|
!------------------- |
296 |
|
|
|
297 |
|
✗ |
ncerr_not_opt = nf90_copy_att(ncid_in, varid_in, name, ncid_out, varid_out) |
298 |
|
✗ |
if (present(ncerr)) then |
299 |
|
✗ |
ncerr = ncerr_not_opt |
300 |
|
|
else |
301 |
|
✗ |
call handle_err("nf95_copy_att " // name, ncerr_not_opt, ncid_out) |
302 |
|
|
end if |
303 |
|
|
|
304 |
|
✗ |
end subroutine nf95_copy_att |
305 |
|
|
|
306 |
|
|
!*********************** |
307 |
|
|
|
308 |
|
✗ |
subroutine nf95_inquire_attribute(ncid, varid, name, xtype, nclen, attnum, & |
309 |
|
|
ncerr) |
310 |
|
|
|
311 |
|
|
use netcdf, only: nf90_inquire_attribute |
312 |
|
|
|
313 |
|
|
integer, intent( in) :: ncid, varid |
314 |
|
|
character (len = *), intent( in) :: name |
315 |
|
|
integer, intent(out), optional :: xtype, nclen, attnum |
316 |
|
|
integer, intent(out), optional:: ncerr |
317 |
|
|
|
318 |
|
|
! Variable local to the procedure: |
319 |
|
|
integer ncerr_not_opt |
320 |
|
|
|
321 |
|
|
!------------------- |
322 |
|
|
|
323 |
|
|
ncerr_not_opt = nf90_inquire_attribute(ncid, varid, name, xtype, nclen, & |
324 |
|
✗ |
attnum) |
325 |
|
✗ |
if (present(ncerr)) then |
326 |
|
✗ |
ncerr = ncerr_not_opt |
327 |
|
|
else |
328 |
|
|
call handle_err("nf95_inquire_attribute " // name, ncerr_not_opt, & |
329 |
|
✗ |
ncid, varid) |
330 |
|
|
end if |
331 |
|
|
|
332 |
|
✗ |
end subroutine nf95_inquire_attribute |
333 |
|
|
|
334 |
|
|
!*********************** |
335 |
|
|
|
336 |
|
✗ |
subroutine nf95_inquire(ncid, nDimensions, nVariables, nAttributes, & |
337 |
|
|
unlimitedDimId, formatNum, ncerr) |
338 |
|
|
|
339 |
|
|
use netcdf, only: nf90_inquire |
340 |
|
|
|
341 |
|
|
integer, intent( in) :: ncid |
342 |
|
|
integer, optional, intent(out) :: nDimensions, nVariables, nAttributes |
343 |
|
|
integer, optional, intent(out) :: unlimitedDimId, formatNum |
344 |
|
|
integer, intent(out), optional:: ncerr |
345 |
|
|
|
346 |
|
|
! Variable local to the procedure: |
347 |
|
|
integer ncerr_not_opt |
348 |
|
|
|
349 |
|
|
!------------------- |
350 |
|
|
|
351 |
|
|
ncerr_not_opt = nf90_inquire(ncid, nDimensions, nVariables, nAttributes, & |
352 |
|
✗ |
unlimitedDimId, formatNum) |
353 |
|
✗ |
if (present(ncerr)) then |
354 |
|
✗ |
ncerr = ncerr_not_opt |
355 |
|
|
else |
356 |
|
✗ |
call handle_err("nf95_inquire", ncerr_not_opt, ncid) |
357 |
|
|
end if |
358 |
|
|
|
359 |
|
✗ |
end subroutine nf95_inquire |
360 |
|
|
|
361 |
|
|
end module simple |
362 |
|
|
|