libsim  Versione 7.1.6
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 
31 MODULE vol7d_netcdf_class
32 
34 USE vol7d_class
37 use netcdf
38 use log4fortran
39 
40 IMPLICIT NONE
41 PRIVATE
42 PUBLIC import, export
43 
44 character (len=255),parameter:: subcategory="vol7d_netcdf_class"
45 
46 !!$!>\brief importa
47 !!$INTERFACE import
48 !!$ MODULE PROCEDURE vol7d_netcdf_import
49 !!$END INTERFACE
50 
52 INTERFACE export
53  MODULE PROCEDURE vol7d_netcdf_export
54 END INTERFACE
55 
56 
57 
58 CONTAINS
59 
60 
61 
62 subroutine vol7d_netcdf_export (this,ncconventions,ncunit,description,filename)
63 
64 TYPE(vol7d),INTENT(IN) :: this
65 integer,optional,intent(inout) :: ncunit
66 character(len=*),intent(in) :: ncconventions
67 character(len=*),intent(inout),optional :: filename
68 character(len=*),INTENT(IN),optional :: description
69 
70 integer :: lunit
71 character(len=254) :: ldescription,arg,lfilename
72 integer :: 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
80 integer :: tarray(8)
81 logical :: opened,exist
82 
83 integer :: 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 
96 integer :: i
97 
98 type(datetime) :: timeref
99 character (len=23) :: isodate
100 
101 
102 integer :: category
103 character(len=512):: a_name
104 
105 character(len=65):: varchar(3)
106 
107 call l4f_launcher(a_name,a_name_append=subcategory)
108 category=l4f_category_get(a_name)
109 
110 
111 if (ncconventions == "CF-1.1") then
112  call vol7d_netcdf_export_cf (this,ncconventions,ncunit,description,filename)
113 else 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()
118 end if
119 
120 call date_and_time(values=tarray)
121 call getarg(0,arg)
122 
123 if (present(description))then
124  ldescription=description
125 else
126  ldescription="NETCDF generated by: "//trim(arg)
127 end if
128 
129 
130 lfilename=trim(arg)//".nc"
131 if (index(arg,'/',back=.true.) > 0) lfilename=lfilename(index(arg,'/',back=.true.)+1 : )
132 
133 if (present(filename))then
134  if (filename == "")then
135  filename=lfilename
136  else
137  lfilename=filename
138  end if
139 end if
140 
141 IF (PRESENT(ncunit)) THEN
142  lunit = ncunit
143 ELSE
144  lunit = 0
145 ENDIF
146 
147 IF (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 
159 END IF
160 IF (PRESENT(ncunit)) ncunit = lunit ! reassign for output
161 
162 call init(timeref,year=1,month=1,day=1,hour=00,minute=00)
163 call getval(timeref,isodate=isodate)
164 
165 nana=size(this%ana)
166 ntime=size(this%time)
167 ntimerange=size(this%timerange)
168 nlevel=size(this%level)
169 nnetwork=size(this%network)
170 
171 ndativarr=0
172 ndativari=0
173 ndativarb=0
174 ndativard=0
175 ndativarc=0
176 
177 if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
178 if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
179 if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
180 if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
181 if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
182 
183 ndatiattrr=size(this%datiattr%r)
184 ndatiattri=size(this%datiattr%i)
185 ndatiattrb=size(this%datiattr%b)
186 ndatiattrd=size(this%datiattr%d)
187 ndatiattrc=size(this%datiattr%c)
188 
189 ndativarattrr=size(this%dativarattr%r)
190 ndativarattri=size(this%dativarattr%i)
191 ndativarattrb=size(this%dativarattr%b)
192 ndativarattrd=size(this%dativarattr%d)
193 ndativarattrc=size(this%dativarattr%c)
194 
195 nanavarr=0
196 nanavari=0
197 nanavarb=0
198 nanavard=0
199 nanavarc=0
200 
201 if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
202 if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
203 if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
204 if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
205 if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
206 
207 nanaattrr=size(this%anaattr%r)
208 nanaattri=size(this%anaattr%i)
209 nanaattrb=size(this%anaattr%b)
210 nanaattrd=size(this%anaattr%d)
211 nanaattrc=size(this%anaattr%c)
212 
213 nanavarattrr=size(this%anavarattr%r)
214 nanavarattri=size(this%anavarattr%i)
215 nanavarattrb=size(this%anavarattr%b)
216 nanavarattrd=size(this%anavarattr%d)
217 nanavarattrc=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))
224 call nccheck( "0Conventions",nf90_put_att(lunit, nf90_global ,"Conventions","CF-1.1"))
225 call nccheck( "0title",nf90_put_att(lunit, nf90_global ,"title", ldescription))
226 
227 
228 call nccheck( "1",nf90_def_dim(lunit,"ana", nana, ana_dimid) )
229 call nccheck( "2",nf90_def_dim(lunit,"ident_len",vol7d_ana_lenident , ident_len_dimid) )
230 
231 call nccheck( "3",nf90_def_dim(lunit,"time", ntime, time_dimid) )
232 
233 call nccheck( "4",nf90_def_dim(lunit,"timerange", ntimerange, timerange_dimid) )
234 call nccheck( "5",nf90_def_dim(lunit,"timerange_vdim", 3, timerange_vdim_dimid) )
235 
236 call nccheck( "6",nf90_def_dim(lunit,"level", nlevel, level_dimid) )
237 call nccheck( "7",nf90_def_dim(lunit,"level_vdim", 4, level_vdim_dimid) )
238 
239 call nccheck( "8",nf90_def_dim(lunit,"network_name", nnetwork, network_dimid) )
240 call nccheck( "9",nf90_def_dim(lunit,"network_name_len",network_name_len, network_name_len_dimid) )
241 
242 call nccheck( "10",nf90_def_dim(lunit,"var_vdim",3, var_vdim_dimid) )
243 call nccheck( "11",nf90_def_dim(lunit,"var_len",65, var_len_dimid) )
244 
245 
246 if (nanavarr > 0) call nccheck( "a1",nf90_def_dim(lunit,"anavarr", nanavarr, anavarr_dimid) )
247 if (nanavari > 0) call nccheck( "a2",nf90_def_dim(lunit,"anavari", nanavari, anavari_dimid) )
248 if (nanavarb > 0) call nccheck( "a3",nf90_def_dim(lunit,"anavarb", nanavarb, anavarb_dimid) )
249 if (nanavard > 0) call nccheck( "a4",nf90_def_dim(lunit,"anavard", nanavard, anavard_dimid) )
250 if (nanavarc > 0) call nccheck( "a5",nf90_def_dim(lunit,"anavarc", nanavarc, anavarc_dimid) )
251 call nccheck( "a6",nf90_def_dim(lunit,"anavarc_len",vol7d_cdatalen, anavarc_len_dimid) )
252 
253 
254 if (ndativarr > 0) call nccheck( "d1",nf90_def_dim(lunit,"dativarr", ndativarr, dativarr_dimid) )
255 if (ndativari > 0) call nccheck( "d2",nf90_def_dim(lunit,"dativari", ndativari, dativari_dimid) )
256 if (ndativarb > 0) call nccheck( "d3",nf90_def_dim(lunit,"dativarb", ndativarb, dativarb_dimid) )
257 if (ndativard > 0) call nccheck( "d4",nf90_def_dim(lunit,"dativard", ndativard, dativard_dimid) )
258 if (ndativarc > 0) call nccheck( "d5",nf90_def_dim(lunit,"dativarc", ndativarc, dativarc_dimid) )
259 call nccheck( "d6",nf90_def_dim(lunit,"dativarc_len",vol7d_cdatalen, dativarc_len_dimid) )
260 
261 ! ripetere per datiattr anavar anaattr -- dativarattr anavarattr
262 
263 
264 call nccheck( "10",nf90_def_var(lunit, "ana_lat", nf90_double, ana_dimid, ana_lat_varid) )
265 call nccheck( "10long_name",nf90_put_att(lunit,ana_lat_varid ,"long_name","latitude") )
266 call nccheck( "10units",nf90_put_att(lunit,ana_lat_varid ,"units","degrees_north") )
267 call nccheck( "10standard_name",nf90_put_att(lunit,ana_lat_varid ,"standard_name","latitude") )
268 call nccheck( "10fillvalue",nf90_put_att(lunit,ana_lat_varid ,"_FillValue",dmiss) )
269 call nccheck( "10missing_value",nf90_put_att(lunit,ana_lat_varid ,"missing_value",dmiss) )
270 
271 call nccheck( "11",nf90_def_var(lunit, "ana_lon", nf90_double, ana_dimid, ana_lon_varid) )
272 call nccheck( "11long_name",nf90_put_att(lunit,ana_lon_varid ,"long_name","longitude") )
273 call nccheck( "11units",nf90_put_att(lunit,ana_lon_varid ,"units","degrees_east") )
274 call nccheck( "11standard_name",nf90_put_att(lunit,ana_lon_varid ,"standard_name","longitude") )
275 call nccheck( "11fillvalue",nf90_put_att(lunit,ana_lon_varid ,"_FillValue",dmiss) )
276 call nccheck( "11missing_value",nf90_put_att(lunit,ana_lon_varid ,"missing_value",dmiss) )
277 
278 call 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") )
280 call nccheck( "12fillvalue",nf90_put_att(lunit,ana_ident_varid ,"_FillValue",cmiss) )
281 call nccheck( "12missing_value",nf90_put_att(lunit,ana_ident_varid ,"missing_value",cmiss) )
282 
283 call nccheck( "13",nf90_def_var(lunit, "time", nf90_int, time_dimid, time_iminuti_varid) )
284 call nccheck( "1313",nf90_put_att(lunit,time_iminuti_varid, "units","minute since "//isodate) )
285 call nccheck( "13fillvalue",nf90_put_att(lunit,time_iminuti_varid ,"_FillValue",imiss) )
286 call nccheck( "13missing_value",nf90_put_att(lunit,time_iminuti_varid ,"missing_value",imiss) )
287 
288 call nccheck( "14",nf90_def_var(lunit, "timerange", nf90_int, (/timerange_vdim_dimid,timerange_dimid/), timerange_vect_varid) )
289 call nccheck( "14fillvalue",nf90_put_att(lunit, timerange_vect_varid ,"_FillValue",imiss) )
290 call nccheck( "14missing_value",nf90_put_att(lunit, timerange_vect_varid ,"missing_value",imiss) )
291 
292 call nccheck( "15",nf90_def_var(lunit, "level", nf90_int, (/level_vdim_dimid,level_dimid/), level_vect_varid) )
293 call nccheck( "15fillvalue",nf90_put_att(lunit,level_vect_varid ,"_FillValue",imiss) )
294 call nccheck( "15missing_value",nf90_put_att(lunit,level_vect_varid ,"missing_value",imiss) )
295 
296 call nccheck( "16",nf90_def_var(lunit, "network_name", nf90_char,(/ network_name_len_dimid,network_dimid/), network_name_varid) )
297 call nccheck( "16fillvalue",nf90_put_att(lunit,network_name_varid ,"_FillValue",cmiss) )
298 call nccheck( "16missing_value",nf90_put_att(lunit,network_name_varid ,"missing_value",cmiss) )
299 
300 
301 ! anagrafica
302 
303 if (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) )
313 end if
314 if (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) )
324 end if
325 if (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) )
335 end if
336 if (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) )
346 end if
347 if (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) )
357 end if
358 
359 
360 
361 ! dati
362 
363 if (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) )
373 end if
374 if (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) )
384 end if
385 if (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) )
395 end if
396 if (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) )
406 end if
407 if (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) )
417 end if
418 
419 ! end definition
420 call nccheck("22", nf90_enddef(lunit) )
421 
422 
423 if (associated(this%ana)) call nccheck("23", nf90_put_var(lunit, ana_lat_varid, getlat(this%ana(:)%coord)))
424 if (associated(this%ana)) call nccheck("24", nf90_put_var(lunit, ana_lon_varid, getlon(this%ana(:)%coord)))
425 
426 if (associated(this%ana)) call nccheck("25", nf90_put_var(lunit, ana_ident_varid, this%ana(:)%ident))
427 
428 if (associated(this%time)) call nccheck("26", nf90_put_var(lunit, time_iminuti_varid , &
429  int(timedelta_getamsec(this%time-timeref)/60000)))
430 
431 if (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
441 end if
442 
443 if (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
451 end if
452 
453 if (associated(this%network)) then
454  call nccheck( "29",nf90_put_var(lunit, network_name_varid,this%network(:)%name))
455 end if
456 
457 
458 ! ana
459 
460 do 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
469 end do
470 
471 do 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
480 end do
481 
482 do 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
491 end do
492 
493 do 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
502 end do
503 
504 do 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
513 end do
514 
515 
516 
517 ! dati
518 
519 do 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
528 end do
529 
530 do 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
539 end do
540 
541 do 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
550 end do
551 
552 do 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
561 end do
562 
563 do 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
572 end do
573 
574 
575 !!$if (associated(this%volanar)) write(unit=lunit)this%volanar
576 if (associated(this%volanar))call nccheck("a231", nf90_put_var(lunit,volanavarr_varid,this%volanar))
577 if (associated(this%volanai))call nccheck("a232", nf90_put_var(lunit,volanavari_varid,this%volanai))
578 if (associated(this%volanad))call nccheck("a233", nf90_put_var(lunit,volanavard_varid,this%volanad))
579 if (associated(this%volanab))call nccheck("a234", nf90_put_var(lunit,volanavarb_varid,this%volanab))
580 if (associated(this%volanac))call nccheck("a235", nf90_put_var(lunit,volanavarc_varid,this%volanac))
581 
582 
583 if (associated(this%voldatir))call nccheck("d231", nf90_put_var(lunit,voldativarr_varid,this%voldatir))
584 if (associated(this%voldatii))call nccheck("d232", nf90_put_var(lunit,voldativari_varid,this%voldatii))
585 if (associated(this%voldatid))call nccheck("d233", nf90_put_var(lunit,voldativard_varid,this%voldatid))
586 if (associated(this%voldatib))call nccheck("d234", nf90_put_var(lunit,voldativarb_varid,this%voldatib))
587 if (associated(this%voldatic))call nccheck("d235", nf90_put_var(lunit,voldativarc_varid,this%voldatic))
588 
589 if (.not. present(ncunit)) call nccheck("90", nf90_close(lunit) )
590 
591 end subroutine vol7d_netcdf_export
592 
593 
594 
595 subroutine vol7d_netcdf_export_cf (this,ncconventions,ncunit,description,filename)
596 
597 TYPE(vol7d),INTENT(IN) :: this
598 integer,optional,intent(inout) :: ncunit
599 character(len=*),intent(in) :: ncconventions
600 character(len=*),intent(inout),optional :: filename
601 character(len=*),INTENT(IN),optional :: description
602 
603 integer :: lunit
604 character(len=254) :: ldescription,arg,lfilename
605 integer :: 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
613 integer :: tarray(8)
614 logical :: opened,exist
615 
616 integer :: 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 
628 integer :: i
629 
630 type(datetime) :: timeref
631 
632 integer :: category
633 character(len=512):: a_name
634 
635 
636 call l4f_launcher(a_name,a_name_append=subcategory)
637 category=l4f_category_get(a_name)
638 
639 
640 if (ncconventions /= "CF-1.1") then
641 
642  call l4f_category_log(category,l4f_info,"ncconventions not supported: "//trim(ncconventions))
643  call exit(1)
644 end if
645 
646 
647 end subroutine vol7d_netcdf_export_cf
648 
649 
650 
651 subroutine nccheck(stringa,status)
652 integer, intent ( in) :: status
653 character (len=*) :: stringa
654 
655 if(status /= nf90_noerr) then
656  print *, stringa
657  print *, trim(nf90_strerror(status))
658  stop "Stopped"
659 end if
660 end subroutine nccheck
661 
662 
663 end MODULE vol7d_netcdf_class
Methods for returning the value of object members.
Index method.
Emit log message for a category with specific priority.
Lettura da file.
Costruttore per la classe vol7d.
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.