libsim Versione 7.2.6
|
◆ vol7d_get_voldatiattrc()
Crea una vista a dimensione ridotta di un volume di attributi di dati di tipo CHARACTER(len=vol7d_cdatalen). È 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: CHARACTER(len=vol7d_cdatalen), POINTER :: vol2d(:,:)
...
CALL vol7d_get_voldatiattrc(v7d1, (/vol7d_ana_d, vol7d_time_d/), vol2d)
IF (ASSOCIATED(vol2d)) THEN
print*,vol2d
...
ENDIF
return
Definizione alla linea 6405 del file vol7d_class.F90. 6407! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6408! authors:
6409! Davide Cesari <dcesari@arpa.emr.it>
6410! Paolo Patruno <ppatruno@arpa.emr.it>
6411
6412! This program is free software; you can redistribute it and/or
6413! modify it under the terms of the GNU General Public License as
6414! published by the Free Software Foundation; either version 2 of
6415! the License, or (at your option) any later version.
6416
6417! This program is distributed in the hope that it will be useful,
6418! but WITHOUT ANY WARRANTY; without even the implied warranty of
6419! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6420! GNU General Public License for more details.
6421
6422! You should have received a copy of the GNU General Public License
6423! along with this program. If not, see <http://www.gnu.org/licenses/>.
6424#include "config.h"
6425
6426!> \defgroup vol7d Libsim package, vol7d library.
6427!! The libsim vol7d library contains classes for managing pointwise
6428!! data, tipically weather observations, and for their import from a
6429!! Db-All.e database or from a WMO BUFR file. In order to compile and
6430!! link programs using this library, you have to insert the required
6431!! \c USE statements in the program units involved, specify the
6432!! location of module files when compiling (tipically \c
6433!! -I/usr/lib/gfortran/modules or \c -I/usr/lib64/gfortran/modules or
6434!! \c -I/usr/include) and indicate the library name \c -lsim_vol7d
6435!! when linking, assuming that the library has been installed in a
6436!! default location.
6437
6438!> Classe per la gestione di un volume completo di dati osservati.
6439!! Questo modulo definisce gli oggetti e i metodi per gestire
6440!! volumi di dati meteorologici sparsi.
6441!! I volumi definiti sono principalmente di 4 categorie:
6442!! - volumi di anagrafica (vol7d::volanar & c.), hanno 3 dimensioni:
6443!! - anagrafica
6444!! - variabile di anagrafica
6445!! - rete
6446!! - volumi di attributi di anagrafica (vol7d::volanaattrr & c.), hanno 4 dimensioni:
6447!! - anagrafica
6448!! - variabile di anagrafica
6449!! - rete
6450!! - variabile di attributi delle variabili di anagrafica
6451!! - volumi di dati (vol7d::voldatir & c.), hanno 6 dimensioni:
6452!! - anagrafica
6453!! - tempo
6454!! - livello verticale
6455!! - intervallo temporale (timerange)
6456!! - variabile di dati
6457!! - rete
6458!! - volumi di attributi di dati (vol7d::voldatiattrr & c.), hanno 7 dimensioni:
6459!! - anagrafica
6460!! - tempo
6461!! - livello verticale
6462!! - intervallo temporale (timerange)
6463!! - variabile di dati
6464!! - rete
6465!! - variabile di attributi delle variabili di dati
6466!!
6467!! Tutte le variabili sono inoltre disponibil1 in 5 tipi diversi:
6468!! - reale (abbreviato r)
6469!! - doppia precisione (abbreviato d)
6470!! - intero (abbreviato i)
6471!! - byte (abbreviato b)
6472!! - carattere (abbreviato c)
6473!!
6474!! Per ognuna delle dimensioni possibili, incluse le variabili e gli
6475!! attributi con i loro diversi tipi,
6476!! è definito un cosiddetto "vettore di descrittori", con un
6477!! numero di elementi pari all'estensione della dimensione stessa,
6478!! che contiene le informazioni necessarie a descrivere
6479!! gli elementi di quella dimensione.
6480!! In realtà l'utente non dovrà generalmente occuparsi di costruire
6481!! un oggetto vol7d con le proprie mani ma utilizzerà nella maggior parte
6482!! dei casi i metodi di importazione preconfezionati che importano dati da
6483!! DB-All.e (vol7d_dballe_class) o dal DB Oracle del SIM (vol7d_oraclesim_class).
6484!!
6485!!
6486!! Il programma esempio_v7d.f90 contiene un esempio elementare di uso
6487!! della classe vol7d:
6488!! \include esempio_v7d.f90
6489!!
6490!! \ingroup vol7d
6498USE io_units
6505IMPLICIT NONE
6506
6507
6508INTEGER, PARAMETER :: vol7d_maxdim_a = 3, vol7d_maxdim_aa = 4, &
6509 vol7d_maxdim_d = 6, vol7d_maxdim_ad = 7
6510
6511INTEGER, PARAMETER :: vol7d_ana_a=1 !< indice della dimensione "anagrafica" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
6512INTEGER, PARAMETER :: vol7d_var_a=2 !< indice della dimensione "variabile" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
6513INTEGER, PARAMETER :: vol7d_network_a=3 !< indice della dimensione "rete" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
6514INTEGER, PARAMETER :: vol7d_attr_a=4 !< indice della dimensione "attributo" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
6515INTEGER, PARAMETER :: vol7d_ana_d=1 !< indice della dimensione "anagrafica" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
6516INTEGER, PARAMETER :: vol7d_time_d=2 !< indice della dimensione "tempo" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
6517INTEGER, PARAMETER :: vol7d_level_d=3 !< indice della dimensione "livello verticale" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
6518INTEGER, PARAMETER :: vol7d_timerange_d=4 !< indice della dimensione "intervallo temporale" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
6519INTEGER, PARAMETER :: vol7d_var_d=5 !< indice della dimensione "variabile" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
6520INTEGER, PARAMETER :: vol7d_network_d=6 !< indice della dimensione "rete" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
6521INTEGER, PARAMETER :: vol7d_attr_d=7 !< indice della dimensione "attributo" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
6522INTEGER, PARAMETER :: vol7d_cdatalen=32
6523
6524TYPE vol7d_varmap
6525 INTEGER :: r, d, i, b, c
6526END TYPE vol7d_varmap
6527
6528!> Definisce un oggetto contenente i volumi anagrafica e dati e tutti
6529!! i descrittori delle loro dimensioni.
6531!> vettore descrittore della dimensione anagrafica
6532 TYPE(vol7d_ana),POINTER :: ana(:)
6533!> vettore descrittore della dimensione tempo
6534 TYPE(datetime),POINTER :: time(:)
6535!> vettore descrittore della dimensione livello verticale
6536 TYPE(vol7d_level),POINTER :: level(:)
6537!> vettore descrittore della dimensione intervallo temporale (timerange)
6538 TYPE(vol7d_timerange),POINTER :: timerange(:)
6539!> vettore descrittore della dimensione rete
6540 TYPE(vol7d_network),POINTER :: network(:)
6541!> vettore descrittore della dimensione variabile di anagrafica
6542 TYPE(vol7d_varvect) :: anavar
6543!> vettore descrittore della dimensione attributo delle variabili di anagrafica
6544 TYPE(vol7d_varvect) :: anaattr
6545!> vettore descrittore della dimensione variabile di anagrafica che ha tali attributi
6546 TYPE(vol7d_varvect) :: anavarattr
6547!> vettore descrittore della dimensione variabile di dati
6548 TYPE(vol7d_varvect) :: dativar
6549!> vettore descrittore della dimensione attributo delle variabili di dati
6550 TYPE(vol7d_varvect) :: datiattr
6551!> vettore descrittore della dimensione variabile di dati che ha tali attributi
6552 TYPE(vol7d_varvect) :: dativarattr
6553
6554!> volume di anagrafica a valori reali
6555 REAL,POINTER :: volanar(:,:,:)
6556!> volume di anagrafica a valori a doppia precisione
6557 DOUBLE PRECISION,POINTER :: volanad(:,:,:)
6558!> volume di anagrafica a valori interi
6559 INTEGER,POINTER :: volanai(:,:,:)
6560!> volume di anagrafica a valori byte
6561 INTEGER(kind=int_b),POINTER :: volanab(:,:,:)
6562!> volume di anagrafica a valori carattere
6563 CHARACTER(len=vol7d_cdatalen),POINTER :: volanac(:,:,:)
6564
6565!> volume di attributi di anagrafica a valori reali
6566 REAL,POINTER :: volanaattrr(:,:,:,:)
6567!> volume di attributi di anagrafica a valori a doppia precisione
6568 DOUBLE PRECISION,POINTER :: volanaattrd(:,:,:,:)
6569!> volume di attributi di anagrafica a valori interi
6570 INTEGER,POINTER :: volanaattri(:,:,:,:)
6571!> volume di attributi di anagrafica a valori byte
6572 INTEGER(kind=int_b),POINTER :: volanaattrb(:,:,:,:)
6573!> volume di attributi di anagrafica a valori carattere
6574 CHARACTER(len=vol7d_cdatalen),POINTER :: volanaattrc(:,:,:,:)
6575
6576!> volume di dati a valori reali
6577 REAL,POINTER :: voldatir(:,:,:,:,:,:) ! sono i dati
6578!> volume di dati a valori a doppia precisione
6579 DOUBLE PRECISION,POINTER :: voldatid(:,:,:,:,:,:)
6580!> volume di dati a valori interi
6581 INTEGER,POINTER :: voldatii(:,:,:,:,:,:)
6582!> volume di dati a valori byte
6583 INTEGER(kind=int_b),POINTER :: voldatib(:,:,:,:,:,:)
6584!> volume di dati a valori carattere
6585 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatic(:,:,:,:,:,:)
6586
6587!> volume di attributi di dati a valori reali
6588 REAL,POINTER :: voldatiattrr(:,:,:,:,:,:,:)
6589!> volume di attributi di dati a valori a doppia precisione
6590 DOUBLE PRECISION,POINTER :: voldatiattrd(:,:,:,:,:,:,:)
6591!> volume di attributi di dati a valori interi
6592 INTEGER,POINTER :: voldatiattri(:,:,:,:,:,:,:)
6593!> volume di attributi di dati a valori byte
6594 INTEGER(kind=int_b),POINTER :: voldatiattrb(:,:,:,:,:,:,:)
6595!> volume di attributi di dati a valori carattere
6596 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatiattrc(:,:,:,:,:,:,:)
6597
6598!> time definition; 0=time is reference time, 1=time is validity time
6599 integer :: time_definition
6600
6602
6603!> Costruttore per la classe vol7d.
6604!! Deve essere richiamato
6605!! per tutti gli oggetti di questo tipo definiti in un programma.
6607 MODULE PROCEDURE vol7d_init
6608END INTERFACE
6609
6610!> Distruttore per la classe vol7d.
6612 MODULE PROCEDURE vol7d_delete
6613END INTERFACE
6614
6615!> Scrittura su file.
6617 MODULE PROCEDURE vol7d_write_on_file
6618END INTERFACE
6619
6620!> Lettura da file.
6621INTERFACE import
6622 MODULE PROCEDURE vol7d_read_from_file
6623END INTERFACE
6624
6625!>Print object
6627 MODULE PROCEDURE vol7d_display, dat_display, dat_vect_display
6628END INTERFACE
6629
6630!>Represent data in a pretty string
6632 MODULE PROCEDURE to_char_dat
6633END INTERFACE
6634
6635!>doubleprecision data conversion
6637 MODULE PROCEDURE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
6638END INTERFACE
6639
6640!>real data conversion
6642 MODULE PROCEDURE realdatd,realdatr,realdati,realdatb,realdatc
6643END INTERFACE
6644
6645!>integer data conversion
6647 MODULE PROCEDURE integerdatd,integerdatr,integerdati,integerdatb,integerdatc
6648END INTERFACE
6649
6650!>copy object
6652 MODULE PROCEDURE vol7d_copy
6653END INTERFACE
6654
6655!> Test for a missing volume
6657 MODULE PROCEDURE vol7d_c_e
6658END INTERFACE
6659
6660!> Check for problems
6661!! return 0 if all check passed
6662!! print diagnostics with log4f
6664 MODULE PROCEDURE vol7d_check
6665END INTERFACE
6666
6667!> Reduce some dimensions (level and timerage) for semplification (rounding).
6668!! You can use this for simplify and use variables in computation like alchimia
6669!! where fields have to be on the same coordinate
6670!! It return real or character data only: if input is charcter data only it return character otherwise il return
6671!! all the data converted to real.
6672!! examples:
6673!! means in time for short periods and istantaneous values
6674!! 2 meter and surface levels
6675!! If there are data on more then one almost equal levels or timeranges, the first var present (at least one point)
6676!! will be taken (order is by icreasing var index).
6677!! You can use predefined values for classic semplification
6678!! almost_equal_levels and almost_equal_timeranges
6679!! The level or timerange in output will be defined by the first element of level and timerange list
6681 MODULE PROCEDURE v7d_rounding
6682END INTERFACE
6683
6684!!$INTERFACE get_volana
6685!!$ MODULE PROCEDURE vol7d_get_volanar, vol7d_get_volanad, vol7d_get_volanai, &
6686!!$ vol7d_get_volanab, vol7d_get_volanac
6687!!$END INTERFACE
6688!!$
6689!!$INTERFACE get_voldati
6690!!$ MODULE PROCEDURE vol7d_get_voldatir, vol7d_get_voldatid, vol7d_get_voldatii, &
6691!!$ vol7d_get_voldatib, vol7d_get_voldatic
6692!!$END INTERFACE
6693!!$
6694!!$INTERFACE get_volanaattr
6695!!$ MODULE PROCEDURE vol7d_get_volanaattrr, vol7d_get_volanaattrd, &
6696!!$ vol7d_get_volanaattri, vol7d_get_volanaattrb, vol7d_get_volanaattrc
6697!!$END INTERFACE
6698!!$
6699!!$INTERFACE get_voldatiattr
6700!!$ MODULE PROCEDURE vol7d_get_voldatiattrr, vol7d_get_voldatiattrd, &
6701!!$ vol7d_get_voldatiattri, vol7d_get_voldatiattrb, vol7d_get_voldatiattrc
6702!!$END INTERFACE
6703
6704PRIVATE vol7d_get_volr, vol7d_get_vold, vol7d_get_voli, vol7d_get_volb, &
6705 vol7d_get_volc, &
6706 volptr1dr, volptr2dr, volptr3dr, volptr4dr, volptr5dr, volptr6dr, volptr7dr, &
6707 volptr1dd, volptr2dd, volptr3dd, volptr4dd, volptr5dd, volptr6dd, volptr7dd, &
6708 volptr1di, volptr2di, volptr3di, volptr4di, volptr5di, volptr6di, volptr7di, &
6709 volptr1db, volptr2db, volptr3db, volptr4db, volptr5db, volptr6db, volptr7db, &
6710 volptr1dc, volptr2dc, volptr3dc, volptr4dc, volptr5dc, volptr6dc, volptr7dc, &
6711 vol7d_nullifyr, vol7d_nullifyd, vol7d_nullifyi, vol7d_nullifyb, vol7d_nullifyc, &
6712 vol7d_init, vol7d_delete, vol7d_write_on_file, vol7d_read_from_file, &
6713 vol7d_check_alloc_ana, vol7d_force_alloc_ana, &
6714 vol7d_check_alloc_dati, vol7d_force_alloc_dati, vol7d_force_alloc, &
6715 vol7d_display, dat_display, dat_vect_display, &
6716 to_char_dat, vol7d_check
6717
6718PRIVATE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
6719
6720PRIVATE vol7d_c_e
6721
6722CONTAINS
6723
6724
6725!> Inizializza un oggetto di tipo vol7d.
6726!! Non riceve alcun parametro tranne l'oggetto stesso. Attenzione, è necessario
6727!! comunque chiamare sempre il costruttore per evitare di avere dei puntatori in
6728!! uno stato indefinito.
6729SUBROUTINE vol7d_init(this,time_definition)
6730TYPE(vol7d),intent(out) :: this !< oggetto da inizializzare
6731integer,INTENT(IN),OPTIONAL :: time_definition !< 0=time is reference time ; 1=time is validity time (default=1)
6732
6739CALL vol7d_var_features_init() ! initialise var features table once
6740
6741NULLIFY(this%ana, this%time, this%level, this%timerange, this%network)
6742
6743NULLIFY(this%volanar, this%volanaattrr, this%voldatir, this%voldatiattrr)
6744NULLIFY(this%volanad, this%volanaattrd, this%voldatid, this%voldatiattrd)
6745NULLIFY(this%volanai, this%volanaattri, this%voldatii, this%voldatiattri)
6746NULLIFY(this%volanab, this%volanaattrb, this%voldatib, this%voldatiattrb)
6747NULLIFY(this%volanac, this%volanaattrc, this%voldatic, this%voldatiattrc)
6748
6749if(present(time_definition)) then
6750 this%time_definition=time_definition
6751else
6752 this%time_definition=1 !default to validity time
6753end if
6754
6755END SUBROUTINE vol7d_init
6756
6757
6758!> Distrugge l'oggetto in maniera pulita, liberando l'eventuale memoria
6759!! dinamicamente allocata. Permette di distruggere la sola parte di dati
6760!! mantenendo l'anagrafica.
6761ELEMENTAL SUBROUTINE vol7d_delete(this, dataonly)
6762TYPE(vol7d),intent(inout) :: this !< oggetto da distruggere
6763LOGICAL, INTENT(in), OPTIONAL :: dataonly !< dealloca solo i dati, tenendo l'anagrafica, (default \c .FALSE.)
6764
6765
6766IF (.NOT. optio_log(dataonly)) THEN
6767 IF (ASSOCIATED(this%volanar)) DEALLOCATE(this%volanar)
6768 IF (ASSOCIATED(this%volanad)) DEALLOCATE(this%volanad)
6769 IF (ASSOCIATED(this%volanai)) DEALLOCATE(this%volanai)
6770 IF (ASSOCIATED(this%volanab)) DEALLOCATE(this%volanab)
6771 IF (ASSOCIATED(this%volanac)) DEALLOCATE(this%volanac)
6772 IF (ASSOCIATED(this%volanaattrr)) DEALLOCATE(this%volanaattrr)
6773 IF (ASSOCIATED(this%volanaattrd)) DEALLOCATE(this%volanaattrd)
6774 IF (ASSOCIATED(this%volanaattri)) DEALLOCATE(this%volanaattri)
6775 IF (ASSOCIATED(this%volanaattrb)) DEALLOCATE(this%volanaattrb)
6776 IF (ASSOCIATED(this%volanaattrc)) DEALLOCATE(this%volanaattrc)
6777ENDIF
6778IF (ASSOCIATED(this%voldatir)) DEALLOCATE(this%voldatir)
6779IF (ASSOCIATED(this%voldatid)) DEALLOCATE(this%voldatid)
6780IF (ASSOCIATED(this%voldatii)) DEALLOCATE(this%voldatii)
6781IF (ASSOCIATED(this%voldatib)) DEALLOCATE(this%voldatib)
6782IF (ASSOCIATED(this%voldatic)) DEALLOCATE(this%voldatic)
6783IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
6784IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
6785IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
6786IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
6787IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
6788
6789IF (.NOT. optio_log(dataonly)) THEN
6790 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
6791 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
6792ENDIF
6793IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
6794IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
6795IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
6796
6797IF (.NOT. optio_log(dataonly)) THEN
6801ENDIF
6805
6806END SUBROUTINE vol7d_delete
6807
6808
6809
6810integer function vol7d_check(this)
6811TYPE(vol7d),intent(in) :: this !< object to check
6812integer :: i,j,k,l,m,n
6813
6814vol7d_check=0
6815
6816if (associated(this%voldatii)) then
6817do i = 1,size(this%voldatii,1)
6818 do j = 1,size(this%voldatii,2)
6819 do k = 1,size(this%voldatii,3)
6820 do l = 1,size(this%voldatii,4)
6821 do m = 1,size(this%voldatii,5)
6822 do n = 1,size(this%voldatii,6)
6823 if (this%voldatii(i,j,k,l,m,n) /= this%voldatii(i,j,k,l,m,n) ) then
6824 CALL l4f_log(l4f_warn,"check: abnormal value at voldatii("&
6826 vol7d_check=1
6827 end if
6828 end do
6829 end do
6830 end do
6831 end do
6832 end do
6833end do
6834end if
6835
6836
6837if (associated(this%voldatir)) then
6838do i = 1,size(this%voldatir,1)
6839 do j = 1,size(this%voldatir,2)
6840 do k = 1,size(this%voldatir,3)
6841 do l = 1,size(this%voldatir,4)
6842 do m = 1,size(this%voldatir,5)
6843 do n = 1,size(this%voldatir,6)
6844 if (this%voldatir(i,j,k,l,m,n) /= this%voldatir(i,j,k,l,m,n) ) then
6845 CALL l4f_log(l4f_warn,"check: abnormal value at voldatir("&
6847 vol7d_check=2
6848 end if
6849 end do
6850 end do
6851 end do
6852 end do
6853 end do
6854end do
6855end if
6856
6857if (associated(this%voldatid)) then
6858do i = 1,size(this%voldatid,1)
6859 do j = 1,size(this%voldatid,2)
6860 do k = 1,size(this%voldatid,3)
6861 do l = 1,size(this%voldatid,4)
6862 do m = 1,size(this%voldatid,5)
6863 do n = 1,size(this%voldatid,6)
6864 if (this%voldatid(i,j,k,l,m,n) /= this%voldatid(i,j,k,l,m,n) ) then
6865 CALL l4f_log(l4f_warn,"check: abnormal value at voldatid("&
6867 vol7d_check=3
6868 end if
6869 end do
6870 end do
6871 end do
6872 end do
6873 end do
6874end do
6875end if
6876
6877if (associated(this%voldatib)) then
6878do i = 1,size(this%voldatib,1)
6879 do j = 1,size(this%voldatib,2)
6880 do k = 1,size(this%voldatib,3)
6881 do l = 1,size(this%voldatib,4)
6882 do m = 1,size(this%voldatib,5)
6883 do n = 1,size(this%voldatib,6)
6884 if (this%voldatib(i,j,k,l,m,n) /= this%voldatib(i,j,k,l,m,n) ) then
6885 CALL l4f_log(l4f_warn,"check: abnormal value at voldatib("&
6887 vol7d_check=4
6888 end if
6889 end do
6890 end do
6891 end do
6892 end do
6893 end do
6894end do
6895end if
6896
6897end function vol7d_check
6898
6899
6900
6901!TODO da completare ! aborta se i volumi sono allocati a dimensione 0
6902!> stampa a video una sintesi del contenuto
6903SUBROUTINE vol7d_display(this)
6904TYPE(vol7d),intent(in) :: this !< oggetto da visualizzare
6905integer :: i
6906
6907REAL :: rdat
6908DOUBLE PRECISION :: ddat
6909INTEGER :: idat
6910INTEGER(kind=int_b) :: bdat
6911CHARACTER(len=vol7d_cdatalen) :: cdat
6912
6913
6914print*,"<<<<<<<<<<<<<<<<<<< vol7d object >>>>>>>>>>>>>>>>>>>>"
6915if (this%time_definition == 0) then
6916 print*,"TIME DEFINITION: time is reference time"
6917else if (this%time_definition == 1) then
6918 print*,"TIME DEFINITION: time is validity time"
6919else
6920 print*,"Time definition have a wrong walue:", this%time_definition
6921end if
6922
6923IF (ASSOCIATED(this%network))then
6924 print*,"---- network vector ----"
6925 print*,"elements=",size(this%network)
6926 do i=1, size(this%network)
6928 end do
6929end IF
6930
6931IF (ASSOCIATED(this%ana))then
6932 print*,"---- ana vector ----"
6933 print*,"elements=",size(this%ana)
6934 do i=1, size(this%ana)
6936 end do
6937end IF
6938
6939IF (ASSOCIATED(this%time))then
6940 print*,"---- time vector ----"
6941 print*,"elements=",size(this%time)
6942 do i=1, size(this%time)
6944 end do
6945end if
6946
6947IF (ASSOCIATED(this%level)) then
6948 print*,"---- level vector ----"
6949 print*,"elements=",size(this%level)
6950 do i =1,size(this%level)
6952 end do
6953end if
6954
6955IF (ASSOCIATED(this%timerange))then
6956 print*,"---- timerange vector ----"
6957 print*,"elements=",size(this%timerange)
6958 do i =1,size(this%timerange)
6960 end do
6961end if
6962
6963
6964print*,"---- ana vector ----"
6965print*,""
6966print*,"->>>>>>>>> anavar -"
6968print*,""
6969print*,"->>>>>>>>> anaattr -"
6971print*,""
6972print*,"->>>>>>>>> anavarattr -"
6974
6975print*,"-- ana data section (first point) --"
6976
6977idat=imiss
6978rdat=rmiss
6979ddat=dmiss
6980bdat=ibmiss
6981cdat=cmiss
6982
6983!ntime = MIN(SIZE(this%time),nprint)
6984!ntimerange = MIN(SIZE(this%timerange),nprint)
6985!nlevel = MIN(SIZE(this%level),nprint)
6986!nnetwork = MIN(SIZE(this%network),nprint)
6987!nana = MIN(SIZE(this%ana),nprint)
6988
6989IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0) THEN
6990if (associated(this%volanai)) then
6991 do i=1,size(this%anavar%i)
6992 idat=this%volanai(1,i,1)
6994 end do
6995end if
6996idat=imiss
6997
6998if (associated(this%volanar)) then
6999 do i=1,size(this%anavar%r)
7000 rdat=this%volanar(1,i,1)
7002 end do
7003end if
7004rdat=rmiss
7005
7006if (associated(this%volanad)) then
7007 do i=1,size(this%anavar%d)
7008 ddat=this%volanad(1,i,1)
7010 end do
7011end if
7012ddat=dmiss
7013
7014if (associated(this%volanab)) then
7015 do i=1,size(this%anavar%b)
7016 bdat=this%volanab(1,i,1)
7018 end do
7019end if
7020bdat=ibmiss
7021
7022if (associated(this%volanac)) then
7023 do i=1,size(this%anavar%c)
7024 cdat=this%volanac(1,i,1)
7026 end do
7027end if
7028cdat=cmiss
7029ENDIF
7030
7031print*,"---- data vector ----"
7032print*,""
7033print*,"->>>>>>>>> dativar -"
7035print*,""
7036print*,"->>>>>>>>> datiattr -"
7038print*,""
7039print*,"->>>>>>>>> dativarattr -"
7041
7042print*,"-- data data section (first point) --"
7043
7044idat=imiss
7045rdat=rmiss
7046ddat=dmiss
7047bdat=ibmiss
7048cdat=cmiss
7049
7050IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0 .AND. size(this%time) > 0 &
7051 .AND. size(this%level) > 0 .AND. size(this%timerange) > 0) THEN
7052if (associated(this%voldatii)) then
7053 do i=1,size(this%dativar%i)
7054 idat=this%voldatii(1,1,1,1,i,1)
7056 end do
7057end if
7058idat=imiss
7059
7060if (associated(this%voldatir)) then
7061 do i=1,size(this%dativar%r)
7062 rdat=this%voldatir(1,1,1,1,i,1)
7064 end do
7065end if
7066rdat=rmiss
7067
7068if (associated(this%voldatid)) then
7069 do i=1,size(this%dativar%d)
7070 ddat=this%voldatid(1,1,1,1,i,1)
7072 end do
7073end if
7074ddat=dmiss
7075
7076if (associated(this%voldatib)) then
7077 do i=1,size(this%dativar%b)
7078 bdat=this%voldatib(1,1,1,1,i,1)
7080 end do
7081end if
7082bdat=ibmiss
7083
7084if (associated(this%voldatic)) then
7085 do i=1,size(this%dativar%c)
7086 cdat=this%voldatic(1,1,1,1,i,1)
7088 end do
7089end if
7090cdat=cmiss
7091ENDIF
7092
7093print*,"<<<<<<<<<<<<<<<<<<< END vol7d object >>>>>>>>>>>>>>>>>>>>"
7094
7095END SUBROUTINE vol7d_display
7096
7097
7098!> stampa a video una sintesi del contenuto
7099SUBROUTINE dat_display(this,idat,rdat,ddat,bdat,cdat)
7100TYPE(vol7d_var),intent(in) :: this !< oggetto da visualizzare
7101!> real
7102REAL :: rdat
7103!> double precision
7104DOUBLE PRECISION :: ddat
7105!> integer
7106INTEGER :: idat
7107!> byte
7108INTEGER(kind=int_b) :: bdat
7109!> character
7110CHARACTER(len=*) :: cdat
7111
7112print *, to_char_dat(this,idat,rdat,ddat,bdat,cdat)
7113
7114end SUBROUTINE dat_display
7115
7116!> stampa a video una sintesi del contenuto
7117SUBROUTINE dat_vect_display(this,idat,rdat,ddat,bdat,cdat)
7118
7119TYPE(vol7d_var),intent(in) :: this(:) !< oggetto da visualizzare
7120!> real
7121REAL :: rdat(:)
7122!> double precision
7123DOUBLE PRECISION :: ddat(:)
7124!> integer
7125INTEGER :: idat(:)
7126!> byte
7127INTEGER(kind=int_b) :: bdat(:)
7128!> character
7129CHARACTER(len=*):: cdat(:)
7130
7131integer :: i
7132
7133do i =1,size(this)
7135end do
7136
7137end SUBROUTINE dat_vect_display
7138
7139
7140FUNCTION to_char_dat(this,idat,rdat,ddat,bdat,cdat)
7141#ifdef HAVE_DBALLE
7142USE dballef
7143#endif
7144TYPE(vol7d_var),INTENT(in) :: this
7145!> real
7146REAL :: rdat
7147!> double precision
7148DOUBLE PRECISION :: ddat
7149!> integer
7150INTEGER :: idat
7151!> byte
7152INTEGER(kind=int_b) :: bdat
7153!> character
7154CHARACTER(len=*) :: cdat
7155CHARACTER(len=80) :: to_char_dat
7156
7157CHARACTER(len=LEN(to_char_dat)) :: to_char_tmp
7158
7159
7160#ifdef HAVE_DBALLE
7161INTEGER :: handle, ier
7162
7163handle = 0
7164to_char_dat="VALUE: "
7165
7170
7172 ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
7173 ier = idba_spiegab(handle,this%btable,cdat,to_char_tmp)
7174 ier = idba_fatto(handle)
7175 to_char_dat=trim(to_char_dat)//" ;char> "//trim(to_char_tmp)
7176endif
7177
7178#else
7179
7180to_char_dat="VALUE: "
7186
7187#endif
7188
7189END FUNCTION to_char_dat
7190
7191
7192!> Tests whether anything has ever been assigned to a vol7d object
7193!! (.TRUE.) or it is as clean as after an init (.FALSE.).
7194FUNCTION vol7d_c_e(this) RESULT(c_e)
7195TYPE(vol7d), INTENT(in) :: this
7196
7197LOGICAL :: c_e
7198
7200 ASSOCIATED(this%level) .OR. ASSOCIATED(this%timerange) .OR. &
7201 ASSOCIATED(this%network) .OR. &
7202 ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
7203 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
7204 ASSOCIATED(this%anavar%c) .OR. &
7205 ASSOCIATED(this%anaattr%r) .OR. ASSOCIATED(this%anaattr%d) .OR. &
7206 ASSOCIATED(this%anaattr%i) .OR. ASSOCIATED(this%anaattr%b) .OR. &
7207 ASSOCIATED(this%anaattr%c) .OR. &
7208 ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
7209 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
7210 ASSOCIATED(this%dativar%c) .OR. &
7211 ASSOCIATED(this%datiattr%r) .OR. ASSOCIATED(this%datiattr%d) .OR. &
7212 ASSOCIATED(this%datiattr%i) .OR. ASSOCIATED(this%datiattr%b) .OR. &
7213 ASSOCIATED(this%datiattr%c)
7214
7215END FUNCTION vol7d_c_e
7216
7217
7218!> Metodo per allocare i descrittori delle 7 dimensioni.
7219!! Riceve un grande numero di parametri opzionali che
7220!! indicano quali descrittori allocare e con quale estensione;
7221!! i descrittori non specificati non vengono toccati.
7222!! Può essere quindi chiamato più volte allocando via via
7223!! descrittori relativi a dimensioni diverse.
7224!! Se un descrittore richiesto è già allocato, viene deallocato
7225!! (perdendone l'eventuale contenuto) e riallocato con l'estensione
7226!! richiesta.
7227!! Per i descrittori relativi a dimensioni che non siano variabili o attributi,
7228!! è possibile specificare l'estensione di una dimensione a 0,
7229!! in tal caso il descrittore viene comunque allocato con lunghezza nulla,
7230!! che è diverso da non allocarlo. Per i descrittori di variabili e attributi
7231!! passare un'estensione 0 equivale a non fornire il parametro.
7232!! Avere uno o più descrittori dimensionati con estensione nulla fa sì
7233!! che anche il volume dati successivamente allocato abbia estensione nulla;
7234!! sebbene ciò appaia inutile, un volume del genere può in realtà servire,
7235!! in associazione ai metodi ::vol7d_merge o ::vol7d_append per estendere
7236!! un volume esistente aggiungendo elementi in alcune dimensioni (quelle
7237!! a estensione non nulla, ovviamente) e mantenendo invariato tutto il resto.
7238!! Per quanto riguarda i descrittori delle dimensioni relative alle
7239!! variabili, la relativa estensione è specificata con la nomenclatura
7240!! \a n<x><y><z> dove <x> può valere:
7241!! - \a ana per variabili relative a voumi di anagrafica
7242!! - \a dati per variabili relative a voumi di dati
7243!!
7244!! <y> può valere:
7245!! - \a var per variabili
7246!! - \a attr per attributi
7247!! - \a varattr variabili aventi attributi nei volumi di attributi
7248!!
7249!! <z> può valere:
7250!! - \a r per variabili o attributi a valori reali
7251!! - \a d per variabili o attributi a valori a doppia precisione
7252!! - \a i per variabili o attributi a valori interi
7253!! - \a b per variabili o attributi a valori byte
7254!! - \a c per variabili o attributi a valori carattere
7255!!
7256SUBROUTINE vol7d_alloc(this, nana, ntime, nlevel, ntimerange, nnetwork, &
7257 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
7258 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
7259 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
7260 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
7261 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
7262 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc, &
7263 ini)
7264TYPE(vol7d),INTENT(inout) :: this !< oggetto di cui allocare i descrittori
7265INTEGER,INTENT(in),OPTIONAL :: nana !< estensione della dimensione anagrafica
7266INTEGER,INTENT(in),OPTIONAL :: ntime !< estensione della dimensione tempo
7267INTEGER,INTENT(in),OPTIONAL :: nlevel !< estensione della dimensione livello varticale
7268INTEGER,INTENT(in),OPTIONAL :: ntimerange !< estensione della dimensione intervallo temporale (timerange)
7269INTEGER,INTENT(in),OPTIONAL :: nnetwork !< estensione della dimensione rete
7270!> estensione delle possibili dimensioni variabile
7271INTEGER,INTENT(in),OPTIONAL :: &
7272 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
7273 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
7274 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
7275 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
7276 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
7277 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc
7278LOGICAL,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
7279
7280INTEGER :: i
7281LOGICAL :: linit
7282
7283IF (PRESENT(ini)) THEN
7284 linit = ini
7285ELSE
7286 linit = .false.
7287ENDIF
7288
7289! Dimensioni principali
7290IF (PRESENT(nana)) THEN
7291 IF (nana >= 0) THEN
7292 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
7293 ALLOCATE(this%ana(nana))
7294 IF (linit) THEN
7295 DO i = 1, nana
7297 ENDDO
7298 ENDIF
7299 ENDIF
7300ENDIF
7301IF (PRESENT(ntime)) THEN
7302 IF (ntime >= 0) THEN
7303 IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
7304 ALLOCATE(this%time(ntime))
7305 IF (linit) THEN
7306 DO i = 1, ntime
7308 ENDDO
7309 ENDIF
7310 ENDIF
7311ENDIF
7312IF (PRESENT(nlevel)) THEN
7313 IF (nlevel >= 0) THEN
7314 IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
7315 ALLOCATE(this%level(nlevel))
7316 IF (linit) THEN
7317 DO i = 1, nlevel
7319 ENDDO
7320 ENDIF
7321 ENDIF
7322ENDIF
7323IF (PRESENT(ntimerange)) THEN
7324 IF (ntimerange >= 0) THEN
7325 IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
7326 ALLOCATE(this%timerange(ntimerange))
7327 IF (linit) THEN
7328 DO i = 1, ntimerange
7330 ENDDO
7331 ENDIF
7332 ENDIF
7333ENDIF
7334IF (PRESENT(nnetwork)) THEN
7335 IF (nnetwork >= 0) THEN
7336 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
7337 ALLOCATE(this%network(nnetwork))
7338 IF (linit) THEN
7339 DO i = 1, nnetwork
7341 ENDDO
7342 ENDIF
7343 ENDIF
7344ENDIF
7345! Dimensioni dei tipi delle variabili
7346CALL vol7d_varvect_alloc(this%anavar, nanavarr, nanavard, &
7347 nanavari, nanavarb, nanavarc, ini)
7348CALL vol7d_varvect_alloc(this%anaattr, nanaattrr, nanaattrd, &
7349 nanaattri, nanaattrb, nanaattrc, ini)
7350CALL vol7d_varvect_alloc(this%anavarattr, nanavarattrr, nanavarattrd, &
7351 nanavarattri, nanavarattrb, nanavarattrc, ini)
7352CALL vol7d_varvect_alloc(this%dativar, ndativarr, ndativard, &
7353 ndativari, ndativarb, ndativarc, ini)
7354CALL vol7d_varvect_alloc(this%datiattr, ndatiattrr, ndatiattrd, &
7355 ndatiattri, ndatiattrb, ndatiattrc, ini)
7356CALL vol7d_varvect_alloc(this%dativarattr, ndativarattrr, ndativarattrd, &
7357 ndativarattri, ndativarattrb, ndativarattrc, ini)
7358
7359END SUBROUTINE vol7d_alloc
7360
7361
7362FUNCTION vol7d_check_alloc_ana(this)
7363TYPE(vol7d),INTENT(in) :: this
7364LOGICAL :: vol7d_check_alloc_ana
7365
7366vol7d_check_alloc_ana = ASSOCIATED(this%ana) .AND. ASSOCIATED(this%network)
7367
7368END FUNCTION vol7d_check_alloc_ana
7369
7370SUBROUTINE vol7d_force_alloc_ana(this, ini)
7371TYPE(vol7d),INTENT(inout) :: this
7372LOGICAL,INTENT(in),OPTIONAL :: ini
7373
7374! Alloco i descrittori minimi per avere un volume di anagrafica
7375IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=1, ini=ini)
7376IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=1, ini=ini)
7377
7378END SUBROUTINE vol7d_force_alloc_ana
7379
7380
7381FUNCTION vol7d_check_alloc_dati(this)
7382TYPE(vol7d),INTENT(in) :: this
7383LOGICAL :: vol7d_check_alloc_dati
7384
7385vol7d_check_alloc_dati = vol7d_check_alloc_ana(this) .AND. &
7386 ASSOCIATED(this%time) .AND. ASSOCIATED(this%level) .AND. &
7387 ASSOCIATED(this%timerange)
7388
7389END FUNCTION vol7d_check_alloc_dati
7390
7391SUBROUTINE vol7d_force_alloc_dati(this, ini)
7392TYPE(vol7d),INTENT(inout) :: this
7393LOGICAL,INTENT(in),OPTIONAL :: ini
7394
7395! Alloco i descrittori minimi per avere un volume di dati
7396CALL vol7d_force_alloc_ana(this, ini)
7397IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=1, ini=ini)
7398IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=1, ini=ini)
7399IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=1, ini=ini)
7400
7401END SUBROUTINE vol7d_force_alloc_dati
7402
7403
7404SUBROUTINE vol7d_force_alloc(this)
7405TYPE(vol7d),INTENT(inout) :: this
7406
7407! If anything really not allocated yet, allocate with size 0
7408IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=0)
7409IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=0)
7410IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=0)
7411IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=0)
7412IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=0)
7413
7414END SUBROUTINE vol7d_force_alloc
7415
7416
7417FUNCTION vol7d_check_vol(this)
7418TYPE(vol7d),INTENT(in) :: this !< oggetto da controllare
7419LOGICAL :: vol7d_check_vol
7420
7421vol7d_check_vol = c_e(this)
7422
7423! Anagrafica
7424IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
7425 vol7d_check_vol = .false.
7426ENDIF
7427
7428IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
7429 vol7d_check_vol = .false.
7430ENDIF
7431
7432IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
7433 vol7d_check_vol = .false.
7434ENDIF
7435
7436IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
7437 vol7d_check_vol = .false.
7438ENDIF
7439
7440IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
7441 vol7d_check_vol = .false.
7442ENDIF
7443IF (ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
7444 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
7445 ASSOCIATED(this%anavar%c)) THEN
7446 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_ana(this)
7447ENDIF
7448
7449! Attributi dell'anagrafica
7450IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
7451 .NOT.ASSOCIATED(this%volanaattrr)) THEN
7452 vol7d_check_vol = .false.
7453ENDIF
7454
7455IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
7456 .NOT.ASSOCIATED(this%volanaattrd)) THEN
7457 vol7d_check_vol = .false.
7458ENDIF
7459
7460IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
7461 .NOT.ASSOCIATED(this%volanaattri)) THEN
7462 vol7d_check_vol = .false.
7463ENDIF
7464
7465IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
7466 .NOT.ASSOCIATED(this%volanaattrb)) THEN
7467 vol7d_check_vol = .false.
7468ENDIF
7469
7470IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
7471 .NOT.ASSOCIATED(this%volanaattrc)) THEN
7472 vol7d_check_vol = .false.
7473ENDIF
7474
7475! Dati
7476IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
7477 vol7d_check_vol = .false.
7478ENDIF
7479
7480IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
7481 vol7d_check_vol = .false.
7482ENDIF
7483
7484IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
7485 vol7d_check_vol = .false.
7486ENDIF
7487
7488IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
7489 vol7d_check_vol = .false.
7490ENDIF
7491
7492IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
7493 vol7d_check_vol = .false.
7494ENDIF
7495
7496! Attributi dei dati
7497IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
7498 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
7499 vol7d_check_vol = .false.
7500ENDIF
7501
7502IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
7503 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
7504 vol7d_check_vol = .false.
7505ENDIF
7506
7507IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
7508 .NOT.ASSOCIATED(this%voldatiattri)) THEN
7509 vol7d_check_vol = .false.
7510ENDIF
7511
7512IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
7513 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
7514 vol7d_check_vol = .false.
7515ENDIF
7516
7517IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
7518 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
7519 vol7d_check_vol = .false.
7520ENDIF
7521IF (ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
7522 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
7523 ASSOCIATED(this%dativar%c)) THEN
7524 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_dati(this)
7525ENDIF
7526
7527END FUNCTION vol7d_check_vol
7528
7529
7530!> Metodo per allocare i volumi richiesti di variabili e attributi per
7531!! anagrafica e dati.
7532!! Se alcuni dei descrittori relativi alle dimensioni anagrafica,
7533!! livello verticale, tempo, intervallo temporale (timerange), rete non sono
7534!! stati richiesti preventivamente con la ::vol7d_alloc, essi vengono allocati
7535!! automaticamente da questo metodo
7536!! con estensione di default pari a 1 (non 0!), questo significa, ad esempio,
7537!! che se prevedo di avere soli dati superficiali, cioè ad un solo livello
7538!! verticale, o una sola rete di stazioni, non devo preoccuparmi di
7539!! specificare questa informazione.
7540!! Tra i 20 possibili volumi allocabili
7541!! ((variabili,attributi)*(anagrafica,dati)*(r,d,i,b,c)=20)
7542!! saranno allocati solo quelli per cui è stato precedentemente richiesto il
7543!! corrispondente descrittore variabili/attributi con la ::vol7d_alloc.
7544SUBROUTINE vol7d_alloc_vol(this, ini, inivol)
7545TYPE(vol7d),INTENT(inout) :: this !< oggetto di cui allocare i volumi
7546LOGICAL,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
7547LOGICAL,INTENT(in),OPTIONAL :: inivol !< se fornito e vale \c .TRUE., i volumi allocati saranno inizializzati a valore mancante
7548
7549LOGICAL :: linivol
7550
7551IF (PRESENT(inivol)) THEN
7552 linivol = inivol
7553ELSE
7554 linivol = .true.
7555ENDIF
7556
7557! Anagrafica
7558IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
7559 CALL vol7d_force_alloc_ana(this, ini)
7560 ALLOCATE(this%volanar(SIZE(this%ana), SIZE(this%anavar%r), SIZE(this%network)))
7561 IF (linivol) this%volanar(:,:,:) = rmiss
7562ENDIF
7563
7564IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
7565 CALL vol7d_force_alloc_ana(this, ini)
7566 ALLOCATE(this%volanad(SIZE(this%ana), SIZE(this%anavar%d), SIZE(this%network)))
7567 IF (linivol) this%volanad(:,:,:) = rdmiss
7568ENDIF
7569
7570IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
7571 CALL vol7d_force_alloc_ana(this, ini)
7572 ALLOCATE(this%volanai(SIZE(this%ana), SIZE(this%anavar%i), SIZE(this%network)))
7573 IF (linivol) this%volanai(:,:,:) = imiss
7574ENDIF
7575
7576IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
7577 CALL vol7d_force_alloc_ana(this, ini)
7578 ALLOCATE(this%volanab(SIZE(this%ana), SIZE(this%anavar%b), SIZE(this%network)))
7579 IF (linivol) this%volanab(:,:,:) = ibmiss
7580ENDIF
7581
7582IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
7583 CALL vol7d_force_alloc_ana(this, ini)
7584 ALLOCATE(this%volanac(SIZE(this%ana), SIZE(this%anavar%c), SIZE(this%network)))
7585 IF (linivol) this%volanac(:,:,:) = cmiss
7586ENDIF
7587
7588! Attributi dell'anagrafica
7589IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
7590 .NOT.ASSOCIATED(this%volanaattrr)) THEN
7591 CALL vol7d_force_alloc_ana(this, ini)
7592 ALLOCATE(this%volanaattrr(SIZE(this%ana), SIZE(this%anavarattr%r), &
7593 SIZE(this%network), SIZE(this%anaattr%r)))
7594 IF (linivol) this%volanaattrr(:,:,:,:) = rmiss
7595ENDIF
7596
7597IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
7598 .NOT.ASSOCIATED(this%volanaattrd)) THEN
7599 CALL vol7d_force_alloc_ana(this, ini)
7600 ALLOCATE(this%volanaattrd(SIZE(this%ana), SIZE(this%anavarattr%d), &
7601 SIZE(this%network), SIZE(this%anaattr%d)))
7602 IF (linivol) this%volanaattrd(:,:,:,:) = rdmiss
7603ENDIF
7604
7605IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
7606 .NOT.ASSOCIATED(this%volanaattri)) THEN
7607 CALL vol7d_force_alloc_ana(this, ini)
7608 ALLOCATE(this%volanaattri(SIZE(this%ana), SIZE(this%anavarattr%i), &
7609 SIZE(this%network), SIZE(this%anaattr%i)))
7610 IF (linivol) this%volanaattri(:,:,:,:) = imiss
7611ENDIF
7612
7613IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
7614 .NOT.ASSOCIATED(this%volanaattrb)) THEN
7615 CALL vol7d_force_alloc_ana(this, ini)
7616 ALLOCATE(this%volanaattrb(SIZE(this%ana), SIZE(this%anavarattr%b), &
7617 SIZE(this%network), SIZE(this%anaattr%b)))
7618 IF (linivol) this%volanaattrb(:,:,:,:) = ibmiss
7619ENDIF
7620
7621IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
7622 .NOT.ASSOCIATED(this%volanaattrc)) THEN
7623 CALL vol7d_force_alloc_ana(this, ini)
7624 ALLOCATE(this%volanaattrc(SIZE(this%ana), SIZE(this%anavarattr%c), &
7625 SIZE(this%network), SIZE(this%anaattr%c)))
7626 IF (linivol) this%volanaattrc(:,:,:,:) = cmiss
7627ENDIF
7628
7629! Dati
7630IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
7631 CALL vol7d_force_alloc_dati(this, ini)
7632 ALLOCATE(this%voldatir(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7633 SIZE(this%timerange), SIZE(this%dativar%r), SIZE(this%network)))
7634 IF (linivol) this%voldatir(:,:,:,:,:,:) = rmiss
7635ENDIF
7636
7637IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
7638 CALL vol7d_force_alloc_dati(this, ini)
7639 ALLOCATE(this%voldatid(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7640 SIZE(this%timerange), SIZE(this%dativar%d), SIZE(this%network)))
7641 IF (linivol) this%voldatid(:,:,:,:,:,:) = rdmiss
7642ENDIF
7643
7644IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
7645 CALL vol7d_force_alloc_dati(this, ini)
7646 ALLOCATE(this%voldatii(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7647 SIZE(this%timerange), SIZE(this%dativar%i), SIZE(this%network)))
7648 IF (linivol) this%voldatii(:,:,:,:,:,:) = imiss
7649ENDIF
7650
7651IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
7652 CALL vol7d_force_alloc_dati(this, ini)
7653 ALLOCATE(this%voldatib(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7654 SIZE(this%timerange), SIZE(this%dativar%b), SIZE(this%network)))
7655 IF (linivol) this%voldatib(:,:,:,:,:,:) = ibmiss
7656ENDIF
7657
7658IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
7659 CALL vol7d_force_alloc_dati(this, ini)
7660 ALLOCATE(this%voldatic(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7661 SIZE(this%timerange), SIZE(this%dativar%c), SIZE(this%network)))
7662 IF (linivol) this%voldatic(:,:,:,:,:,:) = cmiss
7663ENDIF
7664
7665! Attributi dei dati
7666IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
7667 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
7668 CALL vol7d_force_alloc_dati(this, ini)
7669 ALLOCATE(this%voldatiattrr(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7670 SIZE(this%timerange), SIZE(this%dativarattr%r), SIZE(this%network), &
7671 SIZE(this%datiattr%r)))
7672 IF (linivol) this%voldatiattrr(:,:,:,:,:,:,:) = rmiss
7673ENDIF
7674
7675IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
7676 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
7677 CALL vol7d_force_alloc_dati(this, ini)
7678 ALLOCATE(this%voldatiattrd(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7679 SIZE(this%timerange), SIZE(this%dativarattr%d), SIZE(this%network), &
7680 SIZE(this%datiattr%d)))
7681 IF (linivol) this%voldatiattrd(:,:,:,:,:,:,:) = rdmiss
7682ENDIF
7683
7684IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
7685 .NOT.ASSOCIATED(this%voldatiattri)) THEN
7686 CALL vol7d_force_alloc_dati(this, ini)
7687 ALLOCATE(this%voldatiattri(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7688 SIZE(this%timerange), SIZE(this%dativarattr%i), SIZE(this%network), &
7689 SIZE(this%datiattr%i)))
7690 IF (linivol) this%voldatiattri(:,:,:,:,:,:,:) = imiss
7691ENDIF
7692
7693IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
7694 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
7695 CALL vol7d_force_alloc_dati(this, ini)
7696 ALLOCATE(this%voldatiattrb(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7697 SIZE(this%timerange), SIZE(this%dativarattr%b), SIZE(this%network), &
7698 SIZE(this%datiattr%b)))
7699 IF (linivol) this%voldatiattrb(:,:,:,:,:,:,:) = ibmiss
7700ENDIF
7701
7702IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
7703 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
7704 CALL vol7d_force_alloc_dati(this, ini)
7705 ALLOCATE(this%voldatiattrc(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7706 SIZE(this%timerange), SIZE(this%dativarattr%c), SIZE(this%network), &
7707 SIZE(this%datiattr%c)))
7708 IF (linivol) this%voldatiattrc(:,:,:,:,:,:,:) = cmiss
7709ENDIF
7710
7711! Catch-all method
7712CALL vol7d_force_alloc(this)
7713
7714! Creo gli indici var-attr
7715
7716#ifdef DEBUG
7717CALL l4f_log(l4f_debug,"calling: vol7d_set_attr_ind")
7718#endif
7719
7720CALL vol7d_set_attr_ind(this)
7721
7722
7723
7724END SUBROUTINE vol7d_alloc_vol
7725
7726
7727!> Metodo per creare gli indici che associano le variabili aventi attributo
7728!! alle variabili nei relativi descrittori.
7729!! Ha senso chiamare questo metodo solo dopo che i descrittori delle variabili
7730!! e degli attributi desiderati sono stati allocati ed è stato assegnato un
7731!! valore ai relativi membri btable (vedi vol7d_var_class::vol7d_var), se
7732!! i descrittori non sono stati allocati o assegnati, il metodo non fa niente.
7733SUBROUTINE vol7d_set_attr_ind(this)
7734TYPE(vol7d),INTENT(inout) :: this !< oggetto in cui creare gli indici
7735
7736INTEGER :: i
7737
7738! real
7739IF (ASSOCIATED(this%dativar%r)) THEN
7740 IF (ASSOCIATED(this%dativarattr%r)) THEN
7741 DO i = 1, SIZE(this%dativar%r)
7742 this%dativar%r(i)%r = &
7743 firsttrue(this%dativar%r(i)%btable == this%dativarattr%r(:)%btable)
7744 ENDDO
7745 ENDIF
7746
7747 IF (ASSOCIATED(this%dativarattr%d)) THEN
7748 DO i = 1, SIZE(this%dativar%r)
7749 this%dativar%r(i)%d = &
7750 firsttrue(this%dativar%r(i)%btable == this%dativarattr%d(:)%btable)
7751 ENDDO
7752 ENDIF
7753
7754 IF (ASSOCIATED(this%dativarattr%i)) THEN
7755 DO i = 1, SIZE(this%dativar%r)
7756 this%dativar%r(i)%i = &
7757 firsttrue(this%dativar%r(i)%btable == this%dativarattr%i(:)%btable)
7758 ENDDO
7759 ENDIF
7760
7761 IF (ASSOCIATED(this%dativarattr%b)) THEN
7762 DO i = 1, SIZE(this%dativar%r)
7763 this%dativar%r(i)%b = &
7764 firsttrue(this%dativar%r(i)%btable == this%dativarattr%b(:)%btable)
7765 ENDDO
7766 ENDIF
7767
7768 IF (ASSOCIATED(this%dativarattr%c)) THEN
7769 DO i = 1, SIZE(this%dativar%r)
7770 this%dativar%r(i)%c = &
7771 firsttrue(this%dativar%r(i)%btable == this%dativarattr%c(:)%btable)
7772 ENDDO
7773 ENDIF
7774ENDIF
7775! double
7776IF (ASSOCIATED(this%dativar%d)) THEN
7777 IF (ASSOCIATED(this%dativarattr%r)) THEN
7778 DO i = 1, SIZE(this%dativar%d)
7779 this%dativar%d(i)%r = &
7780 firsttrue(this%dativar%d(i)%btable == this%dativarattr%r(:)%btable)
7781 ENDDO
7782 ENDIF
7783
7784 IF (ASSOCIATED(this%dativarattr%d)) THEN
7785 DO i = 1, SIZE(this%dativar%d)
7786 this%dativar%d(i)%d = &
7787 firsttrue(this%dativar%d(i)%btable == this%dativarattr%d(:)%btable)
7788 ENDDO
7789 ENDIF
7790
7791 IF (ASSOCIATED(this%dativarattr%i)) THEN
7792 DO i = 1, SIZE(this%dativar%d)
7793 this%dativar%d(i)%i = &
7794 firsttrue(this%dativar%d(i)%btable == this%dativarattr%i(:)%btable)
7795 ENDDO
7796 ENDIF
7797
7798 IF (ASSOCIATED(this%dativarattr%b)) THEN
7799 DO i = 1, SIZE(this%dativar%d)
7800 this%dativar%d(i)%b = &
7801 firsttrue(this%dativar%d(i)%btable == this%dativarattr%b(:)%btable)
7802 ENDDO
7803 ENDIF
7804
7805 IF (ASSOCIATED(this%dativarattr%c)) THEN
7806 DO i = 1, SIZE(this%dativar%d)
7807 this%dativar%d(i)%c = &
7808 firsttrue(this%dativar%d(i)%btable == this%dativarattr%c(:)%btable)
7809 ENDDO
7810 ENDIF
7811ENDIF
7812! integer
7813IF (ASSOCIATED(this%dativar%i)) THEN
7814 IF (ASSOCIATED(this%dativarattr%r)) THEN
7815 DO i = 1, SIZE(this%dativar%i)
7816 this%dativar%i(i)%r = &
7817 firsttrue(this%dativar%i(i)%btable == this%dativarattr%r(:)%btable)
7818 ENDDO
7819 ENDIF
7820
7821 IF (ASSOCIATED(this%dativarattr%d)) THEN
7822 DO i = 1, SIZE(this%dativar%i)
7823 this%dativar%i(i)%d = &
7824 firsttrue(this%dativar%i(i)%btable == this%dativarattr%d(:)%btable)
7825 ENDDO
7826 ENDIF
7827
7828 IF (ASSOCIATED(this%dativarattr%i)) THEN
7829 DO i = 1, SIZE(this%dativar%i)
7830 this%dativar%i(i)%i = &
7831 firsttrue(this%dativar%i(i)%btable == this%dativarattr%i(:)%btable)
7832 ENDDO
7833 ENDIF
7834
7835 IF (ASSOCIATED(this%dativarattr%b)) THEN
7836 DO i = 1, SIZE(this%dativar%i)
7837 this%dativar%i(i)%b = &
7838 firsttrue(this%dativar%i(i)%btable == this%dativarattr%b(:)%btable)
7839 ENDDO
7840 ENDIF
7841
7842 IF (ASSOCIATED(this%dativarattr%c)) THEN
7843 DO i = 1, SIZE(this%dativar%i)
7844 this%dativar%i(i)%c = &
7845 firsttrue(this%dativar%i(i)%btable == this%dativarattr%c(:)%btable)
7846 ENDDO
7847 ENDIF
7848ENDIF
7849! byte
7850IF (ASSOCIATED(this%dativar%b)) THEN
7851 IF (ASSOCIATED(this%dativarattr%r)) THEN
7852 DO i = 1, SIZE(this%dativar%b)
7853 this%dativar%b(i)%r = &
7854 firsttrue(this%dativar%b(i)%btable == this%dativarattr%r(:)%btable)
7855 ENDDO
7856 ENDIF
7857
7858 IF (ASSOCIATED(this%dativarattr%d)) THEN
7859 DO i = 1, SIZE(this%dativar%b)
7860 this%dativar%b(i)%d = &
7861 firsttrue(this%dativar%b(i)%btable == this%dativarattr%d(:)%btable)
7862 ENDDO
7863 ENDIF
7864
7865 IF (ASSOCIATED(this%dativarattr%i)) THEN
7866 DO i = 1, SIZE(this%dativar%b)
7867 this%dativar%b(i)%i = &
7868 firsttrue(this%dativar%b(i)%btable == this%dativarattr%i(:)%btable)
7869 ENDDO
7870 ENDIF
7871
7872 IF (ASSOCIATED(this%dativarattr%b)) THEN
7873 DO i = 1, SIZE(this%dativar%b)
7874 this%dativar%b(i)%b = &
7875 firsttrue(this%dativar%b(i)%btable == this%dativarattr%b(:)%btable)
7876 ENDDO
7877 ENDIF
7878
7879 IF (ASSOCIATED(this%dativarattr%c)) THEN
7880 DO i = 1, SIZE(this%dativar%b)
7881 this%dativar%b(i)%c = &
7882 firsttrue(this%dativar%b(i)%btable == this%dativarattr%c(:)%btable)
7883 ENDDO
7884 ENDIF
7885ENDIF
7886! character
7887IF (ASSOCIATED(this%dativar%c)) THEN
7888 IF (ASSOCIATED(this%dativarattr%r)) THEN
7889 DO i = 1, SIZE(this%dativar%c)
7890 this%dativar%c(i)%r = &
7891 firsttrue(this%dativar%c(i)%btable == this%dativarattr%r(:)%btable)
7892 ENDDO
7893 ENDIF
7894
7895 IF (ASSOCIATED(this%dativarattr%d)) THEN
7896 DO i = 1, SIZE(this%dativar%c)
7897 this%dativar%c(i)%d = &
7898 firsttrue(this%dativar%c(i)%btable == this%dativarattr%d(:)%btable)
7899 ENDDO
7900 ENDIF
7901
7902 IF (ASSOCIATED(this%dativarattr%i)) THEN
7903 DO i = 1, SIZE(this%dativar%c)
7904 this%dativar%c(i)%i = &
7905 firsttrue(this%dativar%c(i)%btable == this%dativarattr%i(:)%btable)
7906 ENDDO
7907 ENDIF
7908
7909 IF (ASSOCIATED(this%dativarattr%b)) THEN
7910 DO i = 1, SIZE(this%dativar%c)
7911 this%dativar%c(i)%b = &
7912 firsttrue(this%dativar%c(i)%btable == this%dativarattr%b(:)%btable)
7913 ENDDO
7914 ENDIF
7915
7916 IF (ASSOCIATED(this%dativarattr%c)) THEN
7917 DO i = 1, SIZE(this%dativar%c)
7918 this%dativar%c(i)%c = &
7919 firsttrue(this%dativar%c(i)%btable == this%dativarattr%c(:)%btable)
7920 ENDDO
7921 ENDIF
7922ENDIF
7923
7924END SUBROUTINE vol7d_set_attr_ind
7925
7926
7927!> Metodo per fondere 2 oggetti vol7d.
7928!! Il secondo volume viene accodato al primo e poi distrutto, si veda
7929!! quindi la descrizione di ::vol7d_append. Se uno degli oggetti \a
7930!! this o \a that sono vuoti non perde tempo inutile,
7931SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
7932 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
7933TYPE(vol7d),INTENT(INOUT) :: this !< primo oggetto in ingresso, alla fine conterrà il risultato della fusione
7934TYPE(vol7d),INTENT(INOUT) :: that !< secondo oggetto in ingresso, alla fine sarà distrutto
7935LOGICAL,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
7936LOGICAL,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
7937LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple ! experimental, please do not use outside the library now
7938
7939TYPE(vol7d) :: v7d_clean
7940
7941
7943 this = that
7945 that = v7d_clean ! destroy that without deallocating
7946ELSE ! Append that to this and destroy that
7948 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
7950ENDIF
7951
7952END SUBROUTINE vol7d_merge
7953
7954
7955!> Metodo per accodare un oggetto vol7d ad un altro.
7956!! Si tratta di un metodo molto potente e versatile;
7957!! i descrittori delle dimensioni del volume finale conterranno i valori
7958!! dei corrispondenti descrittori del primo e del secondo volume
7959!! e i volumi di anagrafica e dati conterranno i valori dei due volumi
7960!! ai posti giusti, e valori mancanti per le nuove combinazioni che
7961!! eventualmente si verranno a creare.
7962!! Se i volumi multidimensionali di anagrafica e/o dati dei 2 oggetti
7963!! hanno un'intersezione non nulla, negli elementi comuni il volume finale
7964!! conterrà il corrispondente elemento del \b secondo volume.
7965!! Attenzione che, durante l'esecuzione del metodo, la memoria richiesta è
7966!! pari alla memoria complessiva occupata dai 2 volumi iniziali più
7967!! la memoria complessiva del volume finale, per cui, nel caso di volumi grandi,
7968!! ci potrebbero essere problemi di esaurimento della memoria centrale.
7969!! Se l'oggetto \a that è vuoto non perde tempo inutile,
7970!!
7971!! \todo nel caso di elementi comuni inserire la possibiità (opzionale per
7972!! non penalizzare le prestazioni quando ciò non serve) di effettuare una scelta
7973!! più ragionata dell'elemento da tenere, almeno controllando i dati mancanti
7974!! se non le flag di qualità
7975!!
7976!! \todo "rateizzare" l'allocazione dei volumi per ridurre l'occupazione di
7977!! memoria nel caso siano allocati contemporaneamente volumi di variabili e
7978!! di attributi o più volumi di tipi diversi
7979!!
7980!! \todo il parametro \a that è dichiarato \a INOUT perché la vol7d_alloc_vol
7981!! può modificarlo, bisognerebbe implementare una vol7d_check_vol che restituisca
7982!! errore anziché usare la vol7d_alloc_vol.
7983SUBROUTINE vol7d_append(this, that, sort, bestdata, &
7984 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
7985TYPE(vol7d),INTENT(INOUT) :: this !< primo oggetto in ingresso, a cui sarà accodato il secondo
7986TYPE(vol7d),INTENT(IN) :: that !< secondo oggetto in ingresso, non viene modificato dal metodo
7987LOGICAL,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
7988! experimental, please do not use outside the library now, they force the use
7989! of a simplified mapping algorithm which is valid only whene the dimension
7990! content is the same in both volumes , or when one of them is empty
7991LOGICAL,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
7992LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple
7993
7994
7995TYPE(vol7d) :: v7dtmp
7996LOGICAL :: lsort, lbestdata
7997INTEGER,POINTER :: remapt1(:), remapt2(:), remaptr1(:), remaptr2(:), &
7998 remapl1(:), remapl2(:), remapa1(:), remapa2(:), remapn1(:), remapn2(:)
7999
8001IF (.NOT.vol7d_check_vol(that)) RETURN ! be safe
8004 RETURN
8005ENDIF
8006
8007IF (this%time_definition /= that%time_definition) THEN
8008 CALL l4f_log(l4f_fatal, &
8009 'in vol7d_append, cannot append volumes with different &
8010 &time definition')
8011 CALL raise_fatal_error()
8012ENDIF
8013
8014! Completo l'allocazione per avere volumi a norma
8015CALL vol7d_alloc_vol(this)
8016
8020
8021! Calcolo le mappature tra volumi vecchi e volume nuovo
8022! I puntatori remap* vengono tutti o allocati o nullificati
8023IF (optio_log(ltimesimple)) THEN
8024 CALL vol7d_remap2simple_datetime(this%time, that%time, v7dtmp%time, &
8025 lsort, remapt1, remapt2)
8026ELSE
8027 CALL vol7d_remap2_datetime(this%time, that%time, v7dtmp%time, &
8028 lsort, remapt1, remapt2)
8029ENDIF
8030IF (optio_log(ltimerangesimple)) THEN
8031 CALL vol7d_remap2simple_vol7d_timerange(this%timerange, that%timerange, &
8032 v7dtmp%timerange, lsort, remaptr1, remaptr2)
8033ELSE
8034 CALL vol7d_remap2_vol7d_timerange(this%timerange, that%timerange, &
8035 v7dtmp%timerange, lsort, remaptr1, remaptr2)
8036ENDIF
8037IF (optio_log(llevelsimple)) THEN
8038 CALL vol7d_remap2simple_vol7d_level(this%level, that%level, v7dtmp%level, &
8039 lsort, remapl1, remapl2)
8040ELSE
8041 CALL vol7d_remap2_vol7d_level(this%level, that%level, v7dtmp%level, &
8042 lsort, remapl1, remapl2)
8043ENDIF
8044IF (optio_log(lanasimple)) THEN
8045 CALL vol7d_remap2simple_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
8046 .false., remapa1, remapa2)
8047ELSE
8048 CALL vol7d_remap2_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
8049 .false., remapa1, remapa2)
8050ENDIF
8051IF (optio_log(lnetworksimple)) THEN
8052 CALL vol7d_remap2simple_vol7d_network(this%network, that%network, v7dtmp%network, &
8053 .false., remapn1, remapn2)
8054ELSE
8055 CALL vol7d_remap2_vol7d_network(this%network, that%network, v7dtmp%network, &
8056 .false., remapn1, remapn2)
8057ENDIF
8058
8059! Faccio la fusione fisica dei volumi
8060CALL vol7d_merge_finalr(this, that, v7dtmp, &
8061 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
8062 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
8063CALL vol7d_merge_finald(this, that, v7dtmp, &
8064 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
8065 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
8066CALL vol7d_merge_finali(this, that, v7dtmp, &
8067 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
8068 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
8069CALL vol7d_merge_finalb(this, that, v7dtmp, &
8070 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
8071 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
8072CALL vol7d_merge_finalc(this, that, v7dtmp, &
8073 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
8074 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
8075
8076! Dealloco i vettori di rimappatura
8077IF (ASSOCIATED(remapt1)) DEALLOCATE(remapt1)
8078IF (ASSOCIATED(remapt2)) DEALLOCATE(remapt2)
8079IF (ASSOCIATED(remaptr1)) DEALLOCATE(remaptr1)
8080IF (ASSOCIATED(remaptr2)) DEALLOCATE(remaptr2)
8081IF (ASSOCIATED(remapl1)) DEALLOCATE(remapl1)
8082IF (ASSOCIATED(remapl2)) DEALLOCATE(remapl2)
8083IF (ASSOCIATED(remapa1)) DEALLOCATE(remapa1)
8084IF (ASSOCIATED(remapa2)) DEALLOCATE(remapa2)
8085IF (ASSOCIATED(remapn1)) DEALLOCATE(remapn1)
8086IF (ASSOCIATED(remapn2)) DEALLOCATE(remapn2)
8087
8088! Distruggo il vecchio volume e assegno il nuovo a this
8090this = v7dtmp
8091! Ricreo gli indici var-attr
8092CALL vol7d_set_attr_ind(this)
8093
8094END SUBROUTINE vol7d_append
8095
8096
8097!> Metodo per creare una copia completa e indipendente di un oggetto vol7d.
8098!! Questo metodo crea un duplicato di tutti i membri di un oggetto vol7d,
8099!! con la possibilità di rielaborarlo durante la copia. Se l'oggetto da copiare
8100!! è vuoto non perde tempo inutile.
8101!! Attenzione, il codice:
8102!! \code
8103!! USE vol7d_class
8104!! TYPE(vol7d) :: vol1, vol2
8105!! CALL init(vol1)
8106!! CALL init(vol2)
8107!! ... ! riempio vol1
8108!! vol2 = vol1
8109!! \endcode
8110!! fa una cosa diversa rispetto a:
8111!! \code
8112!! USE vol7d_class
8113!! TYPE(vol7d) :: vol1, vol2
8114!! CALL init(vol1)
8115!! CALL init(vol2)
8116!! ... ! riempio vol1
8117!! CALL vol7d_copy(vol1, vol2)
8118!! \endcode
8119!! nel primo caso, infatti, l'operatore di assegnazione copia solo i componenti
8120!! statici di \a vol1 nei corrispondenti elementi di \a vol2, mentre i componenti che
8121!! sono allocati dinamicamente (cioè quelli che in ::vol7d hanno l'attributo
8122!! \c POINTER, in pratica quasi tutti) non vengono duplicati, ma per essi vol2
8123!! conterrà un puntatore al corrispondente elemento a cui già punta vol1, e quindi
8124!! eventuali cambiamenti al contenuto di uno dei due oggetti influenzerà il
8125!! contenuto dell'altro; nel secondo caso, invece, vol1 e vol2 sono, dopo la
8126!! vol7d_copy, 2 istanze
8127!! completamente indipendenti, ma uguali tra loro per contenuto, della classe
8128!! vol7d, e quindi hanno vita indipendente.
8129SUBROUTINE vol7d_copy(this, that, sort, unique, miss, &
8130 lsort_time, lsort_timerange, lsort_level, &
8131 ltime, ltimerange, llevel, lana, lnetwork, &
8132 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
8133 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
8134 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
8135 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
8136 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
8137 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
8138TYPE(vol7d),INTENT(IN) :: this !< oggetto origine
8139TYPE(vol7d),INTENT(INOUT) :: that !< oggetto destinazione
8140LOGICAL,INTENT(IN),OPTIONAL :: sort !< if present and \a .TRUE., sort all the sortable dimensions
8141LOGICAL,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)
8142LOGICAL,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
8143LOGICAL,INTENT(IN),OPTIONAL :: lsort_time !< if present and \a .TRUE., sort only time dimension (alternative to \a sort )
8144LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange !< if present and \a .TRUE., sort only timerange dimension (alternative to \a sort )
8145LOGICAL,INTENT(IN),OPTIONAL :: lsort_level !< if present and \a .TRUE., sort only level dimension (alternative to \a sort )
8146!> se fornito, deve essere un vettore logico della stessa lunghezza di
8147!! this%time indicante quali elementi della dimensione \a time
8148!! mantenere (valori \c .TRUE.) e quali scartare (valori \c .FALSE.)
8149!! nel volume copiato; in alternativa può essere un vettore di
8150!! lunghezza 1, in tal caso, se \c .FALSE. , equivale a scartare tutti
8151!! gli elementi (utile principalmente per le variabili); è compatibile
8152!! col parametro \a miss
8153LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
8154!> come il precedente per la dimensione \a timerange
8155LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
8156!> come il precedente per la dimensione \a level
8157LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
8158!> come il precedente per la dimensione \a ana
8159LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
8160!> come il precedente per la dimensione \a network
8161LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
8162!> come il precedente per tutte le possibili dimensioni variabile
8163LOGICAL,INTENT(in),OPTIONAL :: &
8164 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
8165 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
8166 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
8167 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
8168 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
8169 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
8170
8171LOGICAL :: lsort, lunique, lmiss
8172INTEGER,POINTER :: remapt(:), remaptr(:), remapl(:), remapa(:), remapn(:)
8173
8176IF (.NOT.vol7d_check_vol(this)) RETURN ! be safe
8177
8181
8182! Calcolo le mappature tra volume vecchio e volume nuovo
8183! I puntatori remap* vengono tutti o allocati o nullificati
8184CALL vol7d_remap1_datetime(this%time, that%time, &
8185 lsort.OR.optio_log(lsort_time), lunique, lmiss, remapt, ltime)
8186CALL vol7d_remap1_vol7d_timerange(this%timerange, that%timerange, &
8187 lsort.OR.optio_log(lsort_timerange), lunique, lmiss, remaptr, ltimerange)
8188CALL vol7d_remap1_vol7d_level(this%level, that%level, &
8189 lsort.OR.optio_log(lsort_level), lunique, lmiss, remapl, llevel)
8190CALL vol7d_remap1_vol7d_ana(this%ana, that%ana, &
8191 lsort, lunique, lmiss, remapa, lana)
8192CALL vol7d_remap1_vol7d_network(this%network, that%network, &
8193 lsort, lunique, lmiss, remapn, lnetwork)
8194
8195! lanavari, lanavarb, lanavarc, &
8196! lanaattri, lanaattrb, lanaattrc, &
8197! lanavarattri, lanavarattrb, lanavarattrc, &
8198! ldativari, ldativarb, ldativarc, &
8199! ldatiattri, ldatiattrb, ldatiattrc, &
8200! ldativarattri, ldativarattrb, ldativarattrc
8201! Faccio la riforma fisica dei volumi
8202CALL vol7d_reform_finalr(this, that, &
8203 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8204 lanavarr, lanaattrr, lanavarattrr, ldativarr, ldatiattrr, ldativarattrr)
8205CALL vol7d_reform_finald(this, that, &
8206 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8207 lanavard, lanaattrd, lanavarattrd, ldativard, ldatiattrd, ldativarattrd)
8208CALL vol7d_reform_finali(this, that, &
8209 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8210 lanavari, lanaattri, lanavarattri, ldativari, ldatiattri, ldativarattri)
8211CALL vol7d_reform_finalb(this, that, &
8212 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8213 lanavarb, lanaattrb, lanavarattrb, ldativarb, ldatiattrb, ldativarattrb)
8214CALL vol7d_reform_finalc(this, that, &
8215 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8216 lanavarc, lanaattrc, lanavarattrc, ldativarc, ldatiattrc, ldativarattrc)
8217
8218! Dealloco i vettori di rimappatura
8219IF (ASSOCIATED(remapt)) DEALLOCATE(remapt)
8220IF (ASSOCIATED(remaptr)) DEALLOCATE(remaptr)
8221IF (ASSOCIATED(remapl)) DEALLOCATE(remapl)
8222IF (ASSOCIATED(remapa)) DEALLOCATE(remapa)
8223IF (ASSOCIATED(remapn)) DEALLOCATE(remapn)
8224
8225! Ricreo gli indici var-attr
8226CALL vol7d_set_attr_ind(that)
8227that%time_definition = this%time_definition
8228
8229END SUBROUTINE vol7d_copy
8230
8231
8232!> Metodo per riformare in varie maniere un oggetto vol7d.
8233!! Equivale ad una copia (vedi ::vol7d_copy)
8234!! seguita dalla distruzione del volume iniziale e alla
8235!! sua riassegnazione al volume copiato. Ha senso se almeno uno dei parametri
8236!! \a sort, \a uniq o \a miss è fornito uguale a \c .TRUE., altrimenti
8237!! è solo una perdita di tempo.
8238!! Può essere utile, ad esempio, per eliminare stazioni
8239!! o istanti temporali indesiderati, basta assegnare il loro corrispondente
8240!! elemento del descrittore a valore mancante e chiamare vol7d_reform
8241!! con miss=.TRUE. .
8242SUBROUTINE vol7d_reform(this, sort, unique, miss, &
8243 lsort_time, lsort_timerange, lsort_level, &
8244 ltime, ltimerange, llevel, lana, lnetwork, &
8245 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
8246 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
8247 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
8248 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
8249 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
8250 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc&
8251 ,purgeana)
8252TYPE(vol7d),INTENT(INOUT) :: this !< oggetto da riformare
8253LOGICAL,INTENT(IN),OPTIONAL :: sort !< if present and \a .TRUE., sort all the sortable dimensions
8254LOGICAL,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)
8255LOGICAL,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
8256LOGICAL,INTENT(IN),OPTIONAL :: lsort_time !< if present and \a .TRUE., sort only time dimension (alternative to \a sort )
8257LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange !< if present and \a .TRUE., sort only timerange dimension (alternative to \a sort )
8258LOGICAL,INTENT(IN),OPTIONAL :: lsort_level !< if present and \a .TRUE., sort only level dimension (alternative to \a sort )
8259!> se fornito, deve essere un vettore logico della stessa lunghezza di
8260!! this%time indicante quali elementi della dimensione \a time
8261!! mantenere (valori \c .TRUE.) e quali scartare (valori \c .FALSE.)
8262!! nel volume copiato; in alternativa può essere un vettore di
8263!! lunghezza 1, in tal caso, se \c .FALSE. , equivale a scartare tutti
8264!! gli elementi (utile principalmente per le variabili); è compatibile
8265!! col parametro \a miss
8266LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
8267LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:) !< come il precedente per la dimensione \a timerange
8268LOGICAL,INTENT(IN),OPTIONAL :: llevel(:) !< come il precedente per la dimensione \a level
8269LOGICAL,INTENT(IN),OPTIONAL :: lana(:) !< come il precedente per la dimensione \a ana
8270LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:) !< come il precedente per la dimensione \a network
8271!> come il precedente per tutte le possibili dimensioni variabile
8272LOGICAL,INTENT(in),OPTIONAL :: &
8273 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
8274 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
8275 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
8276 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
8277 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
8278 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
8279LOGICAL,INTENT(IN),OPTIONAL :: purgeana !< if true remove ana with all data missing
8280
8281TYPE(vol7d) :: v7dtmp
8282logical,allocatable :: llana(:)
8283integer :: i
8284
8286 lsort_time, lsort_timerange, lsort_level, &
8287 ltime, ltimerange, llevel, lana, lnetwork, &
8288 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
8289 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
8290 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
8291 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
8292 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
8293 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
8294
8295! destroy old volume
8297
8298if (optio_log(purgeana)) then
8299 allocate(llana(size(v7dtmp%ana)))
8300 llana =.false.
8301 do i =1,size(v7dtmp%ana)
8302 if (associated(v7dtmp%voldatii)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatii(i,:,:,:,:,:)))
8303 if (associated(v7dtmp%voldatir)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatir(i,:,:,:,:,:)))
8304 if (associated(v7dtmp%voldatid)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatid(i,:,:,:,:,:)))
8305 if (associated(v7dtmp%voldatib)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatib(i,:,:,:,:,:)))
8306 if (associated(v7dtmp%voldatic)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatic(i,:,:,:,:,:)))
8307 end do
8308 CALL vol7d_copy(v7dtmp, this,lana=llana)
8310 deallocate(llana)
8311else
8312 this=v7dtmp
8313end if
8314
8315END SUBROUTINE vol7d_reform
8316
8317
8318!> Sorts the sortable dimensions in the volume \a this only when necessary.
8319!! Most of the times, the time, timerange and level dimensions in a
8320!! vol7d object are correctly sorted; on the other side many methods
8321!! strictly rely on this fact in order to work correctly. This method
8322!! performs a quick check and sorts the required dimensions only if
8323!! they are not sorted in ascending order yet, improving safety
8324!! without impairing much performance.
8325SUBROUTINE vol7d_smart_sort(this, lsort_time, lsort_timerange, lsort_level)
8326TYPE(vol7d),INTENT(INOUT) :: this !< object to be sorted
8327LOGICAL,OPTIONAL,INTENT(in) :: lsort_time !< if present and \a .TRUE., sort time dimension if it is not sorted in ascending order
8328LOGICAL,OPTIONAL,INTENT(in) :: lsort_timerange !< if present and \a .TRUE., sort timerange dimension if it is not sorted in ascending order
8329LOGICAL,OPTIONAL,INTENT(in) :: lsort_level !< if present and \a .TRUE., sort vertical level dimension if it is not sorted in ascending order
8330
8331INTEGER :: i
8332LOGICAL :: to_be_sorted
8333
8334to_be_sorted = .false.
8335CALL vol7d_alloc_vol(this) ! usual safety check
8336
8337IF (optio_log(lsort_time)) THEN
8338 DO i = 2, SIZE(this%time)
8339 IF (this%time(i) < this%time(i-1)) THEN
8340 to_be_sorted = .true.
8341 EXIT
8342 ENDIF
8343 ENDDO
8344ENDIF
8345IF (optio_log(lsort_timerange)) THEN
8346 DO i = 2, SIZE(this%timerange)
8347 IF (this%timerange(i) < this%timerange(i-1)) THEN
8348 to_be_sorted = .true.
8349 EXIT
8350 ENDIF
8351 ENDDO
8352ENDIF
8353IF (optio_log(lsort_level)) THEN
8354 DO i = 2, SIZE(this%level)
8355 IF (this%level(i) < this%level(i-1)) THEN
8356 to_be_sorted = .true.
8357 EXIT
8358 ENDIF
8359 ENDDO
8360ENDIF
8361
8362IF (to_be_sorted) CALL vol7d_reform(this, &
8363 lsort_time=lsort_time, lsort_timerange=lsort_timerange, lsort_level=lsort_level )
8364
8365END SUBROUTINE vol7d_smart_sort
8366
8367!> Filter the contents of a volume keeping only desired data.
8368!! This subroutine filters a vol7d object by keeping only a subset of
8369!! the data contained. It can keep only times within a specified
8370!! interval, only station networks contained in a list and only
8371!! specified station or data variables. If a filter parameter is not
8372!! provided, no filtering will take place according to that criterion.
8373!! The volume is reallocated keeping only the desired data.
8374SUBROUTINE vol7d_filter(this, avl, vl, nl, s_d, e_d)
8375TYPE(vol7d),INTENT(inout) :: this !< volume to be filtered
8376CHARACTER(len=*),INTENT(in),OPTIONAL :: avl(:) !< list of station variables to be kept, if not provided or of zero length, all variables are kept
8377CHARACTER(len=*),INTENT(in),OPTIONAL :: vl(:) !< list of data variables to be kept, if not provided or of zero length, all variables are kept
8378TYPE(vol7d_network),OPTIONAL :: nl(:) !< list of station networks to be kept, if not provided or of zero length, all networks are kept
8379TYPE(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
8380TYPE(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
8381
8382INTEGER :: i
8383
8384IF (PRESENT(avl)) THEN
8385 IF (SIZE(avl) > 0) THEN
8386
8387 IF (ASSOCIATED(this%anavar%r)) THEN
8388 DO i = 1, SIZE(this%anavar%r)
8389 IF (all(this%anavar%r(i)%btable /= avl)) this%anavar%r(i) = vol7d_var_miss
8390 ENDDO
8391 ENDIF
8392
8393 IF (ASSOCIATED(this%anavar%i)) THEN
8394 DO i = 1, SIZE(this%anavar%i)
8395 IF (all(this%anavar%i(i)%btable /= avl)) this%anavar%i(i) = vol7d_var_miss
8396 ENDDO
8397 ENDIF
8398
8399 IF (ASSOCIATED(this%anavar%b)) THEN
8400 DO i = 1, SIZE(this%anavar%b)
8401 IF (all(this%anavar%b(i)%btable /= avl)) this%anavar%b(i) = vol7d_var_miss
8402 ENDDO
8403 ENDIF
8404
8405 IF (ASSOCIATED(this%anavar%d)) THEN
8406 DO i = 1, SIZE(this%anavar%d)
8407 IF (all(this%anavar%d(i)%btable /= avl)) this%anavar%d(i) = vol7d_var_miss
8408 ENDDO
8409 ENDIF
8410
8411 IF (ASSOCIATED(this%anavar%c)) THEN
8412 DO i = 1, SIZE(this%anavar%c)
8413 IF (all(this%anavar%c(i)%btable /= avl)) this%anavar%c(i) = vol7d_var_miss
8414 ENDDO
8415 ENDIF
8416
8417 ENDIF
8418ENDIF
8419
8420
8421IF (PRESENT(vl)) THEN
8422 IF (size(vl) > 0) THEN
8423 IF (ASSOCIATED(this%dativar%r)) THEN
8424 DO i = 1, SIZE(this%dativar%r)
8425 IF (all(this%dativar%r(i)%btable /= vl)) this%dativar%r(i) = vol7d_var_miss
8426 ENDDO
8427 ENDIF
8428
8429 IF (ASSOCIATED(this%dativar%i)) THEN
8430 DO i = 1, SIZE(this%dativar%i)
8431 IF (all(this%dativar%i(i)%btable /= vl)) this%dativar%i(i) = vol7d_var_miss
8432 ENDDO
8433 ENDIF
8434
8435 IF (ASSOCIATED(this%dativar%b)) THEN
8436 DO i = 1, SIZE(this%dativar%b)
8437 IF (all(this%dativar%b(i)%btable /= vl)) this%dativar%b(i) = vol7d_var_miss
8438 ENDDO
8439 ENDIF
8440
8441 IF (ASSOCIATED(this%dativar%d)) THEN
8442 DO i = 1, SIZE(this%dativar%d)
8443 IF (all(this%dativar%d(i)%btable /= vl)) this%dativar%d(i) = vol7d_var_miss
8444 ENDDO
8445 ENDIF
8446
8447 IF (ASSOCIATED(this%dativar%c)) THEN
8448 DO i = 1, SIZE(this%dativar%c)
8449 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
8450 ENDDO
8451 ENDIF
8452
8453 IF (ASSOCIATED(this%dativar%c)) THEN
8454 DO i = 1, SIZE(this%dativar%c)
8455 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
8456 ENDDO
8457 ENDIF
8458
8459 ENDIF
8460ENDIF
8461
8462IF (PRESENT(nl)) THEN
8463 IF (SIZE(nl) > 0) THEN
8464 DO i = 1, SIZE(this%network)
8465 IF (all(this%network(i) /= nl)) this%network(i) = vol7d_network_miss
8466 ENDDO
8467 ENDIF
8468ENDIF
8469
8470IF (PRESENT(s_d)) THEN
8472 WHERE (this%time < s_d)
8473 this%time = datetime_miss
8474 END WHERE
8475 ENDIF
8476ENDIF
8477
8478IF (PRESENT(e_d)) THEN
8480 WHERE (this%time > e_d)
8481 this%time = datetime_miss
8482 END WHERE
8483 ENDIF
8484ENDIF
8485
8486CALL vol7d_reform(this, miss=.true.)
8487
8488END SUBROUTINE vol7d_filter
8489
8490
8491!> Metodo per convertire i volumi di dati di un oggetto vol7d in dati
8492!! reali dove possibile. L'oggetto convertito è una copia completa
8493!! dell'originale che può essere quindi distrutto dopo la chiamata.
8494!! Per i dati di anagrafica, al momento sono convertiti solo
8495!! i dati CHARACTER se è passato \a anaconv=.TRUE.
8496!! Gli attributi non sono toccati.
8497SUBROUTINE vol7d_convr(this, that, anaconv)
8498TYPE(vol7d),INTENT(IN) :: this !< oggetto origine
8499TYPE(vol7d),INTENT(INOUT) :: that !< oggetto convertito
8500LOGICAL,OPTIONAL,INTENT(in) :: anaconv !< converti anche anagrafica
8501INTEGER :: i
8502LOGICAL :: fv(1)=(/.false./), tv(1)=(/.true./), acp(1), acn(1)
8503TYPE(vol7d) :: v7d_tmp
8504
8505IF (optio_log(anaconv)) THEN
8506 acp=fv
8507 acn=tv
8508ELSE
8509 acp=tv
8510 acn=fv
8511ENDIF
8512
8513! Volume con solo i dati reali e tutti gli attributi
8514! l'anagrafica e` copiata interamente se necessario
8515CALL vol7d_copy(this, that, &
8516 lanavarr=tv, lanavard=acp, lanavari=acp, lanavarb=acp, lanavarc=acp, &
8517 ldativarr=tv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=fv)
8518
8519! Volume solo di dati double
8520CALL vol7d_copy(this, v7d_tmp, &
8521 lanavarr=fv, lanavard=acn, lanavari=fv, lanavarb=fv, lanavarc=fv, &
8522 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8523 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8524 ldativarr=fv, ldativard=tv, ldativari=fv, ldativarb=fv, ldativarc=fv, &
8525 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8526 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8527
8528! converto a dati reali
8529IF (ASSOCIATED(v7d_tmp%anavar%d) .OR. ASSOCIATED(v7d_tmp%dativar%d)) THEN
8530
8531 IF (ASSOCIATED(v7d_tmp%anavar%d)) THEN
8532! alloco i dati reali e vi trasferisco i double
8533 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanad, 1), SIZE(v7d_tmp%volanad, 2), &
8534 SIZE(v7d_tmp%volanad, 3)))
8535 DO i = 1, SIZE(v7d_tmp%anavar%d)
8536 v7d_tmp%volanar(:,i,:) = &
8537 realdat(v7d_tmp%volanad(:,i,:), v7d_tmp%anavar%d(i))
8538 ENDDO
8539 DEALLOCATE(v7d_tmp%volanad)
8540! trasferisco le variabili
8541 v7d_tmp%anavar%r => v7d_tmp%anavar%d
8542 NULLIFY(v7d_tmp%anavar%d)
8543 ENDIF
8544
8545 IF (ASSOCIATED(v7d_tmp%dativar%d)) THEN
8546! alloco i dati reali e vi trasferisco i double
8547 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatid, 1), SIZE(v7d_tmp%voldatid, 2), &
8548 SIZE(v7d_tmp%voldatid, 3), SIZE(v7d_tmp%voldatid, 4), SIZE(v7d_tmp%voldatid, 5), &
8549 SIZE(v7d_tmp%voldatid, 6)))
8550 DO i = 1, SIZE(v7d_tmp%dativar%d)
8551 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8552 realdat(v7d_tmp%voldatid(:,:,:,:,i,:), v7d_tmp%dativar%d(i))
8553 ENDDO
8554 DEALLOCATE(v7d_tmp%voldatid)
8555! trasferisco le variabili
8556 v7d_tmp%dativar%r => v7d_tmp%dativar%d
8557 NULLIFY(v7d_tmp%dativar%d)
8558 ENDIF
8559
8560! fondo con il volume definitivo
8561 CALL vol7d_merge(that, v7d_tmp)
8562ELSE
8564ENDIF
8565
8566
8567! Volume solo di dati interi
8568CALL vol7d_copy(this, v7d_tmp, &
8569 lanavarr=fv, lanavard=fv, lanavari=acn, lanavarb=fv, lanavarc=fv, &
8570 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8571 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8572 ldativarr=fv, ldativard=fv, ldativari=tv, ldativarb=fv, ldativarc=fv, &
8573 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8574 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8575
8576! converto a dati reali
8577IF (ASSOCIATED(v7d_tmp%anavar%i) .OR. ASSOCIATED(v7d_tmp%dativar%i)) THEN
8578
8579 IF (ASSOCIATED(v7d_tmp%anavar%i)) THEN
8580! alloco i dati reali e vi trasferisco gli interi
8581 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanai, 1), SIZE(v7d_tmp%volanai, 2), &
8582 SIZE(v7d_tmp%volanai, 3)))
8583 DO i = 1, SIZE(v7d_tmp%anavar%i)
8584 v7d_tmp%volanar(:,i,:) = &
8585 realdat(v7d_tmp%volanai(:,i,:), v7d_tmp%anavar%i(i))
8586 ENDDO
8587 DEALLOCATE(v7d_tmp%volanai)
8588! trasferisco le variabili
8589 v7d_tmp%anavar%r => v7d_tmp%anavar%i
8590 NULLIFY(v7d_tmp%anavar%i)
8591 ENDIF
8592
8593 IF (ASSOCIATED(v7d_tmp%dativar%i)) THEN
8594! alloco i dati reali e vi trasferisco gli interi
8595 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatii, 1), SIZE(v7d_tmp%voldatii, 2), &
8596 SIZE(v7d_tmp%voldatii, 3), SIZE(v7d_tmp%voldatii, 4), SIZE(v7d_tmp%voldatii, 5), &
8597 SIZE(v7d_tmp%voldatii, 6)))
8598 DO i = 1, SIZE(v7d_tmp%dativar%i)
8599 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8600 realdat(v7d_tmp%voldatii(:,:,:,:,i,:), v7d_tmp%dativar%i(i))
8601 ENDDO
8602 DEALLOCATE(v7d_tmp%voldatii)
8603! trasferisco le variabili
8604 v7d_tmp%dativar%r => v7d_tmp%dativar%i
8605 NULLIFY(v7d_tmp%dativar%i)
8606 ENDIF
8607
8608! fondo con il volume definitivo
8609 CALL vol7d_merge(that, v7d_tmp)
8610ELSE
8612ENDIF
8613
8614
8615! Volume solo di dati byte
8616CALL vol7d_copy(this, v7d_tmp, &
8617 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=acn, lanavarc=fv, &
8618 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8619 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8620 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=tv, ldativarc=fv, &
8621 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8622 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8623
8624! converto a dati reali
8625IF (ASSOCIATED(v7d_tmp%anavar%b) .OR. ASSOCIATED(v7d_tmp%dativar%b)) THEN
8626
8627 IF (ASSOCIATED(v7d_tmp%anavar%b)) THEN
8628! alloco i dati reali e vi trasferisco i byte
8629 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanab, 1), SIZE(v7d_tmp%volanab, 2), &
8630 SIZE(v7d_tmp%volanab, 3)))
8631 DO i = 1, SIZE(v7d_tmp%anavar%b)
8632 v7d_tmp%volanar(:,i,:) = &
8633 realdat(v7d_tmp%volanab(:,i,:), v7d_tmp%anavar%b(i))
8634 ENDDO
8635 DEALLOCATE(v7d_tmp%volanab)
8636! trasferisco le variabili
8637 v7d_tmp%anavar%r => v7d_tmp%anavar%b
8638 NULLIFY(v7d_tmp%anavar%b)
8639 ENDIF
8640
8641 IF (ASSOCIATED(v7d_tmp%dativar%b)) THEN
8642! alloco i dati reali e vi trasferisco i byte
8643 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatib, 1), SIZE(v7d_tmp%voldatib, 2), &
8644 SIZE(v7d_tmp%voldatib, 3), SIZE(v7d_tmp%voldatib, 4), SIZE(v7d_tmp%voldatib, 5), &
8645 SIZE(v7d_tmp%voldatib, 6)))
8646 DO i = 1, SIZE(v7d_tmp%dativar%b)
8647 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8648 realdat(v7d_tmp%voldatib(:,:,:,:,i,:), v7d_tmp%dativar%b(i))
8649 ENDDO
8650 DEALLOCATE(v7d_tmp%voldatib)
8651! trasferisco le variabili
8652 v7d_tmp%dativar%r => v7d_tmp%dativar%b
8653 NULLIFY(v7d_tmp%dativar%b)
8654 ENDIF
8655
8656! fondo con il volume definitivo
8657 CALL vol7d_merge(that, v7d_tmp)
8658ELSE
8660ENDIF
8661
8662
8663! Volume solo di dati character
8664CALL vol7d_copy(this, v7d_tmp, &
8665 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=fv, lanavarc=acn, &
8666 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8667 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8668 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=tv, &
8669 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8670 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8671
8672! converto a dati reali
8673IF (ASSOCIATED(v7d_tmp%anavar%c) .OR. ASSOCIATED(v7d_tmp%dativar%c)) THEN
8674
8675 IF (ASSOCIATED(v7d_tmp%anavar%c)) THEN
8676! alloco i dati reali e vi trasferisco i character
8677 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanac, 1), SIZE(v7d_tmp%volanac, 2), &
8678 SIZE(v7d_tmp%volanac, 3)))
8679 DO i = 1, SIZE(v7d_tmp%anavar%c)
8680 v7d_tmp%volanar(:,i,:) = &
8681 realdat(v7d_tmp%volanac(:,i,:), v7d_tmp%anavar%c(i))
8682 ENDDO
8683 DEALLOCATE(v7d_tmp%volanac)
8684! trasferisco le variabili
8685 v7d_tmp%anavar%r => v7d_tmp%anavar%c
8686 NULLIFY(v7d_tmp%anavar%c)
8687 ENDIF
8688
8689 IF (ASSOCIATED(v7d_tmp%dativar%c)) THEN
8690! alloco i dati reali e vi trasferisco i character
8691 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatic, 1), SIZE(v7d_tmp%voldatic, 2), &
8692 SIZE(v7d_tmp%voldatic, 3), SIZE(v7d_tmp%voldatic, 4), SIZE(v7d_tmp%voldatic, 5), &
8693 SIZE(v7d_tmp%voldatic, 6)))
8694 DO i = 1, SIZE(v7d_tmp%dativar%c)
8695 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8696 realdat(v7d_tmp%voldatic(:,:,:,:,i,:), v7d_tmp%dativar%c(i))
8697 ENDDO
8698 DEALLOCATE(v7d_tmp%voldatic)
8699! trasferisco le variabili
8700 v7d_tmp%dativar%r => v7d_tmp%dativar%c
8701 NULLIFY(v7d_tmp%dativar%c)
8702 ENDIF
8703
8704! fondo con il volume definitivo
8705 CALL vol7d_merge(that, v7d_tmp)
8706ELSE
8708ENDIF
8709
8710END SUBROUTINE vol7d_convr
8711
8712
8713!> Metodo per ottenere solo le differenze tra due oggetti vol7d.
8714!! Il primo volume viene confrontato col secondo; nel secondo volume ovunque
8715!! i dati confrontati siano coincidenti viene impostato valore mancante.
8716SUBROUTINE vol7d_diff_only (this, that, data_only,ana)
8717TYPE(vol7d),INTENT(IN) :: this !< primo volume da confrontare
8718TYPE(vol7d),INTENT(OUT) :: that !< secondo volume da confrontare in cui eliminare i dati coincidenti
8719logical , optional, intent(in) :: data_only !< attiva l'elaborazione dei soli dati e non dell'anagrafica (default: .false.)
8720logical , optional, intent(in) :: ana !< attiva l'elaborazione dell'anagrafica (coordinate e ident) (default: .false.)
8721logical :: ldata_only,lana
8722
8723IF (PRESENT(data_only)) THEN
8724 ldata_only = data_only
8725ELSE
8726 ldata_only = .false.
8727ENDIF
8728
8729IF (PRESENT(ana)) THEN
8730 lana = ana
8731ELSE
8732 lana = .false.
8733ENDIF
8734
8735
8736#undef VOL7D_POLY_ARRAY
8737#define VOL7D_POLY_ARRAY voldati
8738#include "vol7d_class_diff.F90"
8739#undef VOL7D_POLY_ARRAY
8740#define VOL7D_POLY_ARRAY voldatiattr
8741#include "vol7d_class_diff.F90"
8742#undef VOL7D_POLY_ARRAY
8743
8744if ( .not. ldata_only) then
8745
8746#define VOL7D_POLY_ARRAY volana
8747#include "vol7d_class_diff.F90"
8748#undef VOL7D_POLY_ARRAY
8749#define VOL7D_POLY_ARRAY volanaattr
8750#include "vol7d_class_diff.F90"
8751#undef VOL7D_POLY_ARRAY
8752
8753 if(lana)then
8754 where ( this%ana == that%ana )
8755 that%ana = vol7d_ana_miss
8756 end where
8757 end if
8758
8759end if
8760
8761
8762
8763END SUBROUTINE vol7d_diff_only
8764
8765
8766
8767! Creo le routine da ripetere per i vari tipi di dati di v7d
8768! tramite un template e il preprocessore
8769#undef VOL7D_POLY_TYPE
8770#undef VOL7D_POLY_TYPES
8771#define VOL7D_POLY_TYPE REAL
8772#define VOL7D_POLY_TYPES r
8773#include "vol7d_class_type_templ.F90"
8774#undef VOL7D_POLY_TYPE
8775#undef VOL7D_POLY_TYPES
8776#define VOL7D_POLY_TYPE DOUBLE PRECISION
8777#define VOL7D_POLY_TYPES d
8778#include "vol7d_class_type_templ.F90"
8779#undef VOL7D_POLY_TYPE
8780#undef VOL7D_POLY_TYPES
8781#define VOL7D_POLY_TYPE INTEGER
8782#define VOL7D_POLY_TYPES i
8783#include "vol7d_class_type_templ.F90"
8784#undef VOL7D_POLY_TYPE
8785#undef VOL7D_POLY_TYPES
8786#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
8787#define VOL7D_POLY_TYPES b
8788#include "vol7d_class_type_templ.F90"
8789#undef VOL7D_POLY_TYPE
8790#undef VOL7D_POLY_TYPES
8791#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
8792#define VOL7D_POLY_TYPES c
8793#include "vol7d_class_type_templ.F90"
8794
8795! Creo le routine da ripetere per i vari descrittori di dimensioni di v7d
8796! tramite un template e il preprocessore
8797#define VOL7D_SORT
8798#undef VOL7D_NO_ZERO_ALLOC
8799#undef VOL7D_POLY_TYPE
8800#define VOL7D_POLY_TYPE datetime
8801#include "vol7d_class_desc_templ.F90"
8802#undef VOL7D_POLY_TYPE
8803#define VOL7D_POLY_TYPE vol7d_timerange
8804#include "vol7d_class_desc_templ.F90"
8805#undef VOL7D_POLY_TYPE
8806#define VOL7D_POLY_TYPE vol7d_level
8807#include "vol7d_class_desc_templ.F90"
8808#undef VOL7D_SORT
8809#undef VOL7D_POLY_TYPE
8810#define VOL7D_POLY_TYPE vol7d_network
8811#include "vol7d_class_desc_templ.F90"
8812#undef VOL7D_POLY_TYPE
8813#define VOL7D_POLY_TYPE vol7d_ana
8814#include "vol7d_class_desc_templ.F90"
8815#define VOL7D_NO_ZERO_ALLOC
8816#undef VOL7D_POLY_TYPE
8817#define VOL7D_POLY_TYPE vol7d_var
8818#include "vol7d_class_desc_templ.F90"
8819
8820!>\brief Scrittura su file di un volume Vol7d.
8821!! Scrittura su file unformatted di un intero volume Vol7d.
8822!! Il volume viene serializzato e scritto su file.
8823!! Il file puo' essere aperto opzionalmente dall'utente. Si possono passare
8824!! opzionalmente unità e nome del file altrimenti assegnati internamente a dei default; se assegnati internamente
8825!! tali parametri saranno in output.
8826!! Se non viene fornito il nome file viene utilizzato un file di default con nome pari al nome del programma in
8827!! esecuzione con postfisso ".v7d".
8828!! Come parametro opzionale c'è la description che insieme alla data corrente viene inserita nell'header del file.
8829subroutine vol7d_write_on_file (this,unit,description,filename,filename_auto)
8830
8831TYPE(vol7d),INTENT(IN) :: this !< volume vol7d da scrivere
8832integer,optional,intent(inout) :: unit !< unità su cui scrivere; se passata =0 ritorna il valore rielaborato (default =rielaborato internamente con getlun )
8833character(len=*),intent(in),optional :: filename !< nome del file su cui scrivere
8834character(len=*),intent(out),optional :: filename_auto !< nome del file generato se "filename" è omesso
8835character(len=*),INTENT(IN),optional :: description !< descrizione del volume
8836
8837integer :: lunit
8838character(len=254) :: ldescription,arg,lfilename
8839integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
8840 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
8841 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
8842 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
8843 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
8844 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
8845 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
8846!integer :: im,id,iy
8847integer :: tarray(8)
8848logical :: opened,exist
8849
8850 nana=0
8851 ntime=0
8852 ntimerange=0
8853 nlevel=0
8854 nnetwork=0
8855 ndativarr=0
8856 ndativari=0
8857 ndativarb=0
8858 ndativard=0
8859 ndativarc=0
8860 ndatiattrr=0
8861 ndatiattri=0
8862 ndatiattrb=0
8863 ndatiattrd=0
8864 ndatiattrc=0
8865 ndativarattrr=0
8866 ndativarattri=0
8867 ndativarattrb=0
8868 ndativarattrd=0
8869 ndativarattrc=0
8870 nanavarr=0
8871 nanavari=0
8872 nanavarb=0
8873 nanavard=0
8874 nanavarc=0
8875 nanaattrr=0
8876 nanaattri=0
8877 nanaattrb=0
8878 nanaattrd=0
8879 nanaattrc=0
8880 nanavarattrr=0
8881 nanavarattri=0
8882 nanavarattrb=0
8883 nanavarattrd=0
8884 nanavarattrc=0
8885
8886
8887!call idate(im,id,iy)
8888call date_and_time(values=tarray)
8889call getarg(0,arg)
8890
8891if (present(description))then
8892 ldescription=description
8893else
8894 ldescription="Vol7d generated by: "//trim(arg)
8895end if
8896
8897if (.not. present(unit))then
8898 lunit=getunit()
8899else
8900 if (unit==0)then
8901 lunit=getunit()
8902 unit=lunit
8903 else
8904 lunit=unit
8905 end if
8906end if
8907
8908lfilename=trim(arg)//".v7d"
8910
8911if (present(filename))then
8912 if (filename /= "")then
8913 lfilename=filename
8914 end if
8915end if
8916
8917if (present(filename_auto))filename_auto=lfilename
8918
8919
8920inquire(unit=lunit,opened=opened)
8921if (.not. opened) then
8922! inquire(file=lfilename, EXIST=exist)
8923! IF (exist) THEN
8924! CALL l4f_log(L4F_FATAL, &
8925! 'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename))
8926! CALL raise_fatal_error()
8927! ENDIF
8928 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM')
8929 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
8930end if
8931
8932if (associated(this%ana)) nana=size(this%ana)
8933if (associated(this%time)) ntime=size(this%time)
8934if (associated(this%timerange)) ntimerange=size(this%timerange)
8935if (associated(this%level)) nlevel=size(this%level)
8936if (associated(this%network)) nnetwork=size(this%network)
8937
8938if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
8939if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
8940if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
8941if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
8942if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
8943
8944if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
8945if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
8946if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
8947if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
8948if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)
8949
8950if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
8951if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
8952if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
8953if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
8954if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
8955
8956if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
8957if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
8958if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
8959if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
8960if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
8961
8962if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
8963if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
8964if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
8965if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
8966if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)
8967
8968if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
8969if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
8970if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
8971if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
8972if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)
8973
8974write(unit=lunit)ldescription
8975write(unit=lunit)tarray
8976
8977write(unit=lunit)&
8978 nana, ntime, ntimerange, nlevel, nnetwork, &
8979 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
8980 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
8981 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
8982 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
8983 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
8984 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
8985 this%time_definition
8986
8987
8988!write(unit=lunit)this
8989
8990
8991!! prime 5 dimensioni
8994if (associated(this%level)) write(unit=lunit)this%level
8995if (associated(this%timerange)) write(unit=lunit)this%timerange
8996if (associated(this%network)) write(unit=lunit)this%network
8997
8998 !! 6a dimensione: variabile dell'anagrafica e dei dati
8999 !! con relativi attributi e in 5 tipi diversi
9000
9001if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r
9002if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i
9003if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b
9004if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d
9005if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c
9006
9007if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r
9008if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i
9009if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b
9010if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d
9011if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c
9012
9013if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r
9014if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i
9015if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b
9016if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d
9017if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c
9018
9019if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r
9020if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i
9021if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b
9022if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d
9023if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c
9024
9025if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r
9026if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i
9027if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b
9028if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d
9029if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c
9030
9031if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
9032if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
9033if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
9034if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
9035if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c
9036
9037!! Volumi di valori e attributi per anagrafica e dati
9038
9039if (associated(this%volanar)) write(unit=lunit)this%volanar
9040if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr
9041if (associated(this%voldatir)) write(unit=lunit)this%voldatir
9042if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr
9043
9044if (associated(this%volanai)) write(unit=lunit)this%volanai
9045if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri
9046if (associated(this%voldatii)) write(unit=lunit)this%voldatii
9047if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri
9048
9049if (associated(this%volanab)) write(unit=lunit)this%volanab
9050if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb
9051if (associated(this%voldatib)) write(unit=lunit)this%voldatib
9052if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb
9053
9054if (associated(this%volanad)) write(unit=lunit)this%volanad
9055if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd
9056if (associated(this%voldatid)) write(unit=lunit)this%voldatid
9057if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd
9058
9059if (associated(this%volanac)) write(unit=lunit)this%volanac
9060if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc
9061if (associated(this%voldatic)) write(unit=lunit)this%voldatic
9062if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc
9063
9064if (.not. present(unit)) close(unit=lunit)
9065
9066end subroutine vol7d_write_on_file
9067
9068
9069!>\brief Lettura da file di un volume Vol7d.
9070!! Lettura da file unformatted di un intero volume Vol7d.
9071!! Questa subroutine comprende vol7d_alloc e vol7d_alloc_vol.
9072!! Il file puo' essere aperto opzionalmente dall'utente. Si possono passare
9073!! opzionalmente unità e nome del file altrimenti assegnati internamente a dei default; se assegnati internamente
9074!! tali parametri saranno in output.
9075
9076
9077subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
9078
9079TYPE(vol7d),INTENT(OUT) :: this !< Volume vol7d da leggere
9080integer,intent(inout),optional :: unit !< unità su cui è stato aperto un file; se =0 rielaborato internamente (default = elaborato internamente con getunit)
9081character(len=*),INTENT(in),optional :: filename !< nome del file eventualmente da aprire (default = (nome dell'eseguibile)//.v7d )
9082character(len=*),intent(out),optional :: filename_auto !< nome del file generato se "filename" è omesso
9083character(len=*),INTENT(out),optional :: description !< descrizione del volume letto
9084integer,intent(out),optional :: tarray(8) !< vettore come definito da "date_and_time" della data di scrittura del volume
9085
9086
9087integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
9088 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
9089 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
9090 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
9091 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
9092 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
9093 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
9094
9095character(len=254) :: ldescription,lfilename,arg
9096integer :: ltarray(8),lunit,ios
9097logical :: opened,exist
9098
9099
9100call getarg(0,arg)
9101
9102if (.not. present(unit))then
9103 lunit=getunit()
9104else
9105 if (unit==0)then
9106 lunit=getunit()
9107 unit=lunit
9108 else
9109 lunit=unit
9110 end if
9111end if
9112
9113lfilename=trim(arg)//".v7d"
9115
9116if (present(filename))then
9117 if (filename /= "")then
9118 lfilename=filename
9119 end if
9120end if
9121
9122if (present(filename_auto))filename_auto=lfilename
9123
9124
9125inquire(unit=lunit,opened=opened)
9126IF (.NOT. opened) THEN
9127 inquire(file=lfilename,exist=exist)
9128 IF (.NOT.exist) THEN
9129 CALL l4f_log(l4f_fatal, &
9130 'in vol7d_read_from_file, file does not exists, cannot open')
9131 CALL raise_fatal_error()
9132 ENDIF
9133 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM', &
9134 status='OLD', action='READ')
9135 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
9136end if
9137
9138
9140read(unit=lunit,iostat=ios)ldescription
9141
9142if (ios < 0) then ! A negative value indicates that the End of File or End of Record
9143 call vol7d_alloc (this)
9144 call vol7d_alloc_vol (this)
9145 if (present(description))description=ldescription
9146 if (present(tarray))tarray=ltarray
9147 if (.not. present(unit)) close(unit=lunit)
9148end if
9149
9150read(unit=lunit)ltarray
9151
9152CALL l4f_log(l4f_info, 'Reading vol7d from file')
9153CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
9156
9157if (present(description))description=ldescription
9158if (present(tarray))tarray=ltarray
9159
9160read(unit=lunit)&
9161 nana, ntime, ntimerange, nlevel, nnetwork, &
9162 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
9163 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
9164 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
9165 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
9166 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
9167 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
9168 this%time_definition
9169
9170call vol7d_alloc (this, &
9171 nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,&
9172 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,&
9173 ndativard=ndativard, ndativarc=ndativarc,&
9174 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,&
9175 ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
9176 ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, &
9177 ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,&
9178 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, &
9179 nanavard=nanavard, nanavarc=nanavarc,&
9180 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,&
9181 nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
9182 nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, &
9183 nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc)
9184
9185
9188if (associated(this%level)) read(unit=lunit)this%level
9189if (associated(this%timerange)) read(unit=lunit)this%timerange
9190if (associated(this%network)) read(unit=lunit)this%network
9191
9192if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r
9193if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i
9194if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b
9195if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d
9196if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c
9197
9198if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r
9199if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i
9200if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b
9201if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d
9202if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c
9203
9204if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r
9205if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i
9206if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b
9207if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d
9208if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c
9209
9210if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r
9211if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i
9212if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b
9213if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d
9214if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c
9215
9216if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r
9217if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i
9218if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b
9219if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d
9220if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c
9221
9222if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
9223if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
9224if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
9225if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
9226if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c
9227
9228call vol7d_alloc_vol (this)
9229
9230!! Volumi di valori e attributi per anagrafica e dati
9231
9232if (associated(this%volanar)) read(unit=lunit)this%volanar
9233if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr
9234if (associated(this%voldatir)) read(unit=lunit)this%voldatir
9235if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr
9236
9237if (associated(this%volanai)) read(unit=lunit)this%volanai
9238if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri
9239if (associated(this%voldatii)) read(unit=lunit)this%voldatii
9240if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri
9241
9242if (associated(this%volanab)) read(unit=lunit)this%volanab
9243if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb
9244if (associated(this%voldatib)) read(unit=lunit)this%voldatib
9245if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb
9246
9247if (associated(this%volanad)) read(unit=lunit)this%volanad
9248if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd
9249if (associated(this%voldatid)) read(unit=lunit)this%voldatid
9250if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd
9251
9252if (associated(this%volanac)) read(unit=lunit)this%volanac
9253if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc
9254if (associated(this%voldatic)) read(unit=lunit)this%voldatic
9255if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc
9256
9257if (.not. present(unit)) close(unit=lunit)
9258
9259end subroutine vol7d_read_from_file
9260
9261
9262! to double precision
9263elemental doubleprecision function doubledatd(voldat,var)
9264doubleprecision,intent(in) :: voldat
9265type(vol7d_var),intent(in) :: var
9266
9267doubledatd=voldat
9268
9269end function doubledatd
9270
9271
9272elemental doubleprecision function doubledatr(voldat,var)
9273real,intent(in) :: voldat
9274type(vol7d_var),intent(in) :: var
9275
9277 doubledatr=dble(voldat)
9278else
9279 doubledatr=dmiss
9280end if
9281
9282end function doubledatr
9283
9284
9285elemental doubleprecision function doubledati(voldat,var)
9286integer,intent(in) :: voldat
9287type(vol7d_var),intent(in) :: var
9288
9291 doubledati=dble(voldat)/10.d0**var%scalefactor
9292 else
9293 doubledati=dble(voldat)
9294 endif
9295else
9296 doubledati=dmiss
9297end if
9298
9299end function doubledati
9300
9301
9302elemental doubleprecision function doubledatb(voldat,var)
9303integer(kind=int_b),intent(in) :: voldat
9304type(vol7d_var),intent(in) :: var
9305
9308 doubledatb=dble(voldat)/10.d0**var%scalefactor
9309 else
9310 doubledatb=dble(voldat)
9311 endif
9312else
9313 doubledatb=dmiss
9314end if
9315
9316end function doubledatb
9317
9318
9319elemental doubleprecision function doubledatc(voldat,var)
9320CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
9321type(vol7d_var),intent(in) :: var
9322
9323doubledatc = c2d(voldat)
9325 doubledatc=doubledatc/10.d0**var%scalefactor
9326end if
9327
9328end function doubledatc
9329
9330
9331! to integer
9332elemental integer function integerdatd(voldat,var)
9333doubleprecision,intent(in) :: voldat
9334type(vol7d_var),intent(in) :: var
9335
9338 integerdatd=nint(voldat*10d0**var%scalefactor)
9339 else
9340 integerdatd=nint(voldat)
9341 endif
9342else
9343 integerdatd=imiss
9344end if
9345
9346end function integerdatd
9347
9348
9349elemental integer function integerdatr(voldat,var)
9350real,intent(in) :: voldat
9351type(vol7d_var),intent(in) :: var
9352
9355 integerdatr=nint(voldat*10d0**var%scalefactor)
9356 else
9357 integerdatr=nint(voldat)
9358 endif
9359else
9360 integerdatr=imiss
9361end if
9362
9363end function integerdatr
9364
9365
9366elemental integer function integerdati(voldat,var)
9367integer,intent(in) :: voldat
9368type(vol7d_var),intent(in) :: var
9369
9370integerdati=voldat
9371
9372end function integerdati
9373
9374
9375elemental integer function integerdatb(voldat,var)
9376integer(kind=int_b),intent(in) :: voldat
9377type(vol7d_var),intent(in) :: var
9378
9380 integerdatb=voldat
9381else
9382 integerdatb=imiss
9383end if
9384
9385end function integerdatb
9386
9387
9388elemental integer function integerdatc(voldat,var)
9389CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
9390type(vol7d_var),intent(in) :: var
9391
9392integerdatc=c2i(voldat)
9393
9394end function integerdatc
9395
9396
9397! to real
9398elemental real function realdatd(voldat,var)
9399doubleprecision,intent(in) :: voldat
9400type(vol7d_var),intent(in) :: var
9401
9403 realdatd=real(voldat)
9404else
9405 realdatd=rmiss
9406end if
9407
9408end function realdatd
9409
9410
9411elemental real function realdatr(voldat,var)
9412real,intent(in) :: voldat
9413type(vol7d_var),intent(in) :: var
9414
9415realdatr=voldat
9416
9417end function realdatr
9418
9419
9420elemental real function realdati(voldat,var)
9421integer,intent(in) :: voldat
9422type(vol7d_var),intent(in) :: var
9423
9426 realdati=float(voldat)/10.**var%scalefactor
9427 else
9428 realdati=float(voldat)
9429 endif
9430else
9431 realdati=rmiss
9432end if
9433
9434end function realdati
9435
9436
9437elemental real function realdatb(voldat,var)
9438integer(kind=int_b),intent(in) :: voldat
9439type(vol7d_var),intent(in) :: var
9440
9443 realdatb=float(voldat)/10**var%scalefactor
9444 else
9445 realdatb=float(voldat)
9446 endif
9447else
9448 realdatb=rmiss
9449end if
9450
9451end function realdatb
9452
9453
9454elemental real function realdatc(voldat,var)
9455CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
9456type(vol7d_var),intent(in) :: var
9457
9458realdatc=c2r(voldat)
9460 realdatc=realdatc/10.**var%scalefactor
9461end if
9462
9463end function realdatc
9464
9465
9466!> Return an ana volume of a requested variable as real data.
9467!! It returns a 2-d array of the proper shape (ana x network) for the
9468!! ana variable requested, converted to real type. If the conversion
9469!! fails or if the variable is not contained in the ana volume,
9470!! missing data are returned.
9471FUNCTION realanavol(this, var) RESULT(vol)
9472TYPE(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
9473TYPE(vol7d_var),INTENT(in) :: var !< the ana variable to be returned
9474REAL :: vol(SIZE(this%ana),size(this%network))
9475
9476CHARACTER(len=1) :: dtype
9477INTEGER :: indvar
9478
9479dtype = cmiss
9480indvar = index(this%anavar, var, type=dtype)
9481
9482IF (indvar > 0) THEN
9483 SELECT CASE (dtype)
9484 CASE("d")
9485 vol = realdat(this%volanad(:,indvar,:), var)
9486 CASE("r")
9487 vol = this%volanar(:,indvar,:)
9488 CASE("i")
9489 vol = realdat(this%volanai(:,indvar,:), var)
9490 CASE("b")
9491 vol = realdat(this%volanab(:,indvar,:), var)
9492 CASE("c")
9493 vol = realdat(this%volanac(:,indvar,:), var)
9494 CASE default
9495 vol = rmiss
9496 END SELECT
9497ELSE
9498 vol = rmiss
9499ENDIF
9500
9501END FUNCTION realanavol
9502
9503
9504!> Return an ana volume of a requested variable as integer data.
9505!! It returns a 2-d array of the proper shape (ana x network) for the
9506!! ana variable requested, converted to integer type. If the conversion
9507!! fails or if the variable is not contained in the ana volume,
9508!! missing data are returned.
9509FUNCTION integeranavol(this, var) RESULT(vol)
9510TYPE(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
9511TYPE(vol7d_var),INTENT(in) :: var !< the ana variable to be returned
9512INTEGER :: vol(SIZE(this%ana),size(this%network))
9513
9514CHARACTER(len=1) :: dtype
9515INTEGER :: indvar
9516
9517dtype = cmiss
9518indvar = index(this%anavar, var, type=dtype)
9519
9520IF (indvar > 0) THEN
9521 SELECT CASE (dtype)
9522 CASE("d")
9523 vol = integerdat(this%volanad(:,indvar,:), var)
9524 CASE("r")
9525 vol = integerdat(this%volanar(:,indvar,:), var)
9526 CASE("i")
9527 vol = this%volanai(:,indvar,:)
9528 CASE("b")
9529 vol = integerdat(this%volanab(:,indvar,:), var)
9530 CASE("c")
9531 vol = integerdat(this%volanac(:,indvar,:), var)
9532 CASE default
9533 vol = imiss
9534 END SELECT
9535ELSE
9536 vol = imiss
9537ENDIF
9538
9539END FUNCTION integeranavol
9540
9541
9542!> Move data for all variables from one coordinate in the character volume to other.
9543!! Only not missing data will be copyed and all attributes will be moved together.
9544!! Usefull to colapse data spread in more indices (level or time or ....).
9545!! After the move is possible to set to missing some descriptor and make a copy with miss=.true.
9546!! to obtain a new vol7d with less data shape.
9547subroutine move_datac (v7d,&
9548 indana,indtime,indlevel,indtimerange,indnetwork,&
9549 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
9550
9551TYPE(vol7d),intent(inout) :: v7d !< data in form of character in this object will be moved
9552
9553integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork !< source coordinate of the data
9554integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew !< destination coordinate of data
9555integer :: inddativar,inddativarattr
9556
9557
9558do inddativar=1,size(v7d%dativar%c)
9559
9561 .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
9562 ) then
9563
9564 ! dati
9565 v7d%voldatic &
9566 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
9567 v7d%voldatic &
9568 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
9569
9570
9571 ! attributi
9572 if (associated (v7d%dativarattr%i)) then
9573 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
9574 if (inddativarattr > 0 ) then
9575 v7d%voldatiattri &
9576 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9577 v7d%voldatiattri &
9578 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9579 end if
9580 end if
9581
9582 if (associated (v7d%dativarattr%r)) then
9583 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
9584 if (inddativarattr > 0 ) then
9585 v7d%voldatiattrr &
9586 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9587 v7d%voldatiattrr &
9588 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9589 end if
9590 end if
9591
9592 if (associated (v7d%dativarattr%d)) then
9593 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
9594 if (inddativarattr > 0 ) then
9595 v7d%voldatiattrd &
9596 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9597 v7d%voldatiattrd &
9598 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9599 end if
9600 end if
9601
9602 if (associated (v7d%dativarattr%b)) then
9603 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
9604 if (inddativarattr > 0 ) then
9605 v7d%voldatiattrb &
9606 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9607 v7d%voldatiattrb &
9608 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9609 end if
9610 end if
9611
9612 if (associated (v7d%dativarattr%c)) then
9613 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
9614 if (inddativarattr > 0 ) then
9615 v7d%voldatiattrc &
9616 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9617 v7d%voldatiattrc &
9618 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9619 end if
9620 end if
9621
9622 end if
9623
9624end do
9625
9626end subroutine move_datac
9627
9628!> Move data for all variables from one coordinate in the real volume to other.
9629!! Only not missing data will be copyed and all attributes will be moved together.
9630!! Usefull to colapse data spread in more indices (level or time or ....).
9631!! After the move is possible to set to missing some descriptor and make a copy with miss=.true.
9632!! to obtain a new vol7d with less data shape.
9633subroutine move_datar (v7d,&
9634 indana,indtime,indlevel,indtimerange,indnetwork,&
9635 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
9636
9637TYPE(vol7d),intent(inout) :: v7d !< data in form of character in this object will be moved
9638
9639integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork !< source coordinate of the data
9640integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew !< destination coordinate of data
9641integer :: inddativar,inddativarattr
9642
9643
9644do inddativar=1,size(v7d%dativar%r)
9645
9647 .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
9648 ) then
9649
9650 ! dati
9651 v7d%voldatir &
9652 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
9653 v7d%voldatir &
9654 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
9655
9656
9657 ! attributi
9658 if (associated (v7d%dativarattr%i)) then
9659 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
9660 if (inddativarattr > 0 ) then
9661 v7d%voldatiattri &
9662 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9663 v7d%voldatiattri &
9664 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9665 end if
9666 end if
9667
9668 if (associated (v7d%dativarattr%r)) then
9669 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%r(inddativar))
9670 if (inddativarattr > 0 ) then
9671 v7d%voldatiattrr &
9672 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9673 v7d%voldatiattrr &
9674 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9675 end if
9676 end if
9677
9678 if (associated (v7d%dativarattr%d)) then
9679 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%r(inddativar))
9680 if (inddativarattr > 0 ) then
9681 v7d%voldatiattrd &
9682 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9683 v7d%voldatiattrd &
9684 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9685 end if
9686 end if
9687
9688 if (associated (v7d%dativarattr%b)) then
9689 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%r(inddativar))
9690 if (inddativarattr > 0 ) then
9691 v7d%voldatiattrb &
9692 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9693 v7d%voldatiattrb &
9694 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9695 end if
9696 end if
9697
9698 if (associated (v7d%dativarattr%c)) then
9699 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%r(inddativar))
9700 if (inddativarattr > 0 ) then
9701 v7d%voldatiattrc &
9702 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9703 v7d%voldatiattrc &
9704 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9705 end if
9706 end if
9707
9708 end if
9709
9710end do
9711
9712end subroutine move_datar
9713
9714
9715!> Reduce some dimensions (level and timerage) for semplification (rounding).
9716!! You can use this for simplify and use variables in computation like alchimia
9717!! where fields have to be on the same coordinate
9718!! It return real or character data only: if input is charcter data only it return character otherwise il return
9719!! all the data converted to real.
9720!! examples:
9721!! means in time for short periods and istantaneous values
9722!! 2 meter and surface levels
9723!! If there are data on more then one almost equal levels or timeranges, the first var present (at least one point)
9724!! will be taken (order is by icreasing var index).
9725!! You can use predefined values for classic semplification
9726!! almost_equal_levels and almost_equal_timeranges
9727!! The level or timerange in output will be defined by the first element of level and timerange list
9728subroutine v7d_rounding(v7din,v7dout,level,timerange,nostatproc)
9729type(vol7d),intent(inout) :: v7din !< input volume
9730type(vol7d),intent(out) :: v7dout !> output volume
9731type(vol7d_level),intent(in),optional :: level(:) !< almost equal level list
9732type(vol7d_timerange),intent(in),optional :: timerange(:) !< almost equal timerange list
9733!logical,intent(in),optional :: merge !< if there are data on more then one almost equal levels or timeranges
9734!! will be merged POINT BY POINT with priority for the fird data found ordered by icreasing var index
9735logical,intent(in),optional :: nostatproc !< do not take in account statistical processing code in timerange and P2
9736
9737integer :: nana,nlevel,ntime,ntimerange,nnetwork,nbin
9738integer :: iana,ilevel,itimerange,indl,indt,itime,inetwork
9739type(vol7d_level) :: roundlevel(size(v7din%level))
9740type(vol7d_timerange) :: roundtimerange(size(v7din%timerange))
9741type(vol7d) :: v7d_tmp
9742
9743
9744nbin=0
9745
9746if (associated(v7din%dativar%r)) nbin = nbin + size(v7din%dativar%r)
9747if (associated(v7din%dativar%i)) nbin = nbin + size(v7din%dativar%i)
9748if (associated(v7din%dativar%d)) nbin = nbin + size(v7din%dativar%d)
9749if (associated(v7din%dativar%b)) nbin = nbin + size(v7din%dativar%b)
9750
9752
9753roundlevel=v7din%level
9754
9755if (present(level))then
9756 do ilevel = 1, size(v7din%level)
9757 if ((any(v7din%level(ilevel) .almosteq. level))) then
9758 roundlevel(ilevel)=level(1)
9759 end if
9760 end do
9761end if
9762
9763roundtimerange=v7din%timerange
9764
9765if (present(timerange))then
9766 do itimerange = 1, size(v7din%timerange)
9767 if ((any(v7din%timerange(itimerange) .almosteq. timerange))) then
9768 roundtimerange(itimerange)=timerange(1)
9769 end if
9770 end do
9771end if
9772
9773!set istantaneous values everywere
9774!preserve p1 for forecast time
9775if (optio_log(nostatproc)) then
9776 roundtimerange(:)%timerange=254
9777 roundtimerange(:)%p2=0
9778end if
9779
9780
9781nana=size(v7din%ana)
9782nlevel=count_distinct(roundlevel,back=.true.)
9783ntime=size(v7din%time)
9784ntimerange=count_distinct(roundtimerange,back=.true.)
9785nnetwork=size(v7din%network)
9786
9788
9789if (nbin == 0) then
9791else
9792 call vol7d_convr(v7din,v7d_tmp)
9793end if
9794
9795v7d_tmp%level=roundlevel
9796v7d_tmp%timerange=roundtimerange
9797
9798do ilevel=1, size(v7d_tmp%level)
9799 indl=index(v7d_tmp%level,roundlevel(ilevel))
9800 do itimerange=1,size(v7d_tmp%timerange)
9801 indt=index(v7d_tmp%timerange,roundtimerange(itimerange))
9802
9803 if (indl /= ilevel .or. indt /= itimerange) then
9804
9805 do iana=1, nana
9806 do itime=1,ntime
9807 do inetwork=1,nnetwork
9808
9809 if (nbin > 0) then
9810 call move_datar (v7d_tmp,&
9811 iana,itime,ilevel,itimerange,inetwork,&
9812 iana,itime,indl,indt,inetwork)
9813 else
9814 call move_datac (v7d_tmp,&
9815 iana,itime,ilevel,itimerange,inetwork,&
9816 iana,itime,indl,indt,inetwork)
9817 end if
9818
9819 end do
9820 end do
9821 end do
9822
9823 end if
9824
9825 end do
9826end do
9827
9828! set to missing level and time > nlevel
9829do ilevel=nlevel+1,size(v7d_tmp%level)
9831end do
9832
9833do itimerange=ntimerange+1,size(v7d_tmp%timerange)
9835end do
9836
9837!copy with remove
9840
9841!call display(v7dout)
9842
9843end subroutine v7d_rounding
9844
9845
9847
9848!>\example esempio_qc_convert.f90
9849!!\brief Programma esempio semplice per la scrittura su file di un volume vol7d
9850!!
9851!!Programma che scrive su file un volume vol7d letto da una serie di file ASCII.
9852!!Questo programma scrive i dati del clima che poi verranno letti da modqccli
9853
9854
9855!>\example esempio_v7ddballe_move_and_collapse.f90
9856!!\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 |