libsim Versione 7.2.6
|
◆ vol7d_get_voldatiattrd()
Crea una vista a dimensione ridotta di un volume di attributi di dati di tipo DOUBLE PRECISION. È 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: DOUBLE PRECISION, POINTER :: vol2d(:,:)
...
CALL vol7d_get_voldatiattrd(v7d1, (/vol7d_ana_d, vol7d_time_d/), vol2d)
IF (ASSOCIATED(vol2d)) THEN
print*,vol2d
...
ENDIF
return
Definizione alla linea 4377 del file vol7d_class.F90. 4379! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
4380! authors:
4381! Davide Cesari <dcesari@arpa.emr.it>
4382! Paolo Patruno <ppatruno@arpa.emr.it>
4383
4384! This program is free software; you can redistribute it and/or
4385! modify it under the terms of the GNU General Public License as
4386! published by the Free Software Foundation; either version 2 of
4387! the License, or (at your option) any later version.
4388
4389! This program is distributed in the hope that it will be useful,
4390! but WITHOUT ANY WARRANTY; without even the implied warranty of
4391! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4392! GNU General Public License for more details.
4393
4394! You should have received a copy of the GNU General Public License
4395! along with this program. If not, see <http://www.gnu.org/licenses/>.
4396#include "config.h"
4397
4398!> \defgroup vol7d Libsim package, vol7d library.
4399!! The libsim vol7d library contains classes for managing pointwise
4400!! data, tipically weather observations, and for their import from a
4401!! Db-All.e database or from a WMO BUFR file. In order to compile and
4402!! link programs using this library, you have to insert the required
4403!! \c USE statements in the program units involved, specify the
4404!! location of module files when compiling (tipically \c
4405!! -I/usr/lib/gfortran/modules or \c -I/usr/lib64/gfortran/modules or
4406!! \c -I/usr/include) and indicate the library name \c -lsim_vol7d
4407!! when linking, assuming that the library has been installed in a
4408!! default location.
4409
4410!> Classe per la gestione di un volume completo di dati osservati.
4411!! Questo modulo definisce gli oggetti e i metodi per gestire
4412!! volumi di dati meteorologici sparsi.
4413!! I volumi definiti sono principalmente di 4 categorie:
4414!! - volumi di anagrafica (vol7d::volanar & c.), hanno 3 dimensioni:
4415!! - anagrafica
4416!! - variabile di anagrafica
4417!! - rete
4418!! - volumi di attributi di anagrafica (vol7d::volanaattrr & c.), hanno 4 dimensioni:
4419!! - anagrafica
4420!! - variabile di anagrafica
4421!! - rete
4422!! - variabile di attributi delle variabili di anagrafica
4423!! - volumi di dati (vol7d::voldatir & c.), hanno 6 dimensioni:
4424!! - anagrafica
4425!! - tempo
4426!! - livello verticale
4427!! - intervallo temporale (timerange)
4428!! - variabile di dati
4429!! - rete
4430!! - volumi di attributi di dati (vol7d::voldatiattrr & c.), hanno 7 dimensioni:
4431!! - anagrafica
4432!! - tempo
4433!! - livello verticale
4434!! - intervallo temporale (timerange)
4435!! - variabile di dati
4436!! - rete
4437!! - variabile di attributi delle variabili di dati
4438!!
4439!! Tutte le variabili sono inoltre disponibil1 in 5 tipi diversi:
4440!! - reale (abbreviato r)
4441!! - doppia precisione (abbreviato d)
4442!! - intero (abbreviato i)
4443!! - byte (abbreviato b)
4444!! - carattere (abbreviato c)
4445!!
4446!! Per ognuna delle dimensioni possibili, incluse le variabili e gli
4447!! attributi con i loro diversi tipi,
4448!! è definito un cosiddetto "vettore di descrittori", con un
4449!! numero di elementi pari all'estensione della dimensione stessa,
4450!! che contiene le informazioni necessarie a descrivere
4451!! gli elementi di quella dimensione.
4452!! In realtà l'utente non dovrà generalmente occuparsi di costruire
4453!! un oggetto vol7d con le proprie mani ma utilizzerà nella maggior parte
4454!! dei casi i metodi di importazione preconfezionati che importano dati da
4455!! DB-All.e (vol7d_dballe_class) o dal DB Oracle del SIM (vol7d_oraclesim_class).
4456!!
4457!!
4458!! Il programma esempio_v7d.f90 contiene un esempio elementare di uso
4459!! della classe vol7d:
4460!! \include esempio_v7d.f90
4461!!
4462!! \ingroup vol7d
4470USE io_units
4477IMPLICIT NONE
4478
4479
4480INTEGER, PARAMETER :: vol7d_maxdim_a = 3, vol7d_maxdim_aa = 4, &
4481 vol7d_maxdim_d = 6, vol7d_maxdim_ad = 7
4482
4483INTEGER, PARAMETER :: vol7d_ana_a=1 !< indice della dimensione "anagrafica" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
4484INTEGER, PARAMETER :: vol7d_var_a=2 !< indice della dimensione "variabile" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
4485INTEGER, PARAMETER :: vol7d_network_a=3 !< indice della dimensione "rete" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
4486INTEGER, PARAMETER :: vol7d_attr_a=4 !< indice della dimensione "attributo" nei volumi di anagrafica, da usare nei metodi vol7d_get_volana*
4487INTEGER, PARAMETER :: vol7d_ana_d=1 !< indice della dimensione "anagrafica" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
4488INTEGER, PARAMETER :: vol7d_time_d=2 !< indice della dimensione "tempo" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
4489INTEGER, PARAMETER :: vol7d_level_d=3 !< indice della dimensione "livello verticale" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
4490INTEGER, PARAMETER :: vol7d_timerange_d=4 !< indice della dimensione "intervallo temporale" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
4491INTEGER, PARAMETER :: vol7d_var_d=5 !< indice della dimensione "variabile" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
4492INTEGER, PARAMETER :: vol7d_network_d=6 !< indice della dimensione "rete" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
4493INTEGER, PARAMETER :: vol7d_attr_d=7 !< indice della dimensione "attributo" nei volumi di dati, da usare nei metodi vol7d_get_voldati*
4494INTEGER, PARAMETER :: vol7d_cdatalen=32
4495
4496TYPE vol7d_varmap
4497 INTEGER :: r, d, i, b, c
4498END TYPE vol7d_varmap
4499
4500!> Definisce un oggetto contenente i volumi anagrafica e dati e tutti
4501!! i descrittori delle loro dimensioni.
4503!> vettore descrittore della dimensione anagrafica
4504 TYPE(vol7d_ana),POINTER :: ana(:)
4505!> vettore descrittore della dimensione tempo
4506 TYPE(datetime),POINTER :: time(:)
4507!> vettore descrittore della dimensione livello verticale
4508 TYPE(vol7d_level),POINTER :: level(:)
4509!> vettore descrittore della dimensione intervallo temporale (timerange)
4510 TYPE(vol7d_timerange),POINTER :: timerange(:)
4511!> vettore descrittore della dimensione rete
4512 TYPE(vol7d_network),POINTER :: network(:)
4513!> vettore descrittore della dimensione variabile di anagrafica
4514 TYPE(vol7d_varvect) :: anavar
4515!> vettore descrittore della dimensione attributo delle variabili di anagrafica
4516 TYPE(vol7d_varvect) :: anaattr
4517!> vettore descrittore della dimensione variabile di anagrafica che ha tali attributi
4518 TYPE(vol7d_varvect) :: anavarattr
4519!> vettore descrittore della dimensione variabile di dati
4520 TYPE(vol7d_varvect) :: dativar
4521!> vettore descrittore della dimensione attributo delle variabili di dati
4522 TYPE(vol7d_varvect) :: datiattr
4523!> vettore descrittore della dimensione variabile di dati che ha tali attributi
4524 TYPE(vol7d_varvect) :: dativarattr
4525
4526!> volume di anagrafica a valori reali
4527 REAL,POINTER :: volanar(:,:,:)
4528!> volume di anagrafica a valori a doppia precisione
4529 DOUBLE PRECISION,POINTER :: volanad(:,:,:)
4530!> volume di anagrafica a valori interi
4531 INTEGER,POINTER :: volanai(:,:,:)
4532!> volume di anagrafica a valori byte
4533 INTEGER(kind=int_b),POINTER :: volanab(:,:,:)
4534!> volume di anagrafica a valori carattere
4535 CHARACTER(len=vol7d_cdatalen),POINTER :: volanac(:,:,:)
4536
4537!> volume di attributi di anagrafica a valori reali
4538 REAL,POINTER :: volanaattrr(:,:,:,:)
4539!> volume di attributi di anagrafica a valori a doppia precisione
4540 DOUBLE PRECISION,POINTER :: volanaattrd(:,:,:,:)
4541!> volume di attributi di anagrafica a valori interi
4542 INTEGER,POINTER :: volanaattri(:,:,:,:)
4543!> volume di attributi di anagrafica a valori byte
4544 INTEGER(kind=int_b),POINTER :: volanaattrb(:,:,:,:)
4545!> volume di attributi di anagrafica a valori carattere
4546 CHARACTER(len=vol7d_cdatalen),POINTER :: volanaattrc(:,:,:,:)
4547
4548!> volume di dati a valori reali
4549 REAL,POINTER :: voldatir(:,:,:,:,:,:) ! sono i dati
4550!> volume di dati a valori a doppia precisione
4551 DOUBLE PRECISION,POINTER :: voldatid(:,:,:,:,:,:)
4552!> volume di dati a valori interi
4553 INTEGER,POINTER :: voldatii(:,:,:,:,:,:)
4554!> volume di dati a valori byte
4555 INTEGER(kind=int_b),POINTER :: voldatib(:,:,:,:,:,:)
4556!> volume di dati a valori carattere
4557 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatic(:,:,:,:,:,:)
4558
4559!> volume di attributi di dati a valori reali
4560 REAL,POINTER :: voldatiattrr(:,:,:,:,:,:,:)
4561!> volume di attributi di dati a valori a doppia precisione
4562 DOUBLE PRECISION,POINTER :: voldatiattrd(:,:,:,:,:,:,:)
4563!> volume di attributi di dati a valori interi
4564 INTEGER,POINTER :: voldatiattri(:,:,:,:,:,:,:)
4565!> volume di attributi di dati a valori byte
4566 INTEGER(kind=int_b),POINTER :: voldatiattrb(:,:,:,:,:,:,:)
4567!> volume di attributi di dati a valori carattere
4568 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatiattrc(:,:,:,:,:,:,:)
4569
4570!> time definition; 0=time is reference time, 1=time is validity time
4571 integer :: time_definition
4572
4574
4575!> Costruttore per la classe vol7d.
4576!! Deve essere richiamato
4577!! per tutti gli oggetti di questo tipo definiti in un programma.
4579 MODULE PROCEDURE vol7d_init
4580END INTERFACE
4581
4582!> Distruttore per la classe vol7d.
4584 MODULE PROCEDURE vol7d_delete
4585END INTERFACE
4586
4587!> Scrittura su file.
4589 MODULE PROCEDURE vol7d_write_on_file
4590END INTERFACE
4591
4592!> Lettura da file.
4593INTERFACE import
4594 MODULE PROCEDURE vol7d_read_from_file
4595END INTERFACE
4596
4597!>Print object
4599 MODULE PROCEDURE vol7d_display, dat_display, dat_vect_display
4600END INTERFACE
4601
4602!>Represent data in a pretty string
4604 MODULE PROCEDURE to_char_dat
4605END INTERFACE
4606
4607!>doubleprecision data conversion
4609 MODULE PROCEDURE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
4610END INTERFACE
4611
4612!>real data conversion
4614 MODULE PROCEDURE realdatd,realdatr,realdati,realdatb,realdatc
4615END INTERFACE
4616
4617!>integer data conversion
4619 MODULE PROCEDURE integerdatd,integerdatr,integerdati,integerdatb,integerdatc
4620END INTERFACE
4621
4622!>copy object
4624 MODULE PROCEDURE vol7d_copy
4625END INTERFACE
4626
4627!> Test for a missing volume
4629 MODULE PROCEDURE vol7d_c_e
4630END INTERFACE
4631
4632!> Check for problems
4633!! return 0 if all check passed
4634!! print diagnostics with log4f
4636 MODULE PROCEDURE vol7d_check
4637END INTERFACE
4638
4639!> Reduce some dimensions (level and timerage) for semplification (rounding).
4640!! You can use this for simplify and use variables in computation like alchimia
4641!! where fields have to be on the same coordinate
4642!! It return real or character data only: if input is charcter data only it return character otherwise il return
4643!! all the data converted to real.
4644!! examples:
4645!! means in time for short periods and istantaneous values
4646!! 2 meter and surface levels
4647!! If there are data on more then one almost equal levels or timeranges, the first var present (at least one point)
4648!! will be taken (order is by icreasing var index).
4649!! You can use predefined values for classic semplification
4650!! almost_equal_levels and almost_equal_timeranges
4651!! The level or timerange in output will be defined by the first element of level and timerange list
4653 MODULE PROCEDURE v7d_rounding
4654END INTERFACE
4655
4656!!$INTERFACE get_volana
4657!!$ MODULE PROCEDURE vol7d_get_volanar, vol7d_get_volanad, vol7d_get_volanai, &
4658!!$ vol7d_get_volanab, vol7d_get_volanac
4659!!$END INTERFACE
4660!!$
4661!!$INTERFACE get_voldati
4662!!$ MODULE PROCEDURE vol7d_get_voldatir, vol7d_get_voldatid, vol7d_get_voldatii, &
4663!!$ vol7d_get_voldatib, vol7d_get_voldatic
4664!!$END INTERFACE
4665!!$
4666!!$INTERFACE get_volanaattr
4667!!$ MODULE PROCEDURE vol7d_get_volanaattrr, vol7d_get_volanaattrd, &
4668!!$ vol7d_get_volanaattri, vol7d_get_volanaattrb, vol7d_get_volanaattrc
4669!!$END INTERFACE
4670!!$
4671!!$INTERFACE get_voldatiattr
4672!!$ MODULE PROCEDURE vol7d_get_voldatiattrr, vol7d_get_voldatiattrd, &
4673!!$ vol7d_get_voldatiattri, vol7d_get_voldatiattrb, vol7d_get_voldatiattrc
4674!!$END INTERFACE
4675
4676PRIVATE vol7d_get_volr, vol7d_get_vold, vol7d_get_voli, vol7d_get_volb, &
4677 vol7d_get_volc, &
4678 volptr1dr, volptr2dr, volptr3dr, volptr4dr, volptr5dr, volptr6dr, volptr7dr, &
4679 volptr1dd, volptr2dd, volptr3dd, volptr4dd, volptr5dd, volptr6dd, volptr7dd, &
4680 volptr1di, volptr2di, volptr3di, volptr4di, volptr5di, volptr6di, volptr7di, &
4681 volptr1db, volptr2db, volptr3db, volptr4db, volptr5db, volptr6db, volptr7db, &
4682 volptr1dc, volptr2dc, volptr3dc, volptr4dc, volptr5dc, volptr6dc, volptr7dc, &
4683 vol7d_nullifyr, vol7d_nullifyd, vol7d_nullifyi, vol7d_nullifyb, vol7d_nullifyc, &
4684 vol7d_init, vol7d_delete, vol7d_write_on_file, vol7d_read_from_file, &
4685 vol7d_check_alloc_ana, vol7d_force_alloc_ana, &
4686 vol7d_check_alloc_dati, vol7d_force_alloc_dati, vol7d_force_alloc, &
4687 vol7d_display, dat_display, dat_vect_display, &
4688 to_char_dat, vol7d_check
4689
4690PRIVATE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
4691
4692PRIVATE vol7d_c_e
4693
4694CONTAINS
4695
4696
4697!> Inizializza un oggetto di tipo vol7d.
4698!! Non riceve alcun parametro tranne l'oggetto stesso. Attenzione, è necessario
4699!! comunque chiamare sempre il costruttore per evitare di avere dei puntatori in
4700!! uno stato indefinito.
4701SUBROUTINE vol7d_init(this,time_definition)
4702TYPE(vol7d),intent(out) :: this !< oggetto da inizializzare
4703integer,INTENT(IN),OPTIONAL :: time_definition !< 0=time is reference time ; 1=time is validity time (default=1)
4704
4711CALL vol7d_var_features_init() ! initialise var features table once
4712
4713NULLIFY(this%ana, this%time, this%level, this%timerange, this%network)
4714
4715NULLIFY(this%volanar, this%volanaattrr, this%voldatir, this%voldatiattrr)
4716NULLIFY(this%volanad, this%volanaattrd, this%voldatid, this%voldatiattrd)
4717NULLIFY(this%volanai, this%volanaattri, this%voldatii, this%voldatiattri)
4718NULLIFY(this%volanab, this%volanaattrb, this%voldatib, this%voldatiattrb)
4719NULLIFY(this%volanac, this%volanaattrc, this%voldatic, this%voldatiattrc)
4720
4721if(present(time_definition)) then
4722 this%time_definition=time_definition
4723else
4724 this%time_definition=1 !default to validity time
4725end if
4726
4727END SUBROUTINE vol7d_init
4728
4729
4730!> Distrugge l'oggetto in maniera pulita, liberando l'eventuale memoria
4731!! dinamicamente allocata. Permette di distruggere la sola parte di dati
4732!! mantenendo l'anagrafica.
4733ELEMENTAL SUBROUTINE vol7d_delete(this, dataonly)
4734TYPE(vol7d),intent(inout) :: this !< oggetto da distruggere
4735LOGICAL, INTENT(in), OPTIONAL :: dataonly !< dealloca solo i dati, tenendo l'anagrafica, (default \c .FALSE.)
4736
4737
4738IF (.NOT. optio_log(dataonly)) THEN
4739 IF (ASSOCIATED(this%volanar)) DEALLOCATE(this%volanar)
4740 IF (ASSOCIATED(this%volanad)) DEALLOCATE(this%volanad)
4741 IF (ASSOCIATED(this%volanai)) DEALLOCATE(this%volanai)
4742 IF (ASSOCIATED(this%volanab)) DEALLOCATE(this%volanab)
4743 IF (ASSOCIATED(this%volanac)) DEALLOCATE(this%volanac)
4744 IF (ASSOCIATED(this%volanaattrr)) DEALLOCATE(this%volanaattrr)
4745 IF (ASSOCIATED(this%volanaattrd)) DEALLOCATE(this%volanaattrd)
4746 IF (ASSOCIATED(this%volanaattri)) DEALLOCATE(this%volanaattri)
4747 IF (ASSOCIATED(this%volanaattrb)) DEALLOCATE(this%volanaattrb)
4748 IF (ASSOCIATED(this%volanaattrc)) DEALLOCATE(this%volanaattrc)
4749ENDIF
4750IF (ASSOCIATED(this%voldatir)) DEALLOCATE(this%voldatir)
4751IF (ASSOCIATED(this%voldatid)) DEALLOCATE(this%voldatid)
4752IF (ASSOCIATED(this%voldatii)) DEALLOCATE(this%voldatii)
4753IF (ASSOCIATED(this%voldatib)) DEALLOCATE(this%voldatib)
4754IF (ASSOCIATED(this%voldatic)) DEALLOCATE(this%voldatic)
4755IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
4756IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
4757IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
4758IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
4759IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
4760
4761IF (.NOT. optio_log(dataonly)) THEN
4762 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
4763 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
4764ENDIF
4765IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
4766IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
4767IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
4768
4769IF (.NOT. optio_log(dataonly)) THEN
4773ENDIF
4777
4778END SUBROUTINE vol7d_delete
4779
4780
4781
4782integer function vol7d_check(this)
4783TYPE(vol7d),intent(in) :: this !< object to check
4784integer :: i,j,k,l,m,n
4785
4786vol7d_check=0
4787
4788if (associated(this%voldatii)) then
4789do i = 1,size(this%voldatii,1)
4790 do j = 1,size(this%voldatii,2)
4791 do k = 1,size(this%voldatii,3)
4792 do l = 1,size(this%voldatii,4)
4793 do m = 1,size(this%voldatii,5)
4794 do n = 1,size(this%voldatii,6)
4795 if (this%voldatii(i,j,k,l,m,n) /= this%voldatii(i,j,k,l,m,n) ) then
4796 CALL l4f_log(l4f_warn,"check: abnormal value at voldatii("&
4798 vol7d_check=1
4799 end if
4800 end do
4801 end do
4802 end do
4803 end do
4804 end do
4805end do
4806end if
4807
4808
4809if (associated(this%voldatir)) then
4810do i = 1,size(this%voldatir,1)
4811 do j = 1,size(this%voldatir,2)
4812 do k = 1,size(this%voldatir,3)
4813 do l = 1,size(this%voldatir,4)
4814 do m = 1,size(this%voldatir,5)
4815 do n = 1,size(this%voldatir,6)
4816 if (this%voldatir(i,j,k,l,m,n) /= this%voldatir(i,j,k,l,m,n) ) then
4817 CALL l4f_log(l4f_warn,"check: abnormal value at voldatir("&
4819 vol7d_check=2
4820 end if
4821 end do
4822 end do
4823 end do
4824 end do
4825 end do
4826end do
4827end if
4828
4829if (associated(this%voldatid)) then
4830do i = 1,size(this%voldatid,1)
4831 do j = 1,size(this%voldatid,2)
4832 do k = 1,size(this%voldatid,3)
4833 do l = 1,size(this%voldatid,4)
4834 do m = 1,size(this%voldatid,5)
4835 do n = 1,size(this%voldatid,6)
4836 if (this%voldatid(i,j,k,l,m,n) /= this%voldatid(i,j,k,l,m,n) ) then
4837 CALL l4f_log(l4f_warn,"check: abnormal value at voldatid("&
4839 vol7d_check=3
4840 end if
4841 end do
4842 end do
4843 end do
4844 end do
4845 end do
4846end do
4847end if
4848
4849if (associated(this%voldatib)) then
4850do i = 1,size(this%voldatib,1)
4851 do j = 1,size(this%voldatib,2)
4852 do k = 1,size(this%voldatib,3)
4853 do l = 1,size(this%voldatib,4)
4854 do m = 1,size(this%voldatib,5)
4855 do n = 1,size(this%voldatib,6)
4856 if (this%voldatib(i,j,k,l,m,n) /= this%voldatib(i,j,k,l,m,n) ) then
4857 CALL l4f_log(l4f_warn,"check: abnormal value at voldatib("&
4859 vol7d_check=4
4860 end if
4861 end do
4862 end do
4863 end do
4864 end do
4865 end do
4866end do
4867end if
4868
4869end function vol7d_check
4870
4871
4872
4873!TODO da completare ! aborta se i volumi sono allocati a dimensione 0
4874!> stampa a video una sintesi del contenuto
4875SUBROUTINE vol7d_display(this)
4876TYPE(vol7d),intent(in) :: this !< oggetto da visualizzare
4877integer :: i
4878
4879REAL :: rdat
4880DOUBLE PRECISION :: ddat
4881INTEGER :: idat
4882INTEGER(kind=int_b) :: bdat
4883CHARACTER(len=vol7d_cdatalen) :: cdat
4884
4885
4886print*,"<<<<<<<<<<<<<<<<<<< vol7d object >>>>>>>>>>>>>>>>>>>>"
4887if (this%time_definition == 0) then
4888 print*,"TIME DEFINITION: time is reference time"
4889else if (this%time_definition == 1) then
4890 print*,"TIME DEFINITION: time is validity time"
4891else
4892 print*,"Time definition have a wrong walue:", this%time_definition
4893end if
4894
4895IF (ASSOCIATED(this%network))then
4896 print*,"---- network vector ----"
4897 print*,"elements=",size(this%network)
4898 do i=1, size(this%network)
4900 end do
4901end IF
4902
4903IF (ASSOCIATED(this%ana))then
4904 print*,"---- ana vector ----"
4905 print*,"elements=",size(this%ana)
4906 do i=1, size(this%ana)
4908 end do
4909end IF
4910
4911IF (ASSOCIATED(this%time))then
4912 print*,"---- time vector ----"
4913 print*,"elements=",size(this%time)
4914 do i=1, size(this%time)
4916 end do
4917end if
4918
4919IF (ASSOCIATED(this%level)) then
4920 print*,"---- level vector ----"
4921 print*,"elements=",size(this%level)
4922 do i =1,size(this%level)
4924 end do
4925end if
4926
4927IF (ASSOCIATED(this%timerange))then
4928 print*,"---- timerange vector ----"
4929 print*,"elements=",size(this%timerange)
4930 do i =1,size(this%timerange)
4932 end do
4933end if
4934
4935
4936print*,"---- ana vector ----"
4937print*,""
4938print*,"->>>>>>>>> anavar -"
4940print*,""
4941print*,"->>>>>>>>> anaattr -"
4943print*,""
4944print*,"->>>>>>>>> anavarattr -"
4946
4947print*,"-- ana data section (first point) --"
4948
4949idat=imiss
4950rdat=rmiss
4951ddat=dmiss
4952bdat=ibmiss
4953cdat=cmiss
4954
4955!ntime = MIN(SIZE(this%time),nprint)
4956!ntimerange = MIN(SIZE(this%timerange),nprint)
4957!nlevel = MIN(SIZE(this%level),nprint)
4958!nnetwork = MIN(SIZE(this%network),nprint)
4959!nana = MIN(SIZE(this%ana),nprint)
4960
4961IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0) THEN
4962if (associated(this%volanai)) then
4963 do i=1,size(this%anavar%i)
4964 idat=this%volanai(1,i,1)
4966 end do
4967end if
4968idat=imiss
4969
4970if (associated(this%volanar)) then
4971 do i=1,size(this%anavar%r)
4972 rdat=this%volanar(1,i,1)
4974 end do
4975end if
4976rdat=rmiss
4977
4978if (associated(this%volanad)) then
4979 do i=1,size(this%anavar%d)
4980 ddat=this%volanad(1,i,1)
4982 end do
4983end if
4984ddat=dmiss
4985
4986if (associated(this%volanab)) then
4987 do i=1,size(this%anavar%b)
4988 bdat=this%volanab(1,i,1)
4990 end do
4991end if
4992bdat=ibmiss
4993
4994if (associated(this%volanac)) then
4995 do i=1,size(this%anavar%c)
4996 cdat=this%volanac(1,i,1)
4998 end do
4999end if
5000cdat=cmiss
5001ENDIF
5002
5003print*,"---- data vector ----"
5004print*,""
5005print*,"->>>>>>>>> dativar -"
5007print*,""
5008print*,"->>>>>>>>> datiattr -"
5010print*,""
5011print*,"->>>>>>>>> dativarattr -"
5013
5014print*,"-- data data section (first point) --"
5015
5016idat=imiss
5017rdat=rmiss
5018ddat=dmiss
5019bdat=ibmiss
5020cdat=cmiss
5021
5022IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0 .AND. size(this%time) > 0 &
5023 .AND. size(this%level) > 0 .AND. size(this%timerange) > 0) THEN
5024if (associated(this%voldatii)) then
5025 do i=1,size(this%dativar%i)
5026 idat=this%voldatii(1,1,1,1,i,1)
5028 end do
5029end if
5030idat=imiss
5031
5032if (associated(this%voldatir)) then
5033 do i=1,size(this%dativar%r)
5034 rdat=this%voldatir(1,1,1,1,i,1)
5036 end do
5037end if
5038rdat=rmiss
5039
5040if (associated(this%voldatid)) then
5041 do i=1,size(this%dativar%d)
5042 ddat=this%voldatid(1,1,1,1,i,1)
5044 end do
5045end if
5046ddat=dmiss
5047
5048if (associated(this%voldatib)) then
5049 do i=1,size(this%dativar%b)
5050 bdat=this%voldatib(1,1,1,1,i,1)
5052 end do
5053end if
5054bdat=ibmiss
5055
5056if (associated(this%voldatic)) then
5057 do i=1,size(this%dativar%c)
5058 cdat=this%voldatic(1,1,1,1,i,1)
5060 end do
5061end if
5062cdat=cmiss
5063ENDIF
5064
5065print*,"<<<<<<<<<<<<<<<<<<< END vol7d object >>>>>>>>>>>>>>>>>>>>"
5066
5067END SUBROUTINE vol7d_display
5068
5069
5070!> stampa a video una sintesi del contenuto
5071SUBROUTINE dat_display(this,idat,rdat,ddat,bdat,cdat)
5072TYPE(vol7d_var),intent(in) :: this !< oggetto da visualizzare
5073!> real
5074REAL :: rdat
5075!> double precision
5076DOUBLE PRECISION :: ddat
5077!> integer
5078INTEGER :: idat
5079!> byte
5080INTEGER(kind=int_b) :: bdat
5081!> character
5082CHARACTER(len=*) :: cdat
5083
5084print *, to_char_dat(this,idat,rdat,ddat,bdat,cdat)
5085
5086end SUBROUTINE dat_display
5087
5088!> stampa a video una sintesi del contenuto
5089SUBROUTINE dat_vect_display(this,idat,rdat,ddat,bdat,cdat)
5090
5091TYPE(vol7d_var),intent(in) :: this(:) !< oggetto da visualizzare
5092!> real
5093REAL :: rdat(:)
5094!> double precision
5095DOUBLE PRECISION :: ddat(:)
5096!> integer
5097INTEGER :: idat(:)
5098!> byte
5099INTEGER(kind=int_b) :: bdat(:)
5100!> character
5101CHARACTER(len=*):: cdat(:)
5102
5103integer :: i
5104
5105do i =1,size(this)
5107end do
5108
5109end SUBROUTINE dat_vect_display
5110
5111
5112FUNCTION to_char_dat(this,idat,rdat,ddat,bdat,cdat)
5113#ifdef HAVE_DBALLE
5114USE dballef
5115#endif
5116TYPE(vol7d_var),INTENT(in) :: this
5117!> real
5118REAL :: rdat
5119!> double precision
5120DOUBLE PRECISION :: ddat
5121!> integer
5122INTEGER :: idat
5123!> byte
5124INTEGER(kind=int_b) :: bdat
5125!> character
5126CHARACTER(len=*) :: cdat
5127CHARACTER(len=80) :: to_char_dat
5128
5129CHARACTER(len=LEN(to_char_dat)) :: to_char_tmp
5130
5131
5132#ifdef HAVE_DBALLE
5133INTEGER :: handle, ier
5134
5135handle = 0
5136to_char_dat="VALUE: "
5137
5142
5144 ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
5145 ier = idba_spiegab(handle,this%btable,cdat,to_char_tmp)
5146 ier = idba_fatto(handle)
5147 to_char_dat=trim(to_char_dat)//" ;char> "//trim(to_char_tmp)
5148endif
5149
5150#else
5151
5152to_char_dat="VALUE: "
5158
5159#endif
5160
5161END FUNCTION to_char_dat
5162
5163
5164!> Tests whether anything has ever been assigned to a vol7d object
5165!! (.TRUE.) or it is as clean as after an init (.FALSE.).
5166FUNCTION vol7d_c_e(this) RESULT(c_e)
5167TYPE(vol7d), INTENT(in) :: this
5168
5169LOGICAL :: c_e
5170
5172 ASSOCIATED(this%level) .OR. ASSOCIATED(this%timerange) .OR. &
5173 ASSOCIATED(this%network) .OR. &
5174 ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
5175 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
5176 ASSOCIATED(this%anavar%c) .OR. &
5177 ASSOCIATED(this%anaattr%r) .OR. ASSOCIATED(this%anaattr%d) .OR. &
5178 ASSOCIATED(this%anaattr%i) .OR. ASSOCIATED(this%anaattr%b) .OR. &
5179 ASSOCIATED(this%anaattr%c) .OR. &
5180 ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
5181 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
5182 ASSOCIATED(this%dativar%c) .OR. &
5183 ASSOCIATED(this%datiattr%r) .OR. ASSOCIATED(this%datiattr%d) .OR. &
5184 ASSOCIATED(this%datiattr%i) .OR. ASSOCIATED(this%datiattr%b) .OR. &
5185 ASSOCIATED(this%datiattr%c)
5186
5187END FUNCTION vol7d_c_e
5188
5189
5190!> Metodo per allocare i descrittori delle 7 dimensioni.
5191!! Riceve un grande numero di parametri opzionali che
5192!! indicano quali descrittori allocare e con quale estensione;
5193!! i descrittori non specificati non vengono toccati.
5194!! Può essere quindi chiamato più volte allocando via via
5195!! descrittori relativi a dimensioni diverse.
5196!! Se un descrittore richiesto è già allocato, viene deallocato
5197!! (perdendone l'eventuale contenuto) e riallocato con l'estensione
5198!! richiesta.
5199!! Per i descrittori relativi a dimensioni che non siano variabili o attributi,
5200!! è possibile specificare l'estensione di una dimensione a 0,
5201!! in tal caso il descrittore viene comunque allocato con lunghezza nulla,
5202!! che è diverso da non allocarlo. Per i descrittori di variabili e attributi
5203!! passare un'estensione 0 equivale a non fornire il parametro.
5204!! Avere uno o più descrittori dimensionati con estensione nulla fa sì
5205!! che anche il volume dati successivamente allocato abbia estensione nulla;
5206!! sebbene ciò appaia inutile, un volume del genere può in realtà servire,
5207!! in associazione ai metodi ::vol7d_merge o ::vol7d_append per estendere
5208!! un volume esistente aggiungendo elementi in alcune dimensioni (quelle
5209!! a estensione non nulla, ovviamente) e mantenendo invariato tutto il resto.
5210!! Per quanto riguarda i descrittori delle dimensioni relative alle
5211!! variabili, la relativa estensione è specificata con la nomenclatura
5212!! \a n<x><y><z> dove <x> può valere:
5213!! - \a ana per variabili relative a voumi di anagrafica
5214!! - \a dati per variabili relative a voumi di dati
5215!!
5216!! <y> può valere:
5217!! - \a var per variabili
5218!! - \a attr per attributi
5219!! - \a varattr variabili aventi attributi nei volumi di attributi
5220!!
5221!! <z> può valere:
5222!! - \a r per variabili o attributi a valori reali
5223!! - \a d per variabili o attributi a valori a doppia precisione
5224!! - \a i per variabili o attributi a valori interi
5225!! - \a b per variabili o attributi a valori byte
5226!! - \a c per variabili o attributi a valori carattere
5227!!
5228SUBROUTINE vol7d_alloc(this, nana, ntime, nlevel, ntimerange, nnetwork, &
5229 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
5230 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
5231 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
5232 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
5233 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
5234 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc, &
5235 ini)
5236TYPE(vol7d),INTENT(inout) :: this !< oggetto di cui allocare i descrittori
5237INTEGER,INTENT(in),OPTIONAL :: nana !< estensione della dimensione anagrafica
5238INTEGER,INTENT(in),OPTIONAL :: ntime !< estensione della dimensione tempo
5239INTEGER,INTENT(in),OPTIONAL :: nlevel !< estensione della dimensione livello varticale
5240INTEGER,INTENT(in),OPTIONAL :: ntimerange !< estensione della dimensione intervallo temporale (timerange)
5241INTEGER,INTENT(in),OPTIONAL :: nnetwork !< estensione della dimensione rete
5242!> estensione delle possibili dimensioni variabile
5243INTEGER,INTENT(in),OPTIONAL :: &
5244 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
5245 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
5246 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
5247 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
5248 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
5249 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc
5250LOGICAL,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
5251
5252INTEGER :: i
5253LOGICAL :: linit
5254
5255IF (PRESENT(ini)) THEN
5256 linit = ini
5257ELSE
5258 linit = .false.
5259ENDIF
5260
5261! Dimensioni principali
5262IF (PRESENT(nana)) THEN
5263 IF (nana >= 0) THEN
5264 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
5265 ALLOCATE(this%ana(nana))
5266 IF (linit) THEN
5267 DO i = 1, nana
5269 ENDDO
5270 ENDIF
5271 ENDIF
5272ENDIF
5273IF (PRESENT(ntime)) THEN
5274 IF (ntime >= 0) THEN
5275 IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
5276 ALLOCATE(this%time(ntime))
5277 IF (linit) THEN
5278 DO i = 1, ntime
5280 ENDDO
5281 ENDIF
5282 ENDIF
5283ENDIF
5284IF (PRESENT(nlevel)) THEN
5285 IF (nlevel >= 0) THEN
5286 IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
5287 ALLOCATE(this%level(nlevel))
5288 IF (linit) THEN
5289 DO i = 1, nlevel
5291 ENDDO
5292 ENDIF
5293 ENDIF
5294ENDIF
5295IF (PRESENT(ntimerange)) THEN
5296 IF (ntimerange >= 0) THEN
5297 IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
5298 ALLOCATE(this%timerange(ntimerange))
5299 IF (linit) THEN
5300 DO i = 1, ntimerange
5302 ENDDO
5303 ENDIF
5304 ENDIF
5305ENDIF
5306IF (PRESENT(nnetwork)) THEN
5307 IF (nnetwork >= 0) THEN
5308 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
5309 ALLOCATE(this%network(nnetwork))
5310 IF (linit) THEN
5311 DO i = 1, nnetwork
5313 ENDDO
5314 ENDIF
5315 ENDIF
5316ENDIF
5317! Dimensioni dei tipi delle variabili
5318CALL vol7d_varvect_alloc(this%anavar, nanavarr, nanavard, &
5319 nanavari, nanavarb, nanavarc, ini)
5320CALL vol7d_varvect_alloc(this%anaattr, nanaattrr, nanaattrd, &
5321 nanaattri, nanaattrb, nanaattrc, ini)
5322CALL vol7d_varvect_alloc(this%anavarattr, nanavarattrr, nanavarattrd, &
5323 nanavarattri, nanavarattrb, nanavarattrc, ini)
5324CALL vol7d_varvect_alloc(this%dativar, ndativarr, ndativard, &
5325 ndativari, ndativarb, ndativarc, ini)
5326CALL vol7d_varvect_alloc(this%datiattr, ndatiattrr, ndatiattrd, &
5327 ndatiattri, ndatiattrb, ndatiattrc, ini)
5328CALL vol7d_varvect_alloc(this%dativarattr, ndativarattrr, ndativarattrd, &
5329 ndativarattri, ndativarattrb, ndativarattrc, ini)
5330
5331END SUBROUTINE vol7d_alloc
5332
5333
5334FUNCTION vol7d_check_alloc_ana(this)
5335TYPE(vol7d),INTENT(in) :: this
5336LOGICAL :: vol7d_check_alloc_ana
5337
5338vol7d_check_alloc_ana = ASSOCIATED(this%ana) .AND. ASSOCIATED(this%network)
5339
5340END FUNCTION vol7d_check_alloc_ana
5341
5342SUBROUTINE vol7d_force_alloc_ana(this, ini)
5343TYPE(vol7d),INTENT(inout) :: this
5344LOGICAL,INTENT(in),OPTIONAL :: ini
5345
5346! Alloco i descrittori minimi per avere un volume di anagrafica
5347IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=1, ini=ini)
5348IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=1, ini=ini)
5349
5350END SUBROUTINE vol7d_force_alloc_ana
5351
5352
5353FUNCTION vol7d_check_alloc_dati(this)
5354TYPE(vol7d),INTENT(in) :: this
5355LOGICAL :: vol7d_check_alloc_dati
5356
5357vol7d_check_alloc_dati = vol7d_check_alloc_ana(this) .AND. &
5358 ASSOCIATED(this%time) .AND. ASSOCIATED(this%level) .AND. &
5359 ASSOCIATED(this%timerange)
5360
5361END FUNCTION vol7d_check_alloc_dati
5362
5363SUBROUTINE vol7d_force_alloc_dati(this, ini)
5364TYPE(vol7d),INTENT(inout) :: this
5365LOGICAL,INTENT(in),OPTIONAL :: ini
5366
5367! Alloco i descrittori minimi per avere un volume di dati
5368CALL vol7d_force_alloc_ana(this, ini)
5369IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=1, ini=ini)
5370IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=1, ini=ini)
5371IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=1, ini=ini)
5372
5373END SUBROUTINE vol7d_force_alloc_dati
5374
5375
5376SUBROUTINE vol7d_force_alloc(this)
5377TYPE(vol7d),INTENT(inout) :: this
5378
5379! If anything really not allocated yet, allocate with size 0
5380IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=0)
5381IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=0)
5382IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=0)
5383IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=0)
5384IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=0)
5385
5386END SUBROUTINE vol7d_force_alloc
5387
5388
5389FUNCTION vol7d_check_vol(this)
5390TYPE(vol7d),INTENT(in) :: this !< oggetto da controllare
5391LOGICAL :: vol7d_check_vol
5392
5393vol7d_check_vol = c_e(this)
5394
5395! Anagrafica
5396IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
5397 vol7d_check_vol = .false.
5398ENDIF
5399
5400IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
5401 vol7d_check_vol = .false.
5402ENDIF
5403
5404IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
5405 vol7d_check_vol = .false.
5406ENDIF
5407
5408IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
5409 vol7d_check_vol = .false.
5410ENDIF
5411
5412IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
5413 vol7d_check_vol = .false.
5414ENDIF
5415IF (ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
5416 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
5417 ASSOCIATED(this%anavar%c)) THEN
5418 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_ana(this)
5419ENDIF
5420
5421! Attributi dell'anagrafica
5422IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
5423 .NOT.ASSOCIATED(this%volanaattrr)) THEN
5424 vol7d_check_vol = .false.
5425ENDIF
5426
5427IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
5428 .NOT.ASSOCIATED(this%volanaattrd)) THEN
5429 vol7d_check_vol = .false.
5430ENDIF
5431
5432IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
5433 .NOT.ASSOCIATED(this%volanaattri)) THEN
5434 vol7d_check_vol = .false.
5435ENDIF
5436
5437IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
5438 .NOT.ASSOCIATED(this%volanaattrb)) THEN
5439 vol7d_check_vol = .false.
5440ENDIF
5441
5442IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
5443 .NOT.ASSOCIATED(this%volanaattrc)) THEN
5444 vol7d_check_vol = .false.
5445ENDIF
5446
5447! Dati
5448IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
5449 vol7d_check_vol = .false.
5450ENDIF
5451
5452IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
5453 vol7d_check_vol = .false.
5454ENDIF
5455
5456IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
5457 vol7d_check_vol = .false.
5458ENDIF
5459
5460IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
5461 vol7d_check_vol = .false.
5462ENDIF
5463
5464IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
5465 vol7d_check_vol = .false.
5466ENDIF
5467
5468! Attributi dei dati
5469IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
5470 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
5471 vol7d_check_vol = .false.
5472ENDIF
5473
5474IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
5475 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
5476 vol7d_check_vol = .false.
5477ENDIF
5478
5479IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
5480 .NOT.ASSOCIATED(this%voldatiattri)) THEN
5481 vol7d_check_vol = .false.
5482ENDIF
5483
5484IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
5485 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
5486 vol7d_check_vol = .false.
5487ENDIF
5488
5489IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
5490 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
5491 vol7d_check_vol = .false.
5492ENDIF
5493IF (ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
5494 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
5495 ASSOCIATED(this%dativar%c)) THEN
5496 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_dati(this)
5497ENDIF
5498
5499END FUNCTION vol7d_check_vol
5500
5501
5502!> Metodo per allocare i volumi richiesti di variabili e attributi per
5503!! anagrafica e dati.
5504!! Se alcuni dei descrittori relativi alle dimensioni anagrafica,
5505!! livello verticale, tempo, intervallo temporale (timerange), rete non sono
5506!! stati richiesti preventivamente con la ::vol7d_alloc, essi vengono allocati
5507!! automaticamente da questo metodo
5508!! con estensione di default pari a 1 (non 0!), questo significa, ad esempio,
5509!! che se prevedo di avere soli dati superficiali, cioè ad un solo livello
5510!! verticale, o una sola rete di stazioni, non devo preoccuparmi di
5511!! specificare questa informazione.
5512!! Tra i 20 possibili volumi allocabili
5513!! ((variabili,attributi)*(anagrafica,dati)*(r,d,i,b,c)=20)
5514!! saranno allocati solo quelli per cui è stato precedentemente richiesto il
5515!! corrispondente descrittore variabili/attributi con la ::vol7d_alloc.
5516SUBROUTINE vol7d_alloc_vol(this, ini, inivol)
5517TYPE(vol7d),INTENT(inout) :: this !< oggetto di cui allocare i volumi
5518LOGICAL,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
5519LOGICAL,INTENT(in),OPTIONAL :: inivol !< se fornito e vale \c .TRUE., i volumi allocati saranno inizializzati a valore mancante
5520
5521LOGICAL :: linivol
5522
5523IF (PRESENT(inivol)) THEN
5524 linivol = inivol
5525ELSE
5526 linivol = .true.
5527ENDIF
5528
5529! Anagrafica
5530IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
5531 CALL vol7d_force_alloc_ana(this, ini)
5532 ALLOCATE(this%volanar(SIZE(this%ana), SIZE(this%anavar%r), SIZE(this%network)))
5533 IF (linivol) this%volanar(:,:,:) = rmiss
5534ENDIF
5535
5536IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
5537 CALL vol7d_force_alloc_ana(this, ini)
5538 ALLOCATE(this%volanad(SIZE(this%ana), SIZE(this%anavar%d), SIZE(this%network)))
5539 IF (linivol) this%volanad(:,:,:) = rdmiss
5540ENDIF
5541
5542IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
5543 CALL vol7d_force_alloc_ana(this, ini)
5544 ALLOCATE(this%volanai(SIZE(this%ana), SIZE(this%anavar%i), SIZE(this%network)))
5545 IF (linivol) this%volanai(:,:,:) = imiss
5546ENDIF
5547
5548IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
5549 CALL vol7d_force_alloc_ana(this, ini)
5550 ALLOCATE(this%volanab(SIZE(this%ana), SIZE(this%anavar%b), SIZE(this%network)))
5551 IF (linivol) this%volanab(:,:,:) = ibmiss
5552ENDIF
5553
5554IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
5555 CALL vol7d_force_alloc_ana(this, ini)
5556 ALLOCATE(this%volanac(SIZE(this%ana), SIZE(this%anavar%c), SIZE(this%network)))
5557 IF (linivol) this%volanac(:,:,:) = cmiss
5558ENDIF
5559
5560! Attributi dell'anagrafica
5561IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
5562 .NOT.ASSOCIATED(this%volanaattrr)) THEN
5563 CALL vol7d_force_alloc_ana(this, ini)
5564 ALLOCATE(this%volanaattrr(SIZE(this%ana), SIZE(this%anavarattr%r), &
5565 SIZE(this%network), SIZE(this%anaattr%r)))
5566 IF (linivol) this%volanaattrr(:,:,:,:) = rmiss
5567ENDIF
5568
5569IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
5570 .NOT.ASSOCIATED(this%volanaattrd)) THEN
5571 CALL vol7d_force_alloc_ana(this, ini)
5572 ALLOCATE(this%volanaattrd(SIZE(this%ana), SIZE(this%anavarattr%d), &
5573 SIZE(this%network), SIZE(this%anaattr%d)))
5574 IF (linivol) this%volanaattrd(:,:,:,:) = rdmiss
5575ENDIF
5576
5577IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
5578 .NOT.ASSOCIATED(this%volanaattri)) THEN
5579 CALL vol7d_force_alloc_ana(this, ini)
5580 ALLOCATE(this%volanaattri(SIZE(this%ana), SIZE(this%anavarattr%i), &
5581 SIZE(this%network), SIZE(this%anaattr%i)))
5582 IF (linivol) this%volanaattri(:,:,:,:) = imiss
5583ENDIF
5584
5585IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
5586 .NOT.ASSOCIATED(this%volanaattrb)) THEN
5587 CALL vol7d_force_alloc_ana(this, ini)
5588 ALLOCATE(this%volanaattrb(SIZE(this%ana), SIZE(this%anavarattr%b), &
5589 SIZE(this%network), SIZE(this%anaattr%b)))
5590 IF (linivol) this%volanaattrb(:,:,:,:) = ibmiss
5591ENDIF
5592
5593IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
5594 .NOT.ASSOCIATED(this%volanaattrc)) THEN
5595 CALL vol7d_force_alloc_ana(this, ini)
5596 ALLOCATE(this%volanaattrc(SIZE(this%ana), SIZE(this%anavarattr%c), &
5597 SIZE(this%network), SIZE(this%anaattr%c)))
5598 IF (linivol) this%volanaattrc(:,:,:,:) = cmiss
5599ENDIF
5600
5601! Dati
5602IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
5603 CALL vol7d_force_alloc_dati(this, ini)
5604 ALLOCATE(this%voldatir(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
5605 SIZE(this%timerange), SIZE(this%dativar%r), SIZE(this%network)))
5606 IF (linivol) this%voldatir(:,:,:,:,:,:) = rmiss
5607ENDIF
5608
5609IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
5610 CALL vol7d_force_alloc_dati(this, ini)
5611 ALLOCATE(this%voldatid(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
5612 SIZE(this%timerange), SIZE(this%dativar%d), SIZE(this%network)))
5613 IF (linivol) this%voldatid(:,:,:,:,:,:) = rdmiss
5614ENDIF
5615
5616IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
5617 CALL vol7d_force_alloc_dati(this, ini)
5618 ALLOCATE(this%voldatii(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
5619 SIZE(this%timerange), SIZE(this%dativar%i), SIZE(this%network)))
5620 IF (linivol) this%voldatii(:,:,:,:,:,:) = imiss
5621ENDIF
5622
5623IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
5624 CALL vol7d_force_alloc_dati(this, ini)
5625 ALLOCATE(this%voldatib(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
5626 SIZE(this%timerange), SIZE(this%dativar%b), SIZE(this%network)))
5627 IF (linivol) this%voldatib(:,:,:,:,:,:) = ibmiss
5628ENDIF
5629
5630IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
5631 CALL vol7d_force_alloc_dati(this, ini)
5632 ALLOCATE(this%voldatic(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
5633 SIZE(this%timerange), SIZE(this%dativar%c), SIZE(this%network)))
5634 IF (linivol) this%voldatic(:,:,:,:,:,:) = cmiss
5635ENDIF
5636
5637! Attributi dei dati
5638IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
5639 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
5640 CALL vol7d_force_alloc_dati(this, ini)
5641 ALLOCATE(this%voldatiattrr(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
5642 SIZE(this%timerange), SIZE(this%dativarattr%r), SIZE(this%network), &
5643 SIZE(this%datiattr%r)))
5644 IF (linivol) this%voldatiattrr(:,:,:,:,:,:,:) = rmiss
5645ENDIF
5646
5647IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
5648 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
5649 CALL vol7d_force_alloc_dati(this, ini)
5650 ALLOCATE(this%voldatiattrd(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
5651 SIZE(this%timerange), SIZE(this%dativarattr%d), SIZE(this%network), &
5652 SIZE(this%datiattr%d)))
5653 IF (linivol) this%voldatiattrd(:,:,:,:,:,:,:) = rdmiss
5654ENDIF
5655
5656IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
5657 .NOT.ASSOCIATED(this%voldatiattri)) THEN
5658 CALL vol7d_force_alloc_dati(this, ini)
5659 ALLOCATE(this%voldatiattri(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
5660 SIZE(this%timerange), SIZE(this%dativarattr%i), SIZE(this%network), &
5661 SIZE(this%datiattr%i)))
5662 IF (linivol) this%voldatiattri(:,:,:,:,:,:,:) = imiss
5663ENDIF
5664
5665IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
5666 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
5667 CALL vol7d_force_alloc_dati(this, ini)
5668 ALLOCATE(this%voldatiattrb(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
5669 SIZE(this%timerange), SIZE(this%dativarattr%b), SIZE(this%network), &
5670 SIZE(this%datiattr%b)))
5671 IF (linivol) this%voldatiattrb(:,:,:,:,:,:,:) = ibmiss
5672ENDIF
5673
5674IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
5675 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
5676 CALL vol7d_force_alloc_dati(this, ini)
5677 ALLOCATE(this%voldatiattrc(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
5678 SIZE(this%timerange), SIZE(this%dativarattr%c), SIZE(this%network), &
5679 SIZE(this%datiattr%c)))
5680 IF (linivol) this%voldatiattrc(:,:,:,:,:,:,:) = cmiss
5681ENDIF
5682
5683! Catch-all method
5684CALL vol7d_force_alloc(this)
5685
5686! Creo gli indici var-attr
5687
5688#ifdef DEBUG
5689CALL l4f_log(l4f_debug,"calling: vol7d_set_attr_ind")
5690#endif
5691
5692CALL vol7d_set_attr_ind(this)
5693
5694
5695
5696END SUBROUTINE vol7d_alloc_vol
5697
5698
5699!> Metodo per creare gli indici che associano le variabili aventi attributo
5700!! alle variabili nei relativi descrittori.
5701!! Ha senso chiamare questo metodo solo dopo che i descrittori delle variabili
5702!! e degli attributi desiderati sono stati allocati ed è stato assegnato un
5703!! valore ai relativi membri btable (vedi vol7d_var_class::vol7d_var), se
5704!! i descrittori non sono stati allocati o assegnati, il metodo non fa niente.
5705SUBROUTINE vol7d_set_attr_ind(this)
5706TYPE(vol7d),INTENT(inout) :: this !< oggetto in cui creare gli indici
5707
5708INTEGER :: i
5709
5710! real
5711IF (ASSOCIATED(this%dativar%r)) THEN
5712 IF (ASSOCIATED(this%dativarattr%r)) THEN
5713 DO i = 1, SIZE(this%dativar%r)
5714 this%dativar%r(i)%r = &
5715 firsttrue(this%dativar%r(i)%btable == this%dativarattr%r(:)%btable)
5716 ENDDO
5717 ENDIF
5718
5719 IF (ASSOCIATED(this%dativarattr%d)) THEN
5720 DO i = 1, SIZE(this%dativar%r)
5721 this%dativar%r(i)%d = &
5722 firsttrue(this%dativar%r(i)%btable == this%dativarattr%d(:)%btable)
5723 ENDDO
5724 ENDIF
5725
5726 IF (ASSOCIATED(this%dativarattr%i)) THEN
5727 DO i = 1, SIZE(this%dativar%r)
5728 this%dativar%r(i)%i = &
5729 firsttrue(this%dativar%r(i)%btable == this%dativarattr%i(:)%btable)
5730 ENDDO
5731 ENDIF
5732
5733 IF (ASSOCIATED(this%dativarattr%b)) THEN
5734 DO i = 1, SIZE(this%dativar%r)
5735 this%dativar%r(i)%b = &
5736 firsttrue(this%dativar%r(i)%btable == this%dativarattr%b(:)%btable)
5737 ENDDO
5738 ENDIF
5739
5740 IF (ASSOCIATED(this%dativarattr%c)) THEN
5741 DO i = 1, SIZE(this%dativar%r)
5742 this%dativar%r(i)%c = &
5743 firsttrue(this%dativar%r(i)%btable == this%dativarattr%c(:)%btable)
5744 ENDDO
5745 ENDIF
5746ENDIF
5747! double
5748IF (ASSOCIATED(this%dativar%d)) THEN
5749 IF (ASSOCIATED(this%dativarattr%r)) THEN
5750 DO i = 1, SIZE(this%dativar%d)
5751 this%dativar%d(i)%r = &
5752 firsttrue(this%dativar%d(i)%btable == this%dativarattr%r(:)%btable)
5753 ENDDO
5754 ENDIF
5755
5756 IF (ASSOCIATED(this%dativarattr%d)) THEN
5757 DO i = 1, SIZE(this%dativar%d)
5758 this%dativar%d(i)%d = &
5759 firsttrue(this%dativar%d(i)%btable == this%dativarattr%d(:)%btable)
5760 ENDDO
5761 ENDIF
5762
5763 IF (ASSOCIATED(this%dativarattr%i)) THEN
5764 DO i = 1, SIZE(this%dativar%d)
5765 this%dativar%d(i)%i = &
5766 firsttrue(this%dativar%d(i)%btable == this%dativarattr%i(:)%btable)
5767 ENDDO
5768 ENDIF
5769
5770 IF (ASSOCIATED(this%dativarattr%b)) THEN
5771 DO i = 1, SIZE(this%dativar%d)
5772 this%dativar%d(i)%b = &
5773 firsttrue(this%dativar%d(i)%btable == this%dativarattr%b(:)%btable)
5774 ENDDO
5775 ENDIF
5776
5777 IF (ASSOCIATED(this%dativarattr%c)) THEN
5778 DO i = 1, SIZE(this%dativar%d)
5779 this%dativar%d(i)%c = &
5780 firsttrue(this%dativar%d(i)%btable == this%dativarattr%c(:)%btable)
5781 ENDDO
5782 ENDIF
5783ENDIF
5784! integer
5785IF (ASSOCIATED(this%dativar%i)) THEN
5786 IF (ASSOCIATED(this%dativarattr%r)) THEN
5787 DO i = 1, SIZE(this%dativar%i)
5788 this%dativar%i(i)%r = &
5789 firsttrue(this%dativar%i(i)%btable == this%dativarattr%r(:)%btable)
5790 ENDDO
5791 ENDIF
5792
5793 IF (ASSOCIATED(this%dativarattr%d)) THEN
5794 DO i = 1, SIZE(this%dativar%i)
5795 this%dativar%i(i)%d = &
5796 firsttrue(this%dativar%i(i)%btable == this%dativarattr%d(:)%btable)
5797 ENDDO
5798 ENDIF
5799
5800 IF (ASSOCIATED(this%dativarattr%i)) THEN
5801 DO i = 1, SIZE(this%dativar%i)
5802 this%dativar%i(i)%i = &
5803 firsttrue(this%dativar%i(i)%btable == this%dativarattr%i(:)%btable)
5804 ENDDO
5805 ENDIF
5806
5807 IF (ASSOCIATED(this%dativarattr%b)) THEN
5808 DO i = 1, SIZE(this%dativar%i)
5809 this%dativar%i(i)%b = &
5810 firsttrue(this%dativar%i(i)%btable == this%dativarattr%b(:)%btable)
5811 ENDDO
5812 ENDIF
5813
5814 IF (ASSOCIATED(this%dativarattr%c)) THEN
5815 DO i = 1, SIZE(this%dativar%i)
5816 this%dativar%i(i)%c = &
5817 firsttrue(this%dativar%i(i)%btable == this%dativarattr%c(:)%btable)
5818 ENDDO
5819 ENDIF
5820ENDIF
5821! byte
5822IF (ASSOCIATED(this%dativar%b)) THEN
5823 IF (ASSOCIATED(this%dativarattr%r)) THEN
5824 DO i = 1, SIZE(this%dativar%b)
5825 this%dativar%b(i)%r = &
5826 firsttrue(this%dativar%b(i)%btable == this%dativarattr%r(:)%btable)
5827 ENDDO
5828 ENDIF
5829
5830 IF (ASSOCIATED(this%dativarattr%d)) THEN
5831 DO i = 1, SIZE(this%dativar%b)
5832 this%dativar%b(i)%d = &
5833 firsttrue(this%dativar%b(i)%btable == this%dativarattr%d(:)%btable)
5834 ENDDO
5835 ENDIF
5836
5837 IF (ASSOCIATED(this%dativarattr%i)) THEN
5838 DO i = 1, SIZE(this%dativar%b)
5839 this%dativar%b(i)%i = &
5840 firsttrue(this%dativar%b(i)%btable == this%dativarattr%i(:)%btable)
5841 ENDDO
5842 ENDIF
5843
5844 IF (ASSOCIATED(this%dativarattr%b)) THEN
5845 DO i = 1, SIZE(this%dativar%b)
5846 this%dativar%b(i)%b = &
5847 firsttrue(this%dativar%b(i)%btable == this%dativarattr%b(:)%btable)
5848 ENDDO
5849 ENDIF
5850
5851 IF (ASSOCIATED(this%dativarattr%c)) THEN
5852 DO i = 1, SIZE(this%dativar%b)
5853 this%dativar%b(i)%c = &
5854 firsttrue(this%dativar%b(i)%btable == this%dativarattr%c(:)%btable)
5855 ENDDO
5856 ENDIF
5857ENDIF
5858! character
5859IF (ASSOCIATED(this%dativar%c)) THEN
5860 IF (ASSOCIATED(this%dativarattr%r)) THEN
5861 DO i = 1, SIZE(this%dativar%c)
5862 this%dativar%c(i)%r = &
5863 firsttrue(this%dativar%c(i)%btable == this%dativarattr%r(:)%btable)
5864 ENDDO
5865 ENDIF
5866
5867 IF (ASSOCIATED(this%dativarattr%d)) THEN
5868 DO i = 1, SIZE(this%dativar%c)
5869 this%dativar%c(i)%d = &
5870 firsttrue(this%dativar%c(i)%btable == this%dativarattr%d(:)%btable)
5871 ENDDO
5872 ENDIF
5873
5874 IF (ASSOCIATED(this%dativarattr%i)) THEN
5875 DO i = 1, SIZE(this%dativar%c)
5876 this%dativar%c(i)%i = &
5877 firsttrue(this%dativar%c(i)%btable == this%dativarattr%i(:)%btable)
5878 ENDDO
5879 ENDIF
5880
5881 IF (ASSOCIATED(this%dativarattr%b)) THEN
5882 DO i = 1, SIZE(this%dativar%c)
5883 this%dativar%c(i)%b = &
5884 firsttrue(this%dativar%c(i)%btable == this%dativarattr%b(:)%btable)
5885 ENDDO
5886 ENDIF
5887
5888 IF (ASSOCIATED(this%dativarattr%c)) THEN
5889 DO i = 1, SIZE(this%dativar%c)
5890 this%dativar%c(i)%c = &
5891 firsttrue(this%dativar%c(i)%btable == this%dativarattr%c(:)%btable)
5892 ENDDO
5893 ENDIF
5894ENDIF
5895
5896END SUBROUTINE vol7d_set_attr_ind
5897
5898
5899!> Metodo per fondere 2 oggetti vol7d.
5900!! Il secondo volume viene accodato al primo e poi distrutto, si veda
5901!! quindi la descrizione di ::vol7d_append. Se uno degli oggetti \a
5902!! this o \a that sono vuoti non perde tempo inutile,
5903SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
5904 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
5905TYPE(vol7d),INTENT(INOUT) :: this !< primo oggetto in ingresso, alla fine conterrà il risultato della fusione
5906TYPE(vol7d),INTENT(INOUT) :: that !< secondo oggetto in ingresso, alla fine sarà distrutto
5907LOGICAL,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
5908LOGICAL,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
5909LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple ! experimental, please do not use outside the library now
5910
5911TYPE(vol7d) :: v7d_clean
5912
5913
5915 this = that
5917 that = v7d_clean ! destroy that without deallocating
5918ELSE ! Append that to this and destroy that
5920 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
5922ENDIF
5923
5924END SUBROUTINE vol7d_merge
5925
5926
5927!> Metodo per accodare un oggetto vol7d ad un altro.
5928!! Si tratta di un metodo molto potente e versatile;
5929!! i descrittori delle dimensioni del volume finale conterranno i valori
5930!! dei corrispondenti descrittori del primo e del secondo volume
5931!! e i volumi di anagrafica e dati conterranno i valori dei due volumi
5932!! ai posti giusti, e valori mancanti per le nuove combinazioni che
5933!! eventualmente si verranno a creare.
5934!! Se i volumi multidimensionali di anagrafica e/o dati dei 2 oggetti
5935!! hanno un'intersezione non nulla, negli elementi comuni il volume finale
5936!! conterrà il corrispondente elemento del \b secondo volume.
5937!! Attenzione che, durante l'esecuzione del metodo, la memoria richiesta è
5938!! pari alla memoria complessiva occupata dai 2 volumi iniziali più
5939!! la memoria complessiva del volume finale, per cui, nel caso di volumi grandi,
5940!! ci potrebbero essere problemi di esaurimento della memoria centrale.
5941!! Se l'oggetto \a that è vuoto non perde tempo inutile,
5942!!
5943!! \todo nel caso di elementi comuni inserire la possibiità (opzionale per
5944!! non penalizzare le prestazioni quando ciò non serve) di effettuare una scelta
5945!! più ragionata dell'elemento da tenere, almeno controllando i dati mancanti
5946!! se non le flag di qualità
5947!!
5948!! \todo "rateizzare" l'allocazione dei volumi per ridurre l'occupazione di
5949!! memoria nel caso siano allocati contemporaneamente volumi di variabili e
5950!! di attributi o più volumi di tipi diversi
5951!!
5952!! \todo il parametro \a that è dichiarato \a INOUT perché la vol7d_alloc_vol
5953!! può modificarlo, bisognerebbe implementare una vol7d_check_vol che restituisca
5954!! errore anziché usare la vol7d_alloc_vol.
5955SUBROUTINE vol7d_append(this, that, sort, bestdata, &
5956 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
5957TYPE(vol7d),INTENT(INOUT) :: this !< primo oggetto in ingresso, a cui sarà accodato il secondo
5958TYPE(vol7d),INTENT(IN) :: that !< secondo oggetto in ingresso, non viene modificato dal metodo
5959LOGICAL,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
5960! experimental, please do not use outside the library now, they force the use
5961! of a simplified mapping algorithm which is valid only whene the dimension
5962! content is the same in both volumes , or when one of them is empty
5963LOGICAL,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
5964LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple
5965
5966
5967TYPE(vol7d) :: v7dtmp
5968LOGICAL :: lsort, lbestdata
5969INTEGER,POINTER :: remapt1(:), remapt2(:), remaptr1(:), remaptr2(:), &
5970 remapl1(:), remapl2(:), remapa1(:), remapa2(:), remapn1(:), remapn2(:)
5971
5973IF (.NOT.vol7d_check_vol(that)) RETURN ! be safe
5976 RETURN
5977ENDIF
5978
5979IF (this%time_definition /= that%time_definition) THEN
5980 CALL l4f_log(l4f_fatal, &
5981 'in vol7d_append, cannot append volumes with different &
5982 &time definition')
5983 CALL raise_fatal_error()
5984ENDIF
5985
5986! Completo l'allocazione per avere volumi a norma
5987CALL vol7d_alloc_vol(this)
5988
5992
5993! Calcolo le mappature tra volumi vecchi e volume nuovo
5994! I puntatori remap* vengono tutti o allocati o nullificati
5995IF (optio_log(ltimesimple)) THEN
5996 CALL vol7d_remap2simple_datetime(this%time, that%time, v7dtmp%time, &
5997 lsort, remapt1, remapt2)
5998ELSE
5999 CALL vol7d_remap2_datetime(this%time, that%time, v7dtmp%time, &
6000 lsort, remapt1, remapt2)
6001ENDIF
6002IF (optio_log(ltimerangesimple)) THEN
6003 CALL vol7d_remap2simple_vol7d_timerange(this%timerange, that%timerange, &
6004 v7dtmp%timerange, lsort, remaptr1, remaptr2)
6005ELSE
6006 CALL vol7d_remap2_vol7d_timerange(this%timerange, that%timerange, &
6007 v7dtmp%timerange, lsort, remaptr1, remaptr2)
6008ENDIF
6009IF (optio_log(llevelsimple)) THEN
6010 CALL vol7d_remap2simple_vol7d_level(this%level, that%level, v7dtmp%level, &
6011 lsort, remapl1, remapl2)
6012ELSE
6013 CALL vol7d_remap2_vol7d_level(this%level, that%level, v7dtmp%level, &
6014 lsort, remapl1, remapl2)
6015ENDIF
6016IF (optio_log(lanasimple)) THEN
6017 CALL vol7d_remap2simple_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
6018 .false., remapa1, remapa2)
6019ELSE
6020 CALL vol7d_remap2_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
6021 .false., remapa1, remapa2)
6022ENDIF
6023IF (optio_log(lnetworksimple)) THEN
6024 CALL vol7d_remap2simple_vol7d_network(this%network, that%network, v7dtmp%network, &
6025 .false., remapn1, remapn2)
6026ELSE
6027 CALL vol7d_remap2_vol7d_network(this%network, that%network, v7dtmp%network, &
6028 .false., remapn1, remapn2)
6029ENDIF
6030
6031! Faccio la fusione fisica dei volumi
6032CALL vol7d_merge_finalr(this, that, v7dtmp, &
6033 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
6034 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
6035CALL vol7d_merge_finald(this, that, v7dtmp, &
6036 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
6037 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
6038CALL vol7d_merge_finali(this, that, v7dtmp, &
6039 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
6040 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
6041CALL vol7d_merge_finalb(this, that, v7dtmp, &
6042 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
6043 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
6044CALL vol7d_merge_finalc(this, that, v7dtmp, &
6045 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
6046 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
6047
6048! Dealloco i vettori di rimappatura
6049IF (ASSOCIATED(remapt1)) DEALLOCATE(remapt1)
6050IF (ASSOCIATED(remapt2)) DEALLOCATE(remapt2)
6051IF (ASSOCIATED(remaptr1)) DEALLOCATE(remaptr1)
6052IF (ASSOCIATED(remaptr2)) DEALLOCATE(remaptr2)
6053IF (ASSOCIATED(remapl1)) DEALLOCATE(remapl1)
6054IF (ASSOCIATED(remapl2)) DEALLOCATE(remapl2)
6055IF (ASSOCIATED(remapa1)) DEALLOCATE(remapa1)
6056IF (ASSOCIATED(remapa2)) DEALLOCATE(remapa2)
6057IF (ASSOCIATED(remapn1)) DEALLOCATE(remapn1)
6058IF (ASSOCIATED(remapn2)) DEALLOCATE(remapn2)
6059
6060! Distruggo il vecchio volume e assegno il nuovo a this
6062this = v7dtmp
6063! Ricreo gli indici var-attr
6064CALL vol7d_set_attr_ind(this)
6065
6066END SUBROUTINE vol7d_append
6067
6068
6069!> Metodo per creare una copia completa e indipendente di un oggetto vol7d.
6070!! Questo metodo crea un duplicato di tutti i membri di un oggetto vol7d,
6071!! con la possibilità di rielaborarlo durante la copia. Se l'oggetto da copiare
6072!! è vuoto non perde tempo inutile.
6073!! Attenzione, il codice:
6074!! \code
6075!! USE vol7d_class
6076!! TYPE(vol7d) :: vol1, vol2
6077!! CALL init(vol1)
6078!! CALL init(vol2)
6079!! ... ! riempio vol1
6080!! vol2 = vol1
6081!! \endcode
6082!! fa una cosa diversa rispetto a:
6083!! \code
6084!! USE vol7d_class
6085!! TYPE(vol7d) :: vol1, vol2
6086!! CALL init(vol1)
6087!! CALL init(vol2)
6088!! ... ! riempio vol1
6089!! CALL vol7d_copy(vol1, vol2)
6090!! \endcode
6091!! nel primo caso, infatti, l'operatore di assegnazione copia solo i componenti
6092!! statici di \a vol1 nei corrispondenti elementi di \a vol2, mentre i componenti che
6093!! sono allocati dinamicamente (cioè quelli che in ::vol7d hanno l'attributo
6094!! \c POINTER, in pratica quasi tutti) non vengono duplicati, ma per essi vol2
6095!! conterrà un puntatore al corrispondente elemento a cui già punta vol1, e quindi
6096!! eventuali cambiamenti al contenuto di uno dei due oggetti influenzerà il
6097!! contenuto dell'altro; nel secondo caso, invece, vol1 e vol2 sono, dopo la
6098!! vol7d_copy, 2 istanze
6099!! completamente indipendenti, ma uguali tra loro per contenuto, della classe
6100!! vol7d, e quindi hanno vita indipendente.
6101SUBROUTINE vol7d_copy(this, that, sort, unique, miss, &
6102 lsort_time, lsort_timerange, lsort_level, &
6103 ltime, ltimerange, llevel, lana, lnetwork, &
6104 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
6105 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
6106 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
6107 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
6108 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
6109 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
6110TYPE(vol7d),INTENT(IN) :: this !< oggetto origine
6111TYPE(vol7d),INTENT(INOUT) :: that !< oggetto destinazione
6112LOGICAL,INTENT(IN),OPTIONAL :: sort !< if present and \a .TRUE., sort all the sortable dimensions
6113LOGICAL,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)
6114LOGICAL,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
6115LOGICAL,INTENT(IN),OPTIONAL :: lsort_time !< if present and \a .TRUE., sort only time dimension (alternative to \a sort )
6116LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange !< if present and \a .TRUE., sort only timerange dimension (alternative to \a sort )
6117LOGICAL,INTENT(IN),OPTIONAL :: lsort_level !< if present and \a .TRUE., sort only level dimension (alternative to \a sort )
6118!> se fornito, deve essere un vettore logico della stessa lunghezza di
6119!! this%time indicante quali elementi della dimensione \a time
6120!! mantenere (valori \c .TRUE.) e quali scartare (valori \c .FALSE.)
6121!! nel volume copiato; in alternativa può essere un vettore di
6122!! lunghezza 1, in tal caso, se \c .FALSE. , equivale a scartare tutti
6123!! gli elementi (utile principalmente per le variabili); è compatibile
6124!! col parametro \a miss
6125LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
6126!> come il precedente per la dimensione \a timerange
6127LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
6128!> come il precedente per la dimensione \a level
6129LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
6130!> come il precedente per la dimensione \a ana
6131LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
6132!> come il precedente per la dimensione \a network
6133LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
6134!> come il precedente per tutte le possibili dimensioni variabile
6135LOGICAL,INTENT(in),OPTIONAL :: &
6136 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
6137 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
6138 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
6139 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
6140 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
6141 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
6142
6143LOGICAL :: lsort, lunique, lmiss
6144INTEGER,POINTER :: remapt(:), remaptr(:), remapl(:), remapa(:), remapn(:)
6145
6148IF (.NOT.vol7d_check_vol(this)) RETURN ! be safe
6149
6153
6154! Calcolo le mappature tra volume vecchio e volume nuovo
6155! I puntatori remap* vengono tutti o allocati o nullificati
6156CALL vol7d_remap1_datetime(this%time, that%time, &
6157 lsort.OR.optio_log(lsort_time), lunique, lmiss, remapt, ltime)
6158CALL vol7d_remap1_vol7d_timerange(this%timerange, that%timerange, &
6159 lsort.OR.optio_log(lsort_timerange), lunique, lmiss, remaptr, ltimerange)
6160CALL vol7d_remap1_vol7d_level(this%level, that%level, &
6161 lsort.OR.optio_log(lsort_level), lunique, lmiss, remapl, llevel)
6162CALL vol7d_remap1_vol7d_ana(this%ana, that%ana, &
6163 lsort, lunique, lmiss, remapa, lana)
6164CALL vol7d_remap1_vol7d_network(this%network, that%network, &
6165 lsort, lunique, lmiss, remapn, lnetwork)
6166
6167! lanavari, lanavarb, lanavarc, &
6168! lanaattri, lanaattrb, lanaattrc, &
6169! lanavarattri, lanavarattrb, lanavarattrc, &
6170! ldativari, ldativarb, ldativarc, &
6171! ldatiattri, ldatiattrb, ldatiattrc, &
6172! ldativarattri, ldativarattrb, ldativarattrc
6173! Faccio la riforma fisica dei volumi
6174CALL vol7d_reform_finalr(this, that, &
6175 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
6176 lanavarr, lanaattrr, lanavarattrr, ldativarr, ldatiattrr, ldativarattrr)
6177CALL vol7d_reform_finald(this, that, &
6178 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
6179 lanavard, lanaattrd, lanavarattrd, ldativard, ldatiattrd, ldativarattrd)
6180CALL vol7d_reform_finali(this, that, &
6181 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
6182 lanavari, lanaattri, lanavarattri, ldativari, ldatiattri, ldativarattri)
6183CALL vol7d_reform_finalb(this, that, &
6184 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
6185 lanavarb, lanaattrb, lanavarattrb, ldativarb, ldatiattrb, ldativarattrb)
6186CALL vol7d_reform_finalc(this, that, &
6187 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
6188 lanavarc, lanaattrc, lanavarattrc, ldativarc, ldatiattrc, ldativarattrc)
6189
6190! Dealloco i vettori di rimappatura
6191IF (ASSOCIATED(remapt)) DEALLOCATE(remapt)
6192IF (ASSOCIATED(remaptr)) DEALLOCATE(remaptr)
6193IF (ASSOCIATED(remapl)) DEALLOCATE(remapl)
6194IF (ASSOCIATED(remapa)) DEALLOCATE(remapa)
6195IF (ASSOCIATED(remapn)) DEALLOCATE(remapn)
6196
6197! Ricreo gli indici var-attr
6198CALL vol7d_set_attr_ind(that)
6199that%time_definition = this%time_definition
6200
6201END SUBROUTINE vol7d_copy
6202
6203
6204!> Metodo per riformare in varie maniere un oggetto vol7d.
6205!! Equivale ad una copia (vedi ::vol7d_copy)
6206!! seguita dalla distruzione del volume iniziale e alla
6207!! sua riassegnazione al volume copiato. Ha senso se almeno uno dei parametri
6208!! \a sort, \a uniq o \a miss è fornito uguale a \c .TRUE., altrimenti
6209!! è solo una perdita di tempo.
6210!! Può essere utile, ad esempio, per eliminare stazioni
6211!! o istanti temporali indesiderati, basta assegnare il loro corrispondente
6212!! elemento del descrittore a valore mancante e chiamare vol7d_reform
6213!! con miss=.TRUE. .
6214SUBROUTINE vol7d_reform(this, sort, unique, miss, &
6215 lsort_time, lsort_timerange, lsort_level, &
6216 ltime, ltimerange, llevel, lana, lnetwork, &
6217 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
6218 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
6219 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
6220 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
6221 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
6222 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc&
6223 ,purgeana)
6224TYPE(vol7d),INTENT(INOUT) :: this !< oggetto da riformare
6225LOGICAL,INTENT(IN),OPTIONAL :: sort !< if present and \a .TRUE., sort all the sortable dimensions
6226LOGICAL,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)
6227LOGICAL,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
6228LOGICAL,INTENT(IN),OPTIONAL :: lsort_time !< if present and \a .TRUE., sort only time dimension (alternative to \a sort )
6229LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange !< if present and \a .TRUE., sort only timerange dimension (alternative to \a sort )
6230LOGICAL,INTENT(IN),OPTIONAL :: lsort_level !< if present and \a .TRUE., sort only level dimension (alternative to \a sort )
6231!> se fornito, deve essere un vettore logico della stessa lunghezza di
6232!! this%time indicante quali elementi della dimensione \a time
6233!! mantenere (valori \c .TRUE.) e quali scartare (valori \c .FALSE.)
6234!! nel volume copiato; in alternativa può essere un vettore di
6235!! lunghezza 1, in tal caso, se \c .FALSE. , equivale a scartare tutti
6236!! gli elementi (utile principalmente per le variabili); è compatibile
6237!! col parametro \a miss
6238LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
6239LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:) !< come il precedente per la dimensione \a timerange
6240LOGICAL,INTENT(IN),OPTIONAL :: llevel(:) !< come il precedente per la dimensione \a level
6241LOGICAL,INTENT(IN),OPTIONAL :: lana(:) !< come il precedente per la dimensione \a ana
6242LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:) !< come il precedente per la dimensione \a network
6243!> come il precedente per tutte le possibili dimensioni variabile
6244LOGICAL,INTENT(in),OPTIONAL :: &
6245 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
6246 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
6247 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
6248 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
6249 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
6250 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
6251LOGICAL,INTENT(IN),OPTIONAL :: purgeana !< if true remove ana with all data missing
6252
6253TYPE(vol7d) :: v7dtmp
6254logical,allocatable :: llana(:)
6255integer :: i
6256
6258 lsort_time, lsort_timerange, lsort_level, &
6259 ltime, ltimerange, llevel, lana, lnetwork, &
6260 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
6261 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
6262 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
6263 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
6264 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
6265 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
6266
6267! destroy old volume
6269
6270if (optio_log(purgeana)) then
6271 allocate(llana(size(v7dtmp%ana)))
6272 llana =.false.
6273 do i =1,size(v7dtmp%ana)
6274 if (associated(v7dtmp%voldatii)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatii(i,:,:,:,:,:)))
6275 if (associated(v7dtmp%voldatir)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatir(i,:,:,:,:,:)))
6276 if (associated(v7dtmp%voldatid)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatid(i,:,:,:,:,:)))
6277 if (associated(v7dtmp%voldatib)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatib(i,:,:,:,:,:)))
6278 if (associated(v7dtmp%voldatic)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatic(i,:,:,:,:,:)))
6279 end do
6280 CALL vol7d_copy(v7dtmp, this,lana=llana)
6282 deallocate(llana)
6283else
6284 this=v7dtmp
6285end if
6286
6287END SUBROUTINE vol7d_reform
6288
6289
6290!> Sorts the sortable dimensions in the volume \a this only when necessary.
6291!! Most of the times, the time, timerange and level dimensions in a
6292!! vol7d object are correctly sorted; on the other side many methods
6293!! strictly rely on this fact in order to work correctly. This method
6294!! performs a quick check and sorts the required dimensions only if
6295!! they are not sorted in ascending order yet, improving safety
6296!! without impairing much performance.
6297SUBROUTINE vol7d_smart_sort(this, lsort_time, lsort_timerange, lsort_level)
6298TYPE(vol7d),INTENT(INOUT) :: this !< object to be sorted
6299LOGICAL,OPTIONAL,INTENT(in) :: lsort_time !< if present and \a .TRUE., sort time dimension if it is not sorted in ascending order
6300LOGICAL,OPTIONAL,INTENT(in) :: lsort_timerange !< if present and \a .TRUE., sort timerange dimension if it is not sorted in ascending order
6301LOGICAL,OPTIONAL,INTENT(in) :: lsort_level !< if present and \a .TRUE., sort vertical level dimension if it is not sorted in ascending order
6302
6303INTEGER :: i
6304LOGICAL :: to_be_sorted
6305
6306to_be_sorted = .false.
6307CALL vol7d_alloc_vol(this) ! usual safety check
6308
6309IF (optio_log(lsort_time)) THEN
6310 DO i = 2, SIZE(this%time)
6311 IF (this%time(i) < this%time(i-1)) THEN
6312 to_be_sorted = .true.
6313 EXIT
6314 ENDIF
6315 ENDDO
6316ENDIF
6317IF (optio_log(lsort_timerange)) THEN
6318 DO i = 2, SIZE(this%timerange)
6319 IF (this%timerange(i) < this%timerange(i-1)) THEN
6320 to_be_sorted = .true.
6321 EXIT
6322 ENDIF
6323 ENDDO
6324ENDIF
6325IF (optio_log(lsort_level)) THEN
6326 DO i = 2, SIZE(this%level)
6327 IF (this%level(i) < this%level(i-1)) THEN
6328 to_be_sorted = .true.
6329 EXIT
6330 ENDIF
6331 ENDDO
6332ENDIF
6333
6334IF (to_be_sorted) CALL vol7d_reform(this, &
6335 lsort_time=lsort_time, lsort_timerange=lsort_timerange, lsort_level=lsort_level )
6336
6337END SUBROUTINE vol7d_smart_sort
6338
6339!> Filter the contents of a volume keeping only desired data.
6340!! This subroutine filters a vol7d object by keeping only a subset of
6341!! the data contained. It can keep only times within a specified
6342!! interval, only station networks contained in a list and only
6343!! specified station or data variables. If a filter parameter is not
6344!! provided, no filtering will take place according to that criterion.
6345!! The volume is reallocated keeping only the desired data.
6346SUBROUTINE vol7d_filter(this, avl, vl, nl, s_d, e_d)
6347TYPE(vol7d),INTENT(inout) :: this !< volume to be filtered
6348CHARACTER(len=*),INTENT(in),OPTIONAL :: avl(:) !< list of station variables to be kept, if not provided or of zero length, all variables are kept
6349CHARACTER(len=*),INTENT(in),OPTIONAL :: vl(:) !< list of data variables to be kept, if not provided or of zero length, all variables are kept
6350TYPE(vol7d_network),OPTIONAL :: nl(:) !< list of station networks to be kept, if not provided or of zero length, all networks are kept
6351TYPE(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
6352TYPE(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
6353
6354INTEGER :: i
6355
6356IF (PRESENT(avl)) THEN
6357 IF (SIZE(avl) > 0) THEN
6358
6359 IF (ASSOCIATED(this%anavar%r)) THEN
6360 DO i = 1, SIZE(this%anavar%r)
6361 IF (all(this%anavar%r(i)%btable /= avl)) this%anavar%r(i) = vol7d_var_miss
6362 ENDDO
6363 ENDIF
6364
6365 IF (ASSOCIATED(this%anavar%i)) THEN
6366 DO i = 1, SIZE(this%anavar%i)
6367 IF (all(this%anavar%i(i)%btable /= avl)) this%anavar%i(i) = vol7d_var_miss
6368 ENDDO
6369 ENDIF
6370
6371 IF (ASSOCIATED(this%anavar%b)) THEN
6372 DO i = 1, SIZE(this%anavar%b)
6373 IF (all(this%anavar%b(i)%btable /= avl)) this%anavar%b(i) = vol7d_var_miss
6374 ENDDO
6375 ENDIF
6376
6377 IF (ASSOCIATED(this%anavar%d)) THEN
6378 DO i = 1, SIZE(this%anavar%d)
6379 IF (all(this%anavar%d(i)%btable /= avl)) this%anavar%d(i) = vol7d_var_miss
6380 ENDDO
6381 ENDIF
6382
6383 IF (ASSOCIATED(this%anavar%c)) THEN
6384 DO i = 1, SIZE(this%anavar%c)
6385 IF (all(this%anavar%c(i)%btable /= avl)) this%anavar%c(i) = vol7d_var_miss
6386 ENDDO
6387 ENDIF
6388
6389 ENDIF
6390ENDIF
6391
6392
6393IF (PRESENT(vl)) THEN
6394 IF (size(vl) > 0) THEN
6395 IF (ASSOCIATED(this%dativar%r)) THEN
6396 DO i = 1, SIZE(this%dativar%r)
6397 IF (all(this%dativar%r(i)%btable /= vl)) this%dativar%r(i) = vol7d_var_miss
6398 ENDDO
6399 ENDIF
6400
6401 IF (ASSOCIATED(this%dativar%i)) THEN
6402 DO i = 1, SIZE(this%dativar%i)
6403 IF (all(this%dativar%i(i)%btable /= vl)) this%dativar%i(i) = vol7d_var_miss
6404 ENDDO
6405 ENDIF
6406
6407 IF (ASSOCIATED(this%dativar%b)) THEN
6408 DO i = 1, SIZE(this%dativar%b)
6409 IF (all(this%dativar%b(i)%btable /= vl)) this%dativar%b(i) = vol7d_var_miss
6410 ENDDO
6411 ENDIF
6412
6413 IF (ASSOCIATED(this%dativar%d)) THEN
6414 DO i = 1, SIZE(this%dativar%d)
6415 IF (all(this%dativar%d(i)%btable /= vl)) this%dativar%d(i) = vol7d_var_miss
6416 ENDDO
6417 ENDIF
6418
6419 IF (ASSOCIATED(this%dativar%c)) THEN
6420 DO i = 1, SIZE(this%dativar%c)
6421 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
6422 ENDDO
6423 ENDIF
6424
6425 IF (ASSOCIATED(this%dativar%c)) THEN
6426 DO i = 1, SIZE(this%dativar%c)
6427 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
6428 ENDDO
6429 ENDIF
6430
6431 ENDIF
6432ENDIF
6433
6434IF (PRESENT(nl)) THEN
6435 IF (SIZE(nl) > 0) THEN
6436 DO i = 1, SIZE(this%network)
6437 IF (all(this%network(i) /= nl)) this%network(i) = vol7d_network_miss
6438 ENDDO
6439 ENDIF
6440ENDIF
6441
6442IF (PRESENT(s_d)) THEN
6444 WHERE (this%time < s_d)
6445 this%time = datetime_miss
6446 END WHERE
6447 ENDIF
6448ENDIF
6449
6450IF (PRESENT(e_d)) THEN
6452 WHERE (this%time > e_d)
6453 this%time = datetime_miss
6454 END WHERE
6455 ENDIF
6456ENDIF
6457
6458CALL vol7d_reform(this, miss=.true.)
6459
6460END SUBROUTINE vol7d_filter
6461
6462
6463!> Metodo per convertire i volumi di dati di un oggetto vol7d in dati
6464!! reali dove possibile. L'oggetto convertito è una copia completa
6465!! dell'originale che può essere quindi distrutto dopo la chiamata.
6466!! Per i dati di anagrafica, al momento sono convertiti solo
6467!! i dati CHARACTER se è passato \a anaconv=.TRUE.
6468!! Gli attributi non sono toccati.
6469SUBROUTINE vol7d_convr(this, that, anaconv)
6470TYPE(vol7d),INTENT(IN) :: this !< oggetto origine
6471TYPE(vol7d),INTENT(INOUT) :: that !< oggetto convertito
6472LOGICAL,OPTIONAL,INTENT(in) :: anaconv !< converti anche anagrafica
6473INTEGER :: i
6474LOGICAL :: fv(1)=(/.false./), tv(1)=(/.true./), acp(1), acn(1)
6475TYPE(vol7d) :: v7d_tmp
6476
6477IF (optio_log(anaconv)) THEN
6478 acp=fv
6479 acn=tv
6480ELSE
6481 acp=tv
6482 acn=fv
6483ENDIF
6484
6485! Volume con solo i dati reali e tutti gli attributi
6486! l'anagrafica e` copiata interamente se necessario
6487CALL vol7d_copy(this, that, &
6488 lanavarr=tv, lanavard=acp, lanavari=acp, lanavarb=acp, lanavarc=acp, &
6489 ldativarr=tv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=fv)
6490
6491! Volume solo di dati double
6492CALL vol7d_copy(this, v7d_tmp, &
6493 lanavarr=fv, lanavard=acn, lanavari=fv, lanavarb=fv, lanavarc=fv, &
6494 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
6495 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
6496 ldativarr=fv, ldativard=tv, ldativari=fv, ldativarb=fv, ldativarc=fv, &
6497 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
6498 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
6499
6500! converto a dati reali
6501IF (ASSOCIATED(v7d_tmp%anavar%d) .OR. ASSOCIATED(v7d_tmp%dativar%d)) THEN
6502
6503 IF (ASSOCIATED(v7d_tmp%anavar%d)) THEN
6504! alloco i dati reali e vi trasferisco i double
6505 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanad, 1), SIZE(v7d_tmp%volanad, 2), &
6506 SIZE(v7d_tmp%volanad, 3)))
6507 DO i = 1, SIZE(v7d_tmp%anavar%d)
6508 v7d_tmp%volanar(:,i,:) = &
6509 realdat(v7d_tmp%volanad(:,i,:), v7d_tmp%anavar%d(i))
6510 ENDDO
6511 DEALLOCATE(v7d_tmp%volanad)
6512! trasferisco le variabili
6513 v7d_tmp%anavar%r => v7d_tmp%anavar%d
6514 NULLIFY(v7d_tmp%anavar%d)
6515 ENDIF
6516
6517 IF (ASSOCIATED(v7d_tmp%dativar%d)) THEN
6518! alloco i dati reali e vi trasferisco i double
6519 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatid, 1), SIZE(v7d_tmp%voldatid, 2), &
6520 SIZE(v7d_tmp%voldatid, 3), SIZE(v7d_tmp%voldatid, 4), SIZE(v7d_tmp%voldatid, 5), &
6521 SIZE(v7d_tmp%voldatid, 6)))
6522 DO i = 1, SIZE(v7d_tmp%dativar%d)
6523 v7d_tmp%voldatir(:,:,:,:,i,:) = &
6524 realdat(v7d_tmp%voldatid(:,:,:,:,i,:), v7d_tmp%dativar%d(i))
6525 ENDDO
6526 DEALLOCATE(v7d_tmp%voldatid)
6527! trasferisco le variabili
6528 v7d_tmp%dativar%r => v7d_tmp%dativar%d
6529 NULLIFY(v7d_tmp%dativar%d)
6530 ENDIF
6531
6532! fondo con il volume definitivo
6533 CALL vol7d_merge(that, v7d_tmp)
6534ELSE
6536ENDIF
6537
6538
6539! Volume solo di dati interi
6540CALL vol7d_copy(this, v7d_tmp, &
6541 lanavarr=fv, lanavard=fv, lanavari=acn, lanavarb=fv, lanavarc=fv, &
6542 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
6543 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
6544 ldativarr=fv, ldativard=fv, ldativari=tv, ldativarb=fv, ldativarc=fv, &
6545 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
6546 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
6547
6548! converto a dati reali
6549IF (ASSOCIATED(v7d_tmp%anavar%i) .OR. ASSOCIATED(v7d_tmp%dativar%i)) THEN
6550
6551 IF (ASSOCIATED(v7d_tmp%anavar%i)) THEN
6552! alloco i dati reali e vi trasferisco gli interi
6553 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanai, 1), SIZE(v7d_tmp%volanai, 2), &
6554 SIZE(v7d_tmp%volanai, 3)))
6555 DO i = 1, SIZE(v7d_tmp%anavar%i)
6556 v7d_tmp%volanar(:,i,:) = &
6557 realdat(v7d_tmp%volanai(:,i,:), v7d_tmp%anavar%i(i))
6558 ENDDO
6559 DEALLOCATE(v7d_tmp%volanai)
6560! trasferisco le variabili
6561 v7d_tmp%anavar%r => v7d_tmp%anavar%i
6562 NULLIFY(v7d_tmp%anavar%i)
6563 ENDIF
6564
6565 IF (ASSOCIATED(v7d_tmp%dativar%i)) THEN
6566! alloco i dati reali e vi trasferisco gli interi
6567 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatii, 1), SIZE(v7d_tmp%voldatii, 2), &
6568 SIZE(v7d_tmp%voldatii, 3), SIZE(v7d_tmp%voldatii, 4), SIZE(v7d_tmp%voldatii, 5), &
6569 SIZE(v7d_tmp%voldatii, 6)))
6570 DO i = 1, SIZE(v7d_tmp%dativar%i)
6571 v7d_tmp%voldatir(:,:,:,:,i,:) = &
6572 realdat(v7d_tmp%voldatii(:,:,:,:,i,:), v7d_tmp%dativar%i(i))
6573 ENDDO
6574 DEALLOCATE(v7d_tmp%voldatii)
6575! trasferisco le variabili
6576 v7d_tmp%dativar%r => v7d_tmp%dativar%i
6577 NULLIFY(v7d_tmp%dativar%i)
6578 ENDIF
6579
6580! fondo con il volume definitivo
6581 CALL vol7d_merge(that, v7d_tmp)
6582ELSE
6584ENDIF
6585
6586
6587! Volume solo di dati byte
6588CALL vol7d_copy(this, v7d_tmp, &
6589 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=acn, lanavarc=fv, &
6590 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
6591 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
6592 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=tv, ldativarc=fv, &
6593 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
6594 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
6595
6596! converto a dati reali
6597IF (ASSOCIATED(v7d_tmp%anavar%b) .OR. ASSOCIATED(v7d_tmp%dativar%b)) THEN
6598
6599 IF (ASSOCIATED(v7d_tmp%anavar%b)) THEN
6600! alloco i dati reali e vi trasferisco i byte
6601 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanab, 1), SIZE(v7d_tmp%volanab, 2), &
6602 SIZE(v7d_tmp%volanab, 3)))
6603 DO i = 1, SIZE(v7d_tmp%anavar%b)
6604 v7d_tmp%volanar(:,i,:) = &
6605 realdat(v7d_tmp%volanab(:,i,:), v7d_tmp%anavar%b(i))
6606 ENDDO
6607 DEALLOCATE(v7d_tmp%volanab)
6608! trasferisco le variabili
6609 v7d_tmp%anavar%r => v7d_tmp%anavar%b
6610 NULLIFY(v7d_tmp%anavar%b)
6611 ENDIF
6612
6613 IF (ASSOCIATED(v7d_tmp%dativar%b)) THEN
6614! alloco i dati reali e vi trasferisco i byte
6615 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatib, 1), SIZE(v7d_tmp%voldatib, 2), &
6616 SIZE(v7d_tmp%voldatib, 3), SIZE(v7d_tmp%voldatib, 4), SIZE(v7d_tmp%voldatib, 5), &
6617 SIZE(v7d_tmp%voldatib, 6)))
6618 DO i = 1, SIZE(v7d_tmp%dativar%b)
6619 v7d_tmp%voldatir(:,:,:,:,i,:) = &
6620 realdat(v7d_tmp%voldatib(:,:,:,:,i,:), v7d_tmp%dativar%b(i))
6621 ENDDO
6622 DEALLOCATE(v7d_tmp%voldatib)
6623! trasferisco le variabili
6624 v7d_tmp%dativar%r => v7d_tmp%dativar%b
6625 NULLIFY(v7d_tmp%dativar%b)
6626 ENDIF
6627
6628! fondo con il volume definitivo
6629 CALL vol7d_merge(that, v7d_tmp)
6630ELSE
6632ENDIF
6633
6634
6635! Volume solo di dati character
6636CALL vol7d_copy(this, v7d_tmp, &
6637 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=fv, lanavarc=acn, &
6638 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
6639 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
6640 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=tv, &
6641 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
6642 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
6643
6644! converto a dati reali
6645IF (ASSOCIATED(v7d_tmp%anavar%c) .OR. ASSOCIATED(v7d_tmp%dativar%c)) THEN
6646
6647 IF (ASSOCIATED(v7d_tmp%anavar%c)) THEN
6648! alloco i dati reali e vi trasferisco i character
6649 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanac, 1), SIZE(v7d_tmp%volanac, 2), &
6650 SIZE(v7d_tmp%volanac, 3)))
6651 DO i = 1, SIZE(v7d_tmp%anavar%c)
6652 v7d_tmp%volanar(:,i,:) = &
6653 realdat(v7d_tmp%volanac(:,i,:), v7d_tmp%anavar%c(i))
6654 ENDDO
6655 DEALLOCATE(v7d_tmp%volanac)
6656! trasferisco le variabili
6657 v7d_tmp%anavar%r => v7d_tmp%anavar%c
6658 NULLIFY(v7d_tmp%anavar%c)
6659 ENDIF
6660
6661 IF (ASSOCIATED(v7d_tmp%dativar%c)) THEN
6662! alloco i dati reali e vi trasferisco i character
6663 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatic, 1), SIZE(v7d_tmp%voldatic, 2), &
6664 SIZE(v7d_tmp%voldatic, 3), SIZE(v7d_tmp%voldatic, 4), SIZE(v7d_tmp%voldatic, 5), &
6665 SIZE(v7d_tmp%voldatic, 6)))
6666 DO i = 1, SIZE(v7d_tmp%dativar%c)
6667 v7d_tmp%voldatir(:,:,:,:,i,:) = &
6668 realdat(v7d_tmp%voldatic(:,:,:,:,i,:), v7d_tmp%dativar%c(i))
6669 ENDDO
6670 DEALLOCATE(v7d_tmp%voldatic)
6671! trasferisco le variabili
6672 v7d_tmp%dativar%r => v7d_tmp%dativar%c
6673 NULLIFY(v7d_tmp%dativar%c)
6674 ENDIF
6675
6676! fondo con il volume definitivo
6677 CALL vol7d_merge(that, v7d_tmp)
6678ELSE
6680ENDIF
6681
6682END SUBROUTINE vol7d_convr
6683
6684
6685!> Metodo per ottenere solo le differenze tra due oggetti vol7d.
6686!! Il primo volume viene confrontato col secondo; nel secondo volume ovunque
6687!! i dati confrontati siano coincidenti viene impostato valore mancante.
6688SUBROUTINE vol7d_diff_only (this, that, data_only,ana)
6689TYPE(vol7d),INTENT(IN) :: this !< primo volume da confrontare
6690TYPE(vol7d),INTENT(OUT) :: that !< secondo volume da confrontare in cui eliminare i dati coincidenti
6691logical , optional, intent(in) :: data_only !< attiva l'elaborazione dei soli dati e non dell'anagrafica (default: .false.)
6692logical , optional, intent(in) :: ana !< attiva l'elaborazione dell'anagrafica (coordinate e ident) (default: .false.)
6693logical :: ldata_only,lana
6694
6695IF (PRESENT(data_only)) THEN
6696 ldata_only = data_only
6697ELSE
6698 ldata_only = .false.
6699ENDIF
6700
6701IF (PRESENT(ana)) THEN
6702 lana = ana
6703ELSE
6704 lana = .false.
6705ENDIF
6706
6707
6708#undef VOL7D_POLY_ARRAY
6709#define VOL7D_POLY_ARRAY voldati
6710#include "vol7d_class_diff.F90"
6711#undef VOL7D_POLY_ARRAY
6712#define VOL7D_POLY_ARRAY voldatiattr
6713#include "vol7d_class_diff.F90"
6714#undef VOL7D_POLY_ARRAY
6715
6716if ( .not. ldata_only) then
6717
6718#define VOL7D_POLY_ARRAY volana
6719#include "vol7d_class_diff.F90"
6720#undef VOL7D_POLY_ARRAY
6721#define VOL7D_POLY_ARRAY volanaattr
6722#include "vol7d_class_diff.F90"
6723#undef VOL7D_POLY_ARRAY
6724
6725 if(lana)then
6726 where ( this%ana == that%ana )
6727 that%ana = vol7d_ana_miss
6728 end where
6729 end if
6730
6731end if
6732
6733
6734
6735END SUBROUTINE vol7d_diff_only
6736
6737
6738
6739! Creo le routine da ripetere per i vari tipi di dati di v7d
6740! tramite un template e il preprocessore
6741#undef VOL7D_POLY_TYPE
6742#undef VOL7D_POLY_TYPES
6743#define VOL7D_POLY_TYPE REAL
6744#define VOL7D_POLY_TYPES r
6745#include "vol7d_class_type_templ.F90"
6746#undef VOL7D_POLY_TYPE
6747#undef VOL7D_POLY_TYPES
6748#define VOL7D_POLY_TYPE DOUBLE PRECISION
6749#define VOL7D_POLY_TYPES d
6750#include "vol7d_class_type_templ.F90"
6751#undef VOL7D_POLY_TYPE
6752#undef VOL7D_POLY_TYPES
6753#define VOL7D_POLY_TYPE INTEGER
6754#define VOL7D_POLY_TYPES i
6755#include "vol7d_class_type_templ.F90"
6756#undef VOL7D_POLY_TYPE
6757#undef VOL7D_POLY_TYPES
6758#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
6759#define VOL7D_POLY_TYPES b
6760#include "vol7d_class_type_templ.F90"
6761#undef VOL7D_POLY_TYPE
6762#undef VOL7D_POLY_TYPES
6763#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
6764#define VOL7D_POLY_TYPES c
6765#include "vol7d_class_type_templ.F90"
6766
6767! Creo le routine da ripetere per i vari descrittori di dimensioni di v7d
6768! tramite un template e il preprocessore
6769#define VOL7D_SORT
6770#undef VOL7D_NO_ZERO_ALLOC
6771#undef VOL7D_POLY_TYPE
6772#define VOL7D_POLY_TYPE datetime
6773#include "vol7d_class_desc_templ.F90"
6774#undef VOL7D_POLY_TYPE
6775#define VOL7D_POLY_TYPE vol7d_timerange
6776#include "vol7d_class_desc_templ.F90"
6777#undef VOL7D_POLY_TYPE
6778#define VOL7D_POLY_TYPE vol7d_level
6779#include "vol7d_class_desc_templ.F90"
6780#undef VOL7D_SORT
6781#undef VOL7D_POLY_TYPE
6782#define VOL7D_POLY_TYPE vol7d_network
6783#include "vol7d_class_desc_templ.F90"
6784#undef VOL7D_POLY_TYPE
6785#define VOL7D_POLY_TYPE vol7d_ana
6786#include "vol7d_class_desc_templ.F90"
6787#define VOL7D_NO_ZERO_ALLOC
6788#undef VOL7D_POLY_TYPE
6789#define VOL7D_POLY_TYPE vol7d_var
6790#include "vol7d_class_desc_templ.F90"
6791
6792!>\brief Scrittura su file di un volume Vol7d.
6793!! Scrittura su file unformatted di un intero volume Vol7d.
6794!! Il volume viene serializzato e scritto su file.
6795!! Il file puo' essere aperto opzionalmente dall'utente. Si possono passare
6796!! opzionalmente unità e nome del file altrimenti assegnati internamente a dei default; se assegnati internamente
6797!! tali parametri saranno in output.
6798!! Se non viene fornito il nome file viene utilizzato un file di default con nome pari al nome del programma in
6799!! esecuzione con postfisso ".v7d".
6800!! Come parametro opzionale c'è la description che insieme alla data corrente viene inserita nell'header del file.
6801subroutine vol7d_write_on_file (this,unit,description,filename,filename_auto)
6802
6803TYPE(vol7d),INTENT(IN) :: this !< volume vol7d da scrivere
6804integer,optional,intent(inout) :: unit !< unità su cui scrivere; se passata =0 ritorna il valore rielaborato (default =rielaborato internamente con getlun )
6805character(len=*),intent(in),optional :: filename !< nome del file su cui scrivere
6806character(len=*),intent(out),optional :: filename_auto !< nome del file generato se "filename" è omesso
6807character(len=*),INTENT(IN),optional :: description !< descrizione del volume
6808
6809integer :: lunit
6810character(len=254) :: ldescription,arg,lfilename
6811integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
6812 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
6813 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
6814 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
6815 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
6816 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
6817 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
6818!integer :: im,id,iy
6819integer :: tarray(8)
6820logical :: opened,exist
6821
6822 nana=0
6823 ntime=0
6824 ntimerange=0
6825 nlevel=0
6826 nnetwork=0
6827 ndativarr=0
6828 ndativari=0
6829 ndativarb=0
6830 ndativard=0
6831 ndativarc=0
6832 ndatiattrr=0
6833 ndatiattri=0
6834 ndatiattrb=0
6835 ndatiattrd=0
6836 ndatiattrc=0
6837 ndativarattrr=0
6838 ndativarattri=0
6839 ndativarattrb=0
6840 ndativarattrd=0
6841 ndativarattrc=0
6842 nanavarr=0
6843 nanavari=0
6844 nanavarb=0
6845 nanavard=0
6846 nanavarc=0
6847 nanaattrr=0
6848 nanaattri=0
6849 nanaattrb=0
6850 nanaattrd=0
6851 nanaattrc=0
6852 nanavarattrr=0
6853 nanavarattri=0
6854 nanavarattrb=0
6855 nanavarattrd=0
6856 nanavarattrc=0
6857
6858
6859!call idate(im,id,iy)
6860call date_and_time(values=tarray)
6861call getarg(0,arg)
6862
6863if (present(description))then
6864 ldescription=description
6865else
6866 ldescription="Vol7d generated by: "//trim(arg)
6867end if
6868
6869if (.not. present(unit))then
6870 lunit=getunit()
6871else
6872 if (unit==0)then
6873 lunit=getunit()
6874 unit=lunit
6875 else
6876 lunit=unit
6877 end if
6878end if
6879
6880lfilename=trim(arg)//".v7d"
6882
6883if (present(filename))then
6884 if (filename /= "")then
6885 lfilename=filename
6886 end if
6887end if
6888
6889if (present(filename_auto))filename_auto=lfilename
6890
6891
6892inquire(unit=lunit,opened=opened)
6893if (.not. opened) then
6894! inquire(file=lfilename, EXIST=exist)
6895! IF (exist) THEN
6896! CALL l4f_log(L4F_FATAL, &
6897! 'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename))
6898! CALL raise_fatal_error()
6899! ENDIF
6900 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM')
6901 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
6902end if
6903
6904if (associated(this%ana)) nana=size(this%ana)
6905if (associated(this%time)) ntime=size(this%time)
6906if (associated(this%timerange)) ntimerange=size(this%timerange)
6907if (associated(this%level)) nlevel=size(this%level)
6908if (associated(this%network)) nnetwork=size(this%network)
6909
6910if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
6911if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
6912if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
6913if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
6914if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
6915
6916if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
6917if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
6918if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
6919if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
6920if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)
6921
6922if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
6923if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
6924if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
6925if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
6926if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
6927
6928if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
6929if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
6930if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
6931if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
6932if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
6933
6934if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
6935if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
6936if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
6937if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
6938if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)
6939
6940if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
6941if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
6942if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
6943if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
6944if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)
6945
6946write(unit=lunit)ldescription
6947write(unit=lunit)tarray
6948
6949write(unit=lunit)&
6950 nana, ntime, ntimerange, nlevel, nnetwork, &
6951 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
6952 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
6953 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
6954 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
6955 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
6956 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
6957 this%time_definition
6958
6959
6960!write(unit=lunit)this
6961
6962
6963!! prime 5 dimensioni
6966if (associated(this%level)) write(unit=lunit)this%level
6967if (associated(this%timerange)) write(unit=lunit)this%timerange
6968if (associated(this%network)) write(unit=lunit)this%network
6969
6970 !! 6a dimensione: variabile dell'anagrafica e dei dati
6971 !! con relativi attributi e in 5 tipi diversi
6972
6973if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r
6974if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i
6975if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b
6976if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d
6977if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c
6978
6979if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r
6980if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i
6981if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b
6982if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d
6983if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c
6984
6985if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r
6986if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i
6987if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b
6988if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d
6989if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c
6990
6991if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r
6992if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i
6993if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b
6994if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d
6995if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c
6996
6997if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r
6998if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i
6999if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b
7000if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d
7001if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c
7002
7003if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
7004if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
7005if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
7006if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
7007if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c
7008
7009!! Volumi di valori e attributi per anagrafica e dati
7010
7011if (associated(this%volanar)) write(unit=lunit)this%volanar
7012if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr
7013if (associated(this%voldatir)) write(unit=lunit)this%voldatir
7014if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr
7015
7016if (associated(this%volanai)) write(unit=lunit)this%volanai
7017if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri
7018if (associated(this%voldatii)) write(unit=lunit)this%voldatii
7019if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri
7020
7021if (associated(this%volanab)) write(unit=lunit)this%volanab
7022if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb
7023if (associated(this%voldatib)) write(unit=lunit)this%voldatib
7024if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb
7025
7026if (associated(this%volanad)) write(unit=lunit)this%volanad
7027if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd
7028if (associated(this%voldatid)) write(unit=lunit)this%voldatid
7029if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd
7030
7031if (associated(this%volanac)) write(unit=lunit)this%volanac
7032if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc
7033if (associated(this%voldatic)) write(unit=lunit)this%voldatic
7034if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc
7035
7036if (.not. present(unit)) close(unit=lunit)
7037
7038end subroutine vol7d_write_on_file
7039
7040
7041!>\brief Lettura da file di un volume Vol7d.
7042!! Lettura da file unformatted di un intero volume Vol7d.
7043!! Questa subroutine comprende vol7d_alloc e vol7d_alloc_vol.
7044!! Il file puo' essere aperto opzionalmente dall'utente. Si possono passare
7045!! opzionalmente unità e nome del file altrimenti assegnati internamente a dei default; se assegnati internamente
7046!! tali parametri saranno in output.
7047
7048
7049subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
7050
7051TYPE(vol7d),INTENT(OUT) :: this !< Volume vol7d da leggere
7052integer,intent(inout),optional :: unit !< unità su cui è stato aperto un file; se =0 rielaborato internamente (default = elaborato internamente con getunit)
7053character(len=*),INTENT(in),optional :: filename !< nome del file eventualmente da aprire (default = (nome dell'eseguibile)//.v7d )
7054character(len=*),intent(out),optional :: filename_auto !< nome del file generato se "filename" è omesso
7055character(len=*),INTENT(out),optional :: description !< descrizione del volume letto
7056integer,intent(out),optional :: tarray(8) !< vettore come definito da "date_and_time" della data di scrittura del volume
7057
7058
7059integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
7060 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
7061 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
7062 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
7063 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
7064 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
7065 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
7066
7067character(len=254) :: ldescription,lfilename,arg
7068integer :: ltarray(8),lunit,ios
7069logical :: opened,exist
7070
7071
7072call getarg(0,arg)
7073
7074if (.not. present(unit))then
7075 lunit=getunit()
7076else
7077 if (unit==0)then
7078 lunit=getunit()
7079 unit=lunit
7080 else
7081 lunit=unit
7082 end if
7083end if
7084
7085lfilename=trim(arg)//".v7d"
7087
7088if (present(filename))then
7089 if (filename /= "")then
7090 lfilename=filename
7091 end if
7092end if
7093
7094if (present(filename_auto))filename_auto=lfilename
7095
7096
7097inquire(unit=lunit,opened=opened)
7098IF (.NOT. opened) THEN
7099 inquire(file=lfilename,exist=exist)
7100 IF (.NOT.exist) THEN
7101 CALL l4f_log(l4f_fatal, &
7102 'in vol7d_read_from_file, file does not exists, cannot open')
7103 CALL raise_fatal_error()
7104 ENDIF
7105 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM', &
7106 status='OLD', action='READ')
7107 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
7108end if
7109
7110
7112read(unit=lunit,iostat=ios)ldescription
7113
7114if (ios < 0) then ! A negative value indicates that the End of File or End of Record
7115 call vol7d_alloc (this)
7116 call vol7d_alloc_vol (this)
7117 if (present(description))description=ldescription
7118 if (present(tarray))tarray=ltarray
7119 if (.not. present(unit)) close(unit=lunit)
7120end if
7121
7122read(unit=lunit)ltarray
7123
7124CALL l4f_log(l4f_info, 'Reading vol7d from file')
7125CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
7128
7129if (present(description))description=ldescription
7130if (present(tarray))tarray=ltarray
7131
7132read(unit=lunit)&
7133 nana, ntime, ntimerange, nlevel, nnetwork, &
7134 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
7135 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
7136 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
7137 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
7138 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
7139 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
7140 this%time_definition
7141
7142call vol7d_alloc (this, &
7143 nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,&
7144 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,&
7145 ndativard=ndativard, ndativarc=ndativarc,&
7146 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,&
7147 ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
7148 ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, &
7149 ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,&
7150 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, &
7151 nanavard=nanavard, nanavarc=nanavarc,&
7152 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,&
7153 nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
7154 nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, &
7155 nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc)
7156
7157
7160if (associated(this%level)) read(unit=lunit)this%level
7161if (associated(this%timerange)) read(unit=lunit)this%timerange
7162if (associated(this%network)) read(unit=lunit)this%network
7163
7164if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r
7165if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i
7166if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b
7167if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d
7168if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c
7169
7170if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r
7171if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i
7172if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b
7173if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d
7174if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c
7175
7176if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r
7177if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i
7178if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b
7179if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d
7180if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c
7181
7182if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r
7183if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i
7184if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b
7185if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d
7186if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c
7187
7188if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r
7189if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i
7190if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b
7191if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d
7192if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c
7193
7194if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
7195if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
7196if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
7197if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
7198if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c
7199
7200call vol7d_alloc_vol (this)
7201
7202!! Volumi di valori e attributi per anagrafica e dati
7203
7204if (associated(this%volanar)) read(unit=lunit)this%volanar
7205if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr
7206if (associated(this%voldatir)) read(unit=lunit)this%voldatir
7207if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr
7208
7209if (associated(this%volanai)) read(unit=lunit)this%volanai
7210if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri
7211if (associated(this%voldatii)) read(unit=lunit)this%voldatii
7212if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri
7213
7214if (associated(this%volanab)) read(unit=lunit)this%volanab
7215if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb
7216if (associated(this%voldatib)) read(unit=lunit)this%voldatib
7217if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb
7218
7219if (associated(this%volanad)) read(unit=lunit)this%volanad
7220if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd
7221if (associated(this%voldatid)) read(unit=lunit)this%voldatid
7222if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd
7223
7224if (associated(this%volanac)) read(unit=lunit)this%volanac
7225if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc
7226if (associated(this%voldatic)) read(unit=lunit)this%voldatic
7227if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc
7228
7229if (.not. present(unit)) close(unit=lunit)
7230
7231end subroutine vol7d_read_from_file
7232
7233
7234! to double precision
7235elemental doubleprecision function doubledatd(voldat,var)
7236doubleprecision,intent(in) :: voldat
7237type(vol7d_var),intent(in) :: var
7238
7239doubledatd=voldat
7240
7241end function doubledatd
7242
7243
7244elemental doubleprecision function doubledatr(voldat,var)
7245real,intent(in) :: voldat
7246type(vol7d_var),intent(in) :: var
7247
7249 doubledatr=dble(voldat)
7250else
7251 doubledatr=dmiss
7252end if
7253
7254end function doubledatr
7255
7256
7257elemental doubleprecision function doubledati(voldat,var)
7258integer,intent(in) :: voldat
7259type(vol7d_var),intent(in) :: var
7260
7263 doubledati=dble(voldat)/10.d0**var%scalefactor
7264 else
7265 doubledati=dble(voldat)
7266 endif
7267else
7268 doubledati=dmiss
7269end if
7270
7271end function doubledati
7272
7273
7274elemental doubleprecision function doubledatb(voldat,var)
7275integer(kind=int_b),intent(in) :: voldat
7276type(vol7d_var),intent(in) :: var
7277
7280 doubledatb=dble(voldat)/10.d0**var%scalefactor
7281 else
7282 doubledatb=dble(voldat)
7283 endif
7284else
7285 doubledatb=dmiss
7286end if
7287
7288end function doubledatb
7289
7290
7291elemental doubleprecision function doubledatc(voldat,var)
7292CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
7293type(vol7d_var),intent(in) :: var
7294
7295doubledatc = c2d(voldat)
7297 doubledatc=doubledatc/10.d0**var%scalefactor
7298end if
7299
7300end function doubledatc
7301
7302
7303! to integer
7304elemental integer function integerdatd(voldat,var)
7305doubleprecision,intent(in) :: voldat
7306type(vol7d_var),intent(in) :: var
7307
7310 integerdatd=nint(voldat*10d0**var%scalefactor)
7311 else
7312 integerdatd=nint(voldat)
7313 endif
7314else
7315 integerdatd=imiss
7316end if
7317
7318end function integerdatd
7319
7320
7321elemental integer function integerdatr(voldat,var)
7322real,intent(in) :: voldat
7323type(vol7d_var),intent(in) :: var
7324
7327 integerdatr=nint(voldat*10d0**var%scalefactor)
7328 else
7329 integerdatr=nint(voldat)
7330 endif
7331else
7332 integerdatr=imiss
7333end if
7334
7335end function integerdatr
7336
7337
7338elemental integer function integerdati(voldat,var)
7339integer,intent(in) :: voldat
7340type(vol7d_var),intent(in) :: var
7341
7342integerdati=voldat
7343
7344end function integerdati
7345
7346
7347elemental integer function integerdatb(voldat,var)
7348integer(kind=int_b),intent(in) :: voldat
7349type(vol7d_var),intent(in) :: var
7350
7352 integerdatb=voldat
7353else
7354 integerdatb=imiss
7355end if
7356
7357end function integerdatb
7358
7359
7360elemental integer function integerdatc(voldat,var)
7361CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
7362type(vol7d_var),intent(in) :: var
7363
7364integerdatc=c2i(voldat)
7365
7366end function integerdatc
7367
7368
7369! to real
7370elemental real function realdatd(voldat,var)
7371doubleprecision,intent(in) :: voldat
7372type(vol7d_var),intent(in) :: var
7373
7375 realdatd=real(voldat)
7376else
7377 realdatd=rmiss
7378end if
7379
7380end function realdatd
7381
7382
7383elemental real function realdatr(voldat,var)
7384real,intent(in) :: voldat
7385type(vol7d_var),intent(in) :: var
7386
7387realdatr=voldat
7388
7389end function realdatr
7390
7391
7392elemental real function realdati(voldat,var)
7393integer,intent(in) :: voldat
7394type(vol7d_var),intent(in) :: var
7395
7398 realdati=float(voldat)/10.**var%scalefactor
7399 else
7400 realdati=float(voldat)
7401 endif
7402else
7403 realdati=rmiss
7404end if
7405
7406end function realdati
7407
7408
7409elemental real function realdatb(voldat,var)
7410integer(kind=int_b),intent(in) :: voldat
7411type(vol7d_var),intent(in) :: var
7412
7415 realdatb=float(voldat)/10**var%scalefactor
7416 else
7417 realdatb=float(voldat)
7418 endif
7419else
7420 realdatb=rmiss
7421end if
7422
7423end function realdatb
7424
7425
7426elemental real function realdatc(voldat,var)
7427CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
7428type(vol7d_var),intent(in) :: var
7429
7430realdatc=c2r(voldat)
7432 realdatc=realdatc/10.**var%scalefactor
7433end if
7434
7435end function realdatc
7436
7437
7438!> Return an ana volume of a requested variable as real data.
7439!! It returns a 2-d array of the proper shape (ana x network) for the
7440!! ana variable requested, converted to real type. If the conversion
7441!! fails or if the variable is not contained in the ana volume,
7442!! missing data are returned.
7443FUNCTION realanavol(this, var) RESULT(vol)
7444TYPE(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
7445TYPE(vol7d_var),INTENT(in) :: var !< the ana variable to be returned
7446REAL :: vol(SIZE(this%ana),size(this%network))
7447
7448CHARACTER(len=1) :: dtype
7449INTEGER :: indvar
7450
7451dtype = cmiss
7452indvar = index(this%anavar, var, type=dtype)
7453
7454IF (indvar > 0) THEN
7455 SELECT CASE (dtype)
7456 CASE("d")
7457 vol = realdat(this%volanad(:,indvar,:), var)
7458 CASE("r")
7459 vol = this%volanar(:,indvar,:)
7460 CASE("i")
7461 vol = realdat(this%volanai(:,indvar,:), var)
7462 CASE("b")
7463 vol = realdat(this%volanab(:,indvar,:), var)
7464 CASE("c")
7465 vol = realdat(this%volanac(:,indvar,:), var)
7466 CASE default
7467 vol = rmiss
7468 END SELECT
7469ELSE
7470 vol = rmiss
7471ENDIF
7472
7473END FUNCTION realanavol
7474
7475
7476!> Return an ana volume of a requested variable as integer data.
7477!! It returns a 2-d array of the proper shape (ana x network) for the
7478!! ana variable requested, converted to integer type. If the conversion
7479!! fails or if the variable is not contained in the ana volume,
7480!! missing data are returned.
7481FUNCTION integeranavol(this, var) RESULT(vol)
7482TYPE(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
7483TYPE(vol7d_var),INTENT(in) :: var !< the ana variable to be returned
7484INTEGER :: vol(SIZE(this%ana),size(this%network))
7485
7486CHARACTER(len=1) :: dtype
7487INTEGER :: indvar
7488
7489dtype = cmiss
7490indvar = index(this%anavar, var, type=dtype)
7491
7492IF (indvar > 0) THEN
7493 SELECT CASE (dtype)
7494 CASE("d")
7495 vol = integerdat(this%volanad(:,indvar,:), var)
7496 CASE("r")
7497 vol = integerdat(this%volanar(:,indvar,:), var)
7498 CASE("i")
7499 vol = this%volanai(:,indvar,:)
7500 CASE("b")
7501 vol = integerdat(this%volanab(:,indvar,:), var)
7502 CASE("c")
7503 vol = integerdat(this%volanac(:,indvar,:), var)
7504 CASE default
7505 vol = imiss
7506 END SELECT
7507ELSE
7508 vol = imiss
7509ENDIF
7510
7511END FUNCTION integeranavol
7512
7513
7514!> Move data for all variables from one coordinate in the character volume to other.
7515!! Only not missing data will be copyed and all attributes will be moved together.
7516!! Usefull to colapse data spread in more indices (level or time or ....).
7517!! After the move is possible to set to missing some descriptor and make a copy with miss=.true.
7518!! to obtain a new vol7d with less data shape.
7519subroutine move_datac (v7d,&
7520 indana,indtime,indlevel,indtimerange,indnetwork,&
7521 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
7522
7523TYPE(vol7d),intent(inout) :: v7d !< data in form of character in this object will be moved
7524
7525integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork !< source coordinate of the data
7526integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew !< destination coordinate of data
7527integer :: inddativar,inddativarattr
7528
7529
7530do inddativar=1,size(v7d%dativar%c)
7531
7533 .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
7534 ) then
7535
7536 ! dati
7537 v7d%voldatic &
7538 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
7539 v7d%voldatic &
7540 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
7541
7542
7543 ! attributi
7544 if (associated (v7d%dativarattr%i)) then
7545 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
7546 if (inddativarattr > 0 ) then
7547 v7d%voldatiattri &
7548 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
7549 v7d%voldatiattri &
7550 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
7551 end if
7552 end if
7553
7554 if (associated (v7d%dativarattr%r)) then
7555 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
7556 if (inddativarattr > 0 ) then
7557 v7d%voldatiattrr &
7558 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
7559 v7d%voldatiattrr &
7560 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
7561 end if
7562 end if
7563
7564 if (associated (v7d%dativarattr%d)) then
7565 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
7566 if (inddativarattr > 0 ) then
7567 v7d%voldatiattrd &
7568 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
7569 v7d%voldatiattrd &
7570 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
7571 end if
7572 end if
7573
7574 if (associated (v7d%dativarattr%b)) then
7575 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
7576 if (inddativarattr > 0 ) then
7577 v7d%voldatiattrb &
7578 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
7579 v7d%voldatiattrb &
7580 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
7581 end if
7582 end if
7583
7584 if (associated (v7d%dativarattr%c)) then
7585 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
7586 if (inddativarattr > 0 ) then
7587 v7d%voldatiattrc &
7588 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
7589 v7d%voldatiattrc &
7590 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
7591 end if
7592 end if
7593
7594 end if
7595
7596end do
7597
7598end subroutine move_datac
7599
7600!> Move data for all variables from one coordinate in the real volume to other.
7601!! Only not missing data will be copyed and all attributes will be moved together.
7602!! Usefull to colapse data spread in more indices (level or time or ....).
7603!! After the move is possible to set to missing some descriptor and make a copy with miss=.true.
7604!! to obtain a new vol7d with less data shape.
7605subroutine move_datar (v7d,&
7606 indana,indtime,indlevel,indtimerange,indnetwork,&
7607 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
7608
7609TYPE(vol7d),intent(inout) :: v7d !< data in form of character in this object will be moved
7610
7611integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork !< source coordinate of the data
7612integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew !< destination coordinate of data
7613integer :: inddativar,inddativarattr
7614
7615
7616do inddativar=1,size(v7d%dativar%r)
7617
7619 .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
7620 ) then
7621
7622 ! dati
7623 v7d%voldatir &
7624 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
7625 v7d%voldatir &
7626 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
7627
7628
7629 ! attributi
7630 if (associated (v7d%dativarattr%i)) then
7631 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
7632 if (inddativarattr > 0 ) then
7633 v7d%voldatiattri &
7634 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
7635 v7d%voldatiattri &
7636 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
7637 end if
7638 end if
7639
7640 if (associated (v7d%dativarattr%r)) then
7641 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%r(inddativar))
7642 if (inddativarattr > 0 ) then
7643 v7d%voldatiattrr &
7644 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
7645 v7d%voldatiattrr &
7646 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
7647 end if
7648 end if
7649
7650 if (associated (v7d%dativarattr%d)) then
7651 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%r(inddativar))
7652 if (inddativarattr > 0 ) then
7653 v7d%voldatiattrd &
7654 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
7655 v7d%voldatiattrd &
7656 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
7657 end if
7658 end if
7659
7660 if (associated (v7d%dativarattr%b)) then
7661 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%r(inddativar))
7662 if (inddativarattr > 0 ) then
7663 v7d%voldatiattrb &
7664 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
7665 v7d%voldatiattrb &
7666 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
7667 end if
7668 end if
7669
7670 if (associated (v7d%dativarattr%c)) then
7671 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%r(inddativar))
7672 if (inddativarattr > 0 ) then
7673 v7d%voldatiattrc &
7674 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
7675 v7d%voldatiattrc &
7676 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
7677 end if
7678 end if
7679
7680 end if
7681
7682end do
7683
7684end subroutine move_datar
7685
7686
7687!> Reduce some dimensions (level and timerage) for semplification (rounding).
7688!! You can use this for simplify and use variables in computation like alchimia
7689!! where fields have to be on the same coordinate
7690!! It return real or character data only: if input is charcter data only it return character otherwise il return
7691!! all the data converted to real.
7692!! examples:
7693!! means in time for short periods and istantaneous values
7694!! 2 meter and surface levels
7695!! If there are data on more then one almost equal levels or timeranges, the first var present (at least one point)
7696!! will be taken (order is by icreasing var index).
7697!! You can use predefined values for classic semplification
7698!! almost_equal_levels and almost_equal_timeranges
7699!! The level or timerange in output will be defined by the first element of level and timerange list
7700subroutine v7d_rounding(v7din,v7dout,level,timerange,nostatproc)
7701type(vol7d),intent(inout) :: v7din !< input volume
7702type(vol7d),intent(out) :: v7dout !> output volume
7703type(vol7d_level),intent(in),optional :: level(:) !< almost equal level list
7704type(vol7d_timerange),intent(in),optional :: timerange(:) !< almost equal timerange list
7705!logical,intent(in),optional :: merge !< if there are data on more then one almost equal levels or timeranges
7706!! will be merged POINT BY POINT with priority for the fird data found ordered by icreasing var index
7707logical,intent(in),optional :: nostatproc !< do not take in account statistical processing code in timerange and P2
7708
7709integer :: nana,nlevel,ntime,ntimerange,nnetwork,nbin
7710integer :: iana,ilevel,itimerange,indl,indt,itime,inetwork
7711type(vol7d_level) :: roundlevel(size(v7din%level))
7712type(vol7d_timerange) :: roundtimerange(size(v7din%timerange))
7713type(vol7d) :: v7d_tmp
7714
7715
7716nbin=0
7717
7718if (associated(v7din%dativar%r)) nbin = nbin + size(v7din%dativar%r)
7719if (associated(v7din%dativar%i)) nbin = nbin + size(v7din%dativar%i)
7720if (associated(v7din%dativar%d)) nbin = nbin + size(v7din%dativar%d)
7721if (associated(v7din%dativar%b)) nbin = nbin + size(v7din%dativar%b)
7722
7724
7725roundlevel=v7din%level
7726
7727if (present(level))then
7728 do ilevel = 1, size(v7din%level)
7729 if ((any(v7din%level(ilevel) .almosteq. level))) then
7730 roundlevel(ilevel)=level(1)
7731 end if
7732 end do
7733end if
7734
7735roundtimerange=v7din%timerange
7736
7737if (present(timerange))then
7738 do itimerange = 1, size(v7din%timerange)
7739 if ((any(v7din%timerange(itimerange) .almosteq. timerange))) then
7740 roundtimerange(itimerange)=timerange(1)
7741 end if
7742 end do
7743end if
7744
7745!set istantaneous values everywere
7746!preserve p1 for forecast time
7747if (optio_log(nostatproc)) then
7748 roundtimerange(:)%timerange=254
7749 roundtimerange(:)%p2=0
7750end if
7751
7752
7753nana=size(v7din%ana)
7754nlevel=count_distinct(roundlevel,back=.true.)
7755ntime=size(v7din%time)
7756ntimerange=count_distinct(roundtimerange,back=.true.)
7757nnetwork=size(v7din%network)
7758
7760
7761if (nbin == 0) then
7763else
7764 call vol7d_convr(v7din,v7d_tmp)
7765end if
7766
7767v7d_tmp%level=roundlevel
7768v7d_tmp%timerange=roundtimerange
7769
7770do ilevel=1, size(v7d_tmp%level)
7771 indl=index(v7d_tmp%level,roundlevel(ilevel))
7772 do itimerange=1,size(v7d_tmp%timerange)
7773 indt=index(v7d_tmp%timerange,roundtimerange(itimerange))
7774
7775 if (indl /= ilevel .or. indt /= itimerange) then
7776
7777 do iana=1, nana
7778 do itime=1,ntime
7779 do inetwork=1,nnetwork
7780
7781 if (nbin > 0) then
7782 call move_datar (v7d_tmp,&
7783 iana,itime,ilevel,itimerange,inetwork,&
7784 iana,itime,indl,indt,inetwork)
7785 else
7786 call move_datac (v7d_tmp,&
7787 iana,itime,ilevel,itimerange,inetwork,&
7788 iana,itime,indl,indt,inetwork)
7789 end if
7790
7791 end do
7792 end do
7793 end do
7794
7795 end if
7796
7797 end do
7798end do
7799
7800! set to missing level and time > nlevel
7801do ilevel=nlevel+1,size(v7d_tmp%level)
7803end do
7804
7805do itimerange=ntimerange+1,size(v7d_tmp%timerange)
7807end do
7808
7809!copy with remove
7812
7813!call display(v7dout)
7814
7815end subroutine v7d_rounding
7816
7817
7819
7820!>\example esempio_qc_convert.f90
7821!!\brief Programma esempio semplice per la scrittura su file di un volume vol7d
7822!!
7823!!Programma che scrive su file un volume vol7d letto da una serie di file ASCII.
7824!!Questo programma scrive i dati del clima che poi verranno letti da modqccli
7825
7826
7827!>\example esempio_v7ddballe_move_and_collapse.f90
7828!!\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 |