libsim Versione 7.1.11
|
◆ vol7d_write_on_file()
Scrittura su file di un volume Vol7d. Scrittura su file unformatted di un intero volume Vol7d. Il volume viene serializzato e scritto su file. Il file puo' essere aperto opzionalmente dall'utente. Si possono passare opzionalmente unità e nome del file altrimenti assegnati internamente a dei default; se assegnati internamente tali parametri saranno in output. Se non viene fornito il nome file viene utilizzato un file di default con nome pari al nome del programma in esecuzione con postfisso ".v7d". Come parametro opzionale c'è la description che insieme alla data corrente viene inserita nell'header del file.
Definizione alla linea 8474 del file vol7d_class.F90. 8475! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
8476! authors:
8477! Davide Cesari <dcesari@arpa.emr.it>
8478! Paolo Patruno <ppatruno@arpa.emr.it>
8479
8480! This program is free software; you can redistribute it and/or
8481! modify it under the terms of the GNU General Public License as
8482! published by the Free Software Foundation; either version 2 of
8483! the License, or (at your option) any later version.
8484
8485! This program is distributed in the hope that it will be useful,
8486! but WITHOUT ANY WARRANTY; without even the implied warranty of
8487! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
8488! GNU General Public License for more details.
8489
8490! You should have received a copy of the GNU General Public License
8491! along with this program. If not, see <http://www.gnu.org/licenses/>.
8492#include "config.h"
8493
8505
8573IMPLICIT NONE
8574
8575
8576INTEGER, PARAMETER :: vol7d_maxdim_a = 3, vol7d_maxdim_aa = 4, &
8577 vol7d_maxdim_d = 6, vol7d_maxdim_ad = 7
8578
8579INTEGER, PARAMETER :: vol7d_ana_a=1
8580INTEGER, PARAMETER :: vol7d_var_a=2
8581INTEGER, PARAMETER :: vol7d_network_a=3
8582INTEGER, PARAMETER :: vol7d_attr_a=4
8583INTEGER, PARAMETER :: vol7d_ana_d=1
8584INTEGER, PARAMETER :: vol7d_time_d=2
8585INTEGER, PARAMETER :: vol7d_level_d=3
8586INTEGER, PARAMETER :: vol7d_timerange_d=4
8587INTEGER, PARAMETER :: vol7d_var_d=5
8588INTEGER, PARAMETER :: vol7d_network_d=6
8589INTEGER, PARAMETER :: vol7d_attr_d=7
8590INTEGER, PARAMETER :: vol7d_cdatalen=32
8591
8592TYPE vol7d_varmap
8593 INTEGER :: r, d, i, b, c
8594END TYPE vol7d_varmap
8595
8600 TYPE(vol7d_ana),POINTER :: ana(:)
8602 TYPE(datetime),POINTER :: time(:)
8604 TYPE(vol7d_level),POINTER :: level(:)
8606 TYPE(vol7d_timerange),POINTER :: timerange(:)
8608 TYPE(vol7d_network),POINTER :: network(:)
8610 TYPE(vol7d_varvect) :: anavar
8612 TYPE(vol7d_varvect) :: anaattr
8614 TYPE(vol7d_varvect) :: anavarattr
8616 TYPE(vol7d_varvect) :: dativar
8618 TYPE(vol7d_varvect) :: datiattr
8620 TYPE(vol7d_varvect) :: dativarattr
8621
8623 REAL,POINTER :: volanar(:,:,:)
8625 DOUBLE PRECISION,POINTER :: volanad(:,:,:)
8627 INTEGER,POINTER :: volanai(:,:,:)
8629 INTEGER(kind=int_b),POINTER :: volanab(:,:,:)
8631 CHARACTER(len=vol7d_cdatalen),POINTER :: volanac(:,:,:)
8632
8634 REAL,POINTER :: volanaattrr(:,:,:,:)
8636 DOUBLE PRECISION,POINTER :: volanaattrd(:,:,:,:)
8638 INTEGER,POINTER :: volanaattri(:,:,:,:)
8640 INTEGER(kind=int_b),POINTER :: volanaattrb(:,:,:,:)
8642 CHARACTER(len=vol7d_cdatalen),POINTER :: volanaattrc(:,:,:,:)
8643
8645 REAL,POINTER :: voldatir(:,:,:,:,:,:) ! sono i dati
8647 DOUBLE PRECISION,POINTER :: voldatid(:,:,:,:,:,:)
8649 INTEGER,POINTER :: voldatii(:,:,:,:,:,:)
8651 INTEGER(kind=int_b),POINTER :: voldatib(:,:,:,:,:,:)
8653 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatic(:,:,:,:,:,:)
8654
8656 REAL,POINTER :: voldatiattrr(:,:,:,:,:,:,:)
8658 DOUBLE PRECISION,POINTER :: voldatiattrd(:,:,:,:,:,:,:)
8660 INTEGER,POINTER :: voldatiattri(:,:,:,:,:,:,:)
8662 INTEGER(kind=int_b),POINTER :: voldatiattrb(:,:,:,:,:,:,:)
8664 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatiattrc(:,:,:,:,:,:,:)
8665
8667 integer :: time_definition
8668
8670
8675 MODULE PROCEDURE vol7d_init
8676END INTERFACE
8677
8680 MODULE PROCEDURE vol7d_delete
8681END INTERFACE
8682
8685 MODULE PROCEDURE vol7d_write_on_file
8686END INTERFACE
8687
8689INTERFACE import
8690 MODULE PROCEDURE vol7d_read_from_file
8691END INTERFACE
8692
8695 MODULE PROCEDURE vol7d_display, dat_display, dat_vect_display
8696END INTERFACE
8697
8700 MODULE PROCEDURE to_char_dat
8701END INTERFACE
8702
8705 MODULE PROCEDURE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
8706END INTERFACE
8707
8710 MODULE PROCEDURE realdatd,realdatr,realdati,realdatb,realdatc
8711END INTERFACE
8712
8715 MODULE PROCEDURE integerdatd,integerdatr,integerdati,integerdatb,integerdatc
8716END INTERFACE
8717
8720 MODULE PROCEDURE vol7d_copy
8721END INTERFACE
8722
8725 MODULE PROCEDURE vol7d_c_e
8726END INTERFACE
8727
8732 MODULE PROCEDURE vol7d_check
8733END INTERFACE
8734
8749 MODULE PROCEDURE v7d_rounding
8750END INTERFACE
8751
8752!!$INTERFACE get_volana
8753!!$ MODULE PROCEDURE vol7d_get_volanar, vol7d_get_volanad, vol7d_get_volanai, &
8754!!$ vol7d_get_volanab, vol7d_get_volanac
8755!!$END INTERFACE
8756!!$
8757!!$INTERFACE get_voldati
8758!!$ MODULE PROCEDURE vol7d_get_voldatir, vol7d_get_voldatid, vol7d_get_voldatii, &
8759!!$ vol7d_get_voldatib, vol7d_get_voldatic
8760!!$END INTERFACE
8761!!$
8762!!$INTERFACE get_volanaattr
8763!!$ MODULE PROCEDURE vol7d_get_volanaattrr, vol7d_get_volanaattrd, &
8764!!$ vol7d_get_volanaattri, vol7d_get_volanaattrb, vol7d_get_volanaattrc
8765!!$END INTERFACE
8766!!$
8767!!$INTERFACE get_voldatiattr
8768!!$ MODULE PROCEDURE vol7d_get_voldatiattrr, vol7d_get_voldatiattrd, &
8769!!$ vol7d_get_voldatiattri, vol7d_get_voldatiattrb, vol7d_get_voldatiattrc
8770!!$END INTERFACE
8771
8772PRIVATE vol7d_get_volr, vol7d_get_vold, vol7d_get_voli, vol7d_get_volb, &
8773 vol7d_get_volc, &
8774 volptr1dr, volptr2dr, volptr3dr, volptr4dr, volptr5dr, volptr6dr, volptr7dr, &
8775 volptr1dd, volptr2dd, volptr3dd, volptr4dd, volptr5dd, volptr6dd, volptr7dd, &
8776 volptr1di, volptr2di, volptr3di, volptr4di, volptr5di, volptr6di, volptr7di, &
8777 volptr1db, volptr2db, volptr3db, volptr4db, volptr5db, volptr6db, volptr7db, &
8778 volptr1dc, volptr2dc, volptr3dc, volptr4dc, volptr5dc, volptr6dc, volptr7dc, &
8779 vol7d_nullifyr, vol7d_nullifyd, vol7d_nullifyi, vol7d_nullifyb, vol7d_nullifyc, &
8780 vol7d_init, vol7d_delete, vol7d_write_on_file, vol7d_read_from_file, &
8781 vol7d_check_alloc_ana, vol7d_force_alloc_ana, &
8782 vol7d_check_alloc_dati, vol7d_force_alloc_dati, vol7d_force_alloc, &
8783 vol7d_display, dat_display, dat_vect_display, &
8784 to_char_dat, vol7d_check
8785
8786PRIVATE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
8787
8788PRIVATE vol7d_c_e
8789
8790CONTAINS
8791
8792
8797SUBROUTINE vol7d_init(this,time_definition)
8798TYPE(vol7d),intent(out) :: this
8799integer,INTENT(IN),OPTIONAL :: time_definition
8800
8807CALL vol7d_var_features_init() ! initialise var features table once
8808
8809NULLIFY(this%ana, this%time, this%level, this%timerange, this%network)
8810
8811NULLIFY(this%volanar, this%volanaattrr, this%voldatir, this%voldatiattrr)
8812NULLIFY(this%volanad, this%volanaattrd, this%voldatid, this%voldatiattrd)
8813NULLIFY(this%volanai, this%volanaattri, this%voldatii, this%voldatiattri)
8814NULLIFY(this%volanab, this%volanaattrb, this%voldatib, this%voldatiattrb)
8815NULLIFY(this%volanac, this%volanaattrc, this%voldatic, this%voldatiattrc)
8816
8817if(present(time_definition)) then
8818 this%time_definition=time_definition
8819else
8820 this%time_definition=1 !default to validity time
8821end if
8822
8823END SUBROUTINE vol7d_init
8824
8825
8829ELEMENTAL SUBROUTINE vol7d_delete(this, dataonly)
8830TYPE(vol7d),intent(inout) :: this
8831LOGICAL, INTENT(in), OPTIONAL :: dataonly
8832
8833
8834IF (.NOT. optio_log(dataonly)) THEN
8835 IF (ASSOCIATED(this%volanar)) DEALLOCATE(this%volanar)
8836 IF (ASSOCIATED(this%volanad)) DEALLOCATE(this%volanad)
8837 IF (ASSOCIATED(this%volanai)) DEALLOCATE(this%volanai)
8838 IF (ASSOCIATED(this%volanab)) DEALLOCATE(this%volanab)
8839 IF (ASSOCIATED(this%volanac)) DEALLOCATE(this%volanac)
8840 IF (ASSOCIATED(this%volanaattrr)) DEALLOCATE(this%volanaattrr)
8841 IF (ASSOCIATED(this%volanaattrd)) DEALLOCATE(this%volanaattrd)
8842 IF (ASSOCIATED(this%volanaattri)) DEALLOCATE(this%volanaattri)
8843 IF (ASSOCIATED(this%volanaattrb)) DEALLOCATE(this%volanaattrb)
8844 IF (ASSOCIATED(this%volanaattrc)) DEALLOCATE(this%volanaattrc)
8845ENDIF
8846IF (ASSOCIATED(this%voldatir)) DEALLOCATE(this%voldatir)
8847IF (ASSOCIATED(this%voldatid)) DEALLOCATE(this%voldatid)
8848IF (ASSOCIATED(this%voldatii)) DEALLOCATE(this%voldatii)
8849IF (ASSOCIATED(this%voldatib)) DEALLOCATE(this%voldatib)
8850IF (ASSOCIATED(this%voldatic)) DEALLOCATE(this%voldatic)
8851IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
8852IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
8853IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
8854IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
8855IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
8856
8857IF (.NOT. optio_log(dataonly)) THEN
8858 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
8859 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
8860ENDIF
8861IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
8862IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
8863IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
8864
8865IF (.NOT. optio_log(dataonly)) THEN
8869ENDIF
8873
8874END SUBROUTINE vol7d_delete
8875
8876
8877
8878integer function vol7d_check(this)
8879TYPE(vol7d),intent(in) :: this
8880integer :: i,j,k,l,m,n
8881
8882vol7d_check=0
8883
8884if (associated(this%voldatii)) then
8885do i = 1,size(this%voldatii,1)
8886 do j = 1,size(this%voldatii,2)
8887 do k = 1,size(this%voldatii,3)
8888 do l = 1,size(this%voldatii,4)
8889 do m = 1,size(this%voldatii,5)
8890 do n = 1,size(this%voldatii,6)
8891 if (this%voldatii(i,j,k,l,m,n) /= this%voldatii(i,j,k,l,m,n) ) then
8892 CALL l4f_log(l4f_warn,"check: abnormal value at voldatii("&
8894 vol7d_check=1
8895 end if
8896 end do
8897 end do
8898 end do
8899 end do
8900 end do
8901end do
8902end if
8903
8904
8905if (associated(this%voldatir)) then
8906do i = 1,size(this%voldatir,1)
8907 do j = 1,size(this%voldatir,2)
8908 do k = 1,size(this%voldatir,3)
8909 do l = 1,size(this%voldatir,4)
8910 do m = 1,size(this%voldatir,5)
8911 do n = 1,size(this%voldatir,6)
8912 if (this%voldatir(i,j,k,l,m,n) /= this%voldatir(i,j,k,l,m,n) ) then
8913 CALL l4f_log(l4f_warn,"check: abnormal value at voldatir("&
8915 vol7d_check=2
8916 end if
8917 end do
8918 end do
8919 end do
8920 end do
8921 end do
8922end do
8923end if
8924
8925if (associated(this%voldatid)) then
8926do i = 1,size(this%voldatid,1)
8927 do j = 1,size(this%voldatid,2)
8928 do k = 1,size(this%voldatid,3)
8929 do l = 1,size(this%voldatid,4)
8930 do m = 1,size(this%voldatid,5)
8931 do n = 1,size(this%voldatid,6)
8932 if (this%voldatid(i,j,k,l,m,n) /= this%voldatid(i,j,k,l,m,n) ) then
8933 CALL l4f_log(l4f_warn,"check: abnormal value at voldatid("&
8935 vol7d_check=3
8936 end if
8937 end do
8938 end do
8939 end do
8940 end do
8941 end do
8942end do
8943end if
8944
8945if (associated(this%voldatib)) then
8946do i = 1,size(this%voldatib,1)
8947 do j = 1,size(this%voldatib,2)
8948 do k = 1,size(this%voldatib,3)
8949 do l = 1,size(this%voldatib,4)
8950 do m = 1,size(this%voldatib,5)
8951 do n = 1,size(this%voldatib,6)
8952 if (this%voldatib(i,j,k,l,m,n) /= this%voldatib(i,j,k,l,m,n) ) then
8953 CALL l4f_log(l4f_warn,"check: abnormal value at voldatib("&
8955 vol7d_check=4
8956 end if
8957 end do
8958 end do
8959 end do
8960 end do
8961 end do
8962end do
8963end if
8964
8965end function vol7d_check
8966
8967
8968
8969!TODO da completare ! aborta se i volumi sono allocati a dimensione 0
8971SUBROUTINE vol7d_display(this)
8972TYPE(vol7d),intent(in) :: this
8973integer :: i
8974
8975REAL :: rdat
8976DOUBLE PRECISION :: ddat
8977INTEGER :: idat
8978INTEGER(kind=int_b) :: bdat
8979CHARACTER(len=vol7d_cdatalen) :: cdat
8980
8981
8982print*,"<<<<<<<<<<<<<<<<<<< vol7d object >>>>>>>>>>>>>>>>>>>>"
8983if (this%time_definition == 0) then
8984 print*,"TIME DEFINITION: time is reference time"
8985else if (this%time_definition == 1) then
8986 print*,"TIME DEFINITION: time is validity time"
8987else
8988 print*,"Time definition have a wrong walue:", this%time_definition
8989end if
8990
8991IF (ASSOCIATED(this%network))then
8992 print*,"---- network vector ----"
8993 print*,"elements=",size(this%network)
8994 do i=1, size(this%network)
8996 end do
8997end IF
8998
8999IF (ASSOCIATED(this%ana))then
9000 print*,"---- ana vector ----"
9001 print*,"elements=",size(this%ana)
9002 do i=1, size(this%ana)
9004 end do
9005end IF
9006
9007IF (ASSOCIATED(this%time))then
9008 print*,"---- time vector ----"
9009 print*,"elements=",size(this%time)
9010 do i=1, size(this%time)
9012 end do
9013end if
9014
9015IF (ASSOCIATED(this%level)) then
9016 print*,"---- level vector ----"
9017 print*,"elements=",size(this%level)
9018 do i =1,size(this%level)
9020 end do
9021end if
9022
9023IF (ASSOCIATED(this%timerange))then
9024 print*,"---- timerange vector ----"
9025 print*,"elements=",size(this%timerange)
9026 do i =1,size(this%timerange)
9028 end do
9029end if
9030
9031
9032print*,"---- ana vector ----"
9033print*,""
9034print*,"->>>>>>>>> anavar -"
9036print*,""
9037print*,"->>>>>>>>> anaattr -"
9039print*,""
9040print*,"->>>>>>>>> anavarattr -"
9042
9043print*,"-- ana data section (first point) --"
9044
9045idat=imiss
9046rdat=rmiss
9047ddat=dmiss
9048bdat=ibmiss
9049cdat=cmiss
9050
9051!ntime = MIN(SIZE(this%time),nprint)
9052!ntimerange = MIN(SIZE(this%timerange),nprint)
9053!nlevel = MIN(SIZE(this%level),nprint)
9054!nnetwork = MIN(SIZE(this%network),nprint)
9055!nana = MIN(SIZE(this%ana),nprint)
9056
9057IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0) THEN
9058if (associated(this%volanai)) then
9059 do i=1,size(this%anavar%i)
9060 idat=this%volanai(1,i,1)
9062 end do
9063end if
9064idat=imiss
9065
9066if (associated(this%volanar)) then
9067 do i=1,size(this%anavar%r)
9068 rdat=this%volanar(1,i,1)
9070 end do
9071end if
9072rdat=rmiss
9073
9074if (associated(this%volanad)) then
9075 do i=1,size(this%anavar%d)
9076 ddat=this%volanad(1,i,1)
9078 end do
9079end if
9080ddat=dmiss
9081
9082if (associated(this%volanab)) then
9083 do i=1,size(this%anavar%b)
9084 bdat=this%volanab(1,i,1)
9086 end do
9087end if
9088bdat=ibmiss
9089
9090if (associated(this%volanac)) then
9091 do i=1,size(this%anavar%c)
9092 cdat=this%volanac(1,i,1)
9094 end do
9095end if
9096cdat=cmiss
9097ENDIF
9098
9099print*,"---- data vector ----"
9100print*,""
9101print*,"->>>>>>>>> dativar -"
9103print*,""
9104print*,"->>>>>>>>> datiattr -"
9106print*,""
9107print*,"->>>>>>>>> dativarattr -"
9109
9110print*,"-- data data section (first point) --"
9111
9112idat=imiss
9113rdat=rmiss
9114ddat=dmiss
9115bdat=ibmiss
9116cdat=cmiss
9117
9118IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0 .AND. size(this%time) > 0 &
9119 .AND. size(this%level) > 0 .AND. size(this%timerange) > 0) THEN
9120if (associated(this%voldatii)) then
9121 do i=1,size(this%dativar%i)
9122 idat=this%voldatii(1,1,1,1,i,1)
9124 end do
9125end if
9126idat=imiss
9127
9128if (associated(this%voldatir)) then
9129 do i=1,size(this%dativar%r)
9130 rdat=this%voldatir(1,1,1,1,i,1)
9132 end do
9133end if
9134rdat=rmiss
9135
9136if (associated(this%voldatid)) then
9137 do i=1,size(this%dativar%d)
9138 ddat=this%voldatid(1,1,1,1,i,1)
9140 end do
9141end if
9142ddat=dmiss
9143
9144if (associated(this%voldatib)) then
9145 do i=1,size(this%dativar%b)
9146 bdat=this%voldatib(1,1,1,1,i,1)
9148 end do
9149end if
9150bdat=ibmiss
9151
9152if (associated(this%voldatic)) then
9153 do i=1,size(this%dativar%c)
9154 cdat=this%voldatic(1,1,1,1,i,1)
9156 end do
9157end if
9158cdat=cmiss
9159ENDIF
9160
9161print*,"<<<<<<<<<<<<<<<<<<< END vol7d object >>>>>>>>>>>>>>>>>>>>"
9162
9163END SUBROUTINE vol7d_display
9164
9165
9167SUBROUTINE dat_display(this,idat,rdat,ddat,bdat,cdat)
9168TYPE(vol7d_var),intent(in) :: this
9170REAL :: rdat
9172DOUBLE PRECISION :: ddat
9174INTEGER :: idat
9176INTEGER(kind=int_b) :: bdat
9178CHARACTER(len=*) :: cdat
9179
9180print *, to_char_dat(this,idat,rdat,ddat,bdat,cdat)
9181
9182end SUBROUTINE dat_display
9183
9185SUBROUTINE dat_vect_display(this,idat,rdat,ddat,bdat,cdat)
9186
9187TYPE(vol7d_var),intent(in) :: this(:)
9189REAL :: rdat(:)
9191DOUBLE PRECISION :: ddat(:)
9193INTEGER :: idat(:)
9195INTEGER(kind=int_b) :: bdat(:)
9197CHARACTER(len=*):: cdat(:)
9198
9199integer :: i
9200
9201do i =1,size(this)
9203end do
9204
9205end SUBROUTINE dat_vect_display
9206
9207
9208FUNCTION to_char_dat(this,idat,rdat,ddat,bdat,cdat)
9209#ifdef HAVE_DBALLE
9210USE dballef
9211#endif
9212TYPE(vol7d_var),INTENT(in) :: this
9214REAL :: rdat
9216DOUBLE PRECISION :: ddat
9218INTEGER :: idat
9220INTEGER(kind=int_b) :: bdat
9222CHARACTER(len=*) :: cdat
9223CHARACTER(len=80) :: to_char_dat
9224
9225CHARACTER(len=LEN(to_char_dat)) :: to_char_tmp
9226
9227
9228#ifdef HAVE_DBALLE
9229INTEGER :: handle, ier
9230
9231handle = 0
9232to_char_dat="VALUE: "
9233
9238
9240 ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
9241 ier = idba_spiegab(handle,this%btable,cdat,to_char_tmp)
9242 ier = idba_fatto(handle)
9243 to_char_dat=trim(to_char_dat)//" ;char> "//trim(to_char_tmp)
9244endif
9245
9246#else
9247
9248to_char_dat="VALUE: "
9254
9255#endif
9256
9257END FUNCTION to_char_dat
9258
9259
9262FUNCTION vol7d_c_e(this) RESULT(c_e)
9263TYPE(vol7d), INTENT(in) :: this
9264
9265LOGICAL :: c_e
9266
9268 ASSOCIATED(this%level) .OR. ASSOCIATED(this%timerange) .OR. &
9269 ASSOCIATED(this%network) .OR. &
9270 ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
9271 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
9272 ASSOCIATED(this%anavar%c) .OR. &
9273 ASSOCIATED(this%anaattr%r) .OR. ASSOCIATED(this%anaattr%d) .OR. &
9274 ASSOCIATED(this%anaattr%i) .OR. ASSOCIATED(this%anaattr%b) .OR. &
9275 ASSOCIATED(this%anaattr%c) .OR. &
9276 ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
9277 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
9278 ASSOCIATED(this%dativar%c) .OR. &
9279 ASSOCIATED(this%datiattr%r) .OR. ASSOCIATED(this%datiattr%d) .OR. &
9280 ASSOCIATED(this%datiattr%i) .OR. ASSOCIATED(this%datiattr%b) .OR. &
9281 ASSOCIATED(this%datiattr%c)
9282
9283END FUNCTION vol7d_c_e
9284
9285
9324SUBROUTINE vol7d_alloc(this, nana, ntime, nlevel, ntimerange, nnetwork, &
9325 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
9326 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
9327 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
9328 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
9329 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
9330 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc, &
9331 ini)
9332TYPE(vol7d),INTENT(inout) :: this
9333INTEGER,INTENT(in),OPTIONAL :: nana
9334INTEGER,INTENT(in),OPTIONAL :: ntime
9335INTEGER,INTENT(in),OPTIONAL :: nlevel
9336INTEGER,INTENT(in),OPTIONAL :: ntimerange
9337INTEGER,INTENT(in),OPTIONAL :: nnetwork
9339INTEGER,INTENT(in),OPTIONAL :: &
9340 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
9341 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
9342 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
9343 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
9344 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
9345 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc
9346LOGICAL,INTENT(in),OPTIONAL :: ini
9347
9348INTEGER :: i
9349LOGICAL :: linit
9350
9351IF (PRESENT(ini)) THEN
9352 linit = ini
9353ELSE
9354 linit = .false.
9355ENDIF
9356
9357! Dimensioni principali
9358IF (PRESENT(nana)) THEN
9359 IF (nana >= 0) THEN
9360 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
9361 ALLOCATE(this%ana(nana))
9362 IF (linit) THEN
9363 DO i = 1, nana
9365 ENDDO
9366 ENDIF
9367 ENDIF
9368ENDIF
9369IF (PRESENT(ntime)) THEN
9370 IF (ntime >= 0) THEN
9371 IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
9372 ALLOCATE(this%time(ntime))
9373 IF (linit) THEN
9374 DO i = 1, ntime
9376 ENDDO
9377 ENDIF
9378 ENDIF
9379ENDIF
9380IF (PRESENT(nlevel)) THEN
9381 IF (nlevel >= 0) THEN
9382 IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
9383 ALLOCATE(this%level(nlevel))
9384 IF (linit) THEN
9385 DO i = 1, nlevel
9387 ENDDO
9388 ENDIF
9389 ENDIF
9390ENDIF
9391IF (PRESENT(ntimerange)) THEN
9392 IF (ntimerange >= 0) THEN
9393 IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
9394 ALLOCATE(this%timerange(ntimerange))
9395 IF (linit) THEN
9396 DO i = 1, ntimerange
9398 ENDDO
9399 ENDIF
9400 ENDIF
9401ENDIF
9402IF (PRESENT(nnetwork)) THEN
9403 IF (nnetwork >= 0) THEN
9404 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
9405 ALLOCATE(this%network(nnetwork))
9406 IF (linit) THEN
9407 DO i = 1, nnetwork
9409 ENDDO
9410 ENDIF
9411 ENDIF
9412ENDIF
9413! Dimensioni dei tipi delle variabili
9414CALL vol7d_varvect_alloc(this%anavar, nanavarr, nanavard, &
9415 nanavari, nanavarb, nanavarc, ini)
9416CALL vol7d_varvect_alloc(this%anaattr, nanaattrr, nanaattrd, &
9417 nanaattri, nanaattrb, nanaattrc, ini)
9418CALL vol7d_varvect_alloc(this%anavarattr, nanavarattrr, nanavarattrd, &
9419 nanavarattri, nanavarattrb, nanavarattrc, ini)
9420CALL vol7d_varvect_alloc(this%dativar, ndativarr, ndativard, &
9421 ndativari, ndativarb, ndativarc, ini)
9422CALL vol7d_varvect_alloc(this%datiattr, ndatiattrr, ndatiattrd, &
9423 ndatiattri, ndatiattrb, ndatiattrc, ini)
9424CALL vol7d_varvect_alloc(this%dativarattr, ndativarattrr, ndativarattrd, &
9425 ndativarattri, ndativarattrb, ndativarattrc, ini)
9426
9427END SUBROUTINE vol7d_alloc
9428
9429
9430FUNCTION vol7d_check_alloc_ana(this)
9431TYPE(vol7d),INTENT(in) :: this
9432LOGICAL :: vol7d_check_alloc_ana
9433
9434vol7d_check_alloc_ana = ASSOCIATED(this%ana) .AND. ASSOCIATED(this%network)
9435
9436END FUNCTION vol7d_check_alloc_ana
9437
9438SUBROUTINE vol7d_force_alloc_ana(this, ini)
9439TYPE(vol7d),INTENT(inout) :: this
9440LOGICAL,INTENT(in),OPTIONAL :: ini
9441
9442! Alloco i descrittori minimi per avere un volume di anagrafica
9443IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=1, ini=ini)
9444IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=1, ini=ini)
9445
9446END SUBROUTINE vol7d_force_alloc_ana
9447
9448
9449FUNCTION vol7d_check_alloc_dati(this)
9450TYPE(vol7d),INTENT(in) :: this
9451LOGICAL :: vol7d_check_alloc_dati
9452
9453vol7d_check_alloc_dati = vol7d_check_alloc_ana(this) .AND. &
9454 ASSOCIATED(this%time) .AND. ASSOCIATED(this%level) .AND. &
9455 ASSOCIATED(this%timerange)
9456
9457END FUNCTION vol7d_check_alloc_dati
9458
9459SUBROUTINE vol7d_force_alloc_dati(this, ini)
9460TYPE(vol7d),INTENT(inout) :: this
9461LOGICAL,INTENT(in),OPTIONAL :: ini
9462
9463! Alloco i descrittori minimi per avere un volume di dati
9464CALL vol7d_force_alloc_ana(this, ini)
9465IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=1, ini=ini)
9466IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=1, ini=ini)
9467IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=1, ini=ini)
9468
9469END SUBROUTINE vol7d_force_alloc_dati
9470
9471
9472SUBROUTINE vol7d_force_alloc(this)
9473TYPE(vol7d),INTENT(inout) :: this
9474
9475! If anything really not allocated yet, allocate with size 0
9476IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=0)
9477IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=0)
9478IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=0)
9479IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=0)
9480IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=0)
9481
9482END SUBROUTINE vol7d_force_alloc
9483
9484
9485FUNCTION vol7d_check_vol(this)
9486TYPE(vol7d),INTENT(in) :: this
9487LOGICAL :: vol7d_check_vol
9488
9489vol7d_check_vol = c_e(this)
9490
9491! Anagrafica
9492IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
9493 vol7d_check_vol = .false.
9494ENDIF
9495
9496IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
9497 vol7d_check_vol = .false.
9498ENDIF
9499
9500IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
9501 vol7d_check_vol = .false.
9502ENDIF
9503
9504IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
9505 vol7d_check_vol = .false.
9506ENDIF
9507
9508IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
9509 vol7d_check_vol = .false.
9510ENDIF
9511IF (ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
9512 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
9513 ASSOCIATED(this%anavar%c)) THEN
9514 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_ana(this)
9515ENDIF
9516
9517! Attributi dell'anagrafica
9518IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
9519 .NOT.ASSOCIATED(this%volanaattrr)) THEN
9520 vol7d_check_vol = .false.
9521ENDIF
9522
9523IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
9524 .NOT.ASSOCIATED(this%volanaattrd)) THEN
9525 vol7d_check_vol = .false.
9526ENDIF
9527
9528IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
9529 .NOT.ASSOCIATED(this%volanaattri)) THEN
9530 vol7d_check_vol = .false.
9531ENDIF
9532
9533IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
9534 .NOT.ASSOCIATED(this%volanaattrb)) THEN
9535 vol7d_check_vol = .false.
9536ENDIF
9537
9538IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
9539 .NOT.ASSOCIATED(this%volanaattrc)) THEN
9540 vol7d_check_vol = .false.
9541ENDIF
9542
9543! Dati
9544IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
9545 vol7d_check_vol = .false.
9546ENDIF
9547
9548IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
9549 vol7d_check_vol = .false.
9550ENDIF
9551
9552IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
9553 vol7d_check_vol = .false.
9554ENDIF
9555
9556IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
9557 vol7d_check_vol = .false.
9558ENDIF
9559
9560IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
9561 vol7d_check_vol = .false.
9562ENDIF
9563
9564! Attributi dei dati
9565IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
9566 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
9567 vol7d_check_vol = .false.
9568ENDIF
9569
9570IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
9571 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
9572 vol7d_check_vol = .false.
9573ENDIF
9574
9575IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
9576 .NOT.ASSOCIATED(this%voldatiattri)) THEN
9577 vol7d_check_vol = .false.
9578ENDIF
9579
9580IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
9581 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
9582 vol7d_check_vol = .false.
9583ENDIF
9584
9585IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
9586 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
9587 vol7d_check_vol = .false.
9588ENDIF
9589IF (ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
9590 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
9591 ASSOCIATED(this%dativar%c)) THEN
9592 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_dati(this)
9593ENDIF
9594
9595END FUNCTION vol7d_check_vol
9596
9597
9612SUBROUTINE vol7d_alloc_vol(this, ini, inivol)
9613TYPE(vol7d),INTENT(inout) :: this
9614LOGICAL,INTENT(in),OPTIONAL :: ini
9615LOGICAL,INTENT(in),OPTIONAL :: inivol
9616
9617LOGICAL :: linivol
9618
9619IF (PRESENT(inivol)) THEN
9620 linivol = inivol
9621ELSE
9622 linivol = .true.
9623ENDIF
9624
9625! Anagrafica
9626IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
9627 CALL vol7d_force_alloc_ana(this, ini)
9628 ALLOCATE(this%volanar(SIZE(this%ana), SIZE(this%anavar%r), SIZE(this%network)))
9629 IF (linivol) this%volanar(:,:,:) = rmiss
9630ENDIF
9631
9632IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
9633 CALL vol7d_force_alloc_ana(this, ini)
9634 ALLOCATE(this%volanad(SIZE(this%ana), SIZE(this%anavar%d), SIZE(this%network)))
9635 IF (linivol) this%volanad(:,:,:) = rdmiss
9636ENDIF
9637
9638IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
9639 CALL vol7d_force_alloc_ana(this, ini)
9640 ALLOCATE(this%volanai(SIZE(this%ana), SIZE(this%anavar%i), SIZE(this%network)))
9641 IF (linivol) this%volanai(:,:,:) = imiss
9642ENDIF
9643
9644IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
9645 CALL vol7d_force_alloc_ana(this, ini)
9646 ALLOCATE(this%volanab(SIZE(this%ana), SIZE(this%anavar%b), SIZE(this%network)))
9647 IF (linivol) this%volanab(:,:,:) = ibmiss
9648ENDIF
9649
9650IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
9651 CALL vol7d_force_alloc_ana(this, ini)
9652 ALLOCATE(this%volanac(SIZE(this%ana), SIZE(this%anavar%c), SIZE(this%network)))
9653 IF (linivol) this%volanac(:,:,:) = cmiss
9654ENDIF
9655
9656! Attributi dell'anagrafica
9657IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
9658 .NOT.ASSOCIATED(this%volanaattrr)) THEN
9659 CALL vol7d_force_alloc_ana(this, ini)
9660 ALLOCATE(this%volanaattrr(SIZE(this%ana), SIZE(this%anavarattr%r), &
9661 SIZE(this%network), SIZE(this%anaattr%r)))
9662 IF (linivol) this%volanaattrr(:,:,:,:) = rmiss
9663ENDIF
9664
9665IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
9666 .NOT.ASSOCIATED(this%volanaattrd)) THEN
9667 CALL vol7d_force_alloc_ana(this, ini)
9668 ALLOCATE(this%volanaattrd(SIZE(this%ana), SIZE(this%anavarattr%d), &
9669 SIZE(this%network), SIZE(this%anaattr%d)))
9670 IF (linivol) this%volanaattrd(:,:,:,:) = rdmiss
9671ENDIF
9672
9673IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
9674 .NOT.ASSOCIATED(this%volanaattri)) THEN
9675 CALL vol7d_force_alloc_ana(this, ini)
9676 ALLOCATE(this%volanaattri(SIZE(this%ana), SIZE(this%anavarattr%i), &
9677 SIZE(this%network), SIZE(this%anaattr%i)))
9678 IF (linivol) this%volanaattri(:,:,:,:) = imiss
9679ENDIF
9680
9681IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
9682 .NOT.ASSOCIATED(this%volanaattrb)) THEN
9683 CALL vol7d_force_alloc_ana(this, ini)
9684 ALLOCATE(this%volanaattrb(SIZE(this%ana), SIZE(this%anavarattr%b), &
9685 SIZE(this%network), SIZE(this%anaattr%b)))
9686 IF (linivol) this%volanaattrb(:,:,:,:) = ibmiss
9687ENDIF
9688
9689IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
9690 .NOT.ASSOCIATED(this%volanaattrc)) THEN
9691 CALL vol7d_force_alloc_ana(this, ini)
9692 ALLOCATE(this%volanaattrc(SIZE(this%ana), SIZE(this%anavarattr%c), &
9693 SIZE(this%network), SIZE(this%anaattr%c)))
9694 IF (linivol) this%volanaattrc(:,:,:,:) = cmiss
9695ENDIF
9696
9697! Dati
9698IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
9699 CALL vol7d_force_alloc_dati(this, ini)
9700 ALLOCATE(this%voldatir(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9701 SIZE(this%timerange), SIZE(this%dativar%r), SIZE(this%network)))
9702 IF (linivol) this%voldatir(:,:,:,:,:,:) = rmiss
9703ENDIF
9704
9705IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
9706 CALL vol7d_force_alloc_dati(this, ini)
9707 ALLOCATE(this%voldatid(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9708 SIZE(this%timerange), SIZE(this%dativar%d), SIZE(this%network)))
9709 IF (linivol) this%voldatid(:,:,:,:,:,:) = rdmiss
9710ENDIF
9711
9712IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
9713 CALL vol7d_force_alloc_dati(this, ini)
9714 ALLOCATE(this%voldatii(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9715 SIZE(this%timerange), SIZE(this%dativar%i), SIZE(this%network)))
9716 IF (linivol) this%voldatii(:,:,:,:,:,:) = imiss
9717ENDIF
9718
9719IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
9720 CALL vol7d_force_alloc_dati(this, ini)
9721 ALLOCATE(this%voldatib(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9722 SIZE(this%timerange), SIZE(this%dativar%b), SIZE(this%network)))
9723 IF (linivol) this%voldatib(:,:,:,:,:,:) = ibmiss
9724ENDIF
9725
9726IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
9727 CALL vol7d_force_alloc_dati(this, ini)
9728 ALLOCATE(this%voldatic(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9729 SIZE(this%timerange), SIZE(this%dativar%c), SIZE(this%network)))
9730 IF (linivol) this%voldatic(:,:,:,:,:,:) = cmiss
9731ENDIF
9732
9733! Attributi dei dati
9734IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
9735 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
9736 CALL vol7d_force_alloc_dati(this, ini)
9737 ALLOCATE(this%voldatiattrr(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9738 SIZE(this%timerange), SIZE(this%dativarattr%r), SIZE(this%network), &
9739 SIZE(this%datiattr%r)))
9740 IF (linivol) this%voldatiattrr(:,:,:,:,:,:,:) = rmiss
9741ENDIF
9742
9743IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
9744 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
9745 CALL vol7d_force_alloc_dati(this, ini)
9746 ALLOCATE(this%voldatiattrd(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9747 SIZE(this%timerange), SIZE(this%dativarattr%d), SIZE(this%network), &
9748 SIZE(this%datiattr%d)))
9749 IF (linivol) this%voldatiattrd(:,:,:,:,:,:,:) = rdmiss
9750ENDIF
9751
9752IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
9753 .NOT.ASSOCIATED(this%voldatiattri)) THEN
9754 CALL vol7d_force_alloc_dati(this, ini)
9755 ALLOCATE(this%voldatiattri(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9756 SIZE(this%timerange), SIZE(this%dativarattr%i), SIZE(this%network), &
9757 SIZE(this%datiattr%i)))
9758 IF (linivol) this%voldatiattri(:,:,:,:,:,:,:) = imiss
9759ENDIF
9760
9761IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
9762 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
9763 CALL vol7d_force_alloc_dati(this, ini)
9764 ALLOCATE(this%voldatiattrb(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9765 SIZE(this%timerange), SIZE(this%dativarattr%b), SIZE(this%network), &
9766 SIZE(this%datiattr%b)))
9767 IF (linivol) this%voldatiattrb(:,:,:,:,:,:,:) = ibmiss
9768ENDIF
9769
9770IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
9771 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
9772 CALL vol7d_force_alloc_dati(this, ini)
9773 ALLOCATE(this%voldatiattrc(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9774 SIZE(this%timerange), SIZE(this%dativarattr%c), SIZE(this%network), &
9775 SIZE(this%datiattr%c)))
9776 IF (linivol) this%voldatiattrc(:,:,:,:,:,:,:) = cmiss
9777ENDIF
9778
9779! Catch-all method
9780CALL vol7d_force_alloc(this)
9781
9782! Creo gli indici var-attr
9783
9784#ifdef DEBUG
9785CALL l4f_log(l4f_debug,"calling: vol7d_set_attr_ind")
9786#endif
9787
9788CALL vol7d_set_attr_ind(this)
9789
9790
9791
9792END SUBROUTINE vol7d_alloc_vol
9793
9794
9801SUBROUTINE vol7d_set_attr_ind(this)
9802TYPE(vol7d),INTENT(inout) :: this
9803
9804INTEGER :: i
9805
9806! real
9807IF (ASSOCIATED(this%dativar%r)) THEN
9808 IF (ASSOCIATED(this%dativarattr%r)) THEN
9809 DO i = 1, SIZE(this%dativar%r)
9810 this%dativar%r(i)%r = &
9811 firsttrue(this%dativar%r(i)%btable == this%dativarattr%r(:)%btable)
9812 ENDDO
9813 ENDIF
9814
9815 IF (ASSOCIATED(this%dativarattr%d)) THEN
9816 DO i = 1, SIZE(this%dativar%r)
9817 this%dativar%r(i)%d = &
9818 firsttrue(this%dativar%r(i)%btable == this%dativarattr%d(:)%btable)
9819 ENDDO
9820 ENDIF
9821
9822 IF (ASSOCIATED(this%dativarattr%i)) THEN
9823 DO i = 1, SIZE(this%dativar%r)
9824 this%dativar%r(i)%i = &
9825 firsttrue(this%dativar%r(i)%btable == this%dativarattr%i(:)%btable)
9826 ENDDO
9827 ENDIF
9828
9829 IF (ASSOCIATED(this%dativarattr%b)) THEN
9830 DO i = 1, SIZE(this%dativar%r)
9831 this%dativar%r(i)%b = &
9832 firsttrue(this%dativar%r(i)%btable == this%dativarattr%b(:)%btable)
9833 ENDDO
9834 ENDIF
9835
9836 IF (ASSOCIATED(this%dativarattr%c)) THEN
9837 DO i = 1, SIZE(this%dativar%r)
9838 this%dativar%r(i)%c = &
9839 firsttrue(this%dativar%r(i)%btable == this%dativarattr%c(:)%btable)
9840 ENDDO
9841 ENDIF
9842ENDIF
9843! double
9844IF (ASSOCIATED(this%dativar%d)) THEN
9845 IF (ASSOCIATED(this%dativarattr%r)) THEN
9846 DO i = 1, SIZE(this%dativar%d)
9847 this%dativar%d(i)%r = &
9848 firsttrue(this%dativar%d(i)%btable == this%dativarattr%r(:)%btable)
9849 ENDDO
9850 ENDIF
9851
9852 IF (ASSOCIATED(this%dativarattr%d)) THEN
9853 DO i = 1, SIZE(this%dativar%d)
9854 this%dativar%d(i)%d = &
9855 firsttrue(this%dativar%d(i)%btable == this%dativarattr%d(:)%btable)
9856 ENDDO
9857 ENDIF
9858
9859 IF (ASSOCIATED(this%dativarattr%i)) THEN
9860 DO i = 1, SIZE(this%dativar%d)
9861 this%dativar%d(i)%i = &
9862 firsttrue(this%dativar%d(i)%btable == this%dativarattr%i(:)%btable)
9863 ENDDO
9864 ENDIF
9865
9866 IF (ASSOCIATED(this%dativarattr%b)) THEN
9867 DO i = 1, SIZE(this%dativar%d)
9868 this%dativar%d(i)%b = &
9869 firsttrue(this%dativar%d(i)%btable == this%dativarattr%b(:)%btable)
9870 ENDDO
9871 ENDIF
9872
9873 IF (ASSOCIATED(this%dativarattr%c)) THEN
9874 DO i = 1, SIZE(this%dativar%d)
9875 this%dativar%d(i)%c = &
9876 firsttrue(this%dativar%d(i)%btable == this%dativarattr%c(:)%btable)
9877 ENDDO
9878 ENDIF
9879ENDIF
9880! integer
9881IF (ASSOCIATED(this%dativar%i)) THEN
9882 IF (ASSOCIATED(this%dativarattr%r)) THEN
9883 DO i = 1, SIZE(this%dativar%i)
9884 this%dativar%i(i)%r = &
9885 firsttrue(this%dativar%i(i)%btable == this%dativarattr%r(:)%btable)
9886 ENDDO
9887 ENDIF
9888
9889 IF (ASSOCIATED(this%dativarattr%d)) THEN
9890 DO i = 1, SIZE(this%dativar%i)
9891 this%dativar%i(i)%d = &
9892 firsttrue(this%dativar%i(i)%btable == this%dativarattr%d(:)%btable)
9893 ENDDO
9894 ENDIF
9895
9896 IF (ASSOCIATED(this%dativarattr%i)) THEN
9897 DO i = 1, SIZE(this%dativar%i)
9898 this%dativar%i(i)%i = &
9899 firsttrue(this%dativar%i(i)%btable == this%dativarattr%i(:)%btable)
9900 ENDDO
9901 ENDIF
9902
9903 IF (ASSOCIATED(this%dativarattr%b)) THEN
9904 DO i = 1, SIZE(this%dativar%i)
9905 this%dativar%i(i)%b = &
9906 firsttrue(this%dativar%i(i)%btable == this%dativarattr%b(:)%btable)
9907 ENDDO
9908 ENDIF
9909
9910 IF (ASSOCIATED(this%dativarattr%c)) THEN
9911 DO i = 1, SIZE(this%dativar%i)
9912 this%dativar%i(i)%c = &
9913 firsttrue(this%dativar%i(i)%btable == this%dativarattr%c(:)%btable)
9914 ENDDO
9915 ENDIF
9916ENDIF
9917! byte
9918IF (ASSOCIATED(this%dativar%b)) THEN
9919 IF (ASSOCIATED(this%dativarattr%r)) THEN
9920 DO i = 1, SIZE(this%dativar%b)
9921 this%dativar%b(i)%r = &
9922 firsttrue(this%dativar%b(i)%btable == this%dativarattr%r(:)%btable)
9923 ENDDO
9924 ENDIF
9925
9926 IF (ASSOCIATED(this%dativarattr%d)) THEN
9927 DO i = 1, SIZE(this%dativar%b)
9928 this%dativar%b(i)%d = &
9929 firsttrue(this%dativar%b(i)%btable == this%dativarattr%d(:)%btable)
9930 ENDDO
9931 ENDIF
9932
9933 IF (ASSOCIATED(this%dativarattr%i)) THEN
9934 DO i = 1, SIZE(this%dativar%b)
9935 this%dativar%b(i)%i = &
9936 firsttrue(this%dativar%b(i)%btable == this%dativarattr%i(:)%btable)
9937 ENDDO
9938 ENDIF
9939
9940 IF (ASSOCIATED(this%dativarattr%b)) THEN
9941 DO i = 1, SIZE(this%dativar%b)
9942 this%dativar%b(i)%b = &
9943 firsttrue(this%dativar%b(i)%btable == this%dativarattr%b(:)%btable)
9944 ENDDO
9945 ENDIF
9946
9947 IF (ASSOCIATED(this%dativarattr%c)) THEN
9948 DO i = 1, SIZE(this%dativar%b)
9949 this%dativar%b(i)%c = &
9950 firsttrue(this%dativar%b(i)%btable == this%dativarattr%c(:)%btable)
9951 ENDDO
9952 ENDIF
9953ENDIF
9954! character
9955IF (ASSOCIATED(this%dativar%c)) THEN
9956 IF (ASSOCIATED(this%dativarattr%r)) THEN
9957 DO i = 1, SIZE(this%dativar%c)
9958 this%dativar%c(i)%r = &
9959 firsttrue(this%dativar%c(i)%btable == this%dativarattr%r(:)%btable)
9960 ENDDO
9961 ENDIF
9962
9963 IF (ASSOCIATED(this%dativarattr%d)) THEN
9964 DO i = 1, SIZE(this%dativar%c)
9965 this%dativar%c(i)%d = &
9966 firsttrue(this%dativar%c(i)%btable == this%dativarattr%d(:)%btable)
9967 ENDDO
9968 ENDIF
9969
9970 IF (ASSOCIATED(this%dativarattr%i)) THEN
9971 DO i = 1, SIZE(this%dativar%c)
9972 this%dativar%c(i)%i = &
9973 firsttrue(this%dativar%c(i)%btable == this%dativarattr%i(:)%btable)
9974 ENDDO
9975 ENDIF
9976
9977 IF (ASSOCIATED(this%dativarattr%b)) THEN
9978 DO i = 1, SIZE(this%dativar%c)
9979 this%dativar%c(i)%b = &
9980 firsttrue(this%dativar%c(i)%btable == this%dativarattr%b(:)%btable)
9981 ENDDO
9982 ENDIF
9983
9984 IF (ASSOCIATED(this%dativarattr%c)) THEN
9985 DO i = 1, SIZE(this%dativar%c)
9986 this%dativar%c(i)%c = &
9987 firsttrue(this%dativar%c(i)%btable == this%dativarattr%c(:)%btable)
9988 ENDDO
9989 ENDIF
9990ENDIF
9991
9992END SUBROUTINE vol7d_set_attr_ind
9993
9994
9999SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
10000 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
10001TYPE(vol7d),INTENT(INOUT) :: this
10002TYPE(vol7d),INTENT(INOUT) :: that
10003LOGICAL,INTENT(IN),OPTIONAL :: sort
10004LOGICAL,INTENT(in),OPTIONAL :: bestdata
10005LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple ! experimental, please do not use outside the library now
10006
10007TYPE(vol7d) :: v7d_clean
10008
10009
10011 this = that
10013 that = v7d_clean ! destroy that without deallocating
10014ELSE ! Append that to this and destroy that
10016 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
10018ENDIF
10019
10020END SUBROUTINE vol7d_merge
10021
10022
10051SUBROUTINE vol7d_append(this, that, sort, bestdata, &
10052 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
10053TYPE(vol7d),INTENT(INOUT) :: this
10054TYPE(vol7d),INTENT(IN) :: that
10055LOGICAL,INTENT(IN),OPTIONAL :: sort
10056! experimental, please do not use outside the library now, they force the use
10057! of a simplified mapping algorithm which is valid only whene the dimension
10058! content is the same in both volumes , or when one of them is empty
10059LOGICAL,INTENT(in),OPTIONAL :: bestdata
10060LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple
10061
10062
10063TYPE(vol7d) :: v7dtmp
10064LOGICAL :: lsort, lbestdata
10065INTEGER,POINTER :: remapt1(:), remapt2(:), remaptr1(:), remaptr2(:), &
10066 remapl1(:), remapl2(:), remapa1(:), remapa2(:), remapn1(:), remapn2(:)
10067
10069IF (.NOT.vol7d_check_vol(that)) RETURN ! be safe
10072 RETURN
10073ENDIF
10074
10075IF (this%time_definition /= that%time_definition) THEN
10076 CALL l4f_log(l4f_fatal, &
10077 'in vol7d_append, cannot append volumes with different &
10078 &time definition')
10079 CALL raise_fatal_error()
10080ENDIF
10081
10082! Completo l'allocazione per avere volumi a norma
10083CALL vol7d_alloc_vol(this)
10084
10088
10089! Calcolo le mappature tra volumi vecchi e volume nuovo
10090! I puntatori remap* vengono tutti o allocati o nullificati
10091IF (optio_log(ltimesimple)) THEN
10092 CALL vol7d_remap2simple_datetime(this%time, that%time, v7dtmp%time, &
10093 lsort, remapt1, remapt2)
10094ELSE
10095 CALL vol7d_remap2_datetime(this%time, that%time, v7dtmp%time, &
10096 lsort, remapt1, remapt2)
10097ENDIF
10098IF (optio_log(ltimerangesimple)) THEN
10099 CALL vol7d_remap2simple_vol7d_timerange(this%timerange, that%timerange, &
10100 v7dtmp%timerange, lsort, remaptr1, remaptr2)
10101ELSE
10102 CALL vol7d_remap2_vol7d_timerange(this%timerange, that%timerange, &
10103 v7dtmp%timerange, lsort, remaptr1, remaptr2)
10104ENDIF
10105IF (optio_log(llevelsimple)) THEN
10106 CALL vol7d_remap2simple_vol7d_level(this%level, that%level, v7dtmp%level, &
10107 lsort, remapl1, remapl2)
10108ELSE
10109 CALL vol7d_remap2_vol7d_level(this%level, that%level, v7dtmp%level, &
10110 lsort, remapl1, remapl2)
10111ENDIF
10112IF (optio_log(lanasimple)) THEN
10113 CALL vol7d_remap2simple_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
10114 .false., remapa1, remapa2)
10115ELSE
10116 CALL vol7d_remap2_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
10117 .false., remapa1, remapa2)
10118ENDIF
10119IF (optio_log(lnetworksimple)) THEN
10120 CALL vol7d_remap2simple_vol7d_network(this%network, that%network, v7dtmp%network, &
10121 .false., remapn1, remapn2)
10122ELSE
10123 CALL vol7d_remap2_vol7d_network(this%network, that%network, v7dtmp%network, &
10124 .false., remapn1, remapn2)
10125ENDIF
10126
10127! Faccio la fusione fisica dei volumi
10128CALL vol7d_merge_finalr(this, that, v7dtmp, &
10129 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10130 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10131CALL vol7d_merge_finald(this, that, v7dtmp, &
10132 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10133 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10134CALL vol7d_merge_finali(this, that, v7dtmp, &
10135 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10136 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10137CALL vol7d_merge_finalb(this, that, v7dtmp, &
10138 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10139 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10140CALL vol7d_merge_finalc(this, that, v7dtmp, &
10141 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10142 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10143
10144! Dealloco i vettori di rimappatura
10145IF (ASSOCIATED(remapt1)) DEALLOCATE(remapt1)
10146IF (ASSOCIATED(remapt2)) DEALLOCATE(remapt2)
10147IF (ASSOCIATED(remaptr1)) DEALLOCATE(remaptr1)
10148IF (ASSOCIATED(remaptr2)) DEALLOCATE(remaptr2)
10149IF (ASSOCIATED(remapl1)) DEALLOCATE(remapl1)
10150IF (ASSOCIATED(remapl2)) DEALLOCATE(remapl2)
10151IF (ASSOCIATED(remapa1)) DEALLOCATE(remapa1)
10152IF (ASSOCIATED(remapa2)) DEALLOCATE(remapa2)
10153IF (ASSOCIATED(remapn1)) DEALLOCATE(remapn1)
10154IF (ASSOCIATED(remapn2)) DEALLOCATE(remapn2)
10155
10156! Distruggo il vecchio volume e assegno il nuovo a this
10158this = v7dtmp
10159! Ricreo gli indici var-attr
10160CALL vol7d_set_attr_ind(this)
10161
10162END SUBROUTINE vol7d_append
10163
10164
10197SUBROUTINE vol7d_copy(this, that, sort, unique, miss, &
10198 lsort_time, lsort_timerange, lsort_level, &
10199 ltime, ltimerange, llevel, lana, lnetwork, &
10200 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
10201 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
10202 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
10203 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
10204 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
10205 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
10206TYPE(vol7d),INTENT(IN) :: this
10207TYPE(vol7d),INTENT(INOUT) :: that
10208LOGICAL,INTENT(IN),OPTIONAL :: sort
10209LOGICAL,INTENT(IN),OPTIONAL :: unique
10210LOGICAL,INTENT(IN),OPTIONAL :: miss
10211LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
10212LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
10213LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
10221LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
10223LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
10225LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
10227LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
10229LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
10231LOGICAL,INTENT(in),OPTIONAL :: &
10232 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
10233 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
10234 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
10235 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
10236 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
10237 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
10238
10239LOGICAL :: lsort, lunique, lmiss
10240INTEGER,POINTER :: remapt(:), remaptr(:), remapl(:), remapa(:), remapn(:)
10241
10244IF (.NOT.vol7d_check_vol(this)) RETURN ! be safe
10245
10249
10250! Calcolo le mappature tra volume vecchio e volume nuovo
10251! I puntatori remap* vengono tutti o allocati o nullificati
10252CALL vol7d_remap1_datetime(this%time, that%time, &
10253 lsort.OR.optio_log(lsort_time), lunique, lmiss, remapt, ltime)
10254CALL vol7d_remap1_vol7d_timerange(this%timerange, that%timerange, &
10255 lsort.OR.optio_log(lsort_timerange), lunique, lmiss, remaptr, ltimerange)
10256CALL vol7d_remap1_vol7d_level(this%level, that%level, &
10257 lsort.OR.optio_log(lsort_level), lunique, lmiss, remapl, llevel)
10258CALL vol7d_remap1_vol7d_ana(this%ana, that%ana, &
10259 lsort, lunique, lmiss, remapa, lana)
10260CALL vol7d_remap1_vol7d_network(this%network, that%network, &
10261 lsort, lunique, lmiss, remapn, lnetwork)
10262
10263! lanavari, lanavarb, lanavarc, &
10264! lanaattri, lanaattrb, lanaattrc, &
10265! lanavarattri, lanavarattrb, lanavarattrc, &
10266! ldativari, ldativarb, ldativarc, &
10267! ldatiattri, ldatiattrb, ldatiattrc, &
10268! ldativarattri, ldativarattrb, ldativarattrc
10269! Faccio la riforma fisica dei volumi
10270CALL vol7d_reform_finalr(this, that, &
10271 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
10272 lanavarr, lanaattrr, lanavarattrr, ldativarr, ldatiattrr, ldativarattrr)
10273CALL vol7d_reform_finald(this, that, &
10274 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
10275 lanavard, lanaattrd, lanavarattrd, ldativard, ldatiattrd, ldativarattrd)
10276CALL vol7d_reform_finali(this, that, &
10277 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
10278 lanavari, lanaattri, lanavarattri, ldativari, ldatiattri, ldativarattri)
10279CALL vol7d_reform_finalb(this, that, &
10280 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
10281 lanavarb, lanaattrb, lanavarattrb, ldativarb, ldatiattrb, ldativarattrb)
10282CALL vol7d_reform_finalc(this, that, &
10283 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
10284 lanavarc, lanaattrc, lanavarattrc, ldativarc, ldatiattrc, ldativarattrc)
10285
10286! Dealloco i vettori di rimappatura
10287IF (ASSOCIATED(remapt)) DEALLOCATE(remapt)
10288IF (ASSOCIATED(remaptr)) DEALLOCATE(remaptr)
10289IF (ASSOCIATED(remapl)) DEALLOCATE(remapl)
10290IF (ASSOCIATED(remapa)) DEALLOCATE(remapa)
10291IF (ASSOCIATED(remapn)) DEALLOCATE(remapn)
10292
10293! Ricreo gli indici var-attr
10294CALL vol7d_set_attr_ind(that)
10295that%time_definition = this%time_definition
10296
10297END SUBROUTINE vol7d_copy
10298
10299
10310SUBROUTINE vol7d_reform(this, sort, unique, miss, &
10311 lsort_time, lsort_timerange, lsort_level, &
10312 ltime, ltimerange, llevel, lana, lnetwork, &
10313 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
10314 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
10315 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
10316 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
10317 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
10318 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc&
10319 ,purgeana)
10320TYPE(vol7d),INTENT(INOUT) :: this
10321LOGICAL,INTENT(IN),OPTIONAL :: sort
10322LOGICAL,INTENT(IN),OPTIONAL :: unique
10323LOGICAL,INTENT(IN),OPTIONAL :: miss
10324LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
10325LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
10326LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
10334LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
10335LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
10336LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
10337LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
10338LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
10340LOGICAL,INTENT(in),OPTIONAL :: &
10341 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
10342 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
10343 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
10344 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
10345 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
10346 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
10347LOGICAL,INTENT(IN),OPTIONAL :: purgeana
10348
10349TYPE(vol7d) :: v7dtmp
10350logical,allocatable :: llana(:)
10351integer :: i
10352
10354 lsort_time, lsort_timerange, lsort_level, &
10355 ltime, ltimerange, llevel, lana, lnetwork, &
10356 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
10357 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
10358 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
10359 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
10360 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
10361 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
10362
10363! destroy old volume
10365
10366if (optio_log(purgeana)) then
10367 allocate(llana(size(v7dtmp%ana)))
10368 llana =.false.
10369 do i =1,size(v7dtmp%ana)
10370 if (associated(v7dtmp%voldatii)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatii(i,:,:,:,:,:)))
10371 if (associated(v7dtmp%voldatir)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatir(i,:,:,:,:,:)))
10372 if (associated(v7dtmp%voldatid)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatid(i,:,:,:,:,:)))
10373 if (associated(v7dtmp%voldatib)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatib(i,:,:,:,:,:)))
10374 if (associated(v7dtmp%voldatic)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatic(i,:,:,:,:,:)))
10375 end do
10376 CALL vol7d_copy(v7dtmp, this,lana=llana)
10378 deallocate(llana)
10379else
10380 this=v7dtmp
10381end if
10382
10383END SUBROUTINE vol7d_reform
10384
10385
10393SUBROUTINE vol7d_smart_sort(this, lsort_time, lsort_timerange, lsort_level)
10394TYPE(vol7d),INTENT(INOUT) :: this
10395LOGICAL,OPTIONAL,INTENT(in) :: lsort_time
10396LOGICAL,OPTIONAL,INTENT(in) :: lsort_timerange
10397LOGICAL,OPTIONAL,INTENT(in) :: lsort_level
10398
10399INTEGER :: i
10400LOGICAL :: to_be_sorted
10401
10402to_be_sorted = .false.
10403CALL vol7d_alloc_vol(this) ! usual safety check
10404
10405IF (optio_log(lsort_time)) THEN
10406 DO i = 2, SIZE(this%time)
10407 IF (this%time(i) < this%time(i-1)) THEN
10408 to_be_sorted = .true.
10409 EXIT
10410 ENDIF
10411 ENDDO
10412ENDIF
10413IF (optio_log(lsort_timerange)) THEN
10414 DO i = 2, SIZE(this%timerange)
10415 IF (this%timerange(i) < this%timerange(i-1)) THEN
10416 to_be_sorted = .true.
10417 EXIT
10418 ENDIF
10419 ENDDO
10420ENDIF
10421IF (optio_log(lsort_level)) THEN
10422 DO i = 2, SIZE(this%level)
10423 IF (this%level(i) < this%level(i-1)) THEN
10424 to_be_sorted = .true.
10425 EXIT
10426 ENDIF
10427 ENDDO
10428ENDIF
10429
10430IF (to_be_sorted) CALL vol7d_reform(this, &
10431 lsort_time=lsort_time, lsort_timerange=lsort_timerange, lsort_level=lsort_level )
10432
10433END SUBROUTINE vol7d_smart_sort
10434
10442SUBROUTINE vol7d_filter(this, avl, vl, nl, s_d, e_d)
10443TYPE(vol7d),INTENT(inout) :: this
10444CHARACTER(len=*),INTENT(in),OPTIONAL :: avl(:)
10445CHARACTER(len=*),INTENT(in),OPTIONAL :: vl(:)
10446TYPE(vol7d_network),OPTIONAL :: nl(:)
10447TYPE(datetime),INTENT(in),OPTIONAL :: s_d
10448TYPE(datetime),INTENT(in),OPTIONAL :: e_d
10449
10450INTEGER :: i
10451
10452IF (PRESENT(avl)) THEN
10453 IF (SIZE(avl) > 0) THEN
10454
10455 IF (ASSOCIATED(this%anavar%r)) THEN
10456 DO i = 1, SIZE(this%anavar%r)
10457 IF (all(this%anavar%r(i)%btable /= avl)) this%anavar%r(i) = vol7d_var_miss
10458 ENDDO
10459 ENDIF
10460
10461 IF (ASSOCIATED(this%anavar%i)) THEN
10462 DO i = 1, SIZE(this%anavar%i)
10463 IF (all(this%anavar%i(i)%btable /= avl)) this%anavar%i(i) = vol7d_var_miss
10464 ENDDO
10465 ENDIF
10466
10467 IF (ASSOCIATED(this%anavar%b)) THEN
10468 DO i = 1, SIZE(this%anavar%b)
10469 IF (all(this%anavar%b(i)%btable /= avl)) this%anavar%b(i) = vol7d_var_miss
10470 ENDDO
10471 ENDIF
10472
10473 IF (ASSOCIATED(this%anavar%d)) THEN
10474 DO i = 1, SIZE(this%anavar%d)
10475 IF (all(this%anavar%d(i)%btable /= avl)) this%anavar%d(i) = vol7d_var_miss
10476 ENDDO
10477 ENDIF
10478
10479 IF (ASSOCIATED(this%anavar%c)) THEN
10480 DO i = 1, SIZE(this%anavar%c)
10481 IF (all(this%anavar%c(i)%btable /= avl)) this%anavar%c(i) = vol7d_var_miss
10482 ENDDO
10483 ENDIF
10484
10485 ENDIF
10486ENDIF
10487
10488
10489IF (PRESENT(vl)) THEN
10490 IF (size(vl) > 0) THEN
10491 IF (ASSOCIATED(this%dativar%r)) THEN
10492 DO i = 1, SIZE(this%dativar%r)
10493 IF (all(this%dativar%r(i)%btable /= vl)) this%dativar%r(i) = vol7d_var_miss
10494 ENDDO
10495 ENDIF
10496
10497 IF (ASSOCIATED(this%dativar%i)) THEN
10498 DO i = 1, SIZE(this%dativar%i)
10499 IF (all(this%dativar%i(i)%btable /= vl)) this%dativar%i(i) = vol7d_var_miss
10500 ENDDO
10501 ENDIF
10502
10503 IF (ASSOCIATED(this%dativar%b)) THEN
10504 DO i = 1, SIZE(this%dativar%b)
10505 IF (all(this%dativar%b(i)%btable /= vl)) this%dativar%b(i) = vol7d_var_miss
10506 ENDDO
10507 ENDIF
10508
10509 IF (ASSOCIATED(this%dativar%d)) THEN
10510 DO i = 1, SIZE(this%dativar%d)
10511 IF (all(this%dativar%d(i)%btable /= vl)) this%dativar%d(i) = vol7d_var_miss
10512 ENDDO
10513 ENDIF
10514
10515 IF (ASSOCIATED(this%dativar%c)) THEN
10516 DO i = 1, SIZE(this%dativar%c)
10517 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
10518 ENDDO
10519 ENDIF
10520
10521 IF (ASSOCIATED(this%dativar%c)) THEN
10522 DO i = 1, SIZE(this%dativar%c)
10523 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
10524 ENDDO
10525 ENDIF
10526
10527 ENDIF
10528ENDIF
10529
10530IF (PRESENT(nl)) THEN
10531 IF (SIZE(nl) > 0) THEN
10532 DO i = 1, SIZE(this%network)
10533 IF (all(this%network(i) /= nl)) this%network(i) = vol7d_network_miss
10534 ENDDO
10535 ENDIF
10536ENDIF
10537
10538IF (PRESENT(s_d)) THEN
10540 WHERE (this%time < s_d)
10541 this%time = datetime_miss
10542 END WHERE
10543 ENDIF
10544ENDIF
10545
10546IF (PRESENT(e_d)) THEN
10548 WHERE (this%time > e_d)
10549 this%time = datetime_miss
10550 END WHERE
10551 ENDIF
10552ENDIF
10553
10554CALL vol7d_reform(this, miss=.true.)
10555
10556END SUBROUTINE vol7d_filter
10557
10558
10565SUBROUTINE vol7d_convr(this, that, anaconv)
10566TYPE(vol7d),INTENT(IN) :: this
10567TYPE(vol7d),INTENT(INOUT) :: that
10568LOGICAL,OPTIONAL,INTENT(in) :: anaconv
10569INTEGER :: i
10570LOGICAL :: fv(1)=(/.false./), tv(1)=(/.true./), acp(1), acn(1)
10571TYPE(vol7d) :: v7d_tmp
10572
10573IF (optio_log(anaconv)) THEN
10574 acp=fv
10575 acn=tv
10576ELSE
10577 acp=tv
10578 acn=fv
10579ENDIF
10580
10581! Volume con solo i dati reali e tutti gli attributi
10582! l'anagrafica e` copiata interamente se necessario
10583CALL vol7d_copy(this, that, &
10584 lanavarr=tv, lanavard=acp, lanavari=acp, lanavarb=acp, lanavarc=acp, &
10585 ldativarr=tv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=fv)
10586
10587! Volume solo di dati double
10588CALL vol7d_copy(this, v7d_tmp, &
10589 lanavarr=fv, lanavard=acn, lanavari=fv, lanavarb=fv, lanavarc=fv, &
10590 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
10591 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
10592 ldativarr=fv, ldativard=tv, ldativari=fv, ldativarb=fv, ldativarc=fv, &
10593 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
10594 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
10595
10596! converto a dati reali
10597IF (ASSOCIATED(v7d_tmp%anavar%d) .OR. ASSOCIATED(v7d_tmp%dativar%d)) THEN
10598
10599 IF (ASSOCIATED(v7d_tmp%anavar%d)) THEN
10600! alloco i dati reali e vi trasferisco i double
10601 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanad, 1), SIZE(v7d_tmp%volanad, 2), &
10602 SIZE(v7d_tmp%volanad, 3)))
10603 DO i = 1, SIZE(v7d_tmp%anavar%d)
10604 v7d_tmp%volanar(:,i,:) = &
10605 realdat(v7d_tmp%volanad(:,i,:), v7d_tmp%anavar%d(i))
10606 ENDDO
10607 DEALLOCATE(v7d_tmp%volanad)
10608! trasferisco le variabili
10609 v7d_tmp%anavar%r => v7d_tmp%anavar%d
10610 NULLIFY(v7d_tmp%anavar%d)
10611 ENDIF
10612
10613 IF (ASSOCIATED(v7d_tmp%dativar%d)) THEN
10614! alloco i dati reali e vi trasferisco i double
10615 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatid, 1), SIZE(v7d_tmp%voldatid, 2), &
10616 SIZE(v7d_tmp%voldatid, 3), SIZE(v7d_tmp%voldatid, 4), SIZE(v7d_tmp%voldatid, 5), &
10617 SIZE(v7d_tmp%voldatid, 6)))
10618 DO i = 1, SIZE(v7d_tmp%dativar%d)
10619 v7d_tmp%voldatir(:,:,:,:,i,:) = &
10620 realdat(v7d_tmp%voldatid(:,:,:,:,i,:), v7d_tmp%dativar%d(i))
10621 ENDDO
10622 DEALLOCATE(v7d_tmp%voldatid)
10623! trasferisco le variabili
10624 v7d_tmp%dativar%r => v7d_tmp%dativar%d
10625 NULLIFY(v7d_tmp%dativar%d)
10626 ENDIF
10627
10628! fondo con il volume definitivo
10629 CALL vol7d_merge(that, v7d_tmp)
10630ELSE
10632ENDIF
10633
10634
10635! Volume solo di dati interi
10636CALL vol7d_copy(this, v7d_tmp, &
10637 lanavarr=fv, lanavard=fv, lanavari=acn, lanavarb=fv, lanavarc=fv, &
10638 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
10639 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
10640 ldativarr=fv, ldativard=fv, ldativari=tv, ldativarb=fv, ldativarc=fv, &
10641 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
10642 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
10643
10644! converto a dati reali
10645IF (ASSOCIATED(v7d_tmp%anavar%i) .OR. ASSOCIATED(v7d_tmp%dativar%i)) THEN
10646
10647 IF (ASSOCIATED(v7d_tmp%anavar%i)) THEN
10648! alloco i dati reali e vi trasferisco gli interi
10649 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanai, 1), SIZE(v7d_tmp%volanai, 2), &
10650 SIZE(v7d_tmp%volanai, 3)))
10651 DO i = 1, SIZE(v7d_tmp%anavar%i)
10652 v7d_tmp%volanar(:,i,:) = &
10653 realdat(v7d_tmp%volanai(:,i,:), v7d_tmp%anavar%i(i))
10654 ENDDO
10655 DEALLOCATE(v7d_tmp%volanai)
10656! trasferisco le variabili
10657 v7d_tmp%anavar%r => v7d_tmp%anavar%i
10658 NULLIFY(v7d_tmp%anavar%i)
10659 ENDIF
10660
10661 IF (ASSOCIATED(v7d_tmp%dativar%i)) THEN
10662! alloco i dati reali e vi trasferisco gli interi
10663 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatii, 1), SIZE(v7d_tmp%voldatii, 2), &
10664 SIZE(v7d_tmp%voldatii, 3), SIZE(v7d_tmp%voldatii, 4), SIZE(v7d_tmp%voldatii, 5), &
10665 SIZE(v7d_tmp%voldatii, 6)))
10666 DO i = 1, SIZE(v7d_tmp%dativar%i)
10667 v7d_tmp%voldatir(:,:,:,:,i,:) = &
10668 realdat(v7d_tmp%voldatii(:,:,:,:,i,:), v7d_tmp%dativar%i(i))
10669 ENDDO
10670 DEALLOCATE(v7d_tmp%voldatii)
10671! trasferisco le variabili
10672 v7d_tmp%dativar%r => v7d_tmp%dativar%i
10673 NULLIFY(v7d_tmp%dativar%i)
10674 ENDIF
10675
10676! fondo con il volume definitivo
10677 CALL vol7d_merge(that, v7d_tmp)
10678ELSE
10680ENDIF
10681
10682
10683! Volume solo di dati byte
10684CALL vol7d_copy(this, v7d_tmp, &
10685 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=acn, lanavarc=fv, &
10686 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
10687 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
10688 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=tv, ldativarc=fv, &
10689 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
10690 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
10691
10692! converto a dati reali
10693IF (ASSOCIATED(v7d_tmp%anavar%b) .OR. ASSOCIATED(v7d_tmp%dativar%b)) THEN
10694
10695 IF (ASSOCIATED(v7d_tmp%anavar%b)) THEN
10696! alloco i dati reali e vi trasferisco i byte
10697 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanab, 1), SIZE(v7d_tmp%volanab, 2), &
10698 SIZE(v7d_tmp%volanab, 3)))
10699 DO i = 1, SIZE(v7d_tmp%anavar%b)
10700 v7d_tmp%volanar(:,i,:) = &
10701 realdat(v7d_tmp%volanab(:,i,:), v7d_tmp%anavar%b(i))
10702 ENDDO
10703 DEALLOCATE(v7d_tmp%volanab)
10704! trasferisco le variabili
10705 v7d_tmp%anavar%r => v7d_tmp%anavar%b
10706 NULLIFY(v7d_tmp%anavar%b)
10707 ENDIF
10708
10709 IF (ASSOCIATED(v7d_tmp%dativar%b)) THEN
10710! alloco i dati reali e vi trasferisco i byte
10711 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatib, 1), SIZE(v7d_tmp%voldatib, 2), &
10712 SIZE(v7d_tmp%voldatib, 3), SIZE(v7d_tmp%voldatib, 4), SIZE(v7d_tmp%voldatib, 5), &
10713 SIZE(v7d_tmp%voldatib, 6)))
10714 DO i = 1, SIZE(v7d_tmp%dativar%b)
10715 v7d_tmp%voldatir(:,:,:,:,i,:) = &
10716 realdat(v7d_tmp%voldatib(:,:,:,:,i,:), v7d_tmp%dativar%b(i))
10717 ENDDO
10718 DEALLOCATE(v7d_tmp%voldatib)
10719! trasferisco le variabili
10720 v7d_tmp%dativar%r => v7d_tmp%dativar%b
10721 NULLIFY(v7d_tmp%dativar%b)
10722 ENDIF
10723
10724! fondo con il volume definitivo
10725 CALL vol7d_merge(that, v7d_tmp)
10726ELSE
10728ENDIF
10729
10730
10731! Volume solo di dati character
10732CALL vol7d_copy(this, v7d_tmp, &
10733 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=fv, lanavarc=acn, &
10734 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
10735 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
10736 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=tv, &
10737 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
10738 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
10739
10740! converto a dati reali
10741IF (ASSOCIATED(v7d_tmp%anavar%c) .OR. ASSOCIATED(v7d_tmp%dativar%c)) THEN
10742
10743 IF (ASSOCIATED(v7d_tmp%anavar%c)) THEN
10744! alloco i dati reali e vi trasferisco i character
10745 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanac, 1), SIZE(v7d_tmp%volanac, 2), &
10746 SIZE(v7d_tmp%volanac, 3)))
10747 DO i = 1, SIZE(v7d_tmp%anavar%c)
10748 v7d_tmp%volanar(:,i,:) = &
10749 realdat(v7d_tmp%volanac(:,i,:), v7d_tmp%anavar%c(i))
10750 ENDDO
10751 DEALLOCATE(v7d_tmp%volanac)
10752! trasferisco le variabili
10753 v7d_tmp%anavar%r => v7d_tmp%anavar%c
10754 NULLIFY(v7d_tmp%anavar%c)
10755 ENDIF
10756
10757 IF (ASSOCIATED(v7d_tmp%dativar%c)) THEN
10758! alloco i dati reali e vi trasferisco i character
10759 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatic, 1), SIZE(v7d_tmp%voldatic, 2), &
10760 SIZE(v7d_tmp%voldatic, 3), SIZE(v7d_tmp%voldatic, 4), SIZE(v7d_tmp%voldatic, 5), &
10761 SIZE(v7d_tmp%voldatic, 6)))
10762 DO i = 1, SIZE(v7d_tmp%dativar%c)
10763 v7d_tmp%voldatir(:,:,:,:,i,:) = &
10764 realdat(v7d_tmp%voldatic(:,:,:,:,i,:), v7d_tmp%dativar%c(i))
10765 ENDDO
10766 DEALLOCATE(v7d_tmp%voldatic)
10767! trasferisco le variabili
10768 v7d_tmp%dativar%r => v7d_tmp%dativar%c
10769 NULLIFY(v7d_tmp%dativar%c)
10770 ENDIF
10771
10772! fondo con il volume definitivo
10773 CALL vol7d_merge(that, v7d_tmp)
10774ELSE
10776ENDIF
10777
10778END SUBROUTINE vol7d_convr
10779
10780
10784SUBROUTINE vol7d_diff_only (this, that, data_only,ana)
10785TYPE(vol7d),INTENT(IN) :: this
10786TYPE(vol7d),INTENT(OUT) :: that
10787logical , optional, intent(in) :: data_only
10788logical , optional, intent(in) :: ana
10789logical :: ldata_only,lana
10790
10791IF (PRESENT(data_only)) THEN
10792 ldata_only = data_only
10793ELSE
10794 ldata_only = .false.
10795ENDIF
10796
10797IF (PRESENT(ana)) THEN
10798 lana = ana
10799ELSE
10800 lana = .false.
10801ENDIF
10802
10803
10804#undef VOL7D_POLY_ARRAY
10805#define VOL7D_POLY_ARRAY voldati
10806#include "vol7d_class_diff.F90"
10807#undef VOL7D_POLY_ARRAY
10808#define VOL7D_POLY_ARRAY voldatiattr
10809#include "vol7d_class_diff.F90"
10810#undef VOL7D_POLY_ARRAY
10811
10812if ( .not. ldata_only) then
10813
10814#define VOL7D_POLY_ARRAY volana
10815#include "vol7d_class_diff.F90"
10816#undef VOL7D_POLY_ARRAY
10817#define VOL7D_POLY_ARRAY volanaattr
10818#include "vol7d_class_diff.F90"
10819#undef VOL7D_POLY_ARRAY
10820
10821 if(lana)then
10822 where ( this%ana == that%ana )
10823 that%ana = vol7d_ana_miss
10824 end where
10825 end if
10826
10827end if
10828
10829
10830
10831END SUBROUTINE vol7d_diff_only
10832
10833
10834
10835! Creo le routine da ripetere per i vari tipi di dati di v7d
10836! tramite un template e il preprocessore
10837#undef VOL7D_POLY_TYPE
10838#undef VOL7D_POLY_TYPES
10839#define VOL7D_POLY_TYPE REAL
10840#define VOL7D_POLY_TYPES r
10841#include "vol7d_class_type_templ.F90"
10842#undef VOL7D_POLY_TYPE
10843#undef VOL7D_POLY_TYPES
10844#define VOL7D_POLY_TYPE DOUBLE PRECISION
10845#define VOL7D_POLY_TYPES d
10846#include "vol7d_class_type_templ.F90"
10847#undef VOL7D_POLY_TYPE
10848#undef VOL7D_POLY_TYPES
10849#define VOL7D_POLY_TYPE INTEGER
10850#define VOL7D_POLY_TYPES i
10851#include "vol7d_class_type_templ.F90"
10852#undef VOL7D_POLY_TYPE
10853#undef VOL7D_POLY_TYPES
10854#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
10855#define VOL7D_POLY_TYPES b
10856#include "vol7d_class_type_templ.F90"
10857#undef VOL7D_POLY_TYPE
10858#undef VOL7D_POLY_TYPES
10859#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
10860#define VOL7D_POLY_TYPES c
10861#include "vol7d_class_type_templ.F90"
10862
10863! Creo le routine da ripetere per i vari descrittori di dimensioni di v7d
10864! tramite un template e il preprocessore
10865#define VOL7D_SORT
10866#undef VOL7D_NO_ZERO_ALLOC
10867#undef VOL7D_POLY_TYPE
10868#define VOL7D_POLY_TYPE datetime
10869#include "vol7d_class_desc_templ.F90"
10870#undef VOL7D_POLY_TYPE
10871#define VOL7D_POLY_TYPE vol7d_timerange
10872#include "vol7d_class_desc_templ.F90"
10873#undef VOL7D_POLY_TYPE
10874#define VOL7D_POLY_TYPE vol7d_level
10875#include "vol7d_class_desc_templ.F90"
10876#undef VOL7D_SORT
10877#undef VOL7D_POLY_TYPE
10878#define VOL7D_POLY_TYPE vol7d_network
10879#include "vol7d_class_desc_templ.F90"
10880#undef VOL7D_POLY_TYPE
10881#define VOL7D_POLY_TYPE vol7d_ana
10882#include "vol7d_class_desc_templ.F90"
10883#define VOL7D_NO_ZERO_ALLOC
10884#undef VOL7D_POLY_TYPE
10885#define VOL7D_POLY_TYPE vol7d_var
10886#include "vol7d_class_desc_templ.F90"
10887
10897subroutine vol7d_write_on_file (this,unit,description,filename,filename_auto)
10898
10899TYPE(vol7d),INTENT(IN) :: this
10900integer,optional,intent(inout) :: unit
10901character(len=*),intent(in),optional :: filename
10902character(len=*),intent(out),optional :: filename_auto
10903character(len=*),INTENT(IN),optional :: description
10904
10905integer :: lunit
10906character(len=254) :: ldescription,arg,lfilename
10907integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
10908 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
10909 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
10910 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
10911 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
10912 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
10913 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
10914!integer :: im,id,iy
10915integer :: tarray(8)
10916logical :: opened,exist
10917
10918 nana=0
10919 ntime=0
10920 ntimerange=0
10921 nlevel=0
10922 nnetwork=0
10923 ndativarr=0
10924 ndativari=0
10925 ndativarb=0
10926 ndativard=0
10927 ndativarc=0
10928 ndatiattrr=0
10929 ndatiattri=0
10930 ndatiattrb=0
10931 ndatiattrd=0
10932 ndatiattrc=0
10933 ndativarattrr=0
10934 ndativarattri=0
10935 ndativarattrb=0
10936 ndativarattrd=0
10937 ndativarattrc=0
10938 nanavarr=0
10939 nanavari=0
10940 nanavarb=0
10941 nanavard=0
10942 nanavarc=0
10943 nanaattrr=0
10944 nanaattri=0
10945 nanaattrb=0
10946 nanaattrd=0
10947 nanaattrc=0
10948 nanavarattrr=0
10949 nanavarattri=0
10950 nanavarattrb=0
10951 nanavarattrd=0
10952 nanavarattrc=0
10953
10954
10955!call idate(im,id,iy)
10956call date_and_time(values=tarray)
10957call getarg(0,arg)
10958
10959if (present(description))then
10960 ldescription=description
10961else
10962 ldescription="Vol7d generated by: "//trim(arg)
10963end if
10964
10965if (.not. present(unit))then
10966 lunit=getunit()
10967else
10968 if (unit==0)then
10969 lunit=getunit()
10970 unit=lunit
10971 else
10972 lunit=unit
10973 end if
10974end if
10975
10976lfilename=trim(arg)//".v7d"
10978
10979if (present(filename))then
10980 if (filename /= "")then
10981 lfilename=filename
10982 end if
10983end if
10984
10985if (present(filename_auto))filename_auto=lfilename
10986
10987
10988inquire(unit=lunit,opened=opened)
10989if (.not. opened) then
10990! inquire(file=lfilename, EXIST=exist)
10991! IF (exist) THEN
10992! CALL l4f_log(L4F_FATAL, &
10993! 'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename))
10994! CALL raise_fatal_error()
10995! ENDIF
10996 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM')
10997 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
10998end if
10999
11000if (associated(this%ana)) nana=size(this%ana)
11001if (associated(this%time)) ntime=size(this%time)
11002if (associated(this%timerange)) ntimerange=size(this%timerange)
11003if (associated(this%level)) nlevel=size(this%level)
11004if (associated(this%network)) nnetwork=size(this%network)
11005
11006if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
11007if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
11008if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
11009if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
11010if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
11011
11012if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
11013if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
11014if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
11015if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
11016if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)
11017
11018if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
11019if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
11020if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
11021if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
11022if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
11023
11024if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
11025if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
11026if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
11027if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
11028if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
11029
11030if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
11031if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
11032if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
11033if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
11034if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)
11035
11036if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
11037if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
11038if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
11039if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
11040if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)
11041
11042write(unit=lunit)ldescription
11043write(unit=lunit)tarray
11044
11045write(unit=lunit)&
11046 nana, ntime, ntimerange, nlevel, nnetwork, &
11047 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
11048 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
11049 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
11050 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
11051 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
11052 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
11053 this%time_definition
11054
11055
11056!write(unit=lunit)this
11057
11058
11059!! prime 5 dimensioni
11062if (associated(this%level)) write(unit=lunit)this%level
11063if (associated(this%timerange)) write(unit=lunit)this%timerange
11064if (associated(this%network)) write(unit=lunit)this%network
11065
11066 !! 6a dimensione: variabile dell'anagrafica e dei dati
11067 !! con relativi attributi e in 5 tipi diversi
11068
11069if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r
11070if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i
11071if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b
11072if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d
11073if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c
11074
11075if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r
11076if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i
11077if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b
11078if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d
11079if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c
11080
11081if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r
11082if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i
11083if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b
11084if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d
11085if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c
11086
11087if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r
11088if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i
11089if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b
11090if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d
11091if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c
11092
11093if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r
11094if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i
11095if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b
11096if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d
11097if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c
11098
11099if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
11100if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
11101if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
11102if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
11103if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c
11104
11105!! Volumi di valori e attributi per anagrafica e dati
11106
11107if (associated(this%volanar)) write(unit=lunit)this%volanar
11108if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr
11109if (associated(this%voldatir)) write(unit=lunit)this%voldatir
11110if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr
11111
11112if (associated(this%volanai)) write(unit=lunit)this%volanai
11113if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri
11114if (associated(this%voldatii)) write(unit=lunit)this%voldatii
11115if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri
11116
11117if (associated(this%volanab)) write(unit=lunit)this%volanab
11118if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb
11119if (associated(this%voldatib)) write(unit=lunit)this%voldatib
11120if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb
11121
11122if (associated(this%volanad)) write(unit=lunit)this%volanad
11123if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd
11124if (associated(this%voldatid)) write(unit=lunit)this%voldatid
11125if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd
11126
11127if (associated(this%volanac)) write(unit=lunit)this%volanac
11128if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc
11129if (associated(this%voldatic)) write(unit=lunit)this%voldatic
11130if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc
11131
11132if (.not. present(unit)) close(unit=lunit)
11133
11134end subroutine vol7d_write_on_file
11135
11136
11143
11144
11145subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
11146
11147TYPE(vol7d),INTENT(OUT) :: this
11148integer,intent(inout),optional :: unit
11149character(len=*),INTENT(in),optional :: filename
11150character(len=*),intent(out),optional :: filename_auto
11151character(len=*),INTENT(out),optional :: description
11152integer,intent(out),optional :: tarray(8)
11153
11154
11155integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
11156 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
11157 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
11158 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
11159 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
11160 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
11161 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
11162
11163character(len=254) :: ldescription,lfilename,arg
11164integer :: ltarray(8),lunit,ios
11165logical :: opened,exist
11166
11167
11168call getarg(0,arg)
11169
11170if (.not. present(unit))then
11171 lunit=getunit()
11172else
11173 if (unit==0)then
11174 lunit=getunit()
11175 unit=lunit
11176 else
11177 lunit=unit
11178 end if
11179end if
11180
11181lfilename=trim(arg)//".v7d"
11183
11184if (present(filename))then
11185 if (filename /= "")then
11186 lfilename=filename
11187 end if
11188end if
11189
11190if (present(filename_auto))filename_auto=lfilename
11191
11192
11193inquire(unit=lunit,opened=opened)
11194IF (.NOT. opened) THEN
11195 inquire(file=lfilename,exist=exist)
11196 IF (.NOT.exist) THEN
11197 CALL l4f_log(l4f_fatal, &
11198 'in vol7d_read_from_file, file does not exists, cannot open')
11199 CALL raise_fatal_error()
11200 ENDIF
11201 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM', &
11202 status='OLD', action='READ')
11203 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
11204end if
11205
11206
11208read(unit=lunit,iostat=ios)ldescription
11209
11210if (ios < 0) then ! A negative value indicates that the End of File or End of Record
11211 call vol7d_alloc (this)
11212 call vol7d_alloc_vol (this)
11213 if (present(description))description=ldescription
11214 if (present(tarray))tarray=ltarray
11215 if (.not. present(unit)) close(unit=lunit)
11216end if
11217
11218read(unit=lunit)ltarray
11219
11220CALL l4f_log(l4f_info, 'Reading vol7d from file')
11221CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
11224
11225if (present(description))description=ldescription
11226if (present(tarray))tarray=ltarray
11227
11228read(unit=lunit)&
11229 nana, ntime, ntimerange, nlevel, nnetwork, &
11230 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
11231 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
11232 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
11233 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
11234 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
11235 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
11236 this%time_definition
11237
11238call vol7d_alloc (this, &
11239 nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,&
11240 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,&
11241 ndativard=ndativard, ndativarc=ndativarc,&
11242 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,&
11243 ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
11244 ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, &
11245 ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,&
11246 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, &
11247 nanavard=nanavard, nanavarc=nanavarc,&
11248 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,&
11249 nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
11250 nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, &
11251 nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc)
11252
11253
11256if (associated(this%level)) read(unit=lunit)this%level
11257if (associated(this%timerange)) read(unit=lunit)this%timerange
11258if (associated(this%network)) read(unit=lunit)this%network
11259
11260if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r
11261if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i
11262if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b
11263if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d
11264if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c
11265
11266if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r
11267if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i
11268if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b
11269if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d
11270if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c
11271
11272if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r
11273if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i
11274if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b
11275if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d
11276if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c
11277
11278if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r
11279if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i
11280if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b
11281if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d
11282if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c
11283
11284if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r
11285if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i
11286if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b
11287if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d
11288if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c
11289
11290if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
11291if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
11292if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
11293if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
11294if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c
11295
11296call vol7d_alloc_vol (this)
11297
11298!! Volumi di valori e attributi per anagrafica e dati
11299
11300if (associated(this%volanar)) read(unit=lunit)this%volanar
11301if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr
11302if (associated(this%voldatir)) read(unit=lunit)this%voldatir
11303if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr
11304
11305if (associated(this%volanai)) read(unit=lunit)this%volanai
11306if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri
11307if (associated(this%voldatii)) read(unit=lunit)this%voldatii
11308if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri
11309
11310if (associated(this%volanab)) read(unit=lunit)this%volanab
11311if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb
11312if (associated(this%voldatib)) read(unit=lunit)this%voldatib
11313if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb
11314
11315if (associated(this%volanad)) read(unit=lunit)this%volanad
11316if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd
11317if (associated(this%voldatid)) read(unit=lunit)this%voldatid
11318if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd
11319
11320if (associated(this%volanac)) read(unit=lunit)this%volanac
11321if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc
11322if (associated(this%voldatic)) read(unit=lunit)this%voldatic
11323if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc
11324
11325if (.not. present(unit)) close(unit=lunit)
11326
11327end subroutine vol7d_read_from_file
11328
11329
11330! to double precision
11331elemental doubleprecision function doubledatd(voldat,var)
11332doubleprecision,intent(in) :: voldat
11333type(vol7d_var),intent(in) :: var
11334
11335doubledatd=voldat
11336
11337end function doubledatd
11338
11339
11340elemental doubleprecision function doubledatr(voldat,var)
11341real,intent(in) :: voldat
11342type(vol7d_var),intent(in) :: var
11343
11345 doubledatr=dble(voldat)
11346else
11347 doubledatr=dmiss
11348end if
11349
11350end function doubledatr
11351
11352
11353elemental doubleprecision function doubledati(voldat,var)
11354integer,intent(in) :: voldat
11355type(vol7d_var),intent(in) :: var
11356
11359 doubledati=dble(voldat)/10.d0**var%scalefactor
11360 else
11361 doubledati=dble(voldat)
11362 endif
11363else
11364 doubledati=dmiss
11365end if
11366
11367end function doubledati
11368
11369
11370elemental doubleprecision function doubledatb(voldat,var)
11371integer(kind=int_b),intent(in) :: voldat
11372type(vol7d_var),intent(in) :: var
11373
11376 doubledatb=dble(voldat)/10.d0**var%scalefactor
11377 else
11378 doubledatb=dble(voldat)
11379 endif
11380else
11381 doubledatb=dmiss
11382end if
11383
11384end function doubledatb
11385
11386
11387elemental doubleprecision function doubledatc(voldat,var)
11388CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
11389type(vol7d_var),intent(in) :: var
11390
11391doubledatc = c2d(voldat)
11393 doubledatc=doubledatc/10.d0**var%scalefactor
11394end if
11395
11396end function doubledatc
11397
11398
11399! to integer
11400elemental integer function integerdatd(voldat,var)
11401doubleprecision,intent(in) :: voldat
11402type(vol7d_var),intent(in) :: var
11403
11406 integerdatd=nint(voldat*10d0**var%scalefactor)
11407 else
11408 integerdatd=nint(voldat)
11409 endif
11410else
11411 integerdatd=imiss
11412end if
11413
11414end function integerdatd
11415
11416
11417elemental integer function integerdatr(voldat,var)
11418real,intent(in) :: voldat
11419type(vol7d_var),intent(in) :: var
11420
11423 integerdatr=nint(voldat*10d0**var%scalefactor)
11424 else
11425 integerdatr=nint(voldat)
11426 endif
11427else
11428 integerdatr=imiss
11429end if
11430
11431end function integerdatr
11432
11433
11434elemental integer function integerdati(voldat,var)
11435integer,intent(in) :: voldat
11436type(vol7d_var),intent(in) :: var
11437
11438integerdati=voldat
11439
11440end function integerdati
11441
11442
11443elemental integer function integerdatb(voldat,var)
11444integer(kind=int_b),intent(in) :: voldat
11445type(vol7d_var),intent(in) :: var
11446
11448 integerdatb=voldat
11449else
11450 integerdatb=imiss
11451end if
11452
11453end function integerdatb
11454
11455
11456elemental integer function integerdatc(voldat,var)
11457CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
11458type(vol7d_var),intent(in) :: var
11459
11460integerdatc=c2i(voldat)
11461
11462end function integerdatc
11463
11464
11465! to real
11466elemental real function realdatd(voldat,var)
11467doubleprecision,intent(in) :: voldat
11468type(vol7d_var),intent(in) :: var
11469
11471 realdatd=real(voldat)
11472else
11473 realdatd=rmiss
11474end if
11475
11476end function realdatd
11477
11478
11479elemental real function realdatr(voldat,var)
11480real,intent(in) :: voldat
11481type(vol7d_var),intent(in) :: var
11482
11483realdatr=voldat
11484
11485end function realdatr
11486
11487
11488elemental real function realdati(voldat,var)
11489integer,intent(in) :: voldat
11490type(vol7d_var),intent(in) :: var
11491
11494 realdati=float(voldat)/10.**var%scalefactor
11495 else
11496 realdati=float(voldat)
11497 endif
11498else
11499 realdati=rmiss
11500end if
11501
11502end function realdati
11503
11504
11505elemental real function realdatb(voldat,var)
11506integer(kind=int_b),intent(in) :: voldat
11507type(vol7d_var),intent(in) :: var
11508
11511 realdatb=float(voldat)/10**var%scalefactor
11512 else
11513 realdatb=float(voldat)
11514 endif
11515else
11516 realdatb=rmiss
11517end if
11518
11519end function realdatb
11520
11521
11522elemental real function realdatc(voldat,var)
11523CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
11524type(vol7d_var),intent(in) :: var
11525
11526realdatc=c2r(voldat)
11528 realdatc=realdatc/10.**var%scalefactor
11529end if
11530
11531end function realdatc
11532
11533
11539FUNCTION realanavol(this, var) RESULT(vol)
11540TYPE(vol7d),INTENT(in) :: this
11541TYPE(vol7d_var),INTENT(in) :: var
11542REAL :: vol(SIZE(this%ana),size(this%network))
11543
11544CHARACTER(len=1) :: dtype
11545INTEGER :: indvar
11546
11547dtype = cmiss
11548indvar = index(this%anavar, var, type=dtype)
11549
11550IF (indvar > 0) THEN
11551 SELECT CASE (dtype)
11552 CASE("d")
11553 vol = realdat(this%volanad(:,indvar,:), var)
11554 CASE("r")
11555 vol = this%volanar(:,indvar,:)
11556 CASE("i")
11557 vol = realdat(this%volanai(:,indvar,:), var)
11558 CASE("b")
11559 vol = realdat(this%volanab(:,indvar,:), var)
11560 CASE("c")
11561 vol = realdat(this%volanac(:,indvar,:), var)
11562 CASE default
11563 vol = rmiss
11564 END SELECT
11565ELSE
11566 vol = rmiss
11567ENDIF
11568
11569END FUNCTION realanavol
11570
11571
11577FUNCTION integeranavol(this, var) RESULT(vol)
11578TYPE(vol7d),INTENT(in) :: this
11579TYPE(vol7d_var),INTENT(in) :: var
11580INTEGER :: vol(SIZE(this%ana),size(this%network))
11581
11582CHARACTER(len=1) :: dtype
11583INTEGER :: indvar
11584
11585dtype = cmiss
11586indvar = index(this%anavar, var, type=dtype)
11587
11588IF (indvar > 0) THEN
11589 SELECT CASE (dtype)
11590 CASE("d")
11591 vol = integerdat(this%volanad(:,indvar,:), var)
11592 CASE("r")
11593 vol = integerdat(this%volanar(:,indvar,:), var)
11594 CASE("i")
11595 vol = this%volanai(:,indvar,:)
11596 CASE("b")
11597 vol = integerdat(this%volanab(:,indvar,:), var)
11598 CASE("c")
11599 vol = integerdat(this%volanac(:,indvar,:), var)
11600 CASE default
11601 vol = imiss
11602 END SELECT
11603ELSE
11604 vol = imiss
11605ENDIF
11606
11607END FUNCTION integeranavol
11608
11609
11615subroutine move_datac (v7d,&
11616 indana,indtime,indlevel,indtimerange,indnetwork,&
11617 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
11618
11619TYPE(vol7d),intent(inout) :: v7d
11620
11621integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
11622integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
11623integer :: inddativar,inddativarattr
11624
11625
11626do inddativar=1,size(v7d%dativar%c)
11627
11629 .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
11630 ) then
11631
11632 ! dati
11633 v7d%voldatic &
11634 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
11635 v7d%voldatic &
11636 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
11637
11638
11639 ! attributi
11640 if (associated (v7d%dativarattr%i)) then
11641 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
11642 if (inddativarattr > 0 ) then
11643 v7d%voldatiattri &
11644 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11645 v7d%voldatiattri &
11646 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11647 end if
11648 end if
11649
11650 if (associated (v7d%dativarattr%r)) then
11651 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
11652 if (inddativarattr > 0 ) then
11653 v7d%voldatiattrr &
11654 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11655 v7d%voldatiattrr &
11656 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11657 end if
11658 end if
11659
11660 if (associated (v7d%dativarattr%d)) then
11661 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
11662 if (inddativarattr > 0 ) then
11663 v7d%voldatiattrd &
11664 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11665 v7d%voldatiattrd &
11666 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11667 end if
11668 end if
11669
11670 if (associated (v7d%dativarattr%b)) then
11671 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
11672 if (inddativarattr > 0 ) then
11673 v7d%voldatiattrb &
11674 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11675 v7d%voldatiattrb &
11676 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11677 end if
11678 end if
11679
11680 if (associated (v7d%dativarattr%c)) then
11681 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
11682 if (inddativarattr > 0 ) then
11683 v7d%voldatiattrc &
11684 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11685 v7d%voldatiattrc &
11686 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11687 end if
11688 end if
11689
11690 end if
11691
11692end do
11693
11694end subroutine move_datac
11695
11701subroutine move_datar (v7d,&
11702 indana,indtime,indlevel,indtimerange,indnetwork,&
11703 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
11704
11705TYPE(vol7d),intent(inout) :: v7d
11706
11707integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
11708integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
11709integer :: inddativar,inddativarattr
11710
11711
11712do inddativar=1,size(v7d%dativar%r)
11713
11715 .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
11716 ) then
11717
11718 ! dati
11719 v7d%voldatir &
11720 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
11721 v7d%voldatir &
11722 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
11723
11724
11725 ! attributi
11726 if (associated (v7d%dativarattr%i)) then
11727 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
11728 if (inddativarattr > 0 ) then
11729 v7d%voldatiattri &
11730 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11731 v7d%voldatiattri &
11732 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11733 end if
11734 end if
11735
11736 if (associated (v7d%dativarattr%r)) then
11737 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%r(inddativar))
11738 if (inddativarattr > 0 ) then
11739 v7d%voldatiattrr &
11740 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11741 v7d%voldatiattrr &
11742 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11743 end if
11744 end if
11745
11746 if (associated (v7d%dativarattr%d)) then
11747 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%r(inddativar))
11748 if (inddativarattr > 0 ) then
11749 v7d%voldatiattrd &
11750 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11751 v7d%voldatiattrd &
11752 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11753 end if
11754 end if
11755
11756 if (associated (v7d%dativarattr%b)) then
11757 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%r(inddativar))
11758 if (inddativarattr > 0 ) then
11759 v7d%voldatiattrb &
11760 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11761 v7d%voldatiattrb &
11762 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11763 end if
11764 end if
11765
11766 if (associated (v7d%dativarattr%c)) then
11767 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%r(inddativar))
11768 if (inddativarattr > 0 ) then
11769 v7d%voldatiattrc &
11770 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11771 v7d%voldatiattrc &
11772 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11773 end if
11774 end if
11775
11776 end if
11777
11778end do
11779
11780end subroutine move_datar
11781
11782
11796subroutine v7d_rounding(v7din,v7dout,level,timerange,nostatproc)
11797type(vol7d),intent(inout) :: v7din
11798type(vol7d),intent(out) :: v7dout
11799type(vol7d_level),intent(in),optional :: level(:)
11800type(vol7d_timerange),intent(in),optional :: timerange(:)
11801!logical,intent(in),optional :: merge !< if there are data on more then one almost equal levels or timeranges
11802!! will be merged POINT BY POINT with priority for the fird data found ordered by icreasing var index
11803logical,intent(in),optional :: nostatproc
11804
11805integer :: nana,nlevel,ntime,ntimerange,nnetwork,nbin
11806integer :: iana,ilevel,itimerange,indl,indt,itime,inetwork
11807type(vol7d_level) :: roundlevel(size(v7din%level))
11808type(vol7d_timerange) :: roundtimerange(size(v7din%timerange))
11809type(vol7d) :: v7d_tmp
11810
11811
11812nbin=0
11813
11814if (associated(v7din%dativar%r)) nbin = nbin + size(v7din%dativar%r)
11815if (associated(v7din%dativar%i)) nbin = nbin + size(v7din%dativar%i)
11816if (associated(v7din%dativar%d)) nbin = nbin + size(v7din%dativar%d)
11817if (associated(v7din%dativar%b)) nbin = nbin + size(v7din%dativar%b)
11818
11820
11821roundlevel=v7din%level
11822
11823if (present(level))then
11824 do ilevel = 1, size(v7din%level)
11825 if ((any(v7din%level(ilevel) .almosteq. level))) then
11826 roundlevel(ilevel)=level(1)
11827 end if
11828 end do
11829end if
11830
11831roundtimerange=v7din%timerange
11832
11833if (present(timerange))then
11834 do itimerange = 1, size(v7din%timerange)
11835 if ((any(v7din%timerange(itimerange) .almosteq. timerange))) then
11836 roundtimerange(itimerange)=timerange(1)
11837 end if
11838 end do
11839end if
11840
11841!set istantaneous values everywere
11842!preserve p1 for forecast time
11843if (optio_log(nostatproc)) then
11844 roundtimerange(:)%timerange=254
11845 roundtimerange(:)%p2=0
11846end if
11847
11848
11849nana=size(v7din%ana)
11850nlevel=count_distinct(roundlevel,back=.true.)
11851ntime=size(v7din%time)
11852ntimerange=count_distinct(roundtimerange,back=.true.)
11853nnetwork=size(v7din%network)
11854
11856
11857if (nbin == 0) then
11859else
11860 call vol7d_convr(v7din,v7d_tmp)
11861end if
11862
11863v7d_tmp%level=roundlevel
11864v7d_tmp%timerange=roundtimerange
11865
11866do ilevel=1, size(v7d_tmp%level)
11867 indl=index(v7d_tmp%level,roundlevel(ilevel))
11868 do itimerange=1,size(v7d_tmp%timerange)
11869 indt=index(v7d_tmp%timerange,roundtimerange(itimerange))
11870
11871 if (indl /= ilevel .or. indt /= itimerange) then
11872
11873 do iana=1, nana
11874 do itime=1,ntime
11875 do inetwork=1,nnetwork
11876
11877 if (nbin > 0) then
11878 call move_datar (v7d_tmp,&
11879 iana,itime,ilevel,itimerange,inetwork,&
11880 iana,itime,indl,indt,inetwork)
11881 else
11882 call move_datac (v7d_tmp,&
11883 iana,itime,ilevel,itimerange,inetwork,&
11884 iana,itime,indl,indt,inetwork)
11885 end if
11886
11887 end do
11888 end do
11889 end do
11890
11891 end if
11892
11893 end do
11894end do
11895
11896! set to missing level and time > nlevel
11897do ilevel=nlevel+1,size(v7d_tmp%level)
11899end do
11900
11901do itimerange=ntimerange+1,size(v7d_tmp%timerange)
11903end do
11904
11905!copy with remove
11908
11909!call display(v7dout)
11910
11911end subroutine v7d_rounding
11912
11913
11915
11921
11922
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 |