vol7d_dballe_class.F03

! Copyright (C) 2010  ARPA-SIM <urpsim@smr.arpa.emr.it>
! authors:
! Davide Cesari <dcesari@arpa.emr.it>
! Paolo Patruno <ppatruno@arpa.emr.it>

! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License as
! published by the Free Software Foundation; either version 2 of 
! the License, or (at your option) any later version.

! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.

! You should have received a copy of the GNU General Public License
! along with this program.  If not, see <http://www.gnu.org/licenses/>.

#include "config.h"


MODULE vol7d_dballe_class

USE dballe_class
USE char_utilities
USE vol7d_class
USE array_utilities
use log4fortran
USE geo_coord_class
!use list_mix
use list_character
use list_linkchar
use vol7d_serialize_dballe_class

IMPLICIT NONE

character (len=255),parameter:: subcategory="vol7d_dballe_class"


TYPE vol7d_dballe

  TYPE(vol7d) :: vol7d
  type(dbaconnection) :: idbhandle
  type(dbasession) :: handle
  integer ,pointer :: data_id(:,:,:,:,:)
  integer :: time_definition
  type(l4f_handle) :: category
  logical :: file

END TYPE vol7d_dballe

INTEGER, PARAMETER, PRIVATE :: nftype = 2
CHARACTER(len=16), PARAMETER, PRIVATE :: &
 pathlist(2,nftype) = reshape((/ &
 '/usr/share      ', '/usr/local/share', &
 '/etc            ', '/usr/local/etc  ' /), &
 (/2,nftype/))


type(vol7d_var),allocatable,private :: blocal(:) ! cache of dballe.txt

CHARACTER(len=20),PRIVATE :: dballe_name='wreport', dballe_name_env='DBA_TABLES'


INTERFACE init
  MODULE PROCEDURE vol7d_dballe_init
END INTERFACE init

INTERFACE delete
  MODULE PROCEDURE vol7d_dballe_delete
END INTERFACE delete


INTERFACE import
  MODULE PROCEDURE  vol7d_dballe_importvvnv,vol7d_dballe_import, vol7d_dballe_import_old, dba2v7d
END INTERFACE import

INTERFACE export
  MODULE PROCEDURE vol7d_dballe_export_old,vol7d_dballe_export, v7d2dba
END INTERFACE export


PRIVATE
PUBLIC vol7d_dballe, init, delete, import, export, vol7d_dballe_import_dballevar, vol7d_dballe_set_var_du

CONTAINS


SUBROUTINE vol7d_dballe_init(this,dsn,user,password,write,wipe,repinfo,&
 filename,format,file,categoryappend,time_definition,idbhandle,template)


TYPE(vol7d_dballe),INTENT(out) :: this
character(len=*), INTENT(in),OPTIONAL :: dsn
character(len=*), INTENT(in),OPTIONAL :: user
character(len=*), INTENT(in),OPTIONAL :: password
logical,INTENT(in),OPTIONAL :: write
logical,INTENT(in),OPTIONAL :: wipe
character(len=*), INTENT(in),OPTIONAL :: repinfo
character(len=*),intent(inout),optional :: filename
character(len=*),intent(in),optional :: format
logical,INTENT(in),OPTIONAL :: file
character(len=*),INTENT(in),OPTIONAL :: categoryappend
integer,INTENT(in),OPTIONAL :: time_definition
integer,INTENT(in),OPTIONAL :: idbhandle
character(len=*),intent(in),optional :: template

logical :: quiwrite,loadfile
character(len=512) :: a_name
character(len=254) :: arg,lfilename,lformat

quiwrite=.false.
if (present(write))then
  quiwrite=write
endif

if (present(categoryappend))then
  call l4f_launcher(a_name,a_name_append=trim(subcategory)//"."//trim(categoryappend))
else
  call l4f_launcher(a_name,a_name_append=trim(subcategory))
endif
this%category=l4f_category_get_handle(a_name)

#ifdef DEBUG
CALL l4f_category_log(this%category,l4f_debug,'vol7d_dballe_init start')
#endif

nullify(this%data_id)

if (optio_log(file)) then

  this%file=.true.

  lformat="BUFR"
  if (present(format))then
    lformat=format
  end if

  CALL getarg(0,arg)

  lfilename=trim(arg)//"."//trim(lformat)
  if (index(arg,'/',back=.true.) > 0) lfilename=lfilename(index(arg,'/',back=.true.)+1 : )

  if (present(filename))then
    if (c_e(filename))then
      lfilename=filename
    end if
  end if

  if(quiwrite)then
                                !   this for write in memdb and write file on export
    loadfile=.false.
  else
    loadfile=.true.
  end if

  this%handle=dbasession(wipe=wipe,write=quiwrite,repinfo=repinfo, &
   filename=lfilename,format=lformat,template=template, &
   memdb=.true.,loadfile=loadfile)

else

  this%file=.false.
  this%idbhandle=dbaconnection(dsn,user,password,idbhandle=idbhandle)
  this%handle=dbasession(this%idbhandle,wipe=wipe,write=quiwrite,repinfo=repinfo)

endif

! this init has been added here for cleaningness, this%vol7d gets
! reinitialised afterwards in dba2v7d and this%vol7d%time_definition is
! overwritten by this%time_definition, this duplication is required in
! order to pass time_definition down to dba2v7d
CALL init(this%vol7d, time_definition)
this%time_definition = optio_i(time_definition)

#ifdef DEBUG
CALL l4f_category_log(this%category,l4f_debug,'vol7d_dballe_init end')
#endif        

END SUBROUTINE vol7d_dballe_init




SUBROUTINE vol7d_dballe_importvvnv(this, var, network, coordmin,coordmax, timei, timef, level,timerange,set_network,&
 attr,anavar,anaattr, varkind,attrkind,anavarkind,anaattrkind,anaonly,dataonly,ana)
TYPE(vol7d_dballe),INTENT(inout) :: this
CHARACTER(len=*),INTENT(in) :: var(:)
TYPE(geo_coord),INTENT(inout),optional :: coordmin,coordmax 
TYPE(vol7d_ana),INTENT(inout),optional :: ana
TYPE(datetime),INTENT(in),optional :: timei, timef
TYPE(vol7d_network),INTENT(in) :: network(:)
TYPE(vol7d_network),INTENT(in),OPTIONAL :: set_network
TYPE(vol7d_level),INTENT(in),optional :: level
TYPE(vol7d_timerange),INTENT(in),optional :: timerange
CHARACTER(len=*),INTENT(in),OPTIONAL :: attr(:),anavar(:),anaattr(:)
CHARACTER(len=*),INTENT(in),OPTIONAL :: varkind(:),attrkind(:),anavarkind(:),anaattrkind(:)
logical,intent(in),optional :: anaonly
LOGICAL,INTENT(in),OPTIONAL :: dataonly
TYPE(vol7d_dballe) :: v7ddbatmp

INTEGER :: i

IF (SIZE(network) == 0 )THEN
  CALL import(this, var, coordmin=coordmin, coordmax=coordmax, timei=timei, &
   timef=timef, level=level, timerange=timerange, set_network=set_network, &
   attr=attr, anavar=anavar, anaattr=anaattr, varkind=varkind, attrkind=attrkind, &
   anavarkind=anavarkind, anaattrkind=anaattrkind, anaonly=anaonly, &
   dataonly=dataonly, ana=ana)
ELSE
  CALL init(this%vol7d)
  v7ddbatmp = this ! shallow copy
  DO i = 1, SIZE(network)
    CALL import(v7ddbatmp, var, network(i), coordmin, coordmax, timei, timef, &
     level,timerange, set_network, attr,anavar,anaattr, varkind, attrkind, &
     anavarkind, anaattrkind, anaonly, dataonly, ana)
    CALL vol7d_merge(this%vol7d, v7ddbatmp%vol7d, sort=.true.)
  ENDDO
ENDIF

END SUBROUTINE vol7d_dballe_importvvnv

SUBROUTINE vol7d_dballe_import_old(this, var, network, coordmin, coordmax, timei, timef,level,timerange, set_network,&
 attr,anavar,anaattr, varkind,attrkind,anavarkind,anaattrkind,anaonly,dataonly,ana)

TYPE(vol7d_dballe),INTENT(inout) :: this
CHARACTER(len=*),INTENT(in),OPTIONAL :: var(:)
TYPE(geo_coord),INTENT(inout),optional :: coordmin,coordmax 
TYPE(vol7d_ana),INTENT(inout),optional :: ana
TYPE(datetime),INTENT(in),OPTIONAL :: timei, timef
TYPE(vol7d_network),INTENT(in),OPTIONAL :: network,set_network
TYPE(vol7d_level),INTENT(in),optional :: level
TYPE(vol7d_timerange),INTENT(in),optional :: timerange
CHARACTER(len=*),INTENT(in),OPTIONAL :: attr(:),anavar(:),anaattr(:)
CHARACTER(len=*),INTENT(in),OPTIONAL :: varkind(:),attrkind(:),anavarkind(:),anaattrkind(:)
logical,intent(in),optional :: anaonly
logical,intent(in),optional :: dataonly


INTEGER,PARAMETER :: maxvarlist=100
                                !TYPE(vol7d) :: v7d
                                ! da non fare (con gfortran?)!!!!!
                                !CHARACTER(len=SIZE(var)*7) :: varlist
                                !CHARACTER(len=SIZE(attr)*8) :: starvarlist

LOGICAL ::  ldegnet

INTEGER :: i
integer :: nvar 
integer :: nanavar

                                !CHARACTER(len=10),allocatable :: lvar(:), lanavar(:)
type(dbadcv)       :: vars,starvars,anavars,anastarvars
type(dbafilter)    :: filter
type(dbacoord)     :: mydbacoordmin, mydbacoordmax
type(dbaana)       :: mydbaana
type(dbadatetime)  :: mydatetimemin, mydatetimemax
type(dbatimerange) :: mydbatimerange
type(dbalevel)     :: mydbalevel
type(dbanetwork)   :: mydbanetwork

integer :: nanaattr,nattr

character(len=40) :: query

#ifdef DEBUG
CALL l4f_category_log(this%category,l4f_debug,'inizio')
#endif        


IF (PRESENT(set_network)) THEN
  if (c_e(set_network)) then
    ldegnet = .true.
  else
    ldegnet = .false.
  end if
ELSE
  ldegnet = .false.
ENDIF

if(ldegnet) then
  query = "best"
else
  query=cmiss
end if


                                !     uncommenti this if you want compatibility API with old import

!!$  if (allocated(starvars%dcv)) then
!!$    ldataonly=.false.
!!$  else
!!$    ldataonly=.true.
!!$  end if


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                                ! ------------- prepare filter options

!!
!!           translate import option for dballe2003 api
!!

if (present(var)) then
  nvar=count(c_e(var))
  if (nvar > 0) then
    allocate (vars%dcv(nvar))
    do i=1,size(var)
      if (c_e(var(i)))then
        if (present(varkind))then
          select case (varkind(i))
          case("r")
            allocate (vars%dcv(i)%dat,source=dbadatar(var(i)))
          case("i")
            allocate (vars%dcv(i)%dat,source=dbadatai(var(i)))
          case("b")
            allocate (vars%dcv(i)%dat,source=dbadatab(var(i)))
          case("d")
            allocate (vars%dcv(i)%dat,source=dbadatad(var(i)))
          case("c")
            allocate (vars%dcv(i)%dat,source=dbadatac(var(i)))
          case default
            call l4f_category_log(this%category,l4f_error,"var and varkind mismach")
            CALL raise_fatal_error()
          end select
        else 
          allocate (vars%dcv(i)%dat,source=dbadatac(var(i))) !char is default
        end if
      end if
    end do
  end if
end if

if (present(anavar)) then
  nanavar=count(c_e(anavar))
  if (nanavar > 0) then
    allocate (anavars%dcv(nanavar))
    do i=1,size(anavar)
      if (c_e(anavar(i)))then
        if (present(anavarkind))then
          select case (anavarkind(i))
          case("r")
            allocate (anavars%dcv(i)%dat,source=dbadatar(anavar(i)))
          case("i")
            allocate (anavars%dcv(i)%dat,source=dbadatai(anavar(i)))
          case("b")
            allocate (anavars%dcv(i)%dat,source=dbadatab(anavar(i)))
          case("d")
            allocate (anavars%dcv(i)%dat,source=dbadatad(anavar(i)))
          case("c")
            allocate (anavars%dcv(i)%dat,source=dbadatac(anavar(i)))
          case default
            call l4f_category_log(this%category,l4f_error,"anavar and anavarkind mismach")
            CALL raise_fatal_error()
          end select
        else 
          allocate (anavars%dcv(i)%dat,source=dbadatac(anavar(i))) !char is default
        end if
      end if
    end do
  end if
end if

if (present(attr)) then
  nattr=size(attr)
  if (nattr == 0) then
    allocate (starvars%dcv(nattr))
  else
    nattr=count(c_e(attr))
    if (nattr > 0) then
      allocate (starvars%dcv(nattr))
      do i=1,size(attr)
        if (c_e(attr(i)))then
          if (present(attrkind))then
            select case (attrkind(i))
            case("r")
              allocate (starvars%dcv(i)%dat,source=dbadatar(attr(i)))
            case("i")
              allocate (starvars%dcv(i)%dat,source=dbadatai(attr(i)))
            case("b")
              allocate (starvars%dcv(i)%dat,source=dbadatab(attr(i)))
            case("d")
              allocate (starvars%dcv(i)%dat,source=dbadatad(attr(i)))
            case("c")
              allocate (starvars%dcv(i)%dat,source=dbadatac(attr(i)))
            case default
              call l4f_category_log(this%category,l4f_error,"attr and attrkind mismach")
              CALL raise_fatal_error()
            end select
          else 
            allocate (starvars%dcv(i)%dat,source=dbadatac(attr(i))) !char is default
          end if
        end if
      end do
    end if
  endif
end if

if (present(anaattr)) then
  nanaattr=size(anaattr)
  if (nanaattr == 0) then
    allocate (anastarvars%dcv(nanaattr))
  else
    nanaattr=count(c_e(anaattr))
    if (nanaattr > 0) then
      allocate (anastarvars%dcv(nanaattr))
      do i=1,size(anaattr)
        if (c_e(anaattr(i)))then
          if (present(anaattrkind))then
            select case (anaattrkind(i))
            case("r")
              allocate (anastarvars%dcv(i)%dat,source=dbadatar(anaattr(i)))
            case("i")
              allocate (anastarvars%dcv(i)%dat,source=dbadatai(anaattr(i)))
            case("b")
              allocate (anastarvars%dcv(i)%dat,source=dbadatab(anaattr(i)))
            case("d")
              allocate (anastarvars%dcv(i)%dat,source=dbadatad(anaattr(i)))
            case("c")
              allocate (anastarvars%dcv(i)%dat,source=dbadatac(anaattr(i)))
            case default
              call l4f_category_log(this%category,l4f_error,"attr and attrkind mismach")
              CALL raise_fatal_error()
            end select
          else 
            allocate (anastarvars%dcv(i)%dat,source=dbadatac(anaattr(i))) !char is default
          end if
        end if
      end do
    end if
  end if
end if


                                ! like a cast
mydbacoordmin=dbacoord()
if (present(coordmin)) mydbacoordmin%geo_coord=coordmin
mydbacoordmax=dbacoord()
if (present(coordmax)) mydbacoordmax%geo_coord=coordmax
mydbaana=dbaana()
if (present(ana)) mydbaana%vol7d_ana=ana
mydatetimemin=dbadatetime()
if (present(timei)) mydatetimemin%datetime=timei
mydatetimemax=dbadatetime()
if (present(timef)) mydatetimemax%datetime=timef
mydbatimerange=dbatimerange()
if (present(timerange)) mydbatimerange%vol7d_timerange=timerange
mydbalevel=dbalevel()
if (present(level)) mydbalevel%vol7d_level=level
mydbanetwork=dbanetwork()
if (present(network)) mydbanetwork%vol7d_network=network

!!
!!         here we have options ready for filter
!!
filter=dbafilter(coordmin=mydbacoordmin,coordmax=mydbacoordmax,ana=mydbaana, &
 datetimemin=mydatetimemin,datetimemax=mydatetimemax, &
 timerange=mydbatimerange,level=mydbalevel,network=mydbanetwork,query=query,&
 vars=vars,starvars=starvars,anavars=anavars,anastarvars=anastarvars,&
 dataonly=dataonly,anaonly=anaonly)
!!$  print *, "filter:"
!!$  call filter%display()

call import(this,filter,set_network)


END SUBROUTINE vol7d_dballe_import_old



subroutine vol7d_dballe_import(this,filter,set_network)

TYPE(vol7d_dballe),INTENT(inout) :: this
type(dbafilter),INTENT(in)     :: filter
TYPE(vol7d_network),INTENT(in),OPTIONAL :: set_network

TYPE(vol7d) :: vol7dtmp
type(dbametaanddata),allocatable :: metaanddatav(:)
type(dbafilter)    :: myfilter

CALL l4f_category_log(this%category,l4f_debug,'start import vol7d_dballe')

if ( .not. filter%dataonly) then
                                ! ---------------->   constant station data
  myfilter=dbafilter(filter=filter,contextana=.true.,query=cmiss)
!                                ! set filter
!  call this%handle%set(filter=myfilter)
                                ! estrude the data
  CALL l4f_category_log(this%category,l4f_debug,'start import vol7d_dballe ingest for constant station data')
!  call this%handle%ingest(filter=myfilter)
  call this%handle%ingest(metaanddatav,filter=myfilter)
  CALL l4f_category_log(this%category,l4f_debug,'end import vol7d_dballe ingest')
  CALL l4f_category_log(this%category,l4f_debug,'start import vol7d_dballe dba2v7d')
  call dba2v7d(this%vol7d, metaanddatav,this%time_definition,set_network)
  CALL l4f_category_log(this%category,l4f_debug,'end import vol7d_dballe dba2v7d')

  deallocate (metaanddatav)

else
                                ! empty volume
  call init(this%vol7d)
  call vol7d_alloc(this%vol7d)
  call vol7d_alloc_vol(this%vol7d)
end if
                                ! ---------------->   constant station data end

if ( .not. filter%anaonly) then
                                ! ---------------->   working on data
  myfilter=dbafilter(filter=filter,contextana=.false.)
!                                ! set filter
!  call this%handle%set(filter=myfilter)
                                ! estrude the data

  CALL l4f_category_log(this%category,l4f_debug,'start import vol7d_dballe ingest for station data')
!  call this%handle%ingest(filter=myfilter)
  call this%handle%ingest(metaanddatav,filter=myfilter)
  CALL l4f_category_log(this%category,l4f_debug,'end import vol7d_dballe ingest')
  CALL l4f_category_log(this%category,l4f_debug,'start import vol7d_dballe dba2v7d')
  call dba2v7d(vol7dtmp,metaanddatav,this%time_definition,set_network)
  CALL l4f_category_log(this%category,l4f_debug,'end import vol7d_dballe dba2v7d')

  deallocate (metaanddatav)

  CALL vol7d_merge(this%vol7d, vol7dtmp, sort=.true.) ! Smart merge
!!$else
!!$                                ! should we sort separately in case no merge is done?
!!$  CALL vol7d_smart_sort(this%vol7d, lsort_time=.TRUE., lsort_timerange=.TRUE., lsort_level=.TRUE.)
end if

call vol7d_dballe_set_var_du(this%vol7d)


#ifdef NONE

!!$if (lattr) then
!!$
!!$  allocate  (this%data_id( nana, ntime, nlevel, ntimerange, nnetwork),stat=istat)
!!$  if (istat/= 0) THEN
!!$    CALL l4f_category_log(this%category,L4F_ERROR,'cannot allocate ' &
!!$     //TRIM(to_char(nana*ntime*nlevel*ntimerange*nnetwork))//' data_id elements')
!!$    CALL raise_fatal_error()
!!$    
!!$  ENDIF
!!$
!!$  this%data_id=DBA_MVI
!!$
!!$else

nullify(this%data_id)

!!$end if


                                !memorizzo data_id
#ifdef DEBUG
                                !CALL l4f_category_log(this%category,L4F_DEBUG,"data_id: "//trim(to_char(buffer(i)%data_id)))
#endif

this%data_id(indana,indtime,indlevel,indtimerange,indnetwork)=buffer(i)%data_id


ier=idba_set(this%handle,"*context_id",buffer(i)%data_id)
ier=idba_set(this%handle,"*var_related",buffer(i)%btable)
                                !per ogni dato ora lavoro sugli attributi
ier=idba_set(this%handle, "*varlist",starvarlist )
ier=idba_voglioancora(this%handle,nn)
                                !print*,buffer(i)%btable," numero attributi",nn

#endif

CALL l4f_category_log(this%category,l4f_debug,'end import vol7d_dballe')

end subroutine vol7d_dballe_import




SUBROUTINE vol7d_dballe_delete(this, preserveidbhandle)
TYPE(vol7d_dballe) :: this
logical,intent(in), optional :: preserveidbhandle

# ifndef F2003_FULL_FEATURES
call this%handle%delete()

if (.not. optio_log(preserveidbhandle)) call this%idbhandle%delete()
# endif

!!$if (associated(this%data_id)) then
!!$  deallocate (this%data_id)
!!$  nullify(this%data_id)
!!$end if

CALL delete(this%vol7d)

                                !chiudo il logger
call l4f_category_delete(this%category)
                                !ier=l4f_fini()

END SUBROUTINE vol7d_dballe_delete



!subroutine dba2v7d(this,metaanddatav,vars,starvars,anavars,anastarvars,time_definition, set_network)
subroutine dba2v7d(this,metaanddatav,time_definition, set_network)

type(dbametaanddata),intent(inout)      :: metaanddatav(:)  ! change value in datetime reguard timedefinition
TYPE(vol7d),INTENT(inout)               :: this
integer,INTENT(in),OPTIONAL             :: time_definition
TYPE(vol7d_network),INTENT(in),OPTIONAL :: set_network
type(dbadcv)                :: vars
type(dbadcv)                :: starvars
type(dbadcv)                :: anavars
type(dbadcv)                :: anastarvars


LOGICAL :: ldegnet
integer :: indana,indtime,indlevel,indtimerange,inddativar,indnetwork,indattrvar

integer :: nana,ntime,ntimerange,nlevel,nnetwork

INTEGER :: i, j, k, n
integer :: inddativarattr
integer :: nanavar, indanavar,indanavarattr,nanavarattr

integer :: ndativarr,     ndativari,     ndativarb,     ndativard,     ndativarc
integer :: ndatiattrr,    ndatiattri,    ndatiattrb,    ndatiattrd,    ndatiattrc 
integer :: ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc

integer :: nanavarr,     nanavari,     nanavarb,     nanavard,     nanavarc
integer :: nanaattrr,    nanaattri,    nanaattrb,    nanaattrd,    nanaattrc 
integer :: nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc

integer :: ndativar,ndativarattr

type(characterlist) :: dativarl,dativarattrl,anavarl,anavarattrl

character(len=listcharmaxlen),allocatable :: dativara(:),dativarattra(:),anavara(:),anavarattra(:)
logical :: status
integer :: ltime_definition

type(datetime),allocatable :: tmptime(:)
type(vol7d_network),allocatable :: tmpnetwork(:)
type(vol7d_level),allocatable :: tmplevel(:)
type(vol7d_timerange),allocatable :: tmptimerange(:)
type(vol7d_ana),allocatable :: tmpana(:)


ltime_definition=optio_i(time_definition)
if (.not. c_e(ltime_definition)) ltime_definition = 1

                                ! take in account time_definition
if (ltime_definition == 0) then
  do i =1,size(metaanddatav)
    metaanddatav(i)%metadata%datetime%datetime = &
     metaanddatav(i)%metadata%datetime%datetime - &
     timedelta_new(sec=metaanddatav(i)%metadata%timerange%vol7d_timerange%p1)
  end do
end if

if (ltime_definition == 2) then
  do i =1,size(metaanddatav)
    metaanddatav(i)%metadata%timerange%vol7d_timerange%p1 = 0
  end do
end if


IF (PRESENT(set_network)) THEN
  if (c_e(set_network)) then
    ldegnet = .true.
  else
    ldegnet = .false.
  end if
ELSE
  ldegnet = .false.
ENDIF



!!--------------------------------------------------------------------------
!! find vars, starvars, anavars, anastarvars
!!

! create lists of all
                                ! data
do i =1, size(metaanddatav)
  do j=1, size(metaanddatav(i)%dataattrv%dataattr)
    if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
                                !print *,"dativarl: ", metaanddatav(i)%dataattrv%dataattr(j)%dat%btable
      call dativarl%append(metaanddatav(i)%dataattrv%dataattr(j)%dat%btable)
    else
                                !print *,"anavarl: ", metaanddatav(i)%dataattrv%dataattr(j)%dat%btable
      call anavarl%append(metaanddatav(i)%dataattrv%dataattr(j)%dat%btable)
    end if
  end do
end do

!count and put in vector of unuique key
ndativar     = count_distinct(toarray_charl(dativarl)    , back=.true.)
allocate(dativara(ndativar))
call pack_distinct_c (toarray_charl(dativarl)    , dativara    , back=.true.)
status = dativarl%delete()
allocate (vars%dcv(ndativar))

nanavar      = count_distinct(toarray_charl(anavarl)     , back=.true.)
allocate(anavara(nanavar))
call pack_distinct_c (toarray_charl(anavarl)     , anavara     , back=.true.)
status = anavarl%delete()
allocate (anavars%dcv(nanavar))


an: do n=1,ndativar
  do i =1, size(metaanddatav)
    do j=1, size(metaanddatav(i)%dataattrv%dataattr)
      if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
        if (metaanddatav(i)%dataattrv%dataattr(j)%dat%btable == dativara(n)) then
          allocate(vars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%dat)
          cycle an
        end if
      end if
    end do
  end do 
end do an

bn: do n=1,nanavar
  do i =1, size(metaanddatav)
    do j=1, size(metaanddatav(i)%dataattrv%dataattr)
      if (.not. c_e(metaanddatav(i)%metadata%datetime%datetime)) then
        if (metaanddatav(i)%dataattrv%dataattr(j)%dat%btable == anavara(n)) then
          allocate(anavars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%dat)
          cycle bn
        end if
      end if
    end do
  end do
end do bn

                                ! attributes
do i =1, size(metaanddatav)
  do j=1, size(metaanddatav(i)%dataattrv%dataattr)
    do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
      if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
                                !print *,"dativarattrl: ", metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable
        call dativarattrl%append(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable)
      else
                                !print *,"anavarattrl: ", metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable
        call anavarattrl%append(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable)
      end if
    end do
  end do
end do


ndativarattr = count_distinct(toarray_charl(dativarattrl), back=.true.)
allocate(dativarattra(ndativarattr))
call pack_distinct_c (toarray_charl(dativarattrl), dativarattra, back=.true.)
status = dativarattrl%delete()
allocate(starvars%dcv(ndativarattr))

nanavarattr  = count_distinct(toarray_charl(anavarattrl) , back=.true.)
allocate(anavarattra(nanavarattr))
call pack_distinct_c (toarray_charl(anavarattrl) , anavarattra , back=.true.)
status = anavarattrl%delete()
allocate(anastarvars%dcv(nanavarattr))


cn: do n=1,ndativarattr
  do i =1, size(metaanddatav)
    do j=1, size(metaanddatav(i)%dataattrv%dataattr)
      do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
        if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
          if (metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable == dativarattra(n))then 
            allocate(starvars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
            cycle cn
          end if
        end if
      end do
    end do
  end do
end do cn


dn: do n=1,nanavarattr
  do i =1, size(metaanddatav)
    do j=1, size(metaanddatav(i)%dataattrv%dataattr)
      do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
        if (.not. c_e(metaanddatav(i)%metadata%datetime%datetime)) then
          if (metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable == anavarattra(n))then 
            allocate(anastarvars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
            cycle dn
          end if
        end if
      end do
    end do
  end do
end do dn


!!--------------------------------------------------------------------------


!!
!!             count all unique metadata
!!

if(ldegnet) then
  nnetwork=1
else
  !nnetwork = count_distinct(metaanddatav(:)%metadata%network%vol7d_network, back=.TRUE.)
  allocate (tmpnetwork(size(metaanddatav(:))),&
   source=metaanddatav(:)%metadata%network%vol7d_network)
  call sort(tmpnetwork)
  nnetwork = count_distinct_sorted(tmpnetwork)
end if

!ntime      = count_distinct(metaanddatav(:)%metadata%datetime%datetime, &
! mask=c_e(metaanddatav(:)%metadata%datetime%datetime),back=.TRUE.)
allocate (tmptime(size(metaanddatav(:))),&
 source=metaanddatav(:)%metadata%datetime%datetime)
call sort(tmptime)
ntime = count_distinct_sorted(tmptime,mask=c_e(tmptime))

!ntimerange = count_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange, &
! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
allocate (tmptimerange(size(metaanddatav(:))),&
 source=metaanddatav(:)%metadata%timerange%vol7d_timerange)
call sort(tmptimerange)
ntimerange = count_distinct_sorted(tmptimerange,mask=c_e(tmptimerange))

!nlevel     = count_distinct(metaanddatav(:)%metadata%level%vol7d_level, &
! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level),back=.TRUE.)
allocate (tmplevel(size(metaanddatav(:))),&
 source=metaanddatav(:)%metadata%level%vol7d_level)
call sort(tmplevel)
nlevel = count_distinct_sorted(tmplevel,mask=c_e(tmplevel))

!nana   = count_distinct(metaanddatav(:)%metadata%ana%vol7d_ana, back=.TRUE.)
allocate (tmpana(size(metaanddatav(:))),&
 source=metaanddatav(:)%metadata%ana%vol7d_ana)
call sort(tmpana)
nana = count_distinct_sorted(tmpana)

!!$if(ldegnet) then
!!$  nnetwork=1
!!$else
!!$  nnetwork = size(metaanddatav(:)%metadata%network%vol7d_network)
!!$end if
!!$ntime      = size(metaanddatav(:)%metadata%datetime%datetime)
!!$ntimerange = size(metaanddatav(:)%metadata%timerange%vol7d_timerange)
!!$nlevel     = size(metaanddatav(:)%metadata%level%vol7d_level)
!!$nana       = size(metaanddatav(:)%metadata%ana%vol7d_ana)

                                ! var

ndativarr = 0
ndativari = 0
ndativarb = 0
ndativard = 0
ndativarc = 0

do i =1 ,size(vars%dcv)
  associate(dato => vars%dcv(i)%dat)
    select type (dato)
    type is (dbadatar)
      ndativarr = ndativarr + 1
    type is (dbadatai)
      ndativari = ndativari + 1
    type is (dbadatab)
      ndativarb = ndativarb + 1
    type is (dbadatad)
      ndativard = ndativard + 1
    type is (dbadatac)
      ndativarc = ndativarc + 1
    end select
  end associate
end do


                                !attr

ndatiattrr = 0
ndatiattri = 0
ndatiattrb = 0
ndatiattrd = 0
ndatiattrc = 0

do i =1 ,size(starvars%dcv)
  associate(dato => starvars%dcv(i)%dat)
    select type (dato)
    type is (dbadatar)
      ndatiattrr = ndatiattrr + 1
    type is (dbadatai)
      ndatiattri = ndatiattri + 1
    type is (dbadatab)
      ndatiattrb = ndatiattrb + 1
    type is (dbadatad)
      ndatiattrd = ndatiattrd + 1
    type is (dbadatac)
      ndatiattrc = ndatiattrc + 1
    end select
  end associate
end do


                                ! ana var

nanavarr = 0
nanavari = 0
nanavarb = 0
nanavard = 0
nanavarc = 0

do i =1 ,size(anavars%dcv)
  associate(dato => anavars%dcv(i)%dat)
    select type (dato)
    type is (dbadatar)
      nanavarr = nanavarr + 1
    type is (dbadatai)
      nanavari = nanavari + 1
    type is (dbadatab)
      nanavarb = nanavarb + 1
    type is (dbadatad)
      nanavard = nanavard + 1
    type is (dbadatac)
      nanavarc = nanavarc + 1
    end select
  end associate
end do


                                ! ana attr

nanaattrr = 0
nanaattri = 0
nanaattrb = 0
nanaattrd = 0
nanaattrc = 0

do i =1 ,size(anastarvars%dcv)
  associate(dato => anastarvars%dcv(i)%dat)
    select type (dato)
    type is (dbadatar)
      nanaattrr = nanaattrr + 1
    type is (dbadatai)
      nanaattri = nanaattri + 1
    type is (dbadatab)
      nanaattrb = nanaattrb + 1
    type is (dbadatad)
      nanaattrd = nanaattrd + 1
    type is (dbadatac)
      nanaattrc = nanaattrc + 1
    end select
  end associate
end do


                                !refine

ndativarattrr=0
ndativarattri=0
ndativarattrb=0
ndativarattrd=0
ndativarattrc=0

if (ndatiattrr > 0 ) ndativarattrr=ndativarr+ndativari+ndativarb+ndativard+ndativarc
if (ndatiattri > 0 ) ndativarattri=ndativarr+ndativari+ndativarb+ndativard+ndativarc
if (ndatiattrb > 0 ) ndativarattrb=ndativarr+ndativari+ndativarb+ndativard+ndativarc
if (ndatiattrd > 0 ) ndativarattrd=ndativarr+ndativari+ndativarb+ndativard+ndativarc
if (ndatiattrc > 0 ) ndativarattrc=ndativarr+ndativari+ndativarb+ndativard+ndativarc


nanavarattrr=0
nanavarattri=0
nanavarattrb=0
nanavarattrd=0
nanavarattrc=0

if (nanaattrr > 0 ) nanavarattrr=nanavarr+nanavari+nanavarb+nanavard+nanavarc
if (nanaattri > 0 ) nanavarattri=nanavarr+nanavari+nanavarb+nanavard+nanavarc
if (nanaattrb > 0 ) nanavarattrb=nanavarr+nanavari+nanavarb+nanavard+nanavarc
if (nanaattrd > 0 ) nanavarattrd=nanavarr+nanavari+nanavarb+nanavard+nanavarc
if (nanaattrc > 0 ) nanavarattrc=nanavarr+nanavari+nanavarb+nanavard+nanavarc


CALL init(this,time_definition=ltime_definition)

!!$print *, "nana=",nana, "ntime=",ntime, "ntimerange=",ntimerange, &
!!$ "nlevel=",nlevel, "nnetwork=",nnetwork, &
!!$ "ndativarr=",ndativarr, "ndativari=",ndativari, &
!!$ "ndativarb=",ndativarb, "ndativard=",ndativard, "ndativarc=",ndativarc,&
!!$ "ndatiattrr=",ndatiattrr, "ndatiattri=",ndatiattri, "ndatiattrb=",ndatiattrb,&
!!$ "ndatiattrd=",ndatiattrd, "ndatiattrc=",ndatiattrc,&
!!$ "ndativarattrr=",ndativarattrr, "ndativarattri=",ndativarattri, "ndativarattrb=",ndativarattrb,&
!!$ "ndativarattrd=",ndativarattrd, "ndativarattrc=",ndativarattrc
!!$
!!$print *,"nanaattrr,nanaattri,nanaattrb,nanaattrd,nanaattrc"
!!$print *,nanaattrr,nanaattri,nanaattrb,nanaattrd,nanaattrc


call vol7d_alloc (this, &
nana=nana, ntime=ntime, ntimerange=ntimerange, &
nlevel=nlevel, nnetwork=nnetwork, &
ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb, ndativard=ndativard, ndativarc=ndativarc,&
ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb, ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
ndativarattrr=ndativarattrr, &
ndativarattri=ndativarattri, &
ndativarattrb=ndativarattrb, &
ndativarattrd=ndativarattrd, &
ndativarattrc=ndativarattrc,&
nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, nanavard=nanavard, nanavarc=nanavarc,&
nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb, nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
nanavarattrr=nanavarattrr, &
nanavarattri=nanavarattri, &
nanavarattrb=nanavarattrb, &
nanavarattrd=nanavarattrd, &
nanavarattrc=nanavarattrc)


! fill metadata removing contextana metadata

!nana=count_and_pack_distinct(metaanddatav(:)%metadata%ana%vol7d_ana,this%ana, back=.TRUE.)
!this%ana=pack_distinct(metaanddatav(:)%metadata%ana%vol7d_ana, nana, back=.TRUE.)
this%ana=pack_distinct_sorted(tmpana, nana)
deallocate(tmpana)
!call sort(this%ana)

!ntime=count_and_pack_distinct(metaanddatav(:)%metadata%datetime%datetime,this%time, &
! mask=c_e(metaanddatav(:)%metadata%datetime%datetime), back=.TRUE.)
!this%time=pack_distinct(metaanddatav(:)%metadata%datetime%datetime, ntime, &
! mask=c_e(metaanddatav(:)%metadata%datetime%datetime),back=.TRUE.)
this%time=pack_distinct_sorted(tmptime, ntime,mask=c_e(tmptime))
deallocate(tmptime)
!call sort(this%time)

!ntimerange=count_and_pack_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange,this%timerange, &
! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
!this%timerange=pack_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange, ntimerange, &
! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
this%timerange=pack_distinct_sorted(tmptimerange, ntimerange,mask=c_e(tmptimerange))
deallocate(tmptimerange)
!call sort(this%timerange)

!nlevel=count_and_pack_distinct(metaanddatav(:)%metadata%level%vol7d_level,this%level, &
! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level), back=.TRUE.)
!this%level=pack_distinct(metaanddatav(:)%metadata%level%vol7d_level, nlevel, &
! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level), back=.TRUE.)
this%level=pack_distinct_sorted(tmplevel, nlevel,mask=c_e(tmplevel))
deallocate(tmplevel)
!call sort(this%level)

if(ldegnet)then
  nnetwork=1
  ALLOCATE(this%network(1))
  this%network(1)=set_network
else
  !nnetwork=count_and_pack_distinct(metaanddatav(:)%metadata%network%vol7d_network,this%network, back=.TRUE.)
  !this%network=pack_distinct(metaanddatav(:)%metadata%network%vol7d_network, nnetwork, back=.TRUE.)
  this%network=pack_distinct_sorted(tmpnetwork, nnetwork)
  deallocate(tmpnetwork)
end if
!call sort(this%network)

                                ! var

ndativarr = 0
ndativari = 0
ndativarb = 0
ndativard = 0
ndativarc = 0

do i =1 ,size(vars%dcv)
  associate(dato => vars%dcv(i)%dat)
    select type (dato)
    type is (dbadatar)
      ndativarr = ndativarr + 1
      call init (this%dativar%r(ndativarr), btable=dato%btable)
    type is (dbadatai)
      ndativari = ndativari + 1
      call init (this%dativar%i(ndativari), btable=dato%btable)
    type is (dbadatab)
      ndativarb = ndativarb + 1
      call init (this%dativar%b(ndativarb), btable=dato%btable)
    type is (dbadatad)
      ndativard = ndativard + 1
      call init (this%dativar%d(ndativard), btable=dato%btable)
    type is (dbadatac)
      ndativarc = ndativarc + 1
      call init (this%dativar%c(ndativarc), btable=dato%btable)
    end select
  end associate
end do


                                !attr

ndatiattrr = 0
ndatiattri = 0
ndatiattrb = 0
ndatiattrd = 0
ndatiattrc = 0

do i =1 ,size(starvars%dcv)
  associate(dato => starvars%dcv(i)%dat)
    select type (dato)
    type is (dbadatar)
      ndatiattrr = ndatiattrr + 1
      call init (this%datiattr%r(ndatiattrr), btable=dato%btable)
    type is (dbadatai)
      ndatiattri = ndatiattri + 1
      call init (this%datiattr%i(ndatiattri), btable=dato%btable)
    type is (dbadatab)
      ndatiattrb = ndatiattrb + 1
      call init (this%datiattr%b(ndatiattrb), btable=dato%btable)
    type is (dbadatad)
      ndatiattrd = ndatiattrd + 1
      call init (this%datiattr%d(ndatiattrd), btable=dato%btable)
    type is (dbadatac)
      ndatiattrc = ndatiattrc + 1
      call init (this%datiattr%c(ndatiattrc), btable=dato%btable)
    end select
  end associate
end do


                                ! ana var

nanavarr = 0
nanavari = 0
nanavarb = 0
nanavard = 0
nanavarc = 0

do i =1 ,size(anavars%dcv)
  associate(dato => anavars%dcv(i)%dat)
    select type (dato)
    type is (dbadatar)
      nanavarr = nanavarr + 1
      call init (this%anavar%r(nanavarr), btable=dato%btable)
    type is (dbadatai)
      nanavari = nanavari + 1
      call init (this%anavar%i(nanavari), btable=dato%btable)
    type is (dbadatab)
      nanavarb = nanavarb + 1
      call init (this%anavar%b(nanavarb), btable=dato%btable)
    type is (dbadatad)
      nanavard = nanavard + 1
      call init (this%anavar%d(nanavard), btable=dato%btable)
    type is (dbadatac)
      nanavarc = nanavarc + 1
      call init (this%anavar%c(nanavarc), btable=dato%btable)
    end select
  end associate
end do


                                ! ana attr

nanaattrr = 0
nanaattri = 0
nanaattrb = 0
nanaattrd = 0
nanaattrc = 0

do i =1 ,size(anastarvars%dcv)
  associate(dato => anastarvars%dcv(i)%dat)
    select type (dato)
    type is (dbadatar)
      nanaattrr = nanaattrr + 1
      call init (this%anaattr%r(nanaattrr), btable=dato%btable)
    type is (dbadatai)
      nanaattri = nanaattri + 1
      call init (this%anaattr%i(nanaattri), btable=dato%btable)
    type is (dbadatab)
      nanaattrb = nanaattrb + 1
      call init (this%anaattr%b(nanaattrb), btable=dato%btable)
    type is (dbadatad)
      nanaattrd = nanaattrd + 1
      call init (this%anaattr%d(nanaattrd), btable=dato%btable)
    type is (dbadatac)
      nanaattrc = nanaattrc + 1
      call init (this%anaattr%c(nanaattrc), btable=dato%btable)
    end select
  end associate
end do


                                ! here we colcolate the link from attributes and vars
do i =1, size(vars%dcv)
  associate(dato => vars%dcv(i)%dat)
    if ( ndativarattri > 0 ) call init(this%dativarattr%i(i),btable=dato%btable)
    if ( ndativarattrr > 0 ) call init(this%dativarattr%r(i),btable=dato%btable)
    if ( ndativarattrd > 0 ) call init(this%dativarattr%d(i),btable=dato%btable)
    if ( ndativarattrb > 0 ) call init(this%dativarattr%b(i),btable=dato%btable)
    if ( ndativarattrc > 0 ) call init(this%dativarattr%c(i),btable=dato%btable)
  end associate
end do

do i =1, size(anavars%dcv)
  associate(dato => anavars%dcv(i)%dat)
    if ( nanavarattri > 0 ) call init(this%anavarattr%i(i),btable=dato%btable)
    if ( nanavarattrr > 0 ) call init(this%anavarattr%r(i),btable=dato%btable)
    if ( nanavarattrd > 0 ) call init(this%anavarattr%d(i),btable=dato%btable)
    if ( nanavarattrb > 0 ) call init(this%anavarattr%b(i),btable=dato%btable)
    if ( nanavarattrc > 0 ) call init(this%anavarattr%c(i),btable=dato%btable)
  end associate
end do

                                ! set index in dativaratt*
call vol7d_set_attr_ind(this)

call vol7d_alloc_vol (this)

                                ! Ora qui bisogna metterci dentro idati
indana = 0
indtime = 0
indnetwork = 0
indtime = 0
indtimerange = 0
indlevel = 0
do i =1, size(metaanddatav)

  indana       = index_sorted(this%ana, metaanddatav(i)%metadata%ana%vol7d_ana)

  if (ldegnet)then
    indnetwork=1
  else
    indnetwork = index_sorted(this%network, metaanddatav(i)%metadata%network%vol7d_network)
  endif
    
  if (c_e(metaanddatav(i)%metadata%datetime%datetime) .and. &
      c_e(metaanddatav(i)%metadata%timerange%vol7d_timerange) .and. &
      c_e(metaanddatav(i)%metadata%level%vol7d_level) ) then      ! dati

    indtime      = index_sorted(this%time, metaanddatav(i)%metadata%datetime%datetime)
    indtimerange = index_sorted(this%timerange, metaanddatav(i)%metadata%timerange%vol7d_timerange)
    indlevel     = index_sorted(this%level, metaanddatav(i)%metadata%level%vol7d_level)

    do j=1, size(metaanddatav(i)%dataattrv%dataattr)
      
      associate(dato => metaanddatav(i)%dataattrv%dataattr(j)%dat)
        select type (dato)
        type is (dbadatai)
          inddativar = firsttrue(dato%btable == this%dativar%i%btable)
          this%voldatii( &
           indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
           ) = dato%value
          
        type is (dbadatar)
          inddativar = firsttrue(dato%btable == this%dativar%r%btable)
          this%voldatir( &
           indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
           ) = dato%value
          
        type is (dbadatad)
          inddativar = firsttrue(dato%btable == this%dativar%d%btable)
          this%voldatid( &
           indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
           ) = dato%value
          
        type is (dbadatab)
          inddativar = firsttrue(dato%btable == this%dativar%b%btable)
          this%voldatib( &
           indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
           ) = dato%value
          
        type is (dbadatac)
          inddativar = firsttrue(dato%btable == this%dativar%c%btable)
          this%voldatic( &
           indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
           ) = dato%value
          
        end select
        
        
                                ! dati attributes
        do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
          associate(attr => metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
            select type (attr)
              
            type is (dbadatai)
              inddativarattr  = firsttrue(dato%btable == this%dativarattr%i%btable)
              indattrvar = firsttrue(attr%btable == this%datiattr%i%btable)
              this%voldatiattri( &
               indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
               ) = attr%value
            type is (dbadatar)
              inddativarattr  = firsttrue(dato%btable == this%dativarattr%r%btable)
              indattrvar = firsttrue(attr%btable == this%datiattr%r%btable)
              this%voldatiattrr( &
               indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
               ) = attr%value
            type is (dbadatad)
              inddativarattr  = firsttrue(dato%btable == this%dativarattr%d%btable)
              indattrvar = firsttrue(attr%btable == this%datiattr%d%btable)
              this%voldatiattrd( &
               indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
               ) = attr%value
            type is (dbadatab)
              inddativarattr  = firsttrue(dato%btable == this%dativarattr%b%btable)
              indattrvar = firsttrue(attr%btable == this%datiattr%b%btable)
              this%voldatiattrb( &
               indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
               ) = attr%value
            type is (dbadatac)
              inddativarattr  = firsttrue(dato%btable == this%dativarattr%c%btable)
              indattrvar = firsttrue(attr%btable == this%datiattr%c%btable)
              this%voldatiattrc( &
               indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
               ) = attr%value
              
            end select
          end associate
        end do
      end associate
    end do

  else
                                ! ana
    do j=1, size(metaanddatav(i)%dataattrv%dataattr)
      
      associate(dato => metaanddatav(i)%dataattrv%dataattr(j)%dat)
        select type (dato)
        type is (dbadatai)
          indanavar = firsttrue(dato%btable == this%anavar%i%btable)
          this%volanai( &
           indana,indanavar,indnetwork &
           ) = dato%value
          
        type is (dbadatar)
          indanavar = firsttrue(dato%btable == this%anavar%r%btable)
          this%volanar( &
           indana,indanavar,indnetwork &
           ) = dato%value
          
        type is (dbadatad)
          indanavar = firsttrue(dato%btable == this%anavar%d%btable)
          this%volanad( &
           indana,indanavar,indnetwork &
           ) = dato%value
          
        type is (dbadatab)
          indanavar = firsttrue(dato%btable == this%anavar%b%btable)
          this%volanab( &
           indana,indanavar,indnetwork &
           ) = dato%value
          
        type is (dbadatac)
          indanavar = firsttrue(dato%btable == this%anavar%c%btable)
          this%volanac( &
           indana,indanavar,indnetwork &
           ) = dato%value
          
        end select
        
        
                                ! ana attributes
        do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
          associate(attr => metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
            select type (attr)
              
            type is (dbadatai)
              indanavarattr  = firsttrue(dato%btable == this%anavarattr%i%btable)
              indattrvar = firsttrue(attr%btable == this%anaattr%i%btable)
              this%volanaattri( &
               indana,indanavarattr,indnetwork,indattrvar &
               ) = attr%value
            type is (dbadatar)
              indanavarattr  = firsttrue(dato%btable == this%anavarattr%r%btable)
              indattrvar = firsttrue(attr%btable == this%anaattr%r%btable)
              this%volanaattrr( &
               indana,indanavarattr,indnetwork,indattrvar &
               ) = attr%value
            type is (dbadatad)
              indanavarattr  = firsttrue(dato%btable == this%anavarattr%d%btable)
              indattrvar = firsttrue(attr%btable == this%anaattr%d%btable)
              this%volanaattrd( &
               indana,indanavarattr,indnetwork,indattrvar &
               ) = attr%value
            type is (dbadatab)
              indanavarattr  = firsttrue(dato%btable == this%anavarattr%b%btable)
              indattrvar = firsttrue(attr%btable == this%anaattr%b%btable)
              this%volanaattrb( &
               indana,indanavarattr,indnetwork,indattrvar &
               ) = attr%value
            type is (dbadatac)
              indanavarattr  = firsttrue(dato%btable == this%anavarattr%c%btable)
              indattrvar = firsttrue(attr%btable == this%anaattr%c%btable)
              this%volanaattrc( &
               indana,indanavarattr,indnetwork,indattrvar &
               ) = attr%value
              
            end select
          end associate
        end do
      end associate
    end do
  end if
end do

contains

!!$!> /brief Return an dbadcv from a mixlist with dbadata* type 
!!$function todcv_dbadat(this)
!!$type(dbadcv) :: todcv_dbadat !< array
!!$type(mixlist) :: this
!!$
!!$integer :: i
!!$
!!$allocate (todcv_dbadat%dcv(this%countelements()))
!!$
!!$call this%rewind()
!!$i=0
!!$do while(this%element())
!!$  i=i+1
!!$
!!$  associate (dato => this%current())
!!$    select type (dato)
!!$    type is (dbadatar)
!!$      allocate(todcv_dbadat%dcv(i)%dat,source=dato)
!!$    type is (dbadatai)
!!$      allocate(todcv_dbadat%dcv(i)%dat,source=dato)
!!$    type is (dbadatab)
!!$      allocate(todcv_dbadat%dcv(i)%dat,source=dato)
!!$    type is (dbadatad)
!!$      allocate(todcv_dbadat%dcv(i)%dat,source=dato)
!!$    type is (dbadatac)
!!$      allocate(todcv_dbadat%dcv(i)%dat,source=dato)
!!$    end select
!!$  end associate
!!$
!!$  call this%next()
!!$end do
!!$end function todcv_dbadat

!!$! Definisce le funzioni count_distinct e pack_distinct
!!$#define VOL7D_POLY_TYPE TYPE(dbadata)
!!$#define VOL7D_POLY_TYPES _dbadata
!!$#undef ENABLE_SORT
!!$#include "array_utilities_inc.F90"
!!$#undef VOL7D_POLY_TYPE
!!$#undef VOL7D_POLY_TYPES


end subroutine dba2v7d


subroutine vol7d_dballe_import_dballevar(this)

type(vol7d_var),pointer :: this(:)
INTEGER :: i,un,n

IF (associated(this)) return
IF (allocated(blocal)) then
  ALLOCATE(this(size(blocal)))
  this=blocal
  return
end if

un = open_dballe_file('dballe.txt', filetype_data)
IF (un < 0) then

  call l4f_log(l4f_error,"error open_dballe_file: dballe.txt")
  CALL raise_error("error open_dballe_file: dballe.txt")
  return
end if

n = 0
DO WHILE(.true.)
  READ(un,*,end=100)
  n = n + 1
ENDDO
100 CONTINUE

IF (n > 0) THEN
  ALLOCATE(this(n))
  ALLOCATE(blocal(n))
  rewind(un)
  readline: do i = 1 ,n
    READ(un,'(1x,A6,1x,a65,a24,i4)')blocal(i)%btable,blocal(i)%description,blocal(i)%unit,&
     blocal(i)%scalefactor
    blocal(i)%btable(:1)="B"
    !print*,"B=",blocal(i)%btable
    !print*," D=",blocal(i)%description
    !PRINT*," U=",blocal(i)%unit
    !PRINT*," D=",blocal(i)%scalefactor
  ENDDO readline

  CALL l4f_log(l4f_info,'Found '//trim(to_char(i-1))//' variables in dballe master table')

  this=blocal

ENDIF
CLOSE(un)

END SUBROUTINE vol7d_dballe_import_dballevar




subroutine vol7d_dballe_set_var_du(this)

TYPE(vol7d) :: this
integer :: i,j
type(vol7d_var),pointer :: dballevar(:)

nullify(dballevar)
call vol7d_dballe_import_dballevar(dballevar)

#undef VOL7D_POLY_NAME
#define VOL7D_POLY_NAME dativar


#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V r
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V i
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V b
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V d
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V c
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V

#undef VOL7D_POLY_NAME
#define VOL7D_POLY_NAME anavar


#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V r
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V i
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V b
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V d
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V c
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V


#undef VOL7D_POLY_NAME
#define VOL7D_POLY_NAME datiattr


#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V r
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V i
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V b
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V d
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V c
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V


#undef VOL7D_POLY_NAME
#define VOL7D_POLY_NAME anaattr


#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V r
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V i
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V b
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V d
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V
#define VOL7D_POLY_TYPES_V c
#include "vol7d_dballe_class_var_du.F90"
#undef VOL7D_POLY_TYPES_V


deallocate(dballevar)

return

end subroutine vol7d_dballe_set_var_du



FUNCTION get_dballe_filepath(filename, filetype) RESULT(path)
CHARACTER(len=*), INTENT(in) :: filename
INTEGER, INTENT(in) :: filetype

INTEGER ::  j
CHARACTER(len=512) :: path
LOGICAL :: exist

IF (dballe_name == ' ') THEN
  CALL getarg(0, dballe_name)
  ! dballe_name_env
ENDIF

IF (filetype < 1 .OR. filetype > nftype) THEN
  path = ""
  CALL l4f_log(l4f_error, 'dballe file type '//trim(to_char(filetype))// &
   ' not valid')
  CALL raise_error()
  RETURN
ENDIF

! try with environment variable
CALL getenv(trim(dballe_name_env), path)
IF (path /= ' ') THEN

  path=trim(path)//'/'//filename
  INQUIRE(file=path, exist=exist)
  IF (exist) THEN
    CALL l4f_log(l4f_info, 'dballe file '//trim(path)//' found')
    RETURN
  ENDIF
ENDIF
! try with pathlist
DO j = 1, SIZE(pathlist,1)
  IF (pathlist(j,filetype) == ' ') EXIT
  path=trim(pathlist(j,filetype))//'/'//trim(dballe_name)//'/'//filename
  INQUIRE(file=path, exist=exist)
  IF (exist) THEN
    CALL l4f_log(l4f_info, 'dballe file '//trim(path)//' found')
    RETURN
  ENDIF
ENDDO
CALL l4f_log(l4f_error, 'dballe file '//trim(filename)//' not found')
CALL raise_error()
path = ""

END FUNCTION get_dballe_filepath


FUNCTION open_dballe_file(filename, filetype) RESULT(unit)
CHARACTER(len=*), INTENT(in) :: filename
INTEGER, INTENT(in) :: filetype
INTEGER :: unit,i

CHARACTER(len=512) :: path

unit = -1
path=get_dballe_filepath(filename, filetype)
IF (path == '') RETURN

unit = getunit()
IF (unit == -1) RETURN

OPEN(unit, file=path, status='old', iostat = i)
IF (i == 0) THEN
  CALL l4f_log(l4f_info, 'dballe file '//trim(path)//' opened')
  RETURN
ENDIF

CALL l4f_log(l4f_error, 'dballe file '//trim(filename)//' not found')
CALL raise_error()
unit = -1

END FUNCTION open_dballe_file




!!! TODO manage attr_only
!!! attention template migrated in init
!SUBROUTINE vol7d_dballe_export(this, network, coordmin, coordmax,&
! timei, timef,level,timerange,var,attr,anavar,anaattr,attr_only,ana,dataonly)

SUBROUTINE vol7d_dballe_export_old(this, network, coordmin, coordmax,&
 timei, timef,level,timerange,var,attr,anavar,anaattr,ana,dataonly,anaonly,template,attr_only)

TYPE(vol7d_dballe),INTENT(inout) :: this
character(len=network_name_len),INTENT(in),optional :: network
TYPE(geo_coord),INTENT(in),optional :: coordmin,coordmax 
TYPE(datetime),INTENT(in),optional :: timei, timef
TYPE(vol7d_level),INTENT(in),optional :: level
TYPE(vol7d_timerange),INTENT(in),optional :: timerange
CHARACTER(len=*),INTENT(in),OPTIONAL :: var(:),attr(:),anavar(:),anaattr(:)
!!$!> permette di riscrivere su un DSN letto precedentemente, modificando solo gli attributi ai dati,
!!$!! ottimizzando enormente le prestazioni: gli attributi riscritti saranno quelli con this%data_id definito
!!$!! (solitamente ricopiato dall'oggetto letto)
!!$logical,intent(in),optional :: attr_only 
TYPE(vol7d_ana),INTENT(inout),optional :: ana
logical, intent(in),optional :: dataonly
logical, intent(in),optional :: anaonly
character(len=*),intent(in),optional :: template 
logical, intent(in),optional :: attr_only


type(dbadcv)       :: vars,starvars,anavars,anastarvars
type(dbafilter)    :: filter
type(dbacoord)     :: mydbacoordmin, mydbacoordmax
type(dbaana)       :: mydbaana
type(dbadatetime)  :: mydatetimemin, mydatetimemax
type(dbatimerange) :: mydbatimerange
type(dbalevel)     :: mydbalevel
type(dbanetwork)   :: mydbanetwork

integer :: i
LOGICAL :: lattr, lanaattr
integer :: nanaattr,nattr,nanavar,nvar


                                ! ------------- prepare filter options

!!
!!           translate export option for dballe2003 api
!!

if (present(var)) then
  nvar=count(c_e(var))
  if (nvar > 0) then
    allocate (vars%dcv(nvar))
    do i=1,size(var)
      if (c_e(var(i)))then
        allocate (vars%dcv(i)%dat,source=dbadatac(var(i))) !char is default
      end if
    end do
  end if
end if

if (present(anavar)) then
  nanavar=count(c_e(anavar))
  if (nanavar > 0) then
    allocate (anavars%dcv(nanavar))
    do i=1,size(anavar)
      if (c_e(anavar(i)))then
        allocate (anavars%dcv(i)%dat,source=dbadatac(anavar(i))) !char is default
      end if
    end do
  end if
end if

lattr = .false.
if (present(attr)) then
  nattr=count(c_e(attr))
  if (nattr > 0) then
    lattr = .true.
    allocate (starvars%dcv(nattr))
    do i=1,size(attr)
      if (c_e(attr(i)))then
          allocate (starvars%dcv(i)%dat,source=dbadatac(attr(i))) !char is default
      end if
    end do
  end if
end if

lanaattr = .false.
if (present(anaattr)) then
  nanaattr=count(c_e(anaattr))
  if (nanaattr > 0) then
    lanaattr = .true.
    allocate (anastarvars%dcv(nanaattr))
    do i=1,size(anaattr)
      if (c_e(anaattr(i)))then
        allocate (anastarvars%dcv(i)%dat,source=dbadatac(anaattr(i))) !char is default
      end if
    end do
  end if
end if


                                ! like a cast
mydbacoordmin=dbacoord()
if (present(coordmin)) mydbacoordmin%geo_coord=coordmin
mydbacoordmax=dbacoord()
if (present(coordmax)) mydbacoordmax%geo_coord=coordmax
mydbaana=dbaana()
if (present(ana)) mydbaana%vol7d_ana=ana
mydatetimemin=dbadatetime()
if (present(timei)) mydatetimemin%datetime=timei
mydatetimemax=dbadatetime()
if (present(timef)) mydatetimemax%datetime=timef
mydbatimerange=dbatimerange()
if (present(timerange)) mydbatimerange%vol7d_timerange=timerange
mydbalevel=dbalevel()
if (present(level)) mydbalevel%vol7d_level=level
mydbanetwork=dbanetwork()
if (present(network)) call init(mydbanetwork%vol7d_network,name=network)

!!
!!         here we have options ready for filter
!!
filter=dbafilter(coordmin=mydbacoordmin,coordmax=mydbacoordmax,ana=mydbaana, &
 datetimemin=mydatetimemin,datetimemax=mydatetimemax, &
 timerange=mydbatimerange,level=mydbalevel,network=mydbanetwork,&
 vars=vars,starvars=starvars,anavars=anavars,anastarvars=anastarvars,&
 dataonly=dataonly,anaonly=anaonly)

!!$  print *, "filter:"
!!$  call filter%display()

call export (this, filter,template,attr_only)

end SUBROUTINE vol7d_dballe_export_old


subroutine vol7d_dballe_export (this, filter, template, attr_only)

TYPE(vol7d_dballe),INTENT(inout) :: this
type(dbafilter),intent(in)    :: filter
character(len=*),intent(in),optional :: template 
logical, intent(in),optional :: attr_only

character(len=40) :: ltemplate 

type(dbametaanddatalist) :: metaanddatal
logical :: stat

metaanddatal=dbametaanddatalist()

call v7d2dba(this%vol7d,metaanddatal)
!call metaanddatal%display()

!clean memdb
if (this%file) call this%handle%remove_all()

! using filter here can limit memory use for memdb
call metaanddatal%extrude(session=this%handle,filter=filter,attronly=attr_only,template=template)

if (this%file) then
  !!!!!  this if we have written in memdb and now we have to write the file

  !filter is already in extrude
  !this%handle%set(filter=filter)

  ! export to file
  !! TODO : revert template from init to export  !!!!!!!!!!!!!!!!!!!!!
  !!call this%handle%messages_write_next(template)

  ! note that you can use unsetall hera because the filter was used in extrude
  call filter%dbaset(this%handle)

  ltemplate=this%handle%template
  if (present(template))then
    ltemplate=template
  end if

  call this%handle%messages_write_next(ltemplate)

  !clean memdb
  call this%handle%remove_all()

end if

stat = metaanddatal%delete()

end subroutine vol7d_dballe_export


subroutine v7d2dba(v7d,metaanddatal)
TYPE(vol7d),INTENT(in)   :: v7d  !!!!!! dovrebbe essere intent(in)
type(dbametaanddatalist),intent(inout) :: metaanddatal

TYPE(vol7d_serialize_dballe) :: serialize

serialize = vol7d_serialize_dballe_new()
serialize%anaonly=.true.
call serialize%vol7d_serialize_setup(v7d)
call serialize%vol7d_serialize_export(metaanddatal)

serialize = vol7d_serialize_dballe_new()
serialize%dataonly=.true.
call serialize%vol7d_serialize_setup(v7d)
call serialize%vol7d_serialize_export(metaanddatal)

end subroutine v7d2dba


end MODULE vol7d_dballe_class