libsim Versione 7.2.1
|
◆ vol7d_get_volanaattrc()
Crea una vista a dimensione ridotta di un volume di attributi di anagrafica 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 :: vol1d(:)
...
CALL vol7d_get_volanaattrc(v7d1, (/vol7d_ana_d/), vol1d)
IF (ASSOCIATED(vol1d)) THEN
print*,vol1d
...
ENDIF
return
Definizione alla linea 6296 del file vol7d_class.F90. 6298! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
6299! authors:
6300! Davide Cesari <dcesari@arpa.emr.it>
6301! Paolo Patruno <ppatruno@arpa.emr.it>
6302
6303! This program is free software; you can redistribute it and/or
6304! modify it under the terms of the GNU General Public License as
6305! published by the Free Software Foundation; either version 2 of
6306! the License, or (at your option) any later version.
6307
6308! This program is distributed in the hope that it will be useful,
6309! but WITHOUT ANY WARRANTY; without even the implied warranty of
6310! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6311! GNU General Public License for more details.
6312
6313! You should have received a copy of the GNU General Public License
6314! along with this program. If not, see <http://www.gnu.org/licenses/>.
6315#include "config.h"
6316
6328
6396IMPLICIT NONE
6397
6398
6399INTEGER, PARAMETER :: vol7d_maxdim_a = 3, vol7d_maxdim_aa = 4, &
6400 vol7d_maxdim_d = 6, vol7d_maxdim_ad = 7
6401
6402INTEGER, PARAMETER :: vol7d_ana_a=1
6403INTEGER, PARAMETER :: vol7d_var_a=2
6404INTEGER, PARAMETER :: vol7d_network_a=3
6405INTEGER, PARAMETER :: vol7d_attr_a=4
6406INTEGER, PARAMETER :: vol7d_ana_d=1
6407INTEGER, PARAMETER :: vol7d_time_d=2
6408INTEGER, PARAMETER :: vol7d_level_d=3
6409INTEGER, PARAMETER :: vol7d_timerange_d=4
6410INTEGER, PARAMETER :: vol7d_var_d=5
6411INTEGER, PARAMETER :: vol7d_network_d=6
6412INTEGER, PARAMETER :: vol7d_attr_d=7
6413INTEGER, PARAMETER :: vol7d_cdatalen=32
6414
6415TYPE vol7d_varmap
6416 INTEGER :: r, d, i, b, c
6417END TYPE vol7d_varmap
6418
6423 TYPE(vol7d_ana),POINTER :: ana(:)
6425 TYPE(datetime),POINTER :: time(:)
6427 TYPE(vol7d_level),POINTER :: level(:)
6429 TYPE(vol7d_timerange),POINTER :: timerange(:)
6431 TYPE(vol7d_network),POINTER :: network(:)
6433 TYPE(vol7d_varvect) :: anavar
6435 TYPE(vol7d_varvect) :: anaattr
6437 TYPE(vol7d_varvect) :: anavarattr
6439 TYPE(vol7d_varvect) :: dativar
6441 TYPE(vol7d_varvect) :: datiattr
6443 TYPE(vol7d_varvect) :: dativarattr
6444
6446 REAL,POINTER :: volanar(:,:,:)
6448 DOUBLE PRECISION,POINTER :: volanad(:,:,:)
6450 INTEGER,POINTER :: volanai(:,:,:)
6452 INTEGER(kind=int_b),POINTER :: volanab(:,:,:)
6454 CHARACTER(len=vol7d_cdatalen),POINTER :: volanac(:,:,:)
6455
6457 REAL,POINTER :: volanaattrr(:,:,:,:)
6459 DOUBLE PRECISION,POINTER :: volanaattrd(:,:,:,:)
6461 INTEGER,POINTER :: volanaattri(:,:,:,:)
6463 INTEGER(kind=int_b),POINTER :: volanaattrb(:,:,:,:)
6465 CHARACTER(len=vol7d_cdatalen),POINTER :: volanaattrc(:,:,:,:)
6466
6468 REAL,POINTER :: voldatir(:,:,:,:,:,:) ! sono i dati
6470 DOUBLE PRECISION,POINTER :: voldatid(:,:,:,:,:,:)
6472 INTEGER,POINTER :: voldatii(:,:,:,:,:,:)
6474 INTEGER(kind=int_b),POINTER :: voldatib(:,:,:,:,:,:)
6476 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatic(:,:,:,:,:,:)
6477
6479 REAL,POINTER :: voldatiattrr(:,:,:,:,:,:,:)
6481 DOUBLE PRECISION,POINTER :: voldatiattrd(:,:,:,:,:,:,:)
6483 INTEGER,POINTER :: voldatiattri(:,:,:,:,:,:,:)
6485 INTEGER(kind=int_b),POINTER :: voldatiattrb(:,:,:,:,:,:,:)
6487 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatiattrc(:,:,:,:,:,:,:)
6488
6490 integer :: time_definition
6491
6493
6498 MODULE PROCEDURE vol7d_init
6499END INTERFACE
6500
6503 MODULE PROCEDURE vol7d_delete
6504END INTERFACE
6505
6508 MODULE PROCEDURE vol7d_write_on_file
6509END INTERFACE
6510
6512INTERFACE import
6513 MODULE PROCEDURE vol7d_read_from_file
6514END INTERFACE
6515
6518 MODULE PROCEDURE vol7d_display, dat_display, dat_vect_display
6519END INTERFACE
6520
6523 MODULE PROCEDURE to_char_dat
6524END INTERFACE
6525
6528 MODULE PROCEDURE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
6529END INTERFACE
6530
6533 MODULE PROCEDURE realdatd,realdatr,realdati,realdatb,realdatc
6534END INTERFACE
6535
6538 MODULE PROCEDURE integerdatd,integerdatr,integerdati,integerdatb,integerdatc
6539END INTERFACE
6540
6543 MODULE PROCEDURE vol7d_copy
6544END INTERFACE
6545
6548 MODULE PROCEDURE vol7d_c_e
6549END INTERFACE
6550
6555 MODULE PROCEDURE vol7d_check
6556END INTERFACE
6557
6572 MODULE PROCEDURE v7d_rounding
6573END INTERFACE
6574
6575!!$INTERFACE get_volana
6576!!$ MODULE PROCEDURE vol7d_get_volanar, vol7d_get_volanad, vol7d_get_volanai, &
6577!!$ vol7d_get_volanab, vol7d_get_volanac
6578!!$END INTERFACE
6579!!$
6580!!$INTERFACE get_voldati
6581!!$ MODULE PROCEDURE vol7d_get_voldatir, vol7d_get_voldatid, vol7d_get_voldatii, &
6582!!$ vol7d_get_voldatib, vol7d_get_voldatic
6583!!$END INTERFACE
6584!!$
6585!!$INTERFACE get_volanaattr
6586!!$ MODULE PROCEDURE vol7d_get_volanaattrr, vol7d_get_volanaattrd, &
6587!!$ vol7d_get_volanaattri, vol7d_get_volanaattrb, vol7d_get_volanaattrc
6588!!$END INTERFACE
6589!!$
6590!!$INTERFACE get_voldatiattr
6591!!$ MODULE PROCEDURE vol7d_get_voldatiattrr, vol7d_get_voldatiattrd, &
6592!!$ vol7d_get_voldatiattri, vol7d_get_voldatiattrb, vol7d_get_voldatiattrc
6593!!$END INTERFACE
6594
6595PRIVATE vol7d_get_volr, vol7d_get_vold, vol7d_get_voli, vol7d_get_volb, &
6596 vol7d_get_volc, &
6597 volptr1dr, volptr2dr, volptr3dr, volptr4dr, volptr5dr, volptr6dr, volptr7dr, &
6598 volptr1dd, volptr2dd, volptr3dd, volptr4dd, volptr5dd, volptr6dd, volptr7dd, &
6599 volptr1di, volptr2di, volptr3di, volptr4di, volptr5di, volptr6di, volptr7di, &
6600 volptr1db, volptr2db, volptr3db, volptr4db, volptr5db, volptr6db, volptr7db, &
6601 volptr1dc, volptr2dc, volptr3dc, volptr4dc, volptr5dc, volptr6dc, volptr7dc, &
6602 vol7d_nullifyr, vol7d_nullifyd, vol7d_nullifyi, vol7d_nullifyb, vol7d_nullifyc, &
6603 vol7d_init, vol7d_delete, vol7d_write_on_file, vol7d_read_from_file, &
6604 vol7d_check_alloc_ana, vol7d_force_alloc_ana, &
6605 vol7d_check_alloc_dati, vol7d_force_alloc_dati, vol7d_force_alloc, &
6606 vol7d_display, dat_display, dat_vect_display, &
6607 to_char_dat, vol7d_check
6608
6609PRIVATE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
6610
6611PRIVATE vol7d_c_e
6612
6613CONTAINS
6614
6615
6620SUBROUTINE vol7d_init(this,time_definition)
6621TYPE(vol7d),intent(out) :: this
6622integer,INTENT(IN),OPTIONAL :: time_definition
6623
6630CALL vol7d_var_features_init() ! initialise var features table once
6631
6632NULLIFY(this%ana, this%time, this%level, this%timerange, this%network)
6633
6634NULLIFY(this%volanar, this%volanaattrr, this%voldatir, this%voldatiattrr)
6635NULLIFY(this%volanad, this%volanaattrd, this%voldatid, this%voldatiattrd)
6636NULLIFY(this%volanai, this%volanaattri, this%voldatii, this%voldatiattri)
6637NULLIFY(this%volanab, this%volanaattrb, this%voldatib, this%voldatiattrb)
6638NULLIFY(this%volanac, this%volanaattrc, this%voldatic, this%voldatiattrc)
6639
6640if(present(time_definition)) then
6641 this%time_definition=time_definition
6642else
6643 this%time_definition=1 !default to validity time
6644end if
6645
6646END SUBROUTINE vol7d_init
6647
6648
6652ELEMENTAL SUBROUTINE vol7d_delete(this, dataonly)
6653TYPE(vol7d),intent(inout) :: this
6654LOGICAL, INTENT(in), OPTIONAL :: dataonly
6655
6656
6657IF (.NOT. optio_log(dataonly)) THEN
6658 IF (ASSOCIATED(this%volanar)) DEALLOCATE(this%volanar)
6659 IF (ASSOCIATED(this%volanad)) DEALLOCATE(this%volanad)
6660 IF (ASSOCIATED(this%volanai)) DEALLOCATE(this%volanai)
6661 IF (ASSOCIATED(this%volanab)) DEALLOCATE(this%volanab)
6662 IF (ASSOCIATED(this%volanac)) DEALLOCATE(this%volanac)
6663 IF (ASSOCIATED(this%volanaattrr)) DEALLOCATE(this%volanaattrr)
6664 IF (ASSOCIATED(this%volanaattrd)) DEALLOCATE(this%volanaattrd)
6665 IF (ASSOCIATED(this%volanaattri)) DEALLOCATE(this%volanaattri)
6666 IF (ASSOCIATED(this%volanaattrb)) DEALLOCATE(this%volanaattrb)
6667 IF (ASSOCIATED(this%volanaattrc)) DEALLOCATE(this%volanaattrc)
6668ENDIF
6669IF (ASSOCIATED(this%voldatir)) DEALLOCATE(this%voldatir)
6670IF (ASSOCIATED(this%voldatid)) DEALLOCATE(this%voldatid)
6671IF (ASSOCIATED(this%voldatii)) DEALLOCATE(this%voldatii)
6672IF (ASSOCIATED(this%voldatib)) DEALLOCATE(this%voldatib)
6673IF (ASSOCIATED(this%voldatic)) DEALLOCATE(this%voldatic)
6674IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
6675IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
6676IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
6677IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
6678IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
6679
6680IF (.NOT. optio_log(dataonly)) THEN
6681 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
6682 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
6683ENDIF
6684IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
6685IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
6686IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
6687
6688IF (.NOT. optio_log(dataonly)) THEN
6692ENDIF
6696
6697END SUBROUTINE vol7d_delete
6698
6699
6700
6701integer function vol7d_check(this)
6702TYPE(vol7d),intent(in) :: this
6703integer :: i,j,k,l,m,n
6704
6705vol7d_check=0
6706
6707if (associated(this%voldatii)) then
6708do i = 1,size(this%voldatii,1)
6709 do j = 1,size(this%voldatii,2)
6710 do k = 1,size(this%voldatii,3)
6711 do l = 1,size(this%voldatii,4)
6712 do m = 1,size(this%voldatii,5)
6713 do n = 1,size(this%voldatii,6)
6714 if (this%voldatii(i,j,k,l,m,n) /= this%voldatii(i,j,k,l,m,n) ) then
6715 CALL l4f_log(l4f_warn,"check: abnormal value at voldatii("&
6717 vol7d_check=1
6718 end if
6719 end do
6720 end do
6721 end do
6722 end do
6723 end do
6724end do
6725end if
6726
6727
6728if (associated(this%voldatir)) then
6729do i = 1,size(this%voldatir,1)
6730 do j = 1,size(this%voldatir,2)
6731 do k = 1,size(this%voldatir,3)
6732 do l = 1,size(this%voldatir,4)
6733 do m = 1,size(this%voldatir,5)
6734 do n = 1,size(this%voldatir,6)
6735 if (this%voldatir(i,j,k,l,m,n) /= this%voldatir(i,j,k,l,m,n) ) then
6736 CALL l4f_log(l4f_warn,"check: abnormal value at voldatir("&
6738 vol7d_check=2
6739 end if
6740 end do
6741 end do
6742 end do
6743 end do
6744 end do
6745end do
6746end if
6747
6748if (associated(this%voldatid)) then
6749do i = 1,size(this%voldatid,1)
6750 do j = 1,size(this%voldatid,2)
6751 do k = 1,size(this%voldatid,3)
6752 do l = 1,size(this%voldatid,4)
6753 do m = 1,size(this%voldatid,5)
6754 do n = 1,size(this%voldatid,6)
6755 if (this%voldatid(i,j,k,l,m,n) /= this%voldatid(i,j,k,l,m,n) ) then
6756 CALL l4f_log(l4f_warn,"check: abnormal value at voldatid("&
6758 vol7d_check=3
6759 end if
6760 end do
6761 end do
6762 end do
6763 end do
6764 end do
6765end do
6766end if
6767
6768if (associated(this%voldatib)) then
6769do i = 1,size(this%voldatib,1)
6770 do j = 1,size(this%voldatib,2)
6771 do k = 1,size(this%voldatib,3)
6772 do l = 1,size(this%voldatib,4)
6773 do m = 1,size(this%voldatib,5)
6774 do n = 1,size(this%voldatib,6)
6775 if (this%voldatib(i,j,k,l,m,n) /= this%voldatib(i,j,k,l,m,n) ) then
6776 CALL l4f_log(l4f_warn,"check: abnormal value at voldatib("&
6778 vol7d_check=4
6779 end if
6780 end do
6781 end do
6782 end do
6783 end do
6784 end do
6785end do
6786end if
6787
6788end function vol7d_check
6789
6790
6791
6792!TODO da completare ! aborta se i volumi sono allocati a dimensione 0
6794SUBROUTINE vol7d_display(this)
6795TYPE(vol7d),intent(in) :: this
6796integer :: i
6797
6798REAL :: rdat
6799DOUBLE PRECISION :: ddat
6800INTEGER :: idat
6801INTEGER(kind=int_b) :: bdat
6802CHARACTER(len=vol7d_cdatalen) :: cdat
6803
6804
6805print*,"<<<<<<<<<<<<<<<<<<< vol7d object >>>>>>>>>>>>>>>>>>>>"
6806if (this%time_definition == 0) then
6807 print*,"TIME DEFINITION: time is reference time"
6808else if (this%time_definition == 1) then
6809 print*,"TIME DEFINITION: time is validity time"
6810else
6811 print*,"Time definition have a wrong walue:", this%time_definition
6812end if
6813
6814IF (ASSOCIATED(this%network))then
6815 print*,"---- network vector ----"
6816 print*,"elements=",size(this%network)
6817 do i=1, size(this%network)
6819 end do
6820end IF
6821
6822IF (ASSOCIATED(this%ana))then
6823 print*,"---- ana vector ----"
6824 print*,"elements=",size(this%ana)
6825 do i=1, size(this%ana)
6827 end do
6828end IF
6829
6830IF (ASSOCIATED(this%time))then
6831 print*,"---- time vector ----"
6832 print*,"elements=",size(this%time)
6833 do i=1, size(this%time)
6835 end do
6836end if
6837
6838IF (ASSOCIATED(this%level)) then
6839 print*,"---- level vector ----"
6840 print*,"elements=",size(this%level)
6841 do i =1,size(this%level)
6843 end do
6844end if
6845
6846IF (ASSOCIATED(this%timerange))then
6847 print*,"---- timerange vector ----"
6848 print*,"elements=",size(this%timerange)
6849 do i =1,size(this%timerange)
6851 end do
6852end if
6853
6854
6855print*,"---- ana vector ----"
6856print*,""
6857print*,"->>>>>>>>> anavar -"
6859print*,""
6860print*,"->>>>>>>>> anaattr -"
6862print*,""
6863print*,"->>>>>>>>> anavarattr -"
6865
6866print*,"-- ana data section (first point) --"
6867
6868idat=imiss
6869rdat=rmiss
6870ddat=dmiss
6871bdat=ibmiss
6872cdat=cmiss
6873
6874!ntime = MIN(SIZE(this%time),nprint)
6875!ntimerange = MIN(SIZE(this%timerange),nprint)
6876!nlevel = MIN(SIZE(this%level),nprint)
6877!nnetwork = MIN(SIZE(this%network),nprint)
6878!nana = MIN(SIZE(this%ana),nprint)
6879
6880IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0) THEN
6881if (associated(this%volanai)) then
6882 do i=1,size(this%anavar%i)
6883 idat=this%volanai(1,i,1)
6885 end do
6886end if
6887idat=imiss
6888
6889if (associated(this%volanar)) then
6890 do i=1,size(this%anavar%r)
6891 rdat=this%volanar(1,i,1)
6893 end do
6894end if
6895rdat=rmiss
6896
6897if (associated(this%volanad)) then
6898 do i=1,size(this%anavar%d)
6899 ddat=this%volanad(1,i,1)
6901 end do
6902end if
6903ddat=dmiss
6904
6905if (associated(this%volanab)) then
6906 do i=1,size(this%anavar%b)
6907 bdat=this%volanab(1,i,1)
6909 end do
6910end if
6911bdat=ibmiss
6912
6913if (associated(this%volanac)) then
6914 do i=1,size(this%anavar%c)
6915 cdat=this%volanac(1,i,1)
6917 end do
6918end if
6919cdat=cmiss
6920ENDIF
6921
6922print*,"---- data vector ----"
6923print*,""
6924print*,"->>>>>>>>> dativar -"
6926print*,""
6927print*,"->>>>>>>>> datiattr -"
6929print*,""
6930print*,"->>>>>>>>> dativarattr -"
6932
6933print*,"-- data data section (first point) --"
6934
6935idat=imiss
6936rdat=rmiss
6937ddat=dmiss
6938bdat=ibmiss
6939cdat=cmiss
6940
6941IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0 .AND. size(this%time) > 0 &
6942 .AND. size(this%level) > 0 .AND. size(this%timerange) > 0) THEN
6943if (associated(this%voldatii)) then
6944 do i=1,size(this%dativar%i)
6945 idat=this%voldatii(1,1,1,1,i,1)
6947 end do
6948end if
6949idat=imiss
6950
6951if (associated(this%voldatir)) then
6952 do i=1,size(this%dativar%r)
6953 rdat=this%voldatir(1,1,1,1,i,1)
6955 end do
6956end if
6957rdat=rmiss
6958
6959if (associated(this%voldatid)) then
6960 do i=1,size(this%dativar%d)
6961 ddat=this%voldatid(1,1,1,1,i,1)
6963 end do
6964end if
6965ddat=dmiss
6966
6967if (associated(this%voldatib)) then
6968 do i=1,size(this%dativar%b)
6969 bdat=this%voldatib(1,1,1,1,i,1)
6971 end do
6972end if
6973bdat=ibmiss
6974
6975if (associated(this%voldatic)) then
6976 do i=1,size(this%dativar%c)
6977 cdat=this%voldatic(1,1,1,1,i,1)
6979 end do
6980end if
6981cdat=cmiss
6982ENDIF
6983
6984print*,"<<<<<<<<<<<<<<<<<<< END vol7d object >>>>>>>>>>>>>>>>>>>>"
6985
6986END SUBROUTINE vol7d_display
6987
6988
6990SUBROUTINE dat_display(this,idat,rdat,ddat,bdat,cdat)
6991TYPE(vol7d_var),intent(in) :: this
6993REAL :: rdat
6995DOUBLE PRECISION :: ddat
6997INTEGER :: idat
6999INTEGER(kind=int_b) :: bdat
7001CHARACTER(len=*) :: cdat
7002
7003print *, to_char_dat(this,idat,rdat,ddat,bdat,cdat)
7004
7005end SUBROUTINE dat_display
7006
7008SUBROUTINE dat_vect_display(this,idat,rdat,ddat,bdat,cdat)
7009
7010TYPE(vol7d_var),intent(in) :: this(:)
7012REAL :: rdat(:)
7014DOUBLE PRECISION :: ddat(:)
7016INTEGER :: idat(:)
7018INTEGER(kind=int_b) :: bdat(:)
7020CHARACTER(len=*):: cdat(:)
7021
7022integer :: i
7023
7024do i =1,size(this)
7026end do
7027
7028end SUBROUTINE dat_vect_display
7029
7030
7031FUNCTION to_char_dat(this,idat,rdat,ddat,bdat,cdat)
7032#ifdef HAVE_DBALLE
7033USE dballef
7034#endif
7035TYPE(vol7d_var),INTENT(in) :: this
7037REAL :: rdat
7039DOUBLE PRECISION :: ddat
7041INTEGER :: idat
7043INTEGER(kind=int_b) :: bdat
7045CHARACTER(len=*) :: cdat
7046CHARACTER(len=80) :: to_char_dat
7047
7048CHARACTER(len=LEN(to_char_dat)) :: to_char_tmp
7049
7050
7051#ifdef HAVE_DBALLE
7052INTEGER :: handle, ier
7053
7054handle = 0
7055to_char_dat="VALUE: "
7056
7061
7063 ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
7064 ier = idba_spiegab(handle,this%btable,cdat,to_char_tmp)
7065 ier = idba_fatto(handle)
7066 to_char_dat=trim(to_char_dat)//" ;char> "//trim(to_char_tmp)
7067endif
7068
7069#else
7070
7071to_char_dat="VALUE: "
7077
7078#endif
7079
7080END FUNCTION to_char_dat
7081
7082
7085FUNCTION vol7d_c_e(this) RESULT(c_e)
7086TYPE(vol7d), INTENT(in) :: this
7087
7088LOGICAL :: c_e
7089
7091 ASSOCIATED(this%level) .OR. ASSOCIATED(this%timerange) .OR. &
7092 ASSOCIATED(this%network) .OR. &
7093 ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
7094 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
7095 ASSOCIATED(this%anavar%c) .OR. &
7096 ASSOCIATED(this%anaattr%r) .OR. ASSOCIATED(this%anaattr%d) .OR. &
7097 ASSOCIATED(this%anaattr%i) .OR. ASSOCIATED(this%anaattr%b) .OR. &
7098 ASSOCIATED(this%anaattr%c) .OR. &
7099 ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
7100 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
7101 ASSOCIATED(this%dativar%c) .OR. &
7102 ASSOCIATED(this%datiattr%r) .OR. ASSOCIATED(this%datiattr%d) .OR. &
7103 ASSOCIATED(this%datiattr%i) .OR. ASSOCIATED(this%datiattr%b) .OR. &
7104 ASSOCIATED(this%datiattr%c)
7105
7106END FUNCTION vol7d_c_e
7107
7108
7147SUBROUTINE vol7d_alloc(this, nana, ntime, nlevel, ntimerange, nnetwork, &
7148 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
7149 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
7150 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
7151 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
7152 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
7153 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc, &
7154 ini)
7155TYPE(vol7d),INTENT(inout) :: this
7156INTEGER,INTENT(in),OPTIONAL :: nana
7157INTEGER,INTENT(in),OPTIONAL :: ntime
7158INTEGER,INTENT(in),OPTIONAL :: nlevel
7159INTEGER,INTENT(in),OPTIONAL :: ntimerange
7160INTEGER,INTENT(in),OPTIONAL :: nnetwork
7162INTEGER,INTENT(in),OPTIONAL :: &
7163 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
7164 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
7165 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
7166 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
7167 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
7168 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc
7169LOGICAL,INTENT(in),OPTIONAL :: ini
7170
7171INTEGER :: i
7172LOGICAL :: linit
7173
7174IF (PRESENT(ini)) THEN
7175 linit = ini
7176ELSE
7177 linit = .false.
7178ENDIF
7179
7180! Dimensioni principali
7181IF (PRESENT(nana)) THEN
7182 IF (nana >= 0) THEN
7183 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
7184 ALLOCATE(this%ana(nana))
7185 IF (linit) THEN
7186 DO i = 1, nana
7188 ENDDO
7189 ENDIF
7190 ENDIF
7191ENDIF
7192IF (PRESENT(ntime)) THEN
7193 IF (ntime >= 0) THEN
7194 IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
7195 ALLOCATE(this%time(ntime))
7196 IF (linit) THEN
7197 DO i = 1, ntime
7199 ENDDO
7200 ENDIF
7201 ENDIF
7202ENDIF
7203IF (PRESENT(nlevel)) THEN
7204 IF (nlevel >= 0) THEN
7205 IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
7206 ALLOCATE(this%level(nlevel))
7207 IF (linit) THEN
7208 DO i = 1, nlevel
7210 ENDDO
7211 ENDIF
7212 ENDIF
7213ENDIF
7214IF (PRESENT(ntimerange)) THEN
7215 IF (ntimerange >= 0) THEN
7216 IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
7217 ALLOCATE(this%timerange(ntimerange))
7218 IF (linit) THEN
7219 DO i = 1, ntimerange
7221 ENDDO
7222 ENDIF
7223 ENDIF
7224ENDIF
7225IF (PRESENT(nnetwork)) THEN
7226 IF (nnetwork >= 0) THEN
7227 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
7228 ALLOCATE(this%network(nnetwork))
7229 IF (linit) THEN
7230 DO i = 1, nnetwork
7232 ENDDO
7233 ENDIF
7234 ENDIF
7235ENDIF
7236! Dimensioni dei tipi delle variabili
7237CALL vol7d_varvect_alloc(this%anavar, nanavarr, nanavard, &
7238 nanavari, nanavarb, nanavarc, ini)
7239CALL vol7d_varvect_alloc(this%anaattr, nanaattrr, nanaattrd, &
7240 nanaattri, nanaattrb, nanaattrc, ini)
7241CALL vol7d_varvect_alloc(this%anavarattr, nanavarattrr, nanavarattrd, &
7242 nanavarattri, nanavarattrb, nanavarattrc, ini)
7243CALL vol7d_varvect_alloc(this%dativar, ndativarr, ndativard, &
7244 ndativari, ndativarb, ndativarc, ini)
7245CALL vol7d_varvect_alloc(this%datiattr, ndatiattrr, ndatiattrd, &
7246 ndatiattri, ndatiattrb, ndatiattrc, ini)
7247CALL vol7d_varvect_alloc(this%dativarattr, ndativarattrr, ndativarattrd, &
7248 ndativarattri, ndativarattrb, ndativarattrc, ini)
7249
7250END SUBROUTINE vol7d_alloc
7251
7252
7253FUNCTION vol7d_check_alloc_ana(this)
7254TYPE(vol7d),INTENT(in) :: this
7255LOGICAL :: vol7d_check_alloc_ana
7256
7257vol7d_check_alloc_ana = ASSOCIATED(this%ana) .AND. ASSOCIATED(this%network)
7258
7259END FUNCTION vol7d_check_alloc_ana
7260
7261SUBROUTINE vol7d_force_alloc_ana(this, ini)
7262TYPE(vol7d),INTENT(inout) :: this
7263LOGICAL,INTENT(in),OPTIONAL :: ini
7264
7265! Alloco i descrittori minimi per avere un volume di anagrafica
7266IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=1, ini=ini)
7267IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=1, ini=ini)
7268
7269END SUBROUTINE vol7d_force_alloc_ana
7270
7271
7272FUNCTION vol7d_check_alloc_dati(this)
7273TYPE(vol7d),INTENT(in) :: this
7274LOGICAL :: vol7d_check_alloc_dati
7275
7276vol7d_check_alloc_dati = vol7d_check_alloc_ana(this) .AND. &
7277 ASSOCIATED(this%time) .AND. ASSOCIATED(this%level) .AND. &
7278 ASSOCIATED(this%timerange)
7279
7280END FUNCTION vol7d_check_alloc_dati
7281
7282SUBROUTINE vol7d_force_alloc_dati(this, ini)
7283TYPE(vol7d),INTENT(inout) :: this
7284LOGICAL,INTENT(in),OPTIONAL :: ini
7285
7286! Alloco i descrittori minimi per avere un volume di dati
7287CALL vol7d_force_alloc_ana(this, ini)
7288IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=1, ini=ini)
7289IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=1, ini=ini)
7290IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=1, ini=ini)
7291
7292END SUBROUTINE vol7d_force_alloc_dati
7293
7294
7295SUBROUTINE vol7d_force_alloc(this)
7296TYPE(vol7d),INTENT(inout) :: this
7297
7298! If anything really not allocated yet, allocate with size 0
7299IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=0)
7300IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=0)
7301IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=0)
7302IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=0)
7303IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=0)
7304
7305END SUBROUTINE vol7d_force_alloc
7306
7307
7308FUNCTION vol7d_check_vol(this)
7309TYPE(vol7d),INTENT(in) :: this
7310LOGICAL :: vol7d_check_vol
7311
7312vol7d_check_vol = c_e(this)
7313
7314! Anagrafica
7315IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
7316 vol7d_check_vol = .false.
7317ENDIF
7318
7319IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
7320 vol7d_check_vol = .false.
7321ENDIF
7322
7323IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
7324 vol7d_check_vol = .false.
7325ENDIF
7326
7327IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
7328 vol7d_check_vol = .false.
7329ENDIF
7330
7331IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
7332 vol7d_check_vol = .false.
7333ENDIF
7334IF (ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
7335 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
7336 ASSOCIATED(this%anavar%c)) THEN
7337 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_ana(this)
7338ENDIF
7339
7340! Attributi dell'anagrafica
7341IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
7342 .NOT.ASSOCIATED(this%volanaattrr)) THEN
7343 vol7d_check_vol = .false.
7344ENDIF
7345
7346IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
7347 .NOT.ASSOCIATED(this%volanaattrd)) THEN
7348 vol7d_check_vol = .false.
7349ENDIF
7350
7351IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
7352 .NOT.ASSOCIATED(this%volanaattri)) THEN
7353 vol7d_check_vol = .false.
7354ENDIF
7355
7356IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
7357 .NOT.ASSOCIATED(this%volanaattrb)) THEN
7358 vol7d_check_vol = .false.
7359ENDIF
7360
7361IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
7362 .NOT.ASSOCIATED(this%volanaattrc)) THEN
7363 vol7d_check_vol = .false.
7364ENDIF
7365
7366! Dati
7367IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
7368 vol7d_check_vol = .false.
7369ENDIF
7370
7371IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
7372 vol7d_check_vol = .false.
7373ENDIF
7374
7375IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
7376 vol7d_check_vol = .false.
7377ENDIF
7378
7379IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
7380 vol7d_check_vol = .false.
7381ENDIF
7382
7383IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
7384 vol7d_check_vol = .false.
7385ENDIF
7386
7387! Attributi dei dati
7388IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
7389 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
7390 vol7d_check_vol = .false.
7391ENDIF
7392
7393IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
7394 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
7395 vol7d_check_vol = .false.
7396ENDIF
7397
7398IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
7399 .NOT.ASSOCIATED(this%voldatiattri)) THEN
7400 vol7d_check_vol = .false.
7401ENDIF
7402
7403IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
7404 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
7405 vol7d_check_vol = .false.
7406ENDIF
7407
7408IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
7409 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
7410 vol7d_check_vol = .false.
7411ENDIF
7412IF (ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
7413 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
7414 ASSOCIATED(this%dativar%c)) THEN
7415 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_dati(this)
7416ENDIF
7417
7418END FUNCTION vol7d_check_vol
7419
7420
7435SUBROUTINE vol7d_alloc_vol(this, ini, inivol)
7436TYPE(vol7d),INTENT(inout) :: this
7437LOGICAL,INTENT(in),OPTIONAL :: ini
7438LOGICAL,INTENT(in),OPTIONAL :: inivol
7439
7440LOGICAL :: linivol
7441
7442IF (PRESENT(inivol)) THEN
7443 linivol = inivol
7444ELSE
7445 linivol = .true.
7446ENDIF
7447
7448! Anagrafica
7449IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
7450 CALL vol7d_force_alloc_ana(this, ini)
7451 ALLOCATE(this%volanar(SIZE(this%ana), SIZE(this%anavar%r), SIZE(this%network)))
7452 IF (linivol) this%volanar(:,:,:) = rmiss
7453ENDIF
7454
7455IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
7456 CALL vol7d_force_alloc_ana(this, ini)
7457 ALLOCATE(this%volanad(SIZE(this%ana), SIZE(this%anavar%d), SIZE(this%network)))
7458 IF (linivol) this%volanad(:,:,:) = rdmiss
7459ENDIF
7460
7461IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
7462 CALL vol7d_force_alloc_ana(this, ini)
7463 ALLOCATE(this%volanai(SIZE(this%ana), SIZE(this%anavar%i), SIZE(this%network)))
7464 IF (linivol) this%volanai(:,:,:) = imiss
7465ENDIF
7466
7467IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
7468 CALL vol7d_force_alloc_ana(this, ini)
7469 ALLOCATE(this%volanab(SIZE(this%ana), SIZE(this%anavar%b), SIZE(this%network)))
7470 IF (linivol) this%volanab(:,:,:) = ibmiss
7471ENDIF
7472
7473IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
7474 CALL vol7d_force_alloc_ana(this, ini)
7475 ALLOCATE(this%volanac(SIZE(this%ana), SIZE(this%anavar%c), SIZE(this%network)))
7476 IF (linivol) this%volanac(:,:,:) = cmiss
7477ENDIF
7478
7479! Attributi dell'anagrafica
7480IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
7481 .NOT.ASSOCIATED(this%volanaattrr)) THEN
7482 CALL vol7d_force_alloc_ana(this, ini)
7483 ALLOCATE(this%volanaattrr(SIZE(this%ana), SIZE(this%anavarattr%r), &
7484 SIZE(this%network), SIZE(this%anaattr%r)))
7485 IF (linivol) this%volanaattrr(:,:,:,:) = rmiss
7486ENDIF
7487
7488IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
7489 .NOT.ASSOCIATED(this%volanaattrd)) THEN
7490 CALL vol7d_force_alloc_ana(this, ini)
7491 ALLOCATE(this%volanaattrd(SIZE(this%ana), SIZE(this%anavarattr%d), &
7492 SIZE(this%network), SIZE(this%anaattr%d)))
7493 IF (linivol) this%volanaattrd(:,:,:,:) = rdmiss
7494ENDIF
7495
7496IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
7497 .NOT.ASSOCIATED(this%volanaattri)) THEN
7498 CALL vol7d_force_alloc_ana(this, ini)
7499 ALLOCATE(this%volanaattri(SIZE(this%ana), SIZE(this%anavarattr%i), &
7500 SIZE(this%network), SIZE(this%anaattr%i)))
7501 IF (linivol) this%volanaattri(:,:,:,:) = imiss
7502ENDIF
7503
7504IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
7505 .NOT.ASSOCIATED(this%volanaattrb)) THEN
7506 CALL vol7d_force_alloc_ana(this, ini)
7507 ALLOCATE(this%volanaattrb(SIZE(this%ana), SIZE(this%anavarattr%b), &
7508 SIZE(this%network), SIZE(this%anaattr%b)))
7509 IF (linivol) this%volanaattrb(:,:,:,:) = ibmiss
7510ENDIF
7511
7512IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
7513 .NOT.ASSOCIATED(this%volanaattrc)) THEN
7514 CALL vol7d_force_alloc_ana(this, ini)
7515 ALLOCATE(this%volanaattrc(SIZE(this%ana), SIZE(this%anavarattr%c), &
7516 SIZE(this%network), SIZE(this%anaattr%c)))
7517 IF (linivol) this%volanaattrc(:,:,:,:) = cmiss
7518ENDIF
7519
7520! Dati
7521IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
7522 CALL vol7d_force_alloc_dati(this, ini)
7523 ALLOCATE(this%voldatir(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7524 SIZE(this%timerange), SIZE(this%dativar%r), SIZE(this%network)))
7525 IF (linivol) this%voldatir(:,:,:,:,:,:) = rmiss
7526ENDIF
7527
7528IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
7529 CALL vol7d_force_alloc_dati(this, ini)
7530 ALLOCATE(this%voldatid(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7531 SIZE(this%timerange), SIZE(this%dativar%d), SIZE(this%network)))
7532 IF (linivol) this%voldatid(:,:,:,:,:,:) = rdmiss
7533ENDIF
7534
7535IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
7536 CALL vol7d_force_alloc_dati(this, ini)
7537 ALLOCATE(this%voldatii(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7538 SIZE(this%timerange), SIZE(this%dativar%i), SIZE(this%network)))
7539 IF (linivol) this%voldatii(:,:,:,:,:,:) = imiss
7540ENDIF
7541
7542IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
7543 CALL vol7d_force_alloc_dati(this, ini)
7544 ALLOCATE(this%voldatib(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7545 SIZE(this%timerange), SIZE(this%dativar%b), SIZE(this%network)))
7546 IF (linivol) this%voldatib(:,:,:,:,:,:) = ibmiss
7547ENDIF
7548
7549IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
7550 CALL vol7d_force_alloc_dati(this, ini)
7551 ALLOCATE(this%voldatic(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7552 SIZE(this%timerange), SIZE(this%dativar%c), SIZE(this%network)))
7553 IF (linivol) this%voldatic(:,:,:,:,:,:) = cmiss
7554ENDIF
7555
7556! Attributi dei dati
7557IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
7558 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
7559 CALL vol7d_force_alloc_dati(this, ini)
7560 ALLOCATE(this%voldatiattrr(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7561 SIZE(this%timerange), SIZE(this%dativarattr%r), SIZE(this%network), &
7562 SIZE(this%datiattr%r)))
7563 IF (linivol) this%voldatiattrr(:,:,:,:,:,:,:) = rmiss
7564ENDIF
7565
7566IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
7567 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
7568 CALL vol7d_force_alloc_dati(this, ini)
7569 ALLOCATE(this%voldatiattrd(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7570 SIZE(this%timerange), SIZE(this%dativarattr%d), SIZE(this%network), &
7571 SIZE(this%datiattr%d)))
7572 IF (linivol) this%voldatiattrd(:,:,:,:,:,:,:) = rdmiss
7573ENDIF
7574
7575IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
7576 .NOT.ASSOCIATED(this%voldatiattri)) THEN
7577 CALL vol7d_force_alloc_dati(this, ini)
7578 ALLOCATE(this%voldatiattri(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7579 SIZE(this%timerange), SIZE(this%dativarattr%i), SIZE(this%network), &
7580 SIZE(this%datiattr%i)))
7581 IF (linivol) this%voldatiattri(:,:,:,:,:,:,:) = imiss
7582ENDIF
7583
7584IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
7585 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
7586 CALL vol7d_force_alloc_dati(this, ini)
7587 ALLOCATE(this%voldatiattrb(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7588 SIZE(this%timerange), SIZE(this%dativarattr%b), SIZE(this%network), &
7589 SIZE(this%datiattr%b)))
7590 IF (linivol) this%voldatiattrb(:,:,:,:,:,:,:) = ibmiss
7591ENDIF
7592
7593IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
7594 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
7595 CALL vol7d_force_alloc_dati(this, ini)
7596 ALLOCATE(this%voldatiattrc(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
7597 SIZE(this%timerange), SIZE(this%dativarattr%c), SIZE(this%network), &
7598 SIZE(this%datiattr%c)))
7599 IF (linivol) this%voldatiattrc(:,:,:,:,:,:,:) = cmiss
7600ENDIF
7601
7602! Catch-all method
7603CALL vol7d_force_alloc(this)
7604
7605! Creo gli indici var-attr
7606
7607#ifdef DEBUG
7608CALL l4f_log(l4f_debug,"calling: vol7d_set_attr_ind")
7609#endif
7610
7611CALL vol7d_set_attr_ind(this)
7612
7613
7614
7615END SUBROUTINE vol7d_alloc_vol
7616
7617
7624SUBROUTINE vol7d_set_attr_ind(this)
7625TYPE(vol7d),INTENT(inout) :: this
7626
7627INTEGER :: i
7628
7629! real
7630IF (ASSOCIATED(this%dativar%r)) THEN
7631 IF (ASSOCIATED(this%dativarattr%r)) THEN
7632 DO i = 1, SIZE(this%dativar%r)
7633 this%dativar%r(i)%r = &
7634 firsttrue(this%dativar%r(i)%btable == this%dativarattr%r(:)%btable)
7635 ENDDO
7636 ENDIF
7637
7638 IF (ASSOCIATED(this%dativarattr%d)) THEN
7639 DO i = 1, SIZE(this%dativar%r)
7640 this%dativar%r(i)%d = &
7641 firsttrue(this%dativar%r(i)%btable == this%dativarattr%d(:)%btable)
7642 ENDDO
7643 ENDIF
7644
7645 IF (ASSOCIATED(this%dativarattr%i)) THEN
7646 DO i = 1, SIZE(this%dativar%r)
7647 this%dativar%r(i)%i = &
7648 firsttrue(this%dativar%r(i)%btable == this%dativarattr%i(:)%btable)
7649 ENDDO
7650 ENDIF
7651
7652 IF (ASSOCIATED(this%dativarattr%b)) THEN
7653 DO i = 1, SIZE(this%dativar%r)
7654 this%dativar%r(i)%b = &
7655 firsttrue(this%dativar%r(i)%btable == this%dativarattr%b(:)%btable)
7656 ENDDO
7657 ENDIF
7658
7659 IF (ASSOCIATED(this%dativarattr%c)) THEN
7660 DO i = 1, SIZE(this%dativar%r)
7661 this%dativar%r(i)%c = &
7662 firsttrue(this%dativar%r(i)%btable == this%dativarattr%c(:)%btable)
7663 ENDDO
7664 ENDIF
7665ENDIF
7666! double
7667IF (ASSOCIATED(this%dativar%d)) THEN
7668 IF (ASSOCIATED(this%dativarattr%r)) THEN
7669 DO i = 1, SIZE(this%dativar%d)
7670 this%dativar%d(i)%r = &
7671 firsttrue(this%dativar%d(i)%btable == this%dativarattr%r(:)%btable)
7672 ENDDO
7673 ENDIF
7674
7675 IF (ASSOCIATED(this%dativarattr%d)) THEN
7676 DO i = 1, SIZE(this%dativar%d)
7677 this%dativar%d(i)%d = &
7678 firsttrue(this%dativar%d(i)%btable == this%dativarattr%d(:)%btable)
7679 ENDDO
7680 ENDIF
7681
7682 IF (ASSOCIATED(this%dativarattr%i)) THEN
7683 DO i = 1, SIZE(this%dativar%d)
7684 this%dativar%d(i)%i = &
7685 firsttrue(this%dativar%d(i)%btable == this%dativarattr%i(:)%btable)
7686 ENDDO
7687 ENDIF
7688
7689 IF (ASSOCIATED(this%dativarattr%b)) THEN
7690 DO i = 1, SIZE(this%dativar%d)
7691 this%dativar%d(i)%b = &
7692 firsttrue(this%dativar%d(i)%btable == this%dativarattr%b(:)%btable)
7693 ENDDO
7694 ENDIF
7695
7696 IF (ASSOCIATED(this%dativarattr%c)) THEN
7697 DO i = 1, SIZE(this%dativar%d)
7698 this%dativar%d(i)%c = &
7699 firsttrue(this%dativar%d(i)%btable == this%dativarattr%c(:)%btable)
7700 ENDDO
7701 ENDIF
7702ENDIF
7703! integer
7704IF (ASSOCIATED(this%dativar%i)) THEN
7705 IF (ASSOCIATED(this%dativarattr%r)) THEN
7706 DO i = 1, SIZE(this%dativar%i)
7707 this%dativar%i(i)%r = &
7708 firsttrue(this%dativar%i(i)%btable == this%dativarattr%r(:)%btable)
7709 ENDDO
7710 ENDIF
7711
7712 IF (ASSOCIATED(this%dativarattr%d)) THEN
7713 DO i = 1, SIZE(this%dativar%i)
7714 this%dativar%i(i)%d = &
7715 firsttrue(this%dativar%i(i)%btable == this%dativarattr%d(:)%btable)
7716 ENDDO
7717 ENDIF
7718
7719 IF (ASSOCIATED(this%dativarattr%i)) THEN
7720 DO i = 1, SIZE(this%dativar%i)
7721 this%dativar%i(i)%i = &
7722 firsttrue(this%dativar%i(i)%btable == this%dativarattr%i(:)%btable)
7723 ENDDO
7724 ENDIF
7725
7726 IF (ASSOCIATED(this%dativarattr%b)) THEN
7727 DO i = 1, SIZE(this%dativar%i)
7728 this%dativar%i(i)%b = &
7729 firsttrue(this%dativar%i(i)%btable == this%dativarattr%b(:)%btable)
7730 ENDDO
7731 ENDIF
7732
7733 IF (ASSOCIATED(this%dativarattr%c)) THEN
7734 DO i = 1, SIZE(this%dativar%i)
7735 this%dativar%i(i)%c = &
7736 firsttrue(this%dativar%i(i)%btable == this%dativarattr%c(:)%btable)
7737 ENDDO
7738 ENDIF
7739ENDIF
7740! byte
7741IF (ASSOCIATED(this%dativar%b)) THEN
7742 IF (ASSOCIATED(this%dativarattr%r)) THEN
7743 DO i = 1, SIZE(this%dativar%b)
7744 this%dativar%b(i)%r = &
7745 firsttrue(this%dativar%b(i)%btable == this%dativarattr%r(:)%btable)
7746 ENDDO
7747 ENDIF
7748
7749 IF (ASSOCIATED(this%dativarattr%d)) THEN
7750 DO i = 1, SIZE(this%dativar%b)
7751 this%dativar%b(i)%d = &
7752 firsttrue(this%dativar%b(i)%btable == this%dativarattr%d(:)%btable)
7753 ENDDO
7754 ENDIF
7755
7756 IF (ASSOCIATED(this%dativarattr%i)) THEN
7757 DO i = 1, SIZE(this%dativar%b)
7758 this%dativar%b(i)%i = &
7759 firsttrue(this%dativar%b(i)%btable == this%dativarattr%i(:)%btable)
7760 ENDDO
7761 ENDIF
7762
7763 IF (ASSOCIATED(this%dativarattr%b)) THEN
7764 DO i = 1, SIZE(this%dativar%b)
7765 this%dativar%b(i)%b = &
7766 firsttrue(this%dativar%b(i)%btable == this%dativarattr%b(:)%btable)
7767 ENDDO
7768 ENDIF
7769
7770 IF (ASSOCIATED(this%dativarattr%c)) THEN
7771 DO i = 1, SIZE(this%dativar%b)
7772 this%dativar%b(i)%c = &
7773 firsttrue(this%dativar%b(i)%btable == this%dativarattr%c(:)%btable)
7774 ENDDO
7775 ENDIF
7776ENDIF
7777! character
7778IF (ASSOCIATED(this%dativar%c)) THEN
7779 IF (ASSOCIATED(this%dativarattr%r)) THEN
7780 DO i = 1, SIZE(this%dativar%c)
7781 this%dativar%c(i)%r = &
7782 firsttrue(this%dativar%c(i)%btable == this%dativarattr%r(:)%btable)
7783 ENDDO
7784 ENDIF
7785
7786 IF (ASSOCIATED(this%dativarattr%d)) THEN
7787 DO i = 1, SIZE(this%dativar%c)
7788 this%dativar%c(i)%d = &
7789 firsttrue(this%dativar%c(i)%btable == this%dativarattr%d(:)%btable)
7790 ENDDO
7791 ENDIF
7792
7793 IF (ASSOCIATED(this%dativarattr%i)) THEN
7794 DO i = 1, SIZE(this%dativar%c)
7795 this%dativar%c(i)%i = &
7796 firsttrue(this%dativar%c(i)%btable == this%dativarattr%i(:)%btable)
7797 ENDDO
7798 ENDIF
7799
7800 IF (ASSOCIATED(this%dativarattr%b)) THEN
7801 DO i = 1, SIZE(this%dativar%c)
7802 this%dativar%c(i)%b = &
7803 firsttrue(this%dativar%c(i)%btable == this%dativarattr%b(:)%btable)
7804 ENDDO
7805 ENDIF
7806
7807 IF (ASSOCIATED(this%dativarattr%c)) THEN
7808 DO i = 1, SIZE(this%dativar%c)
7809 this%dativar%c(i)%c = &
7810 firsttrue(this%dativar%c(i)%btable == this%dativarattr%c(:)%btable)
7811 ENDDO
7812 ENDIF
7813ENDIF
7814
7815END SUBROUTINE vol7d_set_attr_ind
7816
7817
7822SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
7823 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
7824TYPE(vol7d),INTENT(INOUT) :: this
7825TYPE(vol7d),INTENT(INOUT) :: that
7826LOGICAL,INTENT(IN),OPTIONAL :: sort
7827LOGICAL,INTENT(in),OPTIONAL :: bestdata
7828LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple ! experimental, please do not use outside the library now
7829
7830TYPE(vol7d) :: v7d_clean
7831
7832
7834 this = that
7836 that = v7d_clean ! destroy that without deallocating
7837ELSE ! Append that to this and destroy that
7839 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
7841ENDIF
7842
7843END SUBROUTINE vol7d_merge
7844
7845
7874SUBROUTINE vol7d_append(this, that, sort, bestdata, &
7875 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
7876TYPE(vol7d),INTENT(INOUT) :: this
7877TYPE(vol7d),INTENT(IN) :: that
7878LOGICAL,INTENT(IN),OPTIONAL :: sort
7879! experimental, please do not use outside the library now, they force the use
7880! of a simplified mapping algorithm which is valid only whene the dimension
7881! content is the same in both volumes , or when one of them is empty
7882LOGICAL,INTENT(in),OPTIONAL :: bestdata
7883LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple
7884
7885
7886TYPE(vol7d) :: v7dtmp
7887LOGICAL :: lsort, lbestdata
7888INTEGER,POINTER :: remapt1(:), remapt2(:), remaptr1(:), remaptr2(:), &
7889 remapl1(:), remapl2(:), remapa1(:), remapa2(:), remapn1(:), remapn2(:)
7890
7892IF (.NOT.vol7d_check_vol(that)) RETURN ! be safe
7895 RETURN
7896ENDIF
7897
7898IF (this%time_definition /= that%time_definition) THEN
7899 CALL l4f_log(l4f_fatal, &
7900 'in vol7d_append, cannot append volumes with different &
7901 &time definition')
7902 CALL raise_fatal_error()
7903ENDIF
7904
7905! Completo l'allocazione per avere volumi a norma
7906CALL vol7d_alloc_vol(this)
7907
7911
7912! Calcolo le mappature tra volumi vecchi e volume nuovo
7913! I puntatori remap* vengono tutti o allocati o nullificati
7914IF (optio_log(ltimesimple)) THEN
7915 CALL vol7d_remap2simple_datetime(this%time, that%time, v7dtmp%time, &
7916 lsort, remapt1, remapt2)
7917ELSE
7918 CALL vol7d_remap2_datetime(this%time, that%time, v7dtmp%time, &
7919 lsort, remapt1, remapt2)
7920ENDIF
7921IF (optio_log(ltimerangesimple)) THEN
7922 CALL vol7d_remap2simple_vol7d_timerange(this%timerange, that%timerange, &
7923 v7dtmp%timerange, lsort, remaptr1, remaptr2)
7924ELSE
7925 CALL vol7d_remap2_vol7d_timerange(this%timerange, that%timerange, &
7926 v7dtmp%timerange, lsort, remaptr1, remaptr2)
7927ENDIF
7928IF (optio_log(llevelsimple)) THEN
7929 CALL vol7d_remap2simple_vol7d_level(this%level, that%level, v7dtmp%level, &
7930 lsort, remapl1, remapl2)
7931ELSE
7932 CALL vol7d_remap2_vol7d_level(this%level, that%level, v7dtmp%level, &
7933 lsort, remapl1, remapl2)
7934ENDIF
7935IF (optio_log(lanasimple)) THEN
7936 CALL vol7d_remap2simple_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
7937 .false., remapa1, remapa2)
7938ELSE
7939 CALL vol7d_remap2_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
7940 .false., remapa1, remapa2)
7941ENDIF
7942IF (optio_log(lnetworksimple)) THEN
7943 CALL vol7d_remap2simple_vol7d_network(this%network, that%network, v7dtmp%network, &
7944 .false., remapn1, remapn2)
7945ELSE
7946 CALL vol7d_remap2_vol7d_network(this%network, that%network, v7dtmp%network, &
7947 .false., remapn1, remapn2)
7948ENDIF
7949
7950! Faccio la fusione fisica dei volumi
7951CALL vol7d_merge_finalr(this, that, v7dtmp, &
7952 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
7953 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
7954CALL vol7d_merge_finald(this, that, v7dtmp, &
7955 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
7956 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
7957CALL vol7d_merge_finali(this, that, v7dtmp, &
7958 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
7959 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
7960CALL vol7d_merge_finalb(this, that, v7dtmp, &
7961 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
7962 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
7963CALL vol7d_merge_finalc(this, that, v7dtmp, &
7964 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
7965 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
7966
7967! Dealloco i vettori di rimappatura
7968IF (ASSOCIATED(remapt1)) DEALLOCATE(remapt1)
7969IF (ASSOCIATED(remapt2)) DEALLOCATE(remapt2)
7970IF (ASSOCIATED(remaptr1)) DEALLOCATE(remaptr1)
7971IF (ASSOCIATED(remaptr2)) DEALLOCATE(remaptr2)
7972IF (ASSOCIATED(remapl1)) DEALLOCATE(remapl1)
7973IF (ASSOCIATED(remapl2)) DEALLOCATE(remapl2)
7974IF (ASSOCIATED(remapa1)) DEALLOCATE(remapa1)
7975IF (ASSOCIATED(remapa2)) DEALLOCATE(remapa2)
7976IF (ASSOCIATED(remapn1)) DEALLOCATE(remapn1)
7977IF (ASSOCIATED(remapn2)) DEALLOCATE(remapn2)
7978
7979! Distruggo il vecchio volume e assegno il nuovo a this
7981this = v7dtmp
7982! Ricreo gli indici var-attr
7983CALL vol7d_set_attr_ind(this)
7984
7985END SUBROUTINE vol7d_append
7986
7987
8020SUBROUTINE vol7d_copy(this, that, sort, unique, miss, &
8021 lsort_time, lsort_timerange, lsort_level, &
8022 ltime, ltimerange, llevel, lana, lnetwork, &
8023 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
8024 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
8025 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
8026 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
8027 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
8028 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
8029TYPE(vol7d),INTENT(IN) :: this
8030TYPE(vol7d),INTENT(INOUT) :: that
8031LOGICAL,INTENT(IN),OPTIONAL :: sort
8032LOGICAL,INTENT(IN),OPTIONAL :: unique
8033LOGICAL,INTENT(IN),OPTIONAL :: miss
8034LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
8035LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
8036LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
8044LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
8046LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
8048LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
8050LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
8052LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
8054LOGICAL,INTENT(in),OPTIONAL :: &
8055 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
8056 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
8057 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
8058 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
8059 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
8060 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
8061
8062LOGICAL :: lsort, lunique, lmiss
8063INTEGER,POINTER :: remapt(:), remaptr(:), remapl(:), remapa(:), remapn(:)
8064
8067IF (.NOT.vol7d_check_vol(this)) RETURN ! be safe
8068
8072
8073! Calcolo le mappature tra volume vecchio e volume nuovo
8074! I puntatori remap* vengono tutti o allocati o nullificati
8075CALL vol7d_remap1_datetime(this%time, that%time, &
8076 lsort.OR.optio_log(lsort_time), lunique, lmiss, remapt, ltime)
8077CALL vol7d_remap1_vol7d_timerange(this%timerange, that%timerange, &
8078 lsort.OR.optio_log(lsort_timerange), lunique, lmiss, remaptr, ltimerange)
8079CALL vol7d_remap1_vol7d_level(this%level, that%level, &
8080 lsort.OR.optio_log(lsort_level), lunique, lmiss, remapl, llevel)
8081CALL vol7d_remap1_vol7d_ana(this%ana, that%ana, &
8082 lsort, lunique, lmiss, remapa, lana)
8083CALL vol7d_remap1_vol7d_network(this%network, that%network, &
8084 lsort, lunique, lmiss, remapn, lnetwork)
8085
8086! lanavari, lanavarb, lanavarc, &
8087! lanaattri, lanaattrb, lanaattrc, &
8088! lanavarattri, lanavarattrb, lanavarattrc, &
8089! ldativari, ldativarb, ldativarc, &
8090! ldatiattri, ldatiattrb, ldatiattrc, &
8091! ldativarattri, ldativarattrb, ldativarattrc
8092! Faccio la riforma fisica dei volumi
8093CALL vol7d_reform_finalr(this, that, &
8094 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8095 lanavarr, lanaattrr, lanavarattrr, ldativarr, ldatiattrr, ldativarattrr)
8096CALL vol7d_reform_finald(this, that, &
8097 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8098 lanavard, lanaattrd, lanavarattrd, ldativard, ldatiattrd, ldativarattrd)
8099CALL vol7d_reform_finali(this, that, &
8100 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8101 lanavari, lanaattri, lanavarattri, ldativari, ldatiattri, ldativarattri)
8102CALL vol7d_reform_finalb(this, that, &
8103 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8104 lanavarb, lanaattrb, lanavarattrb, ldativarb, ldatiattrb, ldativarattrb)
8105CALL vol7d_reform_finalc(this, that, &
8106 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
8107 lanavarc, lanaattrc, lanavarattrc, ldativarc, ldatiattrc, ldativarattrc)
8108
8109! Dealloco i vettori di rimappatura
8110IF (ASSOCIATED(remapt)) DEALLOCATE(remapt)
8111IF (ASSOCIATED(remaptr)) DEALLOCATE(remaptr)
8112IF (ASSOCIATED(remapl)) DEALLOCATE(remapl)
8113IF (ASSOCIATED(remapa)) DEALLOCATE(remapa)
8114IF (ASSOCIATED(remapn)) DEALLOCATE(remapn)
8115
8116! Ricreo gli indici var-attr
8117CALL vol7d_set_attr_ind(that)
8118that%time_definition = this%time_definition
8119
8120END SUBROUTINE vol7d_copy
8121
8122
8133SUBROUTINE vol7d_reform(this, sort, unique, miss, &
8134 lsort_time, lsort_timerange, lsort_level, &
8135 ltime, ltimerange, llevel, lana, lnetwork, &
8136 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
8137 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
8138 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
8139 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
8140 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
8141 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc&
8142 ,purgeana)
8143TYPE(vol7d),INTENT(INOUT) :: this
8144LOGICAL,INTENT(IN),OPTIONAL :: sort
8145LOGICAL,INTENT(IN),OPTIONAL :: unique
8146LOGICAL,INTENT(IN),OPTIONAL :: miss
8147LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
8148LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
8149LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
8157LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
8158LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
8159LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
8160LOGICAL,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(:)
8170LOGICAL,INTENT(IN),OPTIONAL :: purgeana
8171
8172TYPE(vol7d) :: v7dtmp
8173logical,allocatable :: llana(:)
8174integer :: i
8175
8177 lsort_time, lsort_timerange, lsort_level, &
8178 ltime, ltimerange, llevel, lana, lnetwork, &
8179 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
8180 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
8181 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
8182 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
8183 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
8184 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
8185
8186! destroy old volume
8188
8189if (optio_log(purgeana)) then
8190 allocate(llana(size(v7dtmp%ana)))
8191 llana =.false.
8192 do i =1,size(v7dtmp%ana)
8193 if (associated(v7dtmp%voldatii)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatii(i,:,:,:,:,:)))
8194 if (associated(v7dtmp%voldatir)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatir(i,:,:,:,:,:)))
8195 if (associated(v7dtmp%voldatid)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatid(i,:,:,:,:,:)))
8196 if (associated(v7dtmp%voldatib)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatib(i,:,:,:,:,:)))
8197 if (associated(v7dtmp%voldatic)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatic(i,:,:,:,:,:)))
8198 end do
8199 CALL vol7d_copy(v7dtmp, this,lana=llana)
8201 deallocate(llana)
8202else
8203 this=v7dtmp
8204end if
8205
8206END SUBROUTINE vol7d_reform
8207
8208
8216SUBROUTINE vol7d_smart_sort(this, lsort_time, lsort_timerange, lsort_level)
8217TYPE(vol7d),INTENT(INOUT) :: this
8218LOGICAL,OPTIONAL,INTENT(in) :: lsort_time
8219LOGICAL,OPTIONAL,INTENT(in) :: lsort_timerange
8220LOGICAL,OPTIONAL,INTENT(in) :: lsort_level
8221
8222INTEGER :: i
8223LOGICAL :: to_be_sorted
8224
8225to_be_sorted = .false.
8226CALL vol7d_alloc_vol(this) ! usual safety check
8227
8228IF (optio_log(lsort_time)) THEN
8229 DO i = 2, SIZE(this%time)
8230 IF (this%time(i) < this%time(i-1)) THEN
8231 to_be_sorted = .true.
8232 EXIT
8233 ENDIF
8234 ENDDO
8235ENDIF
8236IF (optio_log(lsort_timerange)) THEN
8237 DO i = 2, SIZE(this%timerange)
8238 IF (this%timerange(i) < this%timerange(i-1)) THEN
8239 to_be_sorted = .true.
8240 EXIT
8241 ENDIF
8242 ENDDO
8243ENDIF
8244IF (optio_log(lsort_level)) THEN
8245 DO i = 2, SIZE(this%level)
8246 IF (this%level(i) < this%level(i-1)) THEN
8247 to_be_sorted = .true.
8248 EXIT
8249 ENDIF
8250 ENDDO
8251ENDIF
8252
8253IF (to_be_sorted) CALL vol7d_reform(this, &
8254 lsort_time=lsort_time, lsort_timerange=lsort_timerange, lsort_level=lsort_level )
8255
8256END SUBROUTINE vol7d_smart_sort
8257
8265SUBROUTINE vol7d_filter(this, avl, vl, nl, s_d, e_d)
8266TYPE(vol7d),INTENT(inout) :: this
8267CHARACTER(len=*),INTENT(in),OPTIONAL :: avl(:)
8268CHARACTER(len=*),INTENT(in),OPTIONAL :: vl(:)
8269TYPE(vol7d_network),OPTIONAL :: nl(:)
8270TYPE(datetime),INTENT(in),OPTIONAL :: s_d
8271TYPE(datetime),INTENT(in),OPTIONAL :: e_d
8272
8273INTEGER :: i
8274
8275IF (PRESENT(avl)) THEN
8276 IF (SIZE(avl) > 0) THEN
8277
8278 IF (ASSOCIATED(this%anavar%r)) THEN
8279 DO i = 1, SIZE(this%anavar%r)
8280 IF (all(this%anavar%r(i)%btable /= avl)) this%anavar%r(i) = vol7d_var_miss
8281 ENDDO
8282 ENDIF
8283
8284 IF (ASSOCIATED(this%anavar%i)) THEN
8285 DO i = 1, SIZE(this%anavar%i)
8286 IF (all(this%anavar%i(i)%btable /= avl)) this%anavar%i(i) = vol7d_var_miss
8287 ENDDO
8288 ENDIF
8289
8290 IF (ASSOCIATED(this%anavar%b)) THEN
8291 DO i = 1, SIZE(this%anavar%b)
8292 IF (all(this%anavar%b(i)%btable /= avl)) this%anavar%b(i) = vol7d_var_miss
8293 ENDDO
8294 ENDIF
8295
8296 IF (ASSOCIATED(this%anavar%d)) THEN
8297 DO i = 1, SIZE(this%anavar%d)
8298 IF (all(this%anavar%d(i)%btable /= avl)) this%anavar%d(i) = vol7d_var_miss
8299 ENDDO
8300 ENDIF
8301
8302 IF (ASSOCIATED(this%anavar%c)) THEN
8303 DO i = 1, SIZE(this%anavar%c)
8304 IF (all(this%anavar%c(i)%btable /= avl)) this%anavar%c(i) = vol7d_var_miss
8305 ENDDO
8306 ENDIF
8307
8308 ENDIF
8309ENDIF
8310
8311
8312IF (PRESENT(vl)) THEN
8313 IF (size(vl) > 0) THEN
8314 IF (ASSOCIATED(this%dativar%r)) THEN
8315 DO i = 1, SIZE(this%dativar%r)
8316 IF (all(this%dativar%r(i)%btable /= vl)) this%dativar%r(i) = vol7d_var_miss
8317 ENDDO
8318 ENDIF
8319
8320 IF (ASSOCIATED(this%dativar%i)) THEN
8321 DO i = 1, SIZE(this%dativar%i)
8322 IF (all(this%dativar%i(i)%btable /= vl)) this%dativar%i(i) = vol7d_var_miss
8323 ENDDO
8324 ENDIF
8325
8326 IF (ASSOCIATED(this%dativar%b)) THEN
8327 DO i = 1, SIZE(this%dativar%b)
8328 IF (all(this%dativar%b(i)%btable /= vl)) this%dativar%b(i) = vol7d_var_miss
8329 ENDDO
8330 ENDIF
8331
8332 IF (ASSOCIATED(this%dativar%d)) THEN
8333 DO i = 1, SIZE(this%dativar%d)
8334 IF (all(this%dativar%d(i)%btable /= vl)) this%dativar%d(i) = vol7d_var_miss
8335 ENDDO
8336 ENDIF
8337
8338 IF (ASSOCIATED(this%dativar%c)) THEN
8339 DO i = 1, SIZE(this%dativar%c)
8340 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
8341 ENDDO
8342 ENDIF
8343
8344 IF (ASSOCIATED(this%dativar%c)) THEN
8345 DO i = 1, SIZE(this%dativar%c)
8346 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
8347 ENDDO
8348 ENDIF
8349
8350 ENDIF
8351ENDIF
8352
8353IF (PRESENT(nl)) THEN
8354 IF (SIZE(nl) > 0) THEN
8355 DO i = 1, SIZE(this%network)
8356 IF (all(this%network(i) /= nl)) this%network(i) = vol7d_network_miss
8357 ENDDO
8358 ENDIF
8359ENDIF
8360
8361IF (PRESENT(s_d)) THEN
8363 WHERE (this%time < s_d)
8364 this%time = datetime_miss
8365 END WHERE
8366 ENDIF
8367ENDIF
8368
8369IF (PRESENT(e_d)) THEN
8371 WHERE (this%time > e_d)
8372 this%time = datetime_miss
8373 END WHERE
8374 ENDIF
8375ENDIF
8376
8377CALL vol7d_reform(this, miss=.true.)
8378
8379END SUBROUTINE vol7d_filter
8380
8381
8388SUBROUTINE vol7d_convr(this, that, anaconv)
8389TYPE(vol7d),INTENT(IN) :: this
8390TYPE(vol7d),INTENT(INOUT) :: that
8391LOGICAL,OPTIONAL,INTENT(in) :: anaconv
8392INTEGER :: i
8393LOGICAL :: fv(1)=(/.false./), tv(1)=(/.true./), acp(1), acn(1)
8394TYPE(vol7d) :: v7d_tmp
8395
8396IF (optio_log(anaconv)) THEN
8397 acp=fv
8398 acn=tv
8399ELSE
8400 acp=tv
8401 acn=fv
8402ENDIF
8403
8404! Volume con solo i dati reali e tutti gli attributi
8405! l'anagrafica e` copiata interamente se necessario
8406CALL vol7d_copy(this, that, &
8407 lanavarr=tv, lanavard=acp, lanavari=acp, lanavarb=acp, lanavarc=acp, &
8408 ldativarr=tv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=fv)
8409
8410! Volume solo di dati double
8411CALL vol7d_copy(this, v7d_tmp, &
8412 lanavarr=fv, lanavard=acn, lanavari=fv, lanavarb=fv, lanavarc=fv, &
8413 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8414 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8415 ldativarr=fv, ldativard=tv, ldativari=fv, ldativarb=fv, ldativarc=fv, &
8416 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8417 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8418
8419! converto a dati reali
8420IF (ASSOCIATED(v7d_tmp%anavar%d) .OR. ASSOCIATED(v7d_tmp%dativar%d)) THEN
8421
8422 IF (ASSOCIATED(v7d_tmp%anavar%d)) THEN
8423! alloco i dati reali e vi trasferisco i double
8424 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanad, 1), SIZE(v7d_tmp%volanad, 2), &
8425 SIZE(v7d_tmp%volanad, 3)))
8426 DO i = 1, SIZE(v7d_tmp%anavar%d)
8427 v7d_tmp%volanar(:,i,:) = &
8428 realdat(v7d_tmp%volanad(:,i,:), v7d_tmp%anavar%d(i))
8429 ENDDO
8430 DEALLOCATE(v7d_tmp%volanad)
8431! trasferisco le variabili
8432 v7d_tmp%anavar%r => v7d_tmp%anavar%d
8433 NULLIFY(v7d_tmp%anavar%d)
8434 ENDIF
8435
8436 IF (ASSOCIATED(v7d_tmp%dativar%d)) THEN
8437! alloco i dati reali e vi trasferisco i double
8438 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatid, 1), SIZE(v7d_tmp%voldatid, 2), &
8439 SIZE(v7d_tmp%voldatid, 3), SIZE(v7d_tmp%voldatid, 4), SIZE(v7d_tmp%voldatid, 5), &
8440 SIZE(v7d_tmp%voldatid, 6)))
8441 DO i = 1, SIZE(v7d_tmp%dativar%d)
8442 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8443 realdat(v7d_tmp%voldatid(:,:,:,:,i,:), v7d_tmp%dativar%d(i))
8444 ENDDO
8445 DEALLOCATE(v7d_tmp%voldatid)
8446! trasferisco le variabili
8447 v7d_tmp%dativar%r => v7d_tmp%dativar%d
8448 NULLIFY(v7d_tmp%dativar%d)
8449 ENDIF
8450
8451! fondo con il volume definitivo
8452 CALL vol7d_merge(that, v7d_tmp)
8453ELSE
8455ENDIF
8456
8457
8458! Volume solo di dati interi
8459CALL vol7d_copy(this, v7d_tmp, &
8460 lanavarr=fv, lanavard=fv, lanavari=acn, lanavarb=fv, lanavarc=fv, &
8461 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8462 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8463 ldativarr=fv, ldativard=fv, ldativari=tv, ldativarb=fv, ldativarc=fv, &
8464 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8465 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8466
8467! converto a dati reali
8468IF (ASSOCIATED(v7d_tmp%anavar%i) .OR. ASSOCIATED(v7d_tmp%dativar%i)) THEN
8469
8470 IF (ASSOCIATED(v7d_tmp%anavar%i)) THEN
8471! alloco i dati reali e vi trasferisco gli interi
8472 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanai, 1), SIZE(v7d_tmp%volanai, 2), &
8473 SIZE(v7d_tmp%volanai, 3)))
8474 DO i = 1, SIZE(v7d_tmp%anavar%i)
8475 v7d_tmp%volanar(:,i,:) = &
8476 realdat(v7d_tmp%volanai(:,i,:), v7d_tmp%anavar%i(i))
8477 ENDDO
8478 DEALLOCATE(v7d_tmp%volanai)
8479! trasferisco le variabili
8480 v7d_tmp%anavar%r => v7d_tmp%anavar%i
8481 NULLIFY(v7d_tmp%anavar%i)
8482 ENDIF
8483
8484 IF (ASSOCIATED(v7d_tmp%dativar%i)) THEN
8485! alloco i dati reali e vi trasferisco gli interi
8486 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatii, 1), SIZE(v7d_tmp%voldatii, 2), &
8487 SIZE(v7d_tmp%voldatii, 3), SIZE(v7d_tmp%voldatii, 4), SIZE(v7d_tmp%voldatii, 5), &
8488 SIZE(v7d_tmp%voldatii, 6)))
8489 DO i = 1, SIZE(v7d_tmp%dativar%i)
8490 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8491 realdat(v7d_tmp%voldatii(:,:,:,:,i,:), v7d_tmp%dativar%i(i))
8492 ENDDO
8493 DEALLOCATE(v7d_tmp%voldatii)
8494! trasferisco le variabili
8495 v7d_tmp%dativar%r => v7d_tmp%dativar%i
8496 NULLIFY(v7d_tmp%dativar%i)
8497 ENDIF
8498
8499! fondo con il volume definitivo
8500 CALL vol7d_merge(that, v7d_tmp)
8501ELSE
8503ENDIF
8504
8505
8506! Volume solo di dati byte
8507CALL vol7d_copy(this, v7d_tmp, &
8508 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=acn, lanavarc=fv, &
8509 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8510 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8511 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=tv, ldativarc=fv, &
8512 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8513 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8514
8515! converto a dati reali
8516IF (ASSOCIATED(v7d_tmp%anavar%b) .OR. ASSOCIATED(v7d_tmp%dativar%b)) THEN
8517
8518 IF (ASSOCIATED(v7d_tmp%anavar%b)) THEN
8519! alloco i dati reali e vi trasferisco i byte
8520 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanab, 1), SIZE(v7d_tmp%volanab, 2), &
8521 SIZE(v7d_tmp%volanab, 3)))
8522 DO i = 1, SIZE(v7d_tmp%anavar%b)
8523 v7d_tmp%volanar(:,i,:) = &
8524 realdat(v7d_tmp%volanab(:,i,:), v7d_tmp%anavar%b(i))
8525 ENDDO
8526 DEALLOCATE(v7d_tmp%volanab)
8527! trasferisco le variabili
8528 v7d_tmp%anavar%r => v7d_tmp%anavar%b
8529 NULLIFY(v7d_tmp%anavar%b)
8530 ENDIF
8531
8532 IF (ASSOCIATED(v7d_tmp%dativar%b)) THEN
8533! alloco i dati reali e vi trasferisco i byte
8534 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatib, 1), SIZE(v7d_tmp%voldatib, 2), &
8535 SIZE(v7d_tmp%voldatib, 3), SIZE(v7d_tmp%voldatib, 4), SIZE(v7d_tmp%voldatib, 5), &
8536 SIZE(v7d_tmp%voldatib, 6)))
8537 DO i = 1, SIZE(v7d_tmp%dativar%b)
8538 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8539 realdat(v7d_tmp%voldatib(:,:,:,:,i,:), v7d_tmp%dativar%b(i))
8540 ENDDO
8541 DEALLOCATE(v7d_tmp%voldatib)
8542! trasferisco le variabili
8543 v7d_tmp%dativar%r => v7d_tmp%dativar%b
8544 NULLIFY(v7d_tmp%dativar%b)
8545 ENDIF
8546
8547! fondo con il volume definitivo
8548 CALL vol7d_merge(that, v7d_tmp)
8549ELSE
8551ENDIF
8552
8553
8554! Volume solo di dati character
8555CALL vol7d_copy(this, v7d_tmp, &
8556 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=fv, lanavarc=acn, &
8557 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
8558 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
8559 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=tv, &
8560 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
8561 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
8562
8563! converto a dati reali
8564IF (ASSOCIATED(v7d_tmp%anavar%c) .OR. ASSOCIATED(v7d_tmp%dativar%c)) THEN
8565
8566 IF (ASSOCIATED(v7d_tmp%anavar%c)) THEN
8567! alloco i dati reali e vi trasferisco i character
8568 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanac, 1), SIZE(v7d_tmp%volanac, 2), &
8569 SIZE(v7d_tmp%volanac, 3)))
8570 DO i = 1, SIZE(v7d_tmp%anavar%c)
8571 v7d_tmp%volanar(:,i,:) = &
8572 realdat(v7d_tmp%volanac(:,i,:), v7d_tmp%anavar%c(i))
8573 ENDDO
8574 DEALLOCATE(v7d_tmp%volanac)
8575! trasferisco le variabili
8576 v7d_tmp%anavar%r => v7d_tmp%anavar%c
8577 NULLIFY(v7d_tmp%anavar%c)
8578 ENDIF
8579
8580 IF (ASSOCIATED(v7d_tmp%dativar%c)) THEN
8581! alloco i dati reali e vi trasferisco i character
8582 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatic, 1), SIZE(v7d_tmp%voldatic, 2), &
8583 SIZE(v7d_tmp%voldatic, 3), SIZE(v7d_tmp%voldatic, 4), SIZE(v7d_tmp%voldatic, 5), &
8584 SIZE(v7d_tmp%voldatic, 6)))
8585 DO i = 1, SIZE(v7d_tmp%dativar%c)
8586 v7d_tmp%voldatir(:,:,:,:,i,:) = &
8587 realdat(v7d_tmp%voldatic(:,:,:,:,i,:), v7d_tmp%dativar%c(i))
8588 ENDDO
8589 DEALLOCATE(v7d_tmp%voldatic)
8590! trasferisco le variabili
8591 v7d_tmp%dativar%r => v7d_tmp%dativar%c
8592 NULLIFY(v7d_tmp%dativar%c)
8593 ENDIF
8594
8595! fondo con il volume definitivo
8596 CALL vol7d_merge(that, v7d_tmp)
8597ELSE
8599ENDIF
8600
8601END SUBROUTINE vol7d_convr
8602
8603
8607SUBROUTINE vol7d_diff_only (this, that, data_only,ana)
8608TYPE(vol7d),INTENT(IN) :: this
8609TYPE(vol7d),INTENT(OUT) :: that
8610logical , optional, intent(in) :: data_only
8611logical , optional, intent(in) :: ana
8612logical :: ldata_only,lana
8613
8614IF (PRESENT(data_only)) THEN
8615 ldata_only = data_only
8616ELSE
8617 ldata_only = .false.
8618ENDIF
8619
8620IF (PRESENT(ana)) THEN
8621 lana = ana
8622ELSE
8623 lana = .false.
8624ENDIF
8625
8626
8627#undef VOL7D_POLY_ARRAY
8628#define VOL7D_POLY_ARRAY voldati
8629#include "vol7d_class_diff.F90"
8630#undef VOL7D_POLY_ARRAY
8631#define VOL7D_POLY_ARRAY voldatiattr
8632#include "vol7d_class_diff.F90"
8633#undef VOL7D_POLY_ARRAY
8634
8635if ( .not. ldata_only) then
8636
8637#define VOL7D_POLY_ARRAY volana
8638#include "vol7d_class_diff.F90"
8639#undef VOL7D_POLY_ARRAY
8640#define VOL7D_POLY_ARRAY volanaattr
8641#include "vol7d_class_diff.F90"
8642#undef VOL7D_POLY_ARRAY
8643
8644 if(lana)then
8645 where ( this%ana == that%ana )
8646 that%ana = vol7d_ana_miss
8647 end where
8648 end if
8649
8650end if
8651
8652
8653
8654END SUBROUTINE vol7d_diff_only
8655
8656
8657
8658! Creo le routine da ripetere per i vari tipi di dati di v7d
8659! tramite un template e il preprocessore
8660#undef VOL7D_POLY_TYPE
8661#undef VOL7D_POLY_TYPES
8662#define VOL7D_POLY_TYPE REAL
8663#define VOL7D_POLY_TYPES r
8664#include "vol7d_class_type_templ.F90"
8665#undef VOL7D_POLY_TYPE
8666#undef VOL7D_POLY_TYPES
8667#define VOL7D_POLY_TYPE DOUBLE PRECISION
8668#define VOL7D_POLY_TYPES d
8669#include "vol7d_class_type_templ.F90"
8670#undef VOL7D_POLY_TYPE
8671#undef VOL7D_POLY_TYPES
8672#define VOL7D_POLY_TYPE INTEGER
8673#define VOL7D_POLY_TYPES i
8674#include "vol7d_class_type_templ.F90"
8675#undef VOL7D_POLY_TYPE
8676#undef VOL7D_POLY_TYPES
8677#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
8678#define VOL7D_POLY_TYPES b
8679#include "vol7d_class_type_templ.F90"
8680#undef VOL7D_POLY_TYPE
8681#undef VOL7D_POLY_TYPES
8682#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
8683#define VOL7D_POLY_TYPES c
8684#include "vol7d_class_type_templ.F90"
8685
8686! Creo le routine da ripetere per i vari descrittori di dimensioni di v7d
8687! tramite un template e il preprocessore
8688#define VOL7D_SORT
8689#undef VOL7D_NO_ZERO_ALLOC
8690#undef VOL7D_POLY_TYPE
8691#define VOL7D_POLY_TYPE datetime
8692#include "vol7d_class_desc_templ.F90"
8693#undef VOL7D_POLY_TYPE
8694#define VOL7D_POLY_TYPE vol7d_timerange
8695#include "vol7d_class_desc_templ.F90"
8696#undef VOL7D_POLY_TYPE
8697#define VOL7D_POLY_TYPE vol7d_level
8698#include "vol7d_class_desc_templ.F90"
8699#undef VOL7D_SORT
8700#undef VOL7D_POLY_TYPE
8701#define VOL7D_POLY_TYPE vol7d_network
8702#include "vol7d_class_desc_templ.F90"
8703#undef VOL7D_POLY_TYPE
8704#define VOL7D_POLY_TYPE vol7d_ana
8705#include "vol7d_class_desc_templ.F90"
8706#define VOL7D_NO_ZERO_ALLOC
8707#undef VOL7D_POLY_TYPE
8708#define VOL7D_POLY_TYPE vol7d_var
8709#include "vol7d_class_desc_templ.F90"
8710
8720subroutine vol7d_write_on_file (this,unit,description,filename,filename_auto)
8721
8722TYPE(vol7d),INTENT(IN) :: this
8723integer,optional,intent(inout) :: unit
8724character(len=*),intent(in),optional :: filename
8725character(len=*),intent(out),optional :: filename_auto
8726character(len=*),INTENT(IN),optional :: description
8727
8728integer :: lunit
8729character(len=254) :: ldescription,arg,lfilename
8730integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
8731 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
8732 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
8733 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
8734 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
8735 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
8736 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
8737!integer :: im,id,iy
8738integer :: tarray(8)
8739logical :: opened,exist
8740
8741 nana=0
8742 ntime=0
8743 ntimerange=0
8744 nlevel=0
8745 nnetwork=0
8746 ndativarr=0
8747 ndativari=0
8748 ndativarb=0
8749 ndativard=0
8750 ndativarc=0
8751 ndatiattrr=0
8752 ndatiattri=0
8753 ndatiattrb=0
8754 ndatiattrd=0
8755 ndatiattrc=0
8756 ndativarattrr=0
8757 ndativarattri=0
8758 ndativarattrb=0
8759 ndativarattrd=0
8760 ndativarattrc=0
8761 nanavarr=0
8762 nanavari=0
8763 nanavarb=0
8764 nanavard=0
8765 nanavarc=0
8766 nanaattrr=0
8767 nanaattri=0
8768 nanaattrb=0
8769 nanaattrd=0
8770 nanaattrc=0
8771 nanavarattrr=0
8772 nanavarattri=0
8773 nanavarattrb=0
8774 nanavarattrd=0
8775 nanavarattrc=0
8776
8777
8778!call idate(im,id,iy)
8779call date_and_time(values=tarray)
8780call getarg(0,arg)
8781
8782if (present(description))then
8783 ldescription=description
8784else
8785 ldescription="Vol7d generated by: "//trim(arg)
8786end if
8787
8788if (.not. present(unit))then
8789 lunit=getunit()
8790else
8791 if (unit==0)then
8792 lunit=getunit()
8793 unit=lunit
8794 else
8795 lunit=unit
8796 end if
8797end if
8798
8799lfilename=trim(arg)//".v7d"
8801
8802if (present(filename))then
8803 if (filename /= "")then
8804 lfilename=filename
8805 end if
8806end if
8807
8808if (present(filename_auto))filename_auto=lfilename
8809
8810
8811inquire(unit=lunit,opened=opened)
8812if (.not. opened) then
8813! inquire(file=lfilename, EXIST=exist)
8814! IF (exist) THEN
8815! CALL l4f_log(L4F_FATAL, &
8816! 'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename))
8817! CALL raise_fatal_error()
8818! ENDIF
8819 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM')
8820 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
8821end if
8822
8823if (associated(this%ana)) nana=size(this%ana)
8824if (associated(this%time)) ntime=size(this%time)
8825if (associated(this%timerange)) ntimerange=size(this%timerange)
8826if (associated(this%level)) nlevel=size(this%level)
8827if (associated(this%network)) nnetwork=size(this%network)
8828
8829if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
8830if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
8831if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
8832if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
8833if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
8834
8835if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
8836if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
8837if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
8838if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
8839if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)
8840
8841if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
8842if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
8843if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
8844if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
8845if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
8846
8847if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
8848if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
8849if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
8850if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
8851if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
8852
8853if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
8854if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
8855if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
8856if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
8857if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)
8858
8859if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
8860if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
8861if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
8862if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
8863if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)
8864
8865write(unit=lunit)ldescription
8866write(unit=lunit)tarray
8867
8868write(unit=lunit)&
8869 nana, ntime, ntimerange, nlevel, nnetwork, &
8870 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
8871 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
8872 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
8873 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
8874 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
8875 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
8876 this%time_definition
8877
8878
8879!write(unit=lunit)this
8880
8881
8882!! prime 5 dimensioni
8885if (associated(this%level)) write(unit=lunit)this%level
8886if (associated(this%timerange)) write(unit=lunit)this%timerange
8887if (associated(this%network)) write(unit=lunit)this%network
8888
8889 !! 6a dimensione: variabile dell'anagrafica e dei dati
8890 !! con relativi attributi e in 5 tipi diversi
8891
8892if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r
8893if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i
8894if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b
8895if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d
8896if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c
8897
8898if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r
8899if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i
8900if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b
8901if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d
8902if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c
8903
8904if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r
8905if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i
8906if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b
8907if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d
8908if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c
8909
8910if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r
8911if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i
8912if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b
8913if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d
8914if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c
8915
8916if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r
8917if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i
8918if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b
8919if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d
8920if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c
8921
8922if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
8923if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
8924if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
8925if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
8926if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c
8927
8928!! Volumi di valori e attributi per anagrafica e dati
8929
8930if (associated(this%volanar)) write(unit=lunit)this%volanar
8931if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr
8932if (associated(this%voldatir)) write(unit=lunit)this%voldatir
8933if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr
8934
8935if (associated(this%volanai)) write(unit=lunit)this%volanai
8936if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri
8937if (associated(this%voldatii)) write(unit=lunit)this%voldatii
8938if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri
8939
8940if (associated(this%volanab)) write(unit=lunit)this%volanab
8941if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb
8942if (associated(this%voldatib)) write(unit=lunit)this%voldatib
8943if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb
8944
8945if (associated(this%volanad)) write(unit=lunit)this%volanad
8946if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd
8947if (associated(this%voldatid)) write(unit=lunit)this%voldatid
8948if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd
8949
8950if (associated(this%volanac)) write(unit=lunit)this%volanac
8951if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc
8952if (associated(this%voldatic)) write(unit=lunit)this%voldatic
8953if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc
8954
8955if (.not. present(unit)) close(unit=lunit)
8956
8957end subroutine vol7d_write_on_file
8958
8959
8966
8967
8968subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
8969
8970TYPE(vol7d),INTENT(OUT) :: this
8971integer,intent(inout),optional :: unit
8972character(len=*),INTENT(in),optional :: filename
8973character(len=*),intent(out),optional :: filename_auto
8974character(len=*),INTENT(out),optional :: description
8975integer,intent(out),optional :: tarray(8)
8976
8977
8978integer :: 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
8986character(len=254) :: ldescription,lfilename,arg
8987integer :: ltarray(8),lunit,ios
8988logical :: opened,exist
8989
8990
8991call getarg(0,arg)
8992
8993if (.not. present(unit))then
8994 lunit=getunit()
8995else
8996 if (unit==0)then
8997 lunit=getunit()
8998 unit=lunit
8999 else
9000 lunit=unit
9001 end if
9002end if
9003
9004lfilename=trim(arg)//".v7d"
9006
9007if (present(filename))then
9008 if (filename /= "")then
9009 lfilename=filename
9010 end if
9011end if
9012
9013if (present(filename_auto))filename_auto=lfilename
9014
9015
9016inquire(unit=lunit,opened=opened)
9017IF (.NOT. opened) THEN
9018 inquire(file=lfilename,exist=exist)
9019 IF (.NOT.exist) THEN
9020 CALL l4f_log(l4f_fatal, &
9021 'in vol7d_read_from_file, file does not exists, cannot open')
9022 CALL raise_fatal_error()
9023 ENDIF
9024 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM', &
9025 status='OLD', action='READ')
9026 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
9027end if
9028
9029
9031read(unit=lunit,iostat=ios)ldescription
9032
9033if (ios < 0) then ! A negative value indicates that the End of File or End of Record
9034 call vol7d_alloc (this)
9035 call vol7d_alloc_vol (this)
9036 if (present(description))description=ldescription
9037 if (present(tarray))tarray=ltarray
9038 if (.not. present(unit)) close(unit=lunit)
9039end if
9040
9041read(unit=lunit)ltarray
9042
9043CALL l4f_log(l4f_info, 'Reading vol7d from file')
9044CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
9047
9048if (present(description))description=ldescription
9049if (present(tarray))tarray=ltarray
9050
9051read(unit=lunit)&
9052 nana, ntime, ntimerange, nlevel, nnetwork, &
9053 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
9054 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
9055 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
9056 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
9057 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
9058 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
9059 this%time_definition
9060
9061call vol7d_alloc (this, &
9062 nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,&
9063 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,&
9064 ndativard=ndativard, ndativarc=ndativarc,&
9065 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,&
9066 ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
9067 ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, &
9068 ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,&
9069 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, &
9070 nanavard=nanavard, nanavarc=nanavarc,&
9071 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,&
9072 nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
9073 nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, &
9074 nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc)
9075
9076
9079if (associated(this%level)) read(unit=lunit)this%level
9080if (associated(this%timerange)) read(unit=lunit)this%timerange
9081if (associated(this%network)) read(unit=lunit)this%network
9082
9083if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r
9084if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i
9085if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b
9086if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d
9087if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c
9088
9089if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r
9090if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i
9091if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b
9092if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d
9093if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c
9094
9095if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r
9096if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i
9097if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b
9098if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d
9099if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c
9100
9101if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r
9102if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i
9103if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b
9104if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d
9105if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c
9106
9107if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r
9108if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i
9109if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b
9110if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d
9111if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c
9112
9113if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
9114if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
9115if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
9116if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
9117if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c
9118
9119call vol7d_alloc_vol (this)
9120
9121!! Volumi di valori e attributi per anagrafica e dati
9122
9123if (associated(this%volanar)) read(unit=lunit)this%volanar
9124if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr
9125if (associated(this%voldatir)) read(unit=lunit)this%voldatir
9126if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr
9127
9128if (associated(this%volanai)) read(unit=lunit)this%volanai
9129if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri
9130if (associated(this%voldatii)) read(unit=lunit)this%voldatii
9131if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri
9132
9133if (associated(this%volanab)) read(unit=lunit)this%volanab
9134if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb
9135if (associated(this%voldatib)) read(unit=lunit)this%voldatib
9136if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb
9137
9138if (associated(this%volanad)) read(unit=lunit)this%volanad
9139if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd
9140if (associated(this%voldatid)) read(unit=lunit)this%voldatid
9141if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd
9142
9143if (associated(this%volanac)) read(unit=lunit)this%volanac
9144if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc
9145if (associated(this%voldatic)) read(unit=lunit)this%voldatic
9146if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc
9147
9148if (.not. present(unit)) close(unit=lunit)
9149
9150end subroutine vol7d_read_from_file
9151
9152
9153! to double precision
9154elemental doubleprecision function doubledatd(voldat,var)
9155doubleprecision,intent(in) :: voldat
9156type(vol7d_var),intent(in) :: var
9157
9158doubledatd=voldat
9159
9160end function doubledatd
9161
9162
9163elemental doubleprecision function doubledatr(voldat,var)
9164real,intent(in) :: voldat
9165type(vol7d_var),intent(in) :: var
9166
9168 doubledatr=dble(voldat)
9169else
9170 doubledatr=dmiss
9171end if
9172
9173end function doubledatr
9174
9175
9176elemental doubleprecision function doubledati(voldat,var)
9177integer,intent(in) :: voldat
9178type(vol7d_var),intent(in) :: var
9179
9182 doubledati=dble(voldat)/10.d0**var%scalefactor
9183 else
9184 doubledati=dble(voldat)
9185 endif
9186else
9187 doubledati=dmiss
9188end if
9189
9190end function doubledati
9191
9192
9193elemental doubleprecision function doubledatb(voldat,var)
9194integer(kind=int_b),intent(in) :: voldat
9195type(vol7d_var),intent(in) :: var
9196
9199 doubledatb=dble(voldat)/10.d0**var%scalefactor
9200 else
9201 doubledatb=dble(voldat)
9202 endif
9203else
9204 doubledatb=dmiss
9205end if
9206
9207end function doubledatb
9208
9209
9210elemental doubleprecision function doubledatc(voldat,var)
9211CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
9212type(vol7d_var),intent(in) :: var
9213
9214doubledatc = c2d(voldat)
9216 doubledatc=doubledatc/10.d0**var%scalefactor
9217end if
9218
9219end function doubledatc
9220
9221
9222! to integer
9223elemental integer function integerdatd(voldat,var)
9224doubleprecision,intent(in) :: voldat
9225type(vol7d_var),intent(in) :: var
9226
9229 integerdatd=nint(voldat*10d0**var%scalefactor)
9230 else
9231 integerdatd=nint(voldat)
9232 endif
9233else
9234 integerdatd=imiss
9235end if
9236
9237end function integerdatd
9238
9239
9240elemental integer function integerdatr(voldat,var)
9241real,intent(in) :: voldat
9242type(vol7d_var),intent(in) :: var
9243
9246 integerdatr=nint(voldat*10d0**var%scalefactor)
9247 else
9248 integerdatr=nint(voldat)
9249 endif
9250else
9251 integerdatr=imiss
9252end if
9253
9254end function integerdatr
9255
9256
9257elemental integer function integerdati(voldat,var)
9258integer,intent(in) :: voldat
9259type(vol7d_var),intent(in) :: var
9260
9261integerdati=voldat
9262
9263end function integerdati
9264
9265
9266elemental integer function integerdatb(voldat,var)
9267integer(kind=int_b),intent(in) :: voldat
9268type(vol7d_var),intent(in) :: var
9269
9271 integerdatb=voldat
9272else
9273 integerdatb=imiss
9274end if
9275
9276end function integerdatb
9277
9278
9279elemental integer function integerdatc(voldat,var)
9280CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
9281type(vol7d_var),intent(in) :: var
9282
9283integerdatc=c2i(voldat)
9284
9285end function integerdatc
9286
9287
9288! to real
9289elemental real function realdatd(voldat,var)
9290doubleprecision,intent(in) :: voldat
9291type(vol7d_var),intent(in) :: var
9292
9294 realdatd=real(voldat)
9295else
9296 realdatd=rmiss
9297end if
9298
9299end function realdatd
9300
9301
9302elemental real function realdatr(voldat,var)
9303real,intent(in) :: voldat
9304type(vol7d_var),intent(in) :: var
9305
9306realdatr=voldat
9307
9308end function realdatr
9309
9310
9311elemental real function realdati(voldat,var)
9312integer,intent(in) :: voldat
9313type(vol7d_var),intent(in) :: var
9314
9317 realdati=float(voldat)/10.**var%scalefactor
9318 else
9319 realdati=float(voldat)
9320 endif
9321else
9322 realdati=rmiss
9323end if
9324
9325end function realdati
9326
9327
9328elemental real function realdatb(voldat,var)
9329integer(kind=int_b),intent(in) :: voldat
9330type(vol7d_var),intent(in) :: var
9331
9334 realdatb=float(voldat)/10**var%scalefactor
9335 else
9336 realdatb=float(voldat)
9337 endif
9338else
9339 realdatb=rmiss
9340end if
9341
9342end function realdatb
9343
9344
9345elemental real function realdatc(voldat,var)
9346CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
9347type(vol7d_var),intent(in) :: var
9348
9349realdatc=c2r(voldat)
9351 realdatc=realdatc/10.**var%scalefactor
9352end if
9353
9354end function realdatc
9355
9356
9362FUNCTION realanavol(this, var) RESULT(vol)
9363TYPE(vol7d),INTENT(in) :: this
9364TYPE(vol7d_var),INTENT(in) :: var
9365REAL :: vol(SIZE(this%ana),size(this%network))
9366
9367CHARACTER(len=1) :: dtype
9368INTEGER :: indvar
9369
9370dtype = cmiss
9371indvar = index(this%anavar, var, type=dtype)
9372
9373IF (indvar > 0) THEN
9374 SELECT CASE (dtype)
9375 CASE("d")
9376 vol = realdat(this%volanad(:,indvar,:), var)
9377 CASE("r")
9378 vol = this%volanar(:,indvar,:)
9379 CASE("i")
9380 vol = realdat(this%volanai(:,indvar,:), var)
9381 CASE("b")
9382 vol = realdat(this%volanab(:,indvar,:), var)
9383 CASE("c")
9384 vol = realdat(this%volanac(:,indvar,:), var)
9385 CASE default
9386 vol = rmiss
9387 END SELECT
9388ELSE
9389 vol = rmiss
9390ENDIF
9391
9392END FUNCTION realanavol
9393
9394
9400FUNCTION integeranavol(this, var) RESULT(vol)
9401TYPE(vol7d),INTENT(in) :: this
9402TYPE(vol7d_var),INTENT(in) :: var
9403INTEGER :: vol(SIZE(this%ana),size(this%network))
9404
9405CHARACTER(len=1) :: dtype
9406INTEGER :: indvar
9407
9408dtype = cmiss
9409indvar = index(this%anavar, var, type=dtype)
9410
9411IF (indvar > 0) THEN
9412 SELECT CASE (dtype)
9413 CASE("d")
9414 vol = integerdat(this%volanad(:,indvar,:), var)
9415 CASE("r")
9416 vol = integerdat(this%volanar(:,indvar,:), var)
9417 CASE("i")
9418 vol = this%volanai(:,indvar,:)
9419 CASE("b")
9420 vol = integerdat(this%volanab(:,indvar,:), var)
9421 CASE("c")
9422 vol = integerdat(this%volanac(:,indvar,:), var)
9423 CASE default
9424 vol = imiss
9425 END SELECT
9426ELSE
9427 vol = imiss
9428ENDIF
9429
9430END FUNCTION integeranavol
9431
9432
9438subroutine move_datac (v7d,&
9439 indana,indtime,indlevel,indtimerange,indnetwork,&
9440 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
9441
9442TYPE(vol7d),intent(inout) :: v7d
9443
9444integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
9445integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
9446integer :: inddativar,inddativarattr
9447
9448
9449do inddativar=1,size(v7d%dativar%c)
9450
9452 .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
9453 ) then
9454
9455 ! dati
9456 v7d%voldatic &
9457 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
9458 v7d%voldatic &
9459 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
9460
9461
9462 ! attributi
9463 if (associated (v7d%dativarattr%i)) then
9464 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
9465 if (inddativarattr > 0 ) then
9466 v7d%voldatiattri &
9467 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9468 v7d%voldatiattri &
9469 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9470 end if
9471 end if
9472
9473 if (associated (v7d%dativarattr%r)) then
9474 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
9475 if (inddativarattr > 0 ) then
9476 v7d%voldatiattrr &
9477 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9478 v7d%voldatiattrr &
9479 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9480 end if
9481 end if
9482
9483 if (associated (v7d%dativarattr%d)) then
9484 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
9485 if (inddativarattr > 0 ) then
9486 v7d%voldatiattrd &
9487 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9488 v7d%voldatiattrd &
9489 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9490 end if
9491 end if
9492
9493 if (associated (v7d%dativarattr%b)) then
9494 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
9495 if (inddativarattr > 0 ) then
9496 v7d%voldatiattrb &
9497 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9498 v7d%voldatiattrb &
9499 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9500 end if
9501 end if
9502
9503 if (associated (v7d%dativarattr%c)) then
9504 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
9505 if (inddativarattr > 0 ) then
9506 v7d%voldatiattrc &
9507 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9508 v7d%voldatiattrc &
9509 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9510 end if
9511 end if
9512
9513 end if
9514
9515end do
9516
9517end subroutine move_datac
9518
9524subroutine move_datar (v7d,&
9525 indana,indtime,indlevel,indtimerange,indnetwork,&
9526 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
9527
9528TYPE(vol7d),intent(inout) :: v7d
9529
9530integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
9531integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
9532integer :: inddativar,inddativarattr
9533
9534
9535do inddativar=1,size(v7d%dativar%r)
9536
9538 .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
9539 ) then
9540
9541 ! dati
9542 v7d%voldatir &
9543 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
9544 v7d%voldatir &
9545 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
9546
9547
9548 ! attributi
9549 if (associated (v7d%dativarattr%i)) then
9550 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
9551 if (inddativarattr > 0 ) then
9552 v7d%voldatiattri &
9553 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9554 v7d%voldatiattri &
9555 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9556 end if
9557 end if
9558
9559 if (associated (v7d%dativarattr%r)) then
9560 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%r(inddativar))
9561 if (inddativarattr > 0 ) then
9562 v7d%voldatiattrr &
9563 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9564 v7d%voldatiattrr &
9565 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9566 end if
9567 end if
9568
9569 if (associated (v7d%dativarattr%d)) then
9570 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%r(inddativar))
9571 if (inddativarattr > 0 ) then
9572 v7d%voldatiattrd &
9573 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9574 v7d%voldatiattrd &
9575 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9576 end if
9577 end if
9578
9579 if (associated (v7d%dativarattr%b)) then
9580 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%r(inddativar))
9581 if (inddativarattr > 0 ) then
9582 v7d%voldatiattrb &
9583 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9584 v7d%voldatiattrb &
9585 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9586 end if
9587 end if
9588
9589 if (associated (v7d%dativarattr%c)) then
9590 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%r(inddativar))
9591 if (inddativarattr > 0 ) then
9592 v7d%voldatiattrc &
9593 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
9594 v7d%voldatiattrc &
9595 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
9596 end if
9597 end if
9598
9599 end if
9600
9601end do
9602
9603end subroutine move_datar
9604
9605
9619subroutine v7d_rounding(v7din,v7dout,level,timerange,nostatproc)
9620type(vol7d),intent(inout) :: v7din
9621type(vol7d),intent(out) :: v7dout
9622type(vol7d_level),intent(in),optional :: level(:)
9623type(vol7d_timerange),intent(in),optional :: timerange(:)
9624!logical,intent(in),optional :: merge !< if there are data on more then one almost equal levels or timeranges
9625!! will be merged POINT BY POINT with priority for the fird data found ordered by icreasing var index
9626logical,intent(in),optional :: nostatproc
9627
9628integer :: nana,nlevel,ntime,ntimerange,nnetwork,nbin
9629integer :: iana,ilevel,itimerange,indl,indt,itime,inetwork
9630type(vol7d_level) :: roundlevel(size(v7din%level))
9631type(vol7d_timerange) :: roundtimerange(size(v7din%timerange))
9632type(vol7d) :: v7d_tmp
9633
9634
9635nbin=0
9636
9637if (associated(v7din%dativar%r)) nbin = nbin + size(v7din%dativar%r)
9638if (associated(v7din%dativar%i)) nbin = nbin + size(v7din%dativar%i)
9639if (associated(v7din%dativar%d)) nbin = nbin + size(v7din%dativar%d)
9640if (associated(v7din%dativar%b)) nbin = nbin + size(v7din%dativar%b)
9641
9643
9644roundlevel=v7din%level
9645
9646if (present(level))then
9647 do ilevel = 1, size(v7din%level)
9648 if ((any(v7din%level(ilevel) .almosteq. level))) then
9649 roundlevel(ilevel)=level(1)
9650 end if
9651 end do
9652end if
9653
9654roundtimerange=v7din%timerange
9655
9656if (present(timerange))then
9657 do itimerange = 1, size(v7din%timerange)
9658 if ((any(v7din%timerange(itimerange) .almosteq. timerange))) then
9659 roundtimerange(itimerange)=timerange(1)
9660 end if
9661 end do
9662end if
9663
9664!set istantaneous values everywere
9665!preserve p1 for forecast time
9666if (optio_log(nostatproc)) then
9667 roundtimerange(:)%timerange=254
9668 roundtimerange(:)%p2=0
9669end if
9670
9671
9672nana=size(v7din%ana)
9673nlevel=count_distinct(roundlevel,back=.true.)
9674ntime=size(v7din%time)
9675ntimerange=count_distinct(roundtimerange,back=.true.)
9676nnetwork=size(v7din%network)
9677
9679
9680if (nbin == 0) then
9682else
9683 call vol7d_convr(v7din,v7d_tmp)
9684end if
9685
9686v7d_tmp%level=roundlevel
9687v7d_tmp%timerange=roundtimerange
9688
9689do ilevel=1, size(v7d_tmp%level)
9690 indl=index(v7d_tmp%level,roundlevel(ilevel))
9691 do itimerange=1,size(v7d_tmp%timerange)
9692 indt=index(v7d_tmp%timerange,roundtimerange(itimerange))
9693
9694 if (indl /= ilevel .or. indt /= itimerange) then
9695
9696 do iana=1, nana
9697 do itime=1,ntime
9698 do inetwork=1,nnetwork
9699
9700 if (nbin > 0) then
9701 call move_datar (v7d_tmp,&
9702 iana,itime,ilevel,itimerange,inetwork,&
9703 iana,itime,indl,indt,inetwork)
9704 else
9705 call move_datac (v7d_tmp,&
9706 iana,itime,ilevel,itimerange,inetwork,&
9707 iana,itime,indl,indt,inetwork)
9708 end if
9709
9710 end do
9711 end do
9712 end do
9713
9714 end if
9715
9716 end do
9717end do
9718
9719! set to missing level and time > nlevel
9720do ilevel=nlevel+1,size(v7d_tmp%level)
9722end do
9723
9724do itimerange=ntimerange+1,size(v7d_tmp%timerange)
9726end do
9727
9728!copy with remove
9731
9732!call display(v7dout)
9733
9734end subroutine v7d_rounding
9735
9736
9738
9744
9745
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 |