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