18MODULE vol7d_serialize_dballe_class
19use,
INTRINSIC :: iso_c_binding
30 PROCEDURE :: vol7d_serialize_export
31END TYPE vol7d_serialize_dballe
35 integer :: nanavar,nanaattr
39PUBLIC vol7d_serialize_dballe, vol7d_serialize_dballe_new
43FUNCTION vol7d_serialize_dballe_new()
RESULT(this)
44TYPE(vol7d_serialize_dballe) :: this
53this%vol7d_serialize = vol7d_serialize_new()
56this%column =
'ana,time,timerange,level,network'
57this%loop =
'ana,time,timerange,level,network'
58this%keep_miss = .false.
59this%cachedesc = .true.
62CALL this%vol7d_serialize_parse()
64END FUNCTION vol7d_serialize_dballe_new
77SUBROUTINE vol7d_ana_callback_dba(ana, genericptr)
78TYPE(vol7d_ana),
INTENT(in) :: ana
79TYPE(c_ptr),
VALUE :: genericptr
81type(dbametaanddata),
POINTER :: metaanddata
83CALL c_f_pointer(genericptr, metaanddata)
85metaanddata%metadata%ana%vol7d_ana=ana
87END SUBROUTINE vol7d_ana_callback_dba
90SUBROUTINE vol7d_time_callback_dba(time, genericptr)
91TYPE(datetime),
INTENT(in) :: time
92TYPE(c_ptr),
VALUE :: genericptr
94type(dbametaanddata),
POINTER :: metaanddata
96CALL c_f_pointer(genericptr, metaanddata)
98metaanddata%metadata%datetime%datetime=time
100END SUBROUTINE vol7d_time_callback_dba
102SUBROUTINE vol7d_timerange_callback_dba(timerange, genericptr)
103TYPE(vol7d_timerange),
INTENT(in) :: timerange
104TYPE(c_ptr),
VALUE :: genericptr
106type(dbametaanddata),
POINTER :: metaanddata
108CALL c_f_pointer(genericptr, metaanddata)
110metaanddata%metadata%timerange%vol7d_timerange=timerange
112END SUBROUTINE vol7d_timerange_callback_dba
115SUBROUTINE vol7d_level_callback_dba(level, genericptr)
116TYPE(vol7d_level),
INTENT(in) :: level
117TYPE(c_ptr),
VALUE :: genericptr
119type(dbametaanddata),
POINTER :: metaanddata
121CALL c_f_pointer(genericptr, metaanddata)
123metaanddata%metadata%level%vol7d_level=level
125END SUBROUTINE vol7d_level_callback_dba
128SUBROUTINE vol7d_network_callback_dba(network, genericptr)
129TYPE(vol7d_network),
INTENT(in) :: network
130TYPE(c_ptr),
VALUE :: genericptr
132type(dbametaanddata),
POINTER :: metaanddata
134CALL c_f_pointer(genericptr, metaanddata)
136metaanddata%metadata%network%vol7d_network=network
138END SUBROUTINE vol7d_network_callback_dba
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
148CALL c_f_pointer(genericptr, metaanddata)
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))
157END SUBROUTINE vol7d_valuer_callback_dba
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
167CALL c_f_pointer(genericptr, metaanddata)
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))
176END SUBROUTINE vol7d_valued_callback_dba
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
186CALL c_f_pointer(genericptr, metaanddata)
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))
195END SUBROUTINE vol7d_valuei_callback_dba
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
205CALL c_f_pointer(genericptr, metaanddata)
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))
214END SUBROUTINE vol7d_valueb_callback_dba
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
224CALL c_f_pointer(genericptr, metaanddata)
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))
233END SUBROUTINE vol7d_valuec_callback_dba
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
245CALL c_f_pointer(genericptr, metaanddata)
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
254 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=
dbadatar(attr%btable,valu))
262END SUBROUTINE vol7d_valuer_attr_callback_dba
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
274CALL c_f_pointer(genericptr, metaanddata)
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
283 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=
dbadatad(attr%btable,valu))
291END SUBROUTINE vol7d_valued_attr_callback_dba
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
303CALL c_f_pointer(genericptr, metaanddata)
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
312 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=
dbadatai(attr%btable,valu))
320END SUBROUTINE vol7d_valuei_attr_callback_dba
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
331CALL c_f_pointer(genericptr, metaanddata)
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
340 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=
dbadatab(attr%btable,valu))
348END SUBROUTINE vol7d_valueb_attr_callback_dba
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
358CALL c_f_pointer(genericptr, metaanddata)
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
367 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=
dbadatac(attr%btable,valu))
375END SUBROUTINE vol7d_valuec_attr_callback_dba
378SUBROUTINE vol7d_void_callback_dba(genericptr)
379TYPE(c_ptr),
VALUE :: genericptr
380end SUBROUTINE vol7d_void_callback_dba
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
388type (counter),
POINTER :: conta
390CALL c_f_pointer(genericptr, conta)
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
398END SUBROUTINE vol7d_value_var_header_callback_dba
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
407type (counter),
POINTER :: conta
409CALL c_f_pointer(genericptr, conta)
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
417END SUBROUTINE vol7d_value_attr_header_callback_dba
419SUBROUTINE vol7d_var_callback_dba(var, genericptr)
420TYPE(vol7d_var),
INTENT(in) :: var
421TYPE(c_ptr),
VALUE :: genericptr
423END SUBROUTINE vol7d_var_callback_dba
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
431END SUBROUTINE vol7d_attr_callback_dba
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
441type (counter),
target :: conta
442type(dbametaanddata),
target :: metaanddata
443integer :: i,j, nvar , nattr
445conta=counter(0,0,0,0)
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)
460coli = this%vol7d_serialize_itercol_new()
463 CALL coli%export(c_loc(conta))
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
475allocate(metaanddata%dataattrv%dataattr(nvar))
477 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(nattr))
481linei = this%vol7d_serialize_iterline_new()
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 &
500DO WHILE(linei%next())
502 coli = linei%vol7d_serialize_itercol_new()
503 DO WHILE(coli%next())
505 CALL coli%export(c_loc(metaanddata))
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)
517 if (.not.
allocated(metaanddata%dataattrv%dataattr(i)%dat)) &
518 allocate(metaanddata%dataattrv%dataattr(i)%dat,source=
dbadatai())
520 if (.not.
allocated(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat)) &
521 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=
dbadatac())
525 call metaanddatal%append(metaanddata)
529 deallocate(metaanddata%dataattrv%dataattr(i)%dat)
531 deallocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat)
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)
545END SUBROUTINE vol7d_serialize_export
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.
character version for dbadata
doubleprecision version for dbadata
integer version for dbadata
Class for serializing a vol7d object.