9 type(dbasession) :: session,sessionfrom,sessionto
10 type(dbaconnection) :: connection,connectionfrom
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()
216 type(dbasession) :: sessionana
217 type(dbaanalist) :: anal
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
247 type(dbametaanddata),
allocatable :: metaanddata(:)
248 type(dbadcv) :: attrv
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) &
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(:)
316 type(dbalevel) :: level
317 type(dbatimerange) :: timerange
319 type(dbanetwork) :: network
320 type(dbadatetime) :: datetime
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()
343 call session%set(level=level)
344 call session%set(timerange=timerange)
345 call session%set(ana=ana)
346 call session%set(network=network)
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
379 type(dbametadata) :: metadata
380 type(dbadcv) :: datav
381 type(dbalevel) :: level
382 type(dbatimerange) :: timerange
384 type(dbanetwork) :: network
385 type(dbadatetime) :: datetime
387 print *,
"----------------------------------------------" 388 print *,
"--------------- write3 ------------------------" 392 call session%unsetall()
397 ana=
dbaana(lon=12.d0,lat=45.d0)
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
435 type(dbametadata) :: metadata
436 type(dbadataattrv) :: dataattrv
437 type(dbadcv) :: attrv
438 type(dbadcv) :: datav
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) &
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
511 type(dbametaanddata),
allocatable :: metaanddatav(:)
512 type(dbaana),
allocatable :: ana(:)
513 type(dbafilter) :: filter
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)
555 type(dbametaanddatalist) :: metaanddatal
556 type(dbaanalist) :: anal
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
593 type(dbametaanddata),
allocatable :: metaanddatav(:)
594 type(dbafilter) :: filter
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)
673 type(dbametaanddatalist) :: metaanddatal
674 type(dbafilter) :: filter
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
708 type(dbametaanddatar),
allocatable :: metaanddatarv(:)
709 type(dbafilter) :: filter
712 print *,
"----------------------------------------------" 713 print *,
"--------------- read3 ------------------------" 715 print *,
"dati dati:" 716 filter=dbafilter(var=
"B12102")
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()
764 type(dbametaanddatarlist) :: metaanddatarl
765 type(dbametaanddatar),
allocatable :: metaanddatarv(:)
766 type(dbafilter) :: filter
770 print *,
"----------------------------------------------" 771 print *,
"--------------- read3lfmem ------------------------" 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.)
778 filter=dbafilter(var=
"B12101")
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
815 type(dbametaanddatalist) :: metaanddatal
816 type(dbafilter) :: filter
819 print *,
"----------------------------------------------" 820 print *,
"--------------- readmem ------------------------" 823 session=dbasession(wipe=.true.,&
824 filename=
"example_dballe.bufr",mode=
"r",format=
"BUFR",memdb=.true.,loadfile=.false.)
826 filter=dbafilter(var=
"B12101")
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
842 type(dbametaanddata) :: myelement
843 type(dbametaanddatalist) :: metaanddatal
844 type(dbafilter) :: filter
846 print *,
"----------------------------------------------" 847 print *,
"--------------- read4l ------------------------" 849 print *,
"dati dati:" 850 filter=dbafilter(var=
"B12102")
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
870 type(dbafilter) :: filter
872 print *,
"----------------------------------------------" 873 print *,
"--------------- delete1 ----------------------" 875 filter=dbafilter(var=
"B12101")
876 call session%set(filter=filter)
877 call session%dissolve()
879 end subroutine delete1
884 type(dbametadata),
allocatable :: metadata(:)
885 type(dbafilter) :: filter
887 print *,
"----------------------------------------------" 888 print *,
"--------------- delete2 ----------------------" 891 allocate(metadata(1))
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)))
901 filter=dbafilter(var=
"B12102")
902 call session%set(filter=filter)
903 call session%dissolve(metadata)
907 end subroutine delete2
913 type(dbametadata),
allocatable :: metadata(:)
914 type(dbafilter) :: filter
916 print *,
"----------------------------------------------" 917 print *,
"--------------- delete3 ----------------------" 920 allocate(metadata(1))
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)))
929 filter=dbafilter(var=
"B12102",starvarlist=
"*B33194,*B33193")
930 call session%set(filter=filter)
931 call session%dissolveattr(metadata)
935 end subroutine delete3
938 type(dbasession) :: sessioncp
939 type(dbaconnection) :: connectioncp
940 type(dbametaanddata):: metaanddata
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")
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)
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()
979 type(dbametaanddata),
allocatable:: metaanddatav(:)
982 print *,
"----------------------------------------------" 983 print *,
"--------------- copy1f ----------------------" 986 call sessionfrom%filerewind()
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
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()
1024 type(dbametaanddata),
allocatable :: metaanddatav(:)
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
1070 type(dbasession) :: sessioncp
1071 type(dbaconnection) :: connectioncp
1072 type(dbametaanddatac):: metaanddatac
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")
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)
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