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