dballe_test.F03

#include "config.h"
 
program dballe_test
 
use dballe_class
use datetime_class
use log4fortran
implicit none
 
type(dbasession) :: session, sessionfrom,sessionto
type(dbaconnection) :: connection ,connectionfrom
TYPE(l4f_handle) :: category
INTEGER :: ier
CHARACTER(len=512) :: a_name
 
!questa chiamata prende dal launcher il nome univoco
call l4f_launcher(a_name,a_name_force="dballe_test")
!init di log4fortran
ier=l4f_init()
!imposta a_name
category=l4f_category_get_handle(trim(a_name)//".main")
 
! connect to dsn type DBA
connection=dbaconnection(dsn="sqlite:dballe_test.sqlite?wipe=true")
session=dbasession(connection,wipe=.true.,write=.true.)!,anaflag="write", dataflag="write", attrflag="write")
call write1()    ! write etherogeneous ensamble of data with attributes and constant data using macro object
call write2()    ! write an omogeneous vector of data
call write3()    ! write an etherogeneous ensamble of data
call write4()    ! write an etherogeneous ensamble of data and attributes
call delete1()   ! delete one var from the entire DB
call delete2()   ! delete one var only where are some defined metadati
call delete3()   ! delete some attributes from one var only where are some defined metadati
 
# ifndef F2003_FULL_FEATURES
!close everythings
call session%delete()
call connection%delete()
#endif
 
! connect to dsn type BUFR file for write
session=dbasession(filename="dballe_test.bufr",wipe=.true.,write=.true.,memdb=.false.)
call write0()    ! write ana on file
call write1()    ! write etherogeneous ensamble of data with attributes and constant data using macro object
call write2()    ! write an omogeneous vector of data
call write3()    ! write an etherogeneous ensamble of data
call write4()    ! write an etherogeneous ensamble of data and attributes
 
# ifndef F2003_FULL_FEATURES
!close everythings
call session%delete()
#endif
 
! connect to dsn type BUFR file for read
sessionfrom=dbasession(filename="dballe_test.bufr",memdb=.false.)
! connect to dsn type BUFR file for write
sessionto=dbasession(filename="dballe_test_copy1f.bufr",wipe=.true.,write=.true.,memdb=.false.)
call copy1f()     ! copy data and attributes of everythings to an other file
 
# ifndef F2003_FULL_FEATURES
!close everythings
call sessionto%delete()
call sessionfrom%delete()
#endif
 
! use memdb
! connect to dsn type DBA
connectionfrom=dbaconnection(dsn="mem:")
sessionfrom=dbasession(connectionfrom,wipe=.true.,write=.true.)!,anaflag="write", dataflag="write", attrflag="write")
call sessionfrom%messages_open_input(filename="dballe_test.bufr",mode="r",format="BUFR",simplified=.true.)
! connect to dsn type BUFR file for write
sessionto=dbasession(filename="dballe_test_copy1fmem.bufr",wipe=.true.,write=.true.,memdb=.false.)
call copy1fmem()     ! copy data and attributes of everythings to an other file
 
# ifndef F2003_FULL_FEATURES
!close everythings
call sessionfrom%delete()
call connectionfrom%delete()
call sessionto%delete()
#endif
 
!chiudo il logger
CALL l4f_category_delete(category)
ier=l4f_fini()
 
contains
 
subroutine write0()
 
type(dbasession) :: sessionana
type(dbaanalist) :: anal
type(dbaana) :: ana
logical :: status
 
! connect to dsn type BUFR file for write
sessionana=dbasession(filename="dballe_test_ana.bufr",wipe=.true.,write=.true.,memdb=.false.)
 
 
call anal%append(dbaana(lon=11.d0,lat=45.d0))
call anal%append(dbaana(lon=12.d0,lat=45.d0))
call anal%append(dbaana(lon=13.d0,lat=45.d0))
 
call anal%display()
 
call anal%rewind()
!extrude ana
do while (anal%element())
  !call sessionana%extrude(ana=anal%current())
  ana=anal%current()
  call ana%extrude(sessionana)
  call anal%next()
end do
 
# ifndef F2003_FULL_FEATURES
call sessionana%delete()
#endif
 
status=anal%delete()
 
end subroutine write0
 
 
subroutine write1()
 
type(dbametaanddata),allocatable :: metaanddata(:)
type(dbadcv) :: attrv
integer :: i
 
print *,"----------------------------------------------"
print *,"--------------- write1 ------------------------"
 
allocate(metaanddata(2))   ! one metadata for data and one for constant data
 
metaanddata(1)%metadata=dbametadata( &
  level=dbalevel(level1=105, l1=2000) &
 ,timerange=dbatimerange(timerange=4, p1=3600,p2=7200) &
 ,ana=dbaana(lon=10.d0,lat=45.d0) &
 ,network=dbanetwork("generic") &
 ,datetime=dbadatetime(datetime_new(2014,01,06,18,00)))
 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! create  an etherogeneous ensamble of data
allocate (metaanddata(1)%dataattrv%dataattr(2))
 
! first data
allocate (metaanddata(1)%dataattrv%dataattr(1)%dat,source=dbadatai("B13003",85))
 
! create an etherogeneous ensamble of attr
allocate (attrv%dcv(3))
allocate (attrv%dcv(1)%dat,source=dbadatar("*B33192",30.))
allocate (attrv%dcv(2)%dat,source=dbadatai("*B33193",50))
allocate (attrv%dcv(3)%dat,source=dbadatar("*B33194",70.))
!assemble data and attribute
metaanddata(1)%dataattrv%dataattr(1)%attrv=attrv
 
! second data
allocate (metaanddata(1)%dataattrv%dataattr(2)%dat,source=dbadatai("B12101",27315))
! create an etherogeneous ensamble of attr
deallocate(attrv%dcv)
allocate (attrv%dcv(2))
allocate (attrv%dcv(1)%dat,source=dbadatar("*B33192",30.))
allocate (attrv%dcv(2)%dat,source=dbadatai("*B33193",50))
!assemble data and attribute
metaanddata(1)%dataattrv%dataattr(2)%attrv=attrv
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! station costant data
! copy the same metadata setting that here we have constant in time data
metaanddata(2)%metadata=metaanddata(1)%metadata%dbacontextana()
! create  an etherogeneous ensamble of data
allocate (metaanddata(2)%dataattrv%dataattr(2))
allocate (metaanddata(2)%dataattrv%dataattr(1)%dat,source=dbadatai("B07030",223))
allocate (metaanddata(2)%dataattrv%dataattr(1)%attrv%dcv(0))          ! we do not want attributes
allocate (metaanddata(2)%dataattrv%dataattr(2)%dat,source=dbadatac("B01019","My beautifull station"))
allocate (metaanddata(2)%dataattrv%dataattr(2)%attrv%dcv(0))          ! we do not want attributes
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! display and save everythings
do i=1,size(metaanddata)
  call metaanddata(i)%display()
  !call session%extrude(metaanddata=metaanddata(i))
  call metaanddata(i)%extrude(session)
end do
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
end subroutine write1
 
 
subroutine write2()
 
type(dbadatar),allocatable :: data(:)
 
type(dbalevel) :: level
type(dbatimerange) :: timerange
type(dbaana) :: ana
type(dbanetwork) :: network
type(dbadatetime) :: datetime
integer :: i
 
print *,"----------------------------------------------"
print *,"--------------- write2 ------------------------"
 
 
!clear the dballe session
call session%unsetall()
 
! set and display metadata
level=dbalevel(level1=105, l1=2000)
call level%display()
timerange=dbatimerange(timerange=4, p1=3600,p2=7200)
call timerange%display()
!ana=dbaana(coord=dbacoord(ilon=1000000,ilat=4500000))
ana=dbaana(lon=11.d0,lat=45.d0)
call ana%display()
network=dbanetwork("generic")
call network%display()
datetime=dbadatetime(datetime_new(2014,01,06,18,00))
call datetime%display()
 
! can set metadata  step by step
call session%set(level=level)
call session%set(timerange=timerange)
call session%set(ana=ana)
call session%set(network=network)
call session%set(datetime=datetime)
 
! I can use the reverse vision  step by step
!call level%dbaset(session)
!call timerange%dbaset(session)
!call ana%dbaset(session)
!call network%dbaset(session)
!call datetime%dbaset(session)
 
! create an omogeneous vector of data
allocate (data(2),source=[dbadatar("B12102",265.33),dbadatar("B12101",273.15)])
 
!set and display omogeneous data
do i =1,size(data)
  call data(i)%display()
  call session%set(data=data(i))
  !call data(i)%dbaset(session)
end do
 
!write it in dsn or file
call session%prendilo()
!!$session%enq(metadata)
 
!close message if I am writing on file
call session%close_message()
 
 
end subroutine write2
 
 
subroutine write3()
 
type(dbametadata) :: metadata
type(dbadcv) :: datav
type(dbalevel) :: level
type(dbatimerange) :: timerange
type(dbaana) :: ana
type(dbanetwork) :: network
type(dbadatetime) :: datetime
 
print *,"----------------------------------------------"
print *,"--------------- write3 ------------------------"
 
 
!clear the dballe session
call session%unsetall()
 
! set metadata
level=dbalevel(level1=105, l1=2000)
timerange=dbatimerange(timerange=4, p1=3600,p2=7200)
ana=dbaana(lon=12.d0,lat=45.d0)
network=dbanetwork("generic")
datetime=dbadatetime(datetime_new(2014,01,06,18,00))
 
!assemble metadata
metadata=dbametadata(level=level,timerange=timerange,ana=ana,network=network,datetime=datetime)
call metadata%display()
 
! I can set metadata one shot
call session%set(metadata)
! or in the reverse vision
!call metadata%dbaset(session)
 
call metadata%display()
 
! create and display an etherogeneous ensamble of data
allocate (datav%dcv(2))
allocate (datav%dcv(1)%dat,source=dbadatai("B12102",26312))
allocate (datav%dcv(2)%dat,source=dbadatar("B12101",273.15))
call datav%display()
!set data
call session%set(datav=datav)
 
! or in the reverse vision
!call datav%dbaset(session)
 
!write it in dsn
call session%prendilo()
!!$session%enq(metadata)
 
!close message if I am writing on file
call session%close_message()
 
end subroutine write3
 
 
subroutine write4()
 
type(dbametadata) :: metadata
type(dbadataattrv) :: dataattrv
type(dbadcv) :: attrv
type(dbadcv) :: datav
 
print *,"----------------------------------------------"
print *,"--------------- write4 ------------------------"
 
! clear the dballe session
call session%unsetall()
 
! define metadata
metadata=dbametadata( &
  level=dbalevel(level1=105, l1=2000) &
 ,timerange=dbatimerange(timerange=4, p1=3600,p2=7200) &
 ,ana=dbaana(lon=13.d0,lat=45.d0) &
 ,network=dbanetwork("generic") &
 ,datetime=dbadatetime(datetime_new(2014,01,06,18,00)))
 
call session%set(metadata)
 
! create and display an etherogeneous ensamble of data
allocate (datav%dcv(2))
allocate (datav%dcv(1)%dat,source=dbadatai("B12102",26312))
allocate (datav%dcv(2)%dat,source=dbadatar("B12101",273.15))
 
! create and display an etherogeneous ensamble of attr
allocate (attrv%dcv(3))
allocate (attrv%dcv(1)%dat,source=dbadatai("*B33192",30))
allocate (attrv%dcv(2)%dat,source=dbadatac("*B33193","70"))
allocate (attrv%dcv(3)%dat,source=dbadatad("*B33194",50.d0))
call attrv%display()
 
! assemble data and attribute
allocate (dataattrv%dataattr(2))
! first with attribute
allocate (dataattrv%dataattr(1)%dat,source=datav%dcv(1)%dat)
dataattrv%dataattr(1)%attrv=attrv
! second without attribute
allocate (dataattrv%dataattr(2)%dat,source=datav%dcv(2)%dat)
allocate (dataattrv%dataattr(2)%attrv%dcv(0))
 
call dataattrv%display()
 
! write data and attribute
!call session%extrude(dataattrv=dataattrv)
call dataattrv%extrude(session)
 
! work on constant station data
call session%set(metadata%dbacontextana())
 
! write the same data and attribute as constant station data
!call session%extrude(dataattrv=dataattrv)
call dataattrv%extrude(session)
 
end subroutine write4
 
 
subroutine delete1()
 
type(dbafilter) :: filter
 
print *,"----------------------------------------------"
print *,"--------------- delete1 ----------------------"
 
filter=dbafilter(var="B12101")
call session%set(filter=filter)
call session%dissolve()
 
end subroutine delete1
 
 
subroutine delete2()
 
type(dbametadata),allocatable :: metadata(:)
type(dbafilter) :: filter
 
print *,"----------------------------------------------"
print *,"--------------- delete2 ----------------------"
 
 
allocate(metadata(1))
 
metadata(1)=dbametadata( &
  level=dbalevel(level1=105, l1=2000) &
 ,timerange=dbatimerange(timerange=4, p1=3600,p2=7200) &
 ,ana=dbaana(lon=11.d0,lat=45.d0) &
 ,network=dbanetwork("generic") &
 ,datetime=dbadatetime(datetime_new(2014,01,06,18,00)))
 
 
filter=dbafilter(var="B12102")
call session%set(filter=filter)
call session%dissolve(metadata)
 
deallocate(metadata)
 
end subroutine delete2
 
 
 
subroutine delete3()
 
type(dbametadata),allocatable :: metadata(:)
type(dbafilter) :: filter
 
print *,"----------------------------------------------"
print *,"--------------- delete3 ----------------------"
 
 
allocate(metadata(1))
 
metadata(1)=dbametadata( &
  level=dbalevel(level1=105, l1=2000) &
 ,timerange=dbatimerange(timerange=4, p1=3600,p2=7200) &
 ,ana=dbaana(lon=13.d0,lat=45.d0) &
 ,network=dbanetwork("generic") &
 ,datetime=dbadatetime(datetime_new(2014,01,06,18,00)))
 
filter=dbafilter(var="B12102",starvarlist="*B33194,*B33193")
call session%set(filter=filter)
call session%dissolveattr(metadata)
 
deallocate(metadata)
 
end subroutine delete3
 
 
subroutine copy1f()
type(dbametaanddata), allocatable:: metaanddatav(:)
integer :: i
 
print *,"----------------------------------------------"
print *,"--------------- copy1f ----------------------"
 
! data
call sessionfrom%filerewind()
 
call sessionfrom%set(filter=dbafilter())
call sessionfrom%ingest(metaanddatav)
do while (size(metaanddatav) >0)
  print*,"read/write data; count: ",sessionfrom%count
  do i =1,size(metaanddatav)
    print *, "display metaanddatav index: ", i
!    call metaanddatav(i)%display()
    !call sessionto%extrude(metaanddata=metaanddatav(i))
    call metaanddatav(i)%extrude(sessionto)
  end do
!  call sessionto%close_message()
  call sessionfrom%ingest(metaanddatav)
end do
deallocate (metaanddatav)
 
! constant data
call sessionfrom%filerewind()
 
call sessionfrom%set(filter=dbafilter(contextana=.true.))
call sessionfrom%ingest(metaanddatav)
do while (size(metaanddatav) >0)
  print*,"read/write data; count: ",sessionfrom%count
  do i =1,size(metaanddatav)
    print *, "display metaanddatav index: ", i
!    call metaanddatav(i)%display()
    !call sessionto%extrude(metaanddata=metaanddatav(i))
    call metaanddatav(i)%extrude(sessionto)
  end do
!  call sessionto%close_message()
  call sessionfrom%ingest(metaanddatav)
end do
 
end subroutine copy1f
 
 
subroutine copy1fmem()
type(dbametaanddata),allocatable :: metaanddatav(:)
 
print *,"----------------------------------------------"
print *,"--------------- copy1fmem ----------------------"
 
 
do while (sessionfrom%messages_read_next())
!!$  print*,"read/write message"
!!$  call sessionfrom%set(filter=dbafilter())
!!$  call sessionfrom%ingest(metaanddatav)
!!$  do i =1,size(metaanddatav)
!!$    call metaanddatav(i)%display()
!!$    call sessionto%extrude(metaanddata=metaanddatav(i))
!!$  end do
!!$  call sessionto%prendilo()
 
  print *,"contextana"
  call sessionfrom%set(filter=dbafilter(contextana=.true.))
  call sessionfrom%ingest(metaanddatav)
!!$  do i =1,size(metaanddatav)
!!$    call metaanddatav(i)%display()
!!$    call sessionto%extrude(metaanddata=metaanddatav(i))
!!$  end do
!!$  call sessionto%close_message()
  call sessionfrom%remove_all()
end do
 
end subroutine copy1fmem
 
end program dballe_test