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"
 
!> \defgroup vol7d Libsim package, vol7d library.
!! The libsim vol7d library contains classes for managing pointwise
!! data, tipically weather observations, and for their import from a
!! Db-All.e database or from a WMO BUFR file. In order to compile and
!! link programs using this library, you have to insert the required
!! \c USE statements in the program units involved, specify the
!! location of module files when compiling (tipically \c
!! -I/usr/lib/gfortran/modules or \c -I/usr/lib64/gfortran/modules or
!! \c -I/usr/include) and indicate the library name \c -lsim_vol7d
!! when linking, assuming that the library has been installed in a
!! default location.
 
!> Classe per la gestione di un volume completo di dati osservati.
!! Questo modulo definisce gli oggetti e i metodi per gestire
!! volumi di dati meteorologici sparsi.
!! I volumi definiti sono principalmente di 4 categorie:
!!  - volumi di anagrafica (vol7d::volanar & c.), hanno 3 dimensioni:
!!    - anagrafica
!!    - variabile di anagrafica
!!    - rete
!!  - volumi di attributi di anagrafica (vol7d::volanaattrr & c.), hanno 4 dimensioni:
!!    - anagrafica
!!    - variabile di anagrafica
!!    - rete
!!    - variabile di attributi delle variabili di anagrafica
!!  - volumi di dati (vol7d::voldatir & c.), hanno 6 dimensioni:
!!    - anagrafica
!!    - tempo
!!    - livello verticale
!!    - intervallo temporale (timerange)
!!    - variabile di dati
!!    - rete
!!  - volumi di attributi di dati (vol7d::voldatiattrr & c.), hanno 7 dimensioni:
!!    - anagrafica
!!    - tempo
!!    - livello verticale
!!    - intervallo temporale (timerange)
!!    - variabile di dati
!!    - rete
!!    - variabile di attributi delle variabili di dati
!!
!! Tutte le variabili sono inoltre disponibil1 in 5 tipi diversi:
!!  - reale (abbreviato r)
!!  - doppia precisione (abbreviato d)
!!  - intero  (abbreviato i)
!!  - byte (abbreviato b)
!!  - carattere (abbreviato c)
!!
!! Per ognuna delle dimensioni possibili, incluse le variabili e gli
!! attributi con i loro diversi tipi,
!! è definito un cosiddetto "vettore di descrittori", con un
!! numero di elementi pari all'estensione della dimensione stessa,
!! che contiene le informazioni necessarie a descrivere
!! gli elementi di quella dimensione.
!! In realtà l'utente non dovrà generalmente occuparsi di costruire
!! un oggetto vol7d con le proprie mani ma utilizzerà nella maggior parte
!! dei casi i metodi di importazione preconfezionati che importano dati da
!! DB-All.e (vol7d_dballe_class) o dal DB Oracle del SIM (vol7d_oraclesim_class).
!! 
!!
!! Il programma esempio_v7d.f90 contiene un esempio elementare di uso
!! della classe vol7d:
!! \include esempio_v7d.f90
!!
!! \ingroup vol7d
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 !< indice della dimensione "anagrafica" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
INTEGER, PARAMETER :: vol7d_var_a=2 !< indice della dimensione "variabile" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
INTEGER, PARAMETER :: vol7d_network_a=3 !< indice della dimensione "rete" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
INTEGER, PARAMETER :: vol7d_attr_a=4 !< indice della dimensione "attributo" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
INTEGER, PARAMETER :: vol7d_ana_d=1 !< indice della dimensione "anagrafica" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
INTEGER, PARAMETER :: vol7d_time_d=2 !< indice della dimensione "tempo" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
INTEGER, PARAMETER :: vol7d_level_d=3 !< indice della dimensione "livello verticale" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
INTEGER, PARAMETER :: vol7d_timerange_d=4 !< indice della dimensione "intervallo temporale" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
INTEGER, PARAMETER :: vol7d_var_d=5 !< indice della dimensione "variabile" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
INTEGER, PARAMETER :: vol7d_network_d=6 !< indice della dimensione "rete" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
INTEGER, PARAMETER :: vol7d_attr_d=7 !< indice della dimensione "attributo" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
INTEGER, PARAMETER :: vol7d_cdatalen=32
 
TYPE vol7d_varmap
  INTEGER :: r, d, i, b, c
END TYPE vol7d_varmap
 
!> Definisce un oggetto contenente i volumi anagrafica e dati e tutti
!! i descrittori delle loro dimensioni.
TYPE vol7d
!> vettore descrittore della dimensione anagrafica
  TYPE(vol7d_ana),POINTER :: ana(:)
!> vettore descrittore della dimensione tempo
  TYPE(datetime),POINTER :: time(:)
!> vettore descrittore della dimensione livello verticale
  TYPE(vol7d_level),POINTER :: level(:)
!> vettore descrittore della dimensione intervallo temporale (timerange)
  TYPE(vol7d_timerange),POINTER :: timerange(:)
!> vettore descrittore della dimensione rete
  TYPE(vol7d_network),POINTER :: network(:)
!> vettore descrittore della dimensione variabile di anagrafica
  TYPE(vol7d_varvect) :: anavar
!> vettore descrittore della dimensione attributo delle variabili di anagrafica
    TYPE(vol7d_varvect) :: anaattr
!> vettore descrittore della dimensione variabile di anagrafica che ha tali attributi
    TYPE(vol7d_varvect) :: anavarattr
!> vettore descrittore della dimensione variabile di dati
    TYPE(vol7d_varvect) :: dativar
!> vettore descrittore della dimensione attributo delle variabili di dati
    TYPE(vol7d_varvect) :: datiattr
!> vettore descrittore della dimensione variabile di dati che ha tali attributi
    TYPE(vol7d_varvect) :: dativarattr
 
!> volume di anagrafica a valori reali
  REAL,POINTER :: volanar(:,:,:)
!> volume di anagrafica a valori a doppia precisione
  DOUBLE PRECISION,POINTER :: volanad(:,:,:)
!> volume di anagrafica a valori interi
  INTEGER,POINTER :: volanai(:,:,:)
!> volume di anagrafica a valori byte
  INTEGER(kind=int_b),POINTER :: volanab(:,:,:)
!> volume di anagrafica a valori carattere
  CHARACTER(len=vol7d_cdatalen),POINTER :: volanac(:,:,:)
 
!> volume di attributi di anagrafica a valori reali
  REAL,POINTER :: volanaattrr(:,:,:,:)
!> volume di attributi di anagrafica a valori a doppia precisione
  DOUBLE PRECISION,POINTER :: volanaattrd(:,:,:,:)
!> volume di attributi di anagrafica a valori interi
  INTEGER,POINTER :: volanaattri(:,:,:,:)
!> volume di attributi di anagrafica a valori byte
  INTEGER(kind=int_b),POINTER :: volanaattrb(:,:,:,:)
!> volume di attributi di anagrafica a valori carattere
  CHARACTER(len=vol7d_cdatalen),POINTER :: volanaattrc(:,:,:,:)
 
!> volume di dati a valori reali
  REAL,POINTER :: voldatir(:,:,:,:,:,:) ! sono i dati
!> volume di dati a valori a doppia precisione
  DOUBLE PRECISION,POINTER :: voldatid(:,:,:,:,:,:)
!> volume di dati a valori interi
  INTEGER,POINTER :: voldatii(:,:,:,:,:,:)
!> volume di dati a valori byte
  INTEGER(kind=int_b),POINTER :: voldatib(:,:,:,:,:,:)
!> volume di dati a valori carattere
  CHARACTER(len=vol7d_cdatalen),POINTER :: voldatic(:,:,:,:,:,:)
 
!> volume di attributi di dati a valori reali
  REAL,POINTER :: voldatiattrr(:,:,:,:,:,:,:)
!> volume di attributi di dati a valori a doppia precisione
  DOUBLE PRECISION,POINTER :: voldatiattrd(:,:,:,:,:,:,:)
!> volume di attributi di dati a valori interi
  INTEGER,POINTER :: voldatiattri(:,:,:,:,:,:,:)
!> volume di attributi di dati a valori byte
  INTEGER(kind=int_b),POINTER :: voldatiattrb(:,:,:,:,:,:,:)
!> volume di attributi di dati a valori carattere
  CHARACTER(len=vol7d_cdatalen),POINTER :: voldatiattrc(:,:,:,:,:,:,:)
 
!> time definition; 0=time is reference time, 1=time is validity time
  integer :: time_definition
 
END TYPE vol7d
 
!> Costruttore per la classe vol7d.
!! Deve essere richiamato 
!! per tutti gli oggetti di questo tipo definiti in un programma.
INTERFACE init
  MODULE PROCEDURE vol7d_init
END INTERFACE
 
!> Distruttore per la classe vol7d.
INTERFACE delete
  MODULE PROCEDURE vol7d_delete
END INTERFACE
 
!> Scrittura su file.
INTERFACE export
  MODULE PROCEDURE vol7d_write_on_file
END INTERFACE
 
!> Lettura da file.
INTERFACE import
  MODULE PROCEDURE vol7d_read_from_file
END INTERFACE
 
!>Print object
INTERFACE display
  MODULE PROCEDURE vol7d_display, dat_display, dat_vect_display
END INTERFACE
 
!>Represent data in a pretty string
INTERFACE to_char
  MODULE PROCEDURE to_char_dat
END INTERFACE
 
!>doubleprecision data conversion
INTERFACE doubledat
  MODULE PROCEDURE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
END INTERFACE
 
!>real data conversion
INTERFACE realdat
  MODULE PROCEDURE realdatd,realdatr,realdati,realdatb,realdatc
END INTERFACE
 
!>integer data conversion
INTERFACE integerdat
  MODULE PROCEDURE integerdatd,integerdatr,integerdati,integerdatb,integerdatc
END INTERFACE
 
!>copy object
INTERFACE copy
  MODULE PROCEDURE vol7d_copy
END INTERFACE
 
!> Test for a missing volume
INTERFACE c_e
  MODULE PROCEDURE vol7d_c_e
END INTERFACE
 
!> Check for problems
!! return 0 if all check passed
!! print diagnostics with log4f
INTERFACE check
  MODULE PROCEDURE vol7d_check
END INTERFACE
 
!> Reduce some dimensions (level and timerage) for semplification (rounding).
!! You can use this for simplify and use variables in computation like alchimia
!! where fields have to be on the same coordinate
!! It return real or character data only: if input is charcter data only it return character otherwise il return
!! all the data converted to real.
!! examples:
!! means in time for short periods and istantaneous values
!! 2 meter and surface levels
!! If there are data on more then one almost equal levels or timeranges, the first var present (at least one point)
!! will be taken (order is by icreasing var index).
!! You can use predefined values for classic semplification
!! almost_equal_levels and almost_equal_timeranges
!! The level or timerange in output will be defined by the first element of level and timerange list
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
 
 
!> Inizializza un oggetto di tipo vol7d.
!! Non riceve alcun parametro tranne l'oggetto stesso. Attenzione, è necessario
!! comunque chiamare sempre il costruttore per evitare di avere dei puntatori in
!! uno stato indefinito.
SUBROUTINE vol7d_init(this,time_definition)
TYPE(vol7d),intent(out) :: this !< oggetto da inizializzare
INTEGER,INTENT(IN),OPTIONAL :: time_definition !< 0=time is reference time; 1=time is validity time; 2=time is validity time, forecast range forced to 0 (default=1)
 
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
 
 
!> Distrugge l'oggetto in maniera pulita, liberando l'eventuale memoria
!! dinamicamente allocata. Permette di distruggere la sola parte di dati
!! mantenendo l'anagrafica.
ELEMENTAL SUBROUTINE vol7d_delete(this, dataonly)
TYPE(vol7d),intent(inout) :: this !< oggetto da distruggere
LOGICAL, INTENT(in), OPTIONAL :: dataonly !< dealloca solo i dati, tenendo l'anagrafica, (default \c .FALSE.)
 
 
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 !< object to check
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
!> stampa a video una sintesi del contenuto
SUBROUTINE vol7d_display(this)
TYPE(vol7d),intent(in) :: this !< oggetto da visualizzare
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
 
 
!> stampa a video una sintesi del contenuto
SUBROUTINE dat_display(this,idat,rdat,ddat,bdat,cdat)
TYPE(vol7d_var),intent(in) :: this !< oggetto da visualizzare
!> real
REAL :: rdat
!> double precision
DOUBLE PRECISION :: ddat
!> integer
INTEGER :: idat
!> byte
INTEGER(kind=int_b) :: bdat
!> character
CHARACTER(len=*) :: cdat
 
print *, to_char_dat(this,idat,rdat,ddat,bdat,cdat)
 
end SUBROUTINE dat_display
 
!> stampa a video una sintesi del contenuto
SUBROUTINE dat_vect_display(this,idat,rdat,ddat,bdat,cdat)
 
TYPE(vol7d_var),intent(in) :: this(:) !< oggetto da visualizzare
!> real
REAL :: rdat(:)
!> double precision
DOUBLE PRECISION :: ddat(:)
!> integer
INTEGER :: idat(:)
!> byte
INTEGER(kind=int_b) :: bdat(:)
!> character
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
REAL :: rdat
!> double precision
DOUBLE PRECISION :: ddat
!> integer
INTEGER :: idat
!> byte
INTEGER(kind=int_b) :: bdat
!> character
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
 
 
!> Tests whether anything has ever been assigned to a vol7d object
!! (.TRUE.) or it is as clean as after an init (.FALSE.).
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
 
 
!> Metodo per allocare i descrittori delle 7 dimensioni.
!! Riceve un grande numero di parametri opzionali che
!! indicano quali descrittori allocare e con quale estensione;
!! i descrittori non specificati non vengono toccati.
!! Può essere quindi chiamato più volte allocando via via
!! descrittori relativi a dimensioni diverse.
!! Se un descrittore richiesto è già allocato, viene deallocato
!! (perdendone l'eventuale contenuto) e riallocato con l'estensione
!! richiesta.
!! Per i descrittori relativi a dimensioni che non siano variabili o attributi,
!! è possibile specificare l'estensione di una dimensione a 0,
!! in tal caso il descrittore viene comunque allocato con lunghezza nulla,
!! che è diverso da non allocarlo. Per i descrittori di variabili e attributi
!! passare un'estensione 0 equivale a non fornire il parametro.
!! Avere uno o più descrittori dimensionati con estensione nulla fa sì
!! che anche il volume dati successivamente allocato abbia estensione nulla;
!! sebbene ciò appaia inutile, un volume del genere può in realtà servire,
!! in associazione ai metodi ::vol7d_merge o ::vol7d_append per estendere
!! un volume esistente aggiungendo elementi in alcune dimensioni (quelle
!! a estensione non nulla, ovviamente) e mantenendo invariato tutto il resto.
!! Per quanto riguarda i descrittori delle dimensioni relative alle
!! variabili, la relativa estensione è specificata con la nomenclatura
!! \a n&lt;x&gt;&lt;y&gt;&lt;z&gt; dove &lt;x&gt; può valere:
!!  - \a ana per variabili relative a voumi di anagrafica
!!  - \a dati per variabili relative a voumi di dati
!!
!! &lt;y&gt; può valere:
!!  - \a var per variabili
!!  - \a attr per attributi
!!  - \a varattr variabili aventi attributi nei volumi di attributi
!!
!! &lt;z&gt; può valere:
!!  - \a r per variabili o attributi a valori reali
!!  - \a d per variabili o attributi a valori a doppia precisione
!!  - \a i per variabili o attributi a valori interi
!!  - \a b per variabili o attributi a valori byte
!!  - \a c per variabili o attributi a valori carattere
!!
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 !< oggetto di cui allocare i descrittori
INTEGER,INTENT(in),OPTIONAL :: nana !< estensione della dimensione anagrafica
INTEGER,INTENT(in),OPTIONAL :: ntime !< estensione della dimensione tempo
INTEGER,INTENT(in),OPTIONAL :: nlevel !< estensione della dimensione livello varticale
INTEGER,INTENT(in),OPTIONAL :: ntimerange !< estensione della dimensione intervallo temporale (timerange)
INTEGER,INTENT(in),OPTIONAL :: nnetwork !< estensione della dimensione rete
!> estensione delle possibili dimensioni variabile
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 !< se fornito e vale \c .TRUE., viene chiamato il costruttore, senza parametri opzionali, per ogni elemento di tutti i descrittori allocati, inizializzandolo quindi a valore mancante
 
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 !< oggetto da controllare
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
 
 
!> Metodo per allocare i volumi richiesti di variabili e attributi per
!! anagrafica e dati.
!! Se alcuni dei descrittori relativi alle dimensioni anagrafica,
!! livello verticale, tempo, intervallo temporale (timerange), rete non sono
!! stati richiesti preventivamente con la ::vol7d_alloc, essi vengono allocati
!! automaticamente da questo metodo
!! con estensione di default pari a 1 (non 0!), questo significa, ad esempio,
!! che se prevedo di avere soli dati superficiali, cioè ad un solo livello
!! verticale, o una sola rete di stazioni, non devo preoccuparmi di
!! specificare questa informazione.
!! Tra i 20 possibili volumi allocabili
!! ((variabili,attributi)*(anagrafica,dati)*(r,d,i,b,c)=20)
!! saranno allocati solo quelli per cui è stato precedentemente richiesto il
!! corrispondente descrittore variabili/attributi con la ::vol7d_alloc.
SUBROUTINE vol7d_alloc_vol(this, ini, inivol)
TYPE(vol7d),INTENT(inout) :: this !< oggetto di cui allocare i volumi
LOGICAL,INTENT(in),OPTIONAL :: ini !< se fornito e vale \c .TRUE., viene chiamato il costruttore, senza parametri opzionali, per ogni elemento di tutti i descrittori allocati
LOGICAL,INTENT(in),OPTIONAL :: inivol !< se fornito e vale \c .TRUE., i volumi allocati saranno inizializzati a valore mancante
 
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
 
 
!> Metodo per creare gli indici che associano le variabili aventi attributo
!! alle variabili nei relativi descrittori.
!! Ha senso chiamare questo metodo solo dopo che i descrittori delle variabili
!! e degli attributi desiderati sono stati allocati ed è stato assegnato un
!! valore ai relativi membri btable (vedi vol7d_var_class::vol7d_var), se
!! i descrittori non sono stati allocati o assegnati, il metodo non fa niente.
SUBROUTINE vol7d_set_attr_ind(this)
TYPE(vol7d),INTENT(inout) :: this !< oggetto in cui creare gli indici
 
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
 
 
!> Metodo per fondere 2 oggetti vol7d.
!! Il secondo volume viene accodato al primo e poi distrutto, si veda
!! quindi la descrizione di ::vol7d_append.  Se uno degli oggetti \a
!! this o \a that sono vuoti non perde tempo inutile,
SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
TYPE(vol7d),INTENT(INOUT) :: this !< primo oggetto in ingresso, alla fine conterrà il risultato della fusione
TYPE(vol7d),INTENT(INOUT) :: that !< secondo oggetto in ingresso, alla fine sarà distrutto
LOGICAL,INTENT(IN),OPTIONAL :: sort !< se fornito e uguale a \c .TRUE., i descrittori che supportano un ordinamento (operatori > e/o <) risulteranno ordinati in ordine crescente nell'oggetto finale
LOGICAL,INTENT(in),OPTIONAL :: bestdata !< if provided and \a .TRUE. in case of overlapping volumes keep valid data where available, or data from the second volume if both valid
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
 
 
!> Metodo per accodare un oggetto vol7d ad un altro.
!! Si tratta di un metodo molto potente e versatile;
!! i descrittori delle dimensioni del volume finale conterranno i valori
!! dei corrispondenti descrittori del primo e del secondo volume
!! e i volumi di anagrafica e dati conterranno i valori dei due volumi
!! ai posti giusti, e valori mancanti per le nuove combinazioni che
!! eventualmente si verranno a creare.
!! Se i volumi multidimensionali di anagrafica e/o dati dei 2 oggetti
!! hanno un'intersezione non nulla, negli elementi comuni il volume finale
!! conterrà il corrispondente elemento del \b secondo volume.
!! Attenzione che, durante l'esecuzione del metodo, la memoria richiesta è
!! pari alla memoria complessiva occupata dai 2 volumi iniziali più
!! la memoria complessiva del volume finale, per cui, nel caso di volumi grandi,
!! ci potrebbero essere problemi di esaurimento della memoria centrale.
!! Se l'oggetto \a that è vuoto non perde tempo inutile,
!!
!! \todo nel caso di elementi comuni inserire la possibiità (opzionale per
!! non penalizzare le prestazioni quando ciò non serve) di effettuare una scelta
!! più ragionata dell'elemento da tenere, almeno controllando i dati mancanti
!! se non le flag di qualità
!!
!! \todo "rateizzare" l'allocazione dei volumi per ridurre l'occupazione di
!! memoria nel caso siano allocati contemporaneamente volumi di variabili e
!! di attributi o più volumi di tipi diversi
!!
!! \todo il parametro \a that è dichiarato \a INOUT perché la vol7d_alloc_vol
!! può modificarlo, bisognerebbe implementare una vol7d_check_vol che restituisca
!! errore anziché usare la vol7d_alloc_vol.
SUBROUTINE vol7d_append(this, that, sort, bestdata, &
 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
TYPE(vol7d),INTENT(INOUT) :: this !< primo oggetto in ingresso, a cui sarà accodato il secondo
TYPE(vol7d),INTENT(IN) :: that !< secondo oggetto in ingresso, non viene modificato dal metodo
LOGICAL,INTENT(IN),OPTIONAL :: sort !< se fornito e uguale a \c .TRUE., i descrittori che supportano un ordinamento (operatori > e/o <) risulteranno ordinati in ordine crescente nell'oggetto finale
! 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 !< if provided and \a .TRUE. in case of overlapping volumes keep valid data where available, or data from the second volume if both valid
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
 
 
!> Metodo per creare una copia completa e indipendente di un oggetto vol7d.
!! Questo metodo crea un duplicato di tutti i membri di un oggetto vol7d,
!! con la possibilità di rielaborarlo durante la copia. Se l'oggetto da copiare
!! è vuoto non perde tempo inutile.
!! Attenzione, il codice:
!! \code
!! USE vol7d_class
!! TYPE(vol7d) :: vol1, vol2
!! CALL init(vol1)
!! CALL init(vol2)
!! ... ! riempio vol1
!! vol2 = vol1
!! \endcode
!! fa una cosa diversa rispetto a:
!! \code
!! USE vol7d_class
!! TYPE(vol7d) :: vol1, vol2
!! CALL init(vol1)
!! CALL init(vol2)
!! ... ! riempio vol1
!! CALL vol7d_copy(vol1, vol2)
!! \endcode
!! nel primo caso, infatti, l'operatore di assegnazione copia solo i componenti
!! statici di \a vol1 nei corrispondenti elementi di \a vol2, mentre i componenti che
!! sono allocati dinamicamente (cioè quelli che in ::vol7d hanno l'attributo
!! \c POINTER, in pratica quasi tutti) non vengono duplicati, ma per essi vol2
!! conterrà un puntatore al corrispondente elemento a cui già punta vol1, e quindi 
!! eventuali cambiamenti al contenuto di uno dei due oggetti influenzerà il
!! contenuto dell'altro; nel secondo caso, invece, vol1 e vol2 sono, dopo la
!! vol7d_copy, 2 istanze
!! completamente indipendenti, ma uguali tra loro per contenuto, della classe
!! vol7d, e quindi hanno vita indipendente.
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 !< oggetto origine
TYPE(vol7d),INTENT(INOUT) :: that !< oggetto destinazione
LOGICAL,INTENT(IN),OPTIONAL :: sort !< if present and \a .TRUE., sort all the sortable dimensions
LOGICAL,INTENT(IN),OPTIONAL :: unique !< se fornito e uguale a \c .TRUE., gli eventuali elementi duplicati nei descrittori dell'oggetto iniziale verranno collassati in un unico elemento (con eventuale perdita dei dati relativi agli elementi duplicati)
LOGICAL,INTENT(IN),OPTIONAL :: miss !< se fornito e uguale a \c .TRUE., gli eventuali elementi dei descrittori uguali al corrispondente valore mancante verranno eliminati dall'oggetto riformato
LOGICAL,INTENT(IN),OPTIONAL :: lsort_time !< if present and \a .TRUE., sort only time dimension (alternative to \a sort )
LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange !< if present and \a .TRUE., sort only timerange dimension (alternative to \a sort )
LOGICAL,INTENT(IN),OPTIONAL :: lsort_level !< if present and \a .TRUE., sort only level dimension (alternative to \a sort )
!> se fornito, deve essere un vettore logico della stessa lunghezza di
!! this%time indicante quali elementi della dimensione \a time
!! mantenere (valori \c .TRUE.) e quali scartare (valori \c .FALSE.)
!! nel volume copiato; in alternativa può essere un vettore di
!! lunghezza 1, in tal caso, se \c .FALSE. , equivale a scartare tutti
!! gli elementi (utile principalmente per le variabili); è compatibile
!! col parametro \a miss
LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
!> come il precedente per la dimensione \a timerange
LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
!> come il precedente per la dimensione \a level
LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
!> come il precedente per la dimensione \a ana
LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
!> come il precedente per la dimensione \a network
LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
!> come il precedente per tutte le possibili dimensioni variabile
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
 
 
!> Metodo per riformare in varie maniere un oggetto vol7d.
!! Equivale ad una copia (vedi ::vol7d_copy)
!! seguita dalla distruzione del volume iniziale e alla
!! sua riassegnazione al volume copiato. Ha senso se almeno uno dei parametri
!! \a sort, \a uniq o \a miss è fornito uguale a \c .TRUE., altrimenti
!! è solo una perdita di tempo.
!! Può essere utile, ad esempio, per eliminare stazioni
!! o istanti temporali indesiderati, basta assegnare il loro corrispondente
!! elemento del descrittore a valore mancante e chiamare vol7d_reform
!! con miss=.TRUE. .
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 !< oggetto da riformare
LOGICAL,INTENT(IN),OPTIONAL :: sort !< if present and \a .TRUE., sort all the sortable dimensions
LOGICAL,INTENT(IN),OPTIONAL :: unique !< se fornito e uguale a \c .TRUE., gli eventuali elementi duplicati nei descrittori dell'oggetto iniziale verranno collassati in un unico elemento (con eventuale perdita dei dati relativi agli elementi duplicati)
LOGICAL,INTENT(IN),OPTIONAL :: miss !< se fornito e uguale a \c .TRUE., gli eventuali elementi dei descrittori uguali al corrispondente valore mancante verranno eliminati dall'oggetto riformato
LOGICAL,INTENT(IN),OPTIONAL :: lsort_time !< if present and \a .TRUE., sort only time dimension (alternative to \a sort )
LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange !< if present and \a .TRUE., sort only timerange dimension (alternative to \a sort )
LOGICAL,INTENT(IN),OPTIONAL :: lsort_level !< if present and \a .TRUE., sort only level dimension (alternative to \a sort )
!> se fornito, deve essere un vettore logico della stessa lunghezza di
!! this%time indicante quali elementi della dimensione \a time
!! mantenere (valori \c .TRUE.) e quali scartare (valori \c .FALSE.)
!! nel volume copiato; in alternativa può essere un vettore di
!! lunghezza 1, in tal caso, se \c .FALSE. , equivale a scartare tutti
!! gli elementi (utile principalmente per le variabili); è compatibile
!! col parametro \a miss
LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:) !< come il precedente per la dimensione \a timerange
LOGICAL,INTENT(IN),OPTIONAL :: llevel(:) !< come il precedente per la dimensione \a level
LOGICAL,INTENT(IN),OPTIONAL :: lana(:) !< come il precedente per la dimensione \a ana
LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:) !< come il precedente per la dimensione \a network
!> come il precedente per tutte le possibili dimensioni variabile
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 !< if true remove ana with all data missing
 
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
 
 
!> Sorts the sortable dimensions in the volume \a this only when necessary.
!! Most of the times, the time, timerange and level dimensions in a
!! vol7d object are correctly sorted; on the other side many methods
!! strictly rely on this fact in order to work correctly. This method
!! performs a quick check and sorts the required dimensions only if
!! they are not sorted in ascending order yet, improving safety
!! without impairing much performance.
SUBROUTINE vol7d_smart_sort(this, lsort_time, lsort_timerange, lsort_level)
TYPE(vol7d),INTENT(INOUT) :: this !< object to be sorted
LOGICAL,OPTIONAL,INTENT(in) :: lsort_time !< if present and \a .TRUE., sort time dimension if it is not sorted in ascending order
LOGICAL,OPTIONAL,INTENT(in) :: lsort_timerange !< if present and \a .TRUE., sort timerange dimension if it is not sorted in ascending order
LOGICAL,OPTIONAL,INTENT(in) :: lsort_level !< if present and \a .TRUE., sort vertical level dimension if it is not sorted in ascending order
 
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
 
!> Filter the contents of a volume keeping only desired data.
!! This subroutine filters a vol7d object by keeping only a subset of
!! the data contained.  It can keep only times within a specified
!! interval, only station networks contained in a list and only
!! specified station or data variables. If a filter parameter is not
!! provided, no filtering will take place according to that criterion.
!! The volume is reallocated keeping only the desired data.
SUBROUTINE vol7d_filter(this, avl, vl, nl, s_d, e_d)
TYPE(vol7d),INTENT(inout) :: this !< volume to be filtered
CHARACTER(len=*),INTENT(in),OPTIONAL :: avl(:) !< list of station variables to be kept, if not provided or of zero length, all variables are kept
CHARACTER(len=*),INTENT(in),OPTIONAL :: vl(:) !< list of data variables to be kept, if not provided or of zero length, all variables are kept
TYPE(vol7d_network),OPTIONAL :: nl(:) !< list of station networks to be kept, if not provided or of zero length, all networks are kept
TYPE(datetime),INTENT(in),OPTIONAL :: s_d !< initial time interval for time filtering, if not provided or equal to missing data no lower limit is imposed
TYPE(datetime),INTENT(in),OPTIONAL :: e_d !< final time interval for time filtering, if not provided or equal to missing data no upper limit is imposed
 
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
 
 
!> Metodo per convertire i volumi di dati di un oggetto vol7d in dati
!! reali dove possibile. L'oggetto convertito è una copia completa
!! dell'originale che può essere quindi distrutto dopo la chiamata.
!! Per i dati di anagrafica, al momento sono convertiti solo
!! i dati CHARACTER se è passato \a anaconv=.TRUE.
!! Gli attributi non sono toccati.
SUBROUTINE vol7d_convr(this, that, anaconv)
TYPE(vol7d),INTENT(IN) :: this !< oggetto origine
TYPE(vol7d),INTENT(INOUT) :: that !< oggetto convertito
LOGICAL,OPTIONAL,INTENT(in) :: anaconv !< converti anche anagrafica
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
 
 
!> Metodo per ottenere solo le differenze tra due oggetti vol7d.
!! Il primo volume viene confrontato col secondo; nel secondo volume ovunque 
!! i dati confrontati siano coincidenti viene impostato valore mancante.
SUBROUTINE vol7d_diff_only (this, that, data_only,ana)
TYPE(vol7d),INTENT(IN) :: this !< primo volume da confrontare
TYPE(vol7d),INTENT(OUT) :: that !< secondo volume da confrontare in cui eliminare i dati coincidenti
logical , optional, intent(in) :: data_only !< attiva l'elaborazione dei soli dati e non dell'anagrafica (default: .false.)
logical , optional, intent(in) :: ana !< attiva l'elaborazione dell'anagrafica (coordinate e ident) (default: .false.)
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"
 
!>\brief Scrittura su file di un volume Vol7d.
!! Scrittura su file unformatted di un intero volume Vol7d.
!! Il volume viene serializzato e scritto su file.
!! Il file puo' essere aperto opzionalmente dall'utente. Si possono passare
!! opzionalmente unità e nome del file altrimenti assegnati internamente a dei default; se assegnati internamente 
!! tali parametri saranno in output.
!! Se non viene fornito il nome file viene utilizzato un file di default con nome pari al nome del programma in 
!! esecuzione con postfisso ".v7d".
!! Come parametro opzionale c'è la description che insieme alla data corrente viene inserita nell'header del file.
subroutine vol7d_write_on_file (this,unit,description,filename,filename_auto)
 
TYPE(vol7d),INTENT(IN) :: this !< volume vol7d da scrivere 
integer,optional,intent(inout) :: unit !< unità su cui scrivere; se passata =0 ritorna il valore rielaborato (default =rielaborato internamente con getlun )
character(len=*),intent(in),optional :: filename !< nome del file su cui scrivere
character(len=*),intent(out),optional :: filename_auto !< nome del file generato se "filename" è omesso
character(len=*),INTENT(IN),optional :: description !< descrizione del volume
 
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
 
 
!>\brief Lettura da file di un volume Vol7d.
!! Lettura da file unformatted di un intero volume Vol7d.
!! Questa subroutine comprende vol7d_alloc e vol7d_alloc_vol.
!! Il file puo' essere aperto opzionalmente dall'utente. Si possono passare
!! opzionalmente unità e nome del file altrimenti assegnati internamente a dei default; se assegnati internamente 
!! tali parametri saranno in output.
 
 
subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
 
TYPE(vol7d),INTENT(OUT) :: this !< Volume vol7d da leggere
integer,intent(inout),optional :: unit !< unità su cui è stato aperto un file; se =0 rielaborato internamente (default = elaborato internamente con getunit)
character(len=*),INTENT(in),optional :: filename !< nome del file eventualmente da aprire (default = (nome dell'eseguibile)//.v7d )
character(len=*),intent(out),optional :: filename_auto !< nome del file generato se "filename" è omesso
character(len=*),INTENT(out),optional :: description !< descrizione del volume letto
integer,intent(out),optional :: tarray(8) !< vettore come definito da "date_and_time" della data di scrittura del volume
 
 
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
 
 
!> Return an ana volume of a requested variable as real data.
!! It returns a 2-d array of the proper shape (ana x network) for the
!! ana variable requested, converted to real type. If the conversion
!! fails or if the variable is not contained in the ana volume,
!! missing data are returned.
FUNCTION realanavol(this, var) RESULT(vol)
TYPE(vol7d),INTENT(in) :: this !< the \a vol7d object to query, the method \a vol7d_alloc_vol must have been called for it otherwise progam may abort
TYPE(vol7d_var),INTENT(in) :: var !< the ana variable to be returned
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
 
 
!> Return an ana volume of a requested variable as integer data.
!! It returns a 2-d array of the proper shape (ana x network) for the
!! ana variable requested, converted to integer type. If the conversion
!! fails or if the variable is not contained in the ana volume,
!! missing data are returned.
FUNCTION integeranavol(this, var) RESULT(vol)
TYPE(vol7d),INTENT(in) :: this !< the \a vol7d object to query, the method \a vol7d_alloc_vol must have been called for it otherwise progam may abort
TYPE(vol7d_var),INTENT(in) :: var !< the ana variable to be returned
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
 
 
!> Move data for all variables from one coordinate in the character volume to other.
!! Only not missing data will be copyed and all attributes will be moved together.
!! Usefull to colapse data spread in more indices (level or time or ....).
!! After the move is possible to set to missing some descriptor and make a copy with miss=.true. 
!! to obtain a new vol7d with less data shape.
subroutine move_datac (v7d,&
 indana,indtime,indlevel,indtimerange,indnetwork,&
 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
 
TYPE(vol7d),intent(inout) :: v7d !< data in form of character in this object will be moved
 
integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork !< source coordinate of the data
integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew !< destination coordinate of data
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
 
!> Move data for all variables from one coordinate in the real volume to other.
!! Only not missing data will be copyed and all attributes will be moved together.
!! Usefull to colapse data spread in more indices (level or time or ....).
!! After the move is possible to set to missing some descriptor and make a copy with miss=.true. 
!! to obtain a new vol7d with less data shape.
subroutine move_datar (v7d,&
 indana,indtime,indlevel,indtimerange,indnetwork,&
 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
 
TYPE(vol7d),intent(inout) :: v7d !< data in form of character in this object will be moved
 
integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork !< source coordinate of the data
integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew !< destination coordinate of data
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
 
 
!> Reduce some dimensions (level and timerage) for semplification (rounding).
!! You can use this for simplify and use variables in computation like alchimia
!! where fields have to be on the same coordinate
!! It return real or character data only: if input is charcter data only it return character otherwise il return
!! all the data converted to real.
!! examples:
!! means in time for short periods and istantaneous values
!! 2 meter and surface levels
!! If there are data on more then one almost equal levels or timeranges, the first var present (at least one point)
!! will be taken (order is by icreasing var index).
!! You can use predefined values for classic semplification
!! almost_equal_levels and almost_equal_timeranges
!! The level or timerange in output will be defined by the first element of level and timerange list
subroutine v7d_rounding(v7din,v7dout,level,timerange,nostatproc)
type(vol7d),intent(inout) :: v7din  !< input volume
type(vol7d),intent(out) :: v7dout !> output volume
type(vol7d_level),intent(in),optional :: level(:) !< almost equal level list
type(vol7d_timerange),intent(in),optional :: timerange(:) !< almost equal timerange list
!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 !< do not take in account statistical processing code in timerange and P2
 
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
 
!>\example esempio_qc_convert.f90
!!\brief Programma esempio semplice per la scrittura su file di un volume vol7d 
!!
!!Programma che scrive su file  un volume vol7d letto da una serie di file ASCII.
!!Questo programma scrive i dati del clima che poi verranno letti da modqccli
 
 
!>\example esempio_v7ddballe_move_and_collapse.f90
!!\brief ! Example program to reduce to one the dimensions of levels and time without loss of data