libsim Versione 7.2.6
|
◆ vol7d_get_volanaattrb()
Crea una vista a dimensione ridotta di un volume di attributi di anagrafica di tipo INTEGER(kind=int_b). È necessario fornire uno solo dei parametri opzionali vol*dp corrispondente al numero di dimensioni richieste. L'ordine delle dimensioni nella vista è quello prefissato in vol7d indipendentemente dall'ordine delle dimensioni fornito in dimlist. In caso di fallimento, in particolare se dimlist non contiene tutte le dimensioni non degeneri del volume richiesto oppure se una delle dimensioni è =0, il puntatore vol*dp è restituito in uno stato disassociato, per cui è opportuno controllare sempre in uscita, lo stato del puntatore per evitare che il programma abortisca con un errore di sistema, ad esempio: INTEGER(kind=int_b), POINTER :: vol1d(:)
...
CALL vol7d_get_volanaattrb(v7d1, (/vol7d_ana_d/), vol1d)
IF (ASSOCIATED(vol1d)) THEN
print*,vol1d
...
ENDIF
return
Definizione alla linea 5620 del file vol7d_class.F90. 5622! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
5623! authors:
5624! Davide Cesari <dcesari@arpa.emr.it>
5625! Paolo Patruno <ppatruno@arpa.emr.it>
5626
5627! This program is free software; you can redistribute it and/or
5628! modify it under the terms of the GNU General Public License as
5629! published by the Free Software Foundation; either version 2 of
5630! the License, or (at your option) any later version.
5631
5632! This program is distributed in the hope that it will be useful,
5633! but WITHOUT ANY WARRANTY; without even the implied warranty of
5634! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5635! GNU General Public License for more details.
5636
5637! You should have received a copy of the GNU General Public License
5638! along with this program. If not, see <http://www.gnu.org/licenses/>.
5639#include "config.h"
5640
5641!> \defgroup vol7d Libsim package, vol7d library.
5642!! The libsim vol7d library contains classes for managing pointwise
5643!! data, tipically weather observations, and for their import from a
5644!! Db-All.e database or from a WMO BUFR file. In order to compile and
5645!! link programs using this library, you have to insert the required
5646!! \c USE statements in the program units involved, specify the
5647!! location of module files when compiling (tipically \c
5648!! -I/usr/lib/gfortran/modules or \c -I/usr/lib64/gfortran/modules or
5649!! \c -I/usr/include) and indicate the library name \c -lsim_vol7d
5650!! when linking, assuming that the library has been installed in a
5651!! default location.
5652
5653!> Classe per la gestione di un volume completo di dati osservati.
5654!! Questo modulo definisce gli oggetti e i metodi per gestire
5655!! volumi di dati meteorologici sparsi.
5656!! I volumi definiti sono principalmente di 4 categorie:
5657!! - volumi di anagrafica (vol7d::volanar & c.), hanno 3 dimensioni:
5658!! - anagrafica
5659!! - variabile di anagrafica
5660!! - rete
5661!! - volumi di attributi di anagrafica (vol7d::volanaattrr & c.), hanno 4 dimensioni:
5662!! - anagrafica
5663!! - variabile di anagrafica
5664!! - rete
5665!! - variabile di attributi delle variabili di anagrafica
5666!! - volumi di dati (vol7d::voldatir & c.), hanno 6 dimensioni:
5667!! - anagrafica
5668!! - tempo
5669!! - livello verticale
5670!! - intervallo temporale (timerange)
5671!! - variabile di dati
5672!! - rete
5673!! - volumi di attributi di dati (vol7d::voldatiattrr & c.), hanno 7 dimensioni:
5674!! - anagrafica
5675!! - tempo
5676!! - livello verticale
5677!! - intervallo temporale (timerange)
5678!! - variabile di dati
5679!! - rete
5680!! - variabile di attributi delle variabili di dati
5681!!
5682!! Tutte le variabili sono inoltre disponibil1 in 5 tipi diversi:
5683!! - reale (abbreviato r)
5684!! - doppia precisione (abbreviato d)
5685!! - intero (abbreviato i)
5686!! - byte (abbreviato b)
5687!! - carattere (abbreviato c)
5688!!
5689!! Per ognuna delle dimensioni possibili, incluse le variabili e gli
5690!! attributi con i loro diversi tipi,
5691!! è definito un cosiddetto "vettore di descrittori", con un
5692!! numero di elementi pari all'estensione della dimensione stessa,
5693!! che contiene le informazioni necessarie a descrivere
5694!! gli elementi di quella dimensione.
5695!! In realtà l'utente non dovrà generalmente occuparsi di costruire
5696!! un oggetto vol7d con le proprie mani ma utilizzerà nella maggior parte
5697!! dei casi i metodi di importazione preconfezionati che importano dati da
5698!! DB-All.e (vol7d_dballe_class) o dal DB Oracle del SIM (vol7d_oraclesim_class).
5699!!
5700!!
5701!! Il programma esempio_v7d.f90 contiene un esempio elementare di uso
5702!! della classe vol7d:
5703!! \include esempio_v7d.f90
5704!!
5705!! \ingroup vol7d
5713USE io_units
5720IMPLICIT NONE
5721
5722
5723INTEGER, PARAMETER :: vol7d_maxdim_a = 3, vol7d_maxdim_aa = 4, &
5724 vol7d_maxdim_d = 6, vol7d_maxdim_ad = 7
5725
5726INTEGER, PARAMETER :: vol7d_ana_a=1 !< indice della dimensione "anagrafica" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
5727INTEGER, PARAMETER :: vol7d_var_a=2 !< indice della dimensione "variabile" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
5728INTEGER, PARAMETER :: vol7d_network_a=3 !< indice della dimensione "rete" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
5729INTEGER, PARAMETER :: vol7d_attr_a=4 !< indice della dimensione "attributo" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
5730INTEGER, PARAMETER :: vol7d_ana_d=1 !< indice della dimensione "anagrafica" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
5731INTEGER, PARAMETER :: vol7d_time_d=2 !< indice della dimensione "tempo" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
5732INTEGER, PARAMETER :: vol7d_level_d=3 !< indice della dimensione "livello verticale" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
5733INTEGER, PARAMETER :: vol7d_timerange_d=4 !< indice della dimensione "intervallo temporale" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
5734INTEGER, PARAMETER :: vol7d_var_d=5 !< indice della dimensione "variabile" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
5735INTEGER, PARAMETER :: vol7d_network_d=6 !< indice della dimensione "rete" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
5736INTEGER, PARAMETER :: vol7d_attr_d=7 !< indice della dimensione "attributo" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
5737INTEGER, PARAMETER :: vol7d_cdatalen=32
5738
5739TYPE vol7d_varmap
5740 INTEGER :: r, d, i, b, c
5741END TYPE vol7d_varmap
5742
5743!> Definisce un oggetto contenente i volumi anagrafica e dati e tutti
5744!! i descrittori delle loro dimensioni.
5746!> vettore descrittore della dimensione anagrafica
5747 TYPE(vol7d_ana),POINTER :: ana(:)
5748!> vettore descrittore della dimensione tempo
5749 TYPE(datetime),POINTER :: time(:)
5750!> vettore descrittore della dimensione livello verticale
5751 TYPE(vol7d_level),POINTER :: level(:)
5752!> vettore descrittore della dimensione intervallo temporale (timerange)
5753 TYPE(vol7d_timerange),POINTER :: timerange(:)
5754!> vettore descrittore della dimensione rete
5755 TYPE(vol7d_network),POINTER :: network(:)
5756!> vettore descrittore della dimensione variabile di anagrafica
5757 TYPE(vol7d_varvect) :: anavar
5758!> vettore descrittore della dimensione attributo delle variabili di anagrafica
5759 TYPE(vol7d_varvect) :: anaattr
5760!> vettore descrittore della dimensione variabile di anagrafica che ha tali attributi
5761 TYPE(vol7d_varvect) :: anavarattr
5762!> vettore descrittore della dimensione variabile di dati
5763 TYPE(vol7d_varvect) :: dativar
5764!> vettore descrittore della dimensione attributo delle variabili di dati
5765 TYPE(vol7d_varvect) :: datiattr
5766!> vettore descrittore della dimensione variabile di dati che ha tali attributi
5767 TYPE(vol7d_varvect) :: dativarattr
5768
5769!> volume di anagrafica a valori reali
5770 REAL,POINTER :: volanar(:,:,:)
5771!> volume di anagrafica a valori a doppia precisione
5772 DOUBLE PRECISION,POINTER :: volanad(:,:,:)
5773!> volume di anagrafica a valori interi
5774 INTEGER,POINTER :: volanai(:,:,:)
5775!> volume di anagrafica a valori byte
5776 INTEGER(kind=int_b),POINTER :: volanab(:,:,:)
5777!> volume di anagrafica a valori carattere
5778 CHARACTER(len=vol7d_cdatalen),POINTER :: volanac(:,:,:)
5779
5780!> volume di attributi di anagrafica a valori reali
5781 REAL,POINTER :: volanaattrr(:,:,:,:)
5782!> volume di attributi di anagrafica a valori a doppia precisione
5783 DOUBLE PRECISION,POINTER :: volanaattrd(:,:,:,:)
5784!> volume di attributi di anagrafica a valori interi
5785 INTEGER,POINTER :: volanaattri(:,:,:,:)
5786!> volume di attributi di anagrafica a valori byte
5787 INTEGER(kind=int_b),POINTER :: volanaattrb(:,:,:,:)
5788!> volume di attributi di anagrafica a valori carattere
5789 CHARACTER(len=vol7d_cdatalen),POINTER :: volanaattrc(:,:,:,:)
5790
5791!> volume di dati a valori reali
5792 REAL,POINTER :: voldatir(:,:,:,:,:,:) ! sono i dati
5793!> volume di dati a valori a doppia precisione
5794 DOUBLE PRECISION,POINTER :: voldatid(:,:,:,:,:,:)
5795!> volume di dati a valori interi
5796 INTEGER,POINTER :: voldatii(:,:,:,:,:,:)
5797!> volume di dati a valori byte
5798 INTEGER(kind=int_b),POINTER :: voldatib(:,:,:,:,:,:)
5799!> volume di dati a valori carattere
5800 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatic(:,:,:,:,:,:)
5801
5802!> volume di attributi di dati a valori reali
5803 REAL,POINTER :: voldatiattrr(:,:,:,:,:,:,:)
5804!> volume di attributi di dati a valori a doppia precisione
5805 DOUBLE PRECISION,POINTER :: voldatiattrd(:,:,:,:,:,:,:)
5806!> volume di attributi di dati a valori interi
5807 INTEGER,POINTER :: voldatiattri(:,:,:,:,:,:,:)
5808!> volume di attributi di dati a valori byte
5809 INTEGER(kind=int_b),POINTER :: voldatiattrb(:,:,:,:,:,:,:)
5810!> volume di attributi di dati a valori carattere
5811 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatiattrc(:,:,:,:,:,:,:)
5812
5813!> time definition; 0=time is reference time, 1=time is validity time
5814 integer :: time_definition
5815
5817
5818!> Costruttore per la classe vol7d.
5819!! Deve essere richiamato
5820!! per tutti gli oggetti di questo tipo definiti in un programma.
5822 MODULE PROCEDURE vol7d_init
5823END INTERFACE
5824
5825!> Distruttore per la classe vol7d.
5827 MODULE PROCEDURE vol7d_delete
5828END INTERFACE
5829
5830!> Scrittura su file.
5832 MODULE PROCEDURE vol7d_write_on_file
5833END INTERFACE
5834
5835!> Lettura da file.
5836INTERFACE import
5837 MODULE PROCEDURE vol7d_read_from_file
5838END INTERFACE
5839
5840!>Print object
5842 MODULE PROCEDURE vol7d_display, dat_display, dat_vect_display
5843END INTERFACE
5844
5845!>Represent data in a pretty string
5847 MODULE PROCEDURE to_char_dat
5848END INTERFACE
5849
5850!>doubleprecision data conversion
5852 MODULE PROCEDURE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
5853END INTERFACE
5854
5855!>real data conversion
5857 MODULE PROCEDURE realdatd,realdatr,realdati,realdatb,realdatc
5858END INTERFACE
5859
5860!>integer data conversion
5862 MODULE PROCEDURE integerdatd,integerdatr,integerdati,integerdatb,integerdatc
5863END INTERFACE
5864
5865!>copy object
5867 MODULE PROCEDURE vol7d_copy
5868END INTERFACE
5869
5870!> Test for a missing volume
5872 MODULE PROCEDURE vol7d_c_e
5873END INTERFACE
5874
5875!> Check for problems
5876!! return 0 if all check passed
5877!! print diagnostics with log4f
5879 MODULE PROCEDURE vol7d_check
5880END INTERFACE
5881
5882!> Reduce some dimensions (level and timerage) for semplification (rounding).
5883!! You can use this for simplify and use variables in computation like alchimia
5884!! where fields have to be on the same coordinate
5885!! It return real or character data only: if input is charcter data only it return character otherwise il return
5886!! all the data converted to real.
5887!! examples:
5888!! means in time for short periods and istantaneous values
5889!! 2 meter and surface levels
5890!! If there are data on more then one almost equal levels or timeranges, the first var present (at least one point)
5891!! will be taken (order is by icreasing var index).
5892!! You can use predefined values for classic semplification
5893!! almost_equal_levels and almost_equal_timeranges
5894!! The level or timerange in output will be defined by the first element of level and timerange list
5896 MODULE PROCEDURE v7d_rounding
5897END INTERFACE
5898
5899!!$INTERFACE get_volana
5900!!$ MODULE PROCEDURE vol7d_get_volanar, vol7d_get_volanad, vol7d_get_volanai, &
5901!!$ vol7d_get_volanab, vol7d_get_volanac
5902!!$END INTERFACE
5903!!$
5904!!$INTERFACE get_voldati
5905!!$ MODULE PROCEDURE vol7d_get_voldatir, vol7d_get_voldatid, vol7d_get_voldatii, &
5906!!$ vol7d_get_voldatib, vol7d_get_voldatic
5907!!$END INTERFACE
5908!!$
5909!!$INTERFACE get_volanaattr
5910!!$ MODULE PROCEDURE vol7d_get_volanaattrr, vol7d_get_volanaattrd, &
5911!!$ vol7d_get_volanaattri, vol7d_get_volanaattrb, vol7d_get_volanaattrc
5912!!$END INTERFACE
5913!!$
5914!!$INTERFACE get_voldatiattr
5915!!$ MODULE PROCEDURE vol7d_get_voldatiattrr, vol7d_get_voldatiattrd, &
5916!!$ vol7d_get_voldatiattri, vol7d_get_voldatiattrb, vol7d_get_voldatiattrc
5917!!$END INTERFACE
5918
5919PRIVATE vol7d_get_volr, vol7d_get_vold, vol7d_get_voli, vol7d_get_volb, &
5920 vol7d_get_volc, &
5921 volptr1dr, volptr2dr, volptr3dr, volptr4dr, volptr5dr, volptr6dr, volptr7dr, &
5922 volptr1dd, volptr2dd, volptr3dd, volptr4dd, volptr5dd, volptr6dd, volptr7dd, &
5923 volptr1di, volptr2di, volptr3di, volptr4di, volptr5di, volptr6di, volptr7di, &
5924 volptr1db, volptr2db, volptr3db, volptr4db, volptr5db, volptr6db, volptr7db, &
5925 volptr1dc, volptr2dc, volptr3dc, volptr4dc, volptr5dc, volptr6dc, volptr7dc, &
5926 vol7d_nullifyr, vol7d_nullifyd, vol7d_nullifyi, vol7d_nullifyb, vol7d_nullifyc, &
5927 vol7d_init, vol7d_delete, vol7d_write_on_file, vol7d_read_from_file, &
5928 vol7d_check_alloc_ana, vol7d_force_alloc_ana, &
5929 vol7d_check_alloc_dati, vol7d_force_alloc_dati, vol7d_force_alloc, &
5930 vol7d_display, dat_display, dat_vect_display, &
5931 to_char_dat, vol7d_check
5932
5933PRIVATE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
5934
5935PRIVATE vol7d_c_e
5936
5937CONTAINS
5938
5939
5940!> Inizializza un oggetto di tipo vol7d.
5941!! Non riceve alcun parametro tranne l'oggetto stesso. Attenzione, è necessario
5942!! comunque chiamare sempre il costruttore per evitare di avere dei puntatori in
5943!! uno stato indefinito.
5944SUBROUTINE vol7d_init(this,time_definition)
5945TYPE(vol7d),intent(out) :: this !< oggetto da inizializzare
5946integer,INTENT(IN),OPTIONAL :: time_definition !< 0=time is reference time ; 1=time is validity time (default=1)
5947
5954CALL vol7d_var_features_init() ! initialise var features table once
5955
5956NULLIFY(this%ana, this%time, this%level, this%timerange, this%network)
5957
5958NULLIFY(this%volanar, this%volanaattrr, this%voldatir, this%voldatiattrr)
5959NULLIFY(this%volanad, this%volanaattrd, this%voldatid, this%voldatiattrd)
5960NULLIFY(this%volanai, this%volanaattri, this%voldatii, this%voldatiattri)
5961NULLIFY(this%volanab, this%volanaattrb, this%voldatib, this%voldatiattrb)
5962NULLIFY(this%volanac, this%volanaattrc, this%voldatic, this%voldatiattrc)
5963
5964if(present(time_definition)) then
5965 this%time_definition=time_definition
5966else
5967 this%time_definition=1 !default to validity time
5968end if
5969
5970END SUBROUTINE vol7d_init
5971
5972
5973!> Distrugge l'oggetto in maniera pulita, liberando l'eventuale memoria
5974!! dinamicamente allocata. Permette di distruggere la sola parte di dati
5975!! mantenendo l'anagrafica.
5976ELEMENTAL SUBROUTINE vol7d_delete(this, dataonly)
5977TYPE(vol7d),intent(inout) :: this !< oggetto da distruggere
5978LOGICAL, INTENT(in), OPTIONAL :: dataonly !< dealloca solo i dati, tenendo l'anagrafica, (default \c .FALSE.)
5979
5980
5981IF (.NOT. optio_log(dataonly)) THEN
5982 IF (ASSOCIATED(this%volanar)) DEALLOCATE(this%volanar)
5983 IF (ASSOCIATED(this%volanad)) DEALLOCATE(this%volanad)
5984 IF (ASSOCIATED(this%volanai)) DEALLOCATE(this%volanai)
5985 IF (ASSOCIATED(this%volanab)) DEALLOCATE(this%volanab)
5986 IF (ASSOCIATED(this%volanac)) DEALLOCATE(this%volanac)
5987 IF (ASSOCIATED(this%volanaattrr)) DEALLOCATE(this%volanaattrr)
5988 IF (ASSOCIATED(this%volanaattrd)) DEALLOCATE(this%volanaattrd)
5989 IF (ASSOCIATED(this%volanaattri)) DEALLOCATE(this%volanaattri)
5990 IF (ASSOCIATED(this%volanaattrb)) DEALLOCATE(this%volanaattrb)
5991 IF (ASSOCIATED(this%volanaattrc)) DEALLOCATE(this%volanaattrc)
5992ENDIF
5993IF (ASSOCIATED(this%voldatir)) DEALLOCATE(this%voldatir)
5994IF (ASSOCIATED(this%voldatid)) DEALLOCATE(this%voldatid)
5995IF (ASSOCIATED(this%voldatii)) DEALLOCATE(this%voldatii)
5996IF (ASSOCIATED(this%voldatib)) DEALLOCATE(this%voldatib)
5997IF (ASSOCIATED(this%voldatic)) DEALLOCATE(this%voldatic)
5998IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
5999IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
6000IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
6001IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
6002IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
6003
6004IF (.NOT. optio_log(dataonly)) THEN
6005 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
6006 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
6007ENDIF
6008IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
6009IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
6010IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
6011
6012IF (.NOT. optio_log(dataonly)) THEN
6016ENDIF
6020
6021END SUBROUTINE vol7d_delete
6022
6023
6024
6025integer function vol7d_check(this)
6026TYPE(vol7d),intent(in) :: this !< object to check
6027integer :: i,j,k,l,m,n
6028
6029vol7d_check=0
6030
6031if (associated(this%voldatii)) then
6032do i = 1,size(this%voldatii,1)
6033 do j = 1,size(this%voldatii,2)
6034 do k = 1,size(this%voldatii,3)
6035 do l = 1,size(this%voldatii,4)
6036 do m = 1,size(this%voldatii,5)
6037 do n = 1,size(this%voldatii,6)
6038 if (this%voldatii(i,j,k,l,m,n) /= this%voldatii(i,j,k,l,m,n) ) then
6039 CALL l4f_log(l4f_warn,"check: abnormal value at voldatii("&
6041 vol7d_check=1
6042 end if
6043 end do
6044 end do
6045 end do
6046 end do
6047 end do
6048end do
6049end if
6050
6051
6052if (associated(this%voldatir)) then
6053do i = 1,size(this%voldatir,1)
6054 do j = 1,size(this%voldatir,2)
6055 do k = 1,size(this%voldatir,3)
6056 do l = 1,size(this%voldatir,4)
6057 do m = 1,size(this%voldatir,5)
6058 do n = 1,size(this%voldatir,6)
6059 if (this%voldatir(i,j,k,l,m,n) /= this%voldatir(i,j,k,l,m,n) ) then
6060 CALL l4f_log(l4f_warn,"check: abnormal value at voldatir("&
6062 vol7d_check=2
6063 end if
6064 end do
6065 end do
6066 end do
6067 end do
6068 end do
6069end do
6070end if
6071
6072if (associated(this%voldatid)) then
6073do i = 1,size(this%voldatid,1)
6074 do j = 1,size(this%voldatid,2)
6075 do k = 1,size(this%voldatid,3)
6076 do l = 1,size(this%voldatid,4)
6077 do m = 1,size(this%voldatid,5)
6078 do n = 1,size(this%voldatid,6)
6079 if (this%voldatid(i,j,k,l,m,n) /= this%voldatid(i,j,k,l,m,n) ) then
6080 CALL l4f_log(l4f_warn,"check: abnormal value at voldatid("&
6082 vol7d_check=3
6083 end if
6084 end do
6085 end do
6086 end do
6087 end do
6088 end do
6089end do
6090end if
6091
6092if (associated(this%voldatib)) then
6093do i = 1,size(this%voldatib,1)
6094 do j = 1,size(this%voldatib,2)
6095 do k = 1,size(this%voldatib,3)
6096 do l = 1,size(this%voldatib,4)
6097 do m = 1,size(this%voldatib,5)
6098 do n = 1,size(this%voldatib,6)
6099 if (this%voldatib(i,j,k,l,m,n) /= this%voldatib(i,j,k,l,m,n) ) then
6100 CALL l4f_log(l4f_warn,"check: abnormal value at voldatib("&
6102 vol7d_check=4
6103 end if
6104 end do
6105 end do
6106 end do
6107 end do
6108 end do
6109end do
6110end if
6111
6112end function vol7d_check
6113
6114
6115
6116!TODO da completare ! aborta se i volumi sono allocati a dimensione 0
6117!> stampa a video una sintesi del contenuto
6118SUBROUTINE vol7d_display(this)
6119TYPE(vol7d),intent(in) :: this !< oggetto da visualizzare
6120integer :: i
6121
6122REAL :: rdat
6123DOUBLE PRECISION :: ddat
6124INTEGER :: idat
6125INTEGER(kind=int_b) :: bdat
6126CHARACTER(len=vol7d_cdatalen) :: cdat
6127
6128
6129print*,"<<<<<<<<<<<<<<<<<<< vol7d object >>>>>>>>>>>>>>>>>>>>"
6130if (this%time_definition == 0) then
6131 print*,"TIME DEFINITION: time is reference time"
6132else if (this%time_definition == 1) then
6133 print*,"TIME DEFINITION: time is validity time"
6134else
6135 print*,"Time definition have a wrong walue:", this%time_definition
6136end if
6137
6138IF (ASSOCIATED(this%network))then
6139 print*,"---- network vector ----"
6140 print*,"elements=",size(this%network)
6141 do i=1, size(this%network)
6143 end do
6144end IF
6145
6146IF (ASSOCIATED(this%ana))then
6147 print*,"---- ana vector ----"
6148 print*,"elements=",size(this%ana)
6149 do i=1, size(this%ana)
6151 end do
6152end IF
6153
6154IF (ASSOCIATED(this%time))then
6155 print*,"---- time vector ----"
6156 print*,"elements=",size(this%time)
6157 do i=1, size(this%time)
6159 end do
6160end if
6161
6162IF (ASSOCIATED(this%level)) then
6163 print*,"---- level vector ----"
6164 print*,"elements=",size(this%level)
6165 do i =1,size(this%level)
6167 end do
6168end if
6169
6170IF (ASSOCIATED(this%timerange))then
6171 print*,"---- timerange vector ----"
6172 print*,"elements=",size(this%timerange)
6173 do i =1,size(this%timerange)
6175 end do
6176end if
6177
6178
6179print*,"---- ana vector ----"
6180print*,""
6181print*,"->>>>>>>>> anavar -"
6183print*,""
6184print*,"->>>>>>>>> anaattr -"
6186print*,""
6187print*,"->>>>>>>>> anavarattr -"
6189
6190print*,"-- ana data section (first point) --"
6191
6192idat=imiss
6193rdat=rmiss
6194ddat=dmiss
6195bdat=ibmiss
6196cdat=cmiss
6197
6198!ntime = MIN(SIZE(this%time),nprint)
6199!ntimerange = MIN(SIZE(this%timerange),nprint)
6200!nlevel = MIN(SIZE(this%level),nprint)
6201!nnetwork = MIN(SIZE(this%network),nprint)
6202!nana = MIN(SIZE(this%ana),nprint)
6203
6204IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0) THEN
6205if (associated(this%volanai)) then
6206 do i=1,size(this%anavar%i)
6207 idat=this%volanai(1,i,1)
6209 end do
6210end if
6211idat=imiss
6212
6213if (associated(this%volanar)) then
6214 do i=1,size(this%anavar%r)
6215 rdat=this%volanar(1,i,1)
6217 end do
6218end if
6219rdat=rmiss
6220
6221if (associated(this%volanad)) then
6222 do i=1,size(this%anavar%d)
6223 ddat=this%volanad(1,i,1)
6225 end do
6226end if
6227ddat=dmiss
6228
6229if (associated(this%volanab)) then
6230 do i=1,size(this%anavar%b)
6231 bdat=this%volanab(1,i,1)
6233 end do
6234end if
6235bdat=ibmiss
6236
6237if (associated(this%volanac)) then
6238 do i=1,size(this%anavar%c)
6239 cdat=this%volanac(1,i,1)
6241 end do
6242end if
6243cdat=cmiss
6244ENDIF
6245
6246print*,"---- data vector ----"
6247print*,""
6248print*,"->>>>>>>>> dativar -"
6250print*,""
6251print*,"->>>>>>>>> datiattr -"
6253print*,""
6254print*,"->>>>>>>>> dativarattr -"
6256
6257print*,"-- data data section (first point) --"
6258
6259idat=imiss
6260rdat=rmiss
6261ddat=dmiss
6262bdat=ibmiss
6263cdat=cmiss
6264
6265IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0 .AND. size(this%time) > 0 &
6266 .AND. size(this%level) > 0 .AND. size(this%timerange) > 0) THEN
6267if (associated(this%voldatii)) then
6268 do i=1,size(this%dativar%i)
6269 idat=this%voldatii(1,1,1,1,i,1)
6271 end do
6272end if
6273idat=imiss
6274
6275if (associated(this%voldatir)) then
6276 do i=1,size(this%dativar%r)
6277 rdat=this%voldatir(1,1,1,1,i,1)
6279 end do
6280end if
6281rdat=rmiss
6282
6283if (associated(this%voldatid)) then
6284 do i=1,size(this%dativar%d)
6285 ddat=this%voldatid(1,1,1,1,i,1)
6287 end do
6288end if
6289ddat=dmiss
6290
6291if (associated(this%voldatib)) then
6292 do i=1,size(this%dativar%b)
6293 bdat=this%voldatib(1,1,1,1,i,1)
6295 end do
6296end if
6297bdat=ibmiss
6298
6299if (associated(this%voldatic)) then
6300 do i=1,size(this%dativar%c)
6301 cdat=this%voldatic(1,1,1,1,i,1)
6303 end do
6304end if
6305cdat=cmiss
6306ENDIF
6307
6308print*,"<<<<<<<<<<<<<<<<<<< END vol7d object >>>>>>>>>>>>>>>>>>>>"
6309
6310END SUBROUTINE vol7d_display
6311
6312
6313!> stampa a video una sintesi del contenuto
6314SUBROUTINE dat_display(this,idat,rdat,ddat,bdat,cdat)
6315TYPE(vol7d_var),intent(in) :: this !< oggetto da visualizzare
6316!> real
6317REAL :: rdat
6318!> double precision
6319DOUBLE PRECISION :: ddat
6320!> integer
6321INTEGER :: idat
6322!> byte
6323INTEGER(kind=int_b) :: bdat
6324!> character
6325CHARACTER(len=*) :: cdat
6326
6327print *, to_char_dat(this,idat,rdat,ddat,bdat,cdat)
6328
6329end SUBROUTINE dat_display
6330
6331!> stampa a video una sintesi del contenuto
6332SUBROUTINE dat_vect_display(this,idat,rdat,ddat,bdat,cdat)
6333
6334TYPE(vol7d_var),intent(in) :: this(:) !< oggetto da visualizzare
6335!> real
6336REAL :: rdat(:)
6337!> double precision
6338DOUBLE PRECISION :: ddat(:)
6339!> integer
6340INTEGER :: idat(:)
6341!> byte
6342INTEGER(kind=int_b) :: bdat(:)
6343!> character
6344CHARACTER(len=*):: cdat(:)
6345
6346integer :: i
6347
6348do i =1,size(this)
6350end do
6351
6352end SUBROUTINE dat_vect_display
6353
6354
6355FUNCTION to_char_dat(this,idat,rdat,ddat,bdat,cdat)
6356#ifdef HAVE_DBALLE
6357USE dballef
6358#endif
6359TYPE(vol7d_var),INTENT(in) :: this
6360!> real
6361REAL :: rdat
6362!> double precision
6363DOUBLE PRECISION :: ddat
6364!> integer
6365INTEGER :: idat
6366!> byte
6367INTEGER(kind=int_b) :: bdat
6368!> character
6369CHARACTER(len=*) :: cdat
6370CHARACTER(len=80) :: to_char_dat
6371
6372CHARACTER(len=LEN(to_char_dat)) :: to_char_tmp
6373
6374
6375#ifdef HAVE_DBALLE
6376INTEGER :: handle, ier
6377
6378handle = 0
6379to_char_dat="VALUE: "
6380
6385
6387 ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
6388 ier = idba_spiegab(handle,this%btable,cdat,to_char_tmp)
6389 ier = idba_fatto(handle)
6390 to_char_dat=trim(to_char_dat)//" ;char> "//trim(to_char_tmp)
6391endif
6392
6393#else
6394
6395to_char_dat="VALUE: "
6401
6402#endif
6403
6404END FUNCTION to_char_dat
6405
6406
6407!> Tests whether anything has ever been assigned to a vol7d object
6408!! (.TRUE.) or it is as clean as after an init (.FALSE.).
6409FUNCTION vol7d_c_e(this) RESULT(c_e)
6410TYPE(vol7d), INTENT(in) :: this
6411
6412LOGICAL :: c_e
6413
6415 ASSOCIATED(this%level) .OR. ASSOCIATED(this%timerange) .OR. &
6416 ASSOCIATED(this%network) .OR. &
6417 ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
6418 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
6419 ASSOCIATED(this%anavar%c) .OR. &
6420 ASSOCIATED(this%anaattr%r) .OR. ASSOCIATED(this%anaattr%d) .OR. &
6421 ASSOCIATED(this%anaattr%i) .OR. ASSOCIATED(this%anaattr%b) .OR. &
6422 ASSOCIATED(this%anaattr%c) .OR. &
6423 ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
6424 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
6425 ASSOCIATED(this%dativar%c) .OR. &
6426 ASSOCIATED(this%datiattr%r) .OR. ASSOCIATED(this%datiattr%d) .OR. &
6427 ASSOCIATED(this%datiattr%i) .OR. ASSOCIATED(this%datiattr%b) .OR. &
6428 ASSOCIATED(this%datiattr%c)
6429
6430END FUNCTION vol7d_c_e
6431
6432
6433!> Metodo per allocare i descrittori delle 7 dimensioni.
6434!! Riceve un grande numero di parametri opzionali che
6435!! indicano quali descrittori allocare e con quale estensione;
6436!! i descrittori non specificati non vengono toccati.
6437!! Può essere quindi chiamato più volte allocando via via
6438!! descrittori relativi a dimensioni diverse.
6439!! Se un descrittore richiesto è già allocato, viene deallocato
6440!! (perdendone l'eventuale contenuto) e riallocato con l'estensione
6441!! richiesta.
6442!! Per i descrittori relativi a dimensioni che non siano variabili o attributi,
6443!! è possibile specificare l'estensione di una dimensione a 0,
6444!! in tal caso il descrittore viene comunque allocato con lunghezza nulla,
6445!! che è diverso da non allocarlo. Per i descrittori di variabili e attributi
6446!! passare un'estensione 0 equivale a non fornire il parametro.
6447!! Avere uno o più descrittori dimensionati con estensione nulla fa sì
6448!! che anche il volume dati successivamente allocato abbia estensione nulla;
6449!! sebbene ciò appaia inutile, un volume del genere può in realtà servire,
6450!! in associazione ai metodi ::vol7d_merge o ::vol7d_append per estendere
6451!! un volume esistente aggiungendo elementi in alcune dimensioni (quelle
6452!! a estensione non nulla, ovviamente) e mantenendo invariato tutto il resto.
6453!! Per quanto riguarda i descrittori delle dimensioni relative alle
6454!! variabili, la relativa estensione è specificata con la nomenclatura
6455!! \a n<x><y><z> dove <x> può valere:
6456!! - \a ana per variabili relative a voumi di anagrafica
6457!! - \a dati per variabili relative a voumi di dati
6458!!
6459!! <y> può valere:
6460!! - \a var per variabili
6461!! - \a attr per attributi
6462!! - \a varattr variabili aventi attributi nei volumi di attributi
6463!!
6464!! <z> può valere:
6465!! - \a r per variabili o attributi a valori reali
6466!! - \a d per variabili o attributi a valori a doppia precisione
6467!! - \a i per variabili o attributi a valori interi
6468!! - \a b per variabili o attributi a valori byte
6469!! - \a c per variabili o attributi a valori carattere
6470!!
6471SUBROUTINE vol7d_alloc(this, nana, ntime, nlevel, ntimerange, nnetwork, &
6472 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
6473 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
6474 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
6475 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
6476 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
6477 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc, &
6478 ini)
6479TYPE(vol7d),INTENT(inout) :: this !< oggetto di cui allocare i descrittori
6480INTEGER,INTENT(in),OPTIONAL :: nana !< estensione della dimensione anagrafica
6481INTEGER,INTENT(in),OPTIONAL :: ntime !< estensione della dimensione tempo
6482INTEGER,INTENT(in),OPTIONAL :: nlevel !< estensione della dimensione livello varticale
6483INTEGER,INTENT(in),OPTIONAL :: ntimerange !< estensione della dimensione intervallo temporale (timerange)
6484INTEGER,INTENT(in),OPTIONAL :: nnetwork !< estensione della dimensione rete
6485!> estensione delle possibili dimensioni variabile
6486INTEGER,INTENT(in),OPTIONAL :: &
6487 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
6488 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
6489 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
6490 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
6491 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
6492 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc
6493LOGICAL,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
6494
6495INTEGER :: i
6496LOGICAL :: linit
6497
6498IF (PRESENT(ini)) THEN
6499 linit = ini
6500ELSE
6501 linit = .false.
6502ENDIF
6503
6504! Dimensioni principali
6505IF (PRESENT(nana)) THEN
6506 IF (nana >= 0) THEN
6507 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
6508 ALLOCATE(this%ana(nana))
6509 IF (linit) THEN
6510 DO i = 1, nana
6512 ENDDO
6513 ENDIF
6514 ENDIF
6515ENDIF
6516IF (PRESENT(ntime)) THEN
6517 IF (ntime >= 0) THEN
6518 IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
6519 ALLOCATE(this%time(ntime))
6520 IF (linit) THEN
6521 DO i = 1, ntime
6523 ENDDO
6524 ENDIF
6525 ENDIF
6526ENDIF
6527IF (PRESENT(nlevel)) THEN
6528 IF (nlevel >= 0) THEN
6529 IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
6530 ALLOCATE(this%level(nlevel))
6531 IF (linit) THEN
6532 DO i = 1, nlevel
6534 ENDDO
6535 ENDIF
6536 ENDIF
6537ENDIF
6538IF (PRESENT(ntimerange)) THEN
6539 IF (ntimerange >= 0) THEN
6540 IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
6541 ALLOCATE(this%timerange(ntimerange))
6542 IF (linit) THEN
6543 DO i = 1, ntimerange
6545 ENDDO
6546 ENDIF
6547 ENDIF
6548ENDIF
6549IF (PRESENT(nnetwork)) THEN
6550 IF (nnetwork >= 0) THEN
6551 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
6552 ALLOCATE(this%network(nnetwork))
6553 IF (linit) THEN
6554 DO i = 1, nnetwork
6556 ENDDO
6557 ENDIF
6558 ENDIF
6559ENDIF
6560! Dimensioni dei tipi delle variabili
6561CALL vol7d_varvect_alloc(this%anavar, nanavarr, nanavard, &
6562 nanavari, nanavarb, nanavarc, ini)
6563CALL vol7d_varvect_alloc(this%anaattr, nanaattrr, nanaattrd, &
6564 nanaattri, nanaattrb, nanaattrc, ini)
6565CALL vol7d_varvect_alloc(this%anavarattr, nanavarattrr, nanavarattrd, &
6566 nanavarattri, nanavarattrb, nanavarattrc, ini)
6567CALL vol7d_varvect_alloc(this%dativar, ndativarr, ndativard, &
6568 ndativari, ndativarb, ndativarc, ini)
6569CALL vol7d_varvect_alloc(this%datiattr, ndatiattrr, ndatiattrd, &
6570 ndatiattri, ndatiattrb, ndatiattrc, ini)
6571CALL vol7d_varvect_alloc(this%dativarattr, ndativarattrr, ndativarattrd, &
6572 ndativarattri, ndativarattrb, ndativarattrc, ini)
6573
6574END SUBROUTINE vol7d_alloc
6575
6576
6577FUNCTION vol7d_check_alloc_ana(this)
6578TYPE(vol7d),INTENT(in) :: this
6579LOGICAL :: vol7d_check_alloc_ana
6580
6581vol7d_check_alloc_ana = ASSOCIATED(this%ana) .AND. ASSOCIATED(this%network)
6582
6583END FUNCTION vol7d_check_alloc_ana
6584
6585SUBROUTINE vol7d_force_alloc_ana(this, ini)
6586TYPE(vol7d),INTENT(inout) :: this
6587LOGICAL,INTENT(in),OPTIONAL :: ini
6588
6589! Alloco i descrittori minimi per avere un volume di anagrafica
6590IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=1, ini=ini)
6591IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=1, ini=ini)
6592
6593END SUBROUTINE vol7d_force_alloc_ana
6594
6595
6596FUNCTION vol7d_check_alloc_dati(this)
6597TYPE(vol7d),INTENT(in) :: this
6598LOGICAL :: vol7d_check_alloc_dati
6599
6600vol7d_check_alloc_dati = vol7d_check_alloc_ana(this) .AND. &
6601 ASSOCIATED(this%time) .AND. ASSOCIATED(this%level) .AND. &
6602 ASSOCIATED(this%timerange)
6603
6604END FUNCTION vol7d_check_alloc_dati
6605
6606SUBROUTINE vol7d_force_alloc_dati(this, ini)
6607TYPE(vol7d),INTENT(inout) :: this
6608LOGICAL,INTENT(in),OPTIONAL :: ini
6609
6610! Alloco i descrittori minimi per avere un volume di dati
6611CALL vol7d_force_alloc_ana(this, ini)
6612IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=1, ini=ini)
6613IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=1, ini=ini)
6614IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=1, ini=ini)
6615
6616END SUBROUTINE vol7d_force_alloc_dati
6617
6618
6619SUBROUTINE vol7d_force_alloc(this)
6620TYPE(vol7d),INTENT(inout) :: this
6621
6622! If anything really not allocated yet, allocate with size 0
6623IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=0)
6624IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=0)
6625IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=0)
6626IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=0)
6627IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=0)
6628
6629END SUBROUTINE vol7d_force_alloc
6630
6631
6632FUNCTION vol7d_check_vol(this)
6633TYPE(vol7d),INTENT(in) :: this !< oggetto da controllare
6634LOGICAL :: vol7d_check_vol
6635
6636vol7d_check_vol = c_e(this)
6637
6638! Anagrafica
6639IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
6640 vol7d_check_vol = .false.
6641ENDIF
6642
6643IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
6644 vol7d_check_vol = .false.
6645ENDIF
6646
6647IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
6648 vol7d_check_vol = .false.
6649ENDIF
6650
6651IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
6652 vol7d_check_vol = .false.
6653ENDIF
6654
6655IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
6656 vol7d_check_vol = .false.
6657ENDIF
6658IF (ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
6659 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
6660 ASSOCIATED(this%anavar%c)) THEN
6661 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_ana(this)
6662ENDIF
6663
6664! Attributi dell'anagrafica
6665IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
6666 .NOT.ASSOCIATED(this%volanaattrr)) THEN
6667 vol7d_check_vol = .false.
6668ENDIF
6669
6670IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
6671 .NOT.ASSOCIATED(this%volanaattrd)) THEN
6672 vol7d_check_vol = .false.
6673ENDIF
6674
6675IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
6676 .NOT.ASSOCIATED(this%volanaattri)) THEN
6677 vol7d_check_vol = .false.
6678ENDIF
6679
6680IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
6681 .NOT.ASSOCIATED(this%volanaattrb)) THEN
6682 vol7d_check_vol = .false.
6683ENDIF
6684
6685IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
6686 .NOT.ASSOCIATED(this%volanaattrc)) THEN
6687 vol7d_check_vol = .false.
6688ENDIF
6689
6690! Dati
6691IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
6692 vol7d_check_vol = .false.
6693ENDIF
6694
6695IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
6696 vol7d_check_vol = .false.
6697ENDIF
6698
6699IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
6700 vol7d_check_vol = .false.
6701ENDIF
6702
6703IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
6704 vol7d_check_vol = .false.
6705ENDIF
6706
6707IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
6708 vol7d_check_vol = .false.
6709ENDIF
6710
6711! Attributi dei dati
6712IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
6713 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
6714 vol7d_check_vol = .false.
6715ENDIF
6716
6717IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
6718 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
6719 vol7d_check_vol = .false.
6720ENDIF
6721
6722IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
6723 .NOT.ASSOCIATED(this%voldatiattri)) THEN
6724 vol7d_check_vol = .false.
6725ENDIF
6726
6727IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
6728 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
6729 vol7d_check_vol = .false.
6730ENDIF
6731
6732IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
6733 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
6734 vol7d_check_vol = .false.
6735ENDIF
6736IF (ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
6737 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
6738 ASSOCIATED(this%dativar%c)) THEN
6739 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_dati(this)
6740ENDIF
6741
6742END FUNCTION vol7d_check_vol
6743
6744
6745!> Metodo per allocare i volumi richiesti di variabili e attributi per
6746!! anagrafica e dati.
6747!! Se alcuni dei descrittori relativi alle dimensioni anagrafica,
6748!! livello verticale, tempo, intervallo temporale (timerange), rete non sono
6749!! stati richiesti preventivamente con la ::vol7d_alloc, essi vengono allocati
6750!! automaticamente da questo metodo
6751!! con estensione di default pari a 1 (non 0!), questo significa, ad esempio,
6752!! che se prevedo di avere soli dati superficiali, cioè ad un solo livello
6753!! verticale, o una sola rete di stazioni, non devo preoccuparmi di
6754!! specificare questa informazione.
6755!! Tra i 20 possibili volumi allocabili
6756!! ((variabili,attributi)*(anagrafica,dati)*(r,d,i,b,c)=20)
6757!! saranno allocati solo quelli per cui è stato precedentemente richiesto il
6758!! corrispondente descrittore variabili/attributi con la ::vol7d_alloc.
6759SUBROUTINE vol7d_alloc_vol(this, ini, inivol)
6760TYPE(vol7d),INTENT(inout) :: this !< oggetto di cui allocare i volumi
6761LOGICAL,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
6762LOGICAL,INTENT(in),OPTIONAL :: inivol !< se fornito e vale \c .TRUE., i volumi allocati saranno inizializzati a valore mancante
6763
6764LOGICAL :: linivol
6765
6766IF (PRESENT(inivol)) THEN
6767 linivol = inivol
6768ELSE
6769 linivol = .true.
6770ENDIF
6771
6772! Anagrafica
6773IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
6774 CALL vol7d_force_alloc_ana(this, ini)
6775 ALLOCATE(this%volanar(SIZE(this%ana), SIZE(this%anavar%r), SIZE(this%network)))
6776 IF (linivol) this%volanar(:,:,:) = rmiss
6777ENDIF
6778
6779IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
6780 CALL vol7d_force_alloc_ana(this, ini)
6781 ALLOCATE(this%volanad(SIZE(this%ana), SIZE(this%anavar%d), SIZE(this%network)))
6782 IF (linivol) this%volanad(:,:,:) = rdmiss
6783ENDIF
6784
6785IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
6786 CALL vol7d_force_alloc_ana(this, ini)
6787 ALLOCATE(this%volanai(SIZE(this%ana), SIZE(this%anavar%i), SIZE(this%network)))
6788 IF (linivol) this%volanai(:,:,:) = imiss
6789ENDIF
6790
6791IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
6792 CALL vol7d_force_alloc_ana(this, ini)
6793 ALLOCATE(this%volanab(SIZE(this%ana), SIZE(this%anavar%b), SIZE(this%network)))
6794 IF (linivol) this%volanab(:,:,:) = ibmiss
6795ENDIF
6796
6797IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
6798 CALL vol7d_force_alloc_ana(this, ini)
6799 ALLOCATE(this%volanac(SIZE(this%ana), SIZE(this%anavar%c), SIZE(this%network)))
6800 IF (linivol) this%volanac(:,:,:) = cmiss
6801ENDIF
6802
6803! Attributi dell'anagrafica
6804IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
6805 .NOT.ASSOCIATED(this%volanaattrr)) THEN
6806 CALL vol7d_force_alloc_ana(this, ini)
6807 ALLOCATE(this%volanaattrr(SIZE(this%ana), SIZE(this%anavarattr%r), &
6808 SIZE(this%network), SIZE(this%anaattr%r)))
6809 IF (linivol) this%volanaattrr(:,:,:,:) = rmiss
6810ENDIF
6811
6812IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
6813 .NOT.ASSOCIATED(this%volanaattrd)) THEN
6814 CALL vol7d_force_alloc_ana(this, ini)
6815 ALLOCATE(this%volanaattrd(SIZE(this%ana), SIZE(this%anavarattr%d), &
6816 SIZE(this%network), SIZE(this%anaattr%d)))
6817 IF (linivol) this%volanaattrd(:,:,:,:) = rdmiss
6818ENDIF
6819
6820IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
6821 .NOT.ASSOCIATED(this%volanaattri)) THEN
6822 CALL vol7d_force_alloc_ana(this, ini)
6823 ALLOCATE(this%volanaattri(SIZE(this%ana), SIZE(this%anavarattr%i), &
6824 SIZE(this%network), SIZE(this%anaattr%i)))
6825 IF (linivol) this%volanaattri(:,:,:,:) = imiss
6826ENDIF
6827
6828IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
6829 .NOT.ASSOCIATED(this%volanaattrb)) THEN
6830 CALL vol7d_force_alloc_ana(this, ini)
6831 ALLOCATE(this%volanaattrb(SIZE(this%ana), SIZE(this%anavarattr%b), &
6832 SIZE(this%network), SIZE(this%anaattr%b)))
6833 IF (linivol) this%volanaattrb(:,:,:,:) = ibmiss
6834ENDIF
6835
6836IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
6837 .NOT.ASSOCIATED(this%volanaattrc)) THEN
6838 CALL vol7d_force_alloc_ana(this, ini)
6839 ALLOCATE(this%volanaattrc(SIZE(this%ana), SIZE(this%anavarattr%c), &
6840 SIZE(this%network), SIZE(this%anaattr%c)))
6841 IF (linivol) this%volanaattrc(:,:,:,:) = cmiss
6842ENDIF
6843
6844! Dati
6845IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
6846 CALL vol7d_force_alloc_dati(this, ini)
6847 ALLOCATE(this%voldatir(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
6848 SIZE(this%timerange), SIZE(this%dativar%r), SIZE(this%network)))
6849 IF (linivol) this%voldatir(:,:,:,:,:,:) = rmiss
6850ENDIF
6851
6852IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
6853 CALL vol7d_force_alloc_dati(this, ini)
6854 ALLOCATE(this%voldatid(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
6855 SIZE(this%timerange), SIZE(this%dativar%d), SIZE(this%network)))
6856 IF (linivol) this%voldatid(:,:,:,:,:,:) = rdmiss
6857ENDIF
6858
6859IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
6860 CALL vol7d_force_alloc_dati(this, ini)
6861 ALLOCATE(this%voldatii(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
6862 SIZE(this%timerange), SIZE(this%dativar%i), SIZE(this%network)))
6863 IF (linivol) this%voldatii(:,:,:,:,:,:) = imiss
6864ENDIF
6865
6866IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
6867 CALL vol7d_force_alloc_dati(this, ini)
6868 ALLOCATE(this%voldatib(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
6869 SIZE(this%timerange), SIZE(this%dativar%b), SIZE(this%network)))
6870 IF (linivol) this%voldatib(:,:,:,:,:,:) = ibmiss
6871ENDIF
6872
6873IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
6874 CALL vol7d_force_alloc_dati(this, ini)
6875 ALLOCATE(this%voldatic(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
6876 SIZE(this%timerange), SIZE(this%dativar%c), SIZE(this%network)))
6877 IF (linivol) this%voldatic(:,:,:,:,:,:) = cmiss
6878ENDIF
6879
6880! Attributi dei dati
6881IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
6882 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
6883 CALL vol7d_force_alloc_dati(this, ini)
6884 ALLOCATE(this%voldatiattrr(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
6885 SIZE(this%timerange), SIZE(this%dativarattr%r), SIZE(this%network), &
6886 SIZE(this%datiattr%r)))
6887 IF (linivol) this%voldatiattrr(:,:,:,:,:,:,:) = rmiss
6888ENDIF
6889
6890IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
6891 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
6892 CALL vol7d_force_alloc_dati(this, ini)
6893 ALLOCATE(this%voldatiattrd(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
6894 SIZE(this%timerange), SIZE(this%dativarattr%d), SIZE(this%network), &
6895 SIZE(this%datiattr%d)))
6896 IF (linivol) this%voldatiattrd(:,:,:,:,:,:,:) = rdmiss
6897ENDIF
6898
6899IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
6900 .NOT.ASSOCIATED(this%voldatiattri)) THEN
6901 CALL vol7d_force_alloc_dati(this, ini)
6902 ALLOCATE(this%voldatiattri(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
6903 SIZE(this%timerange), SIZE(this%dativarattr%i), SIZE(this%network), &
6904 SIZE(this%datiattr%i)))
6905 IF (linivol) this%voldatiattri(:,:,:,:,:,:,:) = imiss
6906ENDIF
6907
6908IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
6909 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
6910 CALL vol7d_force_alloc_dati(this, ini)
6911 ALLOCATE(this%voldatiattrb(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
6912 SIZE(this%timerange), SIZE(this%dativarattr%b), SIZE(this%network), &
6913 SIZE(this%datiattr%b)))
6914 IF (linivol) this%voldatiattrb(:,:,:,:,:,:,:) = ibmiss
6915ENDIF
6916
6917IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
6918 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
6919 CALL vol7d_force_alloc_dati(this, ini)
6920 ALLOCATE(this%voldatiattrc(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
6921 SIZE(this%timerange), SIZE(this%dativarattr%c), SIZE(this%network), &
6922 SIZE(this%datiattr%c)))
6923 IF (linivol) this%voldatiattrc(:,:,:,:,:,:,:) = cmiss
6924ENDIF
6925
6926! Catch-all method
6927CALL vol7d_force_alloc(this)
6928
6929! Creo gli indici var-attr
6930
6931#ifdef DEBUG
6932CALL l4f_log(l4f_debug,"calling: vol7d_set_attr_ind")
6933#endif
6934
6935CALL vol7d_set_attr_ind(this)
6936
6937
6938
6939END SUBROUTINE vol7d_alloc_vol
6940
6941
6942!> Metodo per creare gli indici che associano le variabili aventi attributo
6943!! alle variabili nei relativi descrittori.
6944!! Ha senso chiamare questo metodo solo dopo che i descrittori delle variabili
6945!! e degli attributi desiderati sono stati allocati ed è stato assegnato un
6946!! valore ai relativi membri btable (vedi vol7d_var_class::vol7d_var), se
6947!! i descrittori non sono stati allocati o assegnati, il metodo non fa niente.
6948SUBROUTINE vol7d_set_attr_ind(this)
6949TYPE(vol7d),INTENT(inout) :: this !< oggetto in cui creare gli indici
6950
6951INTEGER :: i
6952
6953! real
6954IF (ASSOCIATED(this%dativar%r)) THEN
6955 IF (ASSOCIATED(this%dativarattr%r)) THEN
6956 DO i = 1, SIZE(this%dativar%r)
6957 this%dativar%r(i)%r = &
6958 firsttrue(this%dativar%r(i)%btable == this%dativarattr%r(:)%btable)
6959 ENDDO
6960 ENDIF
6961
6962 IF (ASSOCIATED(this%dativarattr%d)) THEN
6963 DO i = 1, SIZE(this%dativar%r)
6964 this%dativar%r(i)%d = &
6965 firsttrue(this%dativar%r(i)%btable == this%dativarattr%d(:)%btable)
6966 ENDDO
6967 ENDIF
6968
6969 IF (ASSOCIATED(this%dativarattr%i)) THEN
6970 DO i = 1, SIZE(this%dativar%r)
6971 this%dativar%r(i)%i = &
6972 firsttrue(this%dativar%r(i)%btable == this%dativarattr%i(:)%btable)
6973 ENDDO
6974 ENDIF
6975
6976 IF (ASSOCIATED(this%dativarattr%b)) THEN
6977 DO i = 1, SIZE(this%dativar%r)
6978 this%dativar%r(i)%b = &
6979 firsttrue(this%dativar%r(i)%btable == this%dativarattr%b(:)%btable)
6980 ENDDO
6981 ENDIF
6982
6983 IF (ASSOCIATED(this%dativarattr%c)) THEN
6984 DO i = 1, SIZE(this%dativar%r)
6985 this%dativar%r(i)%c = &
6986 firsttrue(this%dativar%r(i)%btable == this%dativarattr%c(:)%btable)
6987 ENDDO
6988 ENDIF
6989ENDIF
6990! double
6991IF (ASSOCIATED(this%dativar%d)) THEN
6992 IF (ASSOCIATED(this%dativarattr%r)) THEN
6993 DO i = 1, SIZE(this%dativar%d)
6994 this%dativar%d(i)%r = &
6995 firsttrue(this%dativar%d(i)%btable == this%dativarattr%r(:)%btable)
6996 ENDDO
6997 ENDIF
6998
6999 IF (ASSOCIATED(this%dativarattr%d)) THEN
7000 DO i = 1, SIZE(this%dativar%d)
7001 this%dativar%d(i)%d = &
7002 firsttrue(this%dativar%d(i)%btable == this%dativarattr%d(:)%btable)
7003 ENDDO
7004 ENDIF
7005
7006 IF (ASSOCIATED(this%dativarattr%i)) THEN
7007 DO i = 1, SIZE(this%dativar%d)
7008 this%dativar%d(i)%i = &
7009 firsttrue(this%dativar%d(i)%btable == this%dativarattr%i(:)%btable)
7010 ENDDO
7011 ENDIF
7012
7013 IF (ASSOCIATED(this%dativarattr%b)) THEN
7014 DO i = 1, SIZE(this%dativar%d)
7015 this%dativar%d(i)%b = &
7016 firsttrue(this%dativar%d(i)%btable == this%dativarattr%b(:)%btable)
7017 ENDDO
7018 ENDIF
7019
7020 IF (ASSOCIATED(this%dativarattr%c)) THEN
7021 DO i = 1, SIZE(this%dativar%d)
7022 this%dativar%d(i)%c = &
7023 firsttrue(this%dativar%d(i)%btable == this%dativarattr%c(:)%btable)
7024 ENDDO
7025 ENDIF
7026ENDIF
7027! integer
7028IF (ASSOCIATED(this%dativar%i)) THEN
7029 IF (ASSOCIATED(this%dativarattr%r)) THEN
7030 DO i = 1, SIZE(this%dativar%i)
7031 this%dativar%i(i)%r = &
7032 firsttrue(this%dativar%i(i)%btable == this%dativarattr%r(:)%btable)
7033 ENDDO
7034 ENDIF
7035
7036 IF (ASSOCIATED(this%dativarattr%d)) THEN
7037 DO i = 1, SIZE(this%dativar%i)
7038 this%dativar%i(i)%d = &
7039 firsttrue(this%dativar%i(i)%btable == this%dativarattr%d(:)%btable)
7040 ENDDO
7041 ENDIF
7042
7043 IF (ASSOCIATED(this%dativarattr%i)) THEN
7044 DO i = 1, SIZE(this%dativar%i)
7045 this%dativar%i(i)%i = &
7046 firsttrue(this%dativar%i(i)%btable == this%dativarattr%i(:)%btable)
7047 ENDDO
7048 ENDIF
7049
7050 IF (ASSOCIATED(this%dativarattr%b)) THEN
7051 DO i = 1, SIZE(this%dativar%i)
7052 this%dativar%i(i)%b = &
7053 firsttrue(this%dativar%i(i)%btable == this%dativarattr%b(:)%btable)
7054 ENDDO
7055 ENDIF
7056
7057 IF (ASSOCIATED(this%dativarattr%c)) THEN
7058 DO i = 1, SIZE(this%dativar%i)
7059 this%dativar%i(i)%c = &
7060 firsttrue(this%dativar%i(i)%btable == this%dativarattr%c(:)%btable)
7061 ENDDO
7062 ENDIF
7063ENDIF
7064! byte
7065IF (ASSOCIATED(this%dativar%b)) THEN
7066 IF (ASSOCIATED(this%dativarattr%r)) THEN
7067 DO i = 1, SIZE(this%dativar%b)
7068 this%dativar%b(i)%r = &
7069 firsttrue(this%dativar%b(i)%btable == this%dativarattr%r(:)%btable)
7070 ENDDO
7071 ENDIF
7072
7073 IF (ASSOCIATED(this%dativarattr%d)) THEN
7074 DO i = 1, SIZE(this%dativar%b)
7075 this%dativar%b(i)%d = &
7076 firsttrue(this%dativar%b(i)%btable == this%dativarattr%d(:)%btable)
7077 ENDDO
7078 ENDIF
7079
7080 IF (ASSOCIATED(this%dativarattr%i)) THEN
7081 DO i = 1, SIZE(this%dativar%b)
7082 this%dativar%b(i)%i = &
7083 firsttrue(this%dativar%b(i)%btable == this%dativarattr%i(:)%btable)
7084 ENDDO
7085 ENDIF
7086
7087 IF (ASSOCIATED(this%dativarattr%b)) THEN
7088 DO i = 1, SIZE(this%dativar%b)
7089 this%dativar%b(i)%b = &
7090 firsttrue(this%dativar%b(i)%btable == this%dativarattr%b(:)%btable)
7091 ENDDO
7092 ENDIF
7093
7094 IF (ASSOCIATED(this%dativarattr%c)) THEN
7095 DO i = 1, SIZE(this%dativar%b)
7096 this%dativar%b(i)%c = &
7097 firsttrue(this%dativar%b(i)%btable == this%dativarattr%c(:)%btable)
7098 ENDDO
7099 ENDIF
7100ENDIF
7101! character
7102IF (ASSOCIATED(this%dativar%c)) THEN
7103 IF (ASSOCIATED(this%dativarattr%r)) THEN
7104 DO i = 1, SIZE(this%dativar%c)
7105 this%dativar%c(i)%r = &
7106 firsttrue(this%dativar%c(i)%btable == this%dativarattr%r(:)%btable)
7107 ENDDO
7108 ENDIF
7109
7110 IF (ASSOCIATED(this%dativarattr%d)) THEN
7111 DO i = 1, SIZE(this%dativar%c)
7112 this%dativar%c(i)%d = &
7113 firsttrue(this%dativar%c(i)%btable == this%dativarattr%d(:)%btable)
7114 ENDDO
7115 ENDIF
7116
7117 IF (ASSOCIATED(this%dativarattr%i)) THEN
7118 DO i = 1, SIZE(this%dativar%c)
7119 this%dativar%c(i)%i = &
7120 firsttrue(this%dativar%c(i)%btable == this%dativarattr%i(:)%btable)
7121 ENDDO
7122 ENDIF
7123
7124 IF (ASSOCIATED(this%dativarattr%b)) THEN
7125 DO i = 1, SIZE(this%dativar%c)
7126 this%dativar%c(i)%b = &
7127 firsttrue(this%dativar%c(i)%btable == this%dativarattr%b(:)%btable)
7128 ENDDO
7129 ENDIF
7130
7131 IF (ASSOCIATED(this%dativarattr%c)) THEN
7132 DO i = 1, SIZE(this%dativar%c)
7133 this%dativar%c(i)%c = &
7134 firsttrue(this%dativar%c(i)%btable == this%dativarattr%c(:)%btable)
7135 ENDDO
7136 ENDIF
7137ENDIF
7138
7139END SUBROUTINE vol7d_set_attr_ind
7140
7141
7142!> Metodo per fondere 2 oggetti vol7d.
7143!! Il secondo volume viene accodato al primo e poi distrutto, si veda
7144!! quindi la descrizione di ::vol7d_append. Se uno degli oggetti \a
7145!! this o \a that sono vuoti non perde tempo inutile,
7146SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
7147 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
7148TYPE(vol7d),INTENT(INOUT) :: this !< primo oggetto in ingresso, alla fine conterrà il risultato della fusione
7149TYPE(vol7d),INTENT(INOUT) :: that !< secondo oggetto in ingresso, alla fine sarà distrutto
7150LOGICAL,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
7151LOGICAL,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
7152LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple ! experimental, please do not use outside the library now
7153
7154TYPE(vol7d) :: v7d_clean
7155
7156
7158 this = that
7160 that = v7d_clean ! destroy that without deallocating
7161ELSE ! Append that to this and destroy that
7163 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
7165ENDIF
7166
7167END SUBROUTINE vol7d_merge
7168
7169
7170!> Metodo per accodare un oggetto vol7d ad un altro.
7171!! Si tratta di un metodo molto potente e versatile;
7172!! i descrittori delle dimensioni del volume finale conterranno i valori
7173!! dei corrispondenti descrittori del primo e del secondo volume
7174!! e i volumi di anagrafica e dati conterranno i valori dei due volumi
7175!! ai posti giusti, e valori mancanti per le nuove combinazioni che
7176!! eventualmente si verranno a creare.
7177!! Se i volumi multidimensionali di anagrafica e/o dati dei 2 oggetti
7178!! hanno un'intersezione non nulla, negli elementi comuni il volume finale
7179!! conterrà il corrispondente elemento del \b secondo volume.
7180!! Attenzione che, durante l'esecuzione del metodo, la memoria richiesta è
7181!! pari alla memoria complessiva occupata dai 2 volumi iniziali più
7182!! la memoria complessiva del volume finale, per cui, nel caso di volumi grandi,
7183!! ci potrebbero essere problemi di esaurimento della memoria centrale.
7184!! Se l'oggetto \a that è vuoto non perde tempo inutile,
7185!!
7186!! \todo nel caso di elementi comuni inserire la possibiità (opzionale per
7187!! non penalizzare le prestazioni quando ciò non serve) di effettuare una scelta
7188!! più ragionata dell'elemento da tenere, almeno controllando i dati mancanti
7189!! se non le flag di qualità
7190!!
7191!! \todo "rateizzare" l'allocazione dei volumi per ridurre l'occupazione di
7192!! memoria nel caso siano allocati contemporaneamente volumi di variabili e
7193!! di attributi o più volumi di tipi diversi
7194!!
7195!! \todo il parametro \a that è dichiarato \a INOUT perché la vol7d_alloc_vol
7196!! può modificarlo, bisognerebbe implementare una vol7d_check_vol che restituisca
7197!! errore anziché usare la vol7d_alloc_vol.
7198SUBROUTINE vol7d_append(this, that, sort, bestdata, &
7199 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
7200TYPE(vol7d),INTENT(INOUT) :: this !< primo oggetto in ingresso, a cui sarà accodato il secondo
7201TYPE(vol7d),INTENT(IN) :: that !< secondo oggetto in ingresso, non viene modificato dal metodo
7202LOGICAL,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
7203! experimental, please do not use outside the library now, they force the use
7204! of a simplified mapping algorithm which is valid only whene the dimension
7205! content is the same in both volumes , or when one of them is empty
7206LOGICAL,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
7207LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple
7208
7209
7210TYPE(vol7d) :: v7dtmp
7211LOGICAL :: lsort, lbestdata
7212INTEGER,POINTER :: remapt1(:), remapt2(:), remaptr1(:), remaptr2(:), &
7213 remapl1(:), remapl2(:), remapa1(:), remapa2(:), remapn1(:), remapn2(:)
7214
7216IF (.NOT.vol7d_check_vol(that)) RETURN ! be safe
7219 RETURN
7220ENDIF
7221
7222IF (this%time_definition /= that%time_definition) THEN
7223 CALL l4f_log(l4f_fatal, &
7224 'in vol7d_append, cannot append volumes with different &
7225 &time definition')
7226 CALL raise_fatal_error()
7227ENDIF
7228
7229! Completo l'allocazione per avere volumi a norma
7230CALL vol7d_alloc_vol(this)
7231
7235
7236! Calcolo le mappature tra volumi vecchi e volume nuovo
7237! I puntatori remap* vengono tutti o allocati o nullificati
7238IF (optio_log(ltimesimple)) THEN
7239 CALL vol7d_remap2simple_datetime(this%time, that%time, v7dtmp%time, &
7240 lsort, remapt1, remapt2)
7241ELSE
7242 CALL vol7d_remap2_datetime(this%time, that%time, v7dtmp%time, &
7243 lsort, remapt1, remapt2)
7244ENDIF
7245IF (optio_log(ltimerangesimple)) THEN
7246 CALL vol7d_remap2simple_vol7d_timerange(this%timerange, that%timerange, &
7247 v7dtmp%timerange, lsort, remaptr1, remaptr2)
7248ELSE
7249 CALL vol7d_remap2_vol7d_timerange(this%timerange, that%timerange, &
7250 v7dtmp%timerange, lsort, remaptr1, remaptr2)
7251ENDIF
7252IF (optio_log(llevelsimple)) THEN
7253 CALL vol7d_remap2simple_vol7d_level(this%level, that%level, v7dtmp%level, &
7254 lsort, remapl1, remapl2)
7255ELSE
7256 CALL vol7d_remap2_vol7d_level(this%level, that%level, v7dtmp%level, &
7257 lsort, remapl1, remapl2)
7258ENDIF
7259IF (optio_log(lanasimple)) THEN
7260 CALL vol7d_remap2simple_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
7261 .false., remapa1, remapa2)
7262ELSE
7263 CALL vol7d_remap2_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
7264 .false., remapa1, remapa2)
7265ENDIF
7266IF (optio_log(lnetworksimple)) THEN
7267 CALL vol7d_remap2simple_vol7d_network(this%network, that%network, v7dtmp%network, &
7268 .false., remapn1, remapn2)
7269ELSE
7270 CALL vol7d_remap2_vol7d_network(this%network, that%network, v7dtmp%network, &
7271 .false., remapn1, remapn2)
7272ENDIF
7273
7274! Faccio la fusione fisica dei volumi
7275CALL vol7d_merge_finalr(this, that, v7dtmp, &
7276 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
7277 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
7278CALL vol7d_merge_finald(this, that, v7dtmp, &
7279 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
7280 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
7281CALL vol7d_merge_finali(this, that, v7dtmp, &
7282 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
7283 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
7284CALL vol7d_merge_finalb(this, that, v7dtmp, &
7285 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
7286 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
7287CALL vol7d_merge_finalc(this, that, v7dtmp, &
7288 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
7289 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
7290
7291! Dealloco i vettori di rimappatura
7292IF (ASSOCIATED(remapt1)) DEALLOCATE(remapt1)
7293IF (ASSOCIATED(remapt2)) DEALLOCATE(remapt2)
7294IF (ASSOCIATED(remaptr1)) DEALLOCATE(remaptr1)
7295IF (ASSOCIATED(remaptr2)) DEALLOCATE(remaptr2)
7296IF (ASSOCIATED(remapl1)) DEALLOCATE(remapl1)
7297IF (ASSOCIATED(remapl2)) DEALLOCATE(remapl2)
7298IF (ASSOCIATED(remapa1)) DEALLOCATE(remapa1)
7299IF (ASSOCIATED(remapa2)) DEALLOCATE(remapa2)
7300IF (ASSOCIATED(remapn1)) DEALLOCATE(remapn1)
7301IF (ASSOCIATED(remapn2)) DEALLOCATE(remapn2)
7302
7303! Distruggo il vecchio volume e assegno il nuovo a this
7305this = v7dtmp
7306! Ricreo gli indici var-attr
7307CALL vol7d_set_attr_ind(this)
7308
7309END SUBROUTINE vol7d_append
7310
7311
7312!> Metodo per creare una copia completa e indipendente di un oggetto vol7d.
7313!! Questo metodo crea un duplicato di tutti i membri di un oggetto vol7d,
7314!! con la possibilità di rielaborarlo durante la copia. Se l'oggetto da copiare
7315!! è vuoto non perde tempo inutile.
7316!! Attenzione, il codice:
7317!! \code
7318!! USE vol7d_class
7319!! TYPE(vol7d) :: vol1, vol2
7320!! CALL init(vol1)
7321!! CALL init(vol2)
7322!! ... ! riempio vol1
7323!! vol2 = vol1
7324!! \endcode
7325!! fa una cosa diversa rispetto a:
7326!! \code
7327!! USE vol7d_class
7328!! TYPE(vol7d) :: vol1, vol2
7329!! CALL init(vol1)
7330!! CALL init(vol2)
7331!! ... ! riempio vol1
7332!! CALL vol7d_copy(vol1, vol2)
7333!! \endcode
7334!! nel primo caso, infatti, l'operatore di assegnazione copia solo i componenti
7335!! statici di \a vol1 nei corrispondenti elementi di \a vol2, mentre i componenti che
7336!! sono allocati dinamicamente (cioè quelli che in ::vol7d hanno l'attributo
7337!! \c POINTER, in pratica quasi tutti) non vengono duplicati, ma per essi vol2
7338!! conterrà un puntatore al corrispondente elemento a cui già punta vol1, e quindi
7339!! eventuali cambiamenti al contenuto di uno dei due oggetti influenzerà il
7340!! contenuto dell'altro; nel secondo caso, invece, vol1 e vol2 sono, dopo la
7341!! vol7d_copy, 2 istanze
7342!! completamente indipendenti, ma uguali tra loro per contenuto, della classe
7343!! vol7d, e quindi hanno vita indipendente.
7344SUBROUTINE vol7d_copy(this, that, sort, unique, miss, &
7345 lsort_time, lsort_timerange, lsort_level, &
7346 ltime, ltimerange, llevel, lana, lnetwork, &
7347 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
7348 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
7349 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
7350 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
7351 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
7352 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
7353TYPE(vol7d),INTENT(IN) :: this !< oggetto origine
7354TYPE(vol7d),INTENT(INOUT) :: that !< oggetto destinazione
7355LOGICAL,INTENT(IN),OPTIONAL :: sort !< if present and \a .TRUE., sort all the sortable dimensions
7356LOGICAL,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)
7357LOGICAL,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
7358LOGICAL,INTENT(IN),OPTIONAL :: lsort_time !< if present and \a .TRUE., sort only time dimension (alternative to \a sort )
7359LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange !< if present and \a .TRUE., sort only timerange dimension (alternative to \a sort )
7360LOGICAL,INTENT(IN),OPTIONAL :: lsort_level !< if present and \a .TRUE., sort only level dimension (alternative to \a sort )
7361!> se fornito, deve essere un vettore logico della stessa lunghezza di
7362!! this%time indicante quali elementi della dimensione \a time
7363!! mantenere (valori \c .TRUE.) e quali scartare (valori \c .FALSE.)
7364!! nel volume copiato; in alternativa può essere un vettore di
7365!! lunghezza 1, in tal caso, se \c .FALSE. , equivale a scartare tutti
7366!! gli elementi (utile principalmente per le variabili); è compatibile
7367!! col parametro \a miss
7368LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
7369!> come il precedente per la dimensione \a timerange
7370LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
7371!> come il precedente per la dimensione \a level
7372LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
7373!> come il precedente per la dimensione \a ana
7374LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
7375!> come il precedente per la dimensione \a network
7376LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
7377!> come il precedente per tutte le possibili dimensioni variabile
7378LOGICAL,INTENT(in),OPTIONAL :: &
7379 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
7380 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
7381 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
7382 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
7383 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
7384 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
7385
7386LOGICAL :: lsort, lunique, lmiss
7387INTEGER,POINTER :: remapt(:), remaptr(:), remapl(:), remapa(:), remapn(:)
7388
7391IF (.NOT.vol7d_check_vol(this)) RETURN ! be safe
7392
7396
7397! Calcolo le mappature tra volume vecchio e volume nuovo
7398! I puntatori remap* vengono tutti o allocati o nullificati
7399CALL vol7d_remap1_datetime(this%time, that%time, &
7400 lsort.OR.optio_log(lsort_time), lunique, lmiss, remapt, ltime)
7401CALL vol7d_remap1_vol7d_timerange(this%timerange, that%timerange, &
7402 lsort.OR.optio_log(lsort_timerange), lunique, lmiss, remaptr, ltimerange)
7403CALL vol7d_remap1_vol7d_level(this%level, that%level, &
7404 lsort.OR.optio_log(lsort_level), lunique, lmiss, remapl, llevel)
7405CALL vol7d_remap1_vol7d_ana(this%ana, that%ana, &
7406 lsort, lunique, lmiss, remapa, lana)
7407CALL vol7d_remap1_vol7d_network(this%network, that%network, &
7408 lsort, lunique, lmiss, remapn, lnetwork)
7409
7410! lanavari, lanavarb, lanavarc, &
7411! lanaattri, lanaattrb, lanaattrc, &
7412! lanavarattri, lanavarattrb, lanavarattrc, &
7413! ldativari, ldativarb, ldativarc, &
7414! ldatiattri, ldatiattrb, ldatiattrc, &
7415! ldativarattri, ldativarattrb, ldativarattrc
7416! Faccio la riforma fisica dei volumi
7417CALL vol7d_reform_finalr(this, that, &
7418 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
7419 lanavarr, lanaattrr, lanavarattrr, ldativarr, ldatiattrr, ldativarattrr)
7420CALL vol7d_reform_finald(this, that, &
7421 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
7422 lanavard, lanaattrd, lanavarattrd, ldativard, ldatiattrd, ldativarattrd)
7423CALL vol7d_reform_finali(this, that, &
7424 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
7425 lanavari, lanaattri, lanavarattri, ldativari, ldatiattri, ldativarattri)
7426CALL vol7d_reform_finalb(this, that, &
7427 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
7428 lanavarb, lanaattrb, lanavarattrb, ldativarb, ldatiattrb, ldativarattrb)
7429CALL vol7d_reform_finalc(this, that, &
7430 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
7431 lanavarc, lanaattrc, lanavarattrc, ldativarc, ldatiattrc, ldativarattrc)
7432
7433! Dealloco i vettori di rimappatura
7434IF (ASSOCIATED(remapt)) DEALLOCATE(remapt)
7435IF (ASSOCIATED(remaptr)) DEALLOCATE(remaptr)
7436IF (ASSOCIATED(remapl)) DEALLOCATE(remapl)
7437IF (ASSOCIATED(remapa)) DEALLOCATE(remapa)
7438IF (ASSOCIATED(remapn)) DEALLOCATE(remapn)
7439
7440! Ricreo gli indici var-attr
7441CALL vol7d_set_attr_ind(that)
7442that%time_definition = this%time_definition
7443
7444END SUBROUTINE vol7d_copy
7445
7446
7447!> Metodo per riformare in varie maniere un oggetto vol7d.
7448!! Equivale ad una copia (vedi ::vol7d_copy)
7449!! seguita dalla distruzione del volume iniziale e alla
7450!! sua riassegnazione al volume copiato. Ha senso se almeno uno dei parametri
7451!! \a sort, \a uniq o \a miss è fornito uguale a \c .TRUE., altrimenti
7452!! è solo una perdita di tempo.
7453!! Può essere utile, ad esempio, per eliminare stazioni
7454!! o istanti temporali indesiderati, basta assegnare il loro corrispondente
7455!! elemento del descrittore a valore mancante e chiamare vol7d_reform
7456!! con miss=.TRUE. .
7457SUBROUTINE vol7d_reform(this, sort, unique, miss, &
7458 lsort_time, lsort_timerange, lsort_level, &
7459 ltime, ltimerange, llevel, lana, lnetwork, &
7460 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
7461 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
7462 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
7463 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
7464 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
7465 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc&
7466 ,purgeana)
7467TYPE(vol7d),INTENT(INOUT) :: this !< oggetto da riformare
7468LOGICAL,INTENT(IN),OPTIONAL :: sort !< if present and \a .TRUE., sort all the sortable dimensions
7469LOGICAL,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)
7470LOGICAL,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
7471LOGICAL,INTENT(IN),OPTIONAL :: lsort_time !< if present and \a .TRUE., sort only time dimension (alternative to \a sort )
7472LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange !< if present and \a .TRUE., sort only timerange dimension (alternative to \a sort )
7473LOGICAL,INTENT(IN),OPTIONAL :: lsort_level !< if present and \a .TRUE., sort only level dimension (alternative to \a sort )
7474!> se fornito, deve essere un vettore logico della stessa lunghezza di
7475!! this%time indicante quali elementi della dimensione \a time
7476!! mantenere (valori \c .TRUE.) e quali scartare (valori \c .FALSE.)
7477!! nel volume copiato; in alternativa può essere un vettore di
7478!! lunghezza 1, in tal caso, se \c .FALSE. , equivale a scartare tutti
7479!! gli elementi (utile principalmente per le variabili); è compatibile
7480!! col parametro \a miss
7481LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
7482LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:) !< come il precedente per la dimensione \a timerange
7483LOGICAL,INTENT(IN),OPTIONAL :: llevel(:) !< come il precedente per la dimensione \a level
7484LOGICAL,INTENT(IN),OPTIONAL :: lana(:) !< come il precedente per la dimensione \a ana
7485LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:) !< come il precedente per la dimensione \a network
7486!> come il precedente per tutte le possibili dimensioni variabile
7487LOGICAL,INTENT(in),OPTIONAL :: &
7488 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
7489 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
7490 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
7491 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
7492 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
7493 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
7494LOGICAL,INTENT(IN),OPTIONAL :: purgeana !< if true remove ana with all data missing
7495
7496TYPE(vol7d) :: v7dtmp
7497logical,allocatable :: llana(:)
7498integer :: i
7499
7501 lsort_time, lsort_timerange, lsort_level, &
7502 ltime, ltimerange, llevel, lana, lnetwork, &
7503 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
7504 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
7505 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
7506 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
7507 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
7508 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
7509
7510! destroy old volume
7512
7513if (optio_log(purgeana)) then
7514 allocate(llana(size(v7dtmp%ana)))
7515 llana =.false.
7516 do i =1,size(v7dtmp%ana)
7517 if (associated(v7dtmp%voldatii)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatii(i,:,:,:,:,:)))
7518 if (associated(v7dtmp%voldatir)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatir(i,:,:,:,:,:)))
7519 if (associated(v7dtmp%voldatid)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatid(i,:,:,:,:,:)))
7520 if (associated(v7dtmp%voldatib)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatib(i,:,:,:,:,:)))
7521 if (associated(v7dtmp%voldatic)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatic(i,:,:,:,:,:)))
7522 end do
7523 CALL vol7d_copy(v7dtmp, this,lana=llana)
7525 deallocate(llana)
7526else
7527 this=v7dtmp
7528end if
7529
7530END SUBROUTINE vol7d_reform
7531
7532
7533!> Sorts the sortable dimensions in the volume \a this only when necessary.
7534!! Most of the times, the time, timerange and level dimensions in a
7535!! vol7d object are correctly sorted; on the other side many methods
7536!! strictly rely on this fact in order to work correctly. This method
7537!! performs a quick check and sorts the required dimensions only if
7538!! they are not sorted in ascending order yet, improving safety
7539!! without impairing much performance.
7540SUBROUTINE vol7d_smart_sort(this, lsort_time, lsort_timerange, lsort_level)
7541TYPE(vol7d),INTENT(INOUT) :: this !< object to be sorted
7542LOGICAL,OPTIONAL,INTENT(in) :: lsort_time !< if present and \a .TRUE., sort time dimension if it is not sorted in ascending order
7543LOGICAL,OPTIONAL,INTENT(in) :: lsort_timerange !< if present and \a .TRUE., sort timerange dimension if it is not sorted in ascending order
7544LOGICAL,OPTIONAL,INTENT(in) :: lsort_level !< if present and \a .TRUE., sort vertical level dimension if it is not sorted in ascending order
7545
7546INTEGER :: i
7547LOGICAL :: to_be_sorted
7548
7549to_be_sorted = .false.
7550CALL vol7d_alloc_vol(this) ! usual safety check
7551
7552IF (optio_log(lsort_time)) THEN
7553 DO i = 2, SIZE(this%time)
7554 IF (this%time(i) < this%time(i-1)) THEN
7555 to_be_sorted = .true.
7556 EXIT
7557 ENDIF
7558 ENDDO
7559ENDIF
7560IF (optio_log(lsort_timerange)) THEN
7561 DO i = 2, SIZE(this%timerange)
7562 IF (this%timerange(i) < this%timerange(i-1)) THEN
7563 to_be_sorted = .true.
7564 EXIT
7565 ENDIF
7566 ENDDO
7567ENDIF
7568IF (optio_log(lsort_level)) THEN
7569 DO i = 2, SIZE(this%level)
7570 IF (this%level(i) < this%level(i-1)) THEN
7571 to_be_sorted = .true.
7572 EXIT
7573 ENDIF
7574 ENDDO
7575ENDIF
7576
7577IF (to_be_sorted) CALL vol7d_reform(this, &
7578 lsort_time=lsort_time, lsort_timerange=lsort_timerange, lsort_level=lsort_level )
7579
7580END SUBROUTINE vol7d_smart_sort
7581
7582!> Filter the contents of a volume keeping only desired data.
7583!! This subroutine filters a vol7d object by keeping only a subset of
7584!! the data contained. It can keep only times within a specified
7585!! interval, only station networks contained in a list and only
7586!! specified station or data variables. If a filter parameter is not
7587!! provided, no filtering will take place according to that criterion.
7588!! The volume is reallocated keeping only the desired data.
7589SUBROUTINE vol7d_filter(this, avl, vl, nl, s_d, e_d)
7590TYPE(vol7d),INTENT(inout) :: this !< volume to be filtered
7591CHARACTER(len=*),INTENT(in),OPTIONAL :: avl(:) !< list of station variables to be kept, if not provided or of zero length, all variables are kept
7592CHARACTER(len=*),INTENT(in),OPTIONAL :: vl(:) !< list of data variables to be kept, if not provided or of zero length, all variables are kept
7593TYPE(vol7d_network),OPTIONAL :: nl(:) !< list of station networks to be kept, if not provided or of zero length, all networks are kept
7594TYPE(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
7595TYPE(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
7596
7597INTEGER :: i
7598
7599IF (PRESENT(avl)) THEN
7600 IF (SIZE(avl) > 0) THEN
7601
7602 IF (ASSOCIATED(this%anavar%r)) THEN
7603 DO i = 1, SIZE(this%anavar%r)
7604 IF (all(this%anavar%r(i)%btable /= avl)) this%anavar%r(i) = vol7d_var_miss
7605 ENDDO
7606 ENDIF
7607
7608 IF (ASSOCIATED(this%anavar%i)) THEN
7609 DO i = 1, SIZE(this%anavar%i)
7610 IF (all(this%anavar%i(i)%btable /= avl)) this%anavar%i(i) = vol7d_var_miss
7611 ENDDO
7612 ENDIF
7613
7614 IF (ASSOCIATED(this%anavar%b)) THEN
7615 DO i = 1, SIZE(this%anavar%b)
7616 IF (all(this%anavar%b(i)%btable /= avl)) this%anavar%b(i) = vol7d_var_miss
7617 ENDDO
7618 ENDIF
7619
7620 IF (ASSOCIATED(this%anavar%d)) THEN
7621 DO i = 1, SIZE(this%anavar%d)
7622 IF (all(this%anavar%d(i)%btable /= avl)) this%anavar%d(i) = vol7d_var_miss
7623 ENDDO
7624 ENDIF
7625
7626 IF (ASSOCIATED(this%anavar%c)) THEN
7627 DO i = 1, SIZE(this%anavar%c)
7628 IF (all(this%anavar%c(i)%btable /= avl)) this%anavar%c(i) = vol7d_var_miss
7629 ENDDO
7630 ENDIF
7631
7632 ENDIF
7633ENDIF
7634
7635
7636IF (PRESENT(vl)) THEN
7637 IF (size(vl) > 0) THEN
7638 IF (ASSOCIATED(this%dativar%r)) THEN
7639 DO i = 1, SIZE(this%dativar%r)
7640 IF (all(this%dativar%r(i)%btable /= vl)) this%dativar%r(i) = vol7d_var_miss
7641 ENDDO
7642 ENDIF
7643
7644 IF (ASSOCIATED(this%dativar%i)) THEN
7645 DO i = 1, SIZE(this%dativar%i)
7646 IF (all(this%dativar%i(i)%btable /= vl)) this%dativar%i(i) = vol7d_var_miss
7647 ENDDO
7648 ENDIF
7649
7650 IF (ASSOCIATED(this%dativar%b)) THEN
7651 DO i = 1, SIZE(this%dativar%b)
7652 IF (all(this%dativar%b(i)%btable /= vl)) this%dativar%b(i) = vol7d_var_miss
7653 ENDDO
7654 ENDIF
7655
7656 IF (ASSOCIATED(this%dativar%d)) THEN
7657 DO i = 1, SIZE(this%dativar%d)
7658 IF (all(this%dativar%d(i)%btable /= vl)) this%dativar%d(i) = vol7d_var_miss
7659 ENDDO
7660 ENDIF
7661
7662 IF (ASSOCIATED(this%dativar%c)) THEN
7663 DO i = 1, SIZE(this%dativar%c)
7664 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
7665 ENDDO
7666 ENDIF
7667
7668 IF (ASSOCIATED(this%dativar%c)) THEN
7669 DO i = 1, SIZE(this%dativar%c)
7670 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
7671 ENDDO
7672 ENDIF
7673
7674 ENDIF
7675ENDIF
7676
7677IF (PRESENT(nl)) THEN
7678 IF (SIZE(nl) > 0) THEN
7679 DO i = 1, SIZE(this%network)
7680 IF (all(this%network(i) /= nl)) this%network(i) = vol7d_network_miss
7681 ENDDO
7682 ENDIF
7683ENDIF
7684
7685IF (PRESENT(s_d)) THEN
7687 WHERE (this%time < s_d)
7688 this%time = datetime_miss
7689 END WHERE
7690 ENDIF
7691ENDIF
7692
7693IF (PRESENT(e_d)) THEN
7695 WHERE (this%time > e_d)
7696 this%time = datetime_miss
7697 END WHERE
7698 ENDIF
7699ENDIF
7700
7701CALL vol7d_reform(this, miss=.true.)
7702
7703END SUBROUTINE vol7d_filter
7704
7705
7706!> Metodo per convertire i volumi di dati di un oggetto vol7d in dati
7707!! reali dove possibile. L'oggetto convertito è una copia completa
7708!! dell'originale che può essere quindi distrutto dopo la chiamata.
7709!! Per i dati di anagrafica, al momento sono convertiti solo
7710!! i dati CHARACTER se è passato \a anaconv=.TRUE.
7711!! Gli attributi non sono toccati.
7712SUBROUTINE vol7d_convr(this, that, anaconv)
7713TYPE(vol7d),INTENT(IN) :: this !< oggetto origine
7714TYPE(vol7d),INTENT(INOUT) :: that !< oggetto convertito
7715LOGICAL,OPTIONAL,INTENT(in) :: anaconv !< converti anche anagrafica
7716INTEGER :: i
7717LOGICAL :: fv(1)=(/.false./), tv(1)=(/.true./), acp(1), acn(1)
7718TYPE(vol7d) :: v7d_tmp
7719
7720IF (optio_log(anaconv)) THEN
7721 acp=fv
7722 acn=tv
7723ELSE
7724 acp=tv
7725 acn=fv
7726ENDIF
7727
7728! Volume con solo i dati reali e tutti gli attributi
7729! l'anagrafica e` copiata interamente se necessario
7730CALL vol7d_copy(this, that, &
7731 lanavarr=tv, lanavard=acp, lanavari=acp, lanavarb=acp, lanavarc=acp, &
7732 ldativarr=tv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=fv)
7733
7734! Volume solo di dati double
7735CALL vol7d_copy(this, v7d_tmp, &
7736 lanavarr=fv, lanavard=acn, lanavari=fv, lanavarb=fv, lanavarc=fv, &
7737 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
7738 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
7739 ldativarr=fv, ldativard=tv, ldativari=fv, ldativarb=fv, ldativarc=fv, &
7740 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
7741 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
7742
7743! converto a dati reali
7744IF (ASSOCIATED(v7d_tmp%anavar%d) .OR. ASSOCIATED(v7d_tmp%dativar%d)) THEN
7745
7746 IF (ASSOCIATED(v7d_tmp%anavar%d)) THEN
7747! alloco i dati reali e vi trasferisco i double
7748 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanad, 1), SIZE(v7d_tmp%volanad, 2), &
7749 SIZE(v7d_tmp%volanad, 3)))
7750 DO i = 1, SIZE(v7d_tmp%anavar%d)
7751 v7d_tmp%volanar(:,i,:) = &
7752 realdat(v7d_tmp%volanad(:,i,:), v7d_tmp%anavar%d(i))
7753 ENDDO
7754 DEALLOCATE(v7d_tmp%volanad)
7755! trasferisco le variabili
7756 v7d_tmp%anavar%r => v7d_tmp%anavar%d
7757 NULLIFY(v7d_tmp%anavar%d)
7758 ENDIF
7759
7760 IF (ASSOCIATED(v7d_tmp%dativar%d)) THEN
7761! alloco i dati reali e vi trasferisco i double
7762 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatid, 1), SIZE(v7d_tmp%voldatid, 2), &
7763 SIZE(v7d_tmp%voldatid, 3), SIZE(v7d_tmp%voldatid, 4), SIZE(v7d_tmp%voldatid, 5), &
7764 SIZE(v7d_tmp%voldatid, 6)))
7765 DO i = 1, SIZE(v7d_tmp%dativar%d)
7766 v7d_tmp%voldatir(:,:,:,:,i,:) = &
7767 realdat(v7d_tmp%voldatid(:,:,:,:,i,:), v7d_tmp%dativar%d(i))
7768 ENDDO
7769 DEALLOCATE(v7d_tmp%voldatid)
7770! trasferisco le variabili
7771 v7d_tmp%dativar%r => v7d_tmp%dativar%d
7772 NULLIFY(v7d_tmp%dativar%d)
7773 ENDIF
7774
7775! fondo con il volume definitivo
7776 CALL vol7d_merge(that, v7d_tmp)
7777ELSE
7779ENDIF
7780
7781
7782! Volume solo di dati interi
7783CALL vol7d_copy(this, v7d_tmp, &
7784 lanavarr=fv, lanavard=fv, lanavari=acn, lanavarb=fv, lanavarc=fv, &
7785 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
7786 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
7787 ldativarr=fv, ldativard=fv, ldativari=tv, ldativarb=fv, ldativarc=fv, &
7788 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
7789 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
7790
7791! converto a dati reali
7792IF (ASSOCIATED(v7d_tmp%anavar%i) .OR. ASSOCIATED(v7d_tmp%dativar%i)) THEN
7793
7794 IF (ASSOCIATED(v7d_tmp%anavar%i)) THEN
7795! alloco i dati reali e vi trasferisco gli interi
7796 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanai, 1), SIZE(v7d_tmp%volanai, 2), &
7797 SIZE(v7d_tmp%volanai, 3)))
7798 DO i = 1, SIZE(v7d_tmp%anavar%i)
7799 v7d_tmp%volanar(:,i,:) = &
7800 realdat(v7d_tmp%volanai(:,i,:), v7d_tmp%anavar%i(i))
7801 ENDDO
7802 DEALLOCATE(v7d_tmp%volanai)
7803! trasferisco le variabili
7804 v7d_tmp%anavar%r => v7d_tmp%anavar%i
7805 NULLIFY(v7d_tmp%anavar%i)
7806 ENDIF
7807
7808 IF (ASSOCIATED(v7d_tmp%dativar%i)) THEN
7809! alloco i dati reali e vi trasferisco gli interi
7810 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatii, 1), SIZE(v7d_tmp%voldatii, 2), &
7811 SIZE(v7d_tmp%voldatii, 3), SIZE(v7d_tmp%voldatii, 4), SIZE(v7d_tmp%voldatii, 5), &
7812 SIZE(v7d_tmp%voldatii, 6)))
7813 DO i = 1, SIZE(v7d_tmp%dativar%i)
7814 v7d_tmp%voldatir(:,:,:,:,i,:) = &
7815 realdat(v7d_tmp%voldatii(:,:,:,:,i,:), v7d_tmp%dativar%i(i))
7816 ENDDO
7817 DEALLOCATE(v7d_tmp%voldatii)
7818! trasferisco le variabili
7819 v7d_tmp%dativar%r => v7d_tmp%dativar%i
7820 NULLIFY(v7d_tmp%dativar%i)
7821 ENDIF
7822
7823! fondo con il volume definitivo
7824 CALL vol7d_merge(that, v7d_tmp)
7825ELSE
7827ENDIF
7828
7829
7830! Volume solo di dati byte
7831CALL vol7d_copy(this, v7d_tmp, &
7832 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=acn, lanavarc=fv, &
7833 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
7834 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
7835 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=tv, ldativarc=fv, &
7836 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
7837 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
7838
7839! converto a dati reali
7840IF (ASSOCIATED(v7d_tmp%anavar%b) .OR. ASSOCIATED(v7d_tmp%dativar%b)) THEN
7841
7842 IF (ASSOCIATED(v7d_tmp%anavar%b)) THEN
7843! alloco i dati reali e vi trasferisco i byte
7844 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanab, 1), SIZE(v7d_tmp%volanab, 2), &
7845 SIZE(v7d_tmp%volanab, 3)))
7846 DO i = 1, SIZE(v7d_tmp%anavar%b)
7847 v7d_tmp%volanar(:,i,:) = &
7848 realdat(v7d_tmp%volanab(:,i,:), v7d_tmp%anavar%b(i))
7849 ENDDO
7850 DEALLOCATE(v7d_tmp%volanab)
7851! trasferisco le variabili
7852 v7d_tmp%anavar%r => v7d_tmp%anavar%b
7853 NULLIFY(v7d_tmp%anavar%b)
7854 ENDIF
7855
7856 IF (ASSOCIATED(v7d_tmp%dativar%b)) THEN
7857! alloco i dati reali e vi trasferisco i byte
7858 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatib, 1), SIZE(v7d_tmp%voldatib, 2), &
7859 SIZE(v7d_tmp%voldatib, 3), SIZE(v7d_tmp%voldatib, 4), SIZE(v7d_tmp%voldatib, 5), &
7860 SIZE(v7d_tmp%voldatib, 6)))
7861 DO i = 1, SIZE(v7d_tmp%dativar%b)
7862 v7d_tmp%voldatir(:,:,:,:,i,:) = &
7863 realdat(v7d_tmp%voldatib(:,:,:,:,i,:), v7d_tmp%dativar%b(i))
7864 ENDDO
7865 DEALLOCATE(v7d_tmp%voldatib)
7866! trasferisco le variabili
7867 v7d_tmp%dativar%r => v7d_tmp%dativar%b
7868 NULLIFY(v7d_tmp%dativar%b)
7869 ENDIF
7870
7871! fondo con il volume definitivo
7872 CALL vol7d_merge(that, v7d_tmp)
7873ELSE
7875ENDIF
7876
7877
7878! Volume solo di dati character
7879CALL vol7d_copy(this, v7d_tmp, &
7880 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=fv, lanavarc=acn, &
7881 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
7882 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
7883 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=tv, &
7884 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
7885 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
7886
7887! converto a dati reali
7888IF (ASSOCIATED(v7d_tmp%anavar%c) .OR. ASSOCIATED(v7d_tmp%dativar%c)) THEN
7889
7890 IF (ASSOCIATED(v7d_tmp%anavar%c)) THEN
7891! alloco i dati reali e vi trasferisco i character
7892 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanac, 1), SIZE(v7d_tmp%volanac, 2), &
7893 SIZE(v7d_tmp%volanac, 3)))
7894 DO i = 1, SIZE(v7d_tmp%anavar%c)
7895 v7d_tmp%volanar(:,i,:) = &
7896 realdat(v7d_tmp%volanac(:,i,:), v7d_tmp%anavar%c(i))
7897 ENDDO
7898 DEALLOCATE(v7d_tmp%volanac)
7899! trasferisco le variabili
7900 v7d_tmp%anavar%r => v7d_tmp%anavar%c
7901 NULLIFY(v7d_tmp%anavar%c)
7902 ENDIF
7903
7904 IF (ASSOCIATED(v7d_tmp%dativar%c)) THEN
7905! alloco i dati reali e vi trasferisco i character
7906 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatic, 1), SIZE(v7d_tmp%voldatic, 2), &
7907 SIZE(v7d_tmp%voldatic, 3), SIZE(v7d_tmp%voldatic, 4), SIZE(v7d_tmp%voldatic, 5), &
7908 SIZE(v7d_tmp%voldatic, 6)))
7909 DO i = 1, SIZE(v7d_tmp%dativar%c)
7910 v7d_tmp%voldatir(:,:,:,:,i,:) = &
7911 realdat(v7d_tmp%voldatic(:,:,:,:,i,:), v7d_tmp%dativar%c(i))
7912 ENDDO
7913 DEALLOCATE(v7d_tmp%voldatic)
7914! trasferisco le variabili
7915 v7d_tmp%dativar%r => v7d_tmp%dativar%c
7916 NULLIFY(v7d_tmp%dativar%c)
7917 ENDIF
7918
7919! fondo con il volume definitivo
7920 CALL vol7d_merge(that, v7d_tmp)
7921ELSE
7923ENDIF
7924
7925END SUBROUTINE vol7d_convr
7926
7927
7928!> Metodo per ottenere solo le differenze tra due oggetti vol7d.
7929!! Il primo volume viene confrontato col secondo; nel secondo volume ovunque
7930!! i dati confrontati siano coincidenti viene impostato valore mancante.
7931SUBROUTINE vol7d_diff_only (this, that, data_only,ana)
7932TYPE(vol7d),INTENT(IN) :: this !< primo volume da confrontare
7933TYPE(vol7d),INTENT(OUT) :: that !< secondo volume da confrontare in cui eliminare i dati coincidenti
7934logical , optional, intent(in) :: data_only !< attiva l'elaborazione dei soli dati e non dell'anagrafica (default: .false.)
7935logical , optional, intent(in) :: ana !< attiva l'elaborazione dell'anagrafica (coordinate e ident) (default: .false.)
7936logical :: ldata_only,lana
7937
7938IF (PRESENT(data_only)) THEN
7939 ldata_only = data_only
7940ELSE
7941 ldata_only = .false.
7942ENDIF
7943
7944IF (PRESENT(ana)) THEN
7945 lana = ana
7946ELSE
7947 lana = .false.
7948ENDIF
7949
7950
7951#undef VOL7D_POLY_ARRAY
7952#define VOL7D_POLY_ARRAY voldati
7953#include "vol7d_class_diff.F90"
7954#undef VOL7D_POLY_ARRAY
7955#define VOL7D_POLY_ARRAY voldatiattr
7956#include "vol7d_class_diff.F90"
7957#undef VOL7D_POLY_ARRAY
7958
7959if ( .not. ldata_only) then
7960
7961#define VOL7D_POLY_ARRAY volana
7962#include "vol7d_class_diff.F90"
7963#undef VOL7D_POLY_ARRAY
7964#define VOL7D_POLY_ARRAY volanaattr
7965#include "vol7d_class_diff.F90"
7966#undef VOL7D_POLY_ARRAY
7967
7968 if(lana)then
7969 where ( this%ana == that%ana )
7970 that%ana = vol7d_ana_miss
7971 end where
7972 end if
7973
7974end if
7975
7976
7977
7978END SUBROUTINE vol7d_diff_only
7979
7980
7981
7982! Creo le routine da ripetere per i vari tipi di dati di v7d
7983! tramite un template e il preprocessore
7984#undef VOL7D_POLY_TYPE
7985#undef VOL7D_POLY_TYPES
7986#define VOL7D_POLY_TYPE REAL
7987#define VOL7D_POLY_TYPES r
7988#include "vol7d_class_type_templ.F90"
7989#undef VOL7D_POLY_TYPE
7990#undef VOL7D_POLY_TYPES
7991#define VOL7D_POLY_TYPE DOUBLE PRECISION
7992#define VOL7D_POLY_TYPES d
7993#include "vol7d_class_type_templ.F90"
7994#undef VOL7D_POLY_TYPE
7995#undef VOL7D_POLY_TYPES
7996#define VOL7D_POLY_TYPE INTEGER
7997#define VOL7D_POLY_TYPES i
7998#include "vol7d_class_type_templ.F90"
7999#undef VOL7D_POLY_TYPE
8000#undef VOL7D_POLY_TYPES
8001#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
8002#define VOL7D_POLY_TYPES b
8003#include "vol7d_class_type_templ.F90"
8004#undef VOL7D_POLY_TYPE
8005#undef VOL7D_POLY_TYPES
8006#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
8007#define VOL7D_POLY_TYPES c
8008#include "vol7d_class_type_templ.F90"
8009
8010! Creo le routine da ripetere per i vari descrittori di dimensioni di v7d
8011! tramite un template e il preprocessore
8012#define VOL7D_SORT
8013#undef VOL7D_NO_ZERO_ALLOC
8014#undef VOL7D_POLY_TYPE
8015#define VOL7D_POLY_TYPE datetime
8016#include "vol7d_class_desc_templ.F90"
8017#undef VOL7D_POLY_TYPE
8018#define VOL7D_POLY_TYPE vol7d_timerange
8019#include "vol7d_class_desc_templ.F90"
8020#undef VOL7D_POLY_TYPE
8021#define VOL7D_POLY_TYPE vol7d_level
8022#include "vol7d_class_desc_templ.F90"
8023#undef VOL7D_SORT
8024#undef VOL7D_POLY_TYPE
8025#define VOL7D_POLY_TYPE vol7d_network
8026#include "vol7d_class_desc_templ.F90"
8027#undef VOL7D_POLY_TYPE
8028#define VOL7D_POLY_TYPE vol7d_ana
8029#include "vol7d_class_desc_templ.F90"
8030#define VOL7D_NO_ZERO_ALLOC
8031#undef VOL7D_POLY_TYPE
8032#define VOL7D_POLY_TYPE vol7d_var
8033#include "vol7d_class_desc_templ.F90"
8034
8035!>\brief Scrittura su file di un volume Vol7d.
8036!! Scrittura su file unformatted di un intero volume Vol7d.
8037!! Il volume viene serializzato e scritto su file.
8038!! Il file puo' essere aperto opzionalmente dall'utente. Si possono passare
8039!! opzionalmente unità e nome del file altrimenti assegnati internamente a dei default; se assegnati internamente
8040!! tali parametri saranno in output.
8041!! Se non viene fornito il nome file viene utilizzato un file di default con nome pari al nome del programma in
8042!! esecuzione con postfisso ".v7d".
8043!! Come parametro opzionale c'è la description che insieme alla data corrente viene inserita nell'header del file.
8044subroutine vol7d_write_on_file (this,unit,description,filename,filename_auto)
8045
8046TYPE(vol7d),INTENT(IN) :: this !< volume vol7d da scrivere
8047integer,optional,intent(inout) :: unit !< unità su cui scrivere; se passata =0 ritorna il valore rielaborato (default =rielaborato internamente con getlun )
8048character(len=*),intent(in),optional :: filename !< nome del file su cui scrivere
8049character(len=*),intent(out),optional :: filename_auto !< nome del file generato se "filename" è omesso
8050character(len=*),INTENT(IN),optional :: description !< descrizione del volume
8051
8052integer :: lunit
8053character(len=254) :: ldescription,arg,lfilename
8054integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
8055 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
8056 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
8057 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
8058 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
8059 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
8060 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
8061!integer :: im,id,iy
8062integer :: tarray(8)
8063logical :: opened,exist
8064
8065 nana=0
8066 ntime=0
8067 ntimerange=0
8068 nlevel=0
8069 nnetwork=0
8070 ndativarr=0
8071 ndativari=0
8072 ndativarb=0
8073 ndativard=0
8074 ndativarc=0
8075 ndatiattrr=0
8076 ndatiattri=0
8077 ndatiattrb=0
8078 ndatiattrd=0
8079 ndatiattrc=0
8080 ndativarattrr=0
8081 ndativarattri=0
8082 ndativarattrb=0
8083 ndativarattrd=0
8084 ndativarattrc=0
8085 nanavarr=0
8086 nanavari=0
8087 nanavarb=0
8088 nanavard=0
8089 nanavarc=0
8090 nanaattrr=0
8091 nanaattri=0
8092 nanaattrb=0
8093 nanaattrd=0
8094 nanaattrc=0
8095 nanavarattrr=0
8096 nanavarattri=0
8097 nanavarattrb=0
8098 nanavarattrd=0
8099 nanavarattrc=0
8100
8101
8102!call idate(im,id,iy)
8103call date_and_time(values=tarray)
8104call getarg(0,arg)
8105
8106if (present(description))then
8107 ldescription=description
8108else
8109 ldescription="Vol7d generated by: "//trim(arg)
8110end if
8111
8112if (.not. present(unit))then
8113 lunit=getunit()
8114else
8115 if (unit==0)then
8116 lunit=getunit()
8117 unit=lunit
8118 else
8119 lunit=unit
8120 end if
8121end if
8122
8123lfilename=trim(arg)//".v7d"
8125
8126if (present(filename))then
8127 if (filename /= "")then
8128 lfilename=filename
8129 end if
8130end if
8131
8132if (present(filename_auto))filename_auto=lfilename
8133
8134
8135inquire(unit=lunit,opened=opened)
8136if (.not. opened) then
8137! inquire(file=lfilename, EXIST=exist)
8138! IF (exist) THEN
8139! CALL l4f_log(L4F_FATAL, &
8140! 'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename))
8141! CALL raise_fatal_error()
8142! ENDIF
8143 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM')
8144 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
8145end if
8146
8147if (associated(this%ana)) nana=size(this%ana)
8148if (associated(this%time)) ntime=size(this%time)
8149if (associated(this%timerange)) ntimerange=size(this%timerange)
8150if (associated(this%level)) nlevel=size(this%level)
8151if (associated(this%network)) nnetwork=size(this%network)
8152
8153if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
8154if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
8155if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
8156if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
8157if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
8158
8159if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
8160if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
8161if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
8162if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
8163if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)
8164
8165if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
8166if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
8167if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
8168if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
8169if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
8170
8171if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
8172if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
8173if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
8174if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
8175if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
8176
8177if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
8178if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
8179if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
8180if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
8181if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)
8182
8183if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
8184if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
8185if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
8186if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
8187if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)
8188
8189write(unit=lunit)ldescription
8190write(unit=lunit)tarray
8191
8192write(unit=lunit)&
8193 nana, ntime, ntimerange, nlevel, nnetwork, &
8194 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
8195 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
8196 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
8197 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
8198 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
8199 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
8200 this%time_definition
8201
8202
8203!write(unit=lunit)this
8204
8205
8206!! prime 5 dimensioni
8209if (associated(this%level)) write(unit=lunit)this%level
8210if (associated(this%timerange)) write(unit=lunit)this%timerange
8211if (associated(this%network)) write(unit=lunit)this%network
8212
8213 !! 6a dimensione: variabile dell'anagrafica e dei dati
8214 !! con relativi attributi e in 5 tipi diversi
8215
8216if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r
8217if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i
8218if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b
8219if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d
8220if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c
8221
8222if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r
8223if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i
8224if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b
8225if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d
8226if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c
8227
8228if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r
8229if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i
8230if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b
8231if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d
8232if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c
8233
8234if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r
8235if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i
8236if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b
8237if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d
8238if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c
8239
8240if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r
8241if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i
8242if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b
8243if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d
8244if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c
8245
8246if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
8247if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
8248if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
8249if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
8250if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c
8251
8252!! Volumi di valori e attributi per anagrafica e dati
8253
8254if (associated(this%volanar)) write(unit=lunit)this%volanar
8255if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr
8256if (associated(this%voldatir)) write(unit=lunit)this%voldatir
8257if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr
8258
8259if (associated(this%volanai)) write(unit=lunit)this%volanai
8260if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri
8261if (associated(this%voldatii)) write(unit=lunit)this%voldatii
8262if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri
8263
8264if (associated(this%volanab)) write(unit=lunit)this%volanab
8265if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb
8266if (associated(this%voldatib)) write(unit=lunit)this%voldatib
8267if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb
8268
8269if (associated(this%volanad)) write(unit=lunit)this%volanad
8270if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd
8271if (associated(this%voldatid)) write(unit=lunit)this%voldatid
8272if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd
8273
8274if (associated(this%volanac)) write(unit=lunit)this%volanac
8275if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc
8276if (associated(this%voldatic)) write(unit=lunit)this%voldatic
8277if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc
8278
8279if (.not. present(unit)) close(unit=lunit)
8280
8281end subroutine vol7d_write_on_file
8282
8283
8284!>\brief Lettura da file di un volume Vol7d.
8285!! Lettura da file unformatted di un intero volume Vol7d.
8286!! Questa subroutine comprende vol7d_alloc e vol7d_alloc_vol.
8287!! Il file puo' essere aperto opzionalmente dall'utente. Si possono passare
8288!! opzionalmente unità e nome del file altrimenti assegnati internamente a dei default; se assegnati internamente
8289!! tali parametri saranno in output.
8290
8291
8292subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
8293
8294TYPE(vol7d),INTENT(OUT) :: this !< Volume vol7d da leggere
8295integer,intent(inout),optional :: unit !< unità su cui è stato aperto un file; se =0 rielaborato internamente (default = elaborato internamente con getunit)
8296character(len=*),INTENT(in),optional :: filename !< nome del file eventualmente da aprire (default = (nome dell'eseguibile)//.v7d )
8297character(len=*),intent(out),optional :: filename_auto !< nome del file generato se "filename" è omesso
8298character(len=*),INTENT(out),optional :: description !< descrizione del volume letto
8299integer,intent(out),optional :: tarray(8) !< vettore come definito da "date_and_time" della data di scrittura del volume
8300
8301
8302integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
8303 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
8304 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
8305 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
8306 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
8307 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
8308 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
8309
8310character(len=254) :: ldescription,lfilename,arg
8311integer :: ltarray(8),lunit,ios
8312logical :: opened,exist
8313
8314
8315call getarg(0,arg)
8316
8317if (.not. present(unit))then
8318 lunit=getunit()
8319else
8320 if (unit==0)then
8321 lunit=getunit()
8322 unit=lunit
8323 else
8324 lunit=unit
8325 end if
8326end if
8327
8328lfilename=trim(arg)//".v7d"
8330
8331if (present(filename))then
8332 if (filename /= "")then
8333 lfilename=filename
8334 end if
8335end if
8336
8337if (present(filename_auto))filename_auto=lfilename
8338
8339
8340inquire(unit=lunit,opened=opened)
8341IF (.NOT. opened) THEN
8342 inquire(file=lfilename,exist=exist)
8343 IF (.NOT.exist) THEN
8344 CALL l4f_log(l4f_fatal, &
8345 'in vol7d_read_from_file, file does not exists, cannot open')
8346 CALL raise_fatal_error()
8347 ENDIF
8348 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM', &
8349 status='OLD', action='READ')
8350 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
8351end if
8352
8353
8355read(unit=lunit,iostat=ios)ldescription
8356
8357if (ios < 0) then ! A negative value indicates that the End of File or End of Record
8358 call vol7d_alloc (this)
8359 call vol7d_alloc_vol (this)
8360 if (present(description))description=ldescription
8361 if (present(tarray))tarray=ltarray
8362 if (.not. present(unit)) close(unit=lunit)
8363end if
8364
8365read(unit=lunit)ltarray
8366
8367CALL l4f_log(l4f_info, 'Reading vol7d from file')
8368CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
8371
8372if (present(description))description=ldescription
8373if (present(tarray))tarray=ltarray
8374
8375read(unit=lunit)&
8376 nana, ntime, ntimerange, nlevel, nnetwork, &
8377 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
8378 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
8379 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
8380 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
8381 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
8382 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
8383 this%time_definition
8384
8385call vol7d_alloc (this, &
8386 nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,&
8387 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,&
8388 ndativard=ndativard, ndativarc=ndativarc,&
8389 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,&
8390 ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
8391 ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, &
8392 ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,&
8393 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, &
8394 nanavard=nanavard, nanavarc=nanavarc,&
8395 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,&
8396 nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
8397 nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, &
8398 nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc)
8399
8400
8403if (associated(this%level)) read(unit=lunit)this%level
8404if (associated(this%timerange)) read(unit=lunit)this%timerange
8405if (associated(this%network)) read(unit=lunit)this%network
8406
8407if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r
8408if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i
8409if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b
8410if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d
8411if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c
8412
8413if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r
8414if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i
8415if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b
8416if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d
8417if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c
8418
8419if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r
8420if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i
8421if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b
8422if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d
8423if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c
8424
8425if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r
8426if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i
8427if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b
8428if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d
8429if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c
8430
8431if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r
8432if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i
8433if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b
8434if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d
8435if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c
8436
8437if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
8438if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
8439if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
8440if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
8441if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c
8442
8443call vol7d_alloc_vol (this)
8444
8445!! Volumi di valori e attributi per anagrafica e dati
8446
8447if (associated(this%volanar)) read(unit=lunit)this%volanar
8448if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr
8449if (associated(this%voldatir)) read(unit=lunit)this%voldatir
8450if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr
8451
8452if (associated(this%volanai)) read(unit=lunit)this%volanai
8453if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri
8454if (associated(this%voldatii)) read(unit=lunit)this%voldatii
8455if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri
8456
8457if (associated(this%volanab)) read(unit=lunit)this%volanab
8458if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb
8459if (associated(this%voldatib)) read(unit=lunit)this%voldatib
8460if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb
8461
8462if (associated(this%volanad)) read(unit=lunit)this%volanad
8463if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd
8464if (associated(this%voldatid)) read(unit=lunit)this%voldatid
8465if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd
8466
8467if (associated(this%volanac)) read(unit=lunit)this%volanac
8468if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc
8469if (associated(this%voldatic)) read(unit=lunit)this%voldatic
8470if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc
8471
8472if (.not. present(unit)) close(unit=lunit)
8473
8474end subroutine vol7d_read_from_file
8475
8476
8477! to double precision
8478elemental doubleprecision function doubledatd(voldat,var)
8479doubleprecision,intent(in) :: voldat
8480type(vol7d_var),intent(in) :: var
8481
8482doubledatd=voldat
8483
8484end function doubledatd
8485
8486
8487elemental doubleprecision function doubledatr(voldat,var)
8488real,intent(in) :: voldat
8489type(vol7d_var),intent(in) :: var
8490
8492 doubledatr=dble(voldat)
8493else
8494 doubledatr=dmiss
8495end if
8496
8497end function doubledatr
8498
8499
8500elemental doubleprecision function doubledati(voldat,var)
8501integer,intent(in) :: voldat
8502type(vol7d_var),intent(in) :: var
8503
8506 doubledati=dble(voldat)/10.d0**var%scalefactor
8507 else
8508 doubledati=dble(voldat)
8509 endif
8510else
8511 doubledati=dmiss
8512end if
8513
8514end function doubledati
8515
8516
8517elemental doubleprecision function doubledatb(voldat,var)
8518integer(kind=int_b),intent(in) :: voldat
8519type(vol7d_var),intent(in) :: var
8520
8523 doubledatb=dble(voldat)/10.d0**var%scalefactor
8524 else
8525 doubledatb=dble(voldat)
8526 endif
8527else
8528 doubledatb=dmiss
8529end if
8530
8531end function doubledatb
8532
8533
8534elemental doubleprecision function doubledatc(voldat,var)
8535CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
8536type(vol7d_var),intent(in) :: var
8537
8538doubledatc = c2d(voldat)
8540 doubledatc=doubledatc/10.d0**var%scalefactor
8541end if
8542
8543end function doubledatc
8544
8545
8546! to integer
8547elemental integer function integerdatd(voldat,var)
8548doubleprecision,intent(in) :: voldat
8549type(vol7d_var),intent(in) :: var
8550
8553 integerdatd=nint(voldat*10d0**var%scalefactor)
8554 else
8555 integerdatd=nint(voldat)
8556 endif
8557else
8558 integerdatd=imiss
8559end if
8560
8561end function integerdatd
8562
8563
8564elemental integer function integerdatr(voldat,var)
8565real,intent(in) :: voldat
8566type(vol7d_var),intent(in) :: var
8567
8570 integerdatr=nint(voldat*10d0**var%scalefactor)
8571 else
8572 integerdatr=nint(voldat)
8573 endif
8574else
8575 integerdatr=imiss
8576end if
8577
8578end function integerdatr
8579
8580
8581elemental integer function integerdati(voldat,var)
8582integer,intent(in) :: voldat
8583type(vol7d_var),intent(in) :: var
8584
8585integerdati=voldat
8586
8587end function integerdati
8588
8589
8590elemental integer function integerdatb(voldat,var)
8591integer(kind=int_b),intent(in) :: voldat
8592type(vol7d_var),intent(in) :: var
8593
8595 integerdatb=voldat
8596else
8597 integerdatb=imiss
8598end if
8599
8600end function integerdatb
8601
8602
8603elemental integer function integerdatc(voldat,var)
8604CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
8605type(vol7d_var),intent(in) :: var
8606
8607integerdatc=c2i(voldat)
8608
8609end function integerdatc
8610
8611
8612! to real
8613elemental real function realdatd(voldat,var)
8614doubleprecision,intent(in) :: voldat
8615type(vol7d_var),intent(in) :: var
8616
8618 realdatd=real(voldat)
8619else
8620 realdatd=rmiss
8621end if
8622
8623end function realdatd
8624
8625
8626elemental real function realdatr(voldat,var)
8627real,intent(in) :: voldat
8628type(vol7d_var),intent(in) :: var
8629
8630realdatr=voldat
8631
8632end function realdatr
8633
8634
8635elemental real function realdati(voldat,var)
8636integer,intent(in) :: voldat
8637type(vol7d_var),intent(in) :: var
8638
8641 realdati=float(voldat)/10.**var%scalefactor
8642 else
8643 realdati=float(voldat)
8644 endif
8645else
8646 realdati=rmiss
8647end if
8648
8649end function realdati
8650
8651
8652elemental real function realdatb(voldat,var)
8653integer(kind=int_b),intent(in) :: voldat
8654type(vol7d_var),intent(in) :: var
8655
8658 realdatb=float(voldat)/10**var%scalefactor
8659 else
8660 realdatb=float(voldat)
8661 endif
8662else
8663 realdatb=rmiss
8664end if
8665
8666end function realdatb
8667
8668
8669elemental real function realdatc(voldat,var)
8670CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
8671type(vol7d_var),intent(in) :: var
8672
8673realdatc=c2r(voldat)
8675 realdatc=realdatc/10.**var%scalefactor
8676end if
8677
8678end function realdatc
8679
8680
8681!> Return an ana volume of a requested variable as real data.
8682!! It returns a 2-d array of the proper shape (ana x network) for the
8683!! ana variable requested, converted to real type. If the conversion
8684!! fails or if the variable is not contained in the ana volume,
8685!! missing data are returned.
8686FUNCTION realanavol(this, var) RESULT(vol)
8687TYPE(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
8688TYPE(vol7d_var),INTENT(in) :: var !< the ana variable to be returned
8689REAL :: vol(SIZE(this%ana),size(this%network))
8690
8691CHARACTER(len=1) :: dtype
8692INTEGER :: indvar
8693
8694dtype = cmiss
8695indvar = index(this%anavar, var, type=dtype)
8696
8697IF (indvar > 0) THEN
8698 SELECT CASE (dtype)
8699 CASE("d")
8700 vol = realdat(this%volanad(:,indvar,:), var)
8701 CASE("r")
8702 vol = this%volanar(:,indvar,:)
8703 CASE("i")
8704 vol = realdat(this%volanai(:,indvar,:), var)
8705 CASE("b")
8706 vol = realdat(this%volanab(:,indvar,:), var)
8707 CASE("c")
8708 vol = realdat(this%volanac(:,indvar,:), var)
8709 CASE default
8710 vol = rmiss
8711 END SELECT
8712ELSE
8713 vol = rmiss
8714ENDIF
8715
8716END FUNCTION realanavol
8717
8718
8719!> Return an ana volume of a requested variable as integer data.
8720!! It returns a 2-d array of the proper shape (ana x network) for the
8721!! ana variable requested, converted to integer type. If the conversion
8722!! fails or if the variable is not contained in the ana volume,
8723!! missing data are returned.
8724FUNCTION integeranavol(this, var) RESULT(vol)
8725TYPE(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
8726TYPE(vol7d_var),INTENT(in) :: var !< the ana variable to be returned
8727INTEGER :: vol(SIZE(this%ana),size(this%network))
8728
8729CHARACTER(len=1) :: dtype
8730INTEGER :: indvar
8731
8732dtype = cmiss
8733indvar = index(this%anavar, var, type=dtype)
8734
8735IF (indvar > 0) THEN
8736 SELECT CASE (dtype)
8737 CASE("d")
8738 vol = integerdat(this%volanad(:,indvar,:), var)
8739 CASE("r")
8740 vol = integerdat(this%volanar(:,indvar,:), var)
8741 CASE("i")
8742 vol = this%volanai(:,indvar,:)
8743 CASE("b")
8744 vol = integerdat(this%volanab(:,indvar,:), var)
8745 CASE("c")
8746 vol = integerdat(this%volanac(:,indvar,:), var)
8747 CASE default
8748 vol = imiss
8749 END SELECT
8750ELSE
8751 vol = imiss
8752ENDIF
8753
8754END FUNCTION integeranavol
8755
8756
8757!> Move data for all variables from one coordinate in the character volume to other.
8758!! Only not missing data will be copyed and all attributes will be moved together.
8759!! Usefull to colapse data spread in more indices (level or time or ....).
8760!! After the move is possible to set to missing some descriptor and make a copy with miss=.true.
8761!! to obtain a new vol7d with less data shape.
8762subroutine move_datac (v7d,&
8763 indana,indtime,indlevel,indtimerange,indnetwork,&
8764 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
8765
8766TYPE(vol7d),intent(inout) :: v7d !< data in form of character in this object will be moved
8767
8768integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork !< source coordinate of the data
8769integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew !< destination coordinate of data
8770integer :: inddativar,inddativarattr
8771
8772
8773do inddativar=1,size(v7d%dativar%c)
8774
8776 .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
8777 ) then
8778
8779 ! dati
8780 v7d%voldatic &
8781 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
8782 v7d%voldatic &
8783 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
8784
8785
8786 ! attributi
8787 if (associated (v7d%dativarattr%i)) then
8788 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
8789 if (inddativarattr > 0 ) then
8790 v7d%voldatiattri &
8791 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
8792 v7d%voldatiattri &
8793 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
8794 end if
8795 end if
8796
8797 if (associated (v7d%dativarattr%r)) then
8798 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
8799 if (inddativarattr > 0 ) then
8800 v7d%voldatiattrr &
8801 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
8802 v7d%voldatiattrr &
8803 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
8804 end if
8805 end if
8806
8807 if (associated (v7d%dativarattr%d)) then
8808 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
8809 if (inddativarattr > 0 ) then
8810 v7d%voldatiattrd &
8811 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
8812 v7d%voldatiattrd &
8813 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
8814 end if
8815 end if
8816
8817 if (associated (v7d%dativarattr%b)) then
8818 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
8819 if (inddativarattr > 0 ) then
8820 v7d%voldatiattrb &
8821 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
8822 v7d%voldatiattrb &
8823 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
8824 end if
8825 end if
8826
8827 if (associated (v7d%dativarattr%c)) then
8828 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
8829 if (inddativarattr > 0 ) then
8830 v7d%voldatiattrc &
8831 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
8832 v7d%voldatiattrc &
8833 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
8834 end if
8835 end if
8836
8837 end if
8838
8839end do
8840
8841end subroutine move_datac
8842
8843!> Move data for all variables from one coordinate in the real volume to other.
8844!! Only not missing data will be copyed and all attributes will be moved together.
8845!! Usefull to colapse data spread in more indices (level or time or ....).
8846!! After the move is possible to set to missing some descriptor and make a copy with miss=.true.
8847!! to obtain a new vol7d with less data shape.
8848subroutine move_datar (v7d,&
8849 indana,indtime,indlevel,indtimerange,indnetwork,&
8850 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
8851
8852TYPE(vol7d),intent(inout) :: v7d !< data in form of character in this object will be moved
8853
8854integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork !< source coordinate of the data
8855integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew !< destination coordinate of data
8856integer :: inddativar,inddativarattr
8857
8858
8859do inddativar=1,size(v7d%dativar%r)
8860
8862 .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
8863 ) then
8864
8865 ! dati
8866 v7d%voldatir &
8867 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
8868 v7d%voldatir &
8869 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
8870
8871
8872 ! attributi
8873 if (associated (v7d%dativarattr%i)) then
8874 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
8875 if (inddativarattr > 0 ) then
8876 v7d%voldatiattri &
8877 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
8878 v7d%voldatiattri &
8879 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
8880 end if
8881 end if
8882
8883 if (associated (v7d%dativarattr%r)) then
8884 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%r(inddativar))
8885 if (inddativarattr > 0 ) then
8886 v7d%voldatiattrr &
8887 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
8888 v7d%voldatiattrr &
8889 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
8890 end if
8891 end if
8892
8893 if (associated (v7d%dativarattr%d)) then
8894 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%r(inddativar))
8895 if (inddativarattr > 0 ) then
8896 v7d%voldatiattrd &
8897 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
8898 v7d%voldatiattrd &
8899 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
8900 end if
8901 end if
8902
8903 if (associated (v7d%dativarattr%b)) then
8904 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%r(inddativar))
8905 if (inddativarattr > 0 ) then
8906 v7d%voldatiattrb &
8907 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
8908 v7d%voldatiattrb &
8909 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
8910 end if
8911 end if
8912
8913 if (associated (v7d%dativarattr%c)) then
8914 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%r(inddativar))
8915 if (inddativarattr > 0 ) then
8916 v7d%voldatiattrc &
8917 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
8918 v7d%voldatiattrc &
8919 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
8920 end if
8921 end if
8922
8923 end if
8924
8925end do
8926
8927end subroutine move_datar
8928
8929
8930!> Reduce some dimensions (level and timerage) for semplification (rounding).
8931!! You can use this for simplify and use variables in computation like alchimia
8932!! where fields have to be on the same coordinate
8933!! It return real or character data only: if input is charcter data only it return character otherwise il return
8934!! all the data converted to real.
8935!! examples:
8936!! means in time for short periods and istantaneous values
8937!! 2 meter and surface levels
8938!! If there are data on more then one almost equal levels or timeranges, the first var present (at least one point)
8939!! will be taken (order is by icreasing var index).
8940!! You can use predefined values for classic semplification
8941!! almost_equal_levels and almost_equal_timeranges
8942!! The level or timerange in output will be defined by the first element of level and timerange list
8943subroutine v7d_rounding(v7din,v7dout,level,timerange,nostatproc)
8944type(vol7d),intent(inout) :: v7din !< input volume
8945type(vol7d),intent(out) :: v7dout !> output volume
8946type(vol7d_level),intent(in),optional :: level(:) !< almost equal level list
8947type(vol7d_timerange),intent(in),optional :: timerange(:) !< almost equal timerange list
8948!logical,intent(in),optional :: merge !< if there are data on more then one almost equal levels or timeranges
8949!! will be merged POINT BY POINT with priority for the fird data found ordered by icreasing var index
8950logical,intent(in),optional :: nostatproc !< do not take in account statistical processing code in timerange and P2
8951
8952integer :: nana,nlevel,ntime,ntimerange,nnetwork,nbin
8953integer :: iana,ilevel,itimerange,indl,indt,itime,inetwork
8954type(vol7d_level) :: roundlevel(size(v7din%level))
8955type(vol7d_timerange) :: roundtimerange(size(v7din%timerange))
8956type(vol7d) :: v7d_tmp
8957
8958
8959nbin=0
8960
8961if (associated(v7din%dativar%r)) nbin = nbin + size(v7din%dativar%r)
8962if (associated(v7din%dativar%i)) nbin = nbin + size(v7din%dativar%i)
8963if (associated(v7din%dativar%d)) nbin = nbin + size(v7din%dativar%d)
8964if (associated(v7din%dativar%b)) nbin = nbin + size(v7din%dativar%b)
8965
8967
8968roundlevel=v7din%level
8969
8970if (present(level))then
8971 do ilevel = 1, size(v7din%level)
8972 if ((any(v7din%level(ilevel) .almosteq. level))) then
8973 roundlevel(ilevel)=level(1)
8974 end if
8975 end do
8976end if
8977
8978roundtimerange=v7din%timerange
8979
8980if (present(timerange))then
8981 do itimerange = 1, size(v7din%timerange)
8982 if ((any(v7din%timerange(itimerange) .almosteq. timerange))) then
8983 roundtimerange(itimerange)=timerange(1)
8984 end if
8985 end do
8986end if
8987
8988!set istantaneous values everywere
8989!preserve p1 for forecast time
8990if (optio_log(nostatproc)) then
8991 roundtimerange(:)%timerange=254
8992 roundtimerange(:)%p2=0
8993end if
8994
8995
8996nana=size(v7din%ana)
8997nlevel=count_distinct(roundlevel,back=.true.)
8998ntime=size(v7din%time)
8999ntimerange=count_distinct(roundtimerange,back=.true.)
9000nnetwork=size(v7din%network)
9001
9003
9004if (nbin == 0) then
9006else
9007 call vol7d_convr(v7din,v7d_tmp)
9008end if
9009
9010v7d_tmp%level=roundlevel
9011v7d_tmp%timerange=roundtimerange
9012
9013do ilevel=1, size(v7d_tmp%level)
9014 indl=index(v7d_tmp%level,roundlevel(ilevel))
9015 do itimerange=1,size(v7d_tmp%timerange)
9016 indt=index(v7d_tmp%timerange,roundtimerange(itimerange))
9017
9018 if (indl /= ilevel .or. indt /= itimerange) then
9019
9020 do iana=1, nana
9021 do itime=1,ntime
9022 do inetwork=1,nnetwork
9023
9024 if (nbin > 0) then
9025 call move_datar (v7d_tmp,&
9026 iana,itime,ilevel,itimerange,inetwork,&
9027 iana,itime,indl,indt,inetwork)
9028 else
9029 call move_datac (v7d_tmp,&
9030 iana,itime,ilevel,itimerange,inetwork,&
9031 iana,itime,indl,indt,inetwork)
9032 end if
9033
9034 end do
9035 end do
9036 end do
9037
9038 end if
9039
9040 end do
9041end do
9042
9043! set to missing level and time > nlevel
9044do ilevel=nlevel+1,size(v7d_tmp%level)
9046end do
9047
9048do itimerange=ntimerange+1,size(v7d_tmp%timerange)
9050end do
9051
9052!copy with remove
9055
9056!call display(v7dout)
9057
9058end subroutine v7d_rounding
9059
9060
9062
9063!>\example esempio_qc_convert.f90
9064!!\brief Programma esempio semplice per la scrittura su file di un volume vol7d
9065!!
9066!!Programma che scrive su file un volume vol7d letto da una serie di file ASCII.
9067!!Questo programma scrive i dati del clima che poi verranno letti da modqccli
9068
9069
9070!>\example esempio_v7ddballe_move_and_collapse.f90
9071!!\brief ! Example program to reduce to one the dimensions of levels and time without loss of data
Set of functions that return a trimmed CHARACTER representation of the input variable. Definition char_utilities.F90:278 Legge un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta da un file FORMATTED o... Definition datetime_class.F90:478 Scrive un oggetto datetime/timedelta o un vettore di oggetti datetime/timedelta su un file FORMATTED ... Definition datetime_class.F90:485 Generic subroutine for checking OPTIONAL parameters. Definition optional_values.f90:36 Check for problems return 0 if all check passed print diagnostics with log4f. Definition vol7d_class.F90:445 Reduce some dimensions (level and timerage) for semplification (rounding). Definition vol7d_class.F90:462 This module defines usefull general purpose function and subroutine. Definition array_utilities.F90:212 Definition of constants to be used for declaring variables of a desired type. Definition kinds.F90:245 Module for quickly interpreting the OPTIONAL parameters passed to a subprogram. Definition optional_values.f90:28 Classe per la gestione dell'anagrafica di stazioni meteo e affini. Definition vol7d_ana_class.F90:212 Classe per la gestione di un volume completo di dati osservati. Definition vol7d_class.F90:273 Classe per la gestione dei livelli verticali in osservazioni meteo e affini. Definition vol7d_level_class.F90:213 Classe per la gestione delle reti di stazioni per osservazioni meteo e affini. Definition vol7d_network_class.F90:214 Classe per la gestione degli intervalli temporali di osservazioni meteo e affini. Definition vol7d_timerange_class.F90:215 Classe per gestire un vettore di oggetti di tipo vol7d_var_class::vol7d_var. Definition vol7d_varvect_class.f90:22 Definisce un oggetto contenente i volumi anagrafica e dati e tutti i descrittori delle loro dimension... Definition vol7d_class.F90:312 |