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