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