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