vol7d_class.F90

! 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_class
USE kinds
USE char_utilities
USE datetime_class
USE optional_values
USE log4fortran
USE err_handling
USE io_units
USE array_utilities
USE vol7d_ana_class
USE vol7d_timerange_class
USE vol7d_level_class
USE vol7d_network_class
USE vol7d_varvect_class
IMPLICIT NONE


INTEGER, PARAMETER :: vol7d_maxdim_a = 3, vol7d_maxdim_aa = 4, &
 vol7d_maxdim_d = 6, vol7d_maxdim_ad = 7

INTEGER, PARAMETER :: vol7d_ana_a=1
INTEGER, PARAMETER :: vol7d_var_a=2
INTEGER, PARAMETER :: vol7d_network_a=3
INTEGER, PARAMETER :: vol7d_attr_a=4
INTEGER, PARAMETER :: vol7d_ana_d=1
INTEGER, PARAMETER :: vol7d_time_d=2
INTEGER, PARAMETER :: vol7d_level_d=3
INTEGER, PARAMETER :: vol7d_timerange_d=4
INTEGER, PARAMETER :: vol7d_var_d=5
INTEGER, PARAMETER :: vol7d_network_d=6
INTEGER, PARAMETER :: vol7d_attr_d=7
INTEGER, PARAMETER :: vol7d_cdatalen=32

TYPE vol7d_varmap
  INTEGER :: r, d, i, b, c
END TYPE vol7d_varmap

TYPE vol7d
  TYPE(vol7d_ana),POINTER :: ana(:)
  TYPE(datetime),POINTER :: time(:)
  TYPE(vol7d_level),POINTER :: level(:)
  TYPE(vol7d_timerange),POINTER :: timerange(:)
  TYPE(vol7d_network),POINTER :: network(:)
  TYPE(vol7d_varvect) :: anavar
    TYPE(vol7d_varvect) :: anaattr
    TYPE(vol7d_varvect) :: anavarattr
    TYPE(vol7d_varvect) :: dativar
    TYPE(vol7d_varvect) :: datiattr
    TYPE(vol7d_varvect) :: dativarattr

  REAL,POINTER :: volanar(:,:,:)
  DOUBLE PRECISION,POINTER :: volanad(:,:,:)
  INTEGER,POINTER :: volanai(:,:,:)
  INTEGER(kind=int_b),POINTER :: volanab(:,:,:)
  CHARACTER(len=vol7d_cdatalen),POINTER :: volanac(:,:,:)

  REAL,POINTER :: volanaattrr(:,:,:,:)
  DOUBLE PRECISION,POINTER :: volanaattrd(:,:,:,:)
  INTEGER,POINTER :: volanaattri(:,:,:,:)
  INTEGER(kind=int_b),POINTER :: volanaattrb(:,:,:,:)
  CHARACTER(len=vol7d_cdatalen),POINTER :: volanaattrc(:,:,:,:)

  REAL,POINTER :: voldatir(:,:,:,:,:,:) ! sono i dati
  DOUBLE PRECISION,POINTER :: voldatid(:,:,:,:,:,:)
  INTEGER,POINTER :: voldatii(:,:,:,:,:,:)
  INTEGER(kind=int_b),POINTER :: voldatib(:,:,:,:,:,:)
  CHARACTER(len=vol7d_cdatalen),POINTER :: voldatic(:,:,:,:,:,:)

  REAL,POINTER :: voldatiattrr(:,:,:,:,:,:,:)
  DOUBLE PRECISION,POINTER :: voldatiattrd(:,:,:,:,:,:,:)
  INTEGER,POINTER :: voldatiattri(:,:,:,:,:,:,:)
  INTEGER(kind=int_b),POINTER :: voldatiattrb(:,:,:,:,:,:,:)
  CHARACTER(len=vol7d_cdatalen),POINTER :: voldatiattrc(:,:,:,:,:,:,:)

  integer :: time_definition

END TYPE vol7d

INTERFACE init
  MODULE PROCEDURE vol7d_init
END INTERFACE

INTERFACE delete
  MODULE PROCEDURE vol7d_delete
END INTERFACE

INTERFACE export
  MODULE PROCEDURE vol7d_write_on_file
END INTERFACE

INTERFACE import
  MODULE PROCEDURE vol7d_read_from_file
END INTERFACE

INTERFACE display
  MODULE PROCEDURE vol7d_display, dat_display, dat_vect_display
END INTERFACE

INTERFACE to_char
  MODULE PROCEDURE to_char_dat
END INTERFACE

INTERFACE doubledat
  MODULE PROCEDURE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
END INTERFACE

INTERFACE realdat
  MODULE PROCEDURE realdatd,realdatr,realdati,realdatb,realdatc
END INTERFACE

INTERFACE integerdat
  MODULE PROCEDURE integerdatd,integerdatr,integerdati,integerdatb,integerdatc
END INTERFACE

INTERFACE copy
  MODULE PROCEDURE vol7d_copy
END INTERFACE

INTERFACE c_e
  MODULE PROCEDURE vol7d_c_e
END INTERFACE

INTERFACE check
  MODULE PROCEDURE vol7d_check
END INTERFACE

INTERFACE rounding
  MODULE PROCEDURE v7d_rounding
END INTERFACE

!!$INTERFACE get_volana
!!$  MODULE PROCEDURE vol7d_get_volanar, vol7d_get_volanad, vol7d_get_volanai, &
!!$   vol7d_get_volanab, vol7d_get_volanac
!!$END INTERFACE
!!$
!!$INTERFACE get_voldati
!!$  MODULE PROCEDURE vol7d_get_voldatir, vol7d_get_voldatid, vol7d_get_voldatii, &
!!$   vol7d_get_voldatib, vol7d_get_voldatic
!!$END INTERFACE
!!$
!!$INTERFACE get_volanaattr
!!$  MODULE PROCEDURE vol7d_get_volanaattrr, vol7d_get_volanaattrd, &
!!$   vol7d_get_volanaattri, vol7d_get_volanaattrb, vol7d_get_volanaattrc
!!$END INTERFACE
!!$
!!$INTERFACE get_voldatiattr
!!$  MODULE PROCEDURE vol7d_get_voldatiattrr, vol7d_get_voldatiattrd, &
!!$   vol7d_get_voldatiattri, vol7d_get_voldatiattrb, vol7d_get_voldatiattrc
!!$END INTERFACE

PRIVATE vol7d_get_volr, vol7d_get_vold, vol7d_get_voli, vol7d_get_volb, &
 vol7d_get_volc, &
 volptr1dr, volptr2dr, volptr3dr, volptr4dr, volptr5dr, volptr6dr, volptr7dr, &
 volptr1dd, volptr2dd, volptr3dd, volptr4dd, volptr5dd, volptr6dd, volptr7dd, &
 volptr1di, volptr2di, volptr3di, volptr4di, volptr5di, volptr6di, volptr7di, &
 volptr1db, volptr2db, volptr3db, volptr4db, volptr5db, volptr6db, volptr7db, &
 volptr1dc, volptr2dc, volptr3dc, volptr4dc, volptr5dc, volptr6dc, volptr7dc, &
 vol7d_nullifyr, vol7d_nullifyd, vol7d_nullifyi, vol7d_nullifyb, vol7d_nullifyc, &
 vol7d_init, vol7d_delete, vol7d_write_on_file, vol7d_read_from_file, &
 vol7d_check_alloc_ana, vol7d_force_alloc_ana, &
 vol7d_check_alloc_dati, vol7d_force_alloc_dati, vol7d_force_alloc, &
 vol7d_display, dat_display, dat_vect_display, &
 to_char_dat, vol7d_check

PRIVATE doubledatd,doubledatr,doubledati,doubledatb,doubledatc

PRIVATE vol7d_c_e

CONTAINS


SUBROUTINE vol7d_init(this,time_definition)
TYPE(vol7d),intent(out) :: this
INTEGER,INTENT(IN),OPTIONAL :: time_definition

CALL init(this%anavar)
CALL init(this%anaattr)
CALL init(this%anavarattr)
CALL init(this%dativar)
CALL init(this%datiattr)
CALL init(this%dativarattr)

NULLIFY(this%ana, this%time, this%level, this%timerange, this%network)

NULLIFY(this%volanar, this%volanaattrr, this%voldatir, this%voldatiattrr)
NULLIFY(this%volanad, this%volanaattrd, this%voldatid, this%voldatiattrd)
NULLIFY(this%volanai, this%volanaattri, this%voldatii, this%voldatiattri)
NULLIFY(this%volanab, this%volanaattrb, this%voldatib, this%voldatiattrb)
NULLIFY(this%volanac, this%volanaattrc, this%voldatic, this%voldatiattrc)

if(present(time_definition)) then
  this%time_definition=time_definition
else
  this%time_definition=1  !default to validity time
end if

END SUBROUTINE vol7d_init


ELEMENTAL SUBROUTINE vol7d_delete(this, dataonly)
TYPE(vol7d),intent(inout) :: this
LOGICAL, INTENT(in), OPTIONAL :: dataonly


IF (.NOT. optio_log(dataonly)) THEN
  IF (ASSOCIATED(this%volanar)) DEALLOCATE(this%volanar)
  IF (ASSOCIATED(this%volanad)) DEALLOCATE(this%volanad)
  IF (ASSOCIATED(this%volanai)) DEALLOCATE(this%volanai)
  IF (ASSOCIATED(this%volanab)) DEALLOCATE(this%volanab)
  IF (ASSOCIATED(this%volanac)) DEALLOCATE(this%volanac)
  IF (ASSOCIATED(this%volanaattrr)) DEALLOCATE(this%volanaattrr)
  IF (ASSOCIATED(this%volanaattrd)) DEALLOCATE(this%volanaattrd)
  IF (ASSOCIATED(this%volanaattri)) DEALLOCATE(this%volanaattri)
  IF (ASSOCIATED(this%volanaattrb)) DEALLOCATE(this%volanaattrb)
  IF (ASSOCIATED(this%volanaattrc)) DEALLOCATE(this%volanaattrc)
ENDIF
IF (ASSOCIATED(this%voldatir)) DEALLOCATE(this%voldatir)
IF (ASSOCIATED(this%voldatid)) DEALLOCATE(this%voldatid)
IF (ASSOCIATED(this%voldatii)) DEALLOCATE(this%voldatii)
IF (ASSOCIATED(this%voldatib)) DEALLOCATE(this%voldatib)
IF (ASSOCIATED(this%voldatic)) DEALLOCATE(this%voldatic)
IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)

IF (.NOT. optio_log(dataonly)) THEN
  IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
  IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
ENDIF
IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)

IF (.NOT. optio_log(dataonly)) THEN
  CALL delete(this%anavar)
  CALL delete(this%anaattr)
  CALL delete(this%anavarattr)
ENDIF
CALL delete(this%dativar)
CALL delete(this%datiattr)
CALL delete(this%dativarattr)

END SUBROUTINE vol7d_delete



integer function vol7d_check(this)
TYPE(vol7d),intent(in) :: this
integer :: i,j,k,l,m,n

vol7d_check=0

if (associated(this%voldatii)) then
do i = 1,size(this%voldatii,1)
  do j = 1,size(this%voldatii,2)
    do k = 1,size(this%voldatii,3)
      do l = 1,size(this%voldatii,4)
        do m = 1,size(this%voldatii,5)
          do n = 1,size(this%voldatii,6)
            if (this%voldatii(i,j,k,l,m,n) /= this%voldatii(i,j,k,l,m,n) ) then
              CALL l4f_log(l4f_warn,"check: abnormal value at voldatii("&
               //t2c(i)//","//t2c(j)//","//t2c(k)//","//t2c(l)//","//t2c(m)//","//t2c(n)//",)")
              vol7d_check=1
            end if
          end do
        end do
      end do
    end do
  end do
end do
end if


if (associated(this%voldatir)) then
do i = 1,size(this%voldatir,1)
  do j = 1,size(this%voldatir,2)
    do k = 1,size(this%voldatir,3)
      do l = 1,size(this%voldatir,4)
        do m = 1,size(this%voldatir,5)
          do n = 1,size(this%voldatir,6)
            if (this%voldatir(i,j,k,l,m,n) /= this%voldatir(i,j,k,l,m,n) ) then
              CALL l4f_log(l4f_warn,"check: abnormal value at voldatir("&
               //t2c(i)//","//t2c(j)//","//t2c(k)//","//t2c(l)//","//t2c(m)//","//t2c(n)//",)")
              vol7d_check=2
            end if
          end do
        end do
      end do
    end do
  end do
end do
end if

if (associated(this%voldatid)) then
do i = 1,size(this%voldatid,1)
  do j = 1,size(this%voldatid,2)
    do k = 1,size(this%voldatid,3)
      do l = 1,size(this%voldatid,4)
        do m = 1,size(this%voldatid,5)
          do n = 1,size(this%voldatid,6)
            if (this%voldatid(i,j,k,l,m,n) /= this%voldatid(i,j,k,l,m,n) ) then
              CALL l4f_log(l4f_warn,"check: abnormal value at voldatid("&
               //t2c(i)//","//t2c(j)//","//t2c(k)//","//t2c(l)//","//t2c(m)//","//t2c(n)//",)")
              vol7d_check=3
            end if
          end do
        end do
      end do
    end do
  end do
end do
end if

if (associated(this%voldatib)) then
do i = 1,size(this%voldatib,1)
  do j = 1,size(this%voldatib,2)
    do k = 1,size(this%voldatib,3)
      do l = 1,size(this%voldatib,4)
        do m = 1,size(this%voldatib,5)
          do n = 1,size(this%voldatib,6)
            if (this%voldatib(i,j,k,l,m,n) /= this%voldatib(i,j,k,l,m,n) ) then
              CALL l4f_log(l4f_warn,"check: abnormal value at voldatib("&
               //t2c(i)//","//t2c(j)//","//t2c(k)//","//t2c(l)//","//t2c(m)//","//t2c(n)//",)")
              vol7d_check=4
            end if
          end do
        end do
      end do
    end do
  end do
end do
end if

end function vol7d_check



!TODO da completare ! aborta se i volumi sono allocati a dimensione 0
SUBROUTINE vol7d_display(this)
TYPE(vol7d),intent(in) :: this
integer :: i

REAL :: rdat
DOUBLE PRECISION :: ddat
INTEGER :: idat
INTEGER(kind=int_b) :: bdat
CHARACTER(len=vol7d_cdatalen) :: cdat


print*,"<<<<<<<<<<<<<<<<<<< vol7d object >>>>>>>>>>>>>>>>>>>>"
if (this%time_definition == 0) then
  print*,"TIME DEFINITION: time is reference time"
else if (this%time_definition == 1) then
  print*,"TIME DEFINITION: time is validity time"
else if (this%time_definition == 2) then
  print*,"TIME DEFINITION: time is validity time, forecast range forced to 0"
else
  print*,"Time definition has a wrong walue:", this%time_definition
end if

IF (ASSOCIATED(this%network))then
  print*,"---- network vector ----"
  print*,"elements=",size(this%network)
  do i=1, size(this%network)
    call display(this%network(i))
  end do
end IF

IF (ASSOCIATED(this%ana))then
  print*,"---- ana vector ----"
  print*,"elements=",size(this%ana)
  do i=1, size(this%ana)
    call display(this%ana(i))
  end do
end IF

IF (ASSOCIATED(this%time))then        
  print*,"---- time vector ----"
  print*,"elements=",size(this%time)
  do i=1, size(this%time)
    call display(this%time(i))
  end do
end if

IF (ASSOCIATED(this%level)) then
  print*,"---- level vector ----"
  print*,"elements=",size(this%level)
  do i =1,size(this%level)
    call display(this%level(i))
  end do
end if

IF (ASSOCIATED(this%timerange))then
  print*,"---- timerange vector ----"
  print*,"elements=",size(this%timerange)
  do i =1,size(this%timerange)
    call display(this%timerange(i))
  end do
end if


print*,"---- ana vector ----"
print*,""
print*,"->>>>>>>>> anavar -"
call display(this%anavar)
print*,""
print*,"->>>>>>>>> anaattr -"
call display(this%anaattr)
print*,""
print*,"->>>>>>>>> anavarattr -"
call display(this%anavarattr)

print*,"-- ana data section (first point) --"

idat=imiss
rdat=rmiss
ddat=dmiss
bdat=ibmiss
cdat=cmiss

!ntime = MIN(SIZE(this%time),nprint)
!ntimerange = MIN(SIZE(this%timerange),nprint)
!nlevel = MIN(SIZE(this%level),nprint)
!nnetwork = MIN(SIZE(this%network),nprint)
!nana = MIN(SIZE(this%ana),nprint)

IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0) THEN
if (associated(this%volanai)) then
  do i=1,size(this%anavar%i)
    idat=this%volanai(1,i,1)
    if (associated(this%anavar%i)) call display(this%anavar%i(i),idat,rdat,ddat,bdat,cdat)
  end do
end if
idat=imiss

if (associated(this%volanar)) then
  do i=1,size(this%anavar%r)
    rdat=this%volanar(1,i,1)
    if (associated(this%anavar%r)) call display(this%anavar%r(i),idat,rdat,ddat,bdat,cdat)
  end do
end if
rdat=rmiss

if (associated(this%volanad)) then
  do i=1,size(this%anavar%d)
    ddat=this%volanad(1,i,1)
    if (associated(this%anavar%d)) call display(this%anavar%d(i),idat,rdat,ddat,bdat,cdat)
  end do
end if
ddat=dmiss

if (associated(this%volanab)) then
  do i=1,size(this%anavar%b)
    bdat=this%volanab(1,i,1)
    if (associated(this%anavar%b)) call display(this%anavar%b(i),idat,rdat,ddat,bdat,cdat)
  end do
end if
bdat=ibmiss

if (associated(this%volanac)) then
  do i=1,size(this%anavar%c)
    cdat=this%volanac(1,i,1)
    if (associated(this%anavar%c)) call display(this%anavar%c(i),idat,rdat,ddat,bdat,cdat)
  end do
end if
cdat=cmiss
ENDIF

print*,"---- data vector ----"
print*,""
print*,"->>>>>>>>> dativar -"
call display(this%dativar)
print*,""
print*,"->>>>>>>>> datiattr -"
call display(this%datiattr)
print*,""
print*,"->>>>>>>>> dativarattr -"
call display(this%dativarattr)

print*,"-- data data section (first point) --"

idat=imiss
rdat=rmiss
ddat=dmiss
bdat=ibmiss
cdat=cmiss

IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0 .AND. size(this%time) > 0 &
 .AND. size(this%level) > 0 .AND. size(this%timerange) > 0) THEN
if (associated(this%voldatii)) then
  do i=1,size(this%dativar%i)
    idat=this%voldatii(1,1,1,1,i,1)
    if (associated(this%dativar%i)) call display(this%dativar%i(i),idat,rdat,ddat,bdat,cdat)
  end do
end if
idat=imiss

if (associated(this%voldatir)) then
  do i=1,size(this%dativar%r)
    rdat=this%voldatir(1,1,1,1,i,1)
    if (associated(this%dativar%r)) call display(this%dativar%r(i),idat,rdat,ddat,bdat,cdat)
  end do
end if
rdat=rmiss

if (associated(this%voldatid)) then
  do i=1,size(this%dativar%d)
    ddat=this%voldatid(1,1,1,1,i,1)
    if (associated(this%dativar%d)) call display(this%dativar%d(i),idat,rdat,ddat,bdat,cdat)
  end do
end if
ddat=dmiss

if (associated(this%voldatib)) then
  do i=1,size(this%dativar%b)
    bdat=this%voldatib(1,1,1,1,i,1)
    if (associated(this%dativar%b)) call display(this%dativar%b(i),idat,rdat,ddat,bdat,cdat)
  end do
end if
bdat=ibmiss

if (associated(this%voldatic)) then
  do i=1,size(this%dativar%c)
    cdat=this%voldatic(1,1,1,1,i,1)
    if (associated(this%dativar%c)) call display(this%dativar%c(i),idat,rdat,ddat,bdat,cdat)
  end do
end if
cdat=cmiss
ENDIF

print*,"<<<<<<<<<<<<<<<<<<< END vol7d object >>>>>>>>>>>>>>>>>>>>"

END SUBROUTINE vol7d_display


SUBROUTINE dat_display(this,idat,rdat,ddat,bdat,cdat)
TYPE(vol7d_var),intent(in) :: this
REAL :: rdat
DOUBLE PRECISION :: ddat
INTEGER :: idat
INTEGER(kind=int_b) :: bdat
CHARACTER(len=*) :: cdat

print *, to_char_dat(this,idat,rdat,ddat,bdat,cdat)

end SUBROUTINE dat_display

SUBROUTINE dat_vect_display(this,idat,rdat,ddat,bdat,cdat)

TYPE(vol7d_var),intent(in) :: this(:)
REAL :: rdat(:)
DOUBLE PRECISION :: ddat(:)
INTEGER :: idat(:)
INTEGER(kind=int_b) :: bdat(:)
CHARACTER(len=*):: cdat(:)

integer :: i

do i =1,size(this)
  call display(this(i),idat(i),rdat(i),ddat(i),bdat(i),cdat(i))
end do

end SUBROUTINE dat_vect_display


FUNCTION to_char_dat(this,idat,rdat,ddat,bdat,cdat)
#ifdef HAVE_DBALLE
USE dballef
#endif
TYPE(vol7d_var),INTENT(in) :: this
REAL :: rdat
DOUBLE PRECISION :: ddat
INTEGER :: idat
INTEGER(kind=int_b) :: bdat
CHARACTER(len=*) :: cdat
CHARACTER(len=80) :: to_char_dat

CHARACTER(len=LEN(to_char_dat)) :: to_char_tmp


#ifdef HAVE_DBALLE
INTEGER :: handle, ier

handle = 0
to_char_dat="VALUE: "

if (c_e(idat)) to_char_dat=trim(to_char_dat)//" ;int> "//trim(to_char(idat))
if (c_e(rdat)) to_char_dat=trim(to_char_dat)//" ;real> "//trim(to_char(rdat))
if (c_e(ddat)) to_char_dat=trim(to_char_dat)//" ;double> "//trim(to_char(ddat))
if (c_e(bdat)) to_char_dat=trim(to_char_dat)//" ;byte> "//trim(to_char(bdat))

if ( c_e(cdat))then
  ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
  ier = idba_spiegab(handle,this%btable,cdat,to_char_tmp)
  ier = idba_fatto(handle)
  to_char_dat=trim(to_char_dat)//" ;char> "//trim(to_char_tmp)
endif

#else

to_char_dat="VALUE: "
if (c_e(idat)) to_char_dat=trim(to_char_dat)//" ;int> "//trim(to_char(idat))
if (c_e(rdat)) to_char_dat=trim(to_char_dat)//" ;real> "//trim(to_char(rdat))
if (c_e(ddat)) to_char_dat=trim(to_char_dat)//" ;double> "//trim(to_char(ddat))
if (c_e(bdat)) to_char_dat=trim(to_char_dat)//" ;byte> "//trim(to_char(bdat))
if (c_e(cdat)) to_char_dat=trim(to_char_dat)//" ;char> "//trim(cdat)

#endif

END FUNCTION to_char_dat


FUNCTION vol7d_c_e(this) RESULT(c_e)
TYPE(vol7d), INTENT(in) :: this

LOGICAL :: c_e

c_e = ASSOCIATED(this%ana) .OR. ASSOCIATED(this%time) .OR. &
 ASSOCIATED(this%level) .OR. ASSOCIATED(this%timerange) .OR. &
 ASSOCIATED(this%network) .OR. &
 ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
 ASSOCIATED(this%anavar%c) .OR. &
 ASSOCIATED(this%anaattr%r) .OR. ASSOCIATED(this%anaattr%d) .OR. &
 ASSOCIATED(this%anaattr%i) .OR. ASSOCIATED(this%anaattr%b) .OR. &
 ASSOCIATED(this%anaattr%c) .OR. &
 ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
 ASSOCIATED(this%dativar%c) .OR. &
 ASSOCIATED(this%datiattr%r) .OR. ASSOCIATED(this%datiattr%d) .OR. &
 ASSOCIATED(this%datiattr%i) .OR. ASSOCIATED(this%datiattr%b) .OR. &
 ASSOCIATED(this%datiattr%c)

END FUNCTION vol7d_c_e


SUBROUTINE vol7d_alloc(this, nana, ntime, nlevel, ntimerange, nnetwork, &
 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc, &
 ini)
TYPE(vol7d),INTENT(inout) :: this
INTEGER,INTENT(in),OPTIONAL :: nana
INTEGER,INTENT(in),OPTIONAL :: ntime
INTEGER,INTENT(in),OPTIONAL :: nlevel
INTEGER,INTENT(in),OPTIONAL :: ntimerange
INTEGER,INTENT(in),OPTIONAL :: nnetwork
INTEGER,INTENT(in),OPTIONAL :: &
 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc
LOGICAL,INTENT(in),OPTIONAL :: ini

INTEGER :: i
LOGICAL :: linit

IF (PRESENT(ini)) THEN
  linit = ini
ELSE
  linit = .false.
ENDIF

! Dimensioni principali
IF (PRESENT(nana)) THEN
  IF (nana >= 0) THEN
    IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
    ALLOCATE(this%ana(nana))
    IF (linit) THEN
      DO i = 1, nana
        CALL init(this%ana(i))
      ENDDO
    ENDIF
  ENDIF
ENDIF
IF (PRESENT(ntime)) THEN
  IF (ntime >= 0) THEN
    IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
    ALLOCATE(this%time(ntime))
    IF (linit) THEN
      DO i = 1, ntime
        CALL init(this%time(i))
      ENDDO
    ENDIF
  ENDIF
ENDIF
IF (PRESENT(nlevel)) THEN
  IF (nlevel >= 0) THEN
    IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
    ALLOCATE(this%level(nlevel))
    IF (linit) THEN
      DO i = 1, nlevel
        CALL init(this%level(i))
      ENDDO
    ENDIF
  ENDIF
ENDIF
IF (PRESENT(ntimerange)) THEN
  IF (ntimerange >= 0) THEN
    IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
    ALLOCATE(this%timerange(ntimerange))
    IF (linit) THEN
      DO i = 1, ntimerange
        CALL init(this%timerange(i))
      ENDDO
    ENDIF
  ENDIF
ENDIF
IF (PRESENT(nnetwork)) THEN
  IF (nnetwork >= 0) THEN
    IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
    ALLOCATE(this%network(nnetwork))
    IF (linit) THEN
      DO i = 1, nnetwork
        CALL init(this%network(i))
      ENDDO
    ENDIF
  ENDIF
ENDIF
! Dimensioni dei tipi delle variabili
CALL vol7d_varvect_alloc(this%anavar, nanavarr, nanavard, &
 nanavari, nanavarb, nanavarc, ini)
CALL vol7d_varvect_alloc(this%anaattr, nanaattrr, nanaattrd, &
 nanaattri, nanaattrb, nanaattrc, ini)
CALL vol7d_varvect_alloc(this%anavarattr, nanavarattrr, nanavarattrd, &
 nanavarattri, nanavarattrb, nanavarattrc, ini)
CALL vol7d_varvect_alloc(this%dativar, ndativarr, ndativard, &
 ndativari, ndativarb, ndativarc, ini)
CALL vol7d_varvect_alloc(this%datiattr, ndatiattrr, ndatiattrd, &
 ndatiattri, ndatiattrb, ndatiattrc, ini)
CALL vol7d_varvect_alloc(this%dativarattr, ndativarattrr, ndativarattrd, &
 ndativarattri, ndativarattrb, ndativarattrc, ini)

END SUBROUTINE vol7d_alloc


FUNCTION vol7d_check_alloc_ana(this)
TYPE(vol7d),INTENT(in) :: this
LOGICAL :: vol7d_check_alloc_ana

vol7d_check_alloc_ana = ASSOCIATED(this%ana) .AND. ASSOCIATED(this%network)

END FUNCTION vol7d_check_alloc_ana

SUBROUTINE vol7d_force_alloc_ana(this, ini)
TYPE(vol7d),INTENT(inout) :: this
LOGICAL,INTENT(in),OPTIONAL :: ini

! Alloco i descrittori minimi per avere un volume di anagrafica
IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=1, ini=ini)
IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=1, ini=ini)

END SUBROUTINE vol7d_force_alloc_ana


FUNCTION vol7d_check_alloc_dati(this)
TYPE(vol7d),INTENT(in) :: this
LOGICAL :: vol7d_check_alloc_dati

vol7d_check_alloc_dati = vol7d_check_alloc_ana(this) .AND. &
 ASSOCIATED(this%time) .AND. ASSOCIATED(this%level) .AND. &
 ASSOCIATED(this%timerange)

END FUNCTION vol7d_check_alloc_dati

SUBROUTINE vol7d_force_alloc_dati(this, ini)
TYPE(vol7d),INTENT(inout) :: this
LOGICAL,INTENT(in),OPTIONAL :: ini

! Alloco i descrittori minimi per avere un volume di dati
CALL vol7d_force_alloc_ana(this, ini)
IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=1, ini=ini)
IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=1, ini=ini)
IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=1, ini=ini)

END SUBROUTINE vol7d_force_alloc_dati


SUBROUTINE vol7d_force_alloc(this)
TYPE(vol7d),INTENT(inout) :: this

! If anything really not allocated yet, allocate with size 0
IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=0)
IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=0)
IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=0)
IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=0)
IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=0)

END SUBROUTINE vol7d_force_alloc


FUNCTION vol7d_check_vol(this)
TYPE(vol7d),INTENT(in) :: this
LOGICAL :: vol7d_check_vol

vol7d_check_vol = c_e(this)

! Anagrafica
IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
  vol7d_check_vol = .false.
ENDIF
IF (ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
 ASSOCIATED(this%anavar%c)) THEN
  vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_ana(this)
ENDIF

! Attributi dell'anagrafica
IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
 .NOT.ASSOCIATED(this%volanaattrr)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
 .NOT.ASSOCIATED(this%volanaattrd)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
 .NOT.ASSOCIATED(this%volanaattri)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
 .NOT.ASSOCIATED(this%volanaattrb)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
 .NOT.ASSOCIATED(this%volanaattrc)) THEN
  vol7d_check_vol = .false.
ENDIF

! Dati
IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
  vol7d_check_vol = .false.
ENDIF

! Attributi dei dati
IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
 .NOT.ASSOCIATED(this%voldatiattri)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
  vol7d_check_vol = .false.
ENDIF

IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
  vol7d_check_vol = .false.
ENDIF
IF (ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
 ASSOCIATED(this%dativar%c)) THEN
  vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_dati(this)
ENDIF

END FUNCTION vol7d_check_vol


SUBROUTINE vol7d_alloc_vol(this, ini, inivol)
TYPE(vol7d),INTENT(inout) :: this
LOGICAL,INTENT(in),OPTIONAL :: ini
LOGICAL,INTENT(in),OPTIONAL :: inivol

LOGICAL :: linivol

IF (PRESENT(inivol)) THEN
  linivol = inivol
ELSE
  linivol = .true.
ENDIF

! Anagrafica
IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
  CALL vol7d_force_alloc_ana(this, ini)
  ALLOCATE(this%volanar(SIZE(this%ana), SIZE(this%anavar%r), SIZE(this%network)))
  IF (linivol) this%volanar(:,:,:) = rmiss
ENDIF

IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
  CALL vol7d_force_alloc_ana(this, ini)
  ALLOCATE(this%volanad(SIZE(this%ana), SIZE(this%anavar%d), SIZE(this%network)))
  IF (linivol) this%volanad(:,:,:) = rdmiss
ENDIF

IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
  CALL vol7d_force_alloc_ana(this, ini)
  ALLOCATE(this%volanai(SIZE(this%ana), SIZE(this%anavar%i), SIZE(this%network)))
  IF (linivol) this%volanai(:,:,:) = imiss
ENDIF

IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
  CALL vol7d_force_alloc_ana(this, ini)
  ALLOCATE(this%volanab(SIZE(this%ana), SIZE(this%anavar%b), SIZE(this%network)))
  IF (linivol) this%volanab(:,:,:) = ibmiss
ENDIF

IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
  CALL vol7d_force_alloc_ana(this, ini)
  ALLOCATE(this%volanac(SIZE(this%ana), SIZE(this%anavar%c), SIZE(this%network)))
  IF (linivol) this%volanac(:,:,:) = cmiss
ENDIF

! Attributi dell'anagrafica
IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
 .NOT.ASSOCIATED(this%volanaattrr)) THEN
  CALL vol7d_force_alloc_ana(this, ini)
  ALLOCATE(this%volanaattrr(SIZE(this%ana), SIZE(this%anavarattr%r), &
   SIZE(this%network), SIZE(this%anaattr%r)))
  IF (linivol) this%volanaattrr(:,:,:,:) = rmiss
ENDIF

IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
 .NOT.ASSOCIATED(this%volanaattrd)) THEN
  CALL vol7d_force_alloc_ana(this, ini)
  ALLOCATE(this%volanaattrd(SIZE(this%ana), SIZE(this%anavarattr%d), &
   SIZE(this%network), SIZE(this%anaattr%d)))
  IF (linivol) this%volanaattrd(:,:,:,:) = rdmiss
ENDIF

IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
 .NOT.ASSOCIATED(this%volanaattri)) THEN
  CALL vol7d_force_alloc_ana(this, ini)
  ALLOCATE(this%volanaattri(SIZE(this%ana), SIZE(this%anavarattr%i), &
   SIZE(this%network), SIZE(this%anaattr%i)))
  IF (linivol) this%volanaattri(:,:,:,:) = imiss
ENDIF

IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
 .NOT.ASSOCIATED(this%volanaattrb)) THEN
  CALL vol7d_force_alloc_ana(this, ini)
  ALLOCATE(this%volanaattrb(SIZE(this%ana), SIZE(this%anavarattr%b), &
   SIZE(this%network), SIZE(this%anaattr%b)))
  IF (linivol) this%volanaattrb(:,:,:,:) = ibmiss
ENDIF

IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
 .NOT.ASSOCIATED(this%volanaattrc)) THEN
  CALL vol7d_force_alloc_ana(this, ini)
  ALLOCATE(this%volanaattrc(SIZE(this%ana), SIZE(this%anavarattr%c), &
   SIZE(this%network), SIZE(this%anaattr%c)))
  IF (linivol) this%volanaattrc(:,:,:,:) = cmiss
ENDIF

! Dati
IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
  CALL vol7d_force_alloc_dati(this, ini)
  ALLOCATE(this%voldatir(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
   SIZE(this%timerange), SIZE(this%dativar%r), SIZE(this%network)))
  IF (linivol) this%voldatir(:,:,:,:,:,:) = rmiss
ENDIF

IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
  CALL vol7d_force_alloc_dati(this, ini)
  ALLOCATE(this%voldatid(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
   SIZE(this%timerange), SIZE(this%dativar%d), SIZE(this%network)))
  IF (linivol) this%voldatid(:,:,:,:,:,:) = rdmiss
ENDIF

IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
  CALL vol7d_force_alloc_dati(this, ini)
  ALLOCATE(this%voldatii(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
   SIZE(this%timerange), SIZE(this%dativar%i), SIZE(this%network)))
  IF (linivol) this%voldatii(:,:,:,:,:,:) = imiss
ENDIF

IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
  CALL vol7d_force_alloc_dati(this, ini)
  ALLOCATE(this%voldatib(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
   SIZE(this%timerange), SIZE(this%dativar%b), SIZE(this%network)))
  IF (linivol) this%voldatib(:,:,:,:,:,:) = ibmiss
ENDIF

IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
  CALL vol7d_force_alloc_dati(this, ini)
  ALLOCATE(this%voldatic(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
   SIZE(this%timerange), SIZE(this%dativar%c), SIZE(this%network)))
  IF (linivol) this%voldatic(:,:,:,:,:,:) = cmiss
ENDIF

! Attributi dei dati
IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
  CALL vol7d_force_alloc_dati(this, ini)
  ALLOCATE(this%voldatiattrr(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
   SIZE(this%timerange), SIZE(this%dativarattr%r), SIZE(this%network), &
   SIZE(this%datiattr%r)))
  IF (linivol) this%voldatiattrr(:,:,:,:,:,:,:) = rmiss
ENDIF

IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
  CALL vol7d_force_alloc_dati(this, ini)
  ALLOCATE(this%voldatiattrd(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
   SIZE(this%timerange), SIZE(this%dativarattr%d), SIZE(this%network), &
   SIZE(this%datiattr%d)))
  IF (linivol) this%voldatiattrd(:,:,:,:,:,:,:) = rdmiss
ENDIF

IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
 .NOT.ASSOCIATED(this%voldatiattri)) THEN
  CALL vol7d_force_alloc_dati(this, ini)
  ALLOCATE(this%voldatiattri(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
   SIZE(this%timerange), SIZE(this%dativarattr%i), SIZE(this%network), &
   SIZE(this%datiattr%i)))
  IF (linivol) this%voldatiattri(:,:,:,:,:,:,:) = imiss
ENDIF

IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
  CALL vol7d_force_alloc_dati(this, ini)
  ALLOCATE(this%voldatiattrb(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
   SIZE(this%timerange), SIZE(this%dativarattr%b), SIZE(this%network), &
   SIZE(this%datiattr%b)))
  IF (linivol) this%voldatiattrb(:,:,:,:,:,:,:) = ibmiss
ENDIF

IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
  CALL vol7d_force_alloc_dati(this, ini)
  ALLOCATE(this%voldatiattrc(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
   SIZE(this%timerange), SIZE(this%dativarattr%c), SIZE(this%network), &
   SIZE(this%datiattr%c)))
  IF (linivol) this%voldatiattrc(:,:,:,:,:,:,:) = cmiss
ENDIF

! Catch-all method
CALL vol7d_force_alloc(this)

! Creo gli indici var-attr

#ifdef DEBUG
CALL l4f_log(l4f_debug,"calling: vol7d_set_attr_ind")
#endif

CALL vol7d_set_attr_ind(this)



END SUBROUTINE vol7d_alloc_vol


SUBROUTINE vol7d_set_attr_ind(this)
TYPE(vol7d),INTENT(inout) :: this

INTEGER :: i

! real
IF (ASSOCIATED(this%dativar%r)) THEN
  IF (ASSOCIATED(this%dativarattr%r)) THEN
    DO i = 1, SIZE(this%dativar%r)
      this%dativar%r(i)%r = &
       firsttrue(this%dativar%r(i)%btable == this%dativarattr%r(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%d)) THEN
    DO i = 1, SIZE(this%dativar%r)
      this%dativar%r(i)%d = &
       firsttrue(this%dativar%r(i)%btable == this%dativarattr%d(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%i)) THEN
    DO i = 1, SIZE(this%dativar%r)
      this%dativar%r(i)%i = &
       firsttrue(this%dativar%r(i)%btable == this%dativarattr%i(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%b)) THEN
    DO i = 1, SIZE(this%dativar%r)
      this%dativar%r(i)%b = &
       firsttrue(this%dativar%r(i)%btable == this%dativarattr%b(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%c)) THEN
    DO i = 1, SIZE(this%dativar%r)
      this%dativar%r(i)%c = &
       firsttrue(this%dativar%r(i)%btable == this%dativarattr%c(:)%btable)
    ENDDO
  ENDIF
ENDIF
! double
IF (ASSOCIATED(this%dativar%d)) THEN
  IF (ASSOCIATED(this%dativarattr%r)) THEN
    DO i = 1, SIZE(this%dativar%d)
      this%dativar%d(i)%r = &
       firsttrue(this%dativar%d(i)%btable == this%dativarattr%r(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%d)) THEN
    DO i = 1, SIZE(this%dativar%d)
      this%dativar%d(i)%d = &
       firsttrue(this%dativar%d(i)%btable == this%dativarattr%d(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%i)) THEN
    DO i = 1, SIZE(this%dativar%d)
      this%dativar%d(i)%i = &
       firsttrue(this%dativar%d(i)%btable == this%dativarattr%i(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%b)) THEN
    DO i = 1, SIZE(this%dativar%d)
      this%dativar%d(i)%b = &
       firsttrue(this%dativar%d(i)%btable == this%dativarattr%b(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%c)) THEN
    DO i = 1, SIZE(this%dativar%d)
      this%dativar%d(i)%c = &
       firsttrue(this%dativar%d(i)%btable == this%dativarattr%c(:)%btable)
    ENDDO
  ENDIF
ENDIF
! integer
IF (ASSOCIATED(this%dativar%i)) THEN
  IF (ASSOCIATED(this%dativarattr%r)) THEN
    DO i = 1, SIZE(this%dativar%i)
      this%dativar%i(i)%r = &
       firsttrue(this%dativar%i(i)%btable == this%dativarattr%r(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%d)) THEN
    DO i = 1, SIZE(this%dativar%i)
      this%dativar%i(i)%d = &
       firsttrue(this%dativar%i(i)%btable == this%dativarattr%d(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%i)) THEN
    DO i = 1, SIZE(this%dativar%i)
      this%dativar%i(i)%i = &
       firsttrue(this%dativar%i(i)%btable == this%dativarattr%i(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%b)) THEN
    DO i = 1, SIZE(this%dativar%i)
      this%dativar%i(i)%b = &
       firsttrue(this%dativar%i(i)%btable == this%dativarattr%b(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%c)) THEN
    DO i = 1, SIZE(this%dativar%i)
      this%dativar%i(i)%c = &
       firsttrue(this%dativar%i(i)%btable == this%dativarattr%c(:)%btable)
    ENDDO
  ENDIF
ENDIF
! byte
IF (ASSOCIATED(this%dativar%b)) THEN
  IF (ASSOCIATED(this%dativarattr%r)) THEN
    DO i = 1, SIZE(this%dativar%b)
      this%dativar%b(i)%r = &
       firsttrue(this%dativar%b(i)%btable == this%dativarattr%r(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%d)) THEN
    DO i = 1, SIZE(this%dativar%b)
      this%dativar%b(i)%d = &
       firsttrue(this%dativar%b(i)%btable == this%dativarattr%d(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%i)) THEN
    DO i = 1, SIZE(this%dativar%b)
      this%dativar%b(i)%i = &
       firsttrue(this%dativar%b(i)%btable == this%dativarattr%i(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%b)) THEN
    DO i = 1, SIZE(this%dativar%b)
      this%dativar%b(i)%b = &
       firsttrue(this%dativar%b(i)%btable == this%dativarattr%b(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%c)) THEN
    DO i = 1, SIZE(this%dativar%b)
      this%dativar%b(i)%c = &
       firsttrue(this%dativar%b(i)%btable == this%dativarattr%c(:)%btable)
    ENDDO
  ENDIF
ENDIF
! character
IF (ASSOCIATED(this%dativar%c)) THEN
  IF (ASSOCIATED(this%dativarattr%r)) THEN
    DO i = 1, SIZE(this%dativar%c)
      this%dativar%c(i)%r = &
       firsttrue(this%dativar%c(i)%btable == this%dativarattr%r(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%d)) THEN
    DO i = 1, SIZE(this%dativar%c)
      this%dativar%c(i)%d = &
       firsttrue(this%dativar%c(i)%btable == this%dativarattr%d(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%i)) THEN
    DO i = 1, SIZE(this%dativar%c)
      this%dativar%c(i)%i = &
       firsttrue(this%dativar%c(i)%btable == this%dativarattr%i(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%b)) THEN
    DO i = 1, SIZE(this%dativar%c)
      this%dativar%c(i)%b = &
       firsttrue(this%dativar%c(i)%btable == this%dativarattr%b(:)%btable)
    ENDDO
  ENDIF

  IF (ASSOCIATED(this%dativarattr%c)) THEN
    DO i = 1, SIZE(this%dativar%c)
      this%dativar%c(i)%c = &
       firsttrue(this%dativar%c(i)%btable == this%dativarattr%c(:)%btable)
    ENDDO
  ENDIF
ENDIF

END SUBROUTINE vol7d_set_attr_ind


SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
TYPE(vol7d),INTENT(INOUT) :: this
TYPE(vol7d),INTENT(INOUT) :: that
LOGICAL,INTENT(IN),OPTIONAL :: sort
LOGICAL,INTENT(in),OPTIONAL :: bestdata
LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple ! experimental, please do not use outside the library now

TYPE(vol7d) :: v7d_clean


IF (.NOT.c_e(this)) THEN ! speedup
  this = that
  CALL init(v7d_clean)
  that = v7d_clean ! destroy that without deallocating
ELSE ! Append that to this and destroy that
  CALL vol7d_append(this, that, sort, bestdata, &
   ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
  CALL delete(that)
ENDIF

END SUBROUTINE vol7d_merge


SUBROUTINE vol7d_append(this, that, sort, bestdata, &
 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
TYPE(vol7d),INTENT(INOUT) :: this
TYPE(vol7d),INTENT(IN) :: that
LOGICAL,INTENT(IN),OPTIONAL :: sort
! experimental, please do not use outside the library now, they force the use
! of a simplified mapping algorithm which is valid only whene the dimension
! content is the same in both volumes , or when one of them is empty
LOGICAL,INTENT(in),OPTIONAL :: bestdata
LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple


TYPE(vol7d) :: v7dtmp
LOGICAL :: lsort, lbestdata
INTEGER,POINTER :: remapt1(:), remapt2(:), remaptr1(:), remaptr2(:), &
 remapl1(:), remapl2(:), remapa1(:), remapa2(:), remapn1(:), remapn2(:)

IF (.NOT.c_e(that)) RETURN ! speedup, nothing to do
IF (.NOT.vol7d_check_vol(that)) RETURN ! be safe
IF (.NOT.c_e(this)) THEN ! this case is like a vol7d_copy, more efficient to copy?
  CALL vol7d_copy(that, this, sort=sort)
  RETURN
ENDIF

IF (this%time_definition /= that%time_definition) THEN
  CALL l4f_log(l4f_fatal, &
   'in vol7d_append, cannot append volumes with different &
   &time definition')
  CALL raise_fatal_error()
ENDIF

! Completo l'allocazione per avere volumi a norma
CALL vol7d_alloc_vol(this)

CALL init(v7dtmp, time_definition=this%time_definition)
CALL optio(sort, lsort)
CALL optio(bestdata, lbestdata)

! Calcolo le mappature tra volumi vecchi e volume nuovo
! I puntatori remap* vengono tutti o allocati o nullificati
IF (optio_log(ltimesimple)) THEN
  CALL vol7d_remap2simple_datetime(this%time, that%time, v7dtmp%time, &
   lsort, remapt1, remapt2)
ELSE
  CALL vol7d_remap2_datetime(this%time, that%time, v7dtmp%time, &
   lsort, remapt1, remapt2)
ENDIF
IF (optio_log(ltimerangesimple)) THEN
  CALL vol7d_remap2simple_vol7d_timerange(this%timerange, that%timerange, &
   v7dtmp%timerange, lsort, remaptr1, remaptr2)
ELSE
  CALL vol7d_remap2_vol7d_timerange(this%timerange, that%timerange, &
   v7dtmp%timerange, lsort, remaptr1, remaptr2)
ENDIF
IF (optio_log(llevelsimple)) THEN
  CALL vol7d_remap2simple_vol7d_level(this%level, that%level, v7dtmp%level, &
   lsort, remapl1, remapl2)
ELSE
  CALL vol7d_remap2_vol7d_level(this%level, that%level, v7dtmp%level, &
   lsort, remapl1, remapl2)
ENDIF
IF (optio_log(lanasimple)) THEN
  CALL vol7d_remap2simple_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
   .false., remapa1, remapa2)
ELSE
  CALL vol7d_remap2_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
   .false., remapa1, remapa2)
ENDIF
IF (optio_log(lnetworksimple)) THEN
  CALL vol7d_remap2simple_vol7d_network(this%network, that%network, v7dtmp%network, &
   .false., remapn1, remapn2)
ELSE
  CALL vol7d_remap2_vol7d_network(this%network, that%network, v7dtmp%network, &
   .false., remapn1, remapn2)
ENDIF

! Faccio la fusione fisica dei volumi
CALL vol7d_merge_finalr(this, that, v7dtmp, &
 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
CALL vol7d_merge_finald(this, that, v7dtmp, &
 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
CALL vol7d_merge_finali(this, that, v7dtmp, &
 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
CALL vol7d_merge_finalb(this, that, v7dtmp, &
 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
CALL vol7d_merge_finalc(this, that, v7dtmp, &
 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
 remaptr1, remaptr2, remapn1, remapn2, lbestdata)

! Dealloco i vettori di rimappatura
IF (ASSOCIATED(remapt1)) DEALLOCATE(remapt1)
IF (ASSOCIATED(remapt2)) DEALLOCATE(remapt2)
IF (ASSOCIATED(remaptr1)) DEALLOCATE(remaptr1)
IF (ASSOCIATED(remaptr2)) DEALLOCATE(remaptr2)
IF (ASSOCIATED(remapl1)) DEALLOCATE(remapl1)
IF (ASSOCIATED(remapl2)) DEALLOCATE(remapl2)
IF (ASSOCIATED(remapa1)) DEALLOCATE(remapa1)
IF (ASSOCIATED(remapa2)) DEALLOCATE(remapa2)
IF (ASSOCIATED(remapn1)) DEALLOCATE(remapn1)
IF (ASSOCIATED(remapn2)) DEALLOCATE(remapn2)

! Distruggo il vecchio volume e assegno il nuovo a this
CALL delete(this)
this = v7dtmp
! Ricreo gli indici var-attr
CALL vol7d_set_attr_ind(this)

END SUBROUTINE vol7d_append


SUBROUTINE vol7d_copy(this, that, sort, unique, miss, &
 lsort_time, lsort_timerange, lsort_level, &
 ltime, ltimerange, llevel, lana, lnetwork, &
 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
TYPE(vol7d),INTENT(IN) :: this
TYPE(vol7d),INTENT(INOUT) :: that
LOGICAL,INTENT(IN),OPTIONAL :: sort
LOGICAL,INTENT(IN),OPTIONAL :: unique
LOGICAL,INTENT(IN),OPTIONAL :: miss
LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
LOGICAL,INTENT(in),OPTIONAL :: &
 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)

LOGICAL :: lsort, lunique, lmiss
INTEGER,POINTER :: remapt(:), remaptr(:), remapl(:), remapa(:), remapn(:)

CALL init(that)
IF (.NOT.c_e(this)) RETURN ! speedup, nothing to do
IF (.NOT.vol7d_check_vol(this)) RETURN ! be safe

CALL optio(sort, lsort)
CALL optio(unique, lunique)
CALL optio(miss, lmiss)

! Calcolo le mappature tra volume vecchio e volume nuovo
! I puntatori remap* vengono tutti o allocati o nullificati
CALL vol7d_remap1_datetime(this%time, that%time, &
 lsort.OR.optio_log(lsort_time), lunique, lmiss, remapt, ltime)
CALL vol7d_remap1_vol7d_timerange(this%timerange, that%timerange, &
 lsort.OR.optio_log(lsort_timerange), lunique, lmiss, remaptr, ltimerange)
CALL vol7d_remap1_vol7d_level(this%level, that%level, &
 lsort.OR.optio_log(lsort_level), lunique, lmiss, remapl, llevel)
CALL vol7d_remap1_vol7d_ana(this%ana, that%ana, &
 lsort, lunique, lmiss, remapa, lana)
CALL vol7d_remap1_vol7d_network(this%network, that%network, &
 lsort, lunique, lmiss, remapn, lnetwork)

! lanavari, lanavarb, lanavarc, &
! lanaattri, lanaattrb, lanaattrc, &
! lanavarattri, lanavarattrb, lanavarattrc, &
! ldativari, ldativarb, ldativarc, &
! ldatiattri, ldatiattrb, ldatiattrc, &
! ldativarattri, ldativarattrb, ldativarattrc
! Faccio la riforma fisica dei volumi
CALL vol7d_reform_finalr(this, that, &
 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
 lanavarr, lanaattrr, lanavarattrr, ldativarr, ldatiattrr, ldativarattrr)
CALL vol7d_reform_finald(this, that, &
 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
 lanavard, lanaattrd, lanavarattrd, ldativard, ldatiattrd, ldativarattrd)
CALL vol7d_reform_finali(this, that, &
 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
 lanavari, lanaattri, lanavarattri, ldativari, ldatiattri, ldativarattri)
CALL vol7d_reform_finalb(this, that, &
 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
 lanavarb, lanaattrb, lanavarattrb, ldativarb, ldatiattrb, ldativarattrb)
CALL vol7d_reform_finalc(this, that, &
 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
 lanavarc, lanaattrc, lanavarattrc, ldativarc, ldatiattrc, ldativarattrc)

! Dealloco i vettori di rimappatura
IF (ASSOCIATED(remapt)) DEALLOCATE(remapt)
IF (ASSOCIATED(remaptr)) DEALLOCATE(remaptr)
IF (ASSOCIATED(remapl)) DEALLOCATE(remapl)
IF (ASSOCIATED(remapa)) DEALLOCATE(remapa)
IF (ASSOCIATED(remapn)) DEALLOCATE(remapn)

! Ricreo gli indici var-attr
CALL vol7d_set_attr_ind(that)
that%time_definition = this%time_definition

END SUBROUTINE vol7d_copy


SUBROUTINE vol7d_reform(this, sort, unique, miss, &
 lsort_time, lsort_timerange, lsort_level, &
 ltime, ltimerange, llevel, lana, lnetwork, &
 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc&
 ,purgeana)
TYPE(vol7d),INTENT(INOUT) :: this
LOGICAL,INTENT(IN),OPTIONAL :: sort
LOGICAL,INTENT(IN),OPTIONAL :: unique
LOGICAL,INTENT(IN),OPTIONAL :: miss
LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
LOGICAL,INTENT(in),OPTIONAL :: &
 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
LOGICAL,INTENT(IN),OPTIONAL :: purgeana

TYPE(vol7d) :: v7dtmp
logical,allocatable :: llana(:)
integer :: i

CALL vol7d_copy(this, v7dtmp, sort, unique, miss, &
 lsort_time, lsort_timerange, lsort_level, &
 ltime, ltimerange, llevel, lana, lnetwork, &
 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)

! destroy old volume
CALL delete(this)

if (optio_log(purgeana)) then
  allocate(llana(size(v7dtmp%ana)))
  llana =.false.
  do i =1,size(v7dtmp%ana)
    if (associated(v7dtmp%voldatii)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatii(i,:,:,:,:,:)))
    if (associated(v7dtmp%voldatir)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatir(i,:,:,:,:,:)))
    if (associated(v7dtmp%voldatid)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatid(i,:,:,:,:,:)))
    if (associated(v7dtmp%voldatib)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatib(i,:,:,:,:,:)))
    if (associated(v7dtmp%voldatic)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatic(i,:,:,:,:,:)))
  end do
  CALL vol7d_copy(v7dtmp, this,lana=llana)
  CALL delete(v7dtmp)
  deallocate(llana)
else
  this=v7dtmp
end if

END SUBROUTINE vol7d_reform


SUBROUTINE vol7d_smart_sort(this, lsort_time, lsort_timerange, lsort_level)
TYPE(vol7d),INTENT(INOUT) :: this
LOGICAL,OPTIONAL,INTENT(in) :: lsort_time
LOGICAL,OPTIONAL,INTENT(in) :: lsort_timerange
LOGICAL,OPTIONAL,INTENT(in) :: lsort_level

INTEGER :: i
LOGICAL :: to_be_sorted

to_be_sorted = .false.
CALL vol7d_alloc_vol(this) ! usual safety check

IF (optio_log(lsort_time)) THEN
  DO i = 2, SIZE(this%time)
    IF (this%time(i) < this%time(i-1)) THEN
      to_be_sorted = .true.
      EXIT
    ENDIF
  ENDDO
ENDIF
IF (optio_log(lsort_timerange)) THEN
  DO i = 2, SIZE(this%timerange)
    IF (this%timerange(i) < this%timerange(i-1)) THEN
      to_be_sorted = .true.
      EXIT
    ENDIF
  ENDDO
ENDIF
IF (optio_log(lsort_level)) THEN
  DO i = 2, SIZE(this%level)
    IF (this%level(i) < this%level(i-1)) THEN
      to_be_sorted = .true.
      EXIT
    ENDIF
  ENDDO
ENDIF

IF (to_be_sorted) CALL vol7d_reform(this, &
 lsort_time=lsort_time, lsort_timerange=lsort_timerange, lsort_level=lsort_level )

END SUBROUTINE vol7d_smart_sort

SUBROUTINE vol7d_filter(this, avl, vl, nl, s_d, e_d)
TYPE(vol7d),INTENT(inout) :: this
CHARACTER(len=*),INTENT(in),OPTIONAL :: avl(:)
CHARACTER(len=*),INTENT(in),OPTIONAL :: vl(:)
TYPE(vol7d_network),OPTIONAL :: nl(:)
TYPE(datetime),INTENT(in),OPTIONAL :: s_d
TYPE(datetime),INTENT(in),OPTIONAL :: e_d

INTEGER :: i

IF (PRESENT(avl)) THEN
  IF (SIZE(avl) > 0) THEN

    IF (ASSOCIATED(this%anavar%r)) THEN
      DO i = 1, SIZE(this%anavar%r)
        IF (all(this%anavar%r(i)%btable /= avl)) this%anavar%r(i) = vol7d_var_miss
      ENDDO
    ENDIF

    IF (ASSOCIATED(this%anavar%i)) THEN
      DO i = 1, SIZE(this%anavar%i)
        IF (all(this%anavar%i(i)%btable /= avl)) this%anavar%i(i) = vol7d_var_miss
      ENDDO
    ENDIF

    IF (ASSOCIATED(this%anavar%b)) THEN
      DO i = 1, SIZE(this%anavar%b)
        IF (all(this%anavar%b(i)%btable /= avl)) this%anavar%b(i) = vol7d_var_miss
      ENDDO
    ENDIF

    IF (ASSOCIATED(this%anavar%d)) THEN
      DO i = 1, SIZE(this%anavar%d)
        IF (all(this%anavar%d(i)%btable /= avl)) this%anavar%d(i) = vol7d_var_miss
      ENDDO
    ENDIF

    IF (ASSOCIATED(this%anavar%c)) THEN
      DO i = 1, SIZE(this%anavar%c)
        IF (all(this%anavar%c(i)%btable /= avl)) this%anavar%c(i) = vol7d_var_miss
      ENDDO
    ENDIF

  ENDIF
ENDIF


IF (PRESENT(vl)) THEN
  IF (size(vl) > 0) THEN
    IF (ASSOCIATED(this%dativar%r)) THEN
      DO i = 1, SIZE(this%dativar%r)
        IF (all(this%dativar%r(i)%btable /= vl)) this%dativar%r(i) = vol7d_var_miss
      ENDDO
    ENDIF

    IF (ASSOCIATED(this%dativar%i)) THEN
      DO i = 1, SIZE(this%dativar%i)
        IF (all(this%dativar%i(i)%btable /= vl)) this%dativar%i(i) = vol7d_var_miss
      ENDDO
    ENDIF

    IF (ASSOCIATED(this%dativar%b)) THEN
      DO i = 1, SIZE(this%dativar%b)
        IF (all(this%dativar%b(i)%btable /= vl)) this%dativar%b(i) = vol7d_var_miss
      ENDDO
    ENDIF

    IF (ASSOCIATED(this%dativar%d)) THEN
      DO i = 1, SIZE(this%dativar%d)
        IF (all(this%dativar%d(i)%btable /= vl)) this%dativar%d(i) = vol7d_var_miss
      ENDDO
    ENDIF

    IF (ASSOCIATED(this%dativar%c)) THEN
      DO i = 1, SIZE(this%dativar%c)
        IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
      ENDDO
    ENDIF

    IF (ASSOCIATED(this%dativar%c)) THEN
      DO i = 1, SIZE(this%dativar%c)
        IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
      ENDDO
    ENDIF

  ENDIF
ENDIF

IF (PRESENT(nl)) THEN
  IF (SIZE(nl) > 0) THEN
    DO i = 1, SIZE(this%network)
      IF (all(this%network(i) /= nl)) this%network(i) = vol7d_network_miss
    ENDDO
  ENDIF
ENDIF

IF (PRESENT(s_d)) THEN
  IF (c_e(s_d)) THEN
    WHERE (this%time < s_d)
      this%time = datetime_miss
    END WHERE
  ENDIF
ENDIF

IF (PRESENT(e_d)) THEN
  IF (c_e(e_d)) THEN
    WHERE (this%time > e_d)
      this%time = datetime_miss
    END WHERE
  ENDIF
ENDIF

CALL vol7d_reform(this, miss=.true.)

END SUBROUTINE vol7d_filter


SUBROUTINE vol7d_convr(this, that, anaconv)
TYPE(vol7d),INTENT(IN) :: this
TYPE(vol7d),INTENT(INOUT) :: that
LOGICAL,OPTIONAL,INTENT(in) :: anaconv
INTEGER :: i
LOGICAL :: fv(1)=(/.false./), tv(1)=(/.true./), acp(1), acn(1)
TYPE(vol7d) :: v7d_tmp

IF (optio_log(anaconv)) THEN
  acp=fv
  acn=tv
ELSE
  acp=tv
  acn=fv
ENDIF

! Volume con solo i dati reali e tutti gli attributi
! l'anagrafica e` copiata interamente se necessario
CALL vol7d_copy(this, that, &
 lanavarr=tv, lanavard=acp, lanavari=acp, lanavarb=acp, lanavarc=acp, &
 ldativarr=tv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=fv)

! Volume solo di dati double
CALL vol7d_copy(this, v7d_tmp, &
 lanavarr=fv, lanavard=acn, lanavari=fv, lanavarb=fv, lanavarc=fv, &
 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
 ldativarr=fv, ldativard=tv, ldativari=fv, ldativarb=fv, ldativarc=fv, &
 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)

! converto a dati reali
IF (ASSOCIATED(v7d_tmp%anavar%d) .OR. ASSOCIATED(v7d_tmp%dativar%d)) THEN

  IF (ASSOCIATED(v7d_tmp%anavar%d)) THEN
! alloco i dati reali e vi trasferisco i double
    ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanad, 1), SIZE(v7d_tmp%volanad, 2), &
     SIZE(v7d_tmp%volanad, 3)))
    DO i = 1, SIZE(v7d_tmp%anavar%d)
      v7d_tmp%volanar(:,i,:) = &
       realdat(v7d_tmp%volanad(:,i,:), v7d_tmp%anavar%d(i))
    ENDDO
    DEALLOCATE(v7d_tmp%volanad)
! trasferisco le variabili
    v7d_tmp%anavar%r => v7d_tmp%anavar%d
    NULLIFY(v7d_tmp%anavar%d)
  ENDIF

  IF (ASSOCIATED(v7d_tmp%dativar%d)) THEN
! alloco i dati reali e vi trasferisco i double
    ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatid, 1), SIZE(v7d_tmp%voldatid, 2), &
     SIZE(v7d_tmp%voldatid, 3), SIZE(v7d_tmp%voldatid, 4), SIZE(v7d_tmp%voldatid, 5), &
     SIZE(v7d_tmp%voldatid, 6)))
    DO i = 1, SIZE(v7d_tmp%dativar%d)
      v7d_tmp%voldatir(:,:,:,:,i,:) = &
       realdat(v7d_tmp%voldatid(:,:,:,:,i,:), v7d_tmp%dativar%d(i))
    ENDDO
    DEALLOCATE(v7d_tmp%voldatid)
! trasferisco le variabili
    v7d_tmp%dativar%r => v7d_tmp%dativar%d
    NULLIFY(v7d_tmp%dativar%d)
  ENDIF

! fondo con il volume definitivo
  CALL vol7d_merge(that, v7d_tmp)
ELSE
  CALL delete(v7d_tmp)
ENDIF


! Volume solo di dati interi
CALL vol7d_copy(this, v7d_tmp, &
 lanavarr=fv, lanavard=fv, lanavari=acn, lanavarb=fv, lanavarc=fv, &
 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
 ldativarr=fv, ldativard=fv, ldativari=tv, ldativarb=fv, ldativarc=fv, &
 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)

! converto a dati reali
IF (ASSOCIATED(v7d_tmp%anavar%i) .OR. ASSOCIATED(v7d_tmp%dativar%i)) THEN

  IF (ASSOCIATED(v7d_tmp%anavar%i)) THEN
! alloco i dati reali e vi trasferisco gli interi
    ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanai, 1), SIZE(v7d_tmp%volanai, 2), &
     SIZE(v7d_tmp%volanai, 3)))
    DO i = 1, SIZE(v7d_tmp%anavar%i)
      v7d_tmp%volanar(:,i,:) = &
       realdat(v7d_tmp%volanai(:,i,:), v7d_tmp%anavar%i(i))
    ENDDO
    DEALLOCATE(v7d_tmp%volanai)
! trasferisco le variabili
    v7d_tmp%anavar%r => v7d_tmp%anavar%i
    NULLIFY(v7d_tmp%anavar%i)
  ENDIF

  IF (ASSOCIATED(v7d_tmp%dativar%i)) THEN
! alloco i dati reali e vi trasferisco gli interi
    ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatii, 1), SIZE(v7d_tmp%voldatii, 2), &
     SIZE(v7d_tmp%voldatii, 3), SIZE(v7d_tmp%voldatii, 4), SIZE(v7d_tmp%voldatii, 5), &
     SIZE(v7d_tmp%voldatii, 6)))
    DO i = 1, SIZE(v7d_tmp%dativar%i)
      v7d_tmp%voldatir(:,:,:,:,i,:) = &
       realdat(v7d_tmp%voldatii(:,:,:,:,i,:), v7d_tmp%dativar%i(i))
    ENDDO
    DEALLOCATE(v7d_tmp%voldatii)
! trasferisco le variabili
    v7d_tmp%dativar%r => v7d_tmp%dativar%i
    NULLIFY(v7d_tmp%dativar%i)
  ENDIF

! fondo con il volume definitivo
  CALL vol7d_merge(that, v7d_tmp)
ELSE
  CALL delete(v7d_tmp)
ENDIF


! Volume solo di dati byte
CALL vol7d_copy(this, v7d_tmp, &
 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=acn, lanavarc=fv, &
 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=tv, ldativarc=fv, &
 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)

! converto a dati reali
IF (ASSOCIATED(v7d_tmp%anavar%b) .OR. ASSOCIATED(v7d_tmp%dativar%b)) THEN

  IF (ASSOCIATED(v7d_tmp%anavar%b)) THEN
! alloco i dati reali e vi trasferisco i byte
    ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanab, 1), SIZE(v7d_tmp%volanab, 2), &
     SIZE(v7d_tmp%volanab, 3)))
    DO i = 1, SIZE(v7d_tmp%anavar%b)
      v7d_tmp%volanar(:,i,:) = &
       realdat(v7d_tmp%volanab(:,i,:), v7d_tmp%anavar%b(i))
    ENDDO
    DEALLOCATE(v7d_tmp%volanab)
! trasferisco le variabili
    v7d_tmp%anavar%r => v7d_tmp%anavar%b
    NULLIFY(v7d_tmp%anavar%b)
  ENDIF

  IF (ASSOCIATED(v7d_tmp%dativar%b)) THEN
! alloco i dati reali e vi trasferisco i byte
    ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatib, 1), SIZE(v7d_tmp%voldatib, 2), &
     SIZE(v7d_tmp%voldatib, 3), SIZE(v7d_tmp%voldatib, 4), SIZE(v7d_tmp%voldatib, 5), &
     SIZE(v7d_tmp%voldatib, 6)))
    DO i = 1, SIZE(v7d_tmp%dativar%b)
      v7d_tmp%voldatir(:,:,:,:,i,:) = &
       realdat(v7d_tmp%voldatib(:,:,:,:,i,:), v7d_tmp%dativar%b(i))
    ENDDO
    DEALLOCATE(v7d_tmp%voldatib)
! trasferisco le variabili
    v7d_tmp%dativar%r => v7d_tmp%dativar%b
    NULLIFY(v7d_tmp%dativar%b)
  ENDIF

! fondo con il volume definitivo
  CALL vol7d_merge(that, v7d_tmp)
ELSE
  CALL delete(v7d_tmp)
ENDIF


! Volume solo di dati character
CALL vol7d_copy(this, v7d_tmp, &
 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=fv, lanavarc=acn, &
 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=tv, &
 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)

! converto a dati reali
IF (ASSOCIATED(v7d_tmp%anavar%c) .OR. ASSOCIATED(v7d_tmp%dativar%c)) THEN

  IF (ASSOCIATED(v7d_tmp%anavar%c)) THEN
! alloco i dati reali e vi trasferisco i character
    ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanac, 1), SIZE(v7d_tmp%volanac, 2), &
     SIZE(v7d_tmp%volanac, 3)))
    DO i = 1, SIZE(v7d_tmp%anavar%c)
      v7d_tmp%volanar(:,i,:) = &
       realdat(v7d_tmp%volanac(:,i,:), v7d_tmp%anavar%c(i))
    ENDDO
    DEALLOCATE(v7d_tmp%volanac)
! trasferisco le variabili
    v7d_tmp%anavar%r => v7d_tmp%anavar%c
    NULLIFY(v7d_tmp%anavar%c)
  ENDIF

  IF (ASSOCIATED(v7d_tmp%dativar%c)) THEN
! alloco i dati reali e vi trasferisco i character
    ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatic, 1), SIZE(v7d_tmp%voldatic, 2), &
     SIZE(v7d_tmp%voldatic, 3), SIZE(v7d_tmp%voldatic, 4), SIZE(v7d_tmp%voldatic, 5), &
     SIZE(v7d_tmp%voldatic, 6)))
    DO i = 1, SIZE(v7d_tmp%dativar%c)
      v7d_tmp%voldatir(:,:,:,:,i,:) = &
       realdat(v7d_tmp%voldatic(:,:,:,:,i,:), v7d_tmp%dativar%c(i))
    ENDDO
    DEALLOCATE(v7d_tmp%voldatic)
! trasferisco le variabili
    v7d_tmp%dativar%r => v7d_tmp%dativar%c
    NULLIFY(v7d_tmp%dativar%c)
  ENDIF

! fondo con il volume definitivo
  CALL vol7d_merge(that, v7d_tmp)
ELSE
  CALL delete(v7d_tmp)
ENDIF

END SUBROUTINE vol7d_convr


SUBROUTINE vol7d_diff_only (this, that, data_only,ana)
TYPE(vol7d),INTENT(IN) :: this
TYPE(vol7d),INTENT(OUT) :: that
logical , optional, intent(in) :: data_only
logical , optional, intent(in) :: ana
logical  :: ldata_only,lana

IF (PRESENT(data_only)) THEN
  ldata_only = data_only
ELSE
  ldata_only = .false.
ENDIF

IF (PRESENT(ana)) THEN
  lana = ana
ELSE
  lana = .false.
ENDIF


#undef VOL7D_POLY_ARRAY
#define VOL7D_POLY_ARRAY voldati
#include "vol7d_class_diff.F90"
#undef VOL7D_POLY_ARRAY
#define VOL7D_POLY_ARRAY voldatiattr
#include "vol7d_class_diff.F90"
#undef VOL7D_POLY_ARRAY

if ( .not. ldata_only) then

#define VOL7D_POLY_ARRAY volana
#include "vol7d_class_diff.F90"
#undef VOL7D_POLY_ARRAY
#define VOL7D_POLY_ARRAY volanaattr
#include "vol7d_class_diff.F90"
#undef VOL7D_POLY_ARRAY

  if(lana)then
    where ( this%ana == that%ana )
      that%ana = vol7d_ana_miss
    end where
  end if

end if



END SUBROUTINE vol7d_diff_only



! Creo le routine da ripetere per i vari tipi di dati di v7d
! tramite un template e il preprocessore
#undef VOL7D_POLY_TYPE
#undef VOL7D_POLY_TYPES
#define VOL7D_POLY_TYPE REAL
#define VOL7D_POLY_TYPES r
#include "vol7d_class_type_templ.F90"
#undef VOL7D_POLY_TYPE
#undef VOL7D_POLY_TYPES
#define VOL7D_POLY_TYPE DOUBLE PRECISION
#define VOL7D_POLY_TYPES d
#include "vol7d_class_type_templ.F90"
#undef VOL7D_POLY_TYPE
#undef VOL7D_POLY_TYPES
#define VOL7D_POLY_TYPE INTEGER
#define VOL7D_POLY_TYPES i
#include "vol7d_class_type_templ.F90"
#undef VOL7D_POLY_TYPE
#undef VOL7D_POLY_TYPES
#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
#define VOL7D_POLY_TYPES b
#include "vol7d_class_type_templ.F90"
#undef VOL7D_POLY_TYPE
#undef VOL7D_POLY_TYPES
#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
#define VOL7D_POLY_TYPES c
#include "vol7d_class_type_templ.F90"

! Creo le routine da ripetere per i vari descrittori di dimensioni di v7d
! tramite un template e il preprocessore
#define VOL7D_SORT
#undef VOL7D_NO_ZERO_ALLOC
#undef VOL7D_POLY_TYPE
#define VOL7D_POLY_TYPE datetime
#include "vol7d_class_desc_templ.F90"
#undef VOL7D_POLY_TYPE
#define VOL7D_POLY_TYPE vol7d_timerange
#include "vol7d_class_desc_templ.F90"
#undef VOL7D_POLY_TYPE
#define VOL7D_POLY_TYPE vol7d_level
#include "vol7d_class_desc_templ.F90"
#undef VOL7D_SORT
#undef VOL7D_POLY_TYPE
#define VOL7D_POLY_TYPE vol7d_network
#include "vol7d_class_desc_templ.F90"
#undef VOL7D_POLY_TYPE
#define VOL7D_POLY_TYPE vol7d_ana
#include "vol7d_class_desc_templ.F90"
#define VOL7D_NO_ZERO_ALLOC
#undef VOL7D_POLY_TYPE
#define VOL7D_POLY_TYPE vol7d_var
#include "vol7d_class_desc_templ.F90"

subroutine vol7d_write_on_file (this,unit,description,filename,filename_auto)

TYPE(vol7d),INTENT(IN) :: this
integer,optional,intent(inout) :: unit
character(len=*),intent(in),optional :: filename
character(len=*),intent(out),optional :: filename_auto
character(len=*),INTENT(IN),optional :: description

integer :: lunit
character(len=254) :: ldescription,arg,lfilename
integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
!integer :: im,id,iy
integer :: tarray(8)
logical :: opened,exist

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


!call idate(im,id,iy)
call date_and_time(values=tarray)
call getarg(0,arg)

if (present(description))then
  ldescription=description
else
  ldescription="Vol7d generated by: "//trim(arg)
end if

if (.not. present(unit))then
  lunit=getunit()
else
  if (unit==0)then
    lunit=getunit()
    unit=lunit
  else
    lunit=unit
  end if
end if

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

if (present(filename))then
  if (filename /= "")then
    lfilename=filename
  end if
end if

if (present(filename_auto))filename_auto=lfilename


inquire(unit=lunit,opened=opened)
if (.not. opened) then 
!  inquire(file=lfilename, EXIST=exist)
!  IF (exist) THEN
!    CALL l4f_log(L4F_FATAL, &
!     'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename))
!    CALL raise_fatal_error()
!  ENDIF
  OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM')
  CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
end if

if (associated(this%ana)) nana=size(this%ana)
if (associated(this%time)) ntime=size(this%time)
if (associated(this%timerange)) ntimerange=size(this%timerange)
if (associated(this%level)) nlevel=size(this%level)
if (associated(this%network)) nnetwork=size(this%network)

if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)

if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)

if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
 
if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)

if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)

if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)

write(unit=lunit)ldescription
write(unit=lunit)tarray

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


!write(unit=lunit)this


!! prime 5 dimensioni
if (associated(this%ana))       call write_unit(this%ana, lunit)
if (associated(this%time))      call write_unit(this%time, lunit)
if (associated(this%level))     write(unit=lunit)this%level
if (associated(this%timerange)) write(unit=lunit)this%timerange
if (associated(this%network))   write(unit=lunit)this%network

  !! 6a dimensione: variabile dell'anagrafica e dei dati
  !! con relativi attributi e in 5 tipi diversi

if (associated(this%anavar%r))      write(unit=lunit)this%anavar%r    
if (associated(this%anavar%i))      write(unit=lunit)this%anavar%i    
if (associated(this%anavar%b))      write(unit=lunit)this%anavar%b    
if (associated(this%anavar%d))      write(unit=lunit)this%anavar%d    
if (associated(this%anavar%c))      write(unit=lunit)this%anavar%c    

if (associated(this%anaattr%r))     write(unit=lunit)this%anaattr%r
if (associated(this%anaattr%i))     write(unit=lunit)this%anaattr%i
if (associated(this%anaattr%b))     write(unit=lunit)this%anaattr%b
if (associated(this%anaattr%d))     write(unit=lunit)this%anaattr%d
if (associated(this%anaattr%c))     write(unit=lunit)this%anaattr%c

if (associated(this%anavarattr%r))  write(unit=lunit)this%anavarattr%r
if (associated(this%anavarattr%i))  write(unit=lunit)this%anavarattr%i
if (associated(this%anavarattr%b))  write(unit=lunit)this%anavarattr%b
if (associated(this%anavarattr%d))  write(unit=lunit)this%anavarattr%d
if (associated(this%anavarattr%c))  write(unit=lunit)this%anavarattr%c

if (associated(this%dativar%r))     write(unit=lunit)this%dativar%r
if (associated(this%dativar%i))     write(unit=lunit)this%dativar%i
if (associated(this%dativar%b))     write(unit=lunit)this%dativar%b
if (associated(this%dativar%d))     write(unit=lunit)this%dativar%d
if (associated(this%dativar%c))     write(unit=lunit)this%dativar%c

if (associated(this%datiattr%r))    write(unit=lunit)this%datiattr%r
if (associated(this%datiattr%i))    write(unit=lunit)this%datiattr%i
if (associated(this%datiattr%b))    write(unit=lunit)this%datiattr%b
if (associated(this%datiattr%d))    write(unit=lunit)this%datiattr%d
if (associated(this%datiattr%c))    write(unit=lunit)this%datiattr%c

if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c

!! Volumi di valori e attributi per anagrafica e dati

if (associated(this%volanar))      write(unit=lunit)this%volanar
if (associated(this%volanaattrr))  write(unit=lunit)this%volanaattrr
if (associated(this%voldatir))     write(unit=lunit)this%voldatir
if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr

if (associated(this%volanai))      write(unit=lunit)this%volanai
if (associated(this%volanaattri))  write(unit=lunit)this%volanaattri
if (associated(this%voldatii))     write(unit=lunit)this%voldatii
if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri

if (associated(this%volanab))      write(unit=lunit)this%volanab
if (associated(this%volanaattrb))  write(unit=lunit)this%volanaattrb
if (associated(this%voldatib))     write(unit=lunit)this%voldatib
if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb

if (associated(this%volanad))      write(unit=lunit)this%volanad
if (associated(this%volanaattrd))  write(unit=lunit)this%volanaattrd
if (associated(this%voldatid))     write(unit=lunit)this%voldatid
if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd

if (associated(this%volanac))      write(unit=lunit)this%volanac
if (associated(this%volanaattrc))  write(unit=lunit)this%volanaattrc
if (associated(this%voldatic))     write(unit=lunit)this%voldatic
if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc

if (.not. present(unit)) close(unit=lunit)

end subroutine vol7d_write_on_file




subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)

TYPE(vol7d),INTENT(OUT) :: this
integer,intent(inout),optional :: unit
character(len=*),INTENT(in),optional :: filename
character(len=*),intent(out),optional :: filename_auto
character(len=*),INTENT(out),optional :: description
integer,intent(out),optional :: tarray(8)


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

character(len=254) :: ldescription,lfilename,arg
integer :: ltarray(8),lunit,ios
logical :: opened,exist


call getarg(0,arg)

if (.not. present(unit))then
  lunit=getunit()
else
  if (unit==0)then
    lunit=getunit()
    unit=lunit
  else
    lunit=unit
  end if
end if

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

if (present(filename))then
  if (filename /= "")then
    lfilename=filename
  end if
end if

if (present(filename_auto))filename_auto=lfilename


inquire(unit=lunit,opened=opened)
IF (.NOT. opened) THEN 
  inquire(file=lfilename,exist=exist)
  IF (.NOT.exist) THEN
    CALL l4f_log(l4f_fatal, &
     'in vol7d_read_from_file, file does not exists, cannot open')
    CALL raise_fatal_error()
  ENDIF
  OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM', &
   status='OLD', action='READ')
  CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
end if


call init(this)
read(unit=lunit,iostat=ios)ldescription

if (ios < 0) then   !  A negative value indicates that the End of File or End of Record
  call vol7d_alloc (this)
  call vol7d_alloc_vol (this)
  if (present(description))description=ldescription
  if (present(tarray))tarray=ltarray
  if (.not. present(unit)) close(unit=lunit)
end if

read(unit=lunit)ltarray

CALL l4f_log(l4f_info, 'Reading vol7d from file')
CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
CALL l4f_log(l4f_info, 'written on '//trim(to_char(ltarray(1)))//' '// &
 trim(to_char(ltarray(2)))//' '//trim(to_char(ltarray(3))))

if (present(description))description=ldescription
if (present(tarray))tarray=ltarray

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

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)


if (associated(this%ana))       call read_unit(this%ana, lunit)
if (associated(this%time))      call read_unit(this%time, lunit)
if (associated(this%level))     read(unit=lunit)this%level
if (associated(this%timerange)) read(unit=lunit)this%timerange
if (associated(this%network))   read(unit=lunit)this%network

if (associated(this%anavar%r))      read(unit=lunit)this%anavar%r    
if (associated(this%anavar%i))      read(unit=lunit)this%anavar%i    
if (associated(this%anavar%b))      read(unit=lunit)this%anavar%b    
if (associated(this%anavar%d))      read(unit=lunit)this%anavar%d    
if (associated(this%anavar%c))      read(unit=lunit)this%anavar%c    

if (associated(this%anaattr%r))     read(unit=lunit)this%anaattr%r
if (associated(this%anaattr%i))     read(unit=lunit)this%anaattr%i
if (associated(this%anaattr%b))     read(unit=lunit)this%anaattr%b
if (associated(this%anaattr%d))     read(unit=lunit)this%anaattr%d
if (associated(this%anaattr%c))     read(unit=lunit)this%anaattr%c

if (associated(this%anavarattr%r))  read(unit=lunit)this%anavarattr%r
if (associated(this%anavarattr%i))  read(unit=lunit)this%anavarattr%i
if (associated(this%anavarattr%b))  read(unit=lunit)this%anavarattr%b
if (associated(this%anavarattr%d))  read(unit=lunit)this%anavarattr%d
if (associated(this%anavarattr%c))  read(unit=lunit)this%anavarattr%c

if (associated(this%dativar%r))     read(unit=lunit)this%dativar%r
if (associated(this%dativar%i))     read(unit=lunit)this%dativar%i
if (associated(this%dativar%b))     read(unit=lunit)this%dativar%b
if (associated(this%dativar%d))     read(unit=lunit)this%dativar%d
if (associated(this%dativar%c))     read(unit=lunit)this%dativar%c

if (associated(this%datiattr%r))    read(unit=lunit)this%datiattr%r
if (associated(this%datiattr%i))    read(unit=lunit)this%datiattr%i
if (associated(this%datiattr%b))    read(unit=lunit)this%datiattr%b
if (associated(this%datiattr%d))    read(unit=lunit)this%datiattr%d
if (associated(this%datiattr%c))    read(unit=lunit)this%datiattr%c

if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c

call vol7d_alloc_vol (this)

!! Volumi di valori e attributi per anagrafica e dati

if (associated(this%volanar))      read(unit=lunit)this%volanar
if (associated(this%volanaattrr))  read(unit=lunit)this%volanaattrr
if (associated(this%voldatir))     read(unit=lunit)this%voldatir
if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr

if (associated(this%volanai))      read(unit=lunit)this%volanai
if (associated(this%volanaattri))  read(unit=lunit)this%volanaattri
if (associated(this%voldatii))     read(unit=lunit)this%voldatii
if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri

if (associated(this%volanab))      read(unit=lunit)this%volanab
if (associated(this%volanaattrb))  read(unit=lunit)this%volanaattrb
if (associated(this%voldatib))     read(unit=lunit)this%voldatib
if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb

if (associated(this%volanad))      read(unit=lunit)this%volanad
if (associated(this%volanaattrd))  read(unit=lunit)this%volanaattrd
if (associated(this%voldatid))     read(unit=lunit)this%voldatid
if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd

if (associated(this%volanac))      read(unit=lunit)this%volanac
if (associated(this%volanaattrc))  read(unit=lunit)this%volanaattrc
if (associated(this%voldatic))     read(unit=lunit)this%voldatic
if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc

if (.not. present(unit)) close(unit=lunit)

end subroutine vol7d_read_from_file


! to double precision
elemental doubleprecision function doubledatd(voldat,var)
doubleprecision,intent(in) :: voldat
type(vol7d_var),intent(in) :: var

doubledatd=voldat

end function doubledatd


elemental doubleprecision function doubledatr(voldat,var)
real,intent(in) :: voldat
type(vol7d_var),intent(in) :: var

if (c_e(voldat))then
  doubledatr=dble(voldat)
else
  doubledatr=dmiss
end if

end function doubledatr


elemental doubleprecision function doubledati(voldat,var)
integer,intent(in) :: voldat
type(vol7d_var),intent(in) :: var

if (c_e(voldat)) then
  if (c_e(var%scalefactor))then
    doubledati=dble(voldat)/10.d0**var%scalefactor
  else
    doubledati=dble(voldat)
  endif
else
  doubledati=dmiss
end if

end function doubledati


elemental doubleprecision function doubledatb(voldat,var)
integer(kind=int_b),intent(in) :: voldat
type(vol7d_var),intent(in) :: var

if (c_e(voldat)) then
  if (c_e(var%scalefactor))then
    doubledatb=dble(voldat)/10.d0**var%scalefactor
  else
    doubledatb=dble(voldat)
  endif
else
  doubledatb=dmiss
end if

end function doubledatb


elemental doubleprecision function doubledatc(voldat,var)
CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
type(vol7d_var),intent(in) :: var

doubledatc = c2d(voldat)
if (c_e(doubledatc) .and. c_e(var%scalefactor))then
  doubledatc=doubledatc/10.d0**var%scalefactor
end if

end function doubledatc


! to integer
elemental integer function integerdatd(voldat,var)
doubleprecision,intent(in) :: voldat
type(vol7d_var),intent(in) :: var

if (c_e(voldat))then
  if (c_e(var%scalefactor)) then
    integerdatd=nint(voldat*10d0**var%scalefactor)
  else
    integerdatd=nint(voldat)
  endif
else
  integerdatd=imiss
end if

end function integerdatd


elemental integer function integerdatr(voldat,var)
real,intent(in) :: voldat
type(vol7d_var),intent(in) :: var

if (c_e(voldat))then
  if (c_e(var%scalefactor)) then
    integerdatr=nint(voldat*10d0**var%scalefactor)
  else
    integerdatr=nint(voldat)
  endif
else
  integerdatr=imiss
end if

end function integerdatr


elemental integer function integerdati(voldat,var)
integer,intent(in) :: voldat
type(vol7d_var),intent(in) :: var

integerdati=voldat

end function integerdati


elemental integer function integerdatb(voldat,var)
integer(kind=int_b),intent(in) :: voldat
type(vol7d_var),intent(in) :: var

if (c_e(voldat))then
  integerdatb=voldat
else
  integerdatb=imiss
end if

end function integerdatb


elemental integer function integerdatc(voldat,var)
CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
type(vol7d_var),intent(in) :: var

integerdatc=c2i(voldat)

end function integerdatc


! to real
elemental real function realdatd(voldat,var)
doubleprecision,intent(in) :: voldat
type(vol7d_var),intent(in) :: var

if (c_e(voldat))then
  realdatd=real(voldat)
else
  realdatd=rmiss
end if

end function realdatd


elemental real function realdatr(voldat,var)
real,intent(in) :: voldat
type(vol7d_var),intent(in) :: var

realdatr=voldat

end function realdatr


elemental real function realdati(voldat,var)
integer,intent(in) :: voldat
type(vol7d_var),intent(in) :: var

if (c_e(voldat)) then
  if (c_e(var%scalefactor))then
    realdati=float(voldat)/10.**var%scalefactor
  else
    realdati=float(voldat)
  endif
else
  realdati=rmiss
end if

end function realdati


elemental real function realdatb(voldat,var)
integer(kind=int_b),intent(in) :: voldat
type(vol7d_var),intent(in) :: var

if (c_e(voldat)) then
  if (c_e(var%scalefactor))then
    realdatb=float(voldat)/10**var%scalefactor
  else
    realdatb=float(voldat)
  endif
else
  realdatb=rmiss
end if

end function realdatb


elemental real function realdatc(voldat,var)
CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
type(vol7d_var),intent(in) :: var

realdatc=c2r(voldat)
if (c_e(realdatc) .and. c_e(var%scalefactor))then
  realdatc=realdatc/10.**var%scalefactor
end if

end function realdatc


FUNCTION realanavol(this, var) RESULT(vol)
TYPE(vol7d),INTENT(in) :: this
TYPE(vol7d_var),INTENT(in) :: var
REAL :: vol(SIZE(this%ana),size(this%network))

CHARACTER(len=1) :: dtype
INTEGER :: indvar

dtype = cmiss
indvar = index(this%anavar, var, type=dtype)

IF (indvar > 0) THEN
  SELECT CASE (dtype)
  CASE("d")
    vol = realdat(this%volanad(:,indvar,:), var)
  CASE("r")
    vol = this%volanar(:,indvar,:)
  CASE("i")
    vol = realdat(this%volanai(:,indvar,:), var)
  CASE("b")
    vol = realdat(this%volanab(:,indvar,:), var)
  CASE("c")
    vol = realdat(this%volanac(:,indvar,:), var)
  CASE default
    vol = rmiss
  END SELECT
ELSE
  vol = rmiss
ENDIF

END FUNCTION realanavol


FUNCTION integeranavol(this, var) RESULT(vol)
TYPE(vol7d),INTENT(in) :: this
TYPE(vol7d_var),INTENT(in) :: var
INTEGER :: vol(SIZE(this%ana),size(this%network))

CHARACTER(len=1) :: dtype
INTEGER :: indvar

dtype = cmiss
indvar = index(this%anavar, var, type=dtype)

IF (indvar > 0) THEN
  SELECT CASE (dtype)
  CASE("d")
    vol = integerdat(this%volanad(:,indvar,:), var)
  CASE("r")
    vol = integerdat(this%volanar(:,indvar,:), var)
  CASE("i")
    vol = this%volanai(:,indvar,:)
  CASE("b")
    vol = integerdat(this%volanab(:,indvar,:), var)
  CASE("c")
    vol = integerdat(this%volanac(:,indvar,:), var)
  CASE default
    vol = imiss
  END SELECT
ELSE
  vol = imiss
ENDIF

END FUNCTION integeranavol


subroutine move_datac (v7d,&
 indana,indtime,indlevel,indtimerange,indnetwork,&
 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)

TYPE(vol7d),intent(inout) :: v7d

integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
integer :: inddativar,inddativarattr


do inddativar=1,size(v7d%dativar%c)

  if (c_e(v7d%voldatic(indana,indtime,indlevel,indtimerange,inddativar,indnetwork)) .and. &
    .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
   ) then

                                ! dati
    v7d%voldatic &
     (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
     v7d%voldatic &
     (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)


                                ! attributi
    if (associated (v7d%dativarattr%i)) then
      inddativarattr  = index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
      if (inddativarattr > 0 ) then
        v7d%voldatiattri &
         (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
         v7d%voldatiattri &
         (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
      end if
    end if

    if (associated (v7d%dativarattr%r)) then
      inddativarattr  = index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
      if (inddativarattr > 0 ) then
        v7d%voldatiattrr &
         (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
         v7d%voldatiattrr &
         (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
      end if
    end if

    if (associated (v7d%dativarattr%d)) then
      inddativarattr  = index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
      if (inddativarattr > 0 ) then
        v7d%voldatiattrd &
         (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
         v7d%voldatiattrd &
         (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
      end if
    end if

    if (associated (v7d%dativarattr%b)) then
      inddativarattr  = index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
      if (inddativarattr > 0 ) then
        v7d%voldatiattrb &
         (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
         v7d%voldatiattrb &
         (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
      end if
    end if

    if (associated (v7d%dativarattr%c)) then
      inddativarattr  = index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
      if (inddativarattr > 0 ) then
        v7d%voldatiattrc &
         (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
         v7d%voldatiattrc &
         (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
      end if
    end if

  end if

end do

end subroutine move_datac

subroutine move_datar (v7d,&
 indana,indtime,indlevel,indtimerange,indnetwork,&
 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)

TYPE(vol7d),intent(inout) :: v7d

integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
integer :: inddativar,inddativarattr


do inddativar=1,size(v7d%dativar%r)

  if (c_e(v7d%voldatir(indana,indtime,indlevel,indtimerange,inddativar,indnetwork)) .and. &
    .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
   ) then

                                ! dati
    v7d%voldatir &
     (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
     v7d%voldatir &
     (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)


                                ! attributi
    if (associated (v7d%dativarattr%i)) then
      inddativarattr  = index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
      if (inddativarattr > 0 ) then
        v7d%voldatiattri &
         (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
         v7d%voldatiattri &
         (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
      end if
    end if

    if (associated (v7d%dativarattr%r)) then
      inddativarattr  = index(v7d%dativarattr%r,v7d%dativar%r(inddativar))
      if (inddativarattr > 0 ) then
        v7d%voldatiattrr &
         (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
         v7d%voldatiattrr &
         (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
      end if
    end if

    if (associated (v7d%dativarattr%d)) then
      inddativarattr  = index(v7d%dativarattr%d,v7d%dativar%r(inddativar))
      if (inddativarattr > 0 ) then
        v7d%voldatiattrd &
         (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
         v7d%voldatiattrd &
         (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
      end if
    end if

    if (associated (v7d%dativarattr%b)) then
      inddativarattr  = index(v7d%dativarattr%b,v7d%dativar%r(inddativar))
      if (inddativarattr > 0 ) then
        v7d%voldatiattrb &
         (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
         v7d%voldatiattrb &
         (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
      end if
    end if

    if (associated (v7d%dativarattr%c)) then
      inddativarattr  = index(v7d%dativarattr%c,v7d%dativar%r(inddativar))
      if (inddativarattr > 0 ) then
          v7d%voldatiattrc &
           (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
           v7d%voldatiattrc &
           (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
      end if
    end if

  end if

end do

end subroutine move_datar


subroutine v7d_rounding(v7din,v7dout,level,timerange,nostatproc)
type(vol7d),intent(inout) :: v7din
type(vol7d),intent(out) :: v7dout
type(vol7d_level),intent(in),optional :: level(:)
type(vol7d_timerange),intent(in),optional :: timerange(:)
!logical,intent(in),optional :: merge !< if there are data on more then one almost equal levels or timeranges
!! will be merged POINT BY POINT with priority for the fird data found ordered by icreasing var index
logical,intent(in),optional :: nostatproc

integer :: nana,nlevel,ntime,ntimerange,nnetwork,nbin
integer :: iana,ilevel,itimerange,indl,indt,itime,inetwork
type(vol7d_level) :: roundlevel(size(v7din%level)) 
type(vol7d_timerange) :: roundtimerange(size(v7din%timerange))
type(vol7d) :: v7d_tmp


nbin=0

if (associated(v7din%dativar%r)) nbin = nbin + size(v7din%dativar%r)
if (associated(v7din%dativar%i)) nbin = nbin + size(v7din%dativar%i)
if (associated(v7din%dativar%d)) nbin = nbin + size(v7din%dativar%d)
if (associated(v7din%dativar%b)) nbin = nbin + size(v7din%dativar%b)

call init(v7d_tmp)

roundlevel=v7din%level

if (present(level))then
  do ilevel = 1, size(v7din%level)
    if ((any(v7din%level(ilevel) .almosteq. level))) then
      roundlevel(ilevel)=level(1)
    end if
  end do
end if

roundtimerange=v7din%timerange

if (present(timerange))then
  do itimerange = 1, size(v7din%timerange)
    if ((any(v7din%timerange(itimerange) .almosteq. timerange))) then
      roundtimerange(itimerange)=timerange(1)
    end if
  end do
end if

!set istantaneous values everywere
!preserve p1 for forecast time
if (optio_log(nostatproc)) then
  roundtimerange(:)%timerange=254
  roundtimerange(:)%p2=0
end if


nana=size(v7din%ana)
nlevel=count_distinct(roundlevel,back=.true.)
ntime=size(v7din%time)
ntimerange=count_distinct(roundtimerange,back=.true.)
nnetwork=size(v7din%network)

call init(v7d_tmp)

if (nbin == 0) then
  call copy(v7din,v7d_tmp)
else
  call vol7d_convr(v7din,v7d_tmp)
end if

v7d_tmp%level=roundlevel
v7d_tmp%timerange=roundtimerange

do ilevel=1, size(v7d_tmp%level)
  indl=index(v7d_tmp%level,roundlevel(ilevel))
  do itimerange=1,size(v7d_tmp%timerange)
    indt=index(v7d_tmp%timerange,roundtimerange(itimerange))

    if (indl /= ilevel .or. indt /= itimerange) then

      do iana=1, nana
        do itime=1,ntime
          do inetwork=1,nnetwork
            
            if (nbin > 0) then
              call move_datar (v7d_tmp,&
               iana,itime,ilevel,itimerange,inetwork,&
               iana,itime,indl,indt,inetwork)
            else
              call move_datac (v7d_tmp,&
               iana,itime,ilevel,itimerange,inetwork,&
               iana,itime,indl,indt,inetwork)
            end if
            
          end do
        end do
      end do
      
    end if

  end do
end do

! set to missing level and time > nlevel
do  ilevel=nlevel+1,size(v7d_tmp%level)
  call init (v7d_tmp%level(ilevel))
end do

do  itimerange=ntimerange+1,size(v7d_tmp%timerange)
  call init (v7d_tmp%timerange(itimerange))
end do

!copy with remove
CALL copy(v7d_tmp,v7dout,miss=.true.,lsort_timerange=.true.,lsort_level=.true.)
CALL delete(v7d_tmp)

!call display(v7dout)

end subroutine v7d_rounding


END MODULE vol7d_class