libsim  Versione7.2.3
example_dballe.F03

Sample program to demostrate the dballe_class module. This module have examples to read/write/manipulate data from/to DB or BUFR.

1 program example_dballe
2 
3 use dballe_class
5 use log4fortran
6 implicit none
7 
8 integer :: i
9 type(dbasession) :: session,sessionfrom,sessionto
10 type(dbaconnection) :: connection,connectionfrom
11 
12 
13 type(dbacoord) :: coord
14 type(dbaana) :: ana
15 type(dbadatetime) :: mydatetime
16 type(dbalevel) :: level
17 type(dbanetwork) :: network
18 type(dbatimerange) :: timerange
19 type(dbametadata) :: metadata
20 type(dbadatar) :: datar
21 type(dbametaanddatar) :: metaanddatar
22 type(dbadc) :: dc
23 type(dbadcv) :: dcv
24 type(dbametaanddatav) :: metaanddatav
25 type(dbadataattrv) :: dataattrv
26 type(dbametaanddata) :: metaandata
27 
28 
29 integer :: category,ier
30 character(len=512):: a_name
31 
32 !questa chiamata prende dal launcher il nome univoco
33 call l4f_launcher(a_name,a_name_force="example",a_name_append="main")
34 !init di log4fortran
35 ier=l4f_init()
36 !imposta a_name
37 category=l4f_category_get(a_name//".main")
38 
39 call l4f_category_log(category,l4f_info,"example_dballe")
40 
41 !Oggetti:
42 
43 !dbacoord : fortran 2003 interface to geo_coord
44 coord=dbacoord(lon=10.d0,lat=45.d0)
45 !dbaana : ana metadata
46 ana=dbaana(coord,ident="mianave")
47 
48 !dbadatetime : datetime metadata
49 mydatetime=dbadatetime(datetime_new(2014,01,06,18,00))
50 
51 !dbalevel : level metadata
52 level=dbalevel(level1=105, l1=2000)
53 
54 !dbanetwork : network metadata
55 network=dbanetwork("generic")
56 
57 !dbatimerange : timerange metadata
58 timerange=dbatimerange(timerange=4, p1=3600,p2=7200)
59 
60 !dbametadata : summ of all metadata pieces
61 metadata=dbametadata(level=level,timerange=timerange,ana=ana,network=network,datetime=mydatetime)
62 
63 !dbametaanddatar : metadata and real data
64 metaanddatar%metadata=metadata
65 metaanddatar%dbadatar=datar
66 !dbametaanddatarlist : metadata and real data double linked list
67 
68 !dbametaanddatai : metadata and integer data
69 !dbametaanddatailist : metadata and integer data double linked list
70 
71 !dbametaanddatab : metadata and byte data
72 !dbametaanddatablist : metadata and byte data double linked list
73 
74 !dbametaanddatac : metadata and character data
75 !dbametaanddataclist : metadata and character data double linked list
76 
77 !dbametaanddatad : metadata and doubleprecision data
78 !dbametaanddatadlist : metadata and diubleprecision data double linked list
79 
80 !dbadc : container for dbadata (used for promiscuous vector of data)
81 allocate(dc%dat,source=dbadatai("B12102",26312))
82 
83 !dbadcv : vector of container of dbadata
84 allocate (dcv%dcv(2))
85 allocate (dcv%dcv(1)%dat,source=dbadatai("B12102",26312))
86 allocate (dcv%dcv(2)%dat,source=dbadatar("B12101",273.15))
87 
88 !dbametaanddatav one metadata plus vector of container of dbadata
89 metaanddatav%metadata=metadata
90 metaanddatav%datav=dcv
91 
92 !dbadataattrv : vector of dbadataattr (more data plus attributes)
93 allocate(dataattrv%dataattr(2))
94 dataattrv%dataattr(1)%dbadc=dc
95 dataattrv%dataattr(1)%attrv=dcv
96 
97 !dbametaanddata : one metadata plus vector of container of dbadata plus attributes
98 metaandata%metadata=metadata
99 metaandata%dataattrv=dataattrv
100 
101 !dbametaanddatalist double linked list of dbametaanddata
102 
103 
104 call l4f_category_log(category,l4f_info,"connect to dsn type DBA")
105 
106 connection=dbaconnection(dsn="sqlite:/tmp/dballe.sqlite")
107 session=dbasession(connection,wipe=.true.,anaflag="write", dataflag="write", attrflag="write")
108 
109 call l4f_category_log(category,l4f_info,"write1")
110 call write1() ! write etherogeneous ensamble of data with attributes and constant data using macro object
111 call l4f_category_log(category,l4f_info,"write2")
112 call write2() ! write an omogeneous vector of data
113 call l4f_category_log(category,l4f_info,"write3")
114 call write3() ! write an etherogeneous ensamble of data
115 call l4f_category_log(category,l4f_info,"write4")
116 call write4() ! write an etherogeneous ensamble of data and attributes
117 call l4f_category_log(category,l4f_info,"write5")
118 call write5() ! write a content of DSN to a file with filter
119 call l4f_category_log(category,l4f_info,"read2")
120 call read2() ! read data and attributes for data filtered and ordered by btable with type predefined
121 call l4f_category_log(category,l4f_info,"delete1")
122 call delete1() ! delete one var from the entire DB
123 call l4f_category_log(category,l4f_info,"delete2")
124 call delete2() ! delete one var only where are some defined metadata
125 call l4f_category_log(category,l4f_info,"delete3")
126 call delete3() ! delete some attributes from one var only where are some defined metadata
127 call l4f_category_log(category,l4f_info,"read1")
128 call read1() ! read ana, data and attributes for constant data, data and attributes for data
129 call l4f_category_log(category,l4f_info,"read3")
130 call read3() ! read an omogeneous vector of data
131 call l4f_category_log(category,l4f_info,"read4")
132 call read4l() ! read data and attributes for data in a double linked list
133 call l4f_category_log(category,l4f_info,"copy1")
134 call copy1() ! copy data and attributes of everythings to an other dsn
135 call l4f_category_log(category,l4f_info,"copy2")
136 call copy2() ! copy data and constant data to an other dsn
137 
138 !close everythings
139 call session%delete()
140 call connection%delete()
141 
142 
143 call l4f_category_log(category,l4f_info,"connect to dsn type BUFR file for write")
144 session=dbasession(filename="example_dballe.bufr",wipe=.true.,write=.true.,memdb=.false.)
145 
146 call l4f_category_log(category,l4f_info,"write0")
147 call write0() ! write ana on file
148 call l4f_category_log(category,l4f_info,"write1")
149 call write1() ! write etherogeneous ensamble of data with attributes and constant data using macro object
150 call l4f_category_log(category,l4f_info,"write2")
151 call write2() ! write an omogeneous vector of data
152 call l4f_category_log(category,l4f_info,"write3")
153 call write3() ! write an etherogeneous ensamble of data
154 call l4f_category_log(category,l4f_info,"write4")
155 call write4() ! write an etherogeneous ensamble of data and attributes
156 
157 !close everythings
158 call session%delete()
159 
160 
161 call l4f_category_log(category,l4f_info,"connect to dsn type BUFR file for read")
162 session=dbasession(filename="example_dballe.bufr",memdb=.false.)
163 
164 call l4f_category_log(category,l4f_info,"read1lf")
165 call read1lf() ! read ana, data and attributes for constant data, data and attributes for data in list
166 call l4f_category_log(category,l4f_info,"read2lf")
167 call read2lf() ! read data and attributes for data filtered and ordered by btable with type predefined in list
168 
169 !! note: I cannot read from file without filter (filter do not work on file) and put everythings in real matrix
170 !! we get error putting somethings that do not fit in real (like station name)
171 !! call read3lf() ! read an omogeneous vector of data
172 
173 ! use memdb
174 call l4f_category_log(category,l4f_info,"read3lfmem")
175 call read3lfmem() ! read an omogeneous vector of data from file using list and mem (and filters)
176 call l4f_category_log(category,l4f_info,"readmem")
177 call readmem() ! read an list of data from file using mem (and filters)
178 
179 call l4f_category_log(category,l4f_info,"connect to dsn type BUFR file for read")
180 sessionfrom=dbasession(filename="example_dballe.bufr",memdb=.false.)
181 call l4f_category_log(category,l4f_info,"connect to dsn type BUFR file for write")
182 sessionto=dbasession(filename="example_dballe_copy1f.bufr",wipe=.true.,write=.true.,memdb=.false.)
183 call l4f_category_log(category,l4f_info,"copy1f")
184 call copy1f() ! copy data and attributes of everythings to an other file
185 ! todo
186 !call l4f_category_log(category,L4F_INFO,"copy2f")
187 !call copy2f() ! copy data and constant data to an other file
188 !close everythings
189 call sessionto%delete()
190 call sessionfrom%delete()
191 
192 
193 call l4f_category_log(category,l4f_info,"use memdb: connect to dsn type DBA")
194 connectionfrom=dbaconnection(dsn="mem:")
195 sessionfrom=dbasession(connectionfrom,wipe=.true.,anaflag="write", dataflag="write", attrflag="write")
196 call sessionfrom%messages_open_input(filename="example_dballe.bufr",mode="r",format="BUFR",simplified=.true.)
197 
198 call l4f_category_log(category,l4f_info,"connect to dsn type BUFR file for write")
199 sessionto=dbasession(filename="example_dballe_copy1fmem.bufr",wipe=.true.,write=.true.,memdb=.false.)
200 call l4f_category_log(category,l4f_info,"copy1fmem")
201 call copy1fmem() ! copy data and attributes of everythings to an other file using mem for input
202 call sessionto%delete()
203 
204 call sessionfrom%messages_open_output(filename="example_dballe_copyf2mem.bufr")
205 call l4f_category_log(category,l4f_info,"copy1f2mem")
206 call copy1f2mem() ! copy data and attributes of everythings to an other file using mem for input and output
207 
208 !close everythings
209 call sessionfrom%delete()
210 call connectionfrom%delete()
211 
212 contains
213 
214 subroutine write0()
215 
216 type(dbasession) :: sessionana
217 type(dbaanalist) :: anal
218 type(dbaana) :: ana
219 logical :: status
220 
221 ! connect to dsn type BUFR file for write
222 sessionana=dbasession(filename="example_dballe_ana.bufr",wipe=.true.,write=.true.,memdb=.false.)
223 
224 
225 call anal%append(dbaana(lon=11.d0,lat=45.d0))
226 call anal%append(dbaana(lon=12.d0,lat=45.d0))
227 call anal%append(dbaana(lon=13.d0,lat=45.d0))
228 
229 call anal%display()
230 
231 call anal%rewind()
232 !extrude ana
233 do while (anal%element())
234  ana=anal%current()
235  call ana%extrude(sessionana)
236  call anal%next()
237 end do
238 
239 call sessionana%delete()
240 status=anal%delete()
241 
242 end subroutine write0
243 
244 
245 subroutine write1()
246 
247 type(dbametaanddata),allocatable :: metaanddata(:)
248 type(dbadcv) :: attrv
249 
250 print *,"----------------------------------------------"
251 print *,"--------------- write1 ------------------------"
252 
253 allocate(metaanddata(2)) ! one metadata for data and one for constant data
254 
255 metaanddata(1)%metadata=dbametadata( &
256  level=dbalevel(level1=105, l1=2000) &
257  ,timerange=dbatimerange(timerange=4, p1=3600,p2=7200) &
258  ,ana=dbaana(lon=10.d0,lat=45.d0) &
259  ,network=dbanetwork("generic") &
260  ,datetime=dbadatetime(datetime_new(2014,01,06,18,00)))
261 
262 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
263 ! create an etherogeneous ensamble of data
264 allocate (metaanddata(1)%dataattrv%dataattr(2))
265 
266 ! first data
267 allocate (metaanddata(1)%dataattrv%dataattr(1)%dat,source=dbadatai("B13003",85))
268 
269 ! create an etherogeneous ensamble of attr
270 allocate (attrv%dcv(3))
271 allocate (attrv%dcv(1)%dat,source=dbadatar("*B33192",30.))
272 allocate (attrv%dcv(2)%dat,source=dbadatai("*B33193",50))
273 allocate (attrv%dcv(3)%dat,source=dbadatar("*B33194",70.))
274 !assemble data and attribute
275 metaanddata(1)%dataattrv%dataattr(1)%attrv=attrv
276 
277 ! second data
278 allocate (metaanddata(1)%dataattrv%dataattr(2)%dat,source=dbadatai("B12101",27315))
279 ! create an etherogeneous ensamble of attr
280 deallocate(attrv%dcv)
281 allocate (attrv%dcv(2))
282 allocate (attrv%dcv(1)%dat,source=dbadatar("*B33192",30.))
283 allocate (attrv%dcv(2)%dat,source=dbadatai("*B33193",50))
284 !assemble data and attribute
285 metaanddata(1)%dataattrv%dataattr(2)%attrv=attrv
286 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
287 
288 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
289 ! station costant data
290 ! copy the same metadata setting that here we have constant in time data
291 metaanddata(2)%metadata=metaanddata(1)%metadata%dbacontextana()
292 ! create an etherogeneous ensamble of data
293 allocate (metaanddata(2)%dataattrv%dataattr(2))
294 allocate (metaanddata(2)%dataattrv%dataattr(1)%dat,source=dbadatai("B07030",223))
295 allocate (metaanddata(2)%dataattrv%dataattr(1)%attrv%dcv(0)) ! we do not want attributes
296 allocate (metaanddata(2)%dataattrv%dataattr(2)%dat,source=dbadatac("B01019","My beautifull station"))
297 allocate (metaanddata(2)%dataattrv%dataattr(2)%attrv%dcv(0)) ! we do not want attributes
298 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
299 
300 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
301 ! display and save everythings
302 do i=1,size(metaanddata)
303  call metaanddata(i)%display()
304  !call session%extrude(metaanddata(i))
305  call metaanddata(i)%extrude(session)
306 end do
307 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
308 
309 end subroutine write1
310 
311 
312 subroutine write2()
313 
314 type(dbadatar),allocatable :: data(:)
315 
316 type(dbalevel) :: level
317 type(dbatimerange) :: timerange
318 type(dbaana) :: ana
319 type(dbanetwork) :: network
320 type(dbadatetime) :: datetime
321 
322 print *,"----------------------------------------------"
323 print *,"--------------- write2 ------------------------"
324 
325 
326 !clear the dballe session
327 call session%unsetall()
328 
329 ! set and display metadata
330 level=dbalevel(level1=105, l1=2000)
331 call level%display()
332 timerange=dbatimerange(timerange=4, p1=3600,p2=7200)
333 call timerange%display()
334 !ana=dbaana(coord=dbacoord(ilon=1000000,ilat=4500000))
335 ana=dbaana(lon=11.d0,lat=45.d0)
336 call ana%display()
337 network=dbanetwork("generic")
338 call network%display()
339 datetime=dbadatetime(datetime_new(2014,01,06,18,00))
340 call datetime%display()
341 
342 ! can set metadata step by step
343 call session%set(level=level)
344 call session%set(timerange=timerange)
345 call session%set(ana=ana)
346 call session%set(network=network)
347 call session%set(datetime=datetime)
348 
349 ! I can use the reverse vision step by step
350 !call level%dbaset(session)
351 !call timerange%dbaset(session)
352 !call ana%dbaset(session)
353 !call network%dbaset(session)
354 !call datetime%dbaset(session)
355 
356 ! create an omogeneous vector of data
357 allocate (data(2),source=[dbadatar("B12102",265.33),dbadatar("B12101",273.15)])
358 
359 !set and display omogeneous data
360 do i =1,size(data)
361  call data(i)%display()
362  call session%set(data=data(i))
363  !call data(i)%dbaset(session)
364 end do
365 
366 !write it in dsn or file
367 call session%prendilo()
368 !!$session%enq(metadata)
369 
370 !close message if I am writing on file
371 call session%close_message()
372 
373 
374 end subroutine write2
375 
376 
377 subroutine write3()
378 
379 type(dbametadata) :: metadata
380 type(dbadcv) :: datav
381 type(dbalevel) :: level
382 type(dbatimerange) :: timerange
383 type(dbaana) :: ana
384 type(dbanetwork) :: network
385 type(dbadatetime) :: datetime
386 
387 print *,"----------------------------------------------"
388 print *,"--------------- write3 ------------------------"
389 
390 
391 !clear the dballe session
392 call session%unsetall()
393 
394 ! set metadata
395 level=dbalevel(level1=105, l1=2000)
396 timerange=dbatimerange(timerange=4, p1=3600,p2=7200)
397 ana=dbaana(lon=12.d0,lat=45.d0)
398 network=dbanetwork("generic")
399 datetime=dbadatetime(datetime_new(2014,01,06,18,00))
400 
401 !assemble metadata
402 metadata=dbametadata(level=level,timerange=timerange,ana=ana,network=network,datetime=datetime)
403 call metadata%display()
404 
405 ! I can set metadata one shot
406 call session%set(metadata)
407 ! or in the reverse vision
408 !call metadata%dbaset(session)
409 
410 call metadata%display()
411 
412 ! create and display an etherogeneous ensamble of data
413 allocate (datav%dcv(2))
414 allocate (datav%dcv(1)%dat,source=dbadatai("B12102",26312))
415 allocate (datav%dcv(2)%dat,source=dbadatar("B12101",273.15))
416 call datav%display()
417 !set data
418 call session%set(datav=datav)
419 
420 ! or in the reverse vision
421 !call datav%dbaset(session)
422 
423 !write it in dsn
424 call session%prendilo()
425 !!$session%enq(metadata)
426 
427 !close message if I am writing on file
428 call session%close_message()
429 
430 end subroutine write3
431 
432 
433 subroutine write4()
434 
435 type(dbametadata) :: metadata
436 type(dbadataattrv) :: dataattrv
437 type(dbadcv) :: attrv
438 type(dbadcv) :: datav
439 
440 print *,"----------------------------------------------"
441 print *,"--------------- write4 ------------------------"
442 
443 ! clear the dballe session
444 call session%unsetall()
445 
446 ! define metadata
447 metadata=dbametadata( &
448  level=dbalevel(level1=105, l1=2000) &
449  ,timerange=dbatimerange(timerange=4, p1=3600,p2=7200) &
450  ,ana=dbaana(lon=13.d0,lat=45.d0) &
451  ,network=dbanetwork("generic") &
452  ,datetime=dbadatetime(datetime_new(2014,01,06,18,00)))
453 
454 call session%set(metadata)
455 
456 ! create and display an etherogeneous ensamble of data
457 allocate (datav%dcv(2))
458 allocate (datav%dcv(1)%dat,source=dbadatai("B12102",26312))
459 allocate (datav%dcv(2)%dat,source=dbadatar("B12101",273.15))
460 
461 ! create and display an etherogeneous ensamble of attr
462 allocate (attrv%dcv(3))
463 allocate (attrv%dcv(1)%dat,source=dbadatai("*B33192",30))
464 allocate (attrv%dcv(2)%dat,source=dbadatac("*B33193","70"))
465 allocate (attrv%dcv(3)%dat,source=dbadatad("*B33194",50.d0))
466 call attrv%display()
467 
468 ! assemble data and attribute
469 allocate (dataattrv%dataattr(2))
470 ! first with attribute
471 allocate (dataattrv%dataattr(1)%dat,source=datav%dcv(1)%dat)
472 dataattrv%dataattr(1)%attrv=attrv
473 ! second without attribute
474 allocate (dataattrv%dataattr(2)%dat,source=datav%dcv(2)%dat)
475 allocate (dataattrv%dataattr(2)%attrv%dcv(0))
476 
477 call dataattrv%display()
478 
479 ! write data and attribute
480 !call session%extrude(dataattrv)
481 call dataattrv%extrude(session)
482 
483 
484 ! work on constant station data
485 call session%set(metadata%dbacontextana())
486 
487 ! write the same data and attribute as constant station data
488 !call session%extrude(dataattrv)
489 call dataattrv%extrude(session)
490 
491 end subroutine write4
492 
493 
494 subroutine write5()
495 
496 print *,"----------------------------------------------"
497 print *,"--------------- write5 ------------------------"
498 
499 call session%messages_open_output(filename="example_dballe_write5.bufr")
500 
501 call session%set(filter=dbafilter(coordmin=dbacoord(lon= 9.d0,lat=44.d0),&
502  coordmax=dbacoord(lon=11.d0,lat=46.d0)))
503 call session%messages_write_next()
504 
505 end subroutine write5
506 
507 
508 
509 subroutine read1()
510 
511 type(dbametaanddata),allocatable :: metaanddatav(:)
512 type(dbaana),allocatable :: ana(:)
513 type(dbafilter) :: filter
514 integer :: i
515 
516 print *,"----------------------------------------------"
517 print *,"--------------- read1 ------------------------"
518 
519 call session%set(filter=dbafilter())
520 
521 print *, "anagrafica:"
522 filter=dbafilter(coordmin=dbacoord(lon= 9.d0,lat=44.d0),&
523  coordmax=dbacoord(lon=11.d0,lat=46.d0))
524 call session%set(filter=filter)
525 call session%ingesta(ana)
526 do i=1,size(ana)
527  call ana(i)%display()
528 end do
529 deallocate(ana)
530 
531 print *, "dati di anagrafica:"
532 call session%set(filter=dbafilter(contextana=.true.))
533 call session%ingest(metaanddatav)
534 do i=1,size(metaanddatav)
535  call metaanddatav(i)%display()
536 end do
537 deallocate(metaanddatav)
538 
539 print *, "dati dati:"
540 filter=dbafilter(var="B12102")
541 call filter%display()
542 call session%set(filter=filter)
543 call session%ingest(metaanddatav)
544 
545 do i=1,size(metaanddatav)
546  call metaanddatav(i)%display()
547 end do
548 
549 deallocate(metaanddatav)
550 
551 end subroutine read1
552 
553 subroutine read1lf()
554 
555 type(dbametaanddatalist) :: metaanddatal
556 type(dbaanalist) :: anal
557 logical :: status
558 
559 print *,"----------------------------------------------"
560 print *,"--------------- read1lf ------------------------"
561 
562 ! here (reading from file) we cannot use filters !!!
563 
564 ! rewind
565 call session%filerewind()
566 
567 print *, "anagrafica:"
568 call session%ingesta(anal)
569 call anal%display()
570 status=anal%delete()
571 
572 ! rewind
573 call session%filerewind()
574 
575 print *, "dati di anagrafica:"
576 call session%ingest(metaanddatal,filter=dbafilter(contextana=.true.))
577 call metaanddatal%display()
578 status = metaanddatal%delete()
579 
580 ! rewind
581 call session%filerewind()
582 
583 print *, "dati dati:"
584 metaanddatal=dbametaanddatalist()
585 call session%ingest(metaanddatal)
586 call metaanddatal%display()
587 status = metaanddatal%delete()
588 
589 end subroutine read1lf
590 
591 subroutine read2()
592 
593 type(dbametaanddata),allocatable :: metaanddatav(:)
594 type(dbafilter) :: filter
595 integer :: i
596 type(dbadcv) :: vars,starvars
597 integer :: ivalue
598 real :: rvalue
599 character(len=128) :: cvalue
600 
601 print *,"----------------------------------------------"
602 print *,"--------------- read2 ------------------------"
603 
604 allocate (vars%dcv(2))
605 allocate (vars%dcv(1)%dat,source=dbadatai("B12101"))
606 allocate (vars%dcv(2)%dat,source=dbadatac("B12102"))
607 
608 filter=dbafilter(vars=vars)
609 print *, "filter:"
610 call filter%display()
611 call session%set(filter=filter)
612 call session%ingest(metaanddatav,filter=filter,noattr=.true.)
613 
614 print *, "dati dati:"
615 do i=1,size(metaanddatav)
616  call metaanddatav(i)%display()
617 end do
618 
619 
620 !!!!!!!!!!!!!!!!
621 ! how use values
622 associate(dato => metaanddatav(1)%dataattrv%dataattr(1)%dat)
623 print *,dato%btable
624 ! with cast
625 select type (dato)
626 type is (dbadatai)
627  print *,"cast integer value",dato%value
628 type is (dbadatar)
629  print *,"cast real value",dato%value
630 type is (dbadatac)
631  print *,"cast character value",dato%value
632 end select
633 
634 ! calling %get
635 call dato%get(ivalue)
636 if (c_e(ivalue)) print *,"get integer value",ivalue
637 call dato%get(rvalue)
638 if (c_e(rvalue)) print *,"get real value",rvalue
639 call dato%get(cvalue)
640 if (c_e(cvalue)) print *,"get char value",cvalue
641 end associate
642 !!!!!!!!!!!!!!!!
643 
644 
645 deallocate (vars%dcv)
646 allocate (vars%dcv(2))
647 allocate (vars%dcv(1)%dat,source=dbadatai("B13003"))
648 allocate (vars%dcv(2)%dat,source=dbadatac("B12102"))
649 allocate (starvars%dcv(3))
650 allocate (starvars%dcv(1)%dat,source=dbadatai("*B33192"))
651 allocate (starvars%dcv(2)%dat,source=dbadatac("*B33193"))
652 allocate (starvars%dcv(3)%dat,source=dbadatad("*B33194"))
653 
654 filter=dbafilter(vars=vars,starvars=starvars)
655 print *, "filter:"
656 call filter%display()
657 call session%set(filter=filter)
658 call session%ingest(metaanddatav,filter=filter)
659 
660 print *, "dati dati:"
661 do i=1,size(metaanddatav)
662  call metaanddatav(i)%display()
663 end do
664 
665 deallocate(metaanddatav)
666 
667 end subroutine read2
668 
669 
670 
671 subroutine read2lf()
672 
673 type(dbametaanddatalist) :: metaanddatal
674 type(dbafilter) :: filter
675 type(dbadcv) :: vars,starvars
676 logical :: status
677 
678 print *,"----------------------------------------------"
679 print *,"--------------- read2lf ------------------------"
680 
681 ! rewind
682 call session%filerewind()
683 
684 allocate (vars%dcv(2))
685 allocate (vars%dcv(1)%dat,source=dbadatai("B13003"))
686 allocate (vars%dcv(2)%dat,source=dbadatac("B12102"))
687 allocate (starvars%dcv(3))
688 allocate (starvars%dcv(1)%dat,source=dbadatai("*B33192"))
689 allocate (starvars%dcv(2)%dat,source=dbadatac("*B33193"))
690 allocate (starvars%dcv(3)%dat,source=dbadatad("*B33194"))
691 
692 filter=dbafilter(vars=vars,starvars=starvars)
693 !print *, "filter:"
694 !call filter%display()
695 
696 call session%ingest(metaanddatal,filter=filter)
697 
698 print *, "dati dati:"
699 call metaanddatal%display()
700 
701 status=metaanddatal%delete()
702 
703 end subroutine read2lf
704 
705 
706 subroutine read3()
707 
708 type(dbametaanddatar),allocatable :: metaanddatarv(:)
709 type(dbafilter) :: filter
710 integer :: i
711 
712 print *,"----------------------------------------------"
713 print *,"--------------- read3 ------------------------"
714 
715 print *, "dati dati:"
716 filter=dbafilter(var="B12102")
717 call filter%display()
718 call session%set(filter=filter)
719 call session%ingest(metaanddatarv)
720 
721 do i=1,size(metaanddatarv)
722  call metaanddatarv(i)%display()
723 end do
724 
725 print *,"max=",maxval(metaanddatarv(:)%dbadatar%value)
726 print *,"livelli", metaanddatarv(:)%metadata%level
727 
728 deallocate(metaanddatarv)
729 
730 end subroutine read3
731 
732 
733 
734 !!$subroutine read3l()
735 !!$
736 !!$type(dbametaanddatarlist) :: metaanddatarl
737 !!$type(dbametaanddatar),allocatable :: metaanddatarv(:)
738 !!$type(dbafilter) :: filter
739 !!$logical :: status
740 !!$
741 !!$print *,"----------------------------------------------"
742 !!$print *,"--------------- read3l ------------------------"
743 !!$
744 !!$! rewind
745 !!$call session%filerewind()
746 !!$
747 !!$print *, "dati dati:"
748 !!$filter=dbafilter(var="B12102")
749 !!$call session%set(filter=filter)
750 !!$call session%ingest(metaanddatarl)
751 !!$
752 !!$call metaanddatarl%display()
753 !!$
754 !!$metaanddatarv=metaanddatarl%toarray()
755 !!$print *,"max=",maxval(metaanddatarv(:)%dbadatar%value)
756 !!$
757 !!$status = metaanddatarl%delete()
758 !!$
759 !!$end subroutine read3l
760 
761 
762 subroutine read3lfmem()
763 
764 type(dbametaanddatarlist) :: metaanddatarl
765 type(dbametaanddatar),allocatable :: metaanddatarv(:)
766 type(dbafilter) :: filter
767 logical :: status
768 integer :: i
769 
770 print *,"----------------------------------------------"
771 print *,"--------------- read3lfmem ------------------------"
772 
773 ! connect to dsn type DBA
774 connection=dbaconnection(dsn="mem:")
775 session=dbasession(connection,wipe=.true.,anaflag="write", dataflag="write", attrflag="write",memdb=.true.)
776 call session%messages_open_input(filename="example_dballe.bufr",mode="r",format="BUFR",simplified=.true.)
777 
778 filter=dbafilter(var="B12101")
779 
780 ! data
781 do while (session%messages_read_next())
782 
783  call session%set(filter=filter)
784 
785  call session%ingest()
786  call session%ingest(metaanddatarv)
787 
788  do i=1,size(metaanddatarv)
789  call metaanddatarv(i)%display()
790  call metaanddatarl%append(metaanddatarv(i))
791  end do
792 
793  call session%remove_all()
794  deallocate (metaanddatarv)
795 end do
796 
797 
798 print *, "dati dati:"
799 call metaanddatarl%display()
800 
801 metaanddatarv=metaanddatarl%toarray()
802 print *,"max=",maxval(metaanddatarv(:)%dbadatar%value)
803 
804 status = metaanddatarl%delete()
805 
806 !close everythings
807 call session%delete()
808 call connection%delete()
809 
810 end subroutine read3lfmem
811 
812 
813 subroutine readmem()
814 
815 type(dbametaanddatalist) :: metaanddatal
816 type(dbafilter) :: filter
817 logical :: status
818 
819 print *,"----------------------------------------------"
820 print *,"--------------- readmem ------------------------"
821 
822 ! create mem db where put bufr from file
823 session=dbasession(wipe=.true.,&
824  filename="example_dballe.bufr",mode="r",format="BUFR",memdb=.true.,loadfile=.false.)
825 
826 filter=dbafilter(var="B12101")
827 ! in this case we have to pass filter and do not set it
828 call session%ingest(metaanddatal,filter=filter)
829 
830 print *, "dati dati:"
831 call metaanddatal%display()
832 
833 status = metaanddatal%delete()
834 
835 call session%delete()
836 
837 end subroutine readmem
838 
839 
840 subroutine read4l()
841 
842 type(dbametaanddata) :: myelement
843 type(dbametaanddatalist) :: metaanddatal
844 type(dbafilter) :: filter
845 
846 print *,"----------------------------------------------"
847 print *,"--------------- read4l ------------------------"
848 
849 print *, "dati dati:"
850 filter=dbafilter(var="B12102")
851 !call session%set(filter=filter)
852 
853 print*,"prima di ingest"
854 call session%ingest(metaanddatal,filter=filter)
855 print*,"prima di display"
856 call metaanddatal%display()
857 
858 print *,"number of list elements=",metaanddatal%countelements()
859 print *,"seek return status =", metaanddatal%seek(1)
860 myelement=metaanddatal%current()
861 print *,"list index 1 ="
862 call myelement%display()
863 print *,"status delete=", metaanddatal%delete()
864 
865 end subroutine read4l
866 
867 
868 subroutine delete1()
869 
870 type(dbafilter) :: filter
871 
872 print *,"----------------------------------------------"
873 print *,"--------------- delete1 ----------------------"
874 
875 filter=dbafilter(var="B12101")
876 call session%set(filter=filter)
877 call session%dissolve()
878 
879 end subroutine delete1
880 
881 
882 subroutine delete2()
883 
884 type(dbametadata),allocatable :: metadata(:)
885 type(dbafilter) :: filter
886 
887 print *,"----------------------------------------------"
888 print *,"--------------- delete2 ----------------------"
889 
890 
891 allocate(metadata(1))
892 
893 metadata(1)=dbametadata( &
894  level=dbalevel(level1=105, l1=2000) &
895  ,timerange=dbatimerange(timerange=4, p1=3600,p2=7200) &
896  ,ana=dbaana(lon=11.d0,lat=45.d0) &
897  ,network=dbanetwork("generic") &
898  ,datetime=dbadatetime(datetime_new(2014,01,06,18,00)))
899 
900 
901 filter=dbafilter(var="B12102")
902 call session%set(filter=filter)
903 call session%dissolve(metadata)
904 
905 deallocate(metadata)
906 
907 end subroutine delete2
908 
909 
910 
911 subroutine delete3()
912 
913 type(dbametadata),allocatable :: metadata(:)
914 type(dbafilter) :: filter
915 
916 print *,"----------------------------------------------"
917 print *,"--------------- delete3 ----------------------"
918 
919 
920 allocate(metadata(1))
921 
922 metadata(1)=dbametadata( &
923  level=dbalevel(level1=105, l1=2000) &
924  ,timerange=dbatimerange(timerange=4, p1=3600,p2=7200) &
925  ,ana=dbaana(lon=13.d0,lat=45.d0) &
926  ,network=dbanetwork("generic") &
927  ,datetime=dbadatetime(datetime_new(2014,01,06,18,00)))
928 
929 filter=dbafilter(var="B12102",starvarlist="*B33194,*B33193")
930 call session%set(filter=filter)
931 call session%dissolveattr(metadata)
932 
933 deallocate(metadata)
934 
935 end subroutine delete3
936 
937 subroutine copy1()
938 type(dbasession) :: sessioncp
939 type(dbaconnection) :: connectioncp
940 type(dbametaanddata):: metaanddata
941 
942 print *,"----------------------------------------------"
943 print *,"--------------- copy1 ----------------------"
944 
945 ! connect to dsn
946 connectioncp=dbaconnection(dsn="sqlite:/tmp/dballecopy1.sqlite")
947 !connectioncp=dbaconnection(dsn="mem:/tmp/dballecopy1")
948 sessioncp=dbasession(connectioncp,wipe=.true.,anaflag="write", dataflag="write", attrflag="write")
949 
950 ! data
951 call session%set(filter=dbafilter())
952 call session%ingest()
953 do while (c_e(session%count) .and. session%count > 0 )
954  call session%ingest (metaanddata)
955  !call sessioncp%extrude(metaanddata)
956  call metaanddata%extrude(sessioncp)
957  if (session%file) call session%close_message()
958 end do
959 
960 ! constant data
961 call session%set(filter=dbafilter(contextana=.true.))
962 call session%ingest()
963 do while (c_e(session%count) .and. session%count > 0)
964  call session%ingest (metaanddata)
965  !call sessioncp%extrude(metaanddata)
966  call metaanddata%extrude(sessioncp)
967  if (session%file) call session%close_message()
968 end do
969 
970 
971 !close everythings
972 call sessioncp%delete()
973 call connectioncp%delete()
974 
975 end subroutine copy1
976 
977 
978 subroutine copy1f()
979 type(dbametaanddata), allocatable:: metaanddatav(:)
980 integer :: i
981 
982 print *,"----------------------------------------------"
983 print *,"--------------- copy1f ----------------------"
984 
985 ! data
986 call sessionfrom%filerewind()
987 
988 call sessionfrom%set(filter=dbafilter())
989 call sessionfrom%ingest(metaanddatav)
990 do while (size(metaanddatav) >0)
991  print*,"read/write data; count: ",sessionfrom%count
992  do i =1,size(metaanddatav)
993  print *, "display metaanddatav index: ", i
994 ! call metaanddatav(i)%display()
995  !call sessionto%extrude(metaanddatav(i))
996  call metaanddatav(i)%extrude(sessionto)
997  end do
998 ! call sessionto%close_message()
999  call sessionfrom%ingest(metaanddatav)
1000 end do
1001 deallocate (metaanddatav)
1002 
1003 ! constant data
1004 call sessionfrom%filerewind()
1005 
1006 call sessionfrom%set(filter=dbafilter(contextana=.true.))
1007 call sessionfrom%ingest(metaanddatav)
1008 do while (size(metaanddatav) >0)
1009  print*,"read/write data; count: ",sessionfrom%count
1010  do i =1,size(metaanddatav)
1011  print *, "display metaanddatav index: ", i
1012 ! call metaanddatav(i)%display()
1013  !call sessionto%extrude(metaanddatav(i))
1014  call metaanddatav(i)%extrude(sessionto)
1015  end do
1016 ! call sessionto%close_message()
1017  call sessionfrom%ingest(metaanddatav)
1018 end do
1019 
1020 end subroutine copy1f
1021 
1022 
1023 subroutine copy1fmem()
1024 type(dbametaanddata),allocatable :: metaanddatav(:)
1025 integer :: i
1026 
1027 print *,"----------------------------------------------"
1028 print *,"--------------- copy1fmem ----------------------"
1029 
1030 
1031 do while (sessionfrom%messages_read_next())
1032  print*,"read/write message"
1033  call sessionfrom%set(filter=dbafilter())
1034  call sessionfrom%ingest(metaanddatav)
1035  do i =1,size(metaanddatav)
1036  call metaanddatav(i)%display()
1037  !call sessionto%extrude(metaanddatav(i))
1038  call metaanddatav(i)%extrude(sessionto)
1039  end do
1040  call sessionto%prendilo()
1041 
1042  print *,"contextana"
1043  call sessionfrom%set(filter=dbafilter(contextana=.true.))
1044  call sessionfrom%ingest(metaanddatav)
1045  do i =1,size(metaanddatav)
1046  call metaanddatav(i)%display()
1047  !call sessionto%extrude(metaanddatav(i))
1048  call metaanddatav(i)%extrude(sessionto)
1049  end do
1050  call sessionto%close_message()
1051  call sessionfrom%remove_all()
1052 end do
1053 
1054 end subroutine copy1fmem
1055 
1056 subroutine copy1f2mem()
1057 
1058 print *,"----------------------------------------------"
1059 print *,"--------------- copy1f2mem ----------------------"
1060 
1061 do while (sessionfrom%messages_read_next())
1062  call sessionfrom%messages_write_next()
1063  call sessionfrom%remove_all()
1064 end do
1065 
1066 end subroutine copy1f2mem
1067 
1068 
1069 subroutine copy2()
1070 type(dbasession) :: sessioncp
1071 type(dbaconnection) :: connectioncp
1072 type(dbametaanddatac):: metaanddatac
1073 
1074 print *,"----------------------------------------------"
1075 print *,"--------------- copy2 ----------------------"
1076 
1077 ! connect to dsn
1078 connectioncp=dbaconnection(dsn="sqlite:/tmp/dballecopy2.sqlite")
1079 sessioncp=dbasession(connectioncp,wipe=.true.,anaflag="write", dataflag="write", attrflag="write")
1080 
1081 ! use character type
1082 
1083 ! data
1084 call session%set(filter=dbafilter())
1085 call session%ingest_metaanddatac()
1086 do while (c_e(session%count) .and. session%count > 0)
1087  call session%ingest_metaanddatac(metaanddatac)
1088  !call sessioncp%extrude(metaanddatac)
1089  call metaanddatac%extrude(sessioncp)
1090 end do
1091 
1092 ! constant data
1093 call session%set(filter=dbafilter(contextana=.true.))
1094 call session%ingest_metaanddatac()
1095 do while (c_e(session%count) .and. session%count > 0)
1096  call session%ingest_metaanddatac(metaanddatac)
1097  !call sessioncp%extrude(metaanddatac)
1098  call metaanddatac%extrude(sessioncp)
1099 end do
1100 
1101 
1102 !close everythings
1103 call sessioncp%delete()
1104 call connectioncp%delete()
1105 
1106 end subroutine copy2
1107 
1108 end program example_dballe

Generated with Doxygen.