libsim Versione 7.2.1
|
◆ vol7d_get_voldatiattrc()
Crea una vista a dimensione ridotta di un volume di attributi di dati di tipo CHARACTER(len=vol7d_cdatalen). È necessario fornire uno solo dei parametri opzionali vol*dp corrispondente al numero di dimensioni richieste. L'ordine delle dimensioni nella vista è quello prefissato in ::vol7d indipendentemente dall'ordine delle dimensioni fornito in dimlist. In caso di fallimento, in particolare se dimlist non contiene tutte le dimensioni non degeneri del volume richiesto oppure se una delle dimensioni è =0, il puntatore vol*dp è restituito in uno stato disassociato, per cui è opportuno controllare sempre in uscita, lo stato del puntatore per evitare che il programma abortisca con un errore di sistema, ad esempio: CHARACTER(len=vol7d_cdatalen), POINTER :: vol2d(:,:)
...
CALL vol7d_get_voldatiattrc(v7d1, (/vol7d_ana_d, vol7d_time_d/), vol2d)
IF (ASSOCIATED(vol2d)) THEN
print*,vol2d
...
ENDIF
return
Definizione alla linea 6405 del file vol7d_class.F90. 6407! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6408! authors:
6409! Davide Cesari <dcesari@arpa.emr.it>
6410! Paolo Patruno <ppatruno@arpa.emr.it>
6411
6412! This program is free software; you can redistribute it and/or
6413! modify it under the terms of the GNU General Public License as
6414! published by the Free Software Foundation; either version 2 of
6415! the License, or (at your option) any later version.
6416
6417! This program is distributed in the hope that it will be useful,
6418! but WITHOUT ANY WARRANTY; without even the implied warranty of
6419! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6420! GNU General Public License for more details.
6421
6422! You should have received a copy of the GNU General Public License
6423! along with this program. If not, see <http://www.gnu.org/licenses/>.
6424#include "config.h"
6425
6437
6505IMPLICIT NONE
6506
6507
6508INTEGER, PARAMETER :: vol7d_maxdim_a = 3, vol7d_maxdim_aa = 4, &
6509 vol7d_maxdim_d = 6, vol7d_maxdim_ad = 7
6510
6511INTEGER, PARAMETER :: vol7d_ana_a=1
6512INTEGER, PARAMETER :: vol7d_var_a=2
6513INTEGER, PARAMETER :: vol7d_network_a=3
6514INTEGER, PARAMETER :: vol7d_attr_a=4
6515INTEGER, PARAMETER :: vol7d_ana_d=1
6516INTEGER, PARAMETER :: vol7d_time_d=2
6517INTEGER, PARAMETER :: vol7d_level_d=3
6518INTEGER, PARAMETER :: vol7d_timerange_d=4
6519INTEGER, PARAMETER :: vol7d_var_d=5
6520INTEGER, PARAMETER :: vol7d_network_d=6
6521INTEGER, PARAMETER :: vol7d_attr_d=7
6522INTEGER, PARAMETER :: vol7d_cdatalen=32
6523
6524TYPE vol7d_varmap
6525 INTEGER :: r, d, i, b, c
6526END TYPE vol7d_varmap
6527
6532 TYPE(vol7d_ana),POINTER :: ana(:)
6534 TYPE(datetime),POINTER :: time(:)
6536 TYPE(vol7d_level),POINTER :: level(:)
6538 TYPE(vol7d_timerange),POINTER :: timerange(:)
6540 TYPE(vol7d_network),POINTER :: network(:)
6542 TYPE(vol7d_varvect) :: anavar
6544 TYPE(vol7d_varvect) :: anaattr
6546 TYPE(vol7d_varvect) :: anavarattr
6548 TYPE(vol7d_varvect) :: dativar
6550 TYPE(vol7d_varvect) :: datiattr
6552 TYPE(vol7d_varvect) :: dativarattr
6553
6555 REAL,POINTER :: volanar(:,:,:)
6557 DOUBLE PRECISION,POINTER :: volanad(:,:,:)
6559 INTEGER,POINTER :: volanai(:,:,:)
6561 INTEGER(kind=int_b),POINTER :: volanab(:,:,:)
6563 CHARACTER(len=vol7d_cdatalen),POINTER :: volanac(:,:,:)
6564
6566 REAL,POINTER :: volanaattrr(:,:,:,:)
6568 DOUBLE PRECISION,POINTER :: volanaattrd(:,:,:,:)
6570 INTEGER,POINTER :: volanaattri(:,:,:,:)
6572 INTEGER(kind=int_b),POINTER :: volanaattrb(:,:,:,:)
6574 CHARACTER(len=vol7d_cdatalen),POINTER :: volanaattrc(:,:,:,:)
6575
6577 REAL,POINTER :: voldatir(:,:,:,:,:,:) ! sono i dati
6579 DOUBLE PRECISION,POINTER :: voldatid(:,:,:,:,:,:)
6581 INTEGER,POINTER :: voldatii(:,:,:,:,:,:)
6583 INTEGER(kind=int_b),POINTER :: voldatib(:,:,:,:,:,:)
6585 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatic(:,:,:,:,:,:)
6586
6588 REAL,POINTER :: voldatiattrr(:,:,:,:,:,:,:)
6590 DOUBLE PRECISION,POINTER :: voldatiattrd(:,:,:,:,:,:,:)
6592 INTEGER,POINTER :: voldatiattri(:,:,:,:,:,:,:)
6594 INTEGER(kind=int_b),POINTER :: voldatiattrb(:,:,:,:,:,:,:)
6596 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatiattrc(:,:,:,:,:,:,:)
6597
6599 integer :: time_definition
6600
6602
6607 MODULE PROCEDURE vol7d_init
6608END INTERFACE
6609
6612 MODULE PROCEDURE vol7d_delete
6613END INTERFACE
6614
6617 MODULE PROCEDURE vol7d_write_on_file
6618END INTERFACE
6619
6621INTERFACE import
6622 MODULE PROCEDURE vol7d_read_from_file
6623END INTERFACE
6624
6627 MODULE PROCEDURE vol7d_display, dat_display, dat_vect_display
6628END INTERFACE
6629
6632 MODULE PROCEDURE to_char_dat
6633END INTERFACE
6634
6637 MODULE PROCEDURE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
6638END INTERFACE
6639
6642 MODULE PROCEDURE realdatd,realdatr,realdati,realdatb,realdatc
6643END INTERFACE
6644
6647 MODULE PROCEDURE integerdatd,integerdatr,integerdati,integerdatb,integerdatc
6648END INTERFACE
6649
6652 MODULE PROCEDURE vol7d_copy
6653END INTERFACE
6654
6657 MODULE PROCEDURE vol7d_c_e
6658END INTERFACE
6659
6664 MODULE PROCEDURE vol7d_check
6665END INTERFACE
6666
6681 MODULE PROCEDURE v7d_rounding
6682END INTERFACE
6683
6684!!$INTERFACE get_volana
6685!!$ MODULE PROCEDURE vol7d_get_volanar, vol7d_get_volanad, vol7d_get_volanai, &
6686!!$ vol7d_get_volanab, vol7d_get_volanac
6687!!$END INTERFACE
6688!!$
6689!!$INTERFACE get_voldati
6690!!$ MODULE PROCEDURE vol7d_get_voldatir, vol7d_get_voldatid, vol7d_get_voldatii, &
6691!!$ vol7d_get_voldatib, vol7d_get_voldatic
6692!!$END INTERFACE
6693!!$
6694!!$INTERFACE get_volanaattr
6695!!$ MODULE PROCEDURE vol7d_get_volanaattrr, vol7d_get_volanaattrd, &
6696!!$ vol7d_get_volanaattri, vol7d_get_volanaattrb, vol7d_get_volanaattrc
6697!!$END INTERFACE
6698!!$
6699!!$INTERFACE get_voldatiattr
6700!!$ MODULE PROCEDURE vol7d_get_voldatiattrr, vol7d_get_voldatiattrd, &
6701!!$ vol7d_get_voldatiattri, vol7d_get_voldatiattrb, vol7d_get_voldatiattrc
6702!!$END INTERFACE
6703
6704PRIVATE vol7d_get_volr, vol7d_get_vold, vol7d_get_voli, vol7d_get_volb, &
6705 vol7d_get_volc, &
6706 volptr1dr, volptr2dr, volptr3dr, volptr4dr, volptr5dr, volptr6dr, volptr7dr, &
6707 volptr1dd, volptr2dd, volptr3dd, volptr4dd, volptr5dd, volptr6dd, volptr7dd, &
6708 volptr1di, volptr2di, volptr3di, volptr4di, volptr5di, volptr6di, volptr7di, &
6709 volptr1db, volptr2db, volptr3db, volptr4db, volptr5db, volptr6db, volptr7db, &
6710 volptr1dc, volptr2dc, volptr3dc, volptr4dc, volptr5dc, volptr6dc, volptr7dc, &
6711 vol7d_nullifyr, vol7d_nullifyd, vol7d_nullifyi, vol7d_nullifyb, vol7d_nullifyc, &
6712 vol7d_init, vol7d_delete, vol7d_write_on_file, vol7d_read_from_file, &
6713 vol7d_check_alloc_ana, vol7d_force_alloc_ana, &
6714 vol7d_check_alloc_dati, vol7d_force_alloc_dati, vol7d_force_alloc, &
6715 vol7d_display, dat_display, dat_vect_display, &
6716 to_char_dat, vol7d_check
6717
6718PRIVATE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
6719
6720PRIVATE vol7d_c_e
6721
6722CONTAINS
6723
6724
6729SUBROUTINE vol7d_init(this,time_definition)
6730TYPE(vol7d),intent(out) :: this
6731integer,INTENT(IN),OPTIONAL :: time_definition
6732
6739CALL vol7d_var_features_init() ! initialise var features table once
6740
6741NULLIFY(this%ana, this%time, this%level, this%timerange, this%network)
6742
6743NULLIFY(this%volanar, this%volanaattrr, this%voldatir, this%voldatiattrr)
6744NULLIFY(this%volanad, this%volanaattrd, this%voldatid, this%voldatiattrd)
6745NULLIFY(this%volanai, this%volanaattri, this%voldatii, this%voldatiattri)
6746NULLIFY(this%volanab, this%volanaattrb, this%voldatib, this%voldatiattrb)
6747NULLIFY(this%volanac, this%volanaattrc, this%voldatic, this%voldatiattrc)
6748
6749if(present(time_definition)) then
6750 this%time_definition=time_definition
6751else
6752 this%time_definition=1 !default to validity time
6753end if
6754
6755END SUBROUTINE vol7d_init
6756
6757
6761ELEMENTAL SUBROUTINE vol7d_delete(this, dataonly)
6762TYPE(vol7d),intent(inout) :: this
6763LOGICAL, INTENT(in), OPTIONAL :: dataonly
6764
6765
6766IF (.NOT. optio_log(dataonly)) THEN
6767 IF (ASSOCIATED(this%volanar)) DEALLOCATE(this%volanar)
6768 IF (ASSOCIATED(this%volanad)) DEALLOCATE(this%volanad)
6769 IF (ASSOCIATED(this%volanai)) DEALLOCATE(this%volanai)
6770 IF (ASSOCIATED(this%volanab)) DEALLOCATE(this%volanab)
6771 IF (ASSOCIATED(this%volanac)) DEALLOCATE(this%volanac)
6772 IF (ASSOCIATED(this%volanaattrr)) DEALLOCATE(this%volanaattrr)
6773 IF (ASSOCIATED(this%volanaattrd)) DEALLOCATE(this%volanaattrd)
6774 IF (ASSOCIATED(this%volanaattri)) DEALLOCATE(this%volanaattri)
6775 IF (ASSOCIATED(this%volanaattrb)) DEALLOCATE(this%volanaattrb)
6776 IF (ASSOCIATED(this%volanaattrc)) DEALLOCATE(this%volanaattrc)
6777ENDIF
6778IF (ASSOCIATED(this%voldatir)) DEALLOCATE(this%voldatir)
6779IF (ASSOCIATED(this%voldatid)) DEALLOCATE(this%voldatid)
6780IF (ASSOCIATED(this%voldatii)) DEALLOCATE(this%voldatii)
6781IF (ASSOCIATED(this%voldatib)) DEALLOCATE(this%voldatib)
6782IF (ASSOCIATED(this%voldatic)) DEALLOCATE(this%voldatic)
6783IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
6784IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
6785IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
6786IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
6787IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
6788
6789IF (.NOT. optio_log(dataonly)) THEN
6790 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
6791 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
6792ENDIF
6793IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
6794IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
6795IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
6796
6797IF (.NOT. optio_log(dataonly)) THEN
6801ENDIF
6805
6806END SUBROUTINE vol7d_delete
6807
6808
6809
6810integer function vol7d_check(this)
6811TYPE(vol7d),intent(in) :: this
6812integer :: i,j,k,l,m,n
6813
6814vol7d_check=0
6815
6816if (associated(this%voldatii)) then
6817do i = 1,size(this%voldatii,1)
6818 do j = 1,size(this%voldatii,2)
6819 do k = 1,size(this%voldatii,3)
6820 do l = 1,size(this%voldatii,4)
6821 do m = 1,size(this%voldatii,5)
6822 do n = 1,size(this%voldatii,6)
6823 if (this%voldatii(i,j,k,l,m,n) /= this%voldatii(i,j,k,l,m,n) ) then
6824 CALL l4f_log(l4f_warn,"check: abnormal value at voldatii("&
6826 vol7d_check=1
6827 end if
6828 end do
6829 end do
6830 end do
6831 end do
6832 end do
6833end do
6834end if
6835
6836
6837if (associated(this%voldatir)) then
6838do i = 1,size(this%voldatir,1)
6839 do j = 1,size(this%voldatir,2)
6840 do k = 1,size(this%voldatir,3)
6841 do l = 1,size(this%voldatir,4)
6842 do m = 1,size(this%voldatir,5)
6843 do n = 1,size(this%voldatir,6)
6844 if (this%voldatir(i,j,k,l,m,n) /= this%voldatir(i,j,k,l,m,n) ) then
6845 CALL l4f_log(l4f_warn,"check: abnormal value at voldatir("&
6847 vol7d_check=2
6848 end if
6849 end do
6850 end do
6851 end do
6852 end do
6853 end do
6854end do
6855end if
6856
6857if (associated(this%voldatid)) then
6858do i = 1,size(this%voldatid,1)
6859 do j = 1,size(this%voldatid,2)
6860 do k = 1,size(this%voldatid,3)
6861 do l = 1,size(this%voldatid,4)
6862 do m = 1,size(this%voldatid,5)
6863 do n = 1,size(this%voldatid,6)
6864 if (this%voldatid(i,j,k,l,m,n) /= this%voldatid(i,j,k,l,m,n) ) then
6865 CALL l4f_log(l4f_warn,"check: abnormal value at voldatid("&
6867 vol7d_check=3
6868 end if
6869 end do
6870 end do
6871 end do
6872 end do
6873 end do
6874end do
6875end if
6876
6877if (associated(this%voldatib)) then
6878do i = 1,size(this%voldatib,1)
6879 do j = 1,size(this%voldatib,2)
6880 do k = 1,size(this%voldatib,3)
6881 do l = 1,size(this%voldatib,4)
6882 do m = 1,size(this%voldatib,5)
6883 do n = 1,size(this%voldatib,6)
6884 if (this%voldatib(i,j,k,l,m,n) /= this%voldatib(i,j,k,l,m,n) ) then
6885 CALL l4f_log(l4f_warn,"check: abnormal value at voldatib("&
6887 vol7d_check=4
6888 end if
6889 end do
6890 end do
6891 end do
6892 end do
6893 end do
6894end do
6895end if
6896
6897end function vol7d_check
6898
6899
6900
6901!TODO da completare ! aborta se i volumi sono allocati a dimensione 0
6903SUBROUTINE vol7d_display(this)
6904TYPE(vol7d),intent(in) :: this
6905integer :: i
6906
6907REAL :: rdat
6908DOUBLE PRECISION :: ddat
6909INTEGER :: idat
6910INTEGER(kind=int_b) :: bdat
6911CHARACTER(len=vol7d_cdatalen) :: cdat
6912
6913
6914print*,"<<<<<<<<<<<<<<<<<<< vol7d object >>>>>>>>>>>>>>>>>>>>"
6915if (this%time_definition == 0) then
6916 print*,"TIME DEFINITION: time is reference time"
6917else if (this%time_definition == 1) then
6918 print*,"TIME DEFINITION: time is validity time"
6919else
6920 print*,"Time definition have a wrong walue:", this%time_definition
6921end if
6922
6923IF (ASSOCIATED(this%network))then
6924 print*,"---- network vector ----"
6925 print*,"elements=",size(this%network)
6926 do i=1, size(this%network)
6928 end do
6929end IF
6930
6931IF (ASSOCIATED(this%ana))then
6932 print*,"---- ana vector ----"
6933 print*,"elements=",size(this%ana)
6934 do i=1, size(this%ana)
6936 end do
6937end IF
6938
6939IF (ASSOCIATED(this%time))then
6940 print*,"---- time vector ----"
6941 print*,"elements=",size(this%time)
6942 do i=1, size(this%time)
6944 end do
6945end if
6946
6947IF (ASSOCIATED(this%level)) then
6948 print*,"---- level vector ----"
6949 print*,"elements=",size(this%level)
6950 do i =1,size(this%level)
6952 end do
6953end if
6954
6955IF (ASSOCIATED(this%timerange))then
6956 print*,"---- timerange vector ----"
6957 print*,"elements=",size(this%timerange)
6958 do i =1,size(this%timerange)
6960 end do
6961end if
6962
6963
6964print*,"---- ana vector ----"
6965print*,""
6966print*,"->>>>>>>>> anavar -"
6968print*,""
6969print*,"->>>>>>>>> anaattr -"
6971print*,""
6972print*,"->>>>>>>>> anavarattr -"
6974
6975print*,"-- ana data section (first point) --"
6976
6977idat=imiss
6978rdat=rmiss
6979ddat=dmiss
6980bdat=ibmiss
6981cdat=cmiss
6982
6983!ntime = MIN(SIZE(this%time),nprint)
6984!ntimerange = MIN(SIZE(this%timerange),nprint)
6985!nlevel = MIN(SIZE(this%level),nprint)
6986!nnetwork = MIN(SIZE(this%network),nprint)
6987!nana = MIN(SIZE(this%ana),nprint)
6988
6989IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0) THEN
6990if (associated(this%volanai)) then
6991 do i=1,size(this%anavar%i)
6992 idat=this%volanai(1,i,1)
6994 end do
6995end if
6996idat=imiss
6997
6998if (associated(this%volanar)) then
6999 do i=1,size(this%anavar%r)
7000 rdat=this%volanar(1,i,1)
7002 end do
7003end if
7004rdat=rmiss
7005
7006if (associated(this%volanad)) then
7007 do i=1,size(this%anavar%d)
7008 ddat=this%volanad(1,i,1)
7010 end do
7011end if
7012ddat=dmiss
7013
7014if (associated(this%volanab)) then
7015 do i=1,size(this%anavar%b)
7016 bdat=this%volanab(1,i,1)
7018 end do
7019end if
7020bdat=ibmiss
7021
7022if (associated(this%volanac)) then
7023 do i=1,size(this%anavar%c)
7024 cdat=this%volanac(1,i,1)
7026 end do
7027end if
7028cdat=cmiss
7029ENDIF
7030
7031print*,"---- data vector ----"
7032print*,""
7033print*,"->>>>>>>>> dativar -"
7035print*,""
7036print*,"->>>>>>>>> datiattr -"
7038print*,""
7039print*,"->>>>>>>>> dativarattr -"
7041
7042print*,"-- data data section (first point) --"
7043
7044idat=imiss
7045rdat=rmiss
7046ddat=dmiss
7047bdat=ibmiss
7048cdat=cmiss
7049
7050IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0 .AND. size(this%time) > 0 &
7051 .AND. size(this%level) > 0 .AND. size(this%timerange) > 0) THEN
7052if (associated(this%voldatii)) then
7053 do i=1,size(this%dativar%i)
7054 idat=this%voldatii(1,1,1,1,i,1)
7056 end do
7057end if
7058idat=imiss
7059
7060if (associated(this%voldatir)) then
7061 do i=1,size(this%dativar%r)
7062 rdat=this%voldatir(1,1,1,1,i,1)
7064 end do
7065end if
7066rdat=rmiss
7067
7068if (associated(this%voldatid)) then
7069 do i=1,size(this%dativar%d)
7070 ddat=this%voldatid(1,1,1,1,i,1)
7072 end do
7073end if
7074ddat=dmiss
7075
7076if (associated(this%voldatib)) then
7077 do i=1,size(this%dativar%b)
7078 bdat=this%voldatib(1,1,1,1,i,1)
7080 end do
7081end if
7082bdat=ibmiss
7083
7084if (associated(this%voldatic)) then
7085 do i=1,size(this%dativar%c)
7086 cdat=this%voldatic(1,1,1,1,i,1)
7088 end do
7089end if
7090cdat=cmiss
7091ENDIF
7092
7093print*,"<<<<<<<<<<<<<<<<<<< END vol7d object >>>>>>>>>>>>>>>>>>>>"
7094
7095END SUBROUTINE vol7d_display
7096
7097
7099SUBROUTINE dat_display(this,idat,rdat,ddat,bdat,cdat)
7100TYPE(vol7d_var),intent(in) :: this
7102REAL :: rdat
7104DOUBLE PRECISION :: ddat
7106INTEGER :: idat
7108INTEGER(kind=int_b) :: bdat
7110CHARACTER(len=*) :: cdat
7111
7112print *, to_char_dat(this,idat,rdat,ddat,bdat,cdat)
7113
7114end SUBROUTINE dat_display
7115
7117SUBROUTINE dat_vect_display(this,idat,rdat,ddat,bdat,cdat)
7118
7119TYPE(vol7d_var),intent(in) :: this(:)
7121REAL :: rdat(:)
7123DOUBLE PRECISION :: ddat(:)
7125INTEGER :: idat(:)
7127INTEGER(kind=int_b) :: bdat(:)
7129CHARACTER(len=*):: cdat(:)
7130
7131integer :: i
7132
7133do i =1,size(this)
7135end do
7136
7137end SUBROUTINE dat_vect_display
7138
7139
7140FUNCTION to_char_dat(this,idat,rdat,ddat,bdat,cdat)
7141#ifdef HAVE_DBALLE
7142USE dballef
7143#endif
7144TYPE(vol7d_var),INTENT(in) :: this
7146REAL :: rdat
7148DOUBLE PRECISION :: ddat
7150INTEGER :: idat
7152INTEGER(kind=int_b) :: bdat
7154CHARACTER(len=*) :: cdat
7155CHARACTER(len=80) :: to_char_dat
7156
7157CHARACTER(len=LEN(to_char_dat)) :: to_char_tmp
7158
7159
7160#ifdef HAVE_DBALLE
7161INTEGER :: handle, ier
7162
7163handle = 0
7164to_char_dat="VALUE: "
7165
7170
7172 ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
7173 ier = idba_spiegab(handle,this%btable,cdat,to_char_tmp)
7174 ier = idba_fatto(handle)
7175 to_char_dat=trim(to_char_dat)//" ;char> "//trim(to_char_tmp)
7176endif
7177
7178#else
7179
7180to_char_dat="VALUE: "
7186
7187#endif
7188
7189END FUNCTION to_char_dat
7190
7191
7194FUNCTION vol7d_c_e(this) RESULT(c_e)
7195TYPE(vol7d), INTENT(in) :: this
7196
7197LOGICAL :: c_e
7198
7200 ASSOCIATED(this%level) .OR. ASSOCIATED(this%timerange) .OR. &
7201 ASSOCIATED(this%network) .OR. &
7202 ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
7203 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
7204 ASSOCIATED(this%anavar%c) .OR. &
7205 ASSOCIATED(this%anaattr%r) .OR. ASSOCIATED(this%anaattr%d) .OR. &
7206 ASSOCIATED(this%anaattr%i) .OR. ASSOCIATED(this%anaattr%b) .OR. &
7207 ASSOCIATED(this%anaattr%c) .OR. &
7208 ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
7209 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
7210 ASSOCIATED(this%dativar%c) .OR. &
7211 ASSOCIATED(this%datiattr%r) .OR. ASSOCIATED(this%datiattr%d) .OR. &
7212 ASSOCIATED(this%datiattr%i) .OR. ASSOCIATED(this%datiattr%b) .OR. &
7213 ASSOCIATED(this%datiattr%c)
7214
7215END FUNCTION vol7d_c_e
7216
7217
7256SUBROUTINE vol7d_alloc(this, nana, ntime, nlevel, ntimerange, nnetwork, &
7257 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
7258 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
7259 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
7260 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
7261 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
7262 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc, &
7263 ini)
7264TYPE(vol7d),INTENT(inout) :: this
7265INTEGER,INTENT(in),OPTIONAL :: nana
7266INTEGER,INTENT(in),OPTIONAL :: ntime
7267INTEGER,INTENT(in),OPTIONAL :: nlevel
7268INTEGER,INTENT(in),OPTIONAL :: ntimerange
7269INTEGER,INTENT(in),OPTIONAL :: nnetwork
7271INTEGER,INTENT(in),OPTIONAL :: &
7272 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
7273 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
7274 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
7275 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
7276 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
7277 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc
7278LOGICAL,INTENT(in),OPTIONAL :: ini
7279
7280INTEGER :: i
7281LOGICAL :: linit
7282
7283IF (PRESENT(ini)) THEN
7284 linit = ini
7285ELSE
7286 linit = .false.
7287ENDIF
7288
7289! Dimensioni principali
7290IF (PRESENT(nana)) THEN
7291 IF (nana >= 0) THEN
7292 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
7293 ALLOCATE(this%ana(nana))
7294 IF (linit) THEN
7295 DO i = 1, nana
7297 ENDDO
7298 ENDIF
7299 ENDIF
7300ENDIF
7301IF (PRESENT(ntime)) THEN
7302 IF (ntime >= 0) THEN
7303 IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
7304 ALLOCATE(this%time(ntime))
7305 IF (linit) THEN
7306 DO i = 1, ntime
7308 ENDDO
7309 ENDIF
7310 ENDIF
7311ENDIF
7312IF (PRESENT(nlevel)) THEN
7313 IF (nlevel >= 0) THEN
7314 IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
7315 ALLOCATE(this%level(nlevel))
7316 IF (linit) THEN
7317 DO i = 1, nlevel
7319 ENDDO
7320 ENDIF
7321 ENDIF
7322ENDIF
7323IF (PRESENT(ntimerange)) THEN
7324 IF (ntimerange >= 0) THEN
7325 IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
7326 ALLOCATE(this%timerange(ntimerange))
7327 IF (linit) THEN
7328 DO i = 1, ntimerange
7330 ENDDO
7331 ENDIF
7332 ENDIF
7333ENDIF
7334IF (PRESENT(nnetwork)) THEN
7335 IF (nnetwork >= 0) THEN
7336 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
7337 ALLOCATE(this%network(nnetwork))
7338 IF (linit) THEN
7339 DO i = 1, nnetwork
7341 ENDDO
7342 ENDIF
7343 ENDIF
7344ENDIF
7345! Dimensioni dei tipi delle variabili
7346CALL vol7d_varvect_alloc(this%anavar, nanavarr, nanavard, &
7347 nanavari, nanavarb, nanavarc, ini)
7348CALL vol7d_varvect_alloc(this%anaattr, nanaattrr, nanaattrd, &
7349 nanaattri, nanaattrb, nanaattrc, ini)
7350CALL vol7d_varvect_alloc(this%anavarattr, nanavarattrr, nanavarattrd, &
7351 nanavarattri, nanavarattrb, nanavarattrc, ini)
7352CALL vol7d_varvect_alloc(this%dativar, ndativarr, ndativard, &
7353 ndativari, ndativarb, ndativarc, ini)
7354CALL vol7d_varvect_alloc(this%datiattr, ndatiattrr, ndatiattrd, &
7355 ndatiattri, ndatiattrb, ndatiattrc, ini)
7356CALL vol7d_varvect_alloc(this%dativarattr, ndativarattrr, ndativarattrd, &
7357 ndativarattri, ndativarattrb, ndativarattrc, ini)
7358
7359END SUBROUTINE vol7d_alloc
7360
7361
7362FUNCTION vol7d_check_alloc_ana(this)
7363TYPE(vol7d),INTENT(in) :: this
7364LOGICAL :: vol7d_check_alloc_ana
7365
7366vol7d_check_alloc_ana = ASSOCIATED(this%ana) .AND. ASSOCIATED(this%network)
7367
7368END FUNCTION vol7d_check_alloc_ana
7369
7370SUBROUTINE vol7d_force_alloc_ana(this, ini)
7371TYPE(vol7d),INTENT(inout) :: this
7372LOGICAL,INTENT(in),OPTIONAL :: ini
7373
7374! Alloco i descrittori minimi per avere un volume di anagrafica
7375IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=1, ini=ini)
7376IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=1, ini=ini)
7377
7378END SUBROUTINE vol7d_force_alloc_ana
7379
7380
7381FUNCTION vol7d_check_alloc_dati(this)
7382TYPE(vol7d),INTENT(in) :: this
7383LOGICAL :: vol7d_check_alloc_dati
7384
7385vol7d_check_alloc_dati = vol7d_check_alloc_ana(this) .AND. &
7386 ASSOCIATED(this%time) .AND. ASSOCIATED(this%level) .AND. &
7387 ASSOCIATED(this%timerange)
7388
7389END FUNCTION vol7d_check_alloc_dati
7390
7391SUBROUTINE vol7d_force_alloc_dati(this, ini)
7392TYPE(vol7d),INTENT(inout) :: this
7393LOGICAL,INTENT(in),OPTIONAL :: ini
7394
7395! Alloco i descrittori minimi per avere un volume di dati
7396CALL vol7d_force_alloc_ana(this, ini)
7397IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=1, ini=ini)
7398IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=1, ini=ini)
7399IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=1, ini=ini)
7400
7401END SUBROUTINE vol7d_force_alloc_dati
7402
7403
7404SUBROUTINE vol7d_force_alloc(this)
7405TYPE(vol7d),INTENT(inout) :: this
7406
7407! If anything really not allocated yet, allocate with size 0
7408IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=0)
7409IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=0)
7410IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=0)
7411IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=0)
7412IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=0)
7413
7414END SUBROUTINE vol7d_force_alloc
7415
7416
7417FUNCTION vol7d_check_vol(this)
7418TYPE(vol7d),INTENT(in) :: this
7419LOGICAL :: vol7d_check_vol
7420
7421vol7d_check_vol = c_e(this)
7422
7423! Anagrafica
7424IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
7425 vol7d_check_vol = .false.
7426ENDIF
7427
7428IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
7429 vol7d_check_vol = .false.
7430ENDIF
7431
7432IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
7433 vol7d_check_vol = .false.
7434ENDIF
7435
7436IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
7437 vol7d_check_vol = .false.
7438ENDIF
7439
7440IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
7441 vol7d_check_vol = .false.
7442ENDIF
7443IF (ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
7444 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
7445 ASSOCIATED(this%anavar%c)) THEN
7446 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_ana(this)
7447ENDIF
7448
7449! Attributi dell'anagrafica
7450IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
7451 .NOT.ASSOCIATED(this%volanaattrr)) THEN
7452 vol7d_check_vol = .false.
7453ENDIF
7454
7455IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
7456 .NOT.ASSOCIATED(this%volanaattrd)) THEN
7457 vol7d_check_vol = .false.
7458ENDIF
7459
7460IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
7461 .NOT.ASSOCIATED(this%volanaattri)) THEN
7462 vol7d_check_vol = .false.
7463ENDIF
7464
7465IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
7466 .NOT.ASSOCIATED(this%volanaattrb)) THEN
7467 vol7d_check_vol = .false.
7468ENDIF
7469
7470IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
7471 .NOT.ASSOCIATED(this%volanaattrc)) THEN
7472 vol7d_check_vol = .false.
7473ENDIF
7474
7475! Dati
7476IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
7477 vol7d_check_vol = .false.
7478ENDIF
7479
7480IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
7481 vol7d_check_vol = .false.
7482ENDIF
7483
7484IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
7485 vol7d_check_vol = .false.
7486ENDIF
7487
7488IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
7489 vol7d_check_vol = .false.
7490ENDIF
7491
7492IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
7493 vol7d_check_vol = .false.
7494ENDIF
7495
7496! Attributi dei dati
7497IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
7498 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
7499 vol7d_check_vol = .false.
7500ENDIF
7501
7502IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
7503 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
7504 vol7d_check_vol = .false.
7505ENDIF
7506
7507IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
7508 .NOT.ASSOCIATED(this%voldatiattri)) THEN
7509 vol7d_check_vol = .false.
7510ENDIF
7511
7512IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
7513 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
7514 vol7d_check_vol = .false.
7515ENDIF
7516
7517IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
7518 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
7519 vol7d_check_vol = .false.
7520ENDIF
7521IF (ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
7522 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
7523 ASSOCIATED(this%dativar%c)) THEN
7524 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_dati(this)
7525ENDIF
7526
7527END FUNCTION vol7d_check_vol
7528
7529
7544SUBROUTINE vol7d_alloc_vol(this, ini, inivol)
7545TYPE(vol7d),INTENT(inout) :: this
7546LOGICAL,INTENT(in),OPTIONAL :: ini
7547LOGICAL,INTENT(in),OPTIONAL :: inivol
7548
7549LOGICAL :: linivol
7550
7551IF (PRESENT(inivol)) THEN
7552 linivol = inivol
7553ELSE
7554 linivol = .true.
7555ENDIF
7556
7557! Anagrafica
7558IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
7559 CALL vol7d_force_alloc_ana(this, ini)
7560 ALLOCATE(this%volanar(SIZE(this%ana), SIZE(this%anavar%r), SIZE(this%network)))
7561 IF (linivol) this%volanar(:,:,:) = rmiss
7562ENDIF
7563
7564IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
7565 CALL vol7d_force_alloc_ana(this, ini)
7566 ALLOCATE(this%volanad(SIZE(this%ana), SIZE(this%anavar%d), SIZE(this%network)))
7567 IF (linivol) this%volanad(:,:,:) = rdmiss
7568ENDIF
7569
7570IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
7571 CALL vol7d_force_alloc_ana(this, ini)
7572 ALLOCATE(this%volanai(SIZE(this%ana), SIZE(this%anavar%i), SIZE(this%network)))
7573 IF (linivol) this%volanai(:,:,:) = imiss
7574ENDIF
7575
7576IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
7577 CALL vol7d_force_alloc_ana(this, ini)
7578 ALLOCATE(this%volanab(SIZE(this%ana), SIZE(this%anavar%b), SIZE(this%network)))
7579 IF (linivol) this%volanab(:,:,:) = ibmiss
7580ENDIF
7581
7582IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
7583 CALL vol7d_force_alloc_ana(this, ini)
7584 ALLOCATE(this%volanac(SIZE(this%ana), SIZE(this%anavar%c), SIZE(this%network)))
7585 IF (linivol) this%volanac(:,:,:) = cmiss
7586ENDIF
7587
7588! Attributi dell'anagrafica
7589IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
7590 .NOT.ASSOCIATED(this%volanaattrr)) THEN
7591 CALL vol7d_force_alloc_ana(this, ini)
7592 ALLOCATE(this%volanaattrr(SIZE(this%ana), SIZE(this%anavarattr%r), &
7593 SIZE(this%network), SIZE(this%anaattr%r)))
7594 IF (linivol) this%volanaattrr(:,:,:,:) = rmiss
7595ENDIF
7596
7597IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
7598 .NOT.ASSOCIATED(this%volanaattrd)) THEN
7599 CALL vol7d_force_alloc_ana(this, ini)
7600 ALLOCATE(this%volanaattrd(SIZE(this%ana), SIZE(this%anavarattr%d), &
7601 SIZE(this%network), SIZE(this%anaattr%d)))
7602 IF (linivol) this%volanaattrd(:,:,:,:) = rdmiss
7603ENDIF
7604
7605IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
7606 .NOT.ASSOCIATED(this%volanaattri)) THEN
7607 CALL vol7d_force_alloc_ana(this, ini)
7608 ALLOCATE(this%volanaattri(SIZE(this%ana), SIZE(this%anavarattr%i), &
7609 SIZE(this%network), SIZE(this%anaattr%i)))
7610 IF (linivol) this%volanaattri(:,:,:,:) = imiss
7611ENDIF
7612
7613IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
7614 .NOT.ASSOCIATED(this%volanaattrb)) THEN
7615 CALL vol7d_force_alloc_ana(this, ini)
7616 ALLOCATE(this%volanaattrb(SIZE(this%ana), SIZE(this%anavarattr%b), &
7617 SIZE(this%network), SIZE(this%anaattr%b)))
7618 IF (linivol) this%volanaattrb(:,:,:,:) = ibmiss
7619ENDIF
7620
7621IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
7622 .NOT.ASSOCIATED(this%volanaattrc)) THEN
7623 CALL vol7d_force_alloc_ana(this, ini)
7624 ALLOCATE(this%volanaattrc(SIZE(this%ana), SIZE(this%anavarattr%c), &
7625 SIZE(this%network), SIZE(this%anaattr%c)))
7626 IF (linivol) this%volanaattrc(:,:,:,:) = cmiss
7627ENDIF
7628
7629! Dati
7630IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
7631 CALL vol7d_force_alloc_dati(this, ini)
7632 ALLOCATE(this%voldatir(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7633 SIZE(this%timerange), SIZE(this%dativar%r), SIZE(this%network)))
7634 IF (linivol) this%voldatir(:,:,:,:,:,:) = rmiss
7635ENDIF
7636
7637IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
7638 CALL vol7d_force_alloc_dati(this, ini)
7639 ALLOCATE(this%voldatid(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7640 SIZE(this%timerange), SIZE(this%dativar%d), SIZE(this%network)))
7641 IF (linivol) this%voldatid(:,:,:,:,:,:) = rdmiss
7642ENDIF
7643
7644IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
7645 CALL vol7d_force_alloc_dati(this, ini)
7646 ALLOCATE(this%voldatii(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7647 SIZE(this%timerange), SIZE(this%dativar%i), SIZE(this%network)))
7648 IF (linivol) this%voldatii(:,:,:,:,:,:) = imiss
7649ENDIF
7650
7651IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
7652 CALL vol7d_force_alloc_dati(this, ini)
7653 ALLOCATE(this%voldatib(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7654 SIZE(this%timerange), SIZE(this%dativar%b), SIZE(this%network)))
7655 IF (linivol) this%voldatib(:,:,:,:,:,:) = ibmiss
7656ENDIF
7657
7658IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
7659 CALL vol7d_force_alloc_dati(this, ini)
7660 ALLOCATE(this%voldatic(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7661 SIZE(this%timerange), SIZE(this%dativar%c), SIZE(this%network)))
7662 IF (linivol) this%voldatic(:,:,:,:,:,:) = cmiss
7663ENDIF
7664
7665! Attributi dei dati
7666IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
7667 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
7668 CALL vol7d_force_alloc_dati(this, ini)
7669 ALLOCATE(this%voldatiattrr(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7670 SIZE(this%timerange), SIZE(this%dativarattr%r), SIZE(this%network), &
7671 SIZE(this%datiattr%r)))
7672 IF (linivol) this%voldatiattrr(:,:,:,:,:,:,:) = rmiss
7673ENDIF
7674
7675IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
7676 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
7677 CALL vol7d_force_alloc_dati(this, ini)
7678 ALLOCATE(this%voldatiattrd(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7679 SIZE(this%timerange), SIZE(this%dativarattr%d), SIZE(this%network), &
7680 SIZE(this%datiattr%d)))
7681 IF (linivol) this%voldatiattrd(:,:,:,:,:,:,:) = rdmiss
7682ENDIF
7683
7684IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
7685 .NOT.ASSOCIATED(this%voldatiattri)) THEN
7686 CALL vol7d_force_alloc_dati(this, ini)
7687 ALLOCATE(this%voldatiattri(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7688 SIZE(this%timerange), SIZE(this%dativarattr%i), SIZE(this%network), &
7689 SIZE(this%datiattr%i)))
7690 IF (linivol) this%voldatiattri(:,:,:,:,:,:,:) = imiss
7691ENDIF
7692
7693IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
7694 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
7695 CALL vol7d_force_alloc_dati(this, ini)
7696 ALLOCATE(this%voldatiattrb(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7697 SIZE(this%timerange), SIZE(this%dativarattr%b), SIZE(this%network), &
7698 SIZE(this%datiattr%b)))
7699 IF (linivol) this%voldatiattrb(:,:,:,:,:,:,:) = ibmiss
7700ENDIF
7701
7702IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
7703 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
7704 CALL vol7d_force_alloc_dati(this, ini)
7705 ALLOCATE(this%voldatiattrc(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7706 SIZE(this%timerange), SIZE(this%dativarattr%c), SIZE(this%network), &
7707 SIZE(this%datiattr%c)))
7708 IF (linivol) this%voldatiattrc(:,:,:,:,:,:,:) = cmiss
7709ENDIF
7710
7711! Catch-all method
7712CALL vol7d_force_alloc(this)
7713
7714! Creo gli indici var-attr
7715
7716#ifdef DEBUG
7717CALL l4f_log(l4f_debug,"calling: vol7d_set_attr_ind")
7718#endif
7719
7720CALL vol7d_set_attr_ind(this)
7721
7722
7723
7724END SUBROUTINE vol7d_alloc_vol
7725
7726
7733SUBROUTINE vol7d_set_attr_ind(this)
7734TYPE(vol7d),INTENT(inout) :: this
7735
7736INTEGER :: i
7737
7738! real
7739IF (ASSOCIATED(this%dativar%r)) THEN
7740 IF (ASSOCIATED(this%dativarattr%r)) THEN
7741 DO i = 1, SIZE(this%dativar%r)
7742 this%dativar%r(i)%r = &
7743 firsttrue(this%dativar%r(i)%btable == this%dativarattr%r(:)%btable)
7744 ENDDO
7745 ENDIF
7746
7747 IF (ASSOCIATED(this%dativarattr%d)) THEN
7748 DO i = 1, SIZE(this%dativar%r)
7749 this%dativar%r(i)%d = &
7750 firsttrue(this%dativar%r(i)%btable == this%dativarattr%d(:)%btable)
7751 ENDDO
7752 ENDIF
7753
7754 IF (ASSOCIATED(this%dativarattr%i)) THEN
7755 DO i = 1, SIZE(this%dativar%r)
7756 this%dativar%r(i)%i = &
7757 firsttrue(this%dativar%r(i)%btable == this%dativarattr%i(:)%btable)
7758 ENDDO
7759 ENDIF
7760
7761 IF (ASSOCIATED(this%dativarattr%b)) THEN
7762 DO i = 1, SIZE(this%dativar%r)
7763 this%dativar%r(i)%b = &
7764 firsttrue(this%dativar%r(i)%btable == this%dativarattr%b(:)%btable)
7765 ENDDO
7766 ENDIF
7767
7768 IF (ASSOCIATED(this%dativarattr%c)) THEN
7769 DO i = 1, SIZE(this%dativar%r)
7770 this%dativar%r(i)%c = &
7771 firsttrue(this%dativar%r(i)%btable == this%dativarattr%c(:)%btable)
7772 ENDDO
7773 ENDIF
7774ENDIF
7775! double
7776IF (ASSOCIATED(this%dativar%d)) THEN
7777 IF (ASSOCIATED(this%dativarattr%r)) THEN
7778 DO i = 1, SIZE(this%dativar%d)
7779 this%dativar%d(i)%r = &
7780 firsttrue(this%dativar%d(i)%btable == this%dativarattr%r(:)%btable)
7781 ENDDO
7782 ENDIF
7783
7784 IF (ASSOCIATED(this%dativarattr%d)) THEN
7785 DO i = 1, SIZE(this%dativar%d)
7786 this%dativar%d(i)%d = &
7787 firsttrue(this%dativar%d(i)%btable == this%dativarattr%d(:)%btable)
7788 ENDDO
7789 ENDIF
7790
7791 IF (ASSOCIATED(this%dativarattr%i)) THEN
7792 DO i = 1, SIZE(this%dativar%d)
7793 this%dativar%d(i)%i = &
7794 firsttrue(this%dativar%d(i)%btable == this%dativarattr%i(:)%btable)
7795 ENDDO
7796 ENDIF
7797
7798 IF (ASSOCIATED(this%dativarattr%b)) THEN
7799 DO i = 1, SIZE(this%dativar%d)
7800 this%dativar%d(i)%b = &
7801 firsttrue(this%dativar%d(i)%btable == this%dativarattr%b(:)%btable)
7802 ENDDO
7803 ENDIF
7804
7805 IF (ASSOCIATED(this%dativarattr%c)) THEN
7806 DO i = 1, SIZE(this%dativar%d)
7807 this%dativar%d(i)%c = &
7808 firsttrue(this%dativar%d(i)%btable == this%dativarattr%c(:)%btable)
7809 ENDDO
7810 ENDIF
7811ENDIF
7812! integer
7813IF (ASSOCIATED(this%dativar%i)) THEN
7814 IF (ASSOCIATED(this%dativarattr%r)) THEN
7815 DO i = 1, SIZE(this%dativar%i)
7816 this%dativar%i(i)%r = &
7817 firsttrue(this%dativar%i(i)%btable == this%dativarattr%r(:)%btable)
7818 ENDDO
7819 ENDIF
7820
7821 IF (ASSOCIATED(this%dativarattr%d)) THEN
7822 DO i = 1, SIZE(this%dativar%i)
7823 this%dativar%i(i)%d = &
7824 firsttrue(this%dativar%i(i)%btable == this%dativarattr%d(:)%btable)
7825 ENDDO
7826 ENDIF
7827
7828 IF (ASSOCIATED(this%dativarattr%i)) THEN
7829 DO i = 1, SIZE(this%dativar%i)
7830 this%dativar%i(i)%i = &
7831 firsttrue(this%dativar%i(i)%btable == this%dativarattr%i(:)%btable)
7832 ENDDO
7833 ENDIF
7834
7835 IF (ASSOCIATED(this%dativarattr%b)) THEN
7836 DO i = 1, SIZE(this%dativar%i)
7837 this%dativar%i(i)%b = &
7838 firsttrue(this%dativar%i(i)%btable == this%dativarattr%b(:)%btable)
7839 ENDDO
7840 ENDIF
7841
7842 IF (ASSOCIATED(this%dativarattr%c)) THEN
7843 DO i = 1, SIZE(this%dativar%i)
7844 this%dativar%i(i)%c = &
7845 firsttrue(this%dativar%i(i)%btable == this%dativarattr%c(:)%btable)
7846 ENDDO
7847 ENDIF
7848ENDIF
7849! byte
7850IF (ASSOCIATED(this%dativar%b)) THEN
7851 IF (ASSOCIATED(this%dativarattr%r)) THEN
7852 DO i = 1, SIZE(this%dativar%b)
7853 this%dativar%b(i)%r = &
7854 firsttrue(this%dativar%b(i)%btable == this%dativarattr%r(:)%btable)
7855 ENDDO
7856 ENDIF
7857
7858 IF (ASSOCIATED(this%dativarattr%d)) THEN
7859 DO i = 1, SIZE(this%dativar%b)
7860 this%dativar%b(i)%d = &
7861 firsttrue(this%dativar%b(i)%btable == this%dativarattr%d(:)%btable)
7862 ENDDO
7863 ENDIF
7864
7865 IF (ASSOCIATED(this%dativarattr%i)) THEN
7866 DO i = 1, SIZE(this%dativar%b)
7867 this%dativar%b(i)%i = &
7868 firsttrue(this%dativar%b(i)%btable == this%dativarattr%i(:)%btable)
7869 ENDDO
7870 ENDIF
7871
7872 IF (ASSOCIATED(this%dativarattr%b)) THEN
7873 DO i = 1, SIZE(this%dativar%b)
7874 this%dativar%b(i)%b = &
7875 firsttrue(this%dativar%b(i)%btable == this%dativarattr%b(:)%btable)
7876 ENDDO
7877 ENDIF
7878
7879 IF (ASSOCIATED(this%dativarattr%c)) THEN
7880 DO i = 1, SIZE(this%dativar%b)
7881 this%dativar%b(i)%c = &
7882 firsttrue(this%dativar%b(i)%btable == this%dativarattr%c(:)%btable)
7883 ENDDO
7884 ENDIF
7885ENDIF
7886! character
7887IF (ASSOCIATED(this%dativar%c)) THEN
7888 IF (ASSOCIATED(this%dativarattr%r)) THEN
7889 DO i = 1, SIZE(this%dativar%c)
7890 this%dativar%c(i)%r = &
7891 firsttrue(this%dativar%c(i)%btable == this%dativarattr%r(:)%btable)
7892 ENDDO
7893 ENDIF
7894
7895 IF (ASSOCIATED(this%dativarattr%d)) THEN
7896 DO i = 1, SIZE(this%dativar%c)
7897 this%dativar%c(i)%d = &
7898 firsttrue(this%dativar%c(i)%btable == this%dativarattr%d(:)%btable)
7899 ENDDO
7900 ENDIF
7901
7902 IF (ASSOCIATED(this%dativarattr%i)) THEN
7903 DO i = 1, SIZE(this%dativar%c)
7904 this%dativar%c(i)%i = &
7905 firsttrue(this%dativar%c(i)%btable == this%dativarattr%i(:)%btable)
7906 ENDDO
7907 ENDIF
7908
7909 IF (ASSOCIATED(this%dativarattr%b)) THEN
7910 DO i = 1, SIZE(this%dativar%c)
7911 this%dativar%c(i)%b = &
7912 firsttrue(this%dativar%c(i)%btable == this%dativarattr%b(:)%btable)
7913 ENDDO
7914 ENDIF
7915
7916 IF (ASSOCIATED(this%dativarattr%c)) THEN
7917 DO i = 1, SIZE(this%dativar%c)
7918 this%dativar%c(i)%c = &
7919 firsttrue(this%dativar%c(i)%btable == this%dativarattr%c(:)%btable)
7920 ENDDO
7921 ENDIF
7922ENDIF
7923
7924END SUBROUTINE vol7d_set_attr_ind
7925
7926
7931SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
7932 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
7933TYPE(vol7d),INTENT(INOUT) :: this
7934TYPE(vol7d),INTENT(INOUT) :: that
7935LOGICAL,INTENT(IN),OPTIONAL :: sort
7936LOGICAL,INTENT(in),OPTIONAL :: bestdata
7937LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple ! experimental, please do not use outside the library now
7938
7939TYPE(vol7d) :: v7d_clean
7940
7941
7943 this = that
7945 that = v7d_clean ! destroy that without deallocating
7946ELSE ! Append that to this and destroy that
7948 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
7950ENDIF
7951
7952END SUBROUTINE vol7d_merge
7953
7954
7983SUBROUTINE vol7d_append(this, that, sort, bestdata, &
7984 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
7985TYPE(vol7d),INTENT(INOUT) :: this
7986TYPE(vol7d),INTENT(IN) :: that
7987LOGICAL,INTENT(IN),OPTIONAL :: sort
7988! experimental, please do not use outside the library now, they force the use
7989! of a simplified mapping algorithm which is valid only whene the dimension
7990! content is the same in both volumes , or when one of them is empty
7991LOGICAL,INTENT(in),OPTIONAL :: bestdata
7992LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple
7993
7994
7995TYPE(vol7d) :: v7dtmp
7996LOGICAL :: lsort, lbestdata
7997INTEGER,POINTER :: remapt1(:), remapt2(:), remaptr1(:), remaptr2(:), &
7998 remapl1(:), remapl2(:), remapa1(:), remapa2(:), remapn1(:), remapn2(:)
7999
8001IF (.NOT.vol7d_check_vol(that)) RETURN ! be safe
8004 RETURN
8005ENDIF
8006
8007IF (this%time_definition /= that%time_definition) THEN
8008 CALL l4f_log(l4f_fatal, &
8009 'in vol7d_append, cannot append volumes with different &
8010 &time definition')
8011 CALL raise_fatal_error()
8012ENDIF
8013
8014! Completo l'allocazione per avere volumi a norma
8015CALL vol7d_alloc_vol(this)
8016
8020
8021! Calcolo le mappature tra volumi vecchi e volume nuovo
8022! I puntatori remap* vengono tutti o allocati o nullificati
8023IF (optio_log(ltimesimple)) THEN
8024 CALL vol7d_remap2simple_datetime(this%time, that%time, v7dtmp%time, &
8025 lsort, remapt1, remapt2)
8026ELSE
8027 CALL vol7d_remap2_datetime(this%time, that%time, v7dtmp%time, &
8028 lsort, remapt1, remapt2)
8029ENDIF
8030IF (optio_log(ltimerangesimple)) THEN
8031 CALL vol7d_remap2simple_vol7d_timerange(this%timerange, that%timerange, &
8032 v7dtmp%timerange, lsort, remaptr1, remaptr2)
8033ELSE
8034 CALL vol7d_remap2_vol7d_timerange(this%timerange, that%timerange, &
8035 v7dtmp%timerange, lsort, remaptr1, remaptr2)
8036ENDIF
8037IF (optio_log(llevelsimple)) THEN
8038 CALL vol7d_remap2simple_vol7d_level(this%level, that%level, v7dtmp%level, &
8039 lsort, remapl1, remapl2)
8040ELSE
8041 CALL vol7d_remap2_vol7d_level(this%level, that%level, v7dtmp%level, &
8042 lsort, remapl1, remapl2)
8043ENDIF
8044IF (optio_log(lanasimple)) THEN
8045 CALL vol7d_remap2simple_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
8046 .false., remapa1, remapa2)
8047ELSE
8048 CALL vol7d_remap2_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
8049 .false., remapa1, remapa2)
8050ENDIF
8051IF (optio_log(lnetworksimple)) THEN
8052 CALL vol7d_remap2simple_vol7d_network(this%network, that%network, v7dtmp%network, &
8053 .false., remapn1, remapn2)
8054ELSE
8055 CALL vol7d_remap2_vol7d_network(this%network, that%network, v7dtmp%network, &
8056 .false., remapn1, remapn2)
8057ENDIF
8058
8059! Faccio la fusione fisica dei volumi
8060CALL vol7d_merge_finalr(this, that, v7dtmp, &
8061 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
8062 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
8063CALL vol7d_merge_finald(this, that, v7dtmp, &
8064 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
8065 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
8066CALL vol7d_merge_finali(this, that, v7dtmp, &
8067 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
8068 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
8069CALL vol7d_merge_finalb(this, that, v7dtmp, &
8070 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
8071 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
8072CALL vol7d_merge_finalc(this, that, v7dtmp, &
8073 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
8074 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
8075
8076! Dealloco i vettori di rimappatura
8077IF (ASSOCIATED(remapt1)) DEALLOCATE(remapt1)
8078IF (ASSOCIATED(remapt2)) DEALLOCATE(remapt2)
8079IF (ASSOCIATED(remaptr1)) DEALLOCATE(remaptr1)
8080IF (ASSOCIATED(remaptr2)) DEALLOCATE(remaptr2)
8081IF (ASSOCIATED(remapl1)) DEALLOCATE(remapl1)
8082IF (ASSOCIATED(remapl2)) DEALLOCATE(remapl2)
8083IF (ASSOCIATED(remapa1)) DEALLOCATE(remapa1)
8084IF (ASSOCIATED(remapa2)) DEALLOCATE(remapa2)
8085IF (ASSOCIATED(remapn1)) DEALLOCATE(remapn1)
8086IF (ASSOCIATED(remapn2)) DEALLOCATE(remapn2)
8087
8088! Distruggo il vecchio volume e assegno il nuovo a this
8090this = v7dtmp
8091! Ricreo gli indici var-attr
8092CALL vol7d_set_attr_ind(this)
8093
8094END SUBROUTINE vol7d_append
8095
8096
8129SUBROUTINE vol7d_copy(this, that, sort, unique, miss, &
8130 lsort_time, lsort_timerange, lsort_level, &
8131 ltime, ltimerange, llevel, lana, lnetwork, &
8132 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
8133 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
8134 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
8135 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
8136 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
8137 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
8138TYPE(vol7d),INTENT(IN) :: this
8139TYPE(vol7d),INTENT(INOUT) :: that
8140LOGICAL,INTENT(IN),OPTIONAL :: sort
8141LOGICAL,INTENT(IN),OPTIONAL :: unique
8142LOGICAL,INTENT(IN),OPTIONAL :: miss
8143LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
8144LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
8145LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
8153LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
8155LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
8157LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
8159LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
8161LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
8163LOGICAL,INTENT(in),OPTIONAL :: &
8164 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
8165 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
8166 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
8167 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
8168 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
8169 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
8170
8171LOGICAL :: lsort, lunique, lmiss
8172INTEGER,POINTER :: remapt(:), remaptr(:), remapl(:), remapa(:), remapn(:)
8173
8176IF (.NOT.vol7d_check_vol(this)) RETURN ! be safe
8177
8181
8182! Calcolo le mappature tra volume vecchio e volume nuovo
8183! I puntatori remap* vengono tutti o allocati o nullificati
8184CALL vol7d_remap1_datetime(this%time, that%time, &
8185 lsort.OR.optio_log(lsort_time), lunique, lmiss, remapt, ltime)
8186CALL vol7d_remap1_vol7d_timerange(this%timerange, that%timerange, &
8187 lsort.OR.optio_log(lsort_timerange), lunique, lmiss, remaptr, ltimerange)
8188CALL vol7d_remap1_vol7d_level(this%level, that%level, &
8189 lsort.OR.optio_log(lsort_level), lunique, lmiss, remapl, llevel)
8190CALL vol7d_remap1_vol7d_ana(this%ana, that%ana, &
8191 lsort, lunique, lmiss, remapa, lana)
8192CALL vol7d_remap1_vol7d_network(this%network, that%network, &
8193 lsort, lunique, lmiss, remapn, lnetwork)
8194
8195! lanavari, lanavarb, lanavarc, &
8196! lanaattri, lanaattrb, lanaattrc, &
8197! lanavarattri, lanavarattrb, lanavarattrc, &
8198! ldativari, ldativarb, ldativarc, &
8199! ldatiattri, ldatiattrb, ldatiattrc, &
8200! ldativarattri, ldativarattrb, ldativarattrc
8201! Faccio la riforma fisica dei volumi
8202CALL vol7d_reform_finalr(this, that, &
8203 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8204 lanavarr, lanaattrr, lanavarattrr, ldativarr, ldatiattrr, ldativarattrr)
8205CALL vol7d_reform_finald(this, that, &
8206 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8207 lanavard, lanaattrd, lanavarattrd, ldativard, ldatiattrd, ldativarattrd)
8208CALL vol7d_reform_finali(this, that, &
8209 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8210 lanavari, lanaattri, lanavarattri, ldativari, ldatiattri, ldativarattri)
8211CALL vol7d_reform_finalb(this, that, &
8212 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8213 lanavarb, lanaattrb, lanavarattrb, ldativarb, ldatiattrb, ldativarattrb)
8214CALL vol7d_reform_finalc(this, that, &
8215 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8216 lanavarc, lanaattrc, lanavarattrc, ldativarc, ldatiattrc, ldativarattrc)
8217
8218! Dealloco i vettori di rimappatura
8219IF (ASSOCIATED(remapt)) DEALLOCATE(remapt)
8220IF (ASSOCIATED(remaptr)) DEALLOCATE(remaptr)
8221IF (ASSOCIATED(remapl)) DEALLOCATE(remapl)
8222IF (ASSOCIATED(remapa)) DEALLOCATE(remapa)
8223IF (ASSOCIATED(remapn)) DEALLOCATE(remapn)
8224
8225! Ricreo gli indici var-attr
8226CALL vol7d_set_attr_ind(that)
8227that%time_definition = this%time_definition
8228
8229END SUBROUTINE vol7d_copy
8230
8231
8242SUBROUTINE vol7d_reform(this, sort, unique, miss, &
8243 lsort_time, lsort_timerange, lsort_level, &
8244 ltime, ltimerange, llevel, lana, lnetwork, &
8245 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
8246 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
8247 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
8248 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
8249 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
8250 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc&
8251 ,purgeana)
8252TYPE(vol7d),INTENT(INOUT) :: this
8253LOGICAL,INTENT(IN),OPTIONAL :: sort
8254LOGICAL,INTENT(IN),OPTIONAL :: unique
8255LOGICAL,INTENT(IN),OPTIONAL :: miss
8256LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
8257LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
8258LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
8266LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
8267LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
8268LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
8269LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
8270LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
8272LOGICAL,INTENT(in),OPTIONAL :: &
8273 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
8274 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
8275 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
8276 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
8277 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
8278 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
8279LOGICAL,INTENT(IN),OPTIONAL :: purgeana
8280
8281TYPE(vol7d) :: v7dtmp
8282logical,allocatable :: llana(:)
8283integer :: i
8284
8286 lsort_time, lsort_timerange, lsort_level, &
8287 ltime, ltimerange, llevel, lana, lnetwork, &
8288 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
8289 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
8290 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
8291 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
8292 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
8293 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
8294
8295! destroy old volume
8297
8298if (optio_log(purgeana)) then
8299 allocate(llana(size(v7dtmp%ana)))
8300 llana =.false.
8301 do i =1,size(v7dtmp%ana)
8302 if (associated(v7dtmp%voldatii)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatii(i,:,:,:,:,:)))
8303 if (associated(v7dtmp%voldatir)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatir(i,:,:,:,:,:)))
8304 if (associated(v7dtmp%voldatid)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatid(i,:,:,:,:,:)))
8305 if (associated(v7dtmp%voldatib)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatib(i,:,:,:,:,:)))
8306 if (associated(v7dtmp%voldatic)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatic(i,:,:,:,:,:)))
8307 end do
8308 CALL vol7d_copy(v7dtmp, this,lana=llana)
8310 deallocate(llana)
8311else
8312 this=v7dtmp
8313end if
8314
8315END SUBROUTINE vol7d_reform
8316
8317
8325SUBROUTINE vol7d_smart_sort(this, lsort_time, lsort_timerange, lsort_level)
8326TYPE(vol7d),INTENT(INOUT) :: this
8327LOGICAL,OPTIONAL,INTENT(in) :: lsort_time
8328LOGICAL,OPTIONAL,INTENT(in) :: lsort_timerange
8329LOGICAL,OPTIONAL,INTENT(in) :: lsort_level
8330
8331INTEGER :: i
8332LOGICAL :: to_be_sorted
8333
8334to_be_sorted = .false.
8335CALL vol7d_alloc_vol(this) ! usual safety check
8336
8337IF (optio_log(lsort_time)) THEN
8338 DO i = 2, SIZE(this%time)
8339 IF (this%time(i) < this%time(i-1)) THEN
8340 to_be_sorted = .true.
8341 EXIT
8342 ENDIF
8343 ENDDO
8344ENDIF
8345IF (optio_log(lsort_timerange)) THEN
8346 DO i = 2, SIZE(this%timerange)
8347 IF (this%timerange(i) < this%timerange(i-1)) THEN
8348 to_be_sorted = .true.
8349 EXIT
8350 ENDIF
8351 ENDDO
8352ENDIF
8353IF (optio_log(lsort_level)) THEN
8354 DO i = 2, SIZE(this%level)
8355 IF (this%level(i) < this%level(i-1)) THEN
8356 to_be_sorted = .true.
8357 EXIT
8358 ENDIF
8359 ENDDO
8360ENDIF
8361
8362IF (to_be_sorted) CALL vol7d_reform(this, &
8363 lsort_time=lsort_time, lsort_timerange=lsort_timerange, lsort_level=lsort_level )
8364
8365END SUBROUTINE vol7d_smart_sort
8366
8374SUBROUTINE vol7d_filter(this, avl, vl, nl, s_d, e_d)
8375TYPE(vol7d),INTENT(inout) :: this
8376CHARACTER(len=*),INTENT(in),OPTIONAL :: avl(:)
8377CHARACTER(len=*),INTENT(in),OPTIONAL :: vl(:)
8378TYPE(vol7d_network),OPTIONAL :: nl(:)
8379TYPE(datetime),INTENT(in),OPTIONAL :: s_d
8380TYPE(datetime),INTENT(in),OPTIONAL :: e_d
8381
8382INTEGER :: i
8383
8384IF (PRESENT(avl)) THEN
8385 IF (SIZE(avl) > 0) THEN
8386
8387 IF (ASSOCIATED(this%anavar%r)) THEN
8388 DO i = 1, SIZE(this%anavar%r)
8389 IF (all(this%anavar%r(i)%btable /= avl)) this%anavar%r(i) = vol7d_var_miss
8390 ENDDO
8391 ENDIF
8392
8393 IF (ASSOCIATED(this%anavar%i)) THEN
8394 DO i = 1, SIZE(this%anavar%i)
8395 IF (all(this%anavar%i(i)%btable /= avl)) this%anavar%i(i) = vol7d_var_miss
8396 ENDDO
8397 ENDIF
8398
8399 IF (ASSOCIATED(this%anavar%b)) THEN
8400 DO i = 1, SIZE(this%anavar%b)
8401 IF (all(this%anavar%b(i)%btable /= avl)) this%anavar%b(i) = vol7d_var_miss
8402 ENDDO
8403 ENDIF
8404
8405 IF (ASSOCIATED(this%anavar%d)) THEN
8406 DO i = 1, SIZE(this%anavar%d)
8407 IF (all(this%anavar%d(i)%btable /= avl)) this%anavar%d(i) = vol7d_var_miss
8408 ENDDO
8409 ENDIF
8410
8411 IF (ASSOCIATED(this%anavar%c)) THEN
8412 DO i = 1, SIZE(this%anavar%c)
8413 IF (all(this%anavar%c(i)%btable /= avl)) this%anavar%c(i) = vol7d_var_miss
8414 ENDDO
8415 ENDIF
8416
8417 ENDIF
8418ENDIF
8419
8420
8421IF (PRESENT(vl)) THEN
8422 IF (size(vl) > 0) THEN
8423 IF (ASSOCIATED(this%dativar%r)) THEN
8424 DO i = 1, SIZE(this%dativar%r)
8425 IF (all(this%dativar%r(i)%btable /= vl)) this%dativar%r(i) = vol7d_var_miss
8426 ENDDO
8427 ENDIF
8428
8429 IF (ASSOCIATED(this%dativar%i)) THEN
8430 DO i = 1, SIZE(this%dativar%i)
8431 IF (all(this%dativar%i(i)%btable /= vl)) this%dativar%i(i) = vol7d_var_miss
8432 ENDDO
8433 ENDIF
8434
8435 IF (ASSOCIATED(this%dativar%b)) THEN
8436 DO i = 1, SIZE(this%dativar%b)
8437 IF (all(this%dativar%b(i)%btable /= vl)) this%dativar%b(i) = vol7d_var_miss
8438 ENDDO
8439 ENDIF
8440
8441 IF (ASSOCIATED(this%dativar%d)) THEN
8442 DO i = 1, SIZE(this%dativar%d)
8443 IF (all(this%dativar%d(i)%btable /= vl)) this%dativar%d(i) = vol7d_var_miss
8444 ENDDO
8445 ENDIF
8446
8447 IF (ASSOCIATED(this%dativar%c)) THEN
8448 DO i = 1, SIZE(this%dativar%c)
8449 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
8450 ENDDO
8451 ENDIF
8452
8453 IF (ASSOCIATED(this%dativar%c)) THEN
8454 DO i = 1, SIZE(this%dativar%c)
8455 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
8456 ENDDO
8457 ENDIF
8458
8459 ENDIF
8460ENDIF
8461
8462IF (PRESENT(nl)) THEN
8463 IF (SIZE(nl) > 0) THEN
8464 DO i = 1, SIZE(this%network)
8465 IF (all(this%network(i) /= nl)) this%network(i) = vol7d_network_miss
8466 ENDDO
8467 ENDIF
8468ENDIF
8469
8470IF (PRESENT(s_d)) THEN
8472 WHERE (this%time < s_d)
8473 this%time = datetime_miss
8474 END WHERE
8475 ENDIF
8476ENDIF
8477
8478IF (PRESENT(e_d)) THEN
8480 WHERE (this%time > e_d)
8481 this%time = datetime_miss
8482 END WHERE
8483 ENDIF
8484ENDIF
8485
8486CALL vol7d_reform(this, miss=.true.)
8487
8488END SUBROUTINE vol7d_filter
8489
8490
8497SUBROUTINE vol7d_convr(this, that, anaconv)
8498TYPE(vol7d),INTENT(IN) :: this
8499TYPE(vol7d),INTENT(INOUT) :: that
8500LOGICAL,OPTIONAL,INTENT(in) :: anaconv
8501INTEGER :: i
8502LOGICAL :: fv(1)=(/.false./), tv(1)=(/.true./), acp(1), acn(1)
8503TYPE(vol7d) :: v7d_tmp
8504
8505IF (optio_log(anaconv)) THEN
8506 acp=fv
8507 acn=tv
8508ELSE
8509 acp=tv
8510 acn=fv
8511ENDIF
8512
8513! Volume con solo i dati reali e tutti gli attributi
8514! l'anagrafica e` copiata interamente se necessario
8515CALL vol7d_copy(this, that, &
8516 lanavarr=tv, lanavard=acp, lanavari=acp, lanavarb=acp, lanavarc=acp, &
8517 ldativarr=tv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=fv)
8518
8519! Volume solo di dati double
8520CALL vol7d_copy(this, v7d_tmp, &
8521 lanavarr=fv, lanavard=acn, lanavari=fv, lanavarb=fv, lanavarc=fv, &
8522 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8523 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8524 ldativarr=fv, ldativard=tv, ldativari=fv, ldativarb=fv, ldativarc=fv, &
8525 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8526 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8527
8528! converto a dati reali
8529IF (ASSOCIATED(v7d_tmp%anavar%d) .OR. ASSOCIATED(v7d_tmp%dativar%d)) THEN
8530
8531 IF (ASSOCIATED(v7d_tmp%anavar%d)) THEN
8532! alloco i dati reali e vi trasferisco i double
8533 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanad, 1), SIZE(v7d_tmp%volanad, 2), &
8534 SIZE(v7d_tmp%volanad, 3)))
8535 DO i = 1, SIZE(v7d_tmp%anavar%d)
8536 v7d_tmp%volanar(:,i,:) = &
8537 realdat(v7d_tmp%volanad(:,i,:), v7d_tmp%anavar%d(i))
8538 ENDDO
8539 DEALLOCATE(v7d_tmp%volanad)
8540! trasferisco le variabili
8541 v7d_tmp%anavar%r => v7d_tmp%anavar%d
8542 NULLIFY(v7d_tmp%anavar%d)
8543 ENDIF
8544
8545 IF (ASSOCIATED(v7d_tmp%dativar%d)) THEN
8546! alloco i dati reali e vi trasferisco i double
8547 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatid, 1), SIZE(v7d_tmp%voldatid, 2), &
8548 SIZE(v7d_tmp%voldatid, 3), SIZE(v7d_tmp%voldatid, 4), SIZE(v7d_tmp%voldatid, 5), &
8549 SIZE(v7d_tmp%voldatid, 6)))
8550 DO i = 1, SIZE(v7d_tmp%dativar%d)
8551 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8552 realdat(v7d_tmp%voldatid(:,:,:,:,i,:), v7d_tmp%dativar%d(i))
8553 ENDDO
8554 DEALLOCATE(v7d_tmp%voldatid)
8555! trasferisco le variabili
8556 v7d_tmp%dativar%r => v7d_tmp%dativar%d
8557 NULLIFY(v7d_tmp%dativar%d)
8558 ENDIF
8559
8560! fondo con il volume definitivo
8561 CALL vol7d_merge(that, v7d_tmp)
8562ELSE
8564ENDIF
8565
8566
8567! Volume solo di dati interi
8568CALL vol7d_copy(this, v7d_tmp, &
8569 lanavarr=fv, lanavard=fv, lanavari=acn, lanavarb=fv, lanavarc=fv, &
8570 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8571 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8572 ldativarr=fv, ldativard=fv, ldativari=tv, ldativarb=fv, ldativarc=fv, &
8573 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8574 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8575
8576! converto a dati reali
8577IF (ASSOCIATED(v7d_tmp%anavar%i) .OR. ASSOCIATED(v7d_tmp%dativar%i)) THEN
8578
8579 IF (ASSOCIATED(v7d_tmp%anavar%i)) THEN
8580! alloco i dati reali e vi trasferisco gli interi
8581 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanai, 1), SIZE(v7d_tmp%volanai, 2), &
8582 SIZE(v7d_tmp%volanai, 3)))
8583 DO i = 1, SIZE(v7d_tmp%anavar%i)
8584 v7d_tmp%volanar(:,i,:) = &
8585 realdat(v7d_tmp%volanai(:,i,:), v7d_tmp%anavar%i(i))
8586 ENDDO
8587 DEALLOCATE(v7d_tmp%volanai)
8588! trasferisco le variabili
8589 v7d_tmp%anavar%r => v7d_tmp%anavar%i
8590 NULLIFY(v7d_tmp%anavar%i)
8591 ENDIF
8592
8593 IF (ASSOCIATED(v7d_tmp%dativar%i)) THEN
8594! alloco i dati reali e vi trasferisco gli interi
8595 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatii, 1), SIZE(v7d_tmp%voldatii, 2), &
8596 SIZE(v7d_tmp%voldatii, 3), SIZE(v7d_tmp%voldatii, 4), SIZE(v7d_tmp%voldatii, 5), &
8597 SIZE(v7d_tmp%voldatii, 6)))
8598 DO i = 1, SIZE(v7d_tmp%dativar%i)
8599 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8600 realdat(v7d_tmp%voldatii(:,:,:,:,i,:), v7d_tmp%dativar%i(i))
8601 ENDDO
8602 DEALLOCATE(v7d_tmp%voldatii)
8603! trasferisco le variabili
8604 v7d_tmp%dativar%r => v7d_tmp%dativar%i
8605 NULLIFY(v7d_tmp%dativar%i)
8606 ENDIF
8607
8608! fondo con il volume definitivo
8609 CALL vol7d_merge(that, v7d_tmp)
8610ELSE
8612ENDIF
8613
8614
8615! Volume solo di dati byte
8616CALL vol7d_copy(this, v7d_tmp, &
8617 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=acn, lanavarc=fv, &
8618 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8619 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8620 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=tv, ldativarc=fv, &
8621 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8622 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8623
8624! converto a dati reali
8625IF (ASSOCIATED(v7d_tmp%anavar%b) .OR. ASSOCIATED(v7d_tmp%dativar%b)) THEN
8626
8627 IF (ASSOCIATED(v7d_tmp%anavar%b)) THEN
8628! alloco i dati reali e vi trasferisco i byte
8629 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanab, 1), SIZE(v7d_tmp%volanab, 2), &
8630 SIZE(v7d_tmp%volanab, 3)))
8631 DO i = 1, SIZE(v7d_tmp%anavar%b)
8632 v7d_tmp%volanar(:,i,:) = &
8633 realdat(v7d_tmp%volanab(:,i,:), v7d_tmp%anavar%b(i))
8634 ENDDO
8635 DEALLOCATE(v7d_tmp%volanab)
8636! trasferisco le variabili
8637 v7d_tmp%anavar%r => v7d_tmp%anavar%b
8638 NULLIFY(v7d_tmp%anavar%b)
8639 ENDIF
8640
8641 IF (ASSOCIATED(v7d_tmp%dativar%b)) THEN
8642! alloco i dati reali e vi trasferisco i byte
8643 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatib, 1), SIZE(v7d_tmp%voldatib, 2), &
8644 SIZE(v7d_tmp%voldatib, 3), SIZE(v7d_tmp%voldatib, 4), SIZE(v7d_tmp%voldatib, 5), &
8645 SIZE(v7d_tmp%voldatib, 6)))
8646 DO i = 1, SIZE(v7d_tmp%dativar%b)
8647 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8648 realdat(v7d_tmp%voldatib(:,:,:,:,i,:), v7d_tmp%dativar%b(i))
8649 ENDDO
8650 DEALLOCATE(v7d_tmp%voldatib)
8651! trasferisco le variabili
8652 v7d_tmp%dativar%r => v7d_tmp%dativar%b
8653 NULLIFY(v7d_tmp%dativar%b)
8654 ENDIF
8655
8656! fondo con il volume definitivo
8657 CALL vol7d_merge(that, v7d_tmp)
8658ELSE
8660ENDIF
8661
8662
8663! Volume solo di dati character
8664CALL vol7d_copy(this, v7d_tmp, &
8665 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=fv, lanavarc=acn, &
8666 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8667 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8668 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=tv, &
8669 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8670 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8671
8672! converto a dati reali
8673IF (ASSOCIATED(v7d_tmp%anavar%c) .OR. ASSOCIATED(v7d_tmp%dativar%c)) THEN
8674
8675 IF (ASSOCIATED(v7d_tmp%anavar%c)) THEN
8676! alloco i dati reali e vi trasferisco i character
8677 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanac, 1), SIZE(v7d_tmp%volanac, 2), &
8678 SIZE(v7d_tmp%volanac, 3)))
8679 DO i = 1, SIZE(v7d_tmp%anavar%c)
8680 v7d_tmp%volanar(:,i,:) = &
8681 realdat(v7d_tmp%volanac(:,i,:), v7d_tmp%anavar%c(i))
8682 ENDDO
8683 DEALLOCATE(v7d_tmp%volanac)
8684! trasferisco le variabili
8685 v7d_tmp%anavar%r => v7d_tmp%anavar%c
8686 NULLIFY(v7d_tmp%anavar%c)
8687 ENDIF
8688
8689 IF (ASSOCIATED(v7d_tmp%dativar%c)) THEN
8690! alloco i dati reali e vi trasferisco i character
8691 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatic, 1), SIZE(v7d_tmp%voldatic, 2), &
8692 SIZE(v7d_tmp%voldatic, 3), SIZE(v7d_tmp%voldatic, 4), SIZE(v7d_tmp%voldatic, 5), &
8693 SIZE(v7d_tmp%voldatic, 6)))
8694 DO i = 1, SIZE(v7d_tmp%dativar%c)
8695 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8696 realdat(v7d_tmp%voldatic(:,:,:,:,i,:), v7d_tmp%dativar%c(i))
8697 ENDDO
8698 DEALLOCATE(v7d_tmp%voldatic)
8699! trasferisco le variabili
8700 v7d_tmp%dativar%r => v7d_tmp%dativar%c
8701 NULLIFY(v7d_tmp%dativar%c)
8702 ENDIF
8703
8704! fondo con il volume definitivo
8705 CALL vol7d_merge(that, v7d_tmp)
8706ELSE
8708ENDIF
8709
8710END SUBROUTINE vol7d_convr
8711
8712
8716SUBROUTINE vol7d_diff_only (this, that, data_only,ana)
8717TYPE(vol7d),INTENT(IN) :: this
8718TYPE(vol7d),INTENT(OUT) :: that
8719logical , optional, intent(in) :: data_only
8720logical , optional, intent(in) :: ana
8721logical :: ldata_only,lana
8722
8723IF (PRESENT(data_only)) THEN
8724 ldata_only = data_only
8725ELSE
8726 ldata_only = .false.
8727ENDIF
8728
8729IF (PRESENT(ana)) THEN
8730 lana = ana
8731ELSE
8732 lana = .false.
8733ENDIF
8734
8735
8736#undef VOL7D_POLY_ARRAY
8737#define VOL7D_POLY_ARRAY voldati
8738#include "vol7d_class_diff.F90"
8739#undef VOL7D_POLY_ARRAY
8740#define VOL7D_POLY_ARRAY voldatiattr
8741#include "vol7d_class_diff.F90"
8742#undef VOL7D_POLY_ARRAY
8743
8744if ( .not. ldata_only) then
8745
8746#define VOL7D_POLY_ARRAY volana
8747#include "vol7d_class_diff.F90"
8748#undef VOL7D_POLY_ARRAY
8749#define VOL7D_POLY_ARRAY volanaattr
8750#include "vol7d_class_diff.F90"
8751#undef VOL7D_POLY_ARRAY
8752
8753 if(lana)then
8754 where ( this%ana == that%ana )
8755 that%ana = vol7d_ana_miss
8756 end where
8757 end if
8758
8759end if
8760
8761
8762
8763END SUBROUTINE vol7d_diff_only
8764
8765
8766
8767! Creo le routine da ripetere per i vari tipi di dati di v7d
8768! tramite un template e il preprocessore
8769#undef VOL7D_POLY_TYPE
8770#undef VOL7D_POLY_TYPES
8771#define VOL7D_POLY_TYPE REAL
8772#define VOL7D_POLY_TYPES r
8773#include "vol7d_class_type_templ.F90"
8774#undef VOL7D_POLY_TYPE
8775#undef VOL7D_POLY_TYPES
8776#define VOL7D_POLY_TYPE DOUBLE PRECISION
8777#define VOL7D_POLY_TYPES d
8778#include "vol7d_class_type_templ.F90"
8779#undef VOL7D_POLY_TYPE
8780#undef VOL7D_POLY_TYPES
8781#define VOL7D_POLY_TYPE INTEGER
8782#define VOL7D_POLY_TYPES i
8783#include "vol7d_class_type_templ.F90"
8784#undef VOL7D_POLY_TYPE
8785#undef VOL7D_POLY_TYPES
8786#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
8787#define VOL7D_POLY_TYPES b
8788#include "vol7d_class_type_templ.F90"
8789#undef VOL7D_POLY_TYPE
8790#undef VOL7D_POLY_TYPES
8791#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
8792#define VOL7D_POLY_TYPES c
8793#include "vol7d_class_type_templ.F90"
8794
8795! Creo le routine da ripetere per i vari descrittori di dimensioni di v7d
8796! tramite un template e il preprocessore
8797#define VOL7D_SORT
8798#undef VOL7D_NO_ZERO_ALLOC
8799#undef VOL7D_POLY_TYPE
8800#define VOL7D_POLY_TYPE datetime
8801#include "vol7d_class_desc_templ.F90"
8802#undef VOL7D_POLY_TYPE
8803#define VOL7D_POLY_TYPE vol7d_timerange
8804#include "vol7d_class_desc_templ.F90"
8805#undef VOL7D_POLY_TYPE
8806#define VOL7D_POLY_TYPE vol7d_level
8807#include "vol7d_class_desc_templ.F90"
8808#undef VOL7D_SORT
8809#undef VOL7D_POLY_TYPE
8810#define VOL7D_POLY_TYPE vol7d_network
8811#include "vol7d_class_desc_templ.F90"
8812#undef VOL7D_POLY_TYPE
8813#define VOL7D_POLY_TYPE vol7d_ana
8814#include "vol7d_class_desc_templ.F90"
8815#define VOL7D_NO_ZERO_ALLOC
8816#undef VOL7D_POLY_TYPE
8817#define VOL7D_POLY_TYPE vol7d_var
8818#include "vol7d_class_desc_templ.F90"
8819
8829subroutine vol7d_write_on_file (this,unit,description,filename,filename_auto)
8830
8831TYPE(vol7d),INTENT(IN) :: this
8832integer,optional,intent(inout) :: unit
8833character(len=*),intent(in),optional :: filename
8834character(len=*),intent(out),optional :: filename_auto
8835character(len=*),INTENT(IN),optional :: description
8836
8837integer :: lunit
8838character(len=254) :: ldescription,arg,lfilename
8839integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
8840 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
8841 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
8842 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
8843 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
8844 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
8845 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
8846!integer :: im,id,iy
8847integer :: tarray(8)
8848logical :: opened,exist
8849
8850 nana=0
8851 ntime=0
8852 ntimerange=0
8853 nlevel=0
8854 nnetwork=0
8855 ndativarr=0
8856 ndativari=0
8857 ndativarb=0
8858 ndativard=0
8859 ndativarc=0
8860 ndatiattrr=0
8861 ndatiattri=0
8862 ndatiattrb=0
8863 ndatiattrd=0
8864 ndatiattrc=0
8865 ndativarattrr=0
8866 ndativarattri=0
8867 ndativarattrb=0
8868 ndativarattrd=0
8869 ndativarattrc=0
8870 nanavarr=0
8871 nanavari=0
8872 nanavarb=0
8873 nanavard=0
8874 nanavarc=0
8875 nanaattrr=0
8876 nanaattri=0
8877 nanaattrb=0
8878 nanaattrd=0
8879 nanaattrc=0
8880 nanavarattrr=0
8881 nanavarattri=0
8882 nanavarattrb=0
8883 nanavarattrd=0
8884 nanavarattrc=0
8885
8886
8887!call idate(im,id,iy)
8888call date_and_time(values=tarray)
8889call getarg(0,arg)
8890
8891if (present(description))then
8892 ldescription=description
8893else
8894 ldescription="Vol7d generated by: "//trim(arg)
8895end if
8896
8897if (.not. present(unit))then
8898 lunit=getunit()
8899else
8900 if (unit==0)then
8901 lunit=getunit()
8902 unit=lunit
8903 else
8904 lunit=unit
8905 end if
8906end if
8907
8908lfilename=trim(arg)//".v7d"
8910
8911if (present(filename))then
8912 if (filename /= "")then
8913 lfilename=filename
8914 end if
8915end if
8916
8917if (present(filename_auto))filename_auto=lfilename
8918
8919
8920inquire(unit=lunit,opened=opened)
8921if (.not. opened) then
8922! inquire(file=lfilename, EXIST=exist)
8923! IF (exist) THEN
8924! CALL l4f_log(L4F_FATAL, &
8925! 'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename))
8926! CALL raise_fatal_error()
8927! ENDIF
8928 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM')
8929 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
8930end if
8931
8932if (associated(this%ana)) nana=size(this%ana)
8933if (associated(this%time)) ntime=size(this%time)
8934if (associated(this%timerange)) ntimerange=size(this%timerange)
8935if (associated(this%level)) nlevel=size(this%level)
8936if (associated(this%network)) nnetwork=size(this%network)
8937
8938if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
8939if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
8940if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
8941if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
8942if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
8943
8944if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
8945if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
8946if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
8947if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
8948if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)
8949
8950if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
8951if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
8952if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
8953if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
8954if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
8955
8956if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
8957if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
8958if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
8959if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
8960if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
8961
8962if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
8963if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
8964if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
8965if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
8966if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)
8967
8968if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
8969if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
8970if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
8971if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
8972if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)
8973
8974write(unit=lunit)ldescription
8975write(unit=lunit)tarray
8976
8977write(unit=lunit)&
8978 nana, ntime, ntimerange, nlevel, nnetwork, &
8979 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
8980 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
8981 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
8982 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
8983 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
8984 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
8985 this%time_definition
8986
8987
8988!write(unit=lunit)this
8989
8990
8991!! prime 5 dimensioni
8994if (associated(this%level)) write(unit=lunit)this%level
8995if (associated(this%timerange)) write(unit=lunit)this%timerange
8996if (associated(this%network)) write(unit=lunit)this%network
8997
8998 !! 6a dimensione: variabile dell'anagrafica e dei dati
8999 !! con relativi attributi e in 5 tipi diversi
9000
9001if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r
9002if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i
9003if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b
9004if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d
9005if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c
9006
9007if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r
9008if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i
9009if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b
9010if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d
9011if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c
9012
9013if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r
9014if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i
9015if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b
9016if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d
9017if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c
9018
9019if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r
9020if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i
9021if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b
9022if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d
9023if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c
9024
9025if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r
9026if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i
9027if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b
9028if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d
9029if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c
9030
9031if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
9032if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
9033if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
9034if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
9035if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c
9036
9037!! Volumi di valori e attributi per anagrafica e dati
9038
9039if (associated(this%volanar)) write(unit=lunit)this%volanar
9040if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr
9041if (associated(this%voldatir)) write(unit=lunit)this%voldatir
9042if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr
9043
9044if (associated(this%volanai)) write(unit=lunit)this%volanai
9045if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri
9046if (associated(this%voldatii)) write(unit=lunit)this%voldatii
9047if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri
9048
9049if (associated(this%volanab)) write(unit=lunit)this%volanab
9050if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb
9051if (associated(this%voldatib)) write(unit=lunit)this%voldatib
9052if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb
9053
9054if (associated(this%volanad)) write(unit=lunit)this%volanad
9055if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd
9056if (associated(this%voldatid)) write(unit=lunit)this%voldatid
9057if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd
9058
9059if (associated(this%volanac)) write(unit=lunit)this%volanac
9060if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc
9061if (associated(this%voldatic)) write(unit=lunit)this%voldatic
9062if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc
9063
9064if (.not. present(unit)) close(unit=lunit)
9065
9066end subroutine vol7d_write_on_file
9067
9068
9075
9076
9077subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
9078
9079TYPE(vol7d),INTENT(OUT) :: this
9080integer,intent(inout),optional :: unit
9081character(len=*),INTENT(in),optional :: filename
9082character(len=*),intent(out),optional :: filename_auto
9083character(len=*),INTENT(out),optional :: description
9084integer,intent(out),optional :: tarray(8)
9085
9086
9087integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
9088 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
9089 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
9090 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
9091 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
9092 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
9093 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
9094
9095character(len=254) :: ldescription,lfilename,arg
9096integer :: ltarray(8),lunit,ios
9097logical :: opened,exist
9098
9099
9100call getarg(0,arg)
9101
9102if (.not. present(unit))then
9103 lunit=getunit()
9104else
9105 if (unit==0)then
9106 lunit=getunit()
9107 unit=lunit
9108 else
9109 lunit=unit
9110 end if
9111end if
9112
9113lfilename=trim(arg)//".v7d"
9115
9116if (present(filename))then
9117 if (filename /= "")then
9118 lfilename=filename
9119 end if
9120end if
9121
9122if (present(filename_auto))filename_auto=lfilename
9123
9124
9125inquire(unit=lunit,opened=opened)
9126IF (.NOT. opened) THEN
9127 inquire(file=lfilename,exist=exist)
9128 IF (.NOT.exist) THEN
9129 CALL l4f_log(l4f_fatal, &
9130 'in vol7d_read_from_file, file does not exists, cannot open')
9131 CALL raise_fatal_error()
9132 ENDIF
9133 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM', &
9134 status='OLD', action='READ')
9135 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
9136end if
9137
9138
9140read(unit=lunit,iostat=ios)ldescription
9141
9142if (ios < 0) then ! A negative value indicates that the End of File or End of Record
9143 call vol7d_alloc (this)
9144 call vol7d_alloc_vol (this)
9145 if (present(description))description=ldescription
9146 if (present(tarray))tarray=ltarray
9147 if (.not. present(unit)) close(unit=lunit)
9148end if
9149
9150read(unit=lunit)ltarray
9151
9152CALL l4f_log(l4f_info, 'Reading vol7d from file')
9153CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
9156
9157if (present(description))description=ldescription
9158if (present(tarray))tarray=ltarray
9159
9160read(unit=lunit)&
9161 nana, ntime, ntimerange, nlevel, nnetwork, &
9162 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
9163 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
9164 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
9165 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
9166 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
9167 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
9168 this%time_definition
9169
9170call vol7d_alloc (this, &
9171 nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,&
9172 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,&
9173 ndativard=ndativard, ndativarc=ndativarc,&
9174 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,&
9175 ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
9176 ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, &
9177 ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,&
9178 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, &
9179 nanavard=nanavard, nanavarc=nanavarc,&
9180 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,&
9181 nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
9182 nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, &
9183 nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc)
9184
9185
9188if (associated(this%level)) read(unit=lunit)this%level
9189if (associated(this%timerange)) read(unit=lunit)this%timerange
9190if (associated(this%network)) read(unit=lunit)this%network
9191
9192if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r
9193if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i
9194if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b
9195if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d
9196if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c
9197
9198if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r
9199if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i
9200if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b
9201if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d
9202if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c
9203
9204if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r
9205if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i
9206if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b
9207if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d
9208if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c
9209
9210if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r
9211if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i
9212if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b
9213if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d
9214if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c
9215
9216if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r
9217if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i
9218if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b
9219if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d
9220if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c
9221
9222if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
9223if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
9224if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
9225if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
9226if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c
9227
9228call vol7d_alloc_vol (this)
9229
9230!! Volumi di valori e attributi per anagrafica e dati
9231
9232if (associated(this%volanar)) read(unit=lunit)this%volanar
9233if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr
9234if (associated(this%voldatir)) read(unit=lunit)this%voldatir
9235if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr
9236
9237if (associated(this%volanai)) read(unit=lunit)this%volanai
9238if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri
9239if (associated(this%voldatii)) read(unit=lunit)this%voldatii
9240if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri
9241
9242if (associated(this%volanab)) read(unit=lunit)this%volanab
9243if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb
9244if (associated(this%voldatib)) read(unit=lunit)this%voldatib
9245if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb
9246
9247if (associated(this%volanad)) read(unit=lunit)this%volanad
9248if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd
9249if (associated(this%voldatid)) read(unit=lunit)this%voldatid
9250if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd
9251
9252if (associated(this%volanac)) read(unit=lunit)this%volanac
9253if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc
9254if (associated(this%voldatic)) read(unit=lunit)this%voldatic
9255if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc
9256
9257if (.not. present(unit)) close(unit=lunit)
9258
9259end subroutine vol7d_read_from_file
9260
9261
9262! to double precision
9263elemental doubleprecision function doubledatd(voldat,var)
9264doubleprecision,intent(in) :: voldat
9265type(vol7d_var),intent(in) :: var
9266
9267doubledatd=voldat
9268
9269end function doubledatd
9270
9271
9272elemental doubleprecision function doubledatr(voldat,var)
9273real,intent(in) :: voldat
9274type(vol7d_var),intent(in) :: var
9275
9277 doubledatr=dble(voldat)
9278else
9279 doubledatr=dmiss
9280end if
9281
9282end function doubledatr
9283
9284
9285elemental doubleprecision function doubledati(voldat,var)
9286integer,intent(in) :: voldat
9287type(vol7d_var),intent(in) :: var
9288
9291 doubledati=dble(voldat)/10.d0**var%scalefactor
9292 else
9293 doubledati=dble(voldat)
9294 endif
9295else
9296 doubledati=dmiss
9297end if
9298
9299end function doubledati
9300
9301
9302elemental doubleprecision function doubledatb(voldat,var)
9303integer(kind=int_b),intent(in) :: voldat
9304type(vol7d_var),intent(in) :: var
9305
9308 doubledatb=dble(voldat)/10.d0**var%scalefactor
9309 else
9310 doubledatb=dble(voldat)
9311 endif
9312else
9313 doubledatb=dmiss
9314end if
9315
9316end function doubledatb
9317
9318
9319elemental doubleprecision function doubledatc(voldat,var)
9320CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
9321type(vol7d_var),intent(in) :: var
9322
9323doubledatc = c2d(voldat)
9325 doubledatc=doubledatc/10.d0**var%scalefactor
9326end if
9327
9328end function doubledatc
9329
9330
9331! to integer
9332elemental integer function integerdatd(voldat,var)
9333doubleprecision,intent(in) :: voldat
9334type(vol7d_var),intent(in) :: var
9335
9338 integerdatd=nint(voldat*10d0**var%scalefactor)
9339 else
9340 integerdatd=nint(voldat)
9341 endif
9342else
9343 integerdatd=imiss
9344end if
9345
9346end function integerdatd
9347
9348
9349elemental integer function integerdatr(voldat,var)
9350real,intent(in) :: voldat
9351type(vol7d_var),intent(in) :: var
9352
9355 integerdatr=nint(voldat*10d0**var%scalefactor)
9356 else
9357 integerdatr=nint(voldat)
9358 endif
9359else
9360 integerdatr=imiss
9361end if
9362
9363end function integerdatr
9364
9365
9366elemental integer function integerdati(voldat,var)
9367integer,intent(in) :: voldat
9368type(vol7d_var),intent(in) :: var
9369
9370integerdati=voldat
9371
9372end function integerdati
9373
9374
9375elemental integer function integerdatb(voldat,var)
9376integer(kind=int_b),intent(in) :: voldat
9377type(vol7d_var),intent(in) :: var
9378
9380 integerdatb=voldat
9381else
9382 integerdatb=imiss
9383end if
9384
9385end function integerdatb
9386
9387
9388elemental integer function integerdatc(voldat,var)
9389CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
9390type(vol7d_var),intent(in) :: var
9391
9392integerdatc=c2i(voldat)
9393
9394end function integerdatc
9395
9396
9397! to real
9398elemental real function realdatd(voldat,var)
9399doubleprecision,intent(in) :: voldat
9400type(vol7d_var),intent(in) :: var
9401
9403 realdatd=real(voldat)
9404else
9405 realdatd=rmiss
9406end if
9407
9408end function realdatd
9409
9410
9411elemental real function realdatr(voldat,var)
9412real,intent(in) :: voldat
9413type(vol7d_var),intent(in) :: var
9414
9415realdatr=voldat
9416
9417end function realdatr
9418
9419
9420elemental real function realdati(voldat,var)
9421integer,intent(in) :: voldat
9422type(vol7d_var),intent(in) :: var
9423
9426 realdati=float(voldat)/10.**var%scalefactor
9427 else
9428 realdati=float(voldat)
9429 endif
9430else
9431 realdati=rmiss
9432end if
9433
9434end function realdati
9435
9436
9437elemental real function realdatb(voldat,var)
9438integer(kind=int_b),intent(in) :: voldat
9439type(vol7d_var),intent(in) :: var
9440
9443 realdatb=float(voldat)/10**var%scalefactor
9444 else
9445 realdatb=float(voldat)
9446 endif
9447else
9448 realdatb=rmiss
9449end if
9450
9451end function realdatb
9452
9453
9454elemental real function realdatc(voldat,var)
9455CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
9456type(vol7d_var),intent(in) :: var
9457
9458realdatc=c2r(voldat)
9460 realdatc=realdatc/10.**var%scalefactor
9461end if
9462
9463end function realdatc
9464
9465
9471FUNCTION realanavol(this, var) RESULT(vol)
9472TYPE(vol7d),INTENT(in) :: this
9473TYPE(vol7d_var),INTENT(in) :: var
9474REAL :: vol(SIZE(this%ana),size(this%network))
9475
9476CHARACTER(len=1) :: dtype
9477INTEGER :: indvar
9478
9479dtype = cmiss
9480indvar = index(this%anavar, var, type=dtype)
9481
9482IF (indvar > 0) THEN
9483 SELECT CASE (dtype)
9484 CASE("d")
9485 vol = realdat(this%volanad(:,indvar,:), var)
9486 CASE("r")
9487 vol = this%volanar(:,indvar,:)
9488 CASE("i")
9489 vol = realdat(this%volanai(:,indvar,:), var)
9490 CASE("b")
9491 vol = realdat(this%volanab(:,indvar,:), var)
9492 CASE("c")
9493 vol = realdat(this%volanac(:,indvar,:), var)
9494 CASE default
9495 vol = rmiss
9496 END SELECT
9497ELSE
9498 vol = rmiss
9499ENDIF
9500
9501END FUNCTION realanavol
9502
9503
9509FUNCTION integeranavol(this, var) RESULT(vol)
9510TYPE(vol7d),INTENT(in) :: this
9511TYPE(vol7d_var),INTENT(in) :: var
9512INTEGER :: vol(SIZE(this%ana),size(this%network))
9513
9514CHARACTER(len=1) :: dtype
9515INTEGER :: indvar
9516
9517dtype = cmiss
9518indvar = index(this%anavar, var, type=dtype)
9519
9520IF (indvar > 0) THEN
9521 SELECT CASE (dtype)
9522 CASE("d")
9523 vol = integerdat(this%volanad(:,indvar,:), var)
9524 CASE("r")
9525 vol = integerdat(this%volanar(:,indvar,:), var)
9526 CASE("i")
9527 vol = this%volanai(:,indvar,:)
9528 CASE("b")
9529 vol = integerdat(this%volanab(:,indvar,:), var)
9530 CASE("c")
9531 vol = integerdat(this%volanac(:,indvar,:), var)
9532 CASE default
9533 vol = imiss
9534 END SELECT
9535ELSE
9536 vol = imiss
9537ENDIF
9538
9539END FUNCTION integeranavol
9540
9541
9547subroutine move_datac (v7d,&
9548 indana,indtime,indlevel,indtimerange,indnetwork,&
9549 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
9550
9551TYPE(vol7d),intent(inout) :: v7d
9552
9553integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
9554integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
9555integer :: inddativar,inddativarattr
9556
9557
9558do inddativar=1,size(v7d%dativar%c)
9559
9561 .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
9562 ) then
9563
9564 ! dati
9565 v7d%voldatic &
9566 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
9567 v7d%voldatic &
9568 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
9569
9570
9571 ! attributi
9572 if (associated (v7d%dativarattr%i)) then
9573 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
9574 if (inddativarattr > 0 ) then
9575 v7d%voldatiattri &
9576 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9577 v7d%voldatiattri &
9578 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9579 end if
9580 end if
9581
9582 if (associated (v7d%dativarattr%r)) then
9583 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
9584 if (inddativarattr > 0 ) then
9585 v7d%voldatiattrr &
9586 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9587 v7d%voldatiattrr &
9588 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9589 end if
9590 end if
9591
9592 if (associated (v7d%dativarattr%d)) then
9593 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
9594 if (inddativarattr > 0 ) then
9595 v7d%voldatiattrd &
9596 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9597 v7d%voldatiattrd &
9598 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9599 end if
9600 end if
9601
9602 if (associated (v7d%dativarattr%b)) then
9603 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
9604 if (inddativarattr > 0 ) then
9605 v7d%voldatiattrb &
9606 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9607 v7d%voldatiattrb &
9608 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9609 end if
9610 end if
9611
9612 if (associated (v7d%dativarattr%c)) then
9613 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
9614 if (inddativarattr > 0 ) then
9615 v7d%voldatiattrc &
9616 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9617 v7d%voldatiattrc &
9618 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9619 end if
9620 end if
9621
9622 end if
9623
9624end do
9625
9626end subroutine move_datac
9627
9633subroutine move_datar (v7d,&
9634 indana,indtime,indlevel,indtimerange,indnetwork,&
9635 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
9636
9637TYPE(vol7d),intent(inout) :: v7d
9638
9639integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
9640integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
9641integer :: inddativar,inddativarattr
9642
9643
9644do inddativar=1,size(v7d%dativar%r)
9645
9647 .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
9648 ) then
9649
9650 ! dati
9651 v7d%voldatir &
9652 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
9653 v7d%voldatir &
9654 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
9655
9656
9657 ! attributi
9658 if (associated (v7d%dativarattr%i)) then
9659 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
9660 if (inddativarattr > 0 ) then
9661 v7d%voldatiattri &
9662 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9663 v7d%voldatiattri &
9664 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9665 end if
9666 end if
9667
9668 if (associated (v7d%dativarattr%r)) then
9669 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%r(inddativar))
9670 if (inddativarattr > 0 ) then
9671 v7d%voldatiattrr &
9672 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9673 v7d%voldatiattrr &
9674 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9675 end if
9676 end if
9677
9678 if (associated (v7d%dativarattr%d)) then
9679 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%r(inddativar))
9680 if (inddativarattr > 0 ) then
9681 v7d%voldatiattrd &
9682 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9683 v7d%voldatiattrd &
9684 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9685 end if
9686 end if
9687
9688 if (associated (v7d%dativarattr%b)) then
9689 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%r(inddativar))
9690 if (inddativarattr > 0 ) then
9691 v7d%voldatiattrb &
9692 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9693 v7d%voldatiattrb &
9694 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9695 end if
9696 end if
9697
9698 if (associated (v7d%dativarattr%c)) then
9699 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%r(inddativar))
9700 if (inddativarattr > 0 ) then
9701 v7d%voldatiattrc &
9702 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9703 v7d%voldatiattrc &
9704 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9705 end if
9706 end if
9707
9708 end if
9709
9710end do
9711
9712end subroutine move_datar
9713
9714
9728subroutine v7d_rounding(v7din,v7dout,level,timerange,nostatproc)
9729type(vol7d),intent(inout) :: v7din
9730type(vol7d),intent(out) :: v7dout
9731type(vol7d_level),intent(in),optional :: level(:)
9732type(vol7d_timerange),intent(in),optional :: timerange(:)
9733!logical,intent(in),optional :: merge !< if there are data on more then one almost equal levels or timeranges
9734!! will be merged POINT BY POINT with priority for the fird data found ordered by icreasing var index
9735logical,intent(in),optional :: nostatproc
9736
9737integer :: nana,nlevel,ntime,ntimerange,nnetwork,nbin
9738integer :: iana,ilevel,itimerange,indl,indt,itime,inetwork
9739type(vol7d_level) :: roundlevel(size(v7din%level))
9740type(vol7d_timerange) :: roundtimerange(size(v7din%timerange))
9741type(vol7d) :: v7d_tmp
9742
9743
9744nbin=0
9745
9746if (associated(v7din%dativar%r)) nbin = nbin + size(v7din%dativar%r)
9747if (associated(v7din%dativar%i)) nbin = nbin + size(v7din%dativar%i)
9748if (associated(v7din%dativar%d)) nbin = nbin + size(v7din%dativar%d)
9749if (associated(v7din%dativar%b)) nbin = nbin + size(v7din%dativar%b)
9750
9752
9753roundlevel=v7din%level
9754
9755if (present(level))then
9756 do ilevel = 1, size(v7din%level)
9757 if ((any(v7din%level(ilevel) .almosteq. level))) then
9758 roundlevel(ilevel)=level(1)
9759 end if
9760 end do
9761end if
9762
9763roundtimerange=v7din%timerange
9764
9765if (present(timerange))then
9766 do itimerange = 1, size(v7din%timerange)
9767 if ((any(v7din%timerange(itimerange) .almosteq. timerange))) then
9768 roundtimerange(itimerange)=timerange(1)
9769 end if
9770 end do
9771end if
9772
9773!set istantaneous values everywere
9774!preserve p1 for forecast time
9775if (optio_log(nostatproc)) then
9776 roundtimerange(:)%timerange=254
9777 roundtimerange(:)%p2=0
9778end if
9779
9780
9781nana=size(v7din%ana)
9782nlevel=count_distinct(roundlevel,back=.true.)
9783ntime=size(v7din%time)
9784ntimerange=count_distinct(roundtimerange,back=.true.)
9785nnetwork=size(v7din%network)
9786
9788
9789if (nbin == 0) then
9791else
9792 call vol7d_convr(v7din,v7d_tmp)
9793end if
9794
9795v7d_tmp%level=roundlevel
9796v7d_tmp%timerange=roundtimerange
9797
9798do ilevel=1, size(v7d_tmp%level)
9799 indl=index(v7d_tmp%level,roundlevel(ilevel))
9800 do itimerange=1,size(v7d_tmp%timerange)
9801 indt=index(v7d_tmp%timerange,roundtimerange(itimerange))
9802
9803 if (indl /= ilevel .or. indt /= itimerange) then
9804
9805 do iana=1, nana
9806 do itime=1,ntime
9807 do inetwork=1,nnetwork
9808
9809 if (nbin > 0) then
9810 call move_datar (v7d_tmp,&
9811 iana,itime,ilevel,itimerange,inetwork,&
9812 iana,itime,indl,indt,inetwork)
9813 else
9814 call move_datac (v7d_tmp,&
9815 iana,itime,ilevel,itimerange,inetwork,&
9816 iana,itime,indl,indt,inetwork)
9817 end if
9818
9819 end do
9820 end do
9821 end do
9822
9823 end if
9824
9825 end do
9826end do
9827
9828! set to missing level and time > nlevel
9829do ilevel=nlevel+1,size(v7d_tmp%level)
9831end do
9832
9833do itimerange=ntimerange+1,size(v7d_tmp%timerange)
9835end do
9836
9837!copy with remove
9840
9841!call display(v7dout)
9842
9843end subroutine v7d_rounding
9844
9845
9847
9853
9854
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 |