libsim Versione 7.2.0
vol7d_netcdf_class.f90
1! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2! authors:
3! Davide Cesari <dcesari@arpa.emr.it>
4! Paolo Patruno <ppatruno@arpa.emr.it>
5
6! This program is free software; you can redistribute it and/or
7! modify it under the terms of the GNU General Public License as
8! published by the Free Software Foundation; either version 2 of
9! the License, or (at your option) any later version.
10
11! This program is distributed in the hope that it will be useful,
12! but WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14! GNU General Public License for more details.
15
16! You should have received a copy of the GNU General Public License
17! along with this program. If not, see <http://www.gnu.org/licenses/>.
18
19
20! to translate from C and use here ......
21!#define NC_ERR_READ(nc_status) \
22! if (nc_status != NC_NOERR) { \
23! fprintf(stderr, \
24! "%s: Error reading netCDF file at line %d : %s \n", ProgName, __LINE__, nc_strerror(nc_status) \
25! ); \
26! exit(1);\
27! }
28
29
30
31MODULE vol7d_netcdf_class
32
37use netcdf
39
40IMPLICIT NONE
41PRIVATE
42PUBLIC import, export
43
44character (len=255),parameter:: subcategory="vol7d_netcdf_class"
45
46!!$!>\brief importa
47!!$INTERFACE import
48!!$ MODULE PROCEDURE vol7d_netcdf_import
49!!$END INTERFACE
50
52INTERFACE export
53 MODULE PROCEDURE vol7d_netcdf_export
54END INTERFACE
55
56
57
58CONTAINS
59
60
61
62subroutine vol7d_netcdf_export (this,ncconventions,ncunit,description,filename)
63
64TYPE(vol7d),INTENT(IN) :: this
65integer,optional,intent(inout) :: ncunit
66character(len=*),intent(in) :: ncconventions
67character(len=*),intent(inout),optional :: filename
68character(len=*),INTENT(IN),optional :: description
69
70integer :: lunit
71character(len=254) :: ldescription,arg,lfilename
72integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
73 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
74 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
75 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
76 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
77 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
78 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
79!integer :: im,id,iy
80integer :: tarray(8)
81logical :: opened,exist
82
83integer :: ana_ident_varid,ana_dimid,ana_lon_varid,ana_lat_varid &
84 ,ident_len_dimid,var_len_dimid &
85 ,level_dimid,level_vdim_dimid,level_vect_varid,network_dimid,network_name_varid &
86 ,network_name_len_dimid,timerange_vdim_dimid &
87 ,time_iminuti_varid,time_dimid,timerange_dimid,timerange_vect_varid,var_vdim_dimid &
88 ,dativard_dimid,dativarr_dimid,dativari_dimid,dativarb_dimid,dativarc_len_dimid,dativarc_dimid &
89 ,voldativarr_varid ,voldativari_varid ,voldativard_varid ,voldativarb_varid ,voldativarc_varid &
90 ,anavard_dimid,anavarr_dimid,anavari_dimid,anavarb_dimid,anavarc_len_dimid,anavarc_dimid &
91 ,volanavarr_varid ,volanavari_varid ,volanavard_varid ,volanavarb_varid ,volanavarc_varid &
92 ,anavarr_varid,anavari_varid,anavard_varid,anavarb_varid,anavarc_varid &
93 ,dativarr_varid,dativari_varid,dativard_varid,dativarb_varid,dativarc_varid
94
95
96integer :: i
97
98type(datetime) :: timeref
99character (len=23) :: isodate
100
101
102integer :: category
103character(len=512):: a_name
104
105character(len=65):: varchar(3)
106
107call l4f_launcher(a_name,a_name_append=subcategory)
108category=l4f_category_get(a_name)
109
110
111if (ncconventions == "CF-1.1") then
112 call vol7d_netcdf_export_cf (this,ncconventions,ncunit,description,filename)
113else if (ncconventions /= "CF-1.1 vol7d") then
114
115 call l4f_category_log(category,l4f_fatal,"ncconventions not supported: "// &
116 trim(ncconventions))
117 call raise_fatal_error()
118end if
119
120call date_and_time(values=tarray)
121call getarg(0,arg)
122
123if (present(description))then
124 ldescription=description
125else
126 ldescription="NETCDF generated by: "//trim(arg)
127end if
128
129
130lfilename=trim(arg)//".nc"
131if (index(arg,'/',back=.true.) > 0) lfilename=lfilename(index(arg,'/',back=.true.)+1 : )
132
133if (present(filename))then
134 if (filename == "")then
135 filename=lfilename
136 else
137 lfilename=filename
138 end if
139end if
140
141IF (PRESENT(ncunit)) THEN
142 lunit = ncunit
143ELSE
144 lunit = 0
145ENDIF
146
147IF (lunit == 0) THEN
148
149 INQUIRE(file=lfilename,exist=exist)
150 IF (exist) THEN
151 CALL l4f_category_log(category,l4f_error, &
152 "file exists, cannot open file "//trim(lfilename))
153 CALL raise_fatal_error()
154 END IF
155
156 CALL nccheck( "0",nf90_create(lfilename, nf90_clobber, lunit) )
157 CALL l4f_category_log(category,l4f_info, "opened "//trim(lfilename))
158
159END IF
160IF (PRESENT(ncunit)) ncunit = lunit ! reassign for output
161
162call init(timeref,year=1,month=1,day=1,hour=00,minute=00)
163call getval(timeref,isodate=isodate)
164
165nana=size(this%ana)
166ntime=size(this%time)
167ntimerange=size(this%timerange)
168nlevel=size(this%level)
169nnetwork=size(this%network)
170
171ndativarr=0
172ndativari=0
173ndativarb=0
174ndativard=0
175ndativarc=0
176
177if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
178if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
179if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
180if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
181if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
182
183ndatiattrr=size(this%datiattr%r)
184ndatiattri=size(this%datiattr%i)
185ndatiattrb=size(this%datiattr%b)
186ndatiattrd=size(this%datiattr%d)
187ndatiattrc=size(this%datiattr%c)
188
189ndativarattrr=size(this%dativarattr%r)
190ndativarattri=size(this%dativarattr%i)
191ndativarattrb=size(this%dativarattr%b)
192ndativarattrd=size(this%dativarattr%d)
193ndativarattrc=size(this%dativarattr%c)
194
195nanavarr=0
196nanavari=0
197nanavarb=0
198nanavard=0
199nanavarc=0
200
201if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
202if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
203if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
204if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
205if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
206
207nanaattrr=size(this%anaattr%r)
208nanaattri=size(this%anaattr%i)
209nanaattrb=size(this%anaattr%b)
210nanaattrd=size(this%anaattr%d)
211nanaattrc=size(this%anaattr%c)
212
213nanavarattrr=size(this%anavarattr%r)
214nanavarattri=size(this%anavarattr%i)
215nanavarattrb=size(this%anavarattr%b)
216nanavarattrd=size(this%anavarattr%d)
217nanavarattrc=size(this%anavarattr%c)
218
219!write(unit=lunit)ldescription
220!write(unit=lunit)tarray
221
222
223!call nccheck( "0Conventions",nf90_put_att(lunit, NF90_GLOBAL ,"Conventions",ncconventions))
224call nccheck( "0Conventions",nf90_put_att(lunit, nf90_global ,"Conventions","CF-1.1"))
225call nccheck( "0title",nf90_put_att(lunit, nf90_global ,"title", ldescription))
226
227
228call nccheck( "1",nf90_def_dim(lunit,"ana", nana, ana_dimid) )
229call nccheck( "2",nf90_def_dim(lunit,"ident_len",vol7d_ana_lenident , ident_len_dimid) )
230
231call nccheck( "3",nf90_def_dim(lunit,"time", ntime, time_dimid) )
232
233call nccheck( "4",nf90_def_dim(lunit,"timerange", ntimerange, timerange_dimid) )
234call nccheck( "5",nf90_def_dim(lunit,"timerange_vdim", 3, timerange_vdim_dimid) )
235
236call nccheck( "6",nf90_def_dim(lunit,"level", nlevel, level_dimid) )
237call nccheck( "7",nf90_def_dim(lunit,"level_vdim", 4, level_vdim_dimid) )
238
239call nccheck( "8",nf90_def_dim(lunit,"network_name", nnetwork, network_dimid) )
240call nccheck( "9",nf90_def_dim(lunit,"network_name_len",network_name_len, network_name_len_dimid) )
241
242call nccheck( "10",nf90_def_dim(lunit,"var_vdim",3, var_vdim_dimid) )
243call nccheck( "11",nf90_def_dim(lunit,"var_len",65, var_len_dimid) )
244
245
246if (nanavarr > 0) call nccheck( "a1",nf90_def_dim(lunit,"anavarr", nanavarr, anavarr_dimid) )
247if (nanavari > 0) call nccheck( "a2",nf90_def_dim(lunit,"anavari", nanavari, anavari_dimid) )
248if (nanavarb > 0) call nccheck( "a3",nf90_def_dim(lunit,"anavarb", nanavarb, anavarb_dimid) )
249if (nanavard > 0) call nccheck( "a4",nf90_def_dim(lunit,"anavard", nanavard, anavard_dimid) )
250if (nanavarc > 0) call nccheck( "a5",nf90_def_dim(lunit,"anavarc", nanavarc, anavarc_dimid) )
251call nccheck( "a6",nf90_def_dim(lunit,"anavarc_len",vol7d_cdatalen, anavarc_len_dimid) )
252
253
254if (ndativarr > 0) call nccheck( "d1",nf90_def_dim(lunit,"dativarr", ndativarr, dativarr_dimid) )
255if (ndativari > 0) call nccheck( "d2",nf90_def_dim(lunit,"dativari", ndativari, dativari_dimid) )
256if (ndativarb > 0) call nccheck( "d3",nf90_def_dim(lunit,"dativarb", ndativarb, dativarb_dimid) )
257if (ndativard > 0) call nccheck( "d4",nf90_def_dim(lunit,"dativard", ndativard, dativard_dimid) )
258if (ndativarc > 0) call nccheck( "d5",nf90_def_dim(lunit,"dativarc", ndativarc, dativarc_dimid) )
259call nccheck( "d6",nf90_def_dim(lunit,"dativarc_len",vol7d_cdatalen, dativarc_len_dimid) )
260
261! ripetere per datiattr anavar anaattr -- dativarattr anavarattr
262
263
264call nccheck( "10",nf90_def_var(lunit, "ana_lat", nf90_double, ana_dimid, ana_lat_varid) )
265call nccheck( "10long_name",nf90_put_att(lunit,ana_lat_varid ,"long_name","latitude") )
266call nccheck( "10units",nf90_put_att(lunit,ana_lat_varid ,"units","degrees_north") )
267call nccheck( "10standard_name",nf90_put_att(lunit,ana_lat_varid ,"standard_name","latitude") )
268call nccheck( "10fillvalue",nf90_put_att(lunit,ana_lat_varid ,"_FillValue",dmiss) )
269call nccheck( "10missing_value",nf90_put_att(lunit,ana_lat_varid ,"missing_value",dmiss) )
270
271call nccheck( "11",nf90_def_var(lunit, "ana_lon", nf90_double, ana_dimid, ana_lon_varid) )
272call nccheck( "11long_name",nf90_put_att(lunit,ana_lon_varid ,"long_name","longitude") )
273call nccheck( "11units",nf90_put_att(lunit,ana_lon_varid ,"units","degrees_east") )
274call nccheck( "11standard_name",nf90_put_att(lunit,ana_lon_varid ,"standard_name","longitude") )
275call nccheck( "11fillvalue",nf90_put_att(lunit,ana_lon_varid ,"_FillValue",dmiss) )
276call nccheck( "11missing_value",nf90_put_att(lunit,ana_lon_varid ,"missing_value",dmiss) )
277
278call nccheck( "12",nf90_def_var(lunit, "ana_ident", nf90_char, (/ ident_len_dimid,ana_dimid/), ana_ident_varid) )
279!call nccheck( "12ident",nf90_put_att(lunit,ana_ident_varid ,"long_name","ana_ident") )
280call nccheck( "12fillvalue",nf90_put_att(lunit,ana_ident_varid ,"_FillValue",cmiss) )
281call nccheck( "12missing_value",nf90_put_att(lunit,ana_ident_varid ,"missing_value",cmiss) )
282
283call nccheck( "13",nf90_def_var(lunit, "time", nf90_int, time_dimid, time_iminuti_varid) )
284call nccheck( "1313",nf90_put_att(lunit,time_iminuti_varid, "units","minute since "//isodate) )
285call nccheck( "13fillvalue",nf90_put_att(lunit,time_iminuti_varid ,"_FillValue",imiss) )
286call nccheck( "13missing_value",nf90_put_att(lunit,time_iminuti_varid ,"missing_value",imiss) )
287
288call nccheck( "14",nf90_def_var(lunit, "timerange", nf90_int, (/timerange_vdim_dimid,timerange_dimid/), timerange_vect_varid) )
289call nccheck( "14fillvalue",nf90_put_att(lunit, timerange_vect_varid ,"_FillValue",imiss) )
290call nccheck( "14missing_value",nf90_put_att(lunit, timerange_vect_varid ,"missing_value",imiss) )
291
292call nccheck( "15",nf90_def_var(lunit, "level", nf90_int, (/level_vdim_dimid,level_dimid/), level_vect_varid) )
293call nccheck( "15fillvalue",nf90_put_att(lunit,level_vect_varid ,"_FillValue",imiss) )
294call nccheck( "15missing_value",nf90_put_att(lunit,level_vect_varid ,"missing_value",imiss) )
295
296call nccheck( "16",nf90_def_var(lunit, "network_name", nf90_char,(/ network_name_len_dimid,network_dimid/), network_name_varid) )
297call nccheck( "16fillvalue",nf90_put_att(lunit,network_name_varid ,"_FillValue",cmiss) )
298call nccheck( "16missing_value",nf90_put_att(lunit,network_name_varid ,"missing_value",cmiss) )
299
300
301! anagrafica
302
303if (nanavarr > 0)then
304 call nccheck( "a81" ,nf90_def_var(lunit,"anavarr",nf90_char,&
305 (/var_len_dimid ,var_vdim_dimid,anavarr_dimid/),anavarr_varid ))
306 call nccheck( "a81fillvalue",nf90_put_att(lunit,anavarr_varid ,"_FillValue",cmiss) )
307 call nccheck( "a81missing_value",nf90_put_att(lunit,anavarr_varid ,"missing_value",cmiss) )
308
309 call nccheck( "a82" ,nf90_def_var(lunit,"volanavarr",nf90_real,&
310 (/ana_dimid,anavarr_dimid,network_dimid/),volanavarr_varid ))
311 call nccheck( "a82fillvalue",nf90_put_att(lunit,volanavarr_varid ,"_FillValue",rmiss) )
312 call nccheck( "a82missing_value",nf90_put_att(lunit,volanavarr_varid ,"missing_value",rmiss) )
313end if
314if (nanavari > 0) then
315 call nccheck( "a83" ,nf90_def_var(lunit,"anavari",nf90_char,&
316 (/var_len_dimid,var_vdim_dimid ,anavari_dimid/),anavari_varid ))
317 call nccheck( "a83fillvalue",nf90_put_att(lunit,anavari_varid ,"_FillValue",cmiss) )
318 call nccheck( "a83missing_value",nf90_put_att(lunit,anavari_varid ,"missing_value",cmiss) )
319
320 call nccheck( "a84" ,nf90_def_var(lunit,"volanavari",nf90_int,&
321 (/ana_dimid,anavari_dimid,network_dimid/),volanavari_varid ))
322 call nccheck( "a84fillvalue",nf90_put_att(lunit,volanavari_varid ,"_FillValue",imiss) )
323 call nccheck( "a84missing_value",nf90_put_att(lunit,volanavari_varid ,"missing_value",imiss) )
324end if
325if (nanavard > 0) then
326 call nccheck( "a85" ,nf90_def_var(lunit,"anavard",nf90_char,&
327 (/var_len_dimid,var_vdim_dimid ,anavard_dimid/),anavard_varid ))
328 call nccheck( "a85fillvalue",nf90_put_att(lunit,anavard_varid ,"_FillValue",cmiss) )
329 call nccheck( "a85missing_value",nf90_put_att(lunit,anavard_varid ,"missing_value",cmiss) )
330
331 call nccheck( "a86" ,nf90_def_var(lunit,"volanavard",nf90_double,&
332 (/ana_dimid,anavard_dimid,network_dimid/),volanavard_varid ))
333 call nccheck( "a86fillvalue",nf90_put_att(lunit,volanavard_varid ,"_FillValue",dmiss) )
334 call nccheck( "a86missing_value",nf90_put_att(lunit,volanavard_varid ,"missing_value",dmiss) )
335end if
336if (nanavarb > 0) then
337 call nccheck( "a87" ,nf90_def_var(lunit,"anavarb",nf90_char,&
338 (/var_len_dimid,var_vdim_dimid ,anavarb_dimid/),anavarb_varid ))
339 call nccheck( "a87fillvalue",nf90_put_att(lunit,anavarb_varid ,"_FillValue",cmiss) )
340 call nccheck( "a87missing_value",nf90_put_att(lunit,anavarb_varid ,"missing_value",cmiss) )
341
342 call nccheck( "a88" ,nf90_def_var(lunit,"volanavarb",nf90_byte,&
343 (/ana_dimid,anavarb_dimid,network_dimid/),volanavarb_varid ))
344 call nccheck( "a88fillvalue",nf90_put_att(lunit,volanavarb_varid ,"_FillValue",ibmiss) )
345 call nccheck( "a88missing_value",nf90_put_att(lunit,volanavarb_varid ,"missing_value",ibmiss) )
346end if
347if (nanavarc > 0) then
348 call nccheck( "a89" ,nf90_def_var(lunit,"anavarc",nf90_char,&
349 (/var_len_dimid,var_vdim_dimid ,anavarc_dimid/),anavarc_varid ))
350 call nccheck( "a89fillvalue",nf90_put_att(lunit,anavarc_varid ,"_FillValue",cmiss) )
351 call nccheck( "a89missing_value",nf90_put_att(lunit,anavarc_varid ,"missing_value",cmiss) )
352
353 call nccheck( "a90" ,nf90_def_var(lunit,"volanavarc",nf90_char,&
354 (/anavarc_len_dimid,ana_dimid,anavarc_dimid,network_dimid/),volanavarc_varid ))
355 call nccheck( "a90fillvalue",nf90_put_att(lunit,volanavarc_varid ,"_FillValue",cmiss) )
356 call nccheck( "a90missing_value",nf90_put_att(lunit,volanavarc_varid ,"missing_value",cmiss) )
357end if
358
359
360
361! dati
362
363if (ndativarr > 0) then
364 call nccheck( "d81" ,nf90_def_var(lunit,"dativarr",nf90_char,&
365 (/var_len_dimid,var_vdim_dimid ,dativarr_dimid/),dativarr_varid ))
366 call nccheck( "d8fillvalue",nf90_put_att(lunit,dativarr_varid, "_FillValue",cmiss) )
367 call nccheck( "d8missing_value",nf90_put_att(lunit,dativarr_varid, "missing_value",cmiss) )
368
369 call nccheck( "d82" ,nf90_def_var(lunit,"voldativarr",nf90_real,&
370 (/ana_dimid,time_dimid,level_dimid,timerange_dimid,dativarr_dimid,network_dimid/),voldativarr_varid ))
371 call nccheck( "d82fillvalue",nf90_put_att(lunit,voldativarr_varid , "_FillValue",rmiss) )
372 call nccheck( "d82missing_value",nf90_put_att(lunit,voldativarr_varid , "missing_value",rmiss) )
373end if
374if (ndativari > 0) then
375 call nccheck( "d83" ,nf90_def_var(lunit,"dativari",nf90_char,&
376 (/var_len_dimid,var_vdim_dimid ,dativari_dimid/),dativari_varid ))
377 call nccheck( "d83fillvalue",nf90_put_att(lunit,dativari_varid, "_FillValue",cmiss) )
378 call nccheck( "d83missing_value",nf90_put_att(lunit,dativari_varid, "missing_value",cmiss) )
379
380 call nccheck( "d84" ,nf90_def_var(lunit,"voldativari",nf90_int,&
381 (/ana_dimid,time_dimid,level_dimid,timerange_dimid,dativari_dimid,network_dimid/),voldativari_varid ))
382 call nccheck( "d84fillvalue",nf90_put_att(lunit,voldativari_varid , "_FillValue",imiss) )
383 call nccheck( "d84missing_value",nf90_put_att(lunit,voldativari_varid , "missing_value",imiss) )
384end if
385if (ndativard > 0) then
386 call nccheck( "d85" ,nf90_def_var(lunit,"dativard",nf90_char,&
387 (/var_len_dimid,var_vdim_dimid ,dativard_dimid/),dativard_varid ))
388 call nccheck( "d85fillvalue",nf90_put_att(lunit,dativard_varid, "_FillValue",cmiss) )
389 call nccheck( "d85missing_value",nf90_put_att(lunit,dativard_varid, "missing_value",cmiss) )
390
391 call nccheck( "d86" ,nf90_def_var(lunit,"voldativard",nf90_double,&
392 (/ana_dimid,time_dimid,level_dimid,timerange_dimid,dativard_dimid,network_dimid/),voldativard_varid ))
393 call nccheck( "d86fillvalue",nf90_put_att(lunit,voldativard_varid , "_FillValue",dmiss) )
394 call nccheck( "d86missing_value",nf90_put_att(lunit,voldativard_varid , "missing_value",dmiss) )
395end if
396if (ndativarb > 0) then
397 call nccheck( "d87" ,nf90_def_var(lunit,"dativarb",nf90_char,&
398 (/var_len_dimid,var_vdim_dimid ,dativarb_dimid/),dativarb_varid ))
399 call nccheck( "d87fillvalue",nf90_put_att(lunit,dativarb_varid, "_FillValue",cmiss) )
400 call nccheck( "d87missing_value",nf90_put_att(lunit,dativarb_varid, "missing_value",cmiss) )
401
402 call nccheck( "d88" ,nf90_def_var(lunit,"voldativarb",nf90_byte,&
403 (/ana_dimid,time_dimid,level_dimid,timerange_dimid,dativarb_dimid,network_dimid/),voldativarb_varid ))
404 call nccheck( "d88fillvalue",nf90_put_att(lunit,voldativarb_varid , "_FillValue",ibmiss) )
405 call nccheck( "d88missing_value",nf90_put_att(lunit,voldativarb_varid , "missing_value",ibmiss) )
406end if
407if (ndativarc > 0) then
408 call nccheck( "d89" ,nf90_def_var(lunit,"dativarc",nf90_char,&
409 (/var_len_dimid,var_vdim_dimid ,dativarc_dimid/),dativarc_varid ))
410 call nccheck( "d89fillvalue",nf90_put_att(lunit,dativarc_varid, "_FillValue",cmiss) )
411 call nccheck( "d89missing_value",nf90_put_att(lunit,dativarc_varid, "missing_value",cmiss) )
412
413 call nccheck( "d90" ,nf90_def_var(lunit,"voldativarc",nf90_char,&
414 (/dativarc_len_dimid,ana_dimid,time_dimid,level_dimid,timerange_dimid,dativarc_dimid,network_dimid/),voldativarc_varid ))
415 call nccheck( "d90fillvalue",nf90_put_att(lunit,voldativarc_varid , "_FillValue",cmiss) )
416 call nccheck( "d90missing_value",nf90_put_att(lunit,voldativarc_varid , "missing_value",cmiss) )
417end if
418
419! end definition
420call nccheck("22", nf90_enddef(lunit) )
421
422
423if (associated(this%ana)) call nccheck("23", nf90_put_var(lunit, ana_lat_varid, getlat(this%ana(:)%coord)))
424if (associated(this%ana)) call nccheck("24", nf90_put_var(lunit, ana_lon_varid, getlon(this%ana(:)%coord)))
425
426if (associated(this%ana)) call nccheck("25", nf90_put_var(lunit, ana_ident_varid, this%ana(:)%ident))
427
428if (associated(this%time)) call nccheck("26", nf90_put_var(lunit, time_iminuti_varid , &
429 int(timedelta_getamsec(this%time-timeref)/60000)))
430
431if (associated(this%level)) then
432 do i=1,nlevel
433
434 call nccheck("27", nf90_put_var(lunit, level_vect_varid,&
435 (/this%level(i)%level1,&
436 this%level(i)%l1,&
437 this%level(i)%level2,&
438 this%level(i)%l2/),&
439 start=(/1,i/),count=(/4,1/)))
440 end do
441end if
442
443if (associated(this%timerange)) then
444 do i=1,ntimerange
445 call nccheck( "28",nf90_put_var(lunit, timerange_vect_varid,&
446 (/this%timerange(i)%timerange,&
447 this%timerange(i)%p1,&
448 this%timerange(i)%p2/),&
449 start=(/1,i/),count=(/3,1/)))
450 end do
451end if
452
453if (associated(this%network)) then
454 call nccheck( "29",nf90_put_var(lunit, network_name_varid,this%network(:)%name))
455end if
456
457
458! ana
459
460do i=1,nanavarr
461 if (associated(this%anavar%r)) then
462 varchar(1)= this%anavar%r(i)%description
463 varchar(2)= this%anavar%r(i)%unit
464 varchar(3)= this%anavar%r(i)%btable
465 call nccheck( "a291",nf90_put_var(lunit, anavarr_varid,&
466 varchar&
467 ,start=(/1,1,i/),count=(/65,3,1/)))
468 end if
469end do
470
471do i=1,nanavari
472 if (associated(this%anavar%i)) then
473 varchar(1)= this%anavar%i(i)%description
474 varchar(2)= this%anavar%i(i)%unit
475 varchar(3)= this%anavar%i(i)%btable
476 call nccheck( "a292",nf90_put_var(lunit, anavari_varid,&
477 varchar&
478 ,start=(/1,1,i/),count=(/65,3,1/)))
479 end if
480end do
481
482do i=1,nanavard
483 if (associated(this%anavar%d)) then
484 varchar(1)= this%anavar%d(i)%description
485 varchar(2)= this%anavar%d(i)%unit
486 varchar(3)= this%anavar%d(i)%btable
487 call nccheck( "a293",nf90_put_var(lunit, anavard_varid,&
488 varchar&
489 ,start=(/1,1,i/),count=(/65,3,1/)))
490 end if
491end do
492
493do i=1,nanavarb
494 if (associated(this%anavar%b)) then
495 varchar(1)= this%anavar%b(i)%description
496 varchar(2)= this%anavar%b(i)%unit
497 varchar(3)= this%anavar%b(i)%btable
498 call nccheck( "a294",nf90_put_var(lunit, anavarb_varid,&
499 varchar&
500 ,start=(/1,1,i/),count=(/65,3,1/)))
501 end if
502end do
503
504do i=1,nanavarc
505 if (associated(this%anavar%c)) then
506 varchar(1)= this%anavar%c(i)%description
507 varchar(2)= this%anavar%c(i)%unit
508 varchar(3)= this%anavar%c(i)%btable
509 call nccheck( "a295",nf90_put_var(lunit, anavarc_varid,&
510 varchar&
511 ,start=(/1,1,i/),count=(/65,3,1/)))
512 end if
513end do
514
515
516
517! dati
518
519do i=1,ndativarr
520 if (associated(this%dativar%r)) then
521 varchar(1)=this%dativar%r(i)%description
522 varchar(2)=this%dativar%r(i)%unit
523 varchar(3)=this%dativar%r(i)%btable
524 call nccheck( "a291",nf90_put_var(lunit, dativarr_varid,&
525 varchar&
526 ,start=(/1,1,i/),count=(/65,3,1/)))
527 end if
528end do
529
530do i=1,ndativari
531 if (associated(this%dativar%i)) then
532 varchar(1)=this%dativar%i(i)%description
533 varchar(2)=this%dativar%i(i)%unit
534 varchar(3)=this%dativar%i(i)%btable
535 call nccheck( "a292",nf90_put_var(lunit, dativari_varid,&
536 varchar&
537 ,start=(/1,1,i/),count=(/65,3,1/)))
538 end if
539end do
540
541do i=1,ndativard
542 if (associated(this%dativar%d)) then
543 varchar(1)=this%dativar%d(i)%description
544 varchar(2)=this%dativar%d(i)%unit
545 varchar(3)=this%dativar%d(i)%btable
546 call nccheck( "a293",nf90_put_var(lunit, dativard_varid,&
547 varchar&
548 ,start=(/1,1,i/),count=(/65,3,1/)))
549 end if
550end do
551
552do i=1,ndativarb
553 if (associated(this%dativar%b)) then
554 varchar(1)=this%dativar%b(i)%description
555 varchar(2)=this%dativar%b(i)%unit
556 varchar(3)=this%dativar%b(i)%btable
557 call nccheck( "a294",nf90_put_var(lunit, dativarb_varid,&
558 varchar&
559 ,start=(/1,1,i/),count=(/65,3,1/)))
560 end if
561end do
562
563do i=1,ndativarc
564 if (associated(this%dativar%c)) then
565 varchar(1)=this%dativar%c(i)%description
566 varchar(2)=this%dativar%c(i)%unit
567 varchar(3)=this%dativar%c(i)%btable
568 call nccheck( "a295",nf90_put_var(lunit, dativarc_varid,&
569 varchar&
570 ,start=(/1,1,i/),count=(/65,3,1/)))
571 end if
572end do
573
574
575!!$if (associated(this%volanar)) write(unit=lunit)this%volanar
576if (associated(this%volanar))call nccheck("a231", nf90_put_var(lunit,volanavarr_varid,this%volanar))
577if (associated(this%volanai))call nccheck("a232", nf90_put_var(lunit,volanavari_varid,this%volanai))
578if (associated(this%volanad))call nccheck("a233", nf90_put_var(lunit,volanavard_varid,this%volanad))
579if (associated(this%volanab))call nccheck("a234", nf90_put_var(lunit,volanavarb_varid,this%volanab))
580if (associated(this%volanac))call nccheck("a235", nf90_put_var(lunit,volanavarc_varid,this%volanac))
581
582
583if (associated(this%voldatir))call nccheck("d231", nf90_put_var(lunit,voldativarr_varid,this%voldatir))
584if (associated(this%voldatii))call nccheck("d232", nf90_put_var(lunit,voldativari_varid,this%voldatii))
585if (associated(this%voldatid))call nccheck("d233", nf90_put_var(lunit,voldativard_varid,this%voldatid))
586if (associated(this%voldatib))call nccheck("d234", nf90_put_var(lunit,voldativarb_varid,this%voldatib))
587if (associated(this%voldatic))call nccheck("d235", nf90_put_var(lunit,voldativarc_varid,this%voldatic))
588
589if (.not. present(ncunit)) call nccheck("90", nf90_close(lunit) )
590
591end subroutine vol7d_netcdf_export
592
593
594
595subroutine vol7d_netcdf_export_cf (this,ncconventions,ncunit,description,filename)
596
597TYPE(vol7d),INTENT(IN) :: this
598integer,optional,intent(inout) :: ncunit
599character(len=*),intent(in) :: ncconventions
600character(len=*),intent(inout),optional :: filename
601character(len=*),INTENT(IN),optional :: description
602
603integer :: lunit
604character(len=254) :: ldescription,arg,lfilename
605integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
606 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
607 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
608 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
609 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
610 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
611 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
612!integer :: im,id,iy
613integer :: tarray(8)
614logical :: opened,exist
615
616integer :: ana_ident_varid,ana_dimid,ana_lon_varid,ana_lat_varid &
617 ,ident_len_dimid,var_len_dimid &
618 ,level_dimid,level_vdim_dimid,level_vect_varid,network_dimid,network_id_varid,timerange_vdim_dimid &
619 ,time_iminuti_varid,time_dimid,timerange_dimid,timerange_vect_varid &
620 ,dativard_dimid,dativarr_dimid,dativari_dimid,dativarb_dimid,dativarc_len_dimid,dativarc_dimid &
621 ,dativarr_varid ,dativari_varid ,dativard_varid ,dativarb_varid ,dativarc_varid &
622 ,anavard_dimid,anavarr_dimid,anavari_dimid,anavarb_dimid,anavarc_len_dimid,anavarc_dimid &
623 ,anavarr_varid ,anavari_varid ,anavard_varid ,anavarb_varid ,anavarc_varid &
624 ,anavarr_btable_varid,anavari_btable_varid,anavard_btable_varid,anavarb_btable_varid,anavarc_btable_varid &
625 ,dativarr_btable_varid,dativari_btable_varid,dativard_btable_varid,dativarb_btable_varid,dativarc_btable_varid
626
627
628integer :: i
629
630type(datetime) :: timeref
631
632integer :: category
633character(len=512):: a_name
634
635
636call l4f_launcher(a_name,a_name_append=subcategory)
637category=l4f_category_get(a_name)
638
639
640if (ncconventions /= "CF-1.1") then
641
642 call l4f_category_log(category,l4f_info,"ncconventions not supported: "//trim(ncconventions))
643 call exit(1)
644end if
645
646
647end subroutine vol7d_netcdf_export_cf
648
649
650
651subroutine nccheck(stringa,status)
652integer, intent ( in) :: status
653character (len=*) :: stringa
654
655if(status /= nf90_noerr) then
656 print *, stringa
657 print *, trim(nf90_strerror(status))
658 stop "Stopped"
659end if
660end subroutine nccheck
661
662
663end MODULE vol7d_netcdf_class
Restituiscono il valore dell'oggetto nella forma desiderata.
Costruttori per le classi datetime e timedelta.
Import one or more geo_coordvect objects from a plain text file or for a file in ESRI/Shapefile forma...
Index method.
Emit log message for a category with specific priority.
Utilities for CHARACTER variables.
Classi per la gestione delle coordinate temporali.
Classes for handling georeferenced sparse points in geographical corodinates.
classe per la gestione del logging
Classe per la gestione di un volume completo di dati osservati.
Class for expressing an absolute time value.
Definisce un oggetto contenente i volumi anagrafica e dati e tutti i descrittori delle loro dimension...

Generated with Doxygen.