18 MODULE vol7d_serialize_dballe_class
19 use,
INTRINSIC :: iso_c_binding
26 type,extends(vol7d_serialize) :: vol7d_serialize_dballe
30 procedure :: vol7d_serialize_export
31 END TYPE vol7d_serialize_dballe
35 integer :: nanavar,nanaattr
39 PUBLIC vol7d_serialize_dballe, vol7d_serialize_dballe_new
43 FUNCTION vol7d_serialize_dballe_new() RESULT(this)
44 TYPE(vol7d_serialize_dballe
) :: this
53 this%vol7d_serialize = vol7d_serialize_new()
56 this%column =
'ana,time,timerange,level,network'
57 this%loop =
'ana,time,timerange,level,network'
58 this%keep_miss = .false.
59 this%cachedesc = .true.
62 CALL this%vol7d_serialize_parse()
64 END FUNCTION vol7d_serialize_dballe_new
77 SUBROUTINE vol7d_ana_callback_dba(ana, genericptr)
78 TYPE(vol7d_ana
),
INTENT(in) :: ana
79 TYPE(c_ptr
),value :: genericptr
83 CALL c_f_pointer(genericptr, metaanddata)
85 metaanddata%metadata%ana%vol7d_ana=ana
87 END SUBROUTINE vol7d_ana_callback_dba
90 SUBROUTINE vol7d_time_callback_dba(time, genericptr)
91 TYPE(datetime
),
INTENT(in) :: time
92 TYPE(c_ptr
),value :: genericptr
96 CALL c_f_pointer(genericptr, metaanddata)
98 metaanddata%metadata%datetime%datetime=time
100 END SUBROUTINE vol7d_time_callback_dba
102 SUBROUTINE vol7d_timerange_callback_dba(timerange, genericptr)
103 TYPE(vol7d_timerange
),
INTENT(in) :: timerange
104 TYPE(c_ptr
),value :: genericptr
108 CALL c_f_pointer(genericptr, metaanddata)
110 metaanddata%metadata%timerange%vol7d_timerange=timerange
112 END SUBROUTINE vol7d_timerange_callback_dba
115 SUBROUTINE vol7d_level_callback_dba(level, genericptr)
116 TYPE(vol7d_level
),
INTENT(in) :: level
117 TYPE(c_ptr
),value :: genericptr
121 CALL c_f_pointer(genericptr, metaanddata)
123 metaanddata%metadata%level%vol7d_level=level
125 END SUBROUTINE vol7d_level_callback_dba
128 SUBROUTINE vol7d_network_callback_dba(network, genericptr)
129 TYPE(vol7d_network
),
INTENT(in) :: network
130 TYPE(c_ptr
),value :: genericptr
134 CALL c_f_pointer(genericptr, metaanddata)
136 metaanddata%metadata%network%vol7d_network=network
138 END SUBROUTINE vol7d_network_callback_dba
141 SUBROUTINE vol7d_valuer_callback_dba(valu, var, genericptr)
142 REAL,
INTENT(in) :: valu
143 TYPE(vol7d_var
),
INTENT(in) :: var
144 TYPE(c_ptr
),value :: genericptr
148 CALL c_f_pointer(genericptr, metaanddata)
150 do 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))
157 END SUBROUTINE vol7d_valuer_callback_dba
160 SUBROUTINE vol7d_valued_callback_dba(valu, var, genericptr)
161 double precision,
INTENT(in) :: valu
162 TYPE(vol7d_var
),
INTENT(in) :: var
163 TYPE(c_ptr
),value :: genericptr
167 CALL c_f_pointer(genericptr, metaanddata)
169 do 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))
176 END SUBROUTINE vol7d_valued_callback_dba
179 SUBROUTINE vol7d_valuei_callback_dba(valu, var, genericptr)
180 integer,
INTENT(in) :: valu
181 TYPE(vol7d_var
),
INTENT(in) :: var
182 TYPE(c_ptr
),value :: genericptr
186 CALL c_f_pointer(genericptr, metaanddata)
188 do 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))
195 END SUBROUTINE vol7d_valuei_callback_dba
198 SUBROUTINE vol7d_valueb_callback_dba(valu, var, genericptr)
199 INTEGER(kind=int_b),
INTENT(in) :: valu
200 TYPE(vol7d_var
),
INTENT(in) :: var
201 TYPE(c_ptr
),value :: genericptr
205 CALL c_f_pointer(genericptr, metaanddata)
207 do 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))
214 END SUBROUTINE vol7d_valueb_callback_dba
217 SUBROUTINE vol7d_valuec_callback_dba(valu, var, genericptr)
218 character(len=*),
INTENT(in) :: valu
219 TYPE(vol7d_var
),
INTENT(in) :: var
220 TYPE(c_ptr
),value :: genericptr
224 CALL c_f_pointer(genericptr, metaanddata)
226 do 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))
233 END SUBROUTINE vol7d_valuec_callback_dba
237 SUBROUTINE vol7d_valuer_attr_callback_dba(valu, var, attr, genericptr)
238 REAL,
INTENT(in) :: valu
239 TYPE(vol7d_var
),
INTENT(in) :: var
240 TYPE(vol7d_var
),
INTENT(in) :: attr
241 TYPE(c_ptr
),value :: genericptr
245 CALL c_f_pointer(genericptr, metaanddata)
248 ivar:
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))
262 END SUBROUTINE vol7d_valuer_attr_callback_dba
266 SUBROUTINE vol7d_valued_attr_callback_dba(valu, var, attr, genericptr)
267 double precision,
INTENT(in) :: valu
268 TYPE(vol7d_var
),
INTENT(in) :: var
269 TYPE(vol7d_var
),
INTENT(in) :: attr
270 TYPE(c_ptr
),value :: genericptr
274 CALL c_f_pointer(genericptr, metaanddata)
277 ivar:
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))
291 END SUBROUTINE vol7d_valued_attr_callback_dba
295 SUBROUTINE vol7d_valuei_attr_callback_dba(valu, var, attr, genericptr)
296 integer,
INTENT(in) :: valu
297 TYPE(vol7d_var
),
INTENT(in) :: var
298 TYPE(vol7d_var
),
INTENT(in) :: attr
299 TYPE(c_ptr
),value :: genericptr
303 CALL c_f_pointer(genericptr, metaanddata)
306 ivar:
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))
320 END SUBROUTINE vol7d_valuei_attr_callback_dba
323 SUBROUTINE vol7d_valueb_attr_callback_dba(valu, var, attr, genericptr)
324 INTEGER(kind=int_b),
INTENT(in) :: valu
325 TYPE(vol7d_var
),
INTENT(in) :: var
326 TYPE(vol7d_var
),
INTENT(in) :: attr
327 TYPE(c_ptr
),value :: genericptr
331 CALL c_f_pointer(genericptr, metaanddata)
334 ivar:
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))
348 END SUBROUTINE vol7d_valueb_attr_callback_dba
350 SUBROUTINE vol7d_valuec_attr_callback_dba(valu, var, attr, genericptr)
351 character(len=*),
INTENT(in) :: valu
352 TYPE(vol7d_var
),
INTENT(in) :: var
353 TYPE(vol7d_var
),
INTENT(in) :: attr
354 TYPE(c_ptr
),value :: genericptr
358 CALL c_f_pointer(genericptr, metaanddata)
361 ivar:
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))
375 END SUBROUTINE vol7d_valuec_attr_callback_dba
378 SUBROUTINE vol7d_void_callback_dba(genericptr)
379 TYPE(c_ptr
),value :: genericptr
380 end SUBROUTINE vol7d_void_callback_dba
383 SUBROUTINE vol7d_value_var_header_callback_dba(var, typ, genericptr)
384 TYPE(vol7d_var
),
INTENT(in) :: var
385 CHARACTER(len=*),
INTENT(in) :: typ
386 TYPE(c_ptr
),value :: genericptr
388 type (counter
),
POINTER :: conta
390 CALL c_f_pointer(genericptr, conta)
392 if (typ(2:2) ==
"d")
then
393 conta%nvar=conta%nvar+1
394 else if (typ(2:2) ==
"a")
then
395 conta%nanavar=conta%nanavar+1
398 END SUBROUTINE vol7d_value_var_header_callback_dba
401 SUBROUTINE vol7d_value_attr_header_callback_dba(var, attr, typ, genericptr)
402 TYPE(vol7d_var
),
INTENT(in) :: var
403 TYPE(vol7d_var
),
INTENT(in) :: attr
404 CHARACTER(len=*),
INTENT(in) :: typ
405 TYPE(c_ptr
),value :: genericptr
407 type (counter
),
POINTER :: conta
409 CALL c_f_pointer(genericptr, conta)
411 if (typ(2:2) ==
"d")
then
412 conta%nattr=conta%nattr+1
413 else if (typ(2:2) ==
"a")
then
414 conta%nanaattr=conta%nanaattr+1
417 END SUBROUTINE vol7d_value_attr_header_callback_dba
419 SUBROUTINE vol7d_var_callback_dba(var, genericptr)
420 TYPE(vol7d_var
),
INTENT(in) :: var
421 TYPE(c_ptr
),value :: genericptr
423 END SUBROUTINE vol7d_var_callback_dba
426 SUBROUTINE vol7d_attr_callback_dba(var, attr, genericptr)
427 TYPE(vol7d_var
),
INTENT(in) :: var
428 TYPE(vol7d_var
),
INTENT(in) :: attr
429 TYPE(c_ptr
),value :: genericptr
431 END SUBROUTINE vol7d_attr_callback_dba
435 SUBROUTINE vol7d_serialize_export(this, metaanddatal)
436 class(vol7d_serialize_dballe),
INTENT(inout) :: this
438 TYPE(vol7d_serialize_iterline
) :: linei
439 TYPE(vol7d_serialize_itercol
) :: coli
441 type (counter
),
target :: conta
443 integer :: i,j, nvar , nattr
445 conta=counter(0,0,0,0)
448 CALL 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)
460 coli = this%vol7d_serialize_itercol_new()
461 DO WHILE(coli%next())
463 CALL coli%export(c_loc(conta))
468 if (conta%nvar > 0) nattr= nattr + conta%nattr/conta%nvar
469 if (conta%nanavar > 0) nattr= nattr + conta%nanaattr/conta%nanavar
470 nvar = conta%nvar + conta%nanavar
475 allocate(metaanddata%dataattrv%dataattr(nvar))
477 allocate(metaanddata%dataattrv%dataattr(i)%attrv%dcv(nattr))
481 linei = this%vol7d_serialize_iterline_new()
484 CALL 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 &
500 DO 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)
545 END SUBROUTINE vol7d_serialize_export
569 END MODULE vol7d_serialize_dballe_class
character version for dbadata
doubleprecision version for dbadata
Classe per la gestione di un volume completo di dati osservati.
Module for parsing command-line optons.
class for import and export data from e to DB-All.e.
Extension of vol7d_class for serializing the contents of a volume.
integer version for dbadata