1 | #define MYFILE 'fbstatncio.F90' |
---|
2 | MODULE fbstatncio |
---|
3 | |
---|
4 | USE fbacctype |
---|
5 | USE nctools |
---|
6 | IMPLICIT NONE |
---|
7 | |
---|
8 | REAL, PARAMETER :: fbstncmiss = 99999. |
---|
9 | |
---|
10 | TYPE fbstatnctype |
---|
11 | INTEGER :: nlev,nbox,nadd |
---|
12 | CHARACTER(len=20), POINTER, DIMENSION(:) :: area |
---|
13 | CHARACTER(len=32), POINTER, DIMENSION(:) :: name |
---|
14 | REAL, POINTER, DIMENSION(:) :: dep |
---|
15 | REAL, POINTER, DIMENSION(:,:,:) :: val |
---|
16 | INTEGER, POINTER, DIMENSION(:,:) :: cnt |
---|
17 | END TYPE fbstatnctype |
---|
18 | |
---|
19 | TYPE fbstathistnctype |
---|
20 | INTEGER :: nlev,nbox,npoints |
---|
21 | CHARACTER(len=20), POINTER, DIMENSION(:) :: area |
---|
22 | REAL, POINTER, DIMENSION(:) :: dep,val |
---|
23 | INTEGER, POINTER, DIMENSION(:,:,:) :: nhist |
---|
24 | END TYPE fbstathistnctype |
---|
25 | |
---|
26 | TYPE fbstatxynctype |
---|
27 | INTEGER :: nlev,nbox,npoints |
---|
28 | CHARACTER(len=20), POINTER, DIMENSION(:) :: area |
---|
29 | REAL, POINTER, DIMENSION(:) :: dep,val |
---|
30 | INTEGER, POINTER, DIMENSION(:,:,:,:) :: nxy |
---|
31 | END TYPE fbstatxynctype |
---|
32 | |
---|
33 | CONTAINS |
---|
34 | |
---|
35 | SUBROUTINE fbstat_ncwrite(cdfilename,nvar,cdvar,nadd,cdadd,& |
---|
36 | & nobe,cdobe,nbge,cdbge,& |
---|
37 | & nbox,nboxl,lenboxname,cdboxnam,lskipbox,nlev,pdep,& |
---|
38 | & knum,pbias,prms,pstd,pomean,pmmean,knuma,poamean, & |
---|
39 | & knumo,poerr,povar,knumb,pberr,pbvar) |
---|
40 | ! Arguments |
---|
41 | CHARACTER(len=*) :: cdfilename ! Netcdf filename |
---|
42 | INTEGER :: nvar ! Number of variables |
---|
43 | CHARACTER(len=*), DIMENSION(nvar) :: cdvar ! Name of variables |
---|
44 | INTEGER :: nadd ! Number of additional data |
---|
45 | CHARACTER(len=*), DIMENSION(nadd) :: cdadd ! Name of entries |
---|
46 | INTEGER :: nobe ! Number of obs errors |
---|
47 | CHARACTER(len=*), DIMENSION(nadd) :: cdobe ! Name of obs erors |
---|
48 | INTEGER :: nbge ! Number of bg errors |
---|
49 | CHARACTER(len=*), DIMENSION(nadd) :: cdbge ! Name of bg erors |
---|
50 | INTEGER :: nbox ! Total number of boxes |
---|
51 | INTEGER :: nboxl ! Actual number of boxes |
---|
52 | INTEGER :: lenboxname ! Length of box names |
---|
53 | CHARACTER(len=lenboxname), DIMENSION(nbox) :: & |
---|
54 | & cdboxnam ! Name of boxes |
---|
55 | LOGICAL, DIMENSION(nbox) :: lskipbox ! Boxes to skip |
---|
56 | INTEGER :: nlev ! Number of levels |
---|
57 | REAL,DIMENSION(nlev) :: pdep ! Depth of levels |
---|
58 | INTEGER, DIMENSION(nlev,nboxl,nadd,nvar) :: & ! Output data |
---|
59 | & knum |
---|
60 | REAL, DIMENSION(nlev,nboxl,nadd,nvar) :: & ! Output data |
---|
61 | & pbias, prms, pstd, pomean, pmmean |
---|
62 | INTEGER, DIMENSION(nlev,nboxl,nvar) :: & ! Output data |
---|
63 | & knuma |
---|
64 | REAL, DIMENSION(nlev,nboxl,nvar) :: & ! Output data |
---|
65 | & poamean |
---|
66 | INTEGER, DIMENSION(nlev,nboxl,nobe,nvar) :: & ! Output data |
---|
67 | & knumo |
---|
68 | REAL, DIMENSION(nlev,nboxl,nobe,nvar) :: & ! Output data |
---|
69 | & poerr,povar |
---|
70 | INTEGER, DIMENSION(nlev,nboxl,nbge,nvar) :: & ! Output data |
---|
71 | & knumb |
---|
72 | REAL, DIMENSION(nlev,nboxl,nbge,nvar) :: & ! Output data |
---|
73 | & pberr,pbvar |
---|
74 | ! Local variables |
---|
75 | INTEGER :: jadd,jvar,incvar,iv,jbox,ip |
---|
76 | CHARACTER(len=50) :: cncvarbase |
---|
77 | CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar |
---|
78 | ! netcdf stuff |
---|
79 | INTEGER :: ncid,idlev,idbox,idlbox,idimdep(1),idimbox(2),idimids(2) |
---|
80 | INTEGER :: idvbox,idvlev |
---|
81 | INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar |
---|
82 | INTEGER :: inoboxes |
---|
83 | REAL, ALLOCATABLE, DIMENSION(:,:) :: ztmp |
---|
84 | INTEGER, ALLOCATABLE, DIMENSION(:,:) :: itmp |
---|
85 | CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: & |
---|
86 | & clboxnam ! Name of boxes |
---|
87 | |
---|
88 | ! Open netCDF files. |
---|
89 | |
---|
90 | CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),& |
---|
91 | & __LINE__,MYFILE) |
---|
92 | |
---|
93 | ! Create dimensions |
---|
94 | |
---|
95 | inoboxes=nbox-COUNT(lskipbox) |
---|
96 | ALLOCATE(ztmp(nlev,inoboxes),itmp(nlev,inoboxes),clboxnam(inoboxes)) |
---|
97 | |
---|
98 | CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE) |
---|
99 | |
---|
100 | CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),& |
---|
101 | & __LINE__,MYFILE) |
---|
102 | |
---|
103 | CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE) |
---|
104 | |
---|
105 | ! Box variable name |
---|
106 | |
---|
107 | idimbox(1)=idlbox |
---|
108 | idimbox(2)=idbox |
---|
109 | CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),& |
---|
110 | & __LINE__,MYFILE) |
---|
111 | |
---|
112 | ! Depths |
---|
113 | |
---|
114 | idimdep(1)=idlev |
---|
115 | CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),& |
---|
116 | & __LINE__,MYFILE) |
---|
117 | |
---|
118 | ! Setup variables names |
---|
119 | |
---|
120 | idimids(1)=idlev |
---|
121 | idimids(2)=idbox |
---|
122 | incvar=(nadd*6+nobe*3+nbge*3+2)*nvar |
---|
123 | ALLOCATE(cncvar(incvar),idvar(incvar)) |
---|
124 | iv=0 |
---|
125 | DO jvar=1,nvar |
---|
126 | DO jadd=1,nadd |
---|
127 | WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdadd(jadd)) |
---|
128 | iv=iv+1 |
---|
129 | cncvar(iv)=TRIM(cncvarbase)//'_bias' |
---|
130 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,& |
---|
131 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
132 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
133 | & __LINE__,MYFILE) |
---|
134 | iv=iv+1 |
---|
135 | cncvar(iv)=TRIM(cncvarbase)//'_rms' |
---|
136 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,& |
---|
137 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
138 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
139 | & __LINE__,MYFILE) |
---|
140 | iv=iv+1 |
---|
141 | cncvar(iv)=TRIM(cncvarbase)//'_std' |
---|
142 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,& |
---|
143 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
144 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
145 | & __LINE__,MYFILE) |
---|
146 | iv=iv+1 |
---|
147 | cncvar(iv)=TRIM(cncvarbase)//'_omean' |
---|
148 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,& |
---|
149 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
150 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
151 | & __LINE__,MYFILE) |
---|
152 | iv=iv+1 |
---|
153 | cncvar(iv)=TRIM(cncvarbase)//'_mmean' |
---|
154 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,& |
---|
155 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
156 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
157 | & __LINE__,MYFILE) |
---|
158 | iv=iv+1 |
---|
159 | cncvar(iv)=TRIM(cncvarbase)//'_count' |
---|
160 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,& |
---|
161 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
162 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
163 | & __LINE__,MYFILE) |
---|
164 | ENDDO |
---|
165 | DO jadd=1,nobe |
---|
166 | WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdobe(jadd)) |
---|
167 | iv=iv+1 |
---|
168 | cncvar(iv)=TRIM(cncvarbase)//'_meanerr' |
---|
169 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,& |
---|
170 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
171 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
172 | & __LINE__,MYFILE) |
---|
173 | iv=iv+1 |
---|
174 | cncvar(iv)=TRIM(cncvarbase)//'_meanvar' |
---|
175 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,& |
---|
176 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
177 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
178 | & __LINE__,MYFILE) |
---|
179 | iv=iv+1 |
---|
180 | cncvar(iv)=TRIM(cncvarbase)//'_count' |
---|
181 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,& |
---|
182 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
183 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
184 | & __LINE__,MYFILE) |
---|
185 | ENDDO |
---|
186 | DO jadd=1,nbge |
---|
187 | WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdbge(jadd)) |
---|
188 | iv=iv+1 |
---|
189 | cncvar(iv)=TRIM(cncvarbase)//'_meanerr' |
---|
190 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,& |
---|
191 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
192 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
193 | & __LINE__,MYFILE) |
---|
194 | iv=iv+1 |
---|
195 | cncvar(iv)=TRIM(cncvarbase)//'_meanvar' |
---|
196 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,& |
---|
197 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
198 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
199 | & __LINE__,MYFILE) |
---|
200 | iv=iv+1 |
---|
201 | cncvar(iv)=TRIM(cncvarbase)//'_count' |
---|
202 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,& |
---|
203 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
204 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
205 | & __LINE__,MYFILE) |
---|
206 | ENDDO |
---|
207 | WRITE(cncvarbase,'(A)')TRIM(cdvar(jvar)) |
---|
208 | iv=iv+1 |
---|
209 | cncvar(iv)=TRIM(cncvarbase)//'_omean' |
---|
210 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,& |
---|
211 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
212 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
213 | & __LINE__,MYFILE) |
---|
214 | iv=iv+1 |
---|
215 | cncvar(iv)=TRIM(cncvarbase)//'_count' |
---|
216 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,& |
---|
217 | & idimids,idvar(iv)),__LINE__,MYFILE) |
---|
218 | CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),& |
---|
219 | & __LINE__,MYFILE) |
---|
220 | ENDDO |
---|
221 | CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE) |
---|
222 | |
---|
223 | ! Write box names |
---|
224 | |
---|
225 | ip=0 |
---|
226 | DO jbox=1,nbox |
---|
227 | IF (.NOT.lskipbox(jbox)) THEN |
---|
228 | ip=ip+1 |
---|
229 | clboxnam(ip)=cdboxnam(jbox) |
---|
230 | ENDIF |
---|
231 | ENDDO |
---|
232 | CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),& |
---|
233 | & __LINE__,MYFILE) |
---|
234 | |
---|
235 | ! Write levels |
---|
236 | |
---|
237 | CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),& |
---|
238 | & __LINE__,MYFILE) |
---|
239 | |
---|
240 | ! Write the output data |
---|
241 | |
---|
242 | iv=0 |
---|
243 | DO jvar=1,nvar |
---|
244 | DO jadd=1,nadd |
---|
245 | iv=iv+1 |
---|
246 | ip=0 |
---|
247 | DO jbox=1,nbox |
---|
248 | IF (.NOT.lskipbox(jbox)) THEN |
---|
249 | ip=ip+1 |
---|
250 | ztmp(:,ip)=pbias(:,ip,jadd,jvar) |
---|
251 | ENDIF |
---|
252 | ENDDO |
---|
253 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),& |
---|
254 | & __LINE__,MYFILE) |
---|
255 | iv=iv+1 |
---|
256 | ip=0 |
---|
257 | DO jbox=1,nbox |
---|
258 | IF (.NOT.lskipbox(jbox)) THEN |
---|
259 | ip=ip+1 |
---|
260 | ztmp(:,ip)=prms(:,ip,jadd,jvar) |
---|
261 | ENDIF |
---|
262 | ENDDO |
---|
263 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),& |
---|
264 | & __LINE__,MYFILE) |
---|
265 | iv=iv+1 |
---|
266 | ip=0 |
---|
267 | DO jbox=1,nbox |
---|
268 | IF (.NOT.lskipbox(jbox)) THEN |
---|
269 | ip=ip+1 |
---|
270 | ztmp(:,ip)=pstd(:,ip,jadd,jvar) |
---|
271 | ENDIF |
---|
272 | ENDDO |
---|
273 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),& |
---|
274 | & __LINE__,MYFILE) |
---|
275 | iv=iv+1 |
---|
276 | ip=0 |
---|
277 | DO jbox=1,nbox |
---|
278 | IF (.NOT.lskipbox(jbox)) THEN |
---|
279 | ip=ip+1 |
---|
280 | ztmp(:,ip)=pomean(:,ip,jadd,jvar) |
---|
281 | ENDIF |
---|
282 | ENDDO |
---|
283 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),& |
---|
284 | & __LINE__,MYFILE) |
---|
285 | iv=iv+1 |
---|
286 | ip=0 |
---|
287 | DO jbox=1,nbox |
---|
288 | IF (.NOT.lskipbox(jbox)) THEN |
---|
289 | ip=ip+1 |
---|
290 | ztmp(:,ip)=pmmean(:,ip,jadd,jvar) |
---|
291 | ENDIF |
---|
292 | ENDDO |
---|
293 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),& |
---|
294 | & __LINE__,MYFILE) |
---|
295 | iv=iv+1 |
---|
296 | ip=0 |
---|
297 | DO jbox=1,nbox |
---|
298 | IF (.NOT.lskipbox(jbox)) THEN |
---|
299 | ip=ip+1 |
---|
300 | itmp(:,ip)=knum(:,ip,jadd,jvar) |
---|
301 | ENDIF |
---|
302 | ENDDO |
---|
303 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),& |
---|
304 | & __LINE__,MYFILE) |
---|
305 | ENDDO |
---|
306 | DO jadd=1,nobe |
---|
307 | iv=iv+1 |
---|
308 | ip=0 |
---|
309 | DO jbox=1,nbox |
---|
310 | IF (.NOT.lskipbox(jbox)) THEN |
---|
311 | ip=ip+1 |
---|
312 | ztmp(:,ip)=poerr(:,ip,jadd,jvar) |
---|
313 | ENDIF |
---|
314 | ENDDO |
---|
315 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),& |
---|
316 | & __LINE__,MYFILE) |
---|
317 | iv=iv+1 |
---|
318 | ip=0 |
---|
319 | DO jbox=1,nbox |
---|
320 | IF (.NOT.lskipbox(jbox)) THEN |
---|
321 | ip=ip+1 |
---|
322 | ztmp(:,ip)=povar(:,ip,jadd,jvar) |
---|
323 | ENDIF |
---|
324 | ENDDO |
---|
325 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),& |
---|
326 | & __LINE__,MYFILE) |
---|
327 | iv=iv+1 |
---|
328 | ip=0 |
---|
329 | DO jbox=1,nbox |
---|
330 | IF (.NOT.lskipbox(jbox)) THEN |
---|
331 | ip=ip+1 |
---|
332 | itmp(:,ip)=knumo(:,ip,jadd,jvar) |
---|
333 | ENDIF |
---|
334 | ENDDO |
---|
335 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),& |
---|
336 | & __LINE__,MYFILE) |
---|
337 | ENDDO |
---|
338 | DO jadd=1,nbge |
---|
339 | iv=iv+1 |
---|
340 | ip=0 |
---|
341 | DO jbox=1,nbox |
---|
342 | IF (.NOT.lskipbox(jbox)) THEN |
---|
343 | ip=ip+1 |
---|
344 | ztmp(:,ip)=pberr(:,ip,jadd,jvar) |
---|
345 | ENDIF |
---|
346 | ENDDO |
---|
347 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),& |
---|
348 | & __LINE__,MYFILE) |
---|
349 | iv=iv+1 |
---|
350 | ip=0 |
---|
351 | DO jbox=1,nbox |
---|
352 | IF (.NOT.lskipbox(jbox)) THEN |
---|
353 | ip=ip+1 |
---|
354 | ztmp(:,ip)=pbvar(:,ip,jadd,jvar) |
---|
355 | ENDIF |
---|
356 | ENDDO |
---|
357 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),& |
---|
358 | & __LINE__,MYFILE) |
---|
359 | iv=iv+1 |
---|
360 | ip=0 |
---|
361 | DO jbox=1,nbox |
---|
362 | IF (.NOT.lskipbox(jbox)) THEN |
---|
363 | ip=ip+1 |
---|
364 | itmp(:,ip)=knumb(:,ip,jadd,jvar) |
---|
365 | ENDIF |
---|
366 | ENDDO |
---|
367 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),& |
---|
368 | & __LINE__,MYFILE) |
---|
369 | ENDDO |
---|
370 | iv=iv+1 |
---|
371 | ip=0 |
---|
372 | DO jbox=1,nbox |
---|
373 | IF (.NOT.lskipbox(jbox)) THEN |
---|
374 | ip=ip+1 |
---|
375 | ztmp(:,ip)=poamean(:,ip,jvar) |
---|
376 | ENDIF |
---|
377 | ENDDO |
---|
378 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),& |
---|
379 | & __LINE__,MYFILE) |
---|
380 | iv=iv+1 |
---|
381 | ip=0 |
---|
382 | DO jbox=1,nbox |
---|
383 | IF (.NOT.lskipbox(jbox)) THEN |
---|
384 | ip=ip+1 |
---|
385 | itmp(:,ip)=knuma(:,ip,jvar) |
---|
386 | ENDIF |
---|
387 | ENDDO |
---|
388 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),& |
---|
389 | & __LINE__,MYFILE) |
---|
390 | ENDDO |
---|
391 | |
---|
392 | ! Close the file |
---|
393 | |
---|
394 | CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE) |
---|
395 | |
---|
396 | DEALLOCATE(cncvar,idvar,ztmp,itmp,clboxnam) |
---|
397 | |
---|
398 | END SUBROUTINE fbstat_ncwrite |
---|
399 | |
---|
400 | SUBROUTINE fbstat_ncwrite_hist(cdfilename,nvar,cdvar,nadd,cdadd,& |
---|
401 | & nbox,lenboxname,cdboxnam,lskipbox,nlev,pdep,& |
---|
402 | & zhist,zhistmin,zhiststep,ntyp) |
---|
403 | ! Arguments |
---|
404 | CHARACTER(len=*) :: cdfilename ! Netcdf filename |
---|
405 | INTEGER :: nvar ! Number of variables |
---|
406 | CHARACTER(len=*), DIMENSION(nvar) :: cdvar ! Name of variables |
---|
407 | INTEGER :: nadd ! Number of addiables |
---|
408 | CHARACTER(len=*), DIMENSION(nadd) :: cdadd ! Name of entries |
---|
409 | INTEGER :: nbox ! Number of boxes |
---|
410 | INTEGER :: lenboxname ! Length of box names |
---|
411 | CHARACTER(len=lenboxname), dimension(nbox) :: & |
---|
412 | & cdboxnam ! Name of boxes |
---|
413 | LOGICAL, DIMENSION(nbox) :: lskipbox ! Boxes to skip |
---|
414 | INTEGER :: nlev ! Number of levels |
---|
415 | REAL,DIMENSION(nlev) :: pdep ! Depth of levels |
---|
416 | TYPE(histtype), DIMENSION(nvar) :: zhist ! Histogram data |
---|
417 | REAL, DIMENSION(nvar) :: & |
---|
418 | & zhistmin,zhiststep ! Histogram info |
---|
419 | integer :: ntyp ! Type to write |
---|
420 | ! Local variables |
---|
421 | INTEGER :: jadd,jvar,incvar,ji,iv,ip,jbox |
---|
422 | CHARACTER(len=50) :: cncvarbase |
---|
423 | CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar |
---|
424 | ! netcdf stuff |
---|
425 | INTEGER :: ncid,idlev,idbox,idlbox,idimhist(nvar),& |
---|
426 | & idimdep(1),idimbox(2),idimids(2),idimval(1),idimcnt(3) |
---|
427 | INTEGER :: idvbox,idvlev |
---|
428 | INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar |
---|
429 | CHARACTER(len=40) :: cdhdimname |
---|
430 | REAL, ALLOCATABLE, DIMENSION(:) :: zhval |
---|
431 | INTEGER :: inoboxes |
---|
432 | INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: itmp |
---|
433 | CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: & |
---|
434 | & clboxnam ! Name of boxes |
---|
435 | |
---|
436 | ! Open netCDF files. |
---|
437 | |
---|
438 | CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),& |
---|
439 | & __LINE__,MYFILE) |
---|
440 | |
---|
441 | ! Create dimensions |
---|
442 | |
---|
443 | inoboxes=nbox-COUNT(lskipbox) |
---|
444 | ALLOCATE(clboxnam(inoboxes)) |
---|
445 | |
---|
446 | CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE) |
---|
447 | |
---|
448 | CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),& |
---|
449 | & __LINE__,MYFILE) |
---|
450 | |
---|
451 | CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE) |
---|
452 | |
---|
453 | DO jvar=1,nvar |
---|
454 | WRITE(cdhdimname,'(A,A)')'hist',TRIM(cdvar(jvar)) |
---|
455 | CALL nchdlerr(nf90_def_dim(ncid,TRIM(cdhdimname),& |
---|
456 | & zhist(jvar)%npoints,idimhist(jvar)),& |
---|
457 | & __LINE__,MYFILE) |
---|
458 | ENDDO |
---|
459 | |
---|
460 | ! Box variable name |
---|
461 | |
---|
462 | idimbox(1)=idlbox |
---|
463 | idimbox(2)=idbox |
---|
464 | CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),& |
---|
465 | & __LINE__,MYFILE) |
---|
466 | |
---|
467 | ! Depths |
---|
468 | |
---|
469 | idimdep(1)=idlev |
---|
470 | CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),& |
---|
471 | & __LINE__,MYFILE) |
---|
472 | |
---|
473 | ! Histogram values and depths |
---|
474 | |
---|
475 | incvar=nvar+nadd*nvar |
---|
476 | ALLOCATE(cncvar(incvar),idvar(incvar)) |
---|
477 | iv=0 |
---|
478 | DO jvar=1,nvar |
---|
479 | iv=iv+1 |
---|
480 | WRITE(cncvar(iv),'(A,A)')TRIM(cdvar(jvar)),'_val' |
---|
481 | idimval(1)=idimhist(jvar) |
---|
482 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),& |
---|
483 | & nf90_float,idimval,idvar(iv)),& |
---|
484 | & __LINE__,MYFILE) |
---|
485 | DO jadd=1,nadd |
---|
486 | iv=iv+1 |
---|
487 | WRITE(cncvar(iv),'(A,A,A)')TRIM(cdvar(jvar)),& |
---|
488 | & TRIM(cdadd(jadd)),'_count' |
---|
489 | idimcnt(1)=idimhist(jvar) |
---|
490 | idimcnt(2)=idlev |
---|
491 | idimcnt(3)=idbox |
---|
492 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),& |
---|
493 | & nf90_int,idimcnt,idvar(iv)),& |
---|
494 | & __LINE__,MYFILE) |
---|
495 | ENDDO |
---|
496 | ENDDO |
---|
497 | CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE) |
---|
498 | |
---|
499 | ! Write box names |
---|
500 | |
---|
501 | ip=0 |
---|
502 | DO jbox=1,nbox |
---|
503 | IF (.NOT.lskipbox(jbox)) THEN |
---|
504 | ip=ip+1 |
---|
505 | clboxnam(ip)=cdboxnam(jbox) |
---|
506 | ENDIF |
---|
507 | ENDDO |
---|
508 | CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),& |
---|
509 | & __LINE__,MYFILE) |
---|
510 | |
---|
511 | ! Write levels |
---|
512 | |
---|
513 | CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),& |
---|
514 | & __LINE__,MYFILE) |
---|
515 | |
---|
516 | iv=0 |
---|
517 | DO jvar=1,nvar |
---|
518 | iv=iv+1 |
---|
519 | ALLOCATE(zhval(zhist(jvar)%npoints)) |
---|
520 | DO ji=1,zhist(jvar)%npoints |
---|
521 | zhval(ji)=(ji-1)*zhiststep(jvar)+zhistmin(jvar) |
---|
522 | ENDDO |
---|
523 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),zhval),& |
---|
524 | & __LINE__,MYFILE) |
---|
525 | DEALLOCATE(zhval) |
---|
526 | DO jadd=1,nadd |
---|
527 | iv=iv+1 |
---|
528 | ALLOCATE(itmp(zhist(jvar)%npoints,nlev,inoboxes)) |
---|
529 | ip=0 |
---|
530 | DO jbox=1,nbox |
---|
531 | IF(.NOT.lskipbox(jbox)) THEN |
---|
532 | ip=ip+1 |
---|
533 | itmp(:,:,ip)=zhist(jvar)%nhist(:,:,ip,jadd,ntyp) |
---|
534 | ENDIF |
---|
535 | ENDDO |
---|
536 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),& |
---|
537 | & __LINE__,MYFILE) |
---|
538 | DEALLOCATE(itmp) |
---|
539 | ENDDO |
---|
540 | ENDDO |
---|
541 | |
---|
542 | ! Close the file |
---|
543 | |
---|
544 | CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE) |
---|
545 | |
---|
546 | DEALLOCATE(cncvar,idvar,clboxnam) |
---|
547 | |
---|
548 | END SUBROUTINE fbstat_ncwrite_hist |
---|
549 | |
---|
550 | SUBROUTINE fbstat_ncwrite_xy(cdfilename,nvar,cdvar,nadd,cdadd,& |
---|
551 | & nbox,lenboxname,cdboxnam,lskipbox,nlev,pdep,& |
---|
552 | & zxy,zxymin,zxystep,ntyp) |
---|
553 | ! Arguments |
---|
554 | CHARACTER(len=*) :: cdfilename ! Netcdf filename |
---|
555 | INTEGER :: nvar ! Number of variables |
---|
556 | CHARACTER(len=*), DIMENSION(nvar) :: cdvar ! Name of variables |
---|
557 | INTEGER :: nadd ! Number of addiables |
---|
558 | CHARACTER(len=*), DIMENSION(nadd) :: cdadd ! Name of entries |
---|
559 | INTEGER :: nbox ! Number of boxes |
---|
560 | INTEGER :: lenboxname ! Length of box names |
---|
561 | CHARACTER(len=lenboxname), dimension(nbox) :: & |
---|
562 | & cdboxnam ! Name of boxes |
---|
563 | LOGICAL, DIMENSION(nbox) :: lskipbox ! Boxes to skip |
---|
564 | INTEGER :: nlev ! Number of levels |
---|
565 | REAL,DIMENSION(nlev) :: pdep ! Depth of levels |
---|
566 | TYPE(xytype), DIMENSION(nvar) :: zxy ! xyplot data |
---|
567 | REAL, DIMENSION(nvar) :: & |
---|
568 | & zxymin,zxystep ! xyplot info |
---|
569 | integer :: ntyp ! Type to write |
---|
570 | ! Local variables |
---|
571 | INTEGER :: jadd,jvar,incvar,ji,iv,ip,jbox |
---|
572 | CHARACTER(len=50) :: cncvarbase |
---|
573 | CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar |
---|
574 | ! netcdf stuff |
---|
575 | INTEGER :: ncid,idlev,idbox,idlbox,idimxy(nvar),& |
---|
576 | & idimdep(1),idimbox(2),idimids(2),idimval(1),idimcnt(4) |
---|
577 | INTEGER :: idvbox,idvlev |
---|
578 | INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar |
---|
579 | CHARACTER(len=40) :: cdhdimname |
---|
580 | REAL, ALLOCATABLE, DIMENSION(:) :: zhval |
---|
581 | INTEGER :: inoboxes |
---|
582 | INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: itmp |
---|
583 | CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: & |
---|
584 | & clboxnam ! Name of boxes |
---|
585 | |
---|
586 | ! Open netCDF files. |
---|
587 | |
---|
588 | CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),& |
---|
589 | & __LINE__,MYFILE) |
---|
590 | |
---|
591 | ! Create dimensions |
---|
592 | |
---|
593 | inoboxes=nbox-COUNT(lskipbox) |
---|
594 | ALLOCATE(clboxnam(inoboxes)) |
---|
595 | |
---|
596 | CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE) |
---|
597 | |
---|
598 | CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),& |
---|
599 | & __LINE__,MYFILE) |
---|
600 | |
---|
601 | CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE) |
---|
602 | |
---|
603 | DO jvar=1,nvar |
---|
604 | WRITE(cdhdimname,'(A,A)')'xy',TRIM(cdvar(jvar)) |
---|
605 | CALL nchdlerr(nf90_def_dim(ncid,TRIM(cdhdimname),& |
---|
606 | & zxy(jvar)%npoints,idimxy(jvar)),& |
---|
607 | & __LINE__,MYFILE) |
---|
608 | ENDDO |
---|
609 | |
---|
610 | ! Box variable name |
---|
611 | |
---|
612 | idimbox(1)=idlbox |
---|
613 | idimbox(2)=idbox |
---|
614 | CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),& |
---|
615 | & __LINE__,MYFILE) |
---|
616 | |
---|
617 | ! Depths |
---|
618 | |
---|
619 | idimdep(1)=idlev |
---|
620 | CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),& |
---|
621 | & __LINE__,MYFILE) |
---|
622 | |
---|
623 | ! Histogram values and depths |
---|
624 | |
---|
625 | incvar=nvar+nadd*nvar |
---|
626 | ALLOCATE(cncvar(incvar),idvar(incvar)) |
---|
627 | iv=0 |
---|
628 | DO jvar=1,nvar |
---|
629 | iv=iv+1 |
---|
630 | WRITE(cncvar(iv),'(A,A)')TRIM(cdvar(jvar)),'_val' |
---|
631 | idimval(1)=idimxy(jvar) |
---|
632 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),& |
---|
633 | & nf90_float,idimval,idvar(iv)),& |
---|
634 | & __LINE__,MYFILE) |
---|
635 | DO jadd=1,nadd |
---|
636 | iv=iv+1 |
---|
637 | WRITE(cncvar(iv),'(A,A,A)')TRIM(cdvar(jvar)),& |
---|
638 | & TRIM(cdadd(jadd)),'_count' |
---|
639 | idimcnt(1)=idimxy(jvar) |
---|
640 | idimcnt(2)=idimxy(jvar) |
---|
641 | idimcnt(3)=idlev |
---|
642 | idimcnt(4)=idbox |
---|
643 | CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),& |
---|
644 | & nf90_int,idimcnt,idvar(iv)),& |
---|
645 | & __LINE__,MYFILE) |
---|
646 | ENDDO |
---|
647 | ENDDO |
---|
648 | CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE) |
---|
649 | |
---|
650 | ! Write box names |
---|
651 | |
---|
652 | ip=0 |
---|
653 | DO jbox=1,nbox |
---|
654 | IF (.NOT.lskipbox(jbox)) THEN |
---|
655 | ip=ip+1 |
---|
656 | clboxnam(ip)=cdboxnam(jbox) |
---|
657 | ENDIF |
---|
658 | ENDDO |
---|
659 | CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),& |
---|
660 | & __LINE__,MYFILE) |
---|
661 | |
---|
662 | ! Write levels |
---|
663 | |
---|
664 | CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),& |
---|
665 | & __LINE__,MYFILE) |
---|
666 | |
---|
667 | iv=0 |
---|
668 | DO jvar=1,nvar |
---|
669 | iv=iv+1 |
---|
670 | ALLOCATE(zhval(zxy(jvar)%npoints)) |
---|
671 | DO ji=1,zxy(jvar)%npoints |
---|
672 | zhval(ji)=(ji-1)*zxystep(jvar)+zxymin(jvar) |
---|
673 | ENDDO |
---|
674 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),zhval),& |
---|
675 | & __LINE__,MYFILE) |
---|
676 | DEALLOCATE(zhval) |
---|
677 | DO jadd=1,nadd |
---|
678 | iv=iv+1 |
---|
679 | ALLOCATE(itmp(zxy(jvar)%npoints,zxy(jvar)%npoints,nlev,inoboxes)) |
---|
680 | ip=0 |
---|
681 | DO jbox=1,nbox |
---|
682 | IF(.NOT.lskipbox(jbox)) THEN |
---|
683 | ip=ip+1 |
---|
684 | itmp(:,:,:,ip)=zxy(jvar)%nxy(:,:,:,ip,jadd,ntyp) |
---|
685 | ENDIF |
---|
686 | ENDDO |
---|
687 | CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),& |
---|
688 | & __LINE__,MYFILE) |
---|
689 | DEALLOCATE(itmp) |
---|
690 | ENDDO |
---|
691 | ENDDO |
---|
692 | |
---|
693 | ! Close the file |
---|
694 | |
---|
695 | CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE) |
---|
696 | |
---|
697 | DEALLOCATE(cncvar,idvar,clboxnam) |
---|
698 | |
---|
699 | END SUBROUTINE fbstat_ncwrite_xy |
---|
700 | |
---|
701 | SUBROUTINE fbstat_ncread(cdfilename,cdvar,sdata) |
---|
702 | ! Arguments |
---|
703 | CHARACTER(len=*) :: cdfilename ! Netcdf filename |
---|
704 | CHARACTER(len=*) :: cdvar ! Name of variables |
---|
705 | TYPE(fbstatnctype) :: sdata ! Data to be filled |
---|
706 | ! Local variables |
---|
707 | INTEGER :: nbox,nlev,nadd,nvar |
---|
708 | INTEGER :: ncid,dimid,varid,i,icntpos |
---|
709 | CHARACTER(len=128) :: cdname,tmpname |
---|
710 | |
---|
711 | ! Open the file and get the dimensions |
---|
712 | |
---|
713 | CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE) |
---|
714 | CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE) |
---|
715 | CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,& |
---|
716 | & len=nbox),__LINE__,MYFILE) |
---|
717 | CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE) |
---|
718 | CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,& |
---|
719 | & len=nlev),__LINE__,MYFILE) |
---|
720 | CALL nchdlerr(nf90_inquire(ncid,nVariables=nvar),__LINE__,MYFILE) |
---|
721 | |
---|
722 | ! Count the number of variables and find the "count" position |
---|
723 | |
---|
724 | nadd=0 |
---|
725 | icntpos=0 |
---|
726 | DO i=1,nvar |
---|
727 | CALL nchdlerr(nf90_inquire_variable(ncid,i,name=cdname),& |
---|
728 | & __LINE__,MYFILE) |
---|
729 | IF (TRIM(cdvar)//'_count'==TRIM(cdname)) THEN |
---|
730 | icntpos=i |
---|
731 | ELSE |
---|
732 | IF (TRIM(cdvar)==cdname(1:LEN_TRIM(cdvar))) THEN |
---|
733 | tmpname=cdname(LEN_TRIM(cdvar)+2:) |
---|
734 | IF (INDEX(tmpname,'_')==0) THEN |
---|
735 | nadd=nadd+1 |
---|
736 | ENDIF |
---|
737 | ENDIF |
---|
738 | ENDIF |
---|
739 | ENDDO |
---|
740 | |
---|
741 | ! Allocate the data structure |
---|
742 | |
---|
743 | CALL fbstat_ncread_alloc(sdata,nlev,nbox,nadd) |
---|
744 | |
---|
745 | ! Get the box names in files |
---|
746 | |
---|
747 | CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE) |
---|
748 | CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE) |
---|
749 | |
---|
750 | ! Get the depths |
---|
751 | |
---|
752 | CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE) |
---|
753 | CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE) |
---|
754 | |
---|
755 | nadd=0 |
---|
756 | DO i=1,nvar |
---|
757 | CALL nchdlerr(nf90_inquire_variable(ncid,i,name=cdname),& |
---|
758 | & __LINE__,MYFILE) |
---|
759 | IF (i==icntpos) THEN |
---|
760 | CALL nchdlerr(nf90_get_var(ncid,i,sdata%cnt),__LINE__,MYFILE) |
---|
761 | ELSE |
---|
762 | IF (TRIM(cdvar)==cdname(1:LEN_TRIM(cdvar))) THEN |
---|
763 | tmpname=cdname(LEN_TRIM(cdvar)+2:) |
---|
764 | IF (INDEX(tmpname,'_')==0) THEN |
---|
765 | nadd=nadd+1 |
---|
766 | sdata%name(nadd)=tmpname(1:MAX(LEN_TRIM(tmpname),32)) |
---|
767 | CALL nchdlerr(nf90_get_var(ncid,i,sdata%val(:,:,nadd)),& |
---|
768 | & __LINE__,MYFILE) |
---|
769 | ENDIF |
---|
770 | ENDIF |
---|
771 | ENDIF |
---|
772 | ENDDO |
---|
773 | |
---|
774 | CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE) |
---|
775 | |
---|
776 | END SUBROUTINE fbstat_ncread |
---|
777 | |
---|
778 | SUBROUTINE fbstat_ncread_alloc(sdata,nlev,nbox,nadd) |
---|
779 | ! Arguments |
---|
780 | TYPE(fbstatnctype) :: sdata ! Data to be allocated |
---|
781 | INTEGER :: nlev,nbox,nadd |
---|
782 | ! Local variables |
---|
783 | |
---|
784 | sdata%nlev=nlev |
---|
785 | sdata%nbox=nbox |
---|
786 | sdata%nadd=nadd |
---|
787 | ALLOCATE( & |
---|
788 | & sdata%area(nbox), & |
---|
789 | & sdata%dep(nlev), & |
---|
790 | & sdata%name(nadd), & |
---|
791 | & sdata%val(nlev,nbox,nadd), & |
---|
792 | & sdata%cnt(nlev,nbox) & |
---|
793 | ) |
---|
794 | |
---|
795 | END SUBROUTINE fbstat_ncread_alloc |
---|
796 | |
---|
797 | SUBROUTINE fbstat_ncread_dealloc(sdata) |
---|
798 | ! Arguments |
---|
799 | TYPE(fbstatnctype) :: sdata ! Data to be deallocated |
---|
800 | ! Local variables |
---|
801 | |
---|
802 | sdata%nlev=0 |
---|
803 | sdata%nbox=0 |
---|
804 | sdata%nadd=0 |
---|
805 | DEALLOCATE( & |
---|
806 | & sdata%area, & |
---|
807 | & sdata%dep, & |
---|
808 | & sdata%name, & |
---|
809 | & sdata%val, & |
---|
810 | & sdata%cnt & |
---|
811 | ) |
---|
812 | |
---|
813 | END SUBROUTINE fbstat_ncread_dealloc |
---|
814 | |
---|
815 | SUBROUTINE fbstat_ncread_hist(cdfilename,cdvar,cdext,sdata) |
---|
816 | ! Arguments |
---|
817 | CHARACTER(len=*) :: cdfilename ! Netcdf filename |
---|
818 | CHARACTER(len=*) :: cdvar ! Name of variables |
---|
819 | CHARACTER(len=*) :: cdext ! Name of extras |
---|
820 | TYPE(fbstathistnctype) :: sdata ! Data to be filled |
---|
821 | ! Local variables |
---|
822 | INTEGER :: nbox,nlev,npoints |
---|
823 | INTEGER :: ncid,dimid,varid |
---|
824 | |
---|
825 | ! Open the file and get the dimensions |
---|
826 | |
---|
827 | CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE) |
---|
828 | CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE) |
---|
829 | CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,& |
---|
830 | & len=nbox),__LINE__,MYFILE) |
---|
831 | CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE) |
---|
832 | CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,& |
---|
833 | & len=nlev),__LINE__,MYFILE) |
---|
834 | CALL nchdlerr(nf90_inq_dimid(ncid,'hist'//TRIM(cdvar),dimid),& |
---|
835 | & __LINE__,MYFILE) |
---|
836 | CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,& |
---|
837 | & len=npoints),__LINE__,MYFILE) |
---|
838 | |
---|
839 | ! Allocate the data structure |
---|
840 | |
---|
841 | CALL fbstat_ncread_hist_alloc(sdata,npoints,nlev,nbox) |
---|
842 | |
---|
843 | ! Get the box names in files |
---|
844 | |
---|
845 | CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE) |
---|
846 | CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE) |
---|
847 | |
---|
848 | ! Get the depths |
---|
849 | |
---|
850 | CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE) |
---|
851 | CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE) |
---|
852 | |
---|
853 | ! Get values |
---|
854 | |
---|
855 | CALL nchdlerr(nf90_inq_varid(ncid,TRIM(cdvar)//'_val',varid),& |
---|
856 | & __LINE__,MYFILE) |
---|
857 | CALL nchdlerr(nf90_get_var(ncid,varid,sdata%val),__LINE__,MYFILE) |
---|
858 | |
---|
859 | ! Get histograms |
---|
860 | |
---|
861 | CALL nchdlerr(nf90_inq_varid(ncid,& |
---|
862 | & TRIM(cdvar)//TRIM(cdext)//'_count',varid),& |
---|
863 | & __LINE__,MYFILE) |
---|
864 | CALL nchdlerr(nf90_get_var(ncid,varid,sdata%nhist),__LINE__,MYFILE) |
---|
865 | |
---|
866 | CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE) |
---|
867 | |
---|
868 | END SUBROUTINE fbstat_ncread_hist |
---|
869 | |
---|
870 | SUBROUTINE fbstat_ncread_hist_alloc(sdata,npoints,nlev,nbox) |
---|
871 | ! Arguments |
---|
872 | TYPE(fbstathistnctype) :: sdata ! Data to be allocated |
---|
873 | INTEGER :: npoints,nlev,nbox |
---|
874 | ! Local variables |
---|
875 | |
---|
876 | sdata%nlev=nlev |
---|
877 | sdata%nbox=nbox |
---|
878 | sdata%npoints=npoints |
---|
879 | ALLOCATE( & |
---|
880 | & sdata%area(nbox), & |
---|
881 | & sdata%dep(nlev), & |
---|
882 | & sdata%val(npoints), & |
---|
883 | & sdata%nhist(npoints,nlev,nbox) & |
---|
884 | & ) |
---|
885 | |
---|
886 | END SUBROUTINE fbstat_ncread_hist_alloc |
---|
887 | |
---|
888 | SUBROUTINE fbstat_ncread_hist_dealloc(sdata) |
---|
889 | ! Arguments |
---|
890 | TYPE(fbstathistnctype) :: sdata ! Data to be deallocated |
---|
891 | ! Local variables |
---|
892 | |
---|
893 | sdata%nlev=0 |
---|
894 | sdata%nbox=0 |
---|
895 | sdata%npoints=0 |
---|
896 | DEALLOCATE( & |
---|
897 | & sdata%area, & |
---|
898 | & sdata%dep, & |
---|
899 | & sdata%val, & |
---|
900 | & sdata%nhist & |
---|
901 | & ) |
---|
902 | |
---|
903 | END SUBROUTINE fbstat_ncread_hist_dealloc |
---|
904 | |
---|
905 | SUBROUTINE fbstat_ncread_xy(cdfilename,cdvar,cdext,sdata) |
---|
906 | ! Arguments |
---|
907 | CHARACTER(len=*) :: cdfilename ! Netcdf filename |
---|
908 | CHARACTER(len=*) :: cdvar ! Name of variables |
---|
909 | CHARACTER(len=*) :: cdext ! Name of extras |
---|
910 | TYPE(fbstatxynctype) :: sdata ! Data to be filled |
---|
911 | ! Local variables |
---|
912 | INTEGER :: nbox,nlev,npoints |
---|
913 | INTEGER :: ncid,dimid,varid |
---|
914 | |
---|
915 | ! Open the file and get the dimensions |
---|
916 | |
---|
917 | CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE) |
---|
918 | CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE) |
---|
919 | CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,& |
---|
920 | & len=nbox),__LINE__,MYFILE) |
---|
921 | CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE) |
---|
922 | CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,& |
---|
923 | & len=nlev),__LINE__,MYFILE) |
---|
924 | CALL nchdlerr(nf90_inq_dimid(ncid,'xy'//TRIM(cdvar),dimid),& |
---|
925 | & __LINE__,MYFILE) |
---|
926 | CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,& |
---|
927 | & len=npoints),__LINE__,MYFILE) |
---|
928 | |
---|
929 | ! Allocate the data structure |
---|
930 | |
---|
931 | CALL fbstat_ncread_xy_alloc(sdata,npoints,nlev,nbox) |
---|
932 | |
---|
933 | ! Get the box names in files |
---|
934 | |
---|
935 | CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE) |
---|
936 | CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE) |
---|
937 | |
---|
938 | ! Get the depths |
---|
939 | |
---|
940 | CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE) |
---|
941 | CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE) |
---|
942 | |
---|
943 | ! Get values |
---|
944 | |
---|
945 | CALL nchdlerr(nf90_inq_varid(ncid,TRIM(cdvar)//'_val',varid),& |
---|
946 | & __LINE__,MYFILE) |
---|
947 | CALL nchdlerr(nf90_get_var(ncid,varid,sdata%val),__LINE__,MYFILE) |
---|
948 | |
---|
949 | ! Get xyograms |
---|
950 | |
---|
951 | CALL nchdlerr(nf90_inq_varid(ncid,& |
---|
952 | & TRIM(cdvar)//TRIM(cdext)//'_count',varid),& |
---|
953 | & __LINE__,MYFILE) |
---|
954 | CALL nchdlerr(nf90_get_var(ncid,varid,sdata%nxy),__LINE__,MYFILE) |
---|
955 | |
---|
956 | CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE) |
---|
957 | |
---|
958 | END SUBROUTINE fbstat_ncread_xy |
---|
959 | |
---|
960 | SUBROUTINE fbstat_ncread_xy_alloc(sdata,npoints,nlev,nbox) |
---|
961 | ! Arguments |
---|
962 | TYPE(fbstatxynctype) :: sdata ! Data to be allocated |
---|
963 | INTEGER :: npoints,nlev,nbox |
---|
964 | ! Local variables |
---|
965 | |
---|
966 | sdata%nlev=nlev |
---|
967 | sdata%nbox=nbox |
---|
968 | sdata%npoints=npoints |
---|
969 | ALLOCATE( & |
---|
970 | & sdata%area(nbox), & |
---|
971 | & sdata%dep(nlev), & |
---|
972 | & sdata%val(npoints), & |
---|
973 | & sdata%nxy(npoints,npoints,nlev,nbox) & |
---|
974 | & ) |
---|
975 | |
---|
976 | END SUBROUTINE fbstat_ncread_xy_alloc |
---|
977 | |
---|
978 | SUBROUTINE fbstat_ncread_xy_dealloc(sdata) |
---|
979 | ! Arguments |
---|
980 | TYPE(fbstatxynctype) :: sdata ! Data to be deallocated |
---|
981 | ! Local variables |
---|
982 | |
---|
983 | sdata%nlev=0 |
---|
984 | sdata%nbox=0 |
---|
985 | sdata%npoints=0 |
---|
986 | DEALLOCATE( & |
---|
987 | & sdata%area, & |
---|
988 | & sdata%dep, & |
---|
989 | & sdata%val, & |
---|
990 | & sdata%nxy & |
---|
991 | & ) |
---|
992 | |
---|
993 | END SUBROUTINE fbstat_ncread_xy_dealloc |
---|
994 | |
---|
995 | END MODULE fbstatncio |
---|