libsim Versione 7.2.1
vol7d_serialize_dballe_class.F03
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/>.
18MODULE vol7d_serialize_dballe_class
19use,INTRINSIC :: iso_c_binding
24IMPLICIT NONE
25
26TYPE,EXTENDS(vol7d_serialize) :: vol7d_serialize_dballe
27 !!TYPE(vol7d_ana) :: ana !< identificativo della stazione da exportare
28 CONTAINS
29! PROCEDURE :: vol7d_serialize_optionparser
30 PROCEDURE :: vol7d_serialize_export
31END TYPE vol7d_serialize_dballe
32
33type counter
34 integer :: nvar,nattr
35 integer :: nanavar,nanaattr
36end type counter
37
38PRIVATE
39PUBLIC vol7d_serialize_dballe, vol7d_serialize_dballe_new
40
41CONTAINS
42
43FUNCTION vol7d_serialize_dballe_new() RESULT(this)
44TYPE(vol7d_serialize_dballe) :: this
45!!$TYPE(vol7d_ana),INTENT(in),optional :: ana !< identificativo della stazione da exportare
46!!$
47!!$if (present(ana))then
48!!$ this%ana=ana
49!!$else
50!!$ call init(this%ana)
51!!$end if
52
53this%vol7d_serialize = vol7d_serialize_new()
54
55! reset unconditionally some parameters
56this%column = 'ana,time,timerange,level,network'
57this%loop = 'ana,time,timerange,level,network'
58this%keep_miss = .false.
59this%cachedesc = .true.
60! call original parse method to fix tuning parameters without forcing
61! to call option methods explicitely
62CALL this%vol7d_serialize_parse()
63
64END FUNCTION vol7d_serialize_dballe_new
65
66
67!SUBROUTINE vol7d_serialize_parse(this, category)
68!CLASS(vol7d_serialize_geojson),INTENT(inout) :: this !< object having undorgone the vol7d_serialize_optionparser method
69!INTEGER,INTENT(in),OPTIONAL :: category !< log4fortran category for logging error messages
70!
71!!! do nothing
72!
73!END SUBROUTINE vol7d_serialize_parse
74
75
76
77SUBROUTINE vol7d_ana_callback_dba(ana, genericptr)
78TYPE(vol7d_ana), INTENT(in) :: ana
79TYPE(c_ptr),VALUE :: genericptr
80
81type(dbametaanddata),POINTER :: metaanddata
82
83CALL c_f_pointer(genericptr, metaanddata)
84
85metaanddata%metadata%ana%vol7d_ana=ana
86
87END SUBROUTINE vol7d_ana_callback_dba
88
89
90SUBROUTINE vol7d_time_callback_dba(time, genericptr)
91TYPE(datetime), INTENT(in) :: time
92TYPE(c_ptr),VALUE :: genericptr
93
94type(dbametaanddata),POINTER :: metaanddata
95
96CALL c_f_pointer(genericptr, metaanddata)
97
98metaanddata%metadata%datetime%datetime=time
99
100END SUBROUTINE vol7d_time_callback_dba
101
102SUBROUTINE vol7d_timerange_callback_dba(timerange, genericptr)
103TYPE(vol7d_timerange), INTENT(in) :: timerange
104TYPE(c_ptr),VALUE :: genericptr
105
106type(dbametaanddata),POINTER :: metaanddata
107
108CALL c_f_pointer(genericptr, metaanddata)
109
110metaanddata%metadata%timerange%vol7d_timerange=timerange
111
112END SUBROUTINE vol7d_timerange_callback_dba
113
114
115SUBROUTINE vol7d_level_callback_dba(level, genericptr)
116TYPE(vol7d_level), INTENT(in) :: level
117TYPE(c_ptr),VALUE :: genericptr
118
119type(dbametaanddata),POINTER :: metaanddata
120
121CALL c_f_pointer(genericptr, metaanddata)
122
123metaanddata%metadata%level%vol7d_level=level
124
125END SUBROUTINE vol7d_level_callback_dba
126
127
128SUBROUTINE vol7d_network_callback_dba(network, genericptr)
129TYPE(vol7d_network), INTENT(in) :: network
130TYPE(c_ptr),VALUE :: genericptr
131
132type(dbametaanddata),POINTER :: metaanddata
133
134CALL c_f_pointer(genericptr, metaanddata)
135
136metaanddata%metadata%network%vol7d_network=network
137
138END SUBROUTINE vol7d_network_callback_dba
139
140
141SUBROUTINE vol7d_valuer_callback_dba(valu, var, genericptr)
142REAL,INTENT(in) :: valu
143TYPE(vol7d_var),INTENT(in) :: var
144TYPE(c_ptr),VALUE :: genericptr
145type(dbametaanddata),POINTER :: metaanddata
146integer :: i
147
148CALL c_f_pointer(genericptr, metaanddata)
149
150do i =1, size(metaanddata%dataattrv%dataattr)
151 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%dat)) then
152 allocate(metaanddata%dataattrv%dataattr(i)%dat,source=dbadatar(var%btable,valu))
153 exit
154 end if
155end do
156
157END SUBROUTINE vol7d_valuer_callback_dba
158
159
160SUBROUTINE vol7d_valued_callback_dba(valu, var, genericptr)
161double precision,INTENT(in) :: valu
162TYPE(vol7d_var),INTENT(in) :: var
163TYPE(c_ptr),VALUE :: genericptr
164type(dbametaanddata),POINTER :: metaanddata
165integer :: i
166
167CALL c_f_pointer(genericptr, metaanddata)
168
169do i =1, size(metaanddata%dataattrv%dataattr)
170 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%dat)) then
171 allocate(metaanddata%dataattrv%dataattr(i)%dat,source=dbadatad(var%btable,valu))
172 exit
173 end if
174end do
175
176END SUBROUTINE vol7d_valued_callback_dba
177
178
179SUBROUTINE vol7d_valuei_callback_dba(valu, var, genericptr)
180integer,INTENT(in) :: valu
181TYPE(vol7d_var),INTENT(in) :: var
182TYPE(c_ptr),VALUE :: genericptr
183type(dbametaanddata),POINTER :: metaanddata
184integer :: i
185
186CALL c_f_pointer(genericptr, metaanddata)
187
188do i =1, size(metaanddata%dataattrv%dataattr)
189 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%dat)) then
190 allocate(metaanddata%dataattrv%dataattr(i)%dat,source=dbadatai(var%btable,valu))
191 exit
192 end if
193end do
194
195END SUBROUTINE vol7d_valuei_callback_dba
196
197
198SUBROUTINE vol7d_valueb_callback_dba(valu, var, genericptr)
199INTEGER(kind=int_b),INTENT(in) :: valu
200TYPE(vol7d_var),INTENT(in) :: var
201TYPE(c_ptr),VALUE :: genericptr
202type(dbametaanddata),POINTER :: metaanddata
203integer :: i
204
205CALL c_f_pointer(genericptr, metaanddata)
206
207do i =1, size(metaanddata%dataattrv%dataattr)
208 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%dat)) then
209 allocate(metaanddata%dataattrv%dataattr(i)%dat,source=dbadatab(var%btable,valu))
210 exit
211 end if
212end do
213
214END SUBROUTINE vol7d_valueb_callback_dba
215
216
217SUBROUTINE vol7d_valuec_callback_dba(valu, var, genericptr)
218character(len=*),INTENT(in) :: valu
219TYPE(vol7d_var),INTENT(in) :: var
220TYPE(c_ptr),VALUE :: genericptr
221type(dbametaanddata),POINTER :: metaanddata
222integer :: i
223
224CALL c_f_pointer(genericptr, metaanddata)
225
226do i =1, size(metaanddata%dataattrv%dataattr)
227 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%dat)) then
228 allocate(metaanddata%dataattrv%dataattr(i)%dat,source=dbadatac(var%btable,valu))
229 exit
230 end if
231end do
232
233END SUBROUTINE vol7d_valuec_callback_dba
234
235
236
237SUBROUTINE vol7d_valuer_attr_callback_dba(valu, var, attr, genericptr)
238REAL,INTENT(in) :: valu
239TYPE(vol7d_var),INTENT(in) :: var
240TYPE(vol7d_var),INTENT(in) :: attr
241TYPE(c_ptr),VALUE :: genericptr
242type(dbametaanddata),POINTER :: metaanddata
243integer :: i,j
244
245CALL c_f_pointer(genericptr, metaanddata)
246
247!print*, "vol7d_valuei_attr_callback_dba: ",var%btable,attr%btable
248ivar:do i =1, size(metaanddata%dataattrv%dataattr)
249 if (allocated(metaanddata%dataattrv%dataattr(i)%dat)) then
250 if (metaanddata%dataattrv%dataattr(i)%dat%btable == var%btable) then
251 do j =1, size(metaanddata%dataattrv%dataattr(i)%attrv%dcv)
252 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat)) then
253 !print *,"allocate attributei: ",var%btable
254 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=dbadatar(attr%btable,valu))
255 exit ivar
256 end if
257 end do
258 end if
259 end if
260end do ivar
261
262END SUBROUTINE vol7d_valuer_attr_callback_dba
263
264
265
266SUBROUTINE vol7d_valued_attr_callback_dba(valu, var, attr, genericptr)
267double precision,INTENT(in) :: valu
268TYPE(vol7d_var),INTENT(in) :: var
269TYPE(vol7d_var),INTENT(in) :: attr
270TYPE(c_ptr),VALUE :: genericptr
271type(dbametaanddata),POINTER :: metaanddata
272integer :: i,j
273
274CALL c_f_pointer(genericptr, metaanddata)
275
276!print*, "vol7d_valuei_attr_callback_dba: ",var%btable,attr%btable
277ivar:do i =1, size(metaanddata%dataattrv%dataattr)
278 if (allocated(metaanddata%dataattrv%dataattr(i)%dat)) then
279 if (metaanddata%dataattrv%dataattr(i)%dat%btable == var%btable) then
280 do j =1, size(metaanddata%dataattrv%dataattr(i)%attrv%dcv)
281 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat)) then
282 !print *,"allocate attributei: ",var%btable
283 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=dbadatad(attr%btable,valu))
284 exit ivar
285 end if
286 end do
287 end if
288 end if
289end do ivar
290
291END SUBROUTINE vol7d_valued_attr_callback_dba
292
293
294
295SUBROUTINE vol7d_valuei_attr_callback_dba(valu, var, attr, genericptr)
296integer,INTENT(in) :: valu
297TYPE(vol7d_var),INTENT(in) :: var
298TYPE(vol7d_var),INTENT(in) :: attr
299TYPE(c_ptr),VALUE :: genericptr
300type(dbametaanddata),POINTER :: metaanddata
301integer :: i,j
302
303CALL c_f_pointer(genericptr, metaanddata)
304
305!print*, "vol7d_valuei_attr_callback_dba: ",var%btable,attr%btable
306ivar:do i =1, size(metaanddata%dataattrv%dataattr)
307 if (allocated(metaanddata%dataattrv%dataattr(i)%dat)) then
308 if (metaanddata%dataattrv%dataattr(i)%dat%btable == var%btable) then
309 do j =1, size(metaanddata%dataattrv%dataattr(i)%attrv%dcv)
310 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat)) then
311 !print *,"allocate attributei: ",var%btable
312 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=dbadatai(attr%btable,valu))
313 exit ivar
314 end if
315 end do
316 end if
317 end if
318end do ivar
319
320END SUBROUTINE vol7d_valuei_attr_callback_dba
321
322
323SUBROUTINE vol7d_valueb_attr_callback_dba(valu, var, attr, genericptr)
324INTEGER(kind=int_b),INTENT(in) :: valu
325TYPE(vol7d_var),INTENT(in) :: var
326TYPE(vol7d_var),INTENT(in) :: attr
327TYPE(c_ptr),VALUE :: genericptr
328type(dbametaanddata),POINTER :: metaanddata
329integer :: i,j
330
331CALL c_f_pointer(genericptr, metaanddata)
332
333!print*, "vol7d_valuei_attr_callback_dba: ",var%btable,attr%btable
334ivar:do i =1, size(metaanddata%dataattrv%dataattr)
335 if (allocated(metaanddata%dataattrv%dataattr(i)%dat)) then
336 if (metaanddata%dataattrv%dataattr(i)%dat%btable == var%btable) then
337 do j =1, size(metaanddata%dataattrv%dataattr(i)%attrv%dcv)
338 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat)) then
339 !print *,"allocate attributei: ",var%btable
340 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=dbadatab(attr%btable,valu))
341 exit ivar
342 end if
343 end do
344 end if
345 end if
346end do ivar
347
348END SUBROUTINE vol7d_valueb_attr_callback_dba
349
350SUBROUTINE vol7d_valuec_attr_callback_dba(valu, var, attr, genericptr)
351character(len=*),INTENT(in) :: valu
352TYPE(vol7d_var),INTENT(in) :: var
353TYPE(vol7d_var),INTENT(in) :: attr
354TYPE(c_ptr),VALUE :: genericptr
355type(dbametaanddata),POINTER :: metaanddata
356integer :: i,j
357
358CALL c_f_pointer(genericptr, metaanddata)
359
360!print*, "vol7d_valuei_attr_callback_dba: ",var%btable,attr%btable
361ivar:do i =1, size(metaanddata%dataattrv%dataattr)
362 if (allocated(metaanddata%dataattrv%dataattr(i)%dat)) then
363 if (metaanddata%dataattrv%dataattr(i)%dat%btable == var%btable) then
364 do j =1, size(metaanddata%dataattrv%dataattr(i)%attrv%dcv)
365 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat)) then
366 !print *,"allocate attributei: ",var%btable
367 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=dbadatac(attr%btable,valu))
368 exit ivar
369 end if
370 end do
371 end if
372 end if
373end do ivar
374
375END SUBROUTINE vol7d_valuec_attr_callback_dba
376
377
378SUBROUTINE vol7d_void_callback_dba(genericptr)
379TYPE(c_ptr),VALUE :: genericptr
380end SUBROUTINE vol7d_void_callback_dba
381
382
383SUBROUTINE vol7d_value_var_header_callback_dba(var, typ, genericptr)
384TYPE(vol7d_var),INTENT(in) :: var
385CHARACTER(len=*),INTENT(in) :: typ
386TYPE(c_ptr),VALUE :: genericptr
387
388type (counter),POINTER :: conta
389
390CALL c_f_pointer(genericptr, conta)
391
392if (typ(2:2) == "d") then
393 conta%nvar=conta%nvar+1
394else if (typ(2:2) == "a") then
395 conta%nanavar=conta%nanavar+1
396end if
397
398END SUBROUTINE vol7d_value_var_header_callback_dba
399
400
401SUBROUTINE vol7d_value_attr_header_callback_dba(var, attr, typ, genericptr)
402TYPE(vol7d_var),INTENT(in) :: var
403TYPE(vol7d_var),INTENT(in) :: attr
404CHARACTER(len=*),INTENT(in) :: typ
405TYPE(c_ptr),VALUE :: genericptr
406
407type (counter),POINTER :: conta
408
409CALL c_f_pointer(genericptr, conta)
410
411if (typ(2:2) == "d") then
412 conta%nattr=conta%nattr+1
413else if (typ(2:2) == "a") then
414 conta%nanaattr=conta%nanaattr+1
415end if
416
417END SUBROUTINE vol7d_value_attr_header_callback_dba
418
419SUBROUTINE vol7d_var_callback_dba(var, genericptr)
420TYPE(vol7d_var), INTENT(in) :: var
421TYPE(c_ptr),VALUE :: genericptr
422
423END SUBROUTINE vol7d_var_callback_dba
424
425
426SUBROUTINE vol7d_attr_callback_dba(var, attr, genericptr)
427TYPE(vol7d_var), INTENT(in) :: var
428TYPE(vol7d_var), INTENT(in) :: attr
429TYPE(c_ptr),VALUE :: genericptr
430
431END SUBROUTINE vol7d_attr_callback_dba
432
433
434
435SUBROUTINE vol7d_serialize_export(this, metaanddatal)
436CLASS(vol7d_serialize_dballe),INTENT(inout) :: this
437type(dbametaanddatalist),INTENT(inout) :: metaanddatal
438TYPE(vol7d_serialize_iterline) :: linei
439TYPE(vol7d_serialize_itercol) :: coli
440
441type (counter),target :: conta
442type(dbametaanddata),target :: metaanddata
443integer :: i,j, nvar , nattr
444
445conta=counter(0,0,0,0)
446
447! set "header" callbacks
448CALL this%vol7d_serialize_set_callback(&
449 vol7d_void_callback_dba,&
450 vol7d_void_callback_dba,&
451 vol7d_void_callback_dba,&
452 vol7d_void_callback_dba,&
453 vol7d_void_callback_dba,&
454 vol7d_void_callback_dba,&
455 vol7d_void_callback_dba,&
456 vol7d_value_var_callback=vol7d_value_var_header_callback_dba, &
457 vol7d_value_attr_callback=vol7d_value_attr_header_callback_dba)
458
459! loop over headers and count columns
460coli = this%vol7d_serialize_itercol_new() ! column iterator from this (header line)
461DO WHILE(coli%next())
462! call callbacks
463 CALL coli%export(c_loc(conta))
464END DO
465
466!print *,"Conta: ",conta
467nattr = 0
468if (conta%nvar > 0) nattr= nattr + conta%nattr/conta%nvar
469if (conta%nanavar > 0) nattr= nattr + conta%nanaattr/conta%nanavar
470nvar = conta%nvar + conta%nanavar
471!print *,"nvar: ",nvar,"nattr: ",nattr
472
473metaanddata%metadata=dbametadata() ! initialize must be done for station constant data
474
475allocate(metaanddata%dataattrv%dataattr(nvar))
476do i =1,nvar
477 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(nattr))
478enddo
479
480! loop over lines
481linei = this%vol7d_serialize_iterline_new()
482
483! set "data lines" callbacks
484CALL linei%vol7d_serialize_iterline_set_callback(vol7d_ana_callback_dba &
485 ,vol7d_time_callback_dba, vol7d_level_callback_dba &
486 ,vol7d_timerange_callback_dba, vol7d_network_callback_dba &
487 ,vol7d_var_callback_dba, vol7d_attr_callback_dba&
488 ,vol7d_valuer_callback_dba &
489 ,vol7d_valued_callback_dba &
490 ,vol7d_valuei_callback_dba &
491 ,vol7d_valueb_callback_dba &
492 ,vol7d_valuec_callback_dba &
493 ,vol7d_valuer_attr_callback_dba &
494 ,vol7d_valued_attr_callback_dba &
495 ,vol7d_valuei_attr_callback_dba &
496 ,vol7d_valueb_attr_callback_dba &
497 ,vol7d_valuec_attr_callback_dba &
498 )
499
500DO WHILE(linei%next())
501
502 coli = linei%vol7d_serialize_itercol_new() ! column iterator from linei (data line)
503 DO WHILE(coli%next())
504! call callbacks
505 CALL coli%export(c_loc(metaanddata))
506 END DO
507
508! manage time definition
509 if (this%v7d%time_definition == 0) then
510 metaanddata%metadata%datetime%datetime = &
511 metaanddata%metadata%datetime%datetime + &
512 timedelta_new(sec=metaanddata%metadata%timerange%vol7d_timerange%p1)
513 end if
514
515!! set to missing
516 do i =1,nvar
517 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%dat)) &
518 allocate(metaanddata%dataattrv%dataattr(i)%dat,source=dbadatai())
519 do j=1,nattr
520 if (.not. allocated(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat)) &
521 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=dbadatac())
522 end do
523 enddo
524
525 call metaanddatal%append(metaanddata)
526
527!! deallocate
528 do i =1,nvar
529 deallocate(metaanddata%dataattrv%dataattr(i)%dat)
530 do j=1,nattr
531 deallocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat)
532 end do
533 enddo
534
535! restore reference time if changed because of time definition
536! otherwise strange things happen
537 if (this%v7d%time_definition == 0) then
538 metaanddata%metadata%datetime%datetime = &
539 metaanddata%metadata%datetime%datetime - &
540 timedelta_new(sec=metaanddata%metadata%timerange%vol7d_timerange%p1)
541 end if
542
543END DO
544
545END SUBROUTINE vol7d_serialize_export
546
547!!$SUBROUTINE default_vol7d_valuec_callback(valu, var, genericptr)
548!!$CHARACTER(len=*),INTENT(in) :: valu
549!!$TYPE(vol7d_var),INTENT(in) :: var
550!!$TYPE(c_ptr),VALUE :: genericptr
551!!$
552!!$CHARACTER(len=64),POINTER :: col
553!!$
554!!$CALL C_F_POINTER(genericptr, col)
555!!$IF (c_e(valu)) THEN
556!!$ IF (c_e(var%scalefactor) .AND. var%unit /= 'CCITTIA5' .AND. &
557!!$ .NOT.(var%scalefactor == 0 .AND. var%unit == 'NUMERIC')) THEN
558!!$ col = t2c(realdat(valu, var))
559!!$ ELSE
560!!$ col = TRIM(valu)
561!!$ ENDIF
562!!$ELSE
563!!$ col = ''
564!!$ENDIF
565!!$
566!!$END SUBROUTINE default_vol7d_valuec_callback
567
568
569END MODULE vol7d_serialize_dballe_class
class for import and export data from e to DB-All.e.
Module for parsing command-line optons.
Classe per la gestione di un volume completo di dati osservati.
Extension of vol7d_class for serializing the contents of a volume.
byte version for dbadata
character version for dbadata
doubleprecision version for dbadata
integer version for dbadata
real version for dbadata
summ of all metadata pieces
Class for serializing a vol7d object.

Generated with Doxygen.