9 type(dbasession) :: session,sessionfrom,sessionto
29 integer :: category,ier
30 character(len=512):: a_name
33 call l4f_launcher(a_name,a_name_force=
"example",a_name_append=
"main")
37 category=l4f_category_get(a_name//
".main")
46 ana=
dbaana(coord,ident=
"mianave")
49 mydatetime=
dbadatetime(datetime_new(2014,01,06,18,00))
61 metadata=
dbametadata(level=level,timerange=timerange,ana=ana,network=network,datetime=mydatetime)
64 metaanddatar%metadata=metadata
65 metaanddatar%dbadatar=datar
81 allocate(dc%dat,source=
dbadatai(
"B12102",26312))
85 allocate (dcv%dcv(1)%dat,source=
dbadatai(
"B12102",26312))
86 allocate (dcv%dcv(2)%dat,source=
dbadatar(
"B12101",273.15))
89 metaanddatav%metadata=metadata
90 metaanddatav%datav=dcv
93 allocate(dataattrv%dataattr(2))
94 dataattrv%dataattr(1)%dbadc=dc
95 dataattrv%dataattr(1)%attrv=dcv
98 metaandata%metadata=metadata
99 metaandata%dataattrv=dataattrv
107 session=
dbasession(connection,wipe=.true.,anaflag=
"write", dataflag=
"write", attrflag=
"write")
139 call session%delete()
140 call connection%delete()
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.)
158 call session%delete()
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.)
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.)
189 call sessionto%delete()
190 call sessionfrom%delete()
193 call
l4f_category_log(category,l4f_info,
"use memdb: connect to dsn type DBA")
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.)
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.)
202 call sessionto%delete()
204 call sessionfrom%messages_open_output(filename=
"example_dballe_copyf2mem.bufr")
209 call sessionfrom%delete()
210 call connectionfrom%delete()
222 sessionana=
dbasession(filename=
"example_dballe_ana.bufr",wipe=.true.,write=.true.,memdb=.false.)
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))
233 do while (anal%element())
235 call ana%extrude(sessionana)
239 call sessionana%delete()
242 end subroutine write0
250 print *,
"----------------------------------------------"
251 print *,
"--------------- write1 ------------------------"
253 allocate(metaanddata(2))
256 level=
dbalevel(level1=105, l1=2000) &
258 ,ana=
dbaana(lon=10.d0,lat=45.d0) &
260 ,datetime=
dbadatetime(datetime_new(2014,01,06,18,00)))
264 allocate (metaanddata(1)%dataattrv%dataattr(2))
267 allocate (metaanddata(1)%dataattrv%dataattr(1)%dat,source=
dbadatai(
"B13003",85))
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.))
275 metaanddata(1)%dataattrv%dataattr(1)%attrv=attrv
278 allocate (metaanddata(1)%dataattrv%dataattr(2)%dat,source=
dbadatai(
"B12101",27315))
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))
285 metaanddata(1)%dataattrv%dataattr(2)%attrv=attrv
291 metaanddata(2)%metadata=metaanddata(1)%metadata%dbacontextana()
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))
296 allocate (metaanddata(2)%dataattrv%dataattr(2)%dat,source=
dbadatac(
"B01019",
"My beautifull station"))
297 allocate (metaanddata(2)%dataattrv%dataattr(2)%attrv%dcv(0))
302 do i=1,
size(metaanddata)
303 call metaanddata(i)%display()
305 call metaanddata(i)%extrude(session)
309 end subroutine write1
314 type(dbadatar),
allocatable :: data(:)
322 print *,
"----------------------------------------------"
323 print *,
"--------------- write2 ------------------------"
327 call session%unsetall()
333 call timerange%display()
335 ana=
dbaana(lon=11.d0,lat=45.d0)
338 call network%display()
339 datetime=
dbadatetime(datetime_new(2014,01,06,18,00))
340 call datetime%display()
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)
357 allocate (
data(2),source=[
dbadatar(
"B12102",265.33),
dbadatar(
"B12101",273.15)])
361 call
data(i)%display()
362 call session%set(data=
data(i))
367 call session%prendilo()
371 call session%close_message()
374 end subroutine write2
387 print *,
"----------------------------------------------"
388 print *,
"--------------- write3 ------------------------"
392 call session%unsetall()
397 ana=
dbaana(lon=12.d0,lat=45.d0)
399 datetime=
dbadatetime(datetime_new(2014,01,06,18,00))
402 metadata=
dbametadata(level=level,timerange=timerange,ana=ana,network=network,datetime=datetime)
403 call metadata%display()
406 call session%set(metadata)
410 call metadata%display()
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))
418 call session%set(datav=datav)
424 call session%prendilo()
428 call session%close_message()
430 end subroutine write3
440 print *,
"----------------------------------------------"
441 print *,
"--------------- write4 ------------------------"
444 call session%unsetall()
448 level=
dbalevel(level1=105, l1=2000) &
450 ,ana=
dbaana(lon=13.d0,lat=45.d0) &
452 ,datetime=
dbadatetime(datetime_new(2014,01,06,18,00)))
454 call session%set(metadata)
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))
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))
469 allocate (dataattrv%dataattr(2))
471 allocate (dataattrv%dataattr(1)%dat,source=datav%dcv(1)%dat)
472 dataattrv%dataattr(1)%attrv=attrv
474 allocate (dataattrv%dataattr(2)%dat,source=datav%dcv(2)%dat)
475 allocate (dataattrv%dataattr(2)%attrv%dcv(0))
477 call dataattrv%display()
481 call dataattrv%extrude(session)
485 call session%set(metadata%dbacontextana())
489 call dataattrv%extrude(session)
491 end subroutine write4
496 print *,
"----------------------------------------------"
497 print *,
"--------------- write5 ------------------------"
499 call session%messages_open_output(filename=
"example_dballe_write5.bufr")
502 coordmax=
dbacoord(lon=11.d0,lat=46.d0)))
503 call session%messages_write_next()
505 end subroutine write5
512 type(dbaana),
allocatable :: ana(:)
516 print *,
"----------------------------------------------"
517 print *,
"--------------- read1 ------------------------"
521 print *,
"anagrafica:"
523 coordmax=
dbacoord(lon=11.d0,lat=46.d0))
524 call session%set(filter=filter)
525 call session%ingesta(ana)
527 call ana(i)%display()
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()
537 deallocate(metaanddatav)
539 print *,
"dati dati:"
541 call filter%display()
542 call session%set(filter=filter)
543 call session%ingest(metaanddatav)
545 do i=1,
size(metaanddatav)
546 call metaanddatav(i)%display()
549 deallocate(metaanddatav)
559 print *,
"----------------------------------------------"
560 print *,
"--------------- read1lf ------------------------"
565 call session%filerewind()
567 print *,
"anagrafica:"
568 call session%ingesta(anal)
573 call session%filerewind()
575 print *,
"dati di anagrafica:"
576 call session%ingest(metaanddatal,filter=
dbafilter(contextana=.true.))
577 call metaanddatal%display()
578 status = metaanddatal%delete()
581 call session%filerewind()
583 print *,
"dati dati:"
585 call session%ingest(metaanddatal)
586 call metaanddatal%display()
587 status = metaanddatal%delete()
589 end subroutine read1lf
596 type(dbadcv) :: vars,starvars
599 character(len=128) :: cvalue
601 print *,
"----------------------------------------------"
602 print *,
"--------------- read2 ------------------------"
604 allocate (vars%dcv(2))
605 allocate (vars%dcv(1)%dat,source=
dbadatai(
"B12101"))
606 allocate (vars%dcv(2)%dat,source=
dbadatac(
"B12102"))
610 call filter%display()
611 call session%set(filter=filter)
612 call session%ingest(metaanddatav,filter=filter,noattr=.true.)
614 print *,
"dati dati:"
615 do i=1,
size(metaanddatav)
616 call metaanddatav(i)%display()
622 associate(dato => metaanddatav(1)%dataattrv%dataattr(1)%dat)
627 print *,
"cast integer value",dato%value
629 print *,
"cast real value",dato%value
631 print *,
"cast character value",dato%value
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
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"))
654 filter=
dbafilter(vars=vars,starvars=starvars)
656 call filter%display()
657 call session%set(filter=filter)
658 call session%ingest(metaanddatav,filter=filter)
660 print *,
"dati dati:"
661 do i=1,
size(metaanddatav)
662 call metaanddatav(i)%display()
665 deallocate(metaanddatav)
675 type(dbadcv) :: vars,starvars
678 print *,
"----------------------------------------------"
679 print *,
"--------------- read2lf ------------------------"
682 call session%filerewind()
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"))
692 filter=
dbafilter(vars=vars,starvars=starvars)
696 call session%ingest(metaanddatal,filter=filter)
698 print *,
"dati dati:"
699 call metaanddatal%display()
701 status=metaanddatal%delete()
703 end subroutine read2lf
712 print *,
"----------------------------------------------"
713 print *,
"--------------- read3 ------------------------"
715 print *,
"dati dati:"
717 call filter%display()
718 call session%set(filter=filter)
719 call session%ingest(metaanddatarv)
721 do i=1,
size(metaanddatarv)
722 call metaanddatarv(i)%display()
725 print *,
"max=",maxval(metaanddatarv(:)%dbadatar%value)
726 print *,
"livelli", metaanddatarv(:)%metadata%level
728 deallocate(metaanddatarv)
762 subroutine read3lfmem()
770 print *,
"----------------------------------------------"
771 print *,
"--------------- read3lfmem ------------------------"
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.)
781 do while (session%messages_read_next())
783 call session%set(filter=filter)
785 call session%ingest()
786 call session%ingest(metaanddatarv)
788 do i=1,
size(metaanddatarv)
789 call metaanddatarv(i)%display()
790 call metaanddatarl%append(metaanddatarv(i))
793 call session%remove_all()
794 deallocate (metaanddatarv)
798 print *,
"dati dati:"
799 call metaanddatarl%display()
801 metaanddatarv=metaanddatarl%toarray()
802 print *,
"max=",maxval(metaanddatarv(:)%dbadatar%value)
804 status = metaanddatarl%delete()
807 call session%delete()
808 call connection%delete()
810 end subroutine read3lfmem
819 print *,
"----------------------------------------------"
820 print *,
"--------------- readmem ------------------------"
824 filename=
"example_dballe.bufr",mode=
"r",format=
"BUFR",memdb=.true.,loadfile=.false.)
828 call session%ingest(metaanddatal,filter=filter)
830 print *,
"dati dati:"
831 call metaanddatal%display()
833 status = metaanddatal%delete()
835 call session%delete()
837 end subroutine readmem
846 print *,
"----------------------------------------------"
847 print *,
"--------------- read4l ------------------------"
849 print *,
"dati dati:"
853 print*,
"prima di ingest"
854 call session%ingest(metaanddatal,filter=filter)
855 print*,
"prima di display"
856 call metaanddatal%display()
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()
865 end subroutine read4l
872 print *,
"----------------------------------------------"
873 print *,
"--------------- delete1 ----------------------"
876 call session%set(filter=filter)
877 call session%dissolve()
879 end subroutine delete1
887 print *,
"----------------------------------------------"
888 print *,
"--------------- delete2 ----------------------"
891 allocate(metadata(1))
894 level=
dbalevel(level1=105, l1=2000) &
896 ,ana=
dbaana(lon=11.d0,lat=45.d0) &
898 ,datetime=
dbadatetime(datetime_new(2014,01,06,18,00)))
902 call session%set(filter=filter)
903 call session%dissolve(metadata)
907 end subroutine delete2
916 print *,
"----------------------------------------------"
917 print *,
"--------------- delete3 ----------------------"
920 allocate(metadata(1))
923 level=
dbalevel(level1=105, l1=2000) &
925 ,ana=
dbaana(lon=13.d0,lat=45.d0) &
927 ,datetime=
dbadatetime(datetime_new(2014,01,06,18,00)))
929 filter=
dbafilter(var=
"B12102",starvarlist=
"*B33194,*B33193")
930 call session%set(filter=filter)
931 call session%dissolveattr(metadata)
935 end subroutine delete3
942 print *,
"----------------------------------------------"
943 print *,
"--------------- copy1 ----------------------"
946 connectioncp=
dbaconnection(dsn=
"sqlite:/tmp/dballecopy1.sqlite")
948 sessioncp=
dbasession(connectioncp,wipe=.true.,anaflag=
"write", dataflag=
"write", attrflag=
"write")
952 call session%ingest()
953 do while (
c_e(session%count) .and. session%count > 0 )
954 call session%ingest (metaanddata)
956 call metaanddata%extrude(sessioncp)
957 if (session%file) call session%close_message()
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)
966 call metaanddata%extrude(sessioncp)
967 if (session%file) call session%close_message()
972 call sessioncp%delete()
973 call connectioncp%delete()
982 print *,
"----------------------------------------------"
983 print *,
"--------------- copy1f ----------------------"
986 call sessionfrom%filerewind()
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
996 call metaanddatav(i)%extrude(sessionto)
999 call sessionfrom%ingest(metaanddatav)
1001 deallocate (metaanddatav)
1004 call sessionfrom%filerewind()
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
1014 call metaanddatav(i)%extrude(sessionto)
1017 call sessionfrom%ingest(metaanddatav)
1020 end subroutine copy1f
1023 subroutine copy1fmem()
1027 print *,
"----------------------------------------------"
1028 print *,
"--------------- copy1fmem ----------------------"
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()
1038 call metaanddatav(i)%extrude(sessionto)
1040 call sessionto%prendilo()
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()
1048 call metaanddatav(i)%extrude(sessionto)
1050 call sessionto%close_message()
1051 call sessionfrom%remove_all()
1054 end subroutine copy1fmem
1056 subroutine copy1f2mem()
1058 print *,
"----------------------------------------------"
1059 print *,
"--------------- copy1f2mem ----------------------"
1061 do while (sessionfrom%messages_read_next())
1062 call sessionfrom%messages_write_next()
1063 call sessionfrom%remove_all()
1066 end subroutine copy1f2mem
1074 print *,
"----------------------------------------------"
1075 print *,
"--------------- copy2 ----------------------"
1078 connectioncp=
dbaconnection(dsn=
"sqlite:/tmp/dballecopy2.sqlite")
1079 sessioncp=
dbasession(connectioncp,wipe=.true.,anaflag=
"write", dataflag=
"write", attrflag=
"write")
1085 call session%ingest_metaanddatac()
1086 do while (
c_e(session%count) .and. session%count > 0)
1087 call session%ingest_metaanddatac(metaanddatac)
1089 call metaanddatac%extrude(sessioncp)
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)
1098 call metaanddatac%extrude(sessioncp)
1103 call sessioncp%delete()
1104 call connectioncp%delete()
1106 end subroutine copy2
1108 end program example_dballe