libsim Versione 7.1.11
|
◆ vol7d_read_from_file()
Lettura da file di un volume Vol7d. Lettura da file unformatted di un intero volume Vol7d. Questa subroutine comprende vol7d_alloc e vol7d_alloc_vol. 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.
Definizione alla linea 8722 del file vol7d_class.F90. 8723! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
8724! authors:
8725! Davide Cesari <dcesari@arpa.emr.it>
8726! Paolo Patruno <ppatruno@arpa.emr.it>
8727
8728! This program is free software; you can redistribute it and/or
8729! modify it under the terms of the GNU General Public License as
8730! published by the Free Software Foundation; either version 2 of
8731! the License, or (at your option) any later version.
8732
8733! This program is distributed in the hope that it will be useful,
8734! but WITHOUT ANY WARRANTY; without even the implied warranty of
8735! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
8736! GNU General Public License for more details.
8737
8738! You should have received a copy of the GNU General Public License
8739! along with this program. If not, see <http://www.gnu.org/licenses/>.
8740#include "config.h"
8741
8753
8821IMPLICIT NONE
8822
8823
8824INTEGER, PARAMETER :: vol7d_maxdim_a = 3, vol7d_maxdim_aa = 4, &
8825 vol7d_maxdim_d = 6, vol7d_maxdim_ad = 7
8826
8827INTEGER, PARAMETER :: vol7d_ana_a=1
8828INTEGER, PARAMETER :: vol7d_var_a=2
8829INTEGER, PARAMETER :: vol7d_network_a=3
8830INTEGER, PARAMETER :: vol7d_attr_a=4
8831INTEGER, PARAMETER :: vol7d_ana_d=1
8832INTEGER, PARAMETER :: vol7d_time_d=2
8833INTEGER, PARAMETER :: vol7d_level_d=3
8834INTEGER, PARAMETER :: vol7d_timerange_d=4
8835INTEGER, PARAMETER :: vol7d_var_d=5
8836INTEGER, PARAMETER :: vol7d_network_d=6
8837INTEGER, PARAMETER :: vol7d_attr_d=7
8838INTEGER, PARAMETER :: vol7d_cdatalen=32
8839
8840TYPE vol7d_varmap
8841 INTEGER :: r, d, i, b, c
8842END TYPE vol7d_varmap
8843
8848 TYPE(vol7d_ana),POINTER :: ana(:)
8850 TYPE(datetime),POINTER :: time(:)
8852 TYPE(vol7d_level),POINTER :: level(:)
8854 TYPE(vol7d_timerange),POINTER :: timerange(:)
8856 TYPE(vol7d_network),POINTER :: network(:)
8858 TYPE(vol7d_varvect) :: anavar
8860 TYPE(vol7d_varvect) :: anaattr
8862 TYPE(vol7d_varvect) :: anavarattr
8864 TYPE(vol7d_varvect) :: dativar
8866 TYPE(vol7d_varvect) :: datiattr
8868 TYPE(vol7d_varvect) :: dativarattr
8869
8871 REAL,POINTER :: volanar(:,:,:)
8873 DOUBLE PRECISION,POINTER :: volanad(:,:,:)
8875 INTEGER,POINTER :: volanai(:,:,:)
8877 INTEGER(kind=int_b),POINTER :: volanab(:,:,:)
8879 CHARACTER(len=vol7d_cdatalen),POINTER :: volanac(:,:,:)
8880
8882 REAL,POINTER :: volanaattrr(:,:,:,:)
8884 DOUBLE PRECISION,POINTER :: volanaattrd(:,:,:,:)
8886 INTEGER,POINTER :: volanaattri(:,:,:,:)
8888 INTEGER(kind=int_b),POINTER :: volanaattrb(:,:,:,:)
8890 CHARACTER(len=vol7d_cdatalen),POINTER :: volanaattrc(:,:,:,:)
8891
8893 REAL,POINTER :: voldatir(:,:,:,:,:,:) ! sono i dati
8895 DOUBLE PRECISION,POINTER :: voldatid(:,:,:,:,:,:)
8897 INTEGER,POINTER :: voldatii(:,:,:,:,:,:)
8899 INTEGER(kind=int_b),POINTER :: voldatib(:,:,:,:,:,:)
8901 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatic(:,:,:,:,:,:)
8902
8904 REAL,POINTER :: voldatiattrr(:,:,:,:,:,:,:)
8906 DOUBLE PRECISION,POINTER :: voldatiattrd(:,:,:,:,:,:,:)
8908 INTEGER,POINTER :: voldatiattri(:,:,:,:,:,:,:)
8910 INTEGER(kind=int_b),POINTER :: voldatiattrb(:,:,:,:,:,:,:)
8912 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatiattrc(:,:,:,:,:,:,:)
8913
8915 integer :: time_definition
8916
8918
8923 MODULE PROCEDURE vol7d_init
8924END INTERFACE
8925
8928 MODULE PROCEDURE vol7d_delete
8929END INTERFACE
8930
8933 MODULE PROCEDURE vol7d_write_on_file
8934END INTERFACE
8935
8937INTERFACE import
8938 MODULE PROCEDURE vol7d_read_from_file
8939END INTERFACE
8940
8943 MODULE PROCEDURE vol7d_display, dat_display, dat_vect_display
8944END INTERFACE
8945
8948 MODULE PROCEDURE to_char_dat
8949END INTERFACE
8950
8953 MODULE PROCEDURE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
8954END INTERFACE
8955
8958 MODULE PROCEDURE realdatd,realdatr,realdati,realdatb,realdatc
8959END INTERFACE
8960
8963 MODULE PROCEDURE integerdatd,integerdatr,integerdati,integerdatb,integerdatc
8964END INTERFACE
8965
8968 MODULE PROCEDURE vol7d_copy
8969END INTERFACE
8970
8973 MODULE PROCEDURE vol7d_c_e
8974END INTERFACE
8975
8980 MODULE PROCEDURE vol7d_check
8981END INTERFACE
8982
8997 MODULE PROCEDURE v7d_rounding
8998END INTERFACE
8999
9000!!$INTERFACE get_volana
9001!!$ MODULE PROCEDURE vol7d_get_volanar, vol7d_get_volanad, vol7d_get_volanai, &
9002!!$ vol7d_get_volanab, vol7d_get_volanac
9003!!$END INTERFACE
9004!!$
9005!!$INTERFACE get_voldati
9006!!$ MODULE PROCEDURE vol7d_get_voldatir, vol7d_get_voldatid, vol7d_get_voldatii, &
9007!!$ vol7d_get_voldatib, vol7d_get_voldatic
9008!!$END INTERFACE
9009!!$
9010!!$INTERFACE get_volanaattr
9011!!$ MODULE PROCEDURE vol7d_get_volanaattrr, vol7d_get_volanaattrd, &
9012!!$ vol7d_get_volanaattri, vol7d_get_volanaattrb, vol7d_get_volanaattrc
9013!!$END INTERFACE
9014!!$
9015!!$INTERFACE get_voldatiattr
9016!!$ MODULE PROCEDURE vol7d_get_voldatiattrr, vol7d_get_voldatiattrd, &
9017!!$ vol7d_get_voldatiattri, vol7d_get_voldatiattrb, vol7d_get_voldatiattrc
9018!!$END INTERFACE
9019
9020PRIVATE vol7d_get_volr, vol7d_get_vold, vol7d_get_voli, vol7d_get_volb, &
9021 vol7d_get_volc, &
9022 volptr1dr, volptr2dr, volptr3dr, volptr4dr, volptr5dr, volptr6dr, volptr7dr, &
9023 volptr1dd, volptr2dd, volptr3dd, volptr4dd, volptr5dd, volptr6dd, volptr7dd, &
9024 volptr1di, volptr2di, volptr3di, volptr4di, volptr5di, volptr6di, volptr7di, &
9025 volptr1db, volptr2db, volptr3db, volptr4db, volptr5db, volptr6db, volptr7db, &
9026 volptr1dc, volptr2dc, volptr3dc, volptr4dc, volptr5dc, volptr6dc, volptr7dc, &
9027 vol7d_nullifyr, vol7d_nullifyd, vol7d_nullifyi, vol7d_nullifyb, vol7d_nullifyc, &
9028 vol7d_init, vol7d_delete, vol7d_write_on_file, vol7d_read_from_file, &
9029 vol7d_check_alloc_ana, vol7d_force_alloc_ana, &
9030 vol7d_check_alloc_dati, vol7d_force_alloc_dati, vol7d_force_alloc, &
9031 vol7d_display, dat_display, dat_vect_display, &
9032 to_char_dat, vol7d_check
9033
9034PRIVATE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
9035
9036PRIVATE vol7d_c_e
9037
9038CONTAINS
9039
9040
9045SUBROUTINE vol7d_init(this,time_definition)
9046TYPE(vol7d),intent(out) :: this
9047integer,INTENT(IN),OPTIONAL :: time_definition
9048
9055CALL vol7d_var_features_init() ! initialise var features table once
9056
9057NULLIFY(this%ana, this%time, this%level, this%timerange, this%network)
9058
9059NULLIFY(this%volanar, this%volanaattrr, this%voldatir, this%voldatiattrr)
9060NULLIFY(this%volanad, this%volanaattrd, this%voldatid, this%voldatiattrd)
9061NULLIFY(this%volanai, this%volanaattri, this%voldatii, this%voldatiattri)
9062NULLIFY(this%volanab, this%volanaattrb, this%voldatib, this%voldatiattrb)
9063NULLIFY(this%volanac, this%volanaattrc, this%voldatic, this%voldatiattrc)
9064
9065if(present(time_definition)) then
9066 this%time_definition=time_definition
9067else
9068 this%time_definition=1 !default to validity time
9069end if
9070
9071END SUBROUTINE vol7d_init
9072
9073
9077ELEMENTAL SUBROUTINE vol7d_delete(this, dataonly)
9078TYPE(vol7d),intent(inout) :: this
9079LOGICAL, INTENT(in), OPTIONAL :: dataonly
9080
9081
9082IF (.NOT. optio_log(dataonly)) THEN
9083 IF (ASSOCIATED(this%volanar)) DEALLOCATE(this%volanar)
9084 IF (ASSOCIATED(this%volanad)) DEALLOCATE(this%volanad)
9085 IF (ASSOCIATED(this%volanai)) DEALLOCATE(this%volanai)
9086 IF (ASSOCIATED(this%volanab)) DEALLOCATE(this%volanab)
9087 IF (ASSOCIATED(this%volanac)) DEALLOCATE(this%volanac)
9088 IF (ASSOCIATED(this%volanaattrr)) DEALLOCATE(this%volanaattrr)
9089 IF (ASSOCIATED(this%volanaattrd)) DEALLOCATE(this%volanaattrd)
9090 IF (ASSOCIATED(this%volanaattri)) DEALLOCATE(this%volanaattri)
9091 IF (ASSOCIATED(this%volanaattrb)) DEALLOCATE(this%volanaattrb)
9092 IF (ASSOCIATED(this%volanaattrc)) DEALLOCATE(this%volanaattrc)
9093ENDIF
9094IF (ASSOCIATED(this%voldatir)) DEALLOCATE(this%voldatir)
9095IF (ASSOCIATED(this%voldatid)) DEALLOCATE(this%voldatid)
9096IF (ASSOCIATED(this%voldatii)) DEALLOCATE(this%voldatii)
9097IF (ASSOCIATED(this%voldatib)) DEALLOCATE(this%voldatib)
9098IF (ASSOCIATED(this%voldatic)) DEALLOCATE(this%voldatic)
9099IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
9100IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
9101IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
9102IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
9103IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
9104
9105IF (.NOT. optio_log(dataonly)) THEN
9106 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
9107 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
9108ENDIF
9109IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
9110IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
9111IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
9112
9113IF (.NOT. optio_log(dataonly)) THEN
9117ENDIF
9121
9122END SUBROUTINE vol7d_delete
9123
9124
9125
9126integer function vol7d_check(this)
9127TYPE(vol7d),intent(in) :: this
9128integer :: i,j,k,l,m,n
9129
9130vol7d_check=0
9131
9132if (associated(this%voldatii)) then
9133do i = 1,size(this%voldatii,1)
9134 do j = 1,size(this%voldatii,2)
9135 do k = 1,size(this%voldatii,3)
9136 do l = 1,size(this%voldatii,4)
9137 do m = 1,size(this%voldatii,5)
9138 do n = 1,size(this%voldatii,6)
9139 if (this%voldatii(i,j,k,l,m,n) /= this%voldatii(i,j,k,l,m,n) ) then
9140 CALL l4f_log(l4f_warn,"check: abnormal value at voldatii("&
9142 vol7d_check=1
9143 end if
9144 end do
9145 end do
9146 end do
9147 end do
9148 end do
9149end do
9150end if
9151
9152
9153if (associated(this%voldatir)) then
9154do i = 1,size(this%voldatir,1)
9155 do j = 1,size(this%voldatir,2)
9156 do k = 1,size(this%voldatir,3)
9157 do l = 1,size(this%voldatir,4)
9158 do m = 1,size(this%voldatir,5)
9159 do n = 1,size(this%voldatir,6)
9160 if (this%voldatir(i,j,k,l,m,n) /= this%voldatir(i,j,k,l,m,n) ) then
9161 CALL l4f_log(l4f_warn,"check: abnormal value at voldatir("&
9163 vol7d_check=2
9164 end if
9165 end do
9166 end do
9167 end do
9168 end do
9169 end do
9170end do
9171end if
9172
9173if (associated(this%voldatid)) then
9174do i = 1,size(this%voldatid,1)
9175 do j = 1,size(this%voldatid,2)
9176 do k = 1,size(this%voldatid,3)
9177 do l = 1,size(this%voldatid,4)
9178 do m = 1,size(this%voldatid,5)
9179 do n = 1,size(this%voldatid,6)
9180 if (this%voldatid(i,j,k,l,m,n) /= this%voldatid(i,j,k,l,m,n) ) then
9181 CALL l4f_log(l4f_warn,"check: abnormal value at voldatid("&
9183 vol7d_check=3
9184 end if
9185 end do
9186 end do
9187 end do
9188 end do
9189 end do
9190end do
9191end if
9192
9193if (associated(this%voldatib)) then
9194do i = 1,size(this%voldatib,1)
9195 do j = 1,size(this%voldatib,2)
9196 do k = 1,size(this%voldatib,3)
9197 do l = 1,size(this%voldatib,4)
9198 do m = 1,size(this%voldatib,5)
9199 do n = 1,size(this%voldatib,6)
9200 if (this%voldatib(i,j,k,l,m,n) /= this%voldatib(i,j,k,l,m,n) ) then
9201 CALL l4f_log(l4f_warn,"check: abnormal value at voldatib("&
9203 vol7d_check=4
9204 end if
9205 end do
9206 end do
9207 end do
9208 end do
9209 end do
9210end do
9211end if
9212
9213end function vol7d_check
9214
9215
9216
9217!TODO da completare ! aborta se i volumi sono allocati a dimensione 0
9219SUBROUTINE vol7d_display(this)
9220TYPE(vol7d),intent(in) :: this
9221integer :: i
9222
9223REAL :: rdat
9224DOUBLE PRECISION :: ddat
9225INTEGER :: idat
9226INTEGER(kind=int_b) :: bdat
9227CHARACTER(len=vol7d_cdatalen) :: cdat
9228
9229
9230print*,"<<<<<<<<<<<<<<<<<<< vol7d object >>>>>>>>>>>>>>>>>>>>"
9231if (this%time_definition == 0) then
9232 print*,"TIME DEFINITION: time is reference time"
9233else if (this%time_definition == 1) then
9234 print*,"TIME DEFINITION: time is validity time"
9235else
9236 print*,"Time definition have a wrong walue:", this%time_definition
9237end if
9238
9239IF (ASSOCIATED(this%network))then
9240 print*,"---- network vector ----"
9241 print*,"elements=",size(this%network)
9242 do i=1, size(this%network)
9244 end do
9245end IF
9246
9247IF (ASSOCIATED(this%ana))then
9248 print*,"---- ana vector ----"
9249 print*,"elements=",size(this%ana)
9250 do i=1, size(this%ana)
9252 end do
9253end IF
9254
9255IF (ASSOCIATED(this%time))then
9256 print*,"---- time vector ----"
9257 print*,"elements=",size(this%time)
9258 do i=1, size(this%time)
9260 end do
9261end if
9262
9263IF (ASSOCIATED(this%level)) then
9264 print*,"---- level vector ----"
9265 print*,"elements=",size(this%level)
9266 do i =1,size(this%level)
9268 end do
9269end if
9270
9271IF (ASSOCIATED(this%timerange))then
9272 print*,"---- timerange vector ----"
9273 print*,"elements=",size(this%timerange)
9274 do i =1,size(this%timerange)
9276 end do
9277end if
9278
9279
9280print*,"---- ana vector ----"
9281print*,""
9282print*,"->>>>>>>>> anavar -"
9284print*,""
9285print*,"->>>>>>>>> anaattr -"
9287print*,""
9288print*,"->>>>>>>>> anavarattr -"
9290
9291print*,"-- ana data section (first point) --"
9292
9293idat=imiss
9294rdat=rmiss
9295ddat=dmiss
9296bdat=ibmiss
9297cdat=cmiss
9298
9299!ntime = MIN(SIZE(this%time),nprint)
9300!ntimerange = MIN(SIZE(this%timerange),nprint)
9301!nlevel = MIN(SIZE(this%level),nprint)
9302!nnetwork = MIN(SIZE(this%network),nprint)
9303!nana = MIN(SIZE(this%ana),nprint)
9304
9305IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0) THEN
9306if (associated(this%volanai)) then
9307 do i=1,size(this%anavar%i)
9308 idat=this%volanai(1,i,1)
9310 end do
9311end if
9312idat=imiss
9313
9314if (associated(this%volanar)) then
9315 do i=1,size(this%anavar%r)
9316 rdat=this%volanar(1,i,1)
9318 end do
9319end if
9320rdat=rmiss
9321
9322if (associated(this%volanad)) then
9323 do i=1,size(this%anavar%d)
9324 ddat=this%volanad(1,i,1)
9326 end do
9327end if
9328ddat=dmiss
9329
9330if (associated(this%volanab)) then
9331 do i=1,size(this%anavar%b)
9332 bdat=this%volanab(1,i,1)
9334 end do
9335end if
9336bdat=ibmiss
9337
9338if (associated(this%volanac)) then
9339 do i=1,size(this%anavar%c)
9340 cdat=this%volanac(1,i,1)
9342 end do
9343end if
9344cdat=cmiss
9345ENDIF
9346
9347print*,"---- data vector ----"
9348print*,""
9349print*,"->>>>>>>>> dativar -"
9351print*,""
9352print*,"->>>>>>>>> datiattr -"
9354print*,""
9355print*,"->>>>>>>>> dativarattr -"
9357
9358print*,"-- data data section (first point) --"
9359
9360idat=imiss
9361rdat=rmiss
9362ddat=dmiss
9363bdat=ibmiss
9364cdat=cmiss
9365
9366IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0 .AND. size(this%time) > 0 &
9367 .AND. size(this%level) > 0 .AND. size(this%timerange) > 0) THEN
9368if (associated(this%voldatii)) then
9369 do i=1,size(this%dativar%i)
9370 idat=this%voldatii(1,1,1,1,i,1)
9372 end do
9373end if
9374idat=imiss
9375
9376if (associated(this%voldatir)) then
9377 do i=1,size(this%dativar%r)
9378 rdat=this%voldatir(1,1,1,1,i,1)
9380 end do
9381end if
9382rdat=rmiss
9383
9384if (associated(this%voldatid)) then
9385 do i=1,size(this%dativar%d)
9386 ddat=this%voldatid(1,1,1,1,i,1)
9388 end do
9389end if
9390ddat=dmiss
9391
9392if (associated(this%voldatib)) then
9393 do i=1,size(this%dativar%b)
9394 bdat=this%voldatib(1,1,1,1,i,1)
9396 end do
9397end if
9398bdat=ibmiss
9399
9400if (associated(this%voldatic)) then
9401 do i=1,size(this%dativar%c)
9402 cdat=this%voldatic(1,1,1,1,i,1)
9404 end do
9405end if
9406cdat=cmiss
9407ENDIF
9408
9409print*,"<<<<<<<<<<<<<<<<<<< END vol7d object >>>>>>>>>>>>>>>>>>>>"
9410
9411END SUBROUTINE vol7d_display
9412
9413
9415SUBROUTINE dat_display(this,idat,rdat,ddat,bdat,cdat)
9416TYPE(vol7d_var),intent(in) :: this
9418REAL :: rdat
9420DOUBLE PRECISION :: ddat
9422INTEGER :: idat
9424INTEGER(kind=int_b) :: bdat
9426CHARACTER(len=*) :: cdat
9427
9428print *, to_char_dat(this,idat,rdat,ddat,bdat,cdat)
9429
9430end SUBROUTINE dat_display
9431
9433SUBROUTINE dat_vect_display(this,idat,rdat,ddat,bdat,cdat)
9434
9435TYPE(vol7d_var),intent(in) :: this(:)
9437REAL :: rdat(:)
9439DOUBLE PRECISION :: ddat(:)
9441INTEGER :: idat(:)
9443INTEGER(kind=int_b) :: bdat(:)
9445CHARACTER(len=*):: cdat(:)
9446
9447integer :: i
9448
9449do i =1,size(this)
9451end do
9452
9453end SUBROUTINE dat_vect_display
9454
9455
9456FUNCTION to_char_dat(this,idat,rdat,ddat,bdat,cdat)
9457#ifdef HAVE_DBALLE
9458USE dballef
9459#endif
9460TYPE(vol7d_var),INTENT(in) :: this
9462REAL :: rdat
9464DOUBLE PRECISION :: ddat
9466INTEGER :: idat
9468INTEGER(kind=int_b) :: bdat
9470CHARACTER(len=*) :: cdat
9471CHARACTER(len=80) :: to_char_dat
9472
9473CHARACTER(len=LEN(to_char_dat)) :: to_char_tmp
9474
9475
9476#ifdef HAVE_DBALLE
9477INTEGER :: handle, ier
9478
9479handle = 0
9480to_char_dat="VALUE: "
9481
9486
9488 ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
9489 ier = idba_spiegab(handle,this%btable,cdat,to_char_tmp)
9490 ier = idba_fatto(handle)
9491 to_char_dat=trim(to_char_dat)//" ;char> "//trim(to_char_tmp)
9492endif
9493
9494#else
9495
9496to_char_dat="VALUE: "
9502
9503#endif
9504
9505END FUNCTION to_char_dat
9506
9507
9510FUNCTION vol7d_c_e(this) RESULT(c_e)
9511TYPE(vol7d), INTENT(in) :: this
9512
9513LOGICAL :: c_e
9514
9516 ASSOCIATED(this%level) .OR. ASSOCIATED(this%timerange) .OR. &
9517 ASSOCIATED(this%network) .OR. &
9518 ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
9519 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
9520 ASSOCIATED(this%anavar%c) .OR. &
9521 ASSOCIATED(this%anaattr%r) .OR. ASSOCIATED(this%anaattr%d) .OR. &
9522 ASSOCIATED(this%anaattr%i) .OR. ASSOCIATED(this%anaattr%b) .OR. &
9523 ASSOCIATED(this%anaattr%c) .OR. &
9524 ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
9525 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
9526 ASSOCIATED(this%dativar%c) .OR. &
9527 ASSOCIATED(this%datiattr%r) .OR. ASSOCIATED(this%datiattr%d) .OR. &
9528 ASSOCIATED(this%datiattr%i) .OR. ASSOCIATED(this%datiattr%b) .OR. &
9529 ASSOCIATED(this%datiattr%c)
9530
9531END FUNCTION vol7d_c_e
9532
9533
9572SUBROUTINE vol7d_alloc(this, nana, ntime, nlevel, ntimerange, nnetwork, &
9573 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
9574 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
9575 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
9576 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
9577 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
9578 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc, &
9579 ini)
9580TYPE(vol7d),INTENT(inout) :: this
9581INTEGER,INTENT(in),OPTIONAL :: nana
9582INTEGER,INTENT(in),OPTIONAL :: ntime
9583INTEGER,INTENT(in),OPTIONAL :: nlevel
9584INTEGER,INTENT(in),OPTIONAL :: ntimerange
9585INTEGER,INTENT(in),OPTIONAL :: nnetwork
9587INTEGER,INTENT(in),OPTIONAL :: &
9588 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
9589 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
9590 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
9591 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
9592 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
9593 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc
9594LOGICAL,INTENT(in),OPTIONAL :: ini
9595
9596INTEGER :: i
9597LOGICAL :: linit
9598
9599IF (PRESENT(ini)) THEN
9600 linit = ini
9601ELSE
9602 linit = .false.
9603ENDIF
9604
9605! Dimensioni principali
9606IF (PRESENT(nana)) THEN
9607 IF (nana >= 0) THEN
9608 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
9609 ALLOCATE(this%ana(nana))
9610 IF (linit) THEN
9611 DO i = 1, nana
9613 ENDDO
9614 ENDIF
9615 ENDIF
9616ENDIF
9617IF (PRESENT(ntime)) THEN
9618 IF (ntime >= 0) THEN
9619 IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
9620 ALLOCATE(this%time(ntime))
9621 IF (linit) THEN
9622 DO i = 1, ntime
9624 ENDDO
9625 ENDIF
9626 ENDIF
9627ENDIF
9628IF (PRESENT(nlevel)) THEN
9629 IF (nlevel >= 0) THEN
9630 IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
9631 ALLOCATE(this%level(nlevel))
9632 IF (linit) THEN
9633 DO i = 1, nlevel
9635 ENDDO
9636 ENDIF
9637 ENDIF
9638ENDIF
9639IF (PRESENT(ntimerange)) THEN
9640 IF (ntimerange >= 0) THEN
9641 IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
9642 ALLOCATE(this%timerange(ntimerange))
9643 IF (linit) THEN
9644 DO i = 1, ntimerange
9646 ENDDO
9647 ENDIF
9648 ENDIF
9649ENDIF
9650IF (PRESENT(nnetwork)) THEN
9651 IF (nnetwork >= 0) THEN
9652 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
9653 ALLOCATE(this%network(nnetwork))
9654 IF (linit) THEN
9655 DO i = 1, nnetwork
9657 ENDDO
9658 ENDIF
9659 ENDIF
9660ENDIF
9661! Dimensioni dei tipi delle variabili
9662CALL vol7d_varvect_alloc(this%anavar, nanavarr, nanavard, &
9663 nanavari, nanavarb, nanavarc, ini)
9664CALL vol7d_varvect_alloc(this%anaattr, nanaattrr, nanaattrd, &
9665 nanaattri, nanaattrb, nanaattrc, ini)
9666CALL vol7d_varvect_alloc(this%anavarattr, nanavarattrr, nanavarattrd, &
9667 nanavarattri, nanavarattrb, nanavarattrc, ini)
9668CALL vol7d_varvect_alloc(this%dativar, ndativarr, ndativard, &
9669 ndativari, ndativarb, ndativarc, ini)
9670CALL vol7d_varvect_alloc(this%datiattr, ndatiattrr, ndatiattrd, &
9671 ndatiattri, ndatiattrb, ndatiattrc, ini)
9672CALL vol7d_varvect_alloc(this%dativarattr, ndativarattrr, ndativarattrd, &
9673 ndativarattri, ndativarattrb, ndativarattrc, ini)
9674
9675END SUBROUTINE vol7d_alloc
9676
9677
9678FUNCTION vol7d_check_alloc_ana(this)
9679TYPE(vol7d),INTENT(in) :: this
9680LOGICAL :: vol7d_check_alloc_ana
9681
9682vol7d_check_alloc_ana = ASSOCIATED(this%ana) .AND. ASSOCIATED(this%network)
9683
9684END FUNCTION vol7d_check_alloc_ana
9685
9686SUBROUTINE vol7d_force_alloc_ana(this, ini)
9687TYPE(vol7d),INTENT(inout) :: this
9688LOGICAL,INTENT(in),OPTIONAL :: ini
9689
9690! Alloco i descrittori minimi per avere un volume di anagrafica
9691IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=1, ini=ini)
9692IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=1, ini=ini)
9693
9694END SUBROUTINE vol7d_force_alloc_ana
9695
9696
9697FUNCTION vol7d_check_alloc_dati(this)
9698TYPE(vol7d),INTENT(in) :: this
9699LOGICAL :: vol7d_check_alloc_dati
9700
9701vol7d_check_alloc_dati = vol7d_check_alloc_ana(this) .AND. &
9702 ASSOCIATED(this%time) .AND. ASSOCIATED(this%level) .AND. &
9703 ASSOCIATED(this%timerange)
9704
9705END FUNCTION vol7d_check_alloc_dati
9706
9707SUBROUTINE vol7d_force_alloc_dati(this, ini)
9708TYPE(vol7d),INTENT(inout) :: this
9709LOGICAL,INTENT(in),OPTIONAL :: ini
9710
9711! Alloco i descrittori minimi per avere un volume di dati
9712CALL vol7d_force_alloc_ana(this, ini)
9713IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=1, ini=ini)
9714IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=1, ini=ini)
9715IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=1, ini=ini)
9716
9717END SUBROUTINE vol7d_force_alloc_dati
9718
9719
9720SUBROUTINE vol7d_force_alloc(this)
9721TYPE(vol7d),INTENT(inout) :: this
9722
9723! If anything really not allocated yet, allocate with size 0
9724IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=0)
9725IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=0)
9726IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=0)
9727IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=0)
9728IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=0)
9729
9730END SUBROUTINE vol7d_force_alloc
9731
9732
9733FUNCTION vol7d_check_vol(this)
9734TYPE(vol7d),INTENT(in) :: this
9735LOGICAL :: vol7d_check_vol
9736
9737vol7d_check_vol = c_e(this)
9738
9739! Anagrafica
9740IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
9741 vol7d_check_vol = .false.
9742ENDIF
9743
9744IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
9745 vol7d_check_vol = .false.
9746ENDIF
9747
9748IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
9749 vol7d_check_vol = .false.
9750ENDIF
9751
9752IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
9753 vol7d_check_vol = .false.
9754ENDIF
9755
9756IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
9757 vol7d_check_vol = .false.
9758ENDIF
9759IF (ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
9760 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
9761 ASSOCIATED(this%anavar%c)) THEN
9762 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_ana(this)
9763ENDIF
9764
9765! Attributi dell'anagrafica
9766IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
9767 .NOT.ASSOCIATED(this%volanaattrr)) THEN
9768 vol7d_check_vol = .false.
9769ENDIF
9770
9771IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
9772 .NOT.ASSOCIATED(this%volanaattrd)) THEN
9773 vol7d_check_vol = .false.
9774ENDIF
9775
9776IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
9777 .NOT.ASSOCIATED(this%volanaattri)) THEN
9778 vol7d_check_vol = .false.
9779ENDIF
9780
9781IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
9782 .NOT.ASSOCIATED(this%volanaattrb)) THEN
9783 vol7d_check_vol = .false.
9784ENDIF
9785
9786IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
9787 .NOT.ASSOCIATED(this%volanaattrc)) THEN
9788 vol7d_check_vol = .false.
9789ENDIF
9790
9791! Dati
9792IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
9793 vol7d_check_vol = .false.
9794ENDIF
9795
9796IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
9797 vol7d_check_vol = .false.
9798ENDIF
9799
9800IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
9801 vol7d_check_vol = .false.
9802ENDIF
9803
9804IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
9805 vol7d_check_vol = .false.
9806ENDIF
9807
9808IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
9809 vol7d_check_vol = .false.
9810ENDIF
9811
9812! Attributi dei dati
9813IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
9814 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
9815 vol7d_check_vol = .false.
9816ENDIF
9817
9818IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
9819 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
9820 vol7d_check_vol = .false.
9821ENDIF
9822
9823IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
9824 .NOT.ASSOCIATED(this%voldatiattri)) THEN
9825 vol7d_check_vol = .false.
9826ENDIF
9827
9828IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
9829 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
9830 vol7d_check_vol = .false.
9831ENDIF
9832
9833IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
9834 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
9835 vol7d_check_vol = .false.
9836ENDIF
9837IF (ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
9838 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
9839 ASSOCIATED(this%dativar%c)) THEN
9840 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_dati(this)
9841ENDIF
9842
9843END FUNCTION vol7d_check_vol
9844
9845
9860SUBROUTINE vol7d_alloc_vol(this, ini, inivol)
9861TYPE(vol7d),INTENT(inout) :: this
9862LOGICAL,INTENT(in),OPTIONAL :: ini
9863LOGICAL,INTENT(in),OPTIONAL :: inivol
9864
9865LOGICAL :: linivol
9866
9867IF (PRESENT(inivol)) THEN
9868 linivol = inivol
9869ELSE
9870 linivol = .true.
9871ENDIF
9872
9873! Anagrafica
9874IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
9875 CALL vol7d_force_alloc_ana(this, ini)
9876 ALLOCATE(this%volanar(SIZE(this%ana), SIZE(this%anavar%r), SIZE(this%network)))
9877 IF (linivol) this%volanar(:,:,:) = rmiss
9878ENDIF
9879
9880IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
9881 CALL vol7d_force_alloc_ana(this, ini)
9882 ALLOCATE(this%volanad(SIZE(this%ana), SIZE(this%anavar%d), SIZE(this%network)))
9883 IF (linivol) this%volanad(:,:,:) = rdmiss
9884ENDIF
9885
9886IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
9887 CALL vol7d_force_alloc_ana(this, ini)
9888 ALLOCATE(this%volanai(SIZE(this%ana), SIZE(this%anavar%i), SIZE(this%network)))
9889 IF (linivol) this%volanai(:,:,:) = imiss
9890ENDIF
9891
9892IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
9893 CALL vol7d_force_alloc_ana(this, ini)
9894 ALLOCATE(this%volanab(SIZE(this%ana), SIZE(this%anavar%b), SIZE(this%network)))
9895 IF (linivol) this%volanab(:,:,:) = ibmiss
9896ENDIF
9897
9898IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
9899 CALL vol7d_force_alloc_ana(this, ini)
9900 ALLOCATE(this%volanac(SIZE(this%ana), SIZE(this%anavar%c), SIZE(this%network)))
9901 IF (linivol) this%volanac(:,:,:) = cmiss
9902ENDIF
9903
9904! Attributi dell'anagrafica
9905IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
9906 .NOT.ASSOCIATED(this%volanaattrr)) THEN
9907 CALL vol7d_force_alloc_ana(this, ini)
9908 ALLOCATE(this%volanaattrr(SIZE(this%ana), SIZE(this%anavarattr%r), &
9909 SIZE(this%network), SIZE(this%anaattr%r)))
9910 IF (linivol) this%volanaattrr(:,:,:,:) = rmiss
9911ENDIF
9912
9913IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
9914 .NOT.ASSOCIATED(this%volanaattrd)) THEN
9915 CALL vol7d_force_alloc_ana(this, ini)
9916 ALLOCATE(this%volanaattrd(SIZE(this%ana), SIZE(this%anavarattr%d), &
9917 SIZE(this%network), SIZE(this%anaattr%d)))
9918 IF (linivol) this%volanaattrd(:,:,:,:) = rdmiss
9919ENDIF
9920
9921IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
9922 .NOT.ASSOCIATED(this%volanaattri)) THEN
9923 CALL vol7d_force_alloc_ana(this, ini)
9924 ALLOCATE(this%volanaattri(SIZE(this%ana), SIZE(this%anavarattr%i), &
9925 SIZE(this%network), SIZE(this%anaattr%i)))
9926 IF (linivol) this%volanaattri(:,:,:,:) = imiss
9927ENDIF
9928
9929IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
9930 .NOT.ASSOCIATED(this%volanaattrb)) THEN
9931 CALL vol7d_force_alloc_ana(this, ini)
9932 ALLOCATE(this%volanaattrb(SIZE(this%ana), SIZE(this%anavarattr%b), &
9933 SIZE(this%network), SIZE(this%anaattr%b)))
9934 IF (linivol) this%volanaattrb(:,:,:,:) = ibmiss
9935ENDIF
9936
9937IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
9938 .NOT.ASSOCIATED(this%volanaattrc)) THEN
9939 CALL vol7d_force_alloc_ana(this, ini)
9940 ALLOCATE(this%volanaattrc(SIZE(this%ana), SIZE(this%anavarattr%c), &
9941 SIZE(this%network), SIZE(this%anaattr%c)))
9942 IF (linivol) this%volanaattrc(:,:,:,:) = cmiss
9943ENDIF
9944
9945! Dati
9946IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
9947 CALL vol7d_force_alloc_dati(this, ini)
9948 ALLOCATE(this%voldatir(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9949 SIZE(this%timerange), SIZE(this%dativar%r), SIZE(this%network)))
9950 IF (linivol) this%voldatir(:,:,:,:,:,:) = rmiss
9951ENDIF
9952
9953IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
9954 CALL vol7d_force_alloc_dati(this, ini)
9955 ALLOCATE(this%voldatid(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9956 SIZE(this%timerange), SIZE(this%dativar%d), SIZE(this%network)))
9957 IF (linivol) this%voldatid(:,:,:,:,:,:) = rdmiss
9958ENDIF
9959
9960IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
9961 CALL vol7d_force_alloc_dati(this, ini)
9962 ALLOCATE(this%voldatii(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9963 SIZE(this%timerange), SIZE(this%dativar%i), SIZE(this%network)))
9964 IF (linivol) this%voldatii(:,:,:,:,:,:) = imiss
9965ENDIF
9966
9967IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
9968 CALL vol7d_force_alloc_dati(this, ini)
9969 ALLOCATE(this%voldatib(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9970 SIZE(this%timerange), SIZE(this%dativar%b), SIZE(this%network)))
9971 IF (linivol) this%voldatib(:,:,:,:,:,:) = ibmiss
9972ENDIF
9973
9974IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
9975 CALL vol7d_force_alloc_dati(this, ini)
9976 ALLOCATE(this%voldatic(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9977 SIZE(this%timerange), SIZE(this%dativar%c), SIZE(this%network)))
9978 IF (linivol) this%voldatic(:,:,:,:,:,:) = cmiss
9979ENDIF
9980
9981! Attributi dei dati
9982IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
9983 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
9984 CALL vol7d_force_alloc_dati(this, ini)
9985 ALLOCATE(this%voldatiattrr(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9986 SIZE(this%timerange), SIZE(this%dativarattr%r), SIZE(this%network), &
9987 SIZE(this%datiattr%r)))
9988 IF (linivol) this%voldatiattrr(:,:,:,:,:,:,:) = rmiss
9989ENDIF
9990
9991IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
9992 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
9993 CALL vol7d_force_alloc_dati(this, ini)
9994 ALLOCATE(this%voldatiattrd(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
9995 SIZE(this%timerange), SIZE(this%dativarattr%d), SIZE(this%network), &
9996 SIZE(this%datiattr%d)))
9997 IF (linivol) this%voldatiattrd(:,:,:,:,:,:,:) = rdmiss
9998ENDIF
9999
10000IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
10001 .NOT.ASSOCIATED(this%voldatiattri)) THEN
10002 CALL vol7d_force_alloc_dati(this, ini)
10003 ALLOCATE(this%voldatiattri(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10004 SIZE(this%timerange), SIZE(this%dativarattr%i), SIZE(this%network), &
10005 SIZE(this%datiattr%i)))
10006 IF (linivol) this%voldatiattri(:,:,:,:,:,:,:) = imiss
10007ENDIF
10008
10009IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
10010 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
10011 CALL vol7d_force_alloc_dati(this, ini)
10012 ALLOCATE(this%voldatiattrb(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10013 SIZE(this%timerange), SIZE(this%dativarattr%b), SIZE(this%network), &
10014 SIZE(this%datiattr%b)))
10015 IF (linivol) this%voldatiattrb(:,:,:,:,:,:,:) = ibmiss
10016ENDIF
10017
10018IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
10019 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
10020 CALL vol7d_force_alloc_dati(this, ini)
10021 ALLOCATE(this%voldatiattrc(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10022 SIZE(this%timerange), SIZE(this%dativarattr%c), SIZE(this%network), &
10023 SIZE(this%datiattr%c)))
10024 IF (linivol) this%voldatiattrc(:,:,:,:,:,:,:) = cmiss
10025ENDIF
10026
10027! Catch-all method
10028CALL vol7d_force_alloc(this)
10029
10030! Creo gli indici var-attr
10031
10032#ifdef DEBUG
10033CALL l4f_log(l4f_debug,"calling: vol7d_set_attr_ind")
10034#endif
10035
10036CALL vol7d_set_attr_ind(this)
10037
10038
10039
10040END SUBROUTINE vol7d_alloc_vol
10041
10042
10049SUBROUTINE vol7d_set_attr_ind(this)
10050TYPE(vol7d),INTENT(inout) :: this
10051
10052INTEGER :: i
10053
10054! real
10055IF (ASSOCIATED(this%dativar%r)) THEN
10056 IF (ASSOCIATED(this%dativarattr%r)) THEN
10057 DO i = 1, SIZE(this%dativar%r)
10058 this%dativar%r(i)%r = &
10059 firsttrue(this%dativar%r(i)%btable == this%dativarattr%r(:)%btable)
10060 ENDDO
10061 ENDIF
10062
10063 IF (ASSOCIATED(this%dativarattr%d)) THEN
10064 DO i = 1, SIZE(this%dativar%r)
10065 this%dativar%r(i)%d = &
10066 firsttrue(this%dativar%r(i)%btable == this%dativarattr%d(:)%btable)
10067 ENDDO
10068 ENDIF
10069
10070 IF (ASSOCIATED(this%dativarattr%i)) THEN
10071 DO i = 1, SIZE(this%dativar%r)
10072 this%dativar%r(i)%i = &
10073 firsttrue(this%dativar%r(i)%btable == this%dativarattr%i(:)%btable)
10074 ENDDO
10075 ENDIF
10076
10077 IF (ASSOCIATED(this%dativarattr%b)) THEN
10078 DO i = 1, SIZE(this%dativar%r)
10079 this%dativar%r(i)%b = &
10080 firsttrue(this%dativar%r(i)%btable == this%dativarattr%b(:)%btable)
10081 ENDDO
10082 ENDIF
10083
10084 IF (ASSOCIATED(this%dativarattr%c)) THEN
10085 DO i = 1, SIZE(this%dativar%r)
10086 this%dativar%r(i)%c = &
10087 firsttrue(this%dativar%r(i)%btable == this%dativarattr%c(:)%btable)
10088 ENDDO
10089 ENDIF
10090ENDIF
10091! double
10092IF (ASSOCIATED(this%dativar%d)) THEN
10093 IF (ASSOCIATED(this%dativarattr%r)) THEN
10094 DO i = 1, SIZE(this%dativar%d)
10095 this%dativar%d(i)%r = &
10096 firsttrue(this%dativar%d(i)%btable == this%dativarattr%r(:)%btable)
10097 ENDDO
10098 ENDIF
10099
10100 IF (ASSOCIATED(this%dativarattr%d)) THEN
10101 DO i = 1, SIZE(this%dativar%d)
10102 this%dativar%d(i)%d = &
10103 firsttrue(this%dativar%d(i)%btable == this%dativarattr%d(:)%btable)
10104 ENDDO
10105 ENDIF
10106
10107 IF (ASSOCIATED(this%dativarattr%i)) THEN
10108 DO i = 1, SIZE(this%dativar%d)
10109 this%dativar%d(i)%i = &
10110 firsttrue(this%dativar%d(i)%btable == this%dativarattr%i(:)%btable)
10111 ENDDO
10112 ENDIF
10113
10114 IF (ASSOCIATED(this%dativarattr%b)) THEN
10115 DO i = 1, SIZE(this%dativar%d)
10116 this%dativar%d(i)%b = &
10117 firsttrue(this%dativar%d(i)%btable == this%dativarattr%b(:)%btable)
10118 ENDDO
10119 ENDIF
10120
10121 IF (ASSOCIATED(this%dativarattr%c)) THEN
10122 DO i = 1, SIZE(this%dativar%d)
10123 this%dativar%d(i)%c = &
10124 firsttrue(this%dativar%d(i)%btable == this%dativarattr%c(:)%btable)
10125 ENDDO
10126 ENDIF
10127ENDIF
10128! integer
10129IF (ASSOCIATED(this%dativar%i)) THEN
10130 IF (ASSOCIATED(this%dativarattr%r)) THEN
10131 DO i = 1, SIZE(this%dativar%i)
10132 this%dativar%i(i)%r = &
10133 firsttrue(this%dativar%i(i)%btable == this%dativarattr%r(:)%btable)
10134 ENDDO
10135 ENDIF
10136
10137 IF (ASSOCIATED(this%dativarattr%d)) THEN
10138 DO i = 1, SIZE(this%dativar%i)
10139 this%dativar%i(i)%d = &
10140 firsttrue(this%dativar%i(i)%btable == this%dativarattr%d(:)%btable)
10141 ENDDO
10142 ENDIF
10143
10144 IF (ASSOCIATED(this%dativarattr%i)) THEN
10145 DO i = 1, SIZE(this%dativar%i)
10146 this%dativar%i(i)%i = &
10147 firsttrue(this%dativar%i(i)%btable == this%dativarattr%i(:)%btable)
10148 ENDDO
10149 ENDIF
10150
10151 IF (ASSOCIATED(this%dativarattr%b)) THEN
10152 DO i = 1, SIZE(this%dativar%i)
10153 this%dativar%i(i)%b = &
10154 firsttrue(this%dativar%i(i)%btable == this%dativarattr%b(:)%btable)
10155 ENDDO
10156 ENDIF
10157
10158 IF (ASSOCIATED(this%dativarattr%c)) THEN
10159 DO i = 1, SIZE(this%dativar%i)
10160 this%dativar%i(i)%c = &
10161 firsttrue(this%dativar%i(i)%btable == this%dativarattr%c(:)%btable)
10162 ENDDO
10163 ENDIF
10164ENDIF
10165! byte
10166IF (ASSOCIATED(this%dativar%b)) THEN
10167 IF (ASSOCIATED(this%dativarattr%r)) THEN
10168 DO i = 1, SIZE(this%dativar%b)
10169 this%dativar%b(i)%r = &
10170 firsttrue(this%dativar%b(i)%btable == this%dativarattr%r(:)%btable)
10171 ENDDO
10172 ENDIF
10173
10174 IF (ASSOCIATED(this%dativarattr%d)) THEN
10175 DO i = 1, SIZE(this%dativar%b)
10176 this%dativar%b(i)%d = &
10177 firsttrue(this%dativar%b(i)%btable == this%dativarattr%d(:)%btable)
10178 ENDDO
10179 ENDIF
10180
10181 IF (ASSOCIATED(this%dativarattr%i)) THEN
10182 DO i = 1, SIZE(this%dativar%b)
10183 this%dativar%b(i)%i = &
10184 firsttrue(this%dativar%b(i)%btable == this%dativarattr%i(:)%btable)
10185 ENDDO
10186 ENDIF
10187
10188 IF (ASSOCIATED(this%dativarattr%b)) THEN
10189 DO i = 1, SIZE(this%dativar%b)
10190 this%dativar%b(i)%b = &
10191 firsttrue(this%dativar%b(i)%btable == this%dativarattr%b(:)%btable)
10192 ENDDO
10193 ENDIF
10194
10195 IF (ASSOCIATED(this%dativarattr%c)) THEN
10196 DO i = 1, SIZE(this%dativar%b)
10197 this%dativar%b(i)%c = &
10198 firsttrue(this%dativar%b(i)%btable == this%dativarattr%c(:)%btable)
10199 ENDDO
10200 ENDIF
10201ENDIF
10202! character
10203IF (ASSOCIATED(this%dativar%c)) THEN
10204 IF (ASSOCIATED(this%dativarattr%r)) THEN
10205 DO i = 1, SIZE(this%dativar%c)
10206 this%dativar%c(i)%r = &
10207 firsttrue(this%dativar%c(i)%btable == this%dativarattr%r(:)%btable)
10208 ENDDO
10209 ENDIF
10210
10211 IF (ASSOCIATED(this%dativarattr%d)) THEN
10212 DO i = 1, SIZE(this%dativar%c)
10213 this%dativar%c(i)%d = &
10214 firsttrue(this%dativar%c(i)%btable == this%dativarattr%d(:)%btable)
10215 ENDDO
10216 ENDIF
10217
10218 IF (ASSOCIATED(this%dativarattr%i)) THEN
10219 DO i = 1, SIZE(this%dativar%c)
10220 this%dativar%c(i)%i = &
10221 firsttrue(this%dativar%c(i)%btable == this%dativarattr%i(:)%btable)
10222 ENDDO
10223 ENDIF
10224
10225 IF (ASSOCIATED(this%dativarattr%b)) THEN
10226 DO i = 1, SIZE(this%dativar%c)
10227 this%dativar%c(i)%b = &
10228 firsttrue(this%dativar%c(i)%btable == this%dativarattr%b(:)%btable)
10229 ENDDO
10230 ENDIF
10231
10232 IF (ASSOCIATED(this%dativarattr%c)) THEN
10233 DO i = 1, SIZE(this%dativar%c)
10234 this%dativar%c(i)%c = &
10235 firsttrue(this%dativar%c(i)%btable == this%dativarattr%c(:)%btable)
10236 ENDDO
10237 ENDIF
10238ENDIF
10239
10240END SUBROUTINE vol7d_set_attr_ind
10241
10242
10247SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
10248 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
10249TYPE(vol7d),INTENT(INOUT) :: this
10250TYPE(vol7d),INTENT(INOUT) :: that
10251LOGICAL,INTENT(IN),OPTIONAL :: sort
10252LOGICAL,INTENT(in),OPTIONAL :: bestdata
10253LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple ! experimental, please do not use outside the library now
10254
10255TYPE(vol7d) :: v7d_clean
10256
10257
10259 this = that
10261 that = v7d_clean ! destroy that without deallocating
10262ELSE ! Append that to this and destroy that
10264 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
10266ENDIF
10267
10268END SUBROUTINE vol7d_merge
10269
10270
10299SUBROUTINE vol7d_append(this, that, sort, bestdata, &
10300 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
10301TYPE(vol7d),INTENT(INOUT) :: this
10302TYPE(vol7d),INTENT(IN) :: that
10303LOGICAL,INTENT(IN),OPTIONAL :: sort
10304! experimental, please do not use outside the library now, they force the use
10305! of a simplified mapping algorithm which is valid only whene the dimension
10306! content is the same in both volumes , or when one of them is empty
10307LOGICAL,INTENT(in),OPTIONAL :: bestdata
10308LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple
10309
10310
10311TYPE(vol7d) :: v7dtmp
10312LOGICAL :: lsort, lbestdata
10313INTEGER,POINTER :: remapt1(:), remapt2(:), remaptr1(:), remaptr2(:), &
10314 remapl1(:), remapl2(:), remapa1(:), remapa2(:), remapn1(:), remapn2(:)
10315
10317IF (.NOT.vol7d_check_vol(that)) RETURN ! be safe
10320 RETURN
10321ENDIF
10322
10323IF (this%time_definition /= that%time_definition) THEN
10324 CALL l4f_log(l4f_fatal, &
10325 'in vol7d_append, cannot append volumes with different &
10326 &time definition')
10327 CALL raise_fatal_error()
10328ENDIF
10329
10330! Completo l'allocazione per avere volumi a norma
10331CALL vol7d_alloc_vol(this)
10332
10336
10337! Calcolo le mappature tra volumi vecchi e volume nuovo
10338! I puntatori remap* vengono tutti o allocati o nullificati
10339IF (optio_log(ltimesimple)) THEN
10340 CALL vol7d_remap2simple_datetime(this%time, that%time, v7dtmp%time, &
10341 lsort, remapt1, remapt2)
10342ELSE
10343 CALL vol7d_remap2_datetime(this%time, that%time, v7dtmp%time, &
10344 lsort, remapt1, remapt2)
10345ENDIF
10346IF (optio_log(ltimerangesimple)) THEN
10347 CALL vol7d_remap2simple_vol7d_timerange(this%timerange, that%timerange, &
10348 v7dtmp%timerange, lsort, remaptr1, remaptr2)
10349ELSE
10350 CALL vol7d_remap2_vol7d_timerange(this%timerange, that%timerange, &
10351 v7dtmp%timerange, lsort, remaptr1, remaptr2)
10352ENDIF
10353IF (optio_log(llevelsimple)) THEN
10354 CALL vol7d_remap2simple_vol7d_level(this%level, that%level, v7dtmp%level, &
10355 lsort, remapl1, remapl2)
10356ELSE
10357 CALL vol7d_remap2_vol7d_level(this%level, that%level, v7dtmp%level, &
10358 lsort, remapl1, remapl2)
10359ENDIF
10360IF (optio_log(lanasimple)) THEN
10361 CALL vol7d_remap2simple_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
10362 .false., remapa1, remapa2)
10363ELSE
10364 CALL vol7d_remap2_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
10365 .false., remapa1, remapa2)
10366ENDIF
10367IF (optio_log(lnetworksimple)) THEN
10368 CALL vol7d_remap2simple_vol7d_network(this%network, that%network, v7dtmp%network, &
10369 .false., remapn1, remapn2)
10370ELSE
10371 CALL vol7d_remap2_vol7d_network(this%network, that%network, v7dtmp%network, &
10372 .false., remapn1, remapn2)
10373ENDIF
10374
10375! Faccio la fusione fisica dei volumi
10376CALL vol7d_merge_finalr(this, that, v7dtmp, &
10377 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10378 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10379CALL vol7d_merge_finald(this, that, v7dtmp, &
10380 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10381 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10382CALL vol7d_merge_finali(this, that, v7dtmp, &
10383 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10384 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10385CALL vol7d_merge_finalb(this, that, v7dtmp, &
10386 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10387 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10388CALL vol7d_merge_finalc(this, that, v7dtmp, &
10389 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10390 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10391
10392! Dealloco i vettori di rimappatura
10393IF (ASSOCIATED(remapt1)) DEALLOCATE(remapt1)
10394IF (ASSOCIATED(remapt2)) DEALLOCATE(remapt2)
10395IF (ASSOCIATED(remaptr1)) DEALLOCATE(remaptr1)
10396IF (ASSOCIATED(remaptr2)) DEALLOCATE(remaptr2)
10397IF (ASSOCIATED(remapl1)) DEALLOCATE(remapl1)
10398IF (ASSOCIATED(remapl2)) DEALLOCATE(remapl2)
10399IF (ASSOCIATED(remapa1)) DEALLOCATE(remapa1)
10400IF (ASSOCIATED(remapa2)) DEALLOCATE(remapa2)
10401IF (ASSOCIATED(remapn1)) DEALLOCATE(remapn1)
10402IF (ASSOCIATED(remapn2)) DEALLOCATE(remapn2)
10403
10404! Distruggo il vecchio volume e assegno il nuovo a this
10406this = v7dtmp
10407! Ricreo gli indici var-attr
10408CALL vol7d_set_attr_ind(this)
10409
10410END SUBROUTINE vol7d_append
10411
10412
10445SUBROUTINE vol7d_copy(this, that, sort, unique, miss, &
10446 lsort_time, lsort_timerange, lsort_level, &
10447 ltime, ltimerange, llevel, lana, lnetwork, &
10448 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
10449 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
10450 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
10451 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
10452 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
10453 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
10454TYPE(vol7d),INTENT(IN) :: this
10455TYPE(vol7d),INTENT(INOUT) :: that
10456LOGICAL,INTENT(IN),OPTIONAL :: sort
10457LOGICAL,INTENT(IN),OPTIONAL :: unique
10458LOGICAL,INTENT(IN),OPTIONAL :: miss
10459LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
10460LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
10461LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
10469LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
10471LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
10473LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
10475LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
10477LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
10479LOGICAL,INTENT(in),OPTIONAL :: &
10480 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
10481 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
10482 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
10483 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
10484 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
10485 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
10486
10487LOGICAL :: lsort, lunique, lmiss
10488INTEGER,POINTER :: remapt(:), remaptr(:), remapl(:), remapa(:), remapn(:)
10489
10492IF (.NOT.vol7d_check_vol(this)) RETURN ! be safe
10493
10497
10498! Calcolo le mappature tra volume vecchio e volume nuovo
10499! I puntatori remap* vengono tutti o allocati o nullificati
10500CALL vol7d_remap1_datetime(this%time, that%time, &
10501 lsort.OR.optio_log(lsort_time), lunique, lmiss, remapt, ltime)
10502CALL vol7d_remap1_vol7d_timerange(this%timerange, that%timerange, &
10503 lsort.OR.optio_log(lsort_timerange), lunique, lmiss, remaptr, ltimerange)
10504CALL vol7d_remap1_vol7d_level(this%level, that%level, &
10505 lsort.OR.optio_log(lsort_level), lunique, lmiss, remapl, llevel)
10506CALL vol7d_remap1_vol7d_ana(this%ana, that%ana, &
10507 lsort, lunique, lmiss, remapa, lana)
10508CALL vol7d_remap1_vol7d_network(this%network, that%network, &
10509 lsort, lunique, lmiss, remapn, lnetwork)
10510
10511! lanavari, lanavarb, lanavarc, &
10512! lanaattri, lanaattrb, lanaattrc, &
10513! lanavarattri, lanavarattrb, lanavarattrc, &
10514! ldativari, ldativarb, ldativarc, &
10515! ldatiattri, ldatiattrb, ldatiattrc, &
10516! ldativarattri, ldativarattrb, ldativarattrc
10517! Faccio la riforma fisica dei volumi
10518CALL vol7d_reform_finalr(this, that, &
10519 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
10520 lanavarr, lanaattrr, lanavarattrr, ldativarr, ldatiattrr, ldativarattrr)
10521CALL vol7d_reform_finald(this, that, &
10522 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
10523 lanavard, lanaattrd, lanavarattrd, ldativard, ldatiattrd, ldativarattrd)
10524CALL vol7d_reform_finali(this, that, &
10525 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
10526 lanavari, lanaattri, lanavarattri, ldativari, ldatiattri, ldativarattri)
10527CALL vol7d_reform_finalb(this, that, &
10528 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
10529 lanavarb, lanaattrb, lanavarattrb, ldativarb, ldatiattrb, ldativarattrb)
10530CALL vol7d_reform_finalc(this, that, &
10531 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
10532 lanavarc, lanaattrc, lanavarattrc, ldativarc, ldatiattrc, ldativarattrc)
10533
10534! Dealloco i vettori di rimappatura
10535IF (ASSOCIATED(remapt)) DEALLOCATE(remapt)
10536IF (ASSOCIATED(remaptr)) DEALLOCATE(remaptr)
10537IF (ASSOCIATED(remapl)) DEALLOCATE(remapl)
10538IF (ASSOCIATED(remapa)) DEALLOCATE(remapa)
10539IF (ASSOCIATED(remapn)) DEALLOCATE(remapn)
10540
10541! Ricreo gli indici var-attr
10542CALL vol7d_set_attr_ind(that)
10543that%time_definition = this%time_definition
10544
10545END SUBROUTINE vol7d_copy
10546
10547
10558SUBROUTINE vol7d_reform(this, sort, unique, miss, &
10559 lsort_time, lsort_timerange, lsort_level, &
10560 ltime, ltimerange, llevel, lana, lnetwork, &
10561 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
10562 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
10563 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
10564 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
10565 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
10566 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc&
10567 ,purgeana)
10568TYPE(vol7d),INTENT(INOUT) :: this
10569LOGICAL,INTENT(IN),OPTIONAL :: sort
10570LOGICAL,INTENT(IN),OPTIONAL :: unique
10571LOGICAL,INTENT(IN),OPTIONAL :: miss
10572LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
10573LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
10574LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
10582LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
10583LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
10584LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
10585LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
10586LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
10588LOGICAL,INTENT(in),OPTIONAL :: &
10589 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
10590 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
10591 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
10592 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
10593 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
10594 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
10595LOGICAL,INTENT(IN),OPTIONAL :: purgeana
10596
10597TYPE(vol7d) :: v7dtmp
10598logical,allocatable :: llana(:)
10599integer :: i
10600
10602 lsort_time, lsort_timerange, lsort_level, &
10603 ltime, ltimerange, llevel, lana, lnetwork, &
10604 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
10605 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
10606 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
10607 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
10608 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
10609 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
10610
10611! destroy old volume
10613
10614if (optio_log(purgeana)) then
10615 allocate(llana(size(v7dtmp%ana)))
10616 llana =.false.
10617 do i =1,size(v7dtmp%ana)
10618 if (associated(v7dtmp%voldatii)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatii(i,:,:,:,:,:)))
10619 if (associated(v7dtmp%voldatir)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatir(i,:,:,:,:,:)))
10620 if (associated(v7dtmp%voldatid)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatid(i,:,:,:,:,:)))
10621 if (associated(v7dtmp%voldatib)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatib(i,:,:,:,:,:)))
10622 if (associated(v7dtmp%voldatic)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatic(i,:,:,:,:,:)))
10623 end do
10624 CALL vol7d_copy(v7dtmp, this,lana=llana)
10626 deallocate(llana)
10627else
10628 this=v7dtmp
10629end if
10630
10631END SUBROUTINE vol7d_reform
10632
10633
10641SUBROUTINE vol7d_smart_sort(this, lsort_time, lsort_timerange, lsort_level)
10642TYPE(vol7d),INTENT(INOUT) :: this
10643LOGICAL,OPTIONAL,INTENT(in) :: lsort_time
10644LOGICAL,OPTIONAL,INTENT(in) :: lsort_timerange
10645LOGICAL,OPTIONAL,INTENT(in) :: lsort_level
10646
10647INTEGER :: i
10648LOGICAL :: to_be_sorted
10649
10650to_be_sorted = .false.
10651CALL vol7d_alloc_vol(this) ! usual safety check
10652
10653IF (optio_log(lsort_time)) THEN
10654 DO i = 2, SIZE(this%time)
10655 IF (this%time(i) < this%time(i-1)) THEN
10656 to_be_sorted = .true.
10657 EXIT
10658 ENDIF
10659 ENDDO
10660ENDIF
10661IF (optio_log(lsort_timerange)) THEN
10662 DO i = 2, SIZE(this%timerange)
10663 IF (this%timerange(i) < this%timerange(i-1)) THEN
10664 to_be_sorted = .true.
10665 EXIT
10666 ENDIF
10667 ENDDO
10668ENDIF
10669IF (optio_log(lsort_level)) THEN
10670 DO i = 2, SIZE(this%level)
10671 IF (this%level(i) < this%level(i-1)) THEN
10672 to_be_sorted = .true.
10673 EXIT
10674 ENDIF
10675 ENDDO
10676ENDIF
10677
10678IF (to_be_sorted) CALL vol7d_reform(this, &
10679 lsort_time=lsort_time, lsort_timerange=lsort_timerange, lsort_level=lsort_level )
10680
10681END SUBROUTINE vol7d_smart_sort
10682
10690SUBROUTINE vol7d_filter(this, avl, vl, nl, s_d, e_d)
10691TYPE(vol7d),INTENT(inout) :: this
10692CHARACTER(len=*),INTENT(in),OPTIONAL :: avl(:)
10693CHARACTER(len=*),INTENT(in),OPTIONAL :: vl(:)
10694TYPE(vol7d_network),OPTIONAL :: nl(:)
10695TYPE(datetime),INTENT(in),OPTIONAL :: s_d
10696TYPE(datetime),INTENT(in),OPTIONAL :: e_d
10697
10698INTEGER :: i
10699
10700IF (PRESENT(avl)) THEN
10701 IF (SIZE(avl) > 0) THEN
10702
10703 IF (ASSOCIATED(this%anavar%r)) THEN
10704 DO i = 1, SIZE(this%anavar%r)
10705 IF (all(this%anavar%r(i)%btable /= avl)) this%anavar%r(i) = vol7d_var_miss
10706 ENDDO
10707 ENDIF
10708
10709 IF (ASSOCIATED(this%anavar%i)) THEN
10710 DO i = 1, SIZE(this%anavar%i)
10711 IF (all(this%anavar%i(i)%btable /= avl)) this%anavar%i(i) = vol7d_var_miss
10712 ENDDO
10713 ENDIF
10714
10715 IF (ASSOCIATED(this%anavar%b)) THEN
10716 DO i = 1, SIZE(this%anavar%b)
10717 IF (all(this%anavar%b(i)%btable /= avl)) this%anavar%b(i) = vol7d_var_miss
10718 ENDDO
10719 ENDIF
10720
10721 IF (ASSOCIATED(this%anavar%d)) THEN
10722 DO i = 1, SIZE(this%anavar%d)
10723 IF (all(this%anavar%d(i)%btable /= avl)) this%anavar%d(i) = vol7d_var_miss
10724 ENDDO
10725 ENDIF
10726
10727 IF (ASSOCIATED(this%anavar%c)) THEN
10728 DO i = 1, SIZE(this%anavar%c)
10729 IF (all(this%anavar%c(i)%btable /= avl)) this%anavar%c(i) = vol7d_var_miss
10730 ENDDO
10731 ENDIF
10732
10733 ENDIF
10734ENDIF
10735
10736
10737IF (PRESENT(vl)) THEN
10738 IF (size(vl) > 0) THEN
10739 IF (ASSOCIATED(this%dativar%r)) THEN
10740 DO i = 1, SIZE(this%dativar%r)
10741 IF (all(this%dativar%r(i)%btable /= vl)) this%dativar%r(i) = vol7d_var_miss
10742 ENDDO
10743 ENDIF
10744
10745 IF (ASSOCIATED(this%dativar%i)) THEN
10746 DO i = 1, SIZE(this%dativar%i)
10747 IF (all(this%dativar%i(i)%btable /= vl)) this%dativar%i(i) = vol7d_var_miss
10748 ENDDO
10749 ENDIF
10750
10751 IF (ASSOCIATED(this%dativar%b)) THEN
10752 DO i = 1, SIZE(this%dativar%b)
10753 IF (all(this%dativar%b(i)%btable /= vl)) this%dativar%b(i) = vol7d_var_miss
10754 ENDDO
10755 ENDIF
10756
10757 IF (ASSOCIATED(this%dativar%d)) THEN
10758 DO i = 1, SIZE(this%dativar%d)
10759 IF (all(this%dativar%d(i)%btable /= vl)) this%dativar%d(i) = vol7d_var_miss
10760 ENDDO
10761 ENDIF
10762
10763 IF (ASSOCIATED(this%dativar%c)) THEN
10764 DO i = 1, SIZE(this%dativar%c)
10765 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
10766 ENDDO
10767 ENDIF
10768
10769 IF (ASSOCIATED(this%dativar%c)) THEN
10770 DO i = 1, SIZE(this%dativar%c)
10771 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
10772 ENDDO
10773 ENDIF
10774
10775 ENDIF
10776ENDIF
10777
10778IF (PRESENT(nl)) THEN
10779 IF (SIZE(nl) > 0) THEN
10780 DO i = 1, SIZE(this%network)
10781 IF (all(this%network(i) /= nl)) this%network(i) = vol7d_network_miss
10782 ENDDO
10783 ENDIF
10784ENDIF
10785
10786IF (PRESENT(s_d)) THEN
10788 WHERE (this%time < s_d)
10789 this%time = datetime_miss
10790 END WHERE
10791 ENDIF
10792ENDIF
10793
10794IF (PRESENT(e_d)) THEN
10796 WHERE (this%time > e_d)
10797 this%time = datetime_miss
10798 END WHERE
10799 ENDIF
10800ENDIF
10801
10802CALL vol7d_reform(this, miss=.true.)
10803
10804END SUBROUTINE vol7d_filter
10805
10806
10813SUBROUTINE vol7d_convr(this, that, anaconv)
10814TYPE(vol7d),INTENT(IN) :: this
10815TYPE(vol7d),INTENT(INOUT) :: that
10816LOGICAL,OPTIONAL,INTENT(in) :: anaconv
10817INTEGER :: i
10818LOGICAL :: fv(1)=(/.false./), tv(1)=(/.true./), acp(1), acn(1)
10819TYPE(vol7d) :: v7d_tmp
10820
10821IF (optio_log(anaconv)) THEN
10822 acp=fv
10823 acn=tv
10824ELSE
10825 acp=tv
10826 acn=fv
10827ENDIF
10828
10829! Volume con solo i dati reali e tutti gli attributi
10830! l'anagrafica e` copiata interamente se necessario
10831CALL vol7d_copy(this, that, &
10832 lanavarr=tv, lanavard=acp, lanavari=acp, lanavarb=acp, lanavarc=acp, &
10833 ldativarr=tv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=fv)
10834
10835! Volume solo di dati double
10836CALL vol7d_copy(this, v7d_tmp, &
10837 lanavarr=fv, lanavard=acn, lanavari=fv, lanavarb=fv, lanavarc=fv, &
10838 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
10839 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
10840 ldativarr=fv, ldativard=tv, ldativari=fv, ldativarb=fv, ldativarc=fv, &
10841 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
10842 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
10843
10844! converto a dati reali
10845IF (ASSOCIATED(v7d_tmp%anavar%d) .OR. ASSOCIATED(v7d_tmp%dativar%d)) THEN
10846
10847 IF (ASSOCIATED(v7d_tmp%anavar%d)) THEN
10848! alloco i dati reali e vi trasferisco i double
10849 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanad, 1), SIZE(v7d_tmp%volanad, 2), &
10850 SIZE(v7d_tmp%volanad, 3)))
10851 DO i = 1, SIZE(v7d_tmp%anavar%d)
10852 v7d_tmp%volanar(:,i,:) = &
10853 realdat(v7d_tmp%volanad(:,i,:), v7d_tmp%anavar%d(i))
10854 ENDDO
10855 DEALLOCATE(v7d_tmp%volanad)
10856! trasferisco le variabili
10857 v7d_tmp%anavar%r => v7d_tmp%anavar%d
10858 NULLIFY(v7d_tmp%anavar%d)
10859 ENDIF
10860
10861 IF (ASSOCIATED(v7d_tmp%dativar%d)) THEN
10862! alloco i dati reali e vi trasferisco i double
10863 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatid, 1), SIZE(v7d_tmp%voldatid, 2), &
10864 SIZE(v7d_tmp%voldatid, 3), SIZE(v7d_tmp%voldatid, 4), SIZE(v7d_tmp%voldatid, 5), &
10865 SIZE(v7d_tmp%voldatid, 6)))
10866 DO i = 1, SIZE(v7d_tmp%dativar%d)
10867 v7d_tmp%voldatir(:,:,:,:,i,:) = &
10868 realdat(v7d_tmp%voldatid(:,:,:,:,i,:), v7d_tmp%dativar%d(i))
10869 ENDDO
10870 DEALLOCATE(v7d_tmp%voldatid)
10871! trasferisco le variabili
10872 v7d_tmp%dativar%r => v7d_tmp%dativar%d
10873 NULLIFY(v7d_tmp%dativar%d)
10874 ENDIF
10875
10876! fondo con il volume definitivo
10877 CALL vol7d_merge(that, v7d_tmp)
10878ELSE
10880ENDIF
10881
10882
10883! Volume solo di dati interi
10884CALL vol7d_copy(this, v7d_tmp, &
10885 lanavarr=fv, lanavard=fv, lanavari=acn, lanavarb=fv, lanavarc=fv, &
10886 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
10887 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
10888 ldativarr=fv, ldativard=fv, ldativari=tv, ldativarb=fv, ldativarc=fv, &
10889 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
10890 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
10891
10892! converto a dati reali
10893IF (ASSOCIATED(v7d_tmp%anavar%i) .OR. ASSOCIATED(v7d_tmp%dativar%i)) THEN
10894
10895 IF (ASSOCIATED(v7d_tmp%anavar%i)) THEN
10896! alloco i dati reali e vi trasferisco gli interi
10897 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanai, 1), SIZE(v7d_tmp%volanai, 2), &
10898 SIZE(v7d_tmp%volanai, 3)))
10899 DO i = 1, SIZE(v7d_tmp%anavar%i)
10900 v7d_tmp%volanar(:,i,:) = &
10901 realdat(v7d_tmp%volanai(:,i,:), v7d_tmp%anavar%i(i))
10902 ENDDO
10903 DEALLOCATE(v7d_tmp%volanai)
10904! trasferisco le variabili
10905 v7d_tmp%anavar%r => v7d_tmp%anavar%i
10906 NULLIFY(v7d_tmp%anavar%i)
10907 ENDIF
10908
10909 IF (ASSOCIATED(v7d_tmp%dativar%i)) THEN
10910! alloco i dati reali e vi trasferisco gli interi
10911 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatii, 1), SIZE(v7d_tmp%voldatii, 2), &
10912 SIZE(v7d_tmp%voldatii, 3), SIZE(v7d_tmp%voldatii, 4), SIZE(v7d_tmp%voldatii, 5), &
10913 SIZE(v7d_tmp%voldatii, 6)))
10914 DO i = 1, SIZE(v7d_tmp%dativar%i)
10915 v7d_tmp%voldatir(:,:,:,:,i,:) = &
10916 realdat(v7d_tmp%voldatii(:,:,:,:,i,:), v7d_tmp%dativar%i(i))
10917 ENDDO
10918 DEALLOCATE(v7d_tmp%voldatii)
10919! trasferisco le variabili
10920 v7d_tmp%dativar%r => v7d_tmp%dativar%i
10921 NULLIFY(v7d_tmp%dativar%i)
10922 ENDIF
10923
10924! fondo con il volume definitivo
10925 CALL vol7d_merge(that, v7d_tmp)
10926ELSE
10928ENDIF
10929
10930
10931! Volume solo di dati byte
10932CALL vol7d_copy(this, v7d_tmp, &
10933 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=acn, lanavarc=fv, &
10934 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
10935 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
10936 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=tv, ldativarc=fv, &
10937 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
10938 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
10939
10940! converto a dati reali
10941IF (ASSOCIATED(v7d_tmp%anavar%b) .OR. ASSOCIATED(v7d_tmp%dativar%b)) THEN
10942
10943 IF (ASSOCIATED(v7d_tmp%anavar%b)) THEN
10944! alloco i dati reali e vi trasferisco i byte
10945 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanab, 1), SIZE(v7d_tmp%volanab, 2), &
10946 SIZE(v7d_tmp%volanab, 3)))
10947 DO i = 1, SIZE(v7d_tmp%anavar%b)
10948 v7d_tmp%volanar(:,i,:) = &
10949 realdat(v7d_tmp%volanab(:,i,:), v7d_tmp%anavar%b(i))
10950 ENDDO
10951 DEALLOCATE(v7d_tmp%volanab)
10952! trasferisco le variabili
10953 v7d_tmp%anavar%r => v7d_tmp%anavar%b
10954 NULLIFY(v7d_tmp%anavar%b)
10955 ENDIF
10956
10957 IF (ASSOCIATED(v7d_tmp%dativar%b)) THEN
10958! alloco i dati reali e vi trasferisco i byte
10959 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatib, 1), SIZE(v7d_tmp%voldatib, 2), &
10960 SIZE(v7d_tmp%voldatib, 3), SIZE(v7d_tmp%voldatib, 4), SIZE(v7d_tmp%voldatib, 5), &
10961 SIZE(v7d_tmp%voldatib, 6)))
10962 DO i = 1, SIZE(v7d_tmp%dativar%b)
10963 v7d_tmp%voldatir(:,:,:,:,i,:) = &
10964 realdat(v7d_tmp%voldatib(:,:,:,:,i,:), v7d_tmp%dativar%b(i))
10965 ENDDO
10966 DEALLOCATE(v7d_tmp%voldatib)
10967! trasferisco le variabili
10968 v7d_tmp%dativar%r => v7d_tmp%dativar%b
10969 NULLIFY(v7d_tmp%dativar%b)
10970 ENDIF
10971
10972! fondo con il volume definitivo
10973 CALL vol7d_merge(that, v7d_tmp)
10974ELSE
10976ENDIF
10977
10978
10979! Volume solo di dati character
10980CALL vol7d_copy(this, v7d_tmp, &
10981 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=fv, lanavarc=acn, &
10982 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
10983 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
10984 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=tv, &
10985 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
10986 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
10987
10988! converto a dati reali
10989IF (ASSOCIATED(v7d_tmp%anavar%c) .OR. ASSOCIATED(v7d_tmp%dativar%c)) THEN
10990
10991 IF (ASSOCIATED(v7d_tmp%anavar%c)) THEN
10992! alloco i dati reali e vi trasferisco i character
10993 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanac, 1), SIZE(v7d_tmp%volanac, 2), &
10994 SIZE(v7d_tmp%volanac, 3)))
10995 DO i = 1, SIZE(v7d_tmp%anavar%c)
10996 v7d_tmp%volanar(:,i,:) = &
10997 realdat(v7d_tmp%volanac(:,i,:), v7d_tmp%anavar%c(i))
10998 ENDDO
10999 DEALLOCATE(v7d_tmp%volanac)
11000! trasferisco le variabili
11001 v7d_tmp%anavar%r => v7d_tmp%anavar%c
11002 NULLIFY(v7d_tmp%anavar%c)
11003 ENDIF
11004
11005 IF (ASSOCIATED(v7d_tmp%dativar%c)) THEN
11006! alloco i dati reali e vi trasferisco i character
11007 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatic, 1), SIZE(v7d_tmp%voldatic, 2), &
11008 SIZE(v7d_tmp%voldatic, 3), SIZE(v7d_tmp%voldatic, 4), SIZE(v7d_tmp%voldatic, 5), &
11009 SIZE(v7d_tmp%voldatic, 6)))
11010 DO i = 1, SIZE(v7d_tmp%dativar%c)
11011 v7d_tmp%voldatir(:,:,:,:,i,:) = &
11012 realdat(v7d_tmp%voldatic(:,:,:,:,i,:), v7d_tmp%dativar%c(i))
11013 ENDDO
11014 DEALLOCATE(v7d_tmp%voldatic)
11015! trasferisco le variabili
11016 v7d_tmp%dativar%r => v7d_tmp%dativar%c
11017 NULLIFY(v7d_tmp%dativar%c)
11018 ENDIF
11019
11020! fondo con il volume definitivo
11021 CALL vol7d_merge(that, v7d_tmp)
11022ELSE
11024ENDIF
11025
11026END SUBROUTINE vol7d_convr
11027
11028
11032SUBROUTINE vol7d_diff_only (this, that, data_only,ana)
11033TYPE(vol7d),INTENT(IN) :: this
11034TYPE(vol7d),INTENT(OUT) :: that
11035logical , optional, intent(in) :: data_only
11036logical , optional, intent(in) :: ana
11037logical :: ldata_only,lana
11038
11039IF (PRESENT(data_only)) THEN
11040 ldata_only = data_only
11041ELSE
11042 ldata_only = .false.
11043ENDIF
11044
11045IF (PRESENT(ana)) THEN
11046 lana = ana
11047ELSE
11048 lana = .false.
11049ENDIF
11050
11051
11052#undef VOL7D_POLY_ARRAY
11053#define VOL7D_POLY_ARRAY voldati
11054#include "vol7d_class_diff.F90"
11055#undef VOL7D_POLY_ARRAY
11056#define VOL7D_POLY_ARRAY voldatiattr
11057#include "vol7d_class_diff.F90"
11058#undef VOL7D_POLY_ARRAY
11059
11060if ( .not. ldata_only) then
11061
11062#define VOL7D_POLY_ARRAY volana
11063#include "vol7d_class_diff.F90"
11064#undef VOL7D_POLY_ARRAY
11065#define VOL7D_POLY_ARRAY volanaattr
11066#include "vol7d_class_diff.F90"
11067#undef VOL7D_POLY_ARRAY
11068
11069 if(lana)then
11070 where ( this%ana == that%ana )
11071 that%ana = vol7d_ana_miss
11072 end where
11073 end if
11074
11075end if
11076
11077
11078
11079END SUBROUTINE vol7d_diff_only
11080
11081
11082
11083! Creo le routine da ripetere per i vari tipi di dati di v7d
11084! tramite un template e il preprocessore
11085#undef VOL7D_POLY_TYPE
11086#undef VOL7D_POLY_TYPES
11087#define VOL7D_POLY_TYPE REAL
11088#define VOL7D_POLY_TYPES r
11089#include "vol7d_class_type_templ.F90"
11090#undef VOL7D_POLY_TYPE
11091#undef VOL7D_POLY_TYPES
11092#define VOL7D_POLY_TYPE DOUBLE PRECISION
11093#define VOL7D_POLY_TYPES d
11094#include "vol7d_class_type_templ.F90"
11095#undef VOL7D_POLY_TYPE
11096#undef VOL7D_POLY_TYPES
11097#define VOL7D_POLY_TYPE INTEGER
11098#define VOL7D_POLY_TYPES i
11099#include "vol7d_class_type_templ.F90"
11100#undef VOL7D_POLY_TYPE
11101#undef VOL7D_POLY_TYPES
11102#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
11103#define VOL7D_POLY_TYPES b
11104#include "vol7d_class_type_templ.F90"
11105#undef VOL7D_POLY_TYPE
11106#undef VOL7D_POLY_TYPES
11107#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
11108#define VOL7D_POLY_TYPES c
11109#include "vol7d_class_type_templ.F90"
11110
11111! Creo le routine da ripetere per i vari descrittori di dimensioni di v7d
11112! tramite un template e il preprocessore
11113#define VOL7D_SORT
11114#undef VOL7D_NO_ZERO_ALLOC
11115#undef VOL7D_POLY_TYPE
11116#define VOL7D_POLY_TYPE datetime
11117#include "vol7d_class_desc_templ.F90"
11118#undef VOL7D_POLY_TYPE
11119#define VOL7D_POLY_TYPE vol7d_timerange
11120#include "vol7d_class_desc_templ.F90"
11121#undef VOL7D_POLY_TYPE
11122#define VOL7D_POLY_TYPE vol7d_level
11123#include "vol7d_class_desc_templ.F90"
11124#undef VOL7D_SORT
11125#undef VOL7D_POLY_TYPE
11126#define VOL7D_POLY_TYPE vol7d_network
11127#include "vol7d_class_desc_templ.F90"
11128#undef VOL7D_POLY_TYPE
11129#define VOL7D_POLY_TYPE vol7d_ana
11130#include "vol7d_class_desc_templ.F90"
11131#define VOL7D_NO_ZERO_ALLOC
11132#undef VOL7D_POLY_TYPE
11133#define VOL7D_POLY_TYPE vol7d_var
11134#include "vol7d_class_desc_templ.F90"
11135
11145subroutine vol7d_write_on_file (this,unit,description,filename,filename_auto)
11146
11147TYPE(vol7d),INTENT(IN) :: this
11148integer,optional,intent(inout) :: unit
11149character(len=*),intent(in),optional :: filename
11150character(len=*),intent(out),optional :: filename_auto
11151character(len=*),INTENT(IN),optional :: description
11152
11153integer :: lunit
11154character(len=254) :: ldescription,arg,lfilename
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!integer :: im,id,iy
11163integer :: tarray(8)
11164logical :: opened,exist
11165
11166 nana=0
11167 ntime=0
11168 ntimerange=0
11169 nlevel=0
11170 nnetwork=0
11171 ndativarr=0
11172 ndativari=0
11173 ndativarb=0
11174 ndativard=0
11175 ndativarc=0
11176 ndatiattrr=0
11177 ndatiattri=0
11178 ndatiattrb=0
11179 ndatiattrd=0
11180 ndatiattrc=0
11181 ndativarattrr=0
11182 ndativarattri=0
11183 ndativarattrb=0
11184 ndativarattrd=0
11185 ndativarattrc=0
11186 nanavarr=0
11187 nanavari=0
11188 nanavarb=0
11189 nanavard=0
11190 nanavarc=0
11191 nanaattrr=0
11192 nanaattri=0
11193 nanaattrb=0
11194 nanaattrd=0
11195 nanaattrc=0
11196 nanavarattrr=0
11197 nanavarattri=0
11198 nanavarattrb=0
11199 nanavarattrd=0
11200 nanavarattrc=0
11201
11202
11203!call idate(im,id,iy)
11204call date_and_time(values=tarray)
11205call getarg(0,arg)
11206
11207if (present(description))then
11208 ldescription=description
11209else
11210 ldescription="Vol7d generated by: "//trim(arg)
11211end if
11212
11213if (.not. present(unit))then
11214 lunit=getunit()
11215else
11216 if (unit==0)then
11217 lunit=getunit()
11218 unit=lunit
11219 else
11220 lunit=unit
11221 end if
11222end if
11223
11224lfilename=trim(arg)//".v7d"
11226
11227if (present(filename))then
11228 if (filename /= "")then
11229 lfilename=filename
11230 end if
11231end if
11232
11233if (present(filename_auto))filename_auto=lfilename
11234
11235
11236inquire(unit=lunit,opened=opened)
11237if (.not. opened) then
11238! inquire(file=lfilename, EXIST=exist)
11239! IF (exist) THEN
11240! CALL l4f_log(L4F_FATAL, &
11241! 'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename))
11242! CALL raise_fatal_error()
11243! ENDIF
11244 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM')
11245 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
11246end if
11247
11248if (associated(this%ana)) nana=size(this%ana)
11249if (associated(this%time)) ntime=size(this%time)
11250if (associated(this%timerange)) ntimerange=size(this%timerange)
11251if (associated(this%level)) nlevel=size(this%level)
11252if (associated(this%network)) nnetwork=size(this%network)
11253
11254if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
11255if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
11256if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
11257if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
11258if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
11259
11260if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
11261if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
11262if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
11263if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
11264if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)
11265
11266if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
11267if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
11268if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
11269if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
11270if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
11271
11272if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
11273if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
11274if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
11275if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
11276if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
11277
11278if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
11279if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
11280if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
11281if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
11282if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)
11283
11284if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
11285if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
11286if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
11287if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
11288if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)
11289
11290write(unit=lunit)ldescription
11291write(unit=lunit)tarray
11292
11293write(unit=lunit)&
11294 nana, ntime, ntimerange, nlevel, nnetwork, &
11295 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
11296 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
11297 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
11298 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
11299 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
11300 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
11301 this%time_definition
11302
11303
11304!write(unit=lunit)this
11305
11306
11307!! prime 5 dimensioni
11310if (associated(this%level)) write(unit=lunit)this%level
11311if (associated(this%timerange)) write(unit=lunit)this%timerange
11312if (associated(this%network)) write(unit=lunit)this%network
11313
11314 !! 6a dimensione: variabile dell'anagrafica e dei dati
11315 !! con relativi attributi e in 5 tipi diversi
11316
11317if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r
11318if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i
11319if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b
11320if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d
11321if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c
11322
11323if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r
11324if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i
11325if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b
11326if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d
11327if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c
11328
11329if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r
11330if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i
11331if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b
11332if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d
11333if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c
11334
11335if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r
11336if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i
11337if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b
11338if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d
11339if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c
11340
11341if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r
11342if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i
11343if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b
11344if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d
11345if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c
11346
11347if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
11348if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
11349if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
11350if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
11351if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c
11352
11353!! Volumi di valori e attributi per anagrafica e dati
11354
11355if (associated(this%volanar)) write(unit=lunit)this%volanar
11356if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr
11357if (associated(this%voldatir)) write(unit=lunit)this%voldatir
11358if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr
11359
11360if (associated(this%volanai)) write(unit=lunit)this%volanai
11361if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri
11362if (associated(this%voldatii)) write(unit=lunit)this%voldatii
11363if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri
11364
11365if (associated(this%volanab)) write(unit=lunit)this%volanab
11366if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb
11367if (associated(this%voldatib)) write(unit=lunit)this%voldatib
11368if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb
11369
11370if (associated(this%volanad)) write(unit=lunit)this%volanad
11371if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd
11372if (associated(this%voldatid)) write(unit=lunit)this%voldatid
11373if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd
11374
11375if (associated(this%volanac)) write(unit=lunit)this%volanac
11376if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc
11377if (associated(this%voldatic)) write(unit=lunit)this%voldatic
11378if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc
11379
11380if (.not. present(unit)) close(unit=lunit)
11381
11382end subroutine vol7d_write_on_file
11383
11384
11391
11392
11393subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
11394
11395TYPE(vol7d),INTENT(OUT) :: this
11396integer,intent(inout),optional :: unit
11397character(len=*),INTENT(in),optional :: filename
11398character(len=*),intent(out),optional :: filename_auto
11399character(len=*),INTENT(out),optional :: description
11400integer,intent(out),optional :: tarray(8)
11401
11402
11403integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
11404 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
11405 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
11406 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
11407 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
11408 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
11409 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
11410
11411character(len=254) :: ldescription,lfilename,arg
11412integer :: ltarray(8),lunit,ios
11413logical :: opened,exist
11414
11415
11416call getarg(0,arg)
11417
11418if (.not. present(unit))then
11419 lunit=getunit()
11420else
11421 if (unit==0)then
11422 lunit=getunit()
11423 unit=lunit
11424 else
11425 lunit=unit
11426 end if
11427end if
11428
11429lfilename=trim(arg)//".v7d"
11431
11432if (present(filename))then
11433 if (filename /= "")then
11434 lfilename=filename
11435 end if
11436end if
11437
11438if (present(filename_auto))filename_auto=lfilename
11439
11440
11441inquire(unit=lunit,opened=opened)
11442IF (.NOT. opened) THEN
11443 inquire(file=lfilename,exist=exist)
11444 IF (.NOT.exist) THEN
11445 CALL l4f_log(l4f_fatal, &
11446 'in vol7d_read_from_file, file does not exists, cannot open')
11447 CALL raise_fatal_error()
11448 ENDIF
11449 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM', &
11450 status='OLD', action='READ')
11451 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
11452end if
11453
11454
11456read(unit=lunit,iostat=ios)ldescription
11457
11458if (ios < 0) then ! A negative value indicates that the End of File or End of Record
11459 call vol7d_alloc (this)
11460 call vol7d_alloc_vol (this)
11461 if (present(description))description=ldescription
11462 if (present(tarray))tarray=ltarray
11463 if (.not. present(unit)) close(unit=lunit)
11464end if
11465
11466read(unit=lunit)ltarray
11467
11468CALL l4f_log(l4f_info, 'Reading vol7d from file')
11469CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
11472
11473if (present(description))description=ldescription
11474if (present(tarray))tarray=ltarray
11475
11476read(unit=lunit)&
11477 nana, ntime, ntimerange, nlevel, nnetwork, &
11478 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
11479 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
11480 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
11481 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
11482 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
11483 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
11484 this%time_definition
11485
11486call vol7d_alloc (this, &
11487 nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,&
11488 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,&
11489 ndativard=ndativard, ndativarc=ndativarc,&
11490 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,&
11491 ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
11492 ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, &
11493 ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,&
11494 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, &
11495 nanavard=nanavard, nanavarc=nanavarc,&
11496 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,&
11497 nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
11498 nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, &
11499 nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc)
11500
11501
11504if (associated(this%level)) read(unit=lunit)this%level
11505if (associated(this%timerange)) read(unit=lunit)this%timerange
11506if (associated(this%network)) read(unit=lunit)this%network
11507
11508if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r
11509if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i
11510if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b
11511if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d
11512if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c
11513
11514if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r
11515if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i
11516if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b
11517if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d
11518if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c
11519
11520if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r
11521if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i
11522if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b
11523if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d
11524if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c
11525
11526if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r
11527if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i
11528if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b
11529if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d
11530if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c
11531
11532if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r
11533if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i
11534if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b
11535if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d
11536if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c
11537
11538if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
11539if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
11540if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
11541if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
11542if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c
11543
11544call vol7d_alloc_vol (this)
11545
11546!! Volumi di valori e attributi per anagrafica e dati
11547
11548if (associated(this%volanar)) read(unit=lunit)this%volanar
11549if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr
11550if (associated(this%voldatir)) read(unit=lunit)this%voldatir
11551if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr
11552
11553if (associated(this%volanai)) read(unit=lunit)this%volanai
11554if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri
11555if (associated(this%voldatii)) read(unit=lunit)this%voldatii
11556if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri
11557
11558if (associated(this%volanab)) read(unit=lunit)this%volanab
11559if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb
11560if (associated(this%voldatib)) read(unit=lunit)this%voldatib
11561if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb
11562
11563if (associated(this%volanad)) read(unit=lunit)this%volanad
11564if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd
11565if (associated(this%voldatid)) read(unit=lunit)this%voldatid
11566if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd
11567
11568if (associated(this%volanac)) read(unit=lunit)this%volanac
11569if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc
11570if (associated(this%voldatic)) read(unit=lunit)this%voldatic
11571if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc
11572
11573if (.not. present(unit)) close(unit=lunit)
11574
11575end subroutine vol7d_read_from_file
11576
11577
11578! to double precision
11579elemental doubleprecision function doubledatd(voldat,var)
11580doubleprecision,intent(in) :: voldat
11581type(vol7d_var),intent(in) :: var
11582
11583doubledatd=voldat
11584
11585end function doubledatd
11586
11587
11588elemental doubleprecision function doubledatr(voldat,var)
11589real,intent(in) :: voldat
11590type(vol7d_var),intent(in) :: var
11591
11593 doubledatr=dble(voldat)
11594else
11595 doubledatr=dmiss
11596end if
11597
11598end function doubledatr
11599
11600
11601elemental doubleprecision function doubledati(voldat,var)
11602integer,intent(in) :: voldat
11603type(vol7d_var),intent(in) :: var
11604
11607 doubledati=dble(voldat)/10.d0**var%scalefactor
11608 else
11609 doubledati=dble(voldat)
11610 endif
11611else
11612 doubledati=dmiss
11613end if
11614
11615end function doubledati
11616
11617
11618elemental doubleprecision function doubledatb(voldat,var)
11619integer(kind=int_b),intent(in) :: voldat
11620type(vol7d_var),intent(in) :: var
11621
11624 doubledatb=dble(voldat)/10.d0**var%scalefactor
11625 else
11626 doubledatb=dble(voldat)
11627 endif
11628else
11629 doubledatb=dmiss
11630end if
11631
11632end function doubledatb
11633
11634
11635elemental doubleprecision function doubledatc(voldat,var)
11636CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
11637type(vol7d_var),intent(in) :: var
11638
11639doubledatc = c2d(voldat)
11641 doubledatc=doubledatc/10.d0**var%scalefactor
11642end if
11643
11644end function doubledatc
11645
11646
11647! to integer
11648elemental integer function integerdatd(voldat,var)
11649doubleprecision,intent(in) :: voldat
11650type(vol7d_var),intent(in) :: var
11651
11654 integerdatd=nint(voldat*10d0**var%scalefactor)
11655 else
11656 integerdatd=nint(voldat)
11657 endif
11658else
11659 integerdatd=imiss
11660end if
11661
11662end function integerdatd
11663
11664
11665elemental integer function integerdatr(voldat,var)
11666real,intent(in) :: voldat
11667type(vol7d_var),intent(in) :: var
11668
11671 integerdatr=nint(voldat*10d0**var%scalefactor)
11672 else
11673 integerdatr=nint(voldat)
11674 endif
11675else
11676 integerdatr=imiss
11677end if
11678
11679end function integerdatr
11680
11681
11682elemental integer function integerdati(voldat,var)
11683integer,intent(in) :: voldat
11684type(vol7d_var),intent(in) :: var
11685
11686integerdati=voldat
11687
11688end function integerdati
11689
11690
11691elemental integer function integerdatb(voldat,var)
11692integer(kind=int_b),intent(in) :: voldat
11693type(vol7d_var),intent(in) :: var
11694
11696 integerdatb=voldat
11697else
11698 integerdatb=imiss
11699end if
11700
11701end function integerdatb
11702
11703
11704elemental integer function integerdatc(voldat,var)
11705CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
11706type(vol7d_var),intent(in) :: var
11707
11708integerdatc=c2i(voldat)
11709
11710end function integerdatc
11711
11712
11713! to real
11714elemental real function realdatd(voldat,var)
11715doubleprecision,intent(in) :: voldat
11716type(vol7d_var),intent(in) :: var
11717
11719 realdatd=real(voldat)
11720else
11721 realdatd=rmiss
11722end if
11723
11724end function realdatd
11725
11726
11727elemental real function realdatr(voldat,var)
11728real,intent(in) :: voldat
11729type(vol7d_var),intent(in) :: var
11730
11731realdatr=voldat
11732
11733end function realdatr
11734
11735
11736elemental real function realdati(voldat,var)
11737integer,intent(in) :: voldat
11738type(vol7d_var),intent(in) :: var
11739
11742 realdati=float(voldat)/10.**var%scalefactor
11743 else
11744 realdati=float(voldat)
11745 endif
11746else
11747 realdati=rmiss
11748end if
11749
11750end function realdati
11751
11752
11753elemental real function realdatb(voldat,var)
11754integer(kind=int_b),intent(in) :: voldat
11755type(vol7d_var),intent(in) :: var
11756
11759 realdatb=float(voldat)/10**var%scalefactor
11760 else
11761 realdatb=float(voldat)
11762 endif
11763else
11764 realdatb=rmiss
11765end if
11766
11767end function realdatb
11768
11769
11770elemental real function realdatc(voldat,var)
11771CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
11772type(vol7d_var),intent(in) :: var
11773
11774realdatc=c2r(voldat)
11776 realdatc=realdatc/10.**var%scalefactor
11777end if
11778
11779end function realdatc
11780
11781
11787FUNCTION realanavol(this, var) RESULT(vol)
11788TYPE(vol7d),INTENT(in) :: this
11789TYPE(vol7d_var),INTENT(in) :: var
11790REAL :: vol(SIZE(this%ana),size(this%network))
11791
11792CHARACTER(len=1) :: dtype
11793INTEGER :: indvar
11794
11795dtype = cmiss
11796indvar = index(this%anavar, var, type=dtype)
11797
11798IF (indvar > 0) THEN
11799 SELECT CASE (dtype)
11800 CASE("d")
11801 vol = realdat(this%volanad(:,indvar,:), var)
11802 CASE("r")
11803 vol = this%volanar(:,indvar,:)
11804 CASE("i")
11805 vol = realdat(this%volanai(:,indvar,:), var)
11806 CASE("b")
11807 vol = realdat(this%volanab(:,indvar,:), var)
11808 CASE("c")
11809 vol = realdat(this%volanac(:,indvar,:), var)
11810 CASE default
11811 vol = rmiss
11812 END SELECT
11813ELSE
11814 vol = rmiss
11815ENDIF
11816
11817END FUNCTION realanavol
11818
11819
11825FUNCTION integeranavol(this, var) RESULT(vol)
11826TYPE(vol7d),INTENT(in) :: this
11827TYPE(vol7d_var),INTENT(in) :: var
11828INTEGER :: vol(SIZE(this%ana),size(this%network))
11829
11830CHARACTER(len=1) :: dtype
11831INTEGER :: indvar
11832
11833dtype = cmiss
11834indvar = index(this%anavar, var, type=dtype)
11835
11836IF (indvar > 0) THEN
11837 SELECT CASE (dtype)
11838 CASE("d")
11839 vol = integerdat(this%volanad(:,indvar,:), var)
11840 CASE("r")
11841 vol = integerdat(this%volanar(:,indvar,:), var)
11842 CASE("i")
11843 vol = this%volanai(:,indvar,:)
11844 CASE("b")
11845 vol = integerdat(this%volanab(:,indvar,:), var)
11846 CASE("c")
11847 vol = integerdat(this%volanac(:,indvar,:), var)
11848 CASE default
11849 vol = imiss
11850 END SELECT
11851ELSE
11852 vol = imiss
11853ENDIF
11854
11855END FUNCTION integeranavol
11856
11857
11863subroutine move_datac (v7d,&
11864 indana,indtime,indlevel,indtimerange,indnetwork,&
11865 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
11866
11867TYPE(vol7d),intent(inout) :: v7d
11868
11869integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
11870integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
11871integer :: inddativar,inddativarattr
11872
11873
11874do inddativar=1,size(v7d%dativar%c)
11875
11877 .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
11878 ) then
11879
11880 ! dati
11881 v7d%voldatic &
11882 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
11883 v7d%voldatic &
11884 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
11885
11886
11887 ! attributi
11888 if (associated (v7d%dativarattr%i)) then
11889 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
11890 if (inddativarattr > 0 ) then
11891 v7d%voldatiattri &
11892 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11893 v7d%voldatiattri &
11894 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11895 end if
11896 end if
11897
11898 if (associated (v7d%dativarattr%r)) then
11899 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
11900 if (inddativarattr > 0 ) then
11901 v7d%voldatiattrr &
11902 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11903 v7d%voldatiattrr &
11904 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11905 end if
11906 end if
11907
11908 if (associated (v7d%dativarattr%d)) then
11909 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
11910 if (inddativarattr > 0 ) then
11911 v7d%voldatiattrd &
11912 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11913 v7d%voldatiattrd &
11914 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11915 end if
11916 end if
11917
11918 if (associated (v7d%dativarattr%b)) then
11919 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
11920 if (inddativarattr > 0 ) then
11921 v7d%voldatiattrb &
11922 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11923 v7d%voldatiattrb &
11924 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11925 end if
11926 end if
11927
11928 if (associated (v7d%dativarattr%c)) then
11929 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
11930 if (inddativarattr > 0 ) then
11931 v7d%voldatiattrc &
11932 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11933 v7d%voldatiattrc &
11934 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11935 end if
11936 end if
11937
11938 end if
11939
11940end do
11941
11942end subroutine move_datac
11943
11949subroutine move_datar (v7d,&
11950 indana,indtime,indlevel,indtimerange,indnetwork,&
11951 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
11952
11953TYPE(vol7d),intent(inout) :: v7d
11954
11955integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
11956integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
11957integer :: inddativar,inddativarattr
11958
11959
11960do inddativar=1,size(v7d%dativar%r)
11961
11963 .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
11964 ) then
11965
11966 ! dati
11967 v7d%voldatir &
11968 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
11969 v7d%voldatir &
11970 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
11971
11972
11973 ! attributi
11974 if (associated (v7d%dativarattr%i)) then
11975 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
11976 if (inddativarattr > 0 ) then
11977 v7d%voldatiattri &
11978 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11979 v7d%voldatiattri &
11980 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11981 end if
11982 end if
11983
11984 if (associated (v7d%dativarattr%r)) then
11985 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%r(inddativar))
11986 if (inddativarattr > 0 ) then
11987 v7d%voldatiattrr &
11988 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11989 v7d%voldatiattrr &
11990 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
11991 end if
11992 end if
11993
11994 if (associated (v7d%dativarattr%d)) then
11995 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%r(inddativar))
11996 if (inddativarattr > 0 ) then
11997 v7d%voldatiattrd &
11998 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
11999 v7d%voldatiattrd &
12000 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12001 end if
12002 end if
12003
12004 if (associated (v7d%dativarattr%b)) then
12005 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%r(inddativar))
12006 if (inddativarattr > 0 ) then
12007 v7d%voldatiattrb &
12008 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12009 v7d%voldatiattrb &
12010 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12011 end if
12012 end if
12013
12014 if (associated (v7d%dativarattr%c)) then
12015 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%r(inddativar))
12016 if (inddativarattr > 0 ) then
12017 v7d%voldatiattrc &
12018 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12019 v7d%voldatiattrc &
12020 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12021 end if
12022 end if
12023
12024 end if
12025
12026end do
12027
12028end subroutine move_datar
12029
12030
12044subroutine v7d_rounding(v7din,v7dout,level,timerange,nostatproc)
12045type(vol7d),intent(inout) :: v7din
12046type(vol7d),intent(out) :: v7dout
12047type(vol7d_level),intent(in),optional :: level(:)
12048type(vol7d_timerange),intent(in),optional :: timerange(:)
12049!logical,intent(in),optional :: merge !< if there are data on more then one almost equal levels or timeranges
12050!! will be merged POINT BY POINT with priority for the fird data found ordered by icreasing var index
12051logical,intent(in),optional :: nostatproc
12052
12053integer :: nana,nlevel,ntime,ntimerange,nnetwork,nbin
12054integer :: iana,ilevel,itimerange,indl,indt,itime,inetwork
12055type(vol7d_level) :: roundlevel(size(v7din%level))
12056type(vol7d_timerange) :: roundtimerange(size(v7din%timerange))
12057type(vol7d) :: v7d_tmp
12058
12059
12060nbin=0
12061
12062if (associated(v7din%dativar%r)) nbin = nbin + size(v7din%dativar%r)
12063if (associated(v7din%dativar%i)) nbin = nbin + size(v7din%dativar%i)
12064if (associated(v7din%dativar%d)) nbin = nbin + size(v7din%dativar%d)
12065if (associated(v7din%dativar%b)) nbin = nbin + size(v7din%dativar%b)
12066
12068
12069roundlevel=v7din%level
12070
12071if (present(level))then
12072 do ilevel = 1, size(v7din%level)
12073 if ((any(v7din%level(ilevel) .almosteq. level))) then
12074 roundlevel(ilevel)=level(1)
12075 end if
12076 end do
12077end if
12078
12079roundtimerange=v7din%timerange
12080
12081if (present(timerange))then
12082 do itimerange = 1, size(v7din%timerange)
12083 if ((any(v7din%timerange(itimerange) .almosteq. timerange))) then
12084 roundtimerange(itimerange)=timerange(1)
12085 end if
12086 end do
12087end if
12088
12089!set istantaneous values everywere
12090!preserve p1 for forecast time
12091if (optio_log(nostatproc)) then
12092 roundtimerange(:)%timerange=254
12093 roundtimerange(:)%p2=0
12094end if
12095
12096
12097nana=size(v7din%ana)
12098nlevel=count_distinct(roundlevel,back=.true.)
12099ntime=size(v7din%time)
12100ntimerange=count_distinct(roundtimerange,back=.true.)
12101nnetwork=size(v7din%network)
12102
12104
12105if (nbin == 0) then
12107else
12108 call vol7d_convr(v7din,v7d_tmp)
12109end if
12110
12111v7d_tmp%level=roundlevel
12112v7d_tmp%timerange=roundtimerange
12113
12114do ilevel=1, size(v7d_tmp%level)
12115 indl=index(v7d_tmp%level,roundlevel(ilevel))
12116 do itimerange=1,size(v7d_tmp%timerange)
12117 indt=index(v7d_tmp%timerange,roundtimerange(itimerange))
12118
12119 if (indl /= ilevel .or. indt /= itimerange) then
12120
12121 do iana=1, nana
12122 do itime=1,ntime
12123 do inetwork=1,nnetwork
12124
12125 if (nbin > 0) then
12126 call move_datar (v7d_tmp,&
12127 iana,itime,ilevel,itimerange,inetwork,&
12128 iana,itime,indl,indt,inetwork)
12129 else
12130 call move_datac (v7d_tmp,&
12131 iana,itime,ilevel,itimerange,inetwork,&
12132 iana,itime,indl,indt,inetwork)
12133 end if
12134
12135 end do
12136 end do
12137 end do
12138
12139 end if
12140
12141 end do
12142end do
12143
12144! set to missing level and time > nlevel
12145do ilevel=nlevel+1,size(v7d_tmp%level)
12147end do
12148
12149do itimerange=ntimerange+1,size(v7d_tmp%timerange)
12151end do
12152
12153!copy with remove
12156
12157!call display(v7dout)
12158
12159end subroutine v7d_rounding
12160
12161
12163
12169
12170
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 |