libsim Versione 7.2.4
|
◆ move_datar()
Move data for all variables from one coordinate in the real volume to other. Only not missing data will be copyed and all attributes will be moved together. Usefull to colapse data spread in more indices (level or time or ....). After the move is possible to set to missing some descriptor and make a copy with miss=.true. to obtain a new vol7d with less data shape.
Definizione alla linea 9272 del file vol7d_class.F90. 9275! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
9276! authors:
9277! Davide Cesari <dcesari@arpa.emr.it>
9278! Paolo Patruno <ppatruno@arpa.emr.it>
9279
9280! This program is free software; you can redistribute it and/or
9281! modify it under the terms of the GNU General Public License as
9282! published by the Free Software Foundation; either version 2 of
9283! the License, or (at your option) any later version.
9284
9285! This program is distributed in the hope that it will be useful,
9286! but WITHOUT ANY WARRANTY; without even the implied warranty of
9287! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
9288! GNU General Public License for more details.
9289
9290! You should have received a copy of the GNU General Public License
9291! along with this program. If not, see <http://www.gnu.org/licenses/>.
9292#include "config.h"
9293
9305
9373IMPLICIT NONE
9374
9375
9376INTEGER, PARAMETER :: vol7d_maxdim_a = 3, vol7d_maxdim_aa = 4, &
9377 vol7d_maxdim_d = 6, vol7d_maxdim_ad = 7
9378
9379INTEGER, PARAMETER :: vol7d_ana_a=1
9380INTEGER, PARAMETER :: vol7d_var_a=2
9381INTEGER, PARAMETER :: vol7d_network_a=3
9382INTEGER, PARAMETER :: vol7d_attr_a=4
9383INTEGER, PARAMETER :: vol7d_ana_d=1
9384INTEGER, PARAMETER :: vol7d_time_d=2
9385INTEGER, PARAMETER :: vol7d_level_d=3
9386INTEGER, PARAMETER :: vol7d_timerange_d=4
9387INTEGER, PARAMETER :: vol7d_var_d=5
9388INTEGER, PARAMETER :: vol7d_network_d=6
9389INTEGER, PARAMETER :: vol7d_attr_d=7
9390INTEGER, PARAMETER :: vol7d_cdatalen=32
9391
9392TYPE vol7d_varmap
9393 INTEGER :: r, d, i, b, c
9394END TYPE vol7d_varmap
9395
9400 TYPE(vol7d_ana),POINTER :: ana(:)
9402 TYPE(datetime),POINTER :: time(:)
9404 TYPE(vol7d_level),POINTER :: level(:)
9406 TYPE(vol7d_timerange),POINTER :: timerange(:)
9408 TYPE(vol7d_network),POINTER :: network(:)
9410 TYPE(vol7d_varvect) :: anavar
9412 TYPE(vol7d_varvect) :: anaattr
9414 TYPE(vol7d_varvect) :: anavarattr
9416 TYPE(vol7d_varvect) :: dativar
9418 TYPE(vol7d_varvect) :: datiattr
9420 TYPE(vol7d_varvect) :: dativarattr
9421
9423 REAL,POINTER :: volanar(:,:,:)
9425 DOUBLE PRECISION,POINTER :: volanad(:,:,:)
9427 INTEGER,POINTER :: volanai(:,:,:)
9429 INTEGER(kind=int_b),POINTER :: volanab(:,:,:)
9431 CHARACTER(len=vol7d_cdatalen),POINTER :: volanac(:,:,:)
9432
9434 REAL,POINTER :: volanaattrr(:,:,:,:)
9436 DOUBLE PRECISION,POINTER :: volanaattrd(:,:,:,:)
9438 INTEGER,POINTER :: volanaattri(:,:,:,:)
9440 INTEGER(kind=int_b),POINTER :: volanaattrb(:,:,:,:)
9442 CHARACTER(len=vol7d_cdatalen),POINTER :: volanaattrc(:,:,:,:)
9443
9445 REAL,POINTER :: voldatir(:,:,:,:,:,:) ! sono i dati
9447 DOUBLE PRECISION,POINTER :: voldatid(:,:,:,:,:,:)
9449 INTEGER,POINTER :: voldatii(:,:,:,:,:,:)
9451 INTEGER(kind=int_b),POINTER :: voldatib(:,:,:,:,:,:)
9453 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatic(:,:,:,:,:,:)
9454
9456 REAL,POINTER :: voldatiattrr(:,:,:,:,:,:,:)
9458 DOUBLE PRECISION,POINTER :: voldatiattrd(:,:,:,:,:,:,:)
9460 INTEGER,POINTER :: voldatiattri(:,:,:,:,:,:,:)
9462 INTEGER(kind=int_b),POINTER :: voldatiattrb(:,:,:,:,:,:,:)
9464 CHARACTER(len=vol7d_cdatalen),POINTER :: voldatiattrc(:,:,:,:,:,:,:)
9465
9467 integer :: time_definition
9468
9470
9475 MODULE PROCEDURE vol7d_init
9476END INTERFACE
9477
9480 MODULE PROCEDURE vol7d_delete
9481END INTERFACE
9482
9485 MODULE PROCEDURE vol7d_write_on_file
9486END INTERFACE
9487
9489INTERFACE import
9490 MODULE PROCEDURE vol7d_read_from_file
9491END INTERFACE
9492
9495 MODULE PROCEDURE vol7d_display, dat_display, dat_vect_display
9496END INTERFACE
9497
9500 MODULE PROCEDURE to_char_dat
9501END INTERFACE
9502
9505 MODULE PROCEDURE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
9506END INTERFACE
9507
9510 MODULE PROCEDURE realdatd,realdatr,realdati,realdatb,realdatc
9511END INTERFACE
9512
9515 MODULE PROCEDURE integerdatd,integerdatr,integerdati,integerdatb,integerdatc
9516END INTERFACE
9517
9520 MODULE PROCEDURE vol7d_copy
9521END INTERFACE
9522
9525 MODULE PROCEDURE vol7d_c_e
9526END INTERFACE
9527
9532 MODULE PROCEDURE vol7d_check
9533END INTERFACE
9534
9549 MODULE PROCEDURE v7d_rounding
9550END INTERFACE
9551
9552!!$INTERFACE get_volana
9553!!$ MODULE PROCEDURE vol7d_get_volanar, vol7d_get_volanad, vol7d_get_volanai, &
9554!!$ vol7d_get_volanab, vol7d_get_volanac
9555!!$END INTERFACE
9556!!$
9557!!$INTERFACE get_voldati
9558!!$ MODULE PROCEDURE vol7d_get_voldatir, vol7d_get_voldatid, vol7d_get_voldatii, &
9559!!$ vol7d_get_voldatib, vol7d_get_voldatic
9560!!$END INTERFACE
9561!!$
9562!!$INTERFACE get_volanaattr
9563!!$ MODULE PROCEDURE vol7d_get_volanaattrr, vol7d_get_volanaattrd, &
9564!!$ vol7d_get_volanaattri, vol7d_get_volanaattrb, vol7d_get_volanaattrc
9565!!$END INTERFACE
9566!!$
9567!!$INTERFACE get_voldatiattr
9568!!$ MODULE PROCEDURE vol7d_get_voldatiattrr, vol7d_get_voldatiattrd, &
9569!!$ vol7d_get_voldatiattri, vol7d_get_voldatiattrb, vol7d_get_voldatiattrc
9570!!$END INTERFACE
9571
9572PRIVATE vol7d_get_volr, vol7d_get_vold, vol7d_get_voli, vol7d_get_volb, &
9573 vol7d_get_volc, &
9574 volptr1dr, volptr2dr, volptr3dr, volptr4dr, volptr5dr, volptr6dr, volptr7dr, &
9575 volptr1dd, volptr2dd, volptr3dd, volptr4dd, volptr5dd, volptr6dd, volptr7dd, &
9576 volptr1di, volptr2di, volptr3di, volptr4di, volptr5di, volptr6di, volptr7di, &
9577 volptr1db, volptr2db, volptr3db, volptr4db, volptr5db, volptr6db, volptr7db, &
9578 volptr1dc, volptr2dc, volptr3dc, volptr4dc, volptr5dc, volptr6dc, volptr7dc, &
9579 vol7d_nullifyr, vol7d_nullifyd, vol7d_nullifyi, vol7d_nullifyb, vol7d_nullifyc, &
9580 vol7d_init, vol7d_delete, vol7d_write_on_file, vol7d_read_from_file, &
9581 vol7d_check_alloc_ana, vol7d_force_alloc_ana, &
9582 vol7d_check_alloc_dati, vol7d_force_alloc_dati, vol7d_force_alloc, &
9583 vol7d_display, dat_display, dat_vect_display, &
9584 to_char_dat, vol7d_check
9585
9586PRIVATE doubledatd,doubledatr,doubledati,doubledatb,doubledatc
9587
9588PRIVATE vol7d_c_e
9589
9590CONTAINS
9591
9592
9597SUBROUTINE vol7d_init(this,time_definition)
9598TYPE(vol7d),intent(out) :: this
9599integer,INTENT(IN),OPTIONAL :: time_definition
9600
9607CALL vol7d_var_features_init() ! initialise var features table once
9608
9609NULLIFY(this%ana, this%time, this%level, this%timerange, this%network)
9610
9611NULLIFY(this%volanar, this%volanaattrr, this%voldatir, this%voldatiattrr)
9612NULLIFY(this%volanad, this%volanaattrd, this%voldatid, this%voldatiattrd)
9613NULLIFY(this%volanai, this%volanaattri, this%voldatii, this%voldatiattri)
9614NULLIFY(this%volanab, this%volanaattrb, this%voldatib, this%voldatiattrb)
9615NULLIFY(this%volanac, this%volanaattrc, this%voldatic, this%voldatiattrc)
9616
9617if(present(time_definition)) then
9618 this%time_definition=time_definition
9619else
9620 this%time_definition=1 !default to validity time
9621end if
9622
9623END SUBROUTINE vol7d_init
9624
9625
9629ELEMENTAL SUBROUTINE vol7d_delete(this, dataonly)
9630TYPE(vol7d),intent(inout) :: this
9631LOGICAL, INTENT(in), OPTIONAL :: dataonly
9632
9633
9634IF (.NOT. optio_log(dataonly)) THEN
9635 IF (ASSOCIATED(this%volanar)) DEALLOCATE(this%volanar)
9636 IF (ASSOCIATED(this%volanad)) DEALLOCATE(this%volanad)
9637 IF (ASSOCIATED(this%volanai)) DEALLOCATE(this%volanai)
9638 IF (ASSOCIATED(this%volanab)) DEALLOCATE(this%volanab)
9639 IF (ASSOCIATED(this%volanac)) DEALLOCATE(this%volanac)
9640 IF (ASSOCIATED(this%volanaattrr)) DEALLOCATE(this%volanaattrr)
9641 IF (ASSOCIATED(this%volanaattrd)) DEALLOCATE(this%volanaattrd)
9642 IF (ASSOCIATED(this%volanaattri)) DEALLOCATE(this%volanaattri)
9643 IF (ASSOCIATED(this%volanaattrb)) DEALLOCATE(this%volanaattrb)
9644 IF (ASSOCIATED(this%volanaattrc)) DEALLOCATE(this%volanaattrc)
9645ENDIF
9646IF (ASSOCIATED(this%voldatir)) DEALLOCATE(this%voldatir)
9647IF (ASSOCIATED(this%voldatid)) DEALLOCATE(this%voldatid)
9648IF (ASSOCIATED(this%voldatii)) DEALLOCATE(this%voldatii)
9649IF (ASSOCIATED(this%voldatib)) DEALLOCATE(this%voldatib)
9650IF (ASSOCIATED(this%voldatic)) DEALLOCATE(this%voldatic)
9651IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
9652IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
9653IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
9654IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
9655IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
9656
9657IF (.NOT. optio_log(dataonly)) THEN
9658 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
9659 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
9660ENDIF
9661IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
9662IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
9663IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
9664
9665IF (.NOT. optio_log(dataonly)) THEN
9669ENDIF
9673
9674END SUBROUTINE vol7d_delete
9675
9676
9677
9678integer function vol7d_check(this)
9679TYPE(vol7d),intent(in) :: this
9680integer :: i,j,k,l,m,n
9681
9682vol7d_check=0
9683
9684if (associated(this%voldatii)) then
9685do i = 1,size(this%voldatii,1)
9686 do j = 1,size(this%voldatii,2)
9687 do k = 1,size(this%voldatii,3)
9688 do l = 1,size(this%voldatii,4)
9689 do m = 1,size(this%voldatii,5)
9690 do n = 1,size(this%voldatii,6)
9691 if (this%voldatii(i,j,k,l,m,n) /= this%voldatii(i,j,k,l,m,n) ) then
9692 CALL l4f_log(l4f_warn,"check: abnormal value at voldatii("&
9694 vol7d_check=1
9695 end if
9696 end do
9697 end do
9698 end do
9699 end do
9700 end do
9701end do
9702end if
9703
9704
9705if (associated(this%voldatir)) then
9706do i = 1,size(this%voldatir,1)
9707 do j = 1,size(this%voldatir,2)
9708 do k = 1,size(this%voldatir,3)
9709 do l = 1,size(this%voldatir,4)
9710 do m = 1,size(this%voldatir,5)
9711 do n = 1,size(this%voldatir,6)
9712 if (this%voldatir(i,j,k,l,m,n) /= this%voldatir(i,j,k,l,m,n) ) then
9713 CALL l4f_log(l4f_warn,"check: abnormal value at voldatir("&
9715 vol7d_check=2
9716 end if
9717 end do
9718 end do
9719 end do
9720 end do
9721 end do
9722end do
9723end if
9724
9725if (associated(this%voldatid)) then
9726do i = 1,size(this%voldatid,1)
9727 do j = 1,size(this%voldatid,2)
9728 do k = 1,size(this%voldatid,3)
9729 do l = 1,size(this%voldatid,4)
9730 do m = 1,size(this%voldatid,5)
9731 do n = 1,size(this%voldatid,6)
9732 if (this%voldatid(i,j,k,l,m,n) /= this%voldatid(i,j,k,l,m,n) ) then
9733 CALL l4f_log(l4f_warn,"check: abnormal value at voldatid("&
9735 vol7d_check=3
9736 end if
9737 end do
9738 end do
9739 end do
9740 end do
9741 end do
9742end do
9743end if
9744
9745if (associated(this%voldatib)) then
9746do i = 1,size(this%voldatib,1)
9747 do j = 1,size(this%voldatib,2)
9748 do k = 1,size(this%voldatib,3)
9749 do l = 1,size(this%voldatib,4)
9750 do m = 1,size(this%voldatib,5)
9751 do n = 1,size(this%voldatib,6)
9752 if (this%voldatib(i,j,k,l,m,n) /= this%voldatib(i,j,k,l,m,n) ) then
9753 CALL l4f_log(l4f_warn,"check: abnormal value at voldatib("&
9755 vol7d_check=4
9756 end if
9757 end do
9758 end do
9759 end do
9760 end do
9761 end do
9762end do
9763end if
9764
9765end function vol7d_check
9766
9767
9768
9769!TODO da completare ! aborta se i volumi sono allocati a dimensione 0
9771SUBROUTINE vol7d_display(this)
9772TYPE(vol7d),intent(in) :: this
9773integer :: i
9774
9775REAL :: rdat
9776DOUBLE PRECISION :: ddat
9777INTEGER :: idat
9778INTEGER(kind=int_b) :: bdat
9779CHARACTER(len=vol7d_cdatalen) :: cdat
9780
9781
9782print*,"<<<<<<<<<<<<<<<<<<< vol7d object >>>>>>>>>>>>>>>>>>>>"
9783if (this%time_definition == 0) then
9784 print*,"TIME DEFINITION: time is reference time"
9785else if (this%time_definition == 1) then
9786 print*,"TIME DEFINITION: time is validity time"
9787else
9788 print*,"Time definition have a wrong walue:", this%time_definition
9789end if
9790
9791IF (ASSOCIATED(this%network))then
9792 print*,"---- network vector ----"
9793 print*,"elements=",size(this%network)
9794 do i=1, size(this%network)
9796 end do
9797end IF
9798
9799IF (ASSOCIATED(this%ana))then
9800 print*,"---- ana vector ----"
9801 print*,"elements=",size(this%ana)
9802 do i=1, size(this%ana)
9804 end do
9805end IF
9806
9807IF (ASSOCIATED(this%time))then
9808 print*,"---- time vector ----"
9809 print*,"elements=",size(this%time)
9810 do i=1, size(this%time)
9812 end do
9813end if
9814
9815IF (ASSOCIATED(this%level)) then
9816 print*,"---- level vector ----"
9817 print*,"elements=",size(this%level)
9818 do i =1,size(this%level)
9820 end do
9821end if
9822
9823IF (ASSOCIATED(this%timerange))then
9824 print*,"---- timerange vector ----"
9825 print*,"elements=",size(this%timerange)
9826 do i =1,size(this%timerange)
9828 end do
9829end if
9830
9831
9832print*,"---- ana vector ----"
9833print*,""
9834print*,"->>>>>>>>> anavar -"
9836print*,""
9837print*,"->>>>>>>>> anaattr -"
9839print*,""
9840print*,"->>>>>>>>> anavarattr -"
9842
9843print*,"-- ana data section (first point) --"
9844
9845idat=imiss
9846rdat=rmiss
9847ddat=dmiss
9848bdat=ibmiss
9849cdat=cmiss
9850
9851!ntime = MIN(SIZE(this%time),nprint)
9852!ntimerange = MIN(SIZE(this%timerange),nprint)
9853!nlevel = MIN(SIZE(this%level),nprint)
9854!nnetwork = MIN(SIZE(this%network),nprint)
9855!nana = MIN(SIZE(this%ana),nprint)
9856
9857IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0) THEN
9858if (associated(this%volanai)) then
9859 do i=1,size(this%anavar%i)
9860 idat=this%volanai(1,i,1)
9862 end do
9863end if
9864idat=imiss
9865
9866if (associated(this%volanar)) then
9867 do i=1,size(this%anavar%r)
9868 rdat=this%volanar(1,i,1)
9870 end do
9871end if
9872rdat=rmiss
9873
9874if (associated(this%volanad)) then
9875 do i=1,size(this%anavar%d)
9876 ddat=this%volanad(1,i,1)
9878 end do
9879end if
9880ddat=dmiss
9881
9882if (associated(this%volanab)) then
9883 do i=1,size(this%anavar%b)
9884 bdat=this%volanab(1,i,1)
9886 end do
9887end if
9888bdat=ibmiss
9889
9890if (associated(this%volanac)) then
9891 do i=1,size(this%anavar%c)
9892 cdat=this%volanac(1,i,1)
9894 end do
9895end if
9896cdat=cmiss
9897ENDIF
9898
9899print*,"---- data vector ----"
9900print*,""
9901print*,"->>>>>>>>> dativar -"
9903print*,""
9904print*,"->>>>>>>>> datiattr -"
9906print*,""
9907print*,"->>>>>>>>> dativarattr -"
9909
9910print*,"-- data data section (first point) --"
9911
9912idat=imiss
9913rdat=rmiss
9914ddat=dmiss
9915bdat=ibmiss
9916cdat=cmiss
9917
9918IF (SIZE(this%ana) > 0 .AND. SIZE(this%network) > 0 .AND. size(this%time) > 0 &
9919 .AND. size(this%level) > 0 .AND. size(this%timerange) > 0) THEN
9920if (associated(this%voldatii)) then
9921 do i=1,size(this%dativar%i)
9922 idat=this%voldatii(1,1,1,1,i,1)
9924 end do
9925end if
9926idat=imiss
9927
9928if (associated(this%voldatir)) then
9929 do i=1,size(this%dativar%r)
9930 rdat=this%voldatir(1,1,1,1,i,1)
9932 end do
9933end if
9934rdat=rmiss
9935
9936if (associated(this%voldatid)) then
9937 do i=1,size(this%dativar%d)
9938 ddat=this%voldatid(1,1,1,1,i,1)
9940 end do
9941end if
9942ddat=dmiss
9943
9944if (associated(this%voldatib)) then
9945 do i=1,size(this%dativar%b)
9946 bdat=this%voldatib(1,1,1,1,i,1)
9948 end do
9949end if
9950bdat=ibmiss
9951
9952if (associated(this%voldatic)) then
9953 do i=1,size(this%dativar%c)
9954 cdat=this%voldatic(1,1,1,1,i,1)
9956 end do
9957end if
9958cdat=cmiss
9959ENDIF
9960
9961print*,"<<<<<<<<<<<<<<<<<<< END vol7d object >>>>>>>>>>>>>>>>>>>>"
9962
9963END SUBROUTINE vol7d_display
9964
9965
9967SUBROUTINE dat_display(this,idat,rdat,ddat,bdat,cdat)
9968TYPE(vol7d_var),intent(in) :: this
9970REAL :: rdat
9972DOUBLE PRECISION :: ddat
9974INTEGER :: idat
9976INTEGER(kind=int_b) :: bdat
9978CHARACTER(len=*) :: cdat
9979
9980print *, to_char_dat(this,idat,rdat,ddat,bdat,cdat)
9981
9982end SUBROUTINE dat_display
9983
9985SUBROUTINE dat_vect_display(this,idat,rdat,ddat,bdat,cdat)
9986
9987TYPE(vol7d_var),intent(in) :: this(:)
9989REAL :: rdat(:)
9991DOUBLE PRECISION :: ddat(:)
9993INTEGER :: idat(:)
9995INTEGER(kind=int_b) :: bdat(:)
9997CHARACTER(len=*):: cdat(:)
9998
9999integer :: i
10000
10001do i =1,size(this)
10003end do
10004
10005end SUBROUTINE dat_vect_display
10006
10007
10008FUNCTION to_char_dat(this,idat,rdat,ddat,bdat,cdat)
10009#ifdef HAVE_DBALLE
10010USE dballef
10011#endif
10012TYPE(vol7d_var),INTENT(in) :: this
10014REAL :: rdat
10016DOUBLE PRECISION :: ddat
10018INTEGER :: idat
10020INTEGER(kind=int_b) :: bdat
10022CHARACTER(len=*) :: cdat
10023CHARACTER(len=80) :: to_char_dat
10024
10025CHARACTER(len=LEN(to_char_dat)) :: to_char_tmp
10026
10027
10028#ifdef HAVE_DBALLE
10029INTEGER :: handle, ier
10030
10031handle = 0
10032to_char_dat="VALUE: "
10033
10038
10040 ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
10041 ier = idba_spiegab(handle,this%btable,cdat,to_char_tmp)
10042 ier = idba_fatto(handle)
10043 to_char_dat=trim(to_char_dat)//" ;char> "//trim(to_char_tmp)
10044endif
10045
10046#else
10047
10048to_char_dat="VALUE: "
10054
10055#endif
10056
10057END FUNCTION to_char_dat
10058
10059
10062FUNCTION vol7d_c_e(this) RESULT(c_e)
10063TYPE(vol7d), INTENT(in) :: this
10064
10065LOGICAL :: c_e
10066
10068 ASSOCIATED(this%level) .OR. ASSOCIATED(this%timerange) .OR. &
10069 ASSOCIATED(this%network) .OR. &
10070 ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
10071 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
10072 ASSOCIATED(this%anavar%c) .OR. &
10073 ASSOCIATED(this%anaattr%r) .OR. ASSOCIATED(this%anaattr%d) .OR. &
10074 ASSOCIATED(this%anaattr%i) .OR. ASSOCIATED(this%anaattr%b) .OR. &
10075 ASSOCIATED(this%anaattr%c) .OR. &
10076 ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
10077 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
10078 ASSOCIATED(this%dativar%c) .OR. &
10079 ASSOCIATED(this%datiattr%r) .OR. ASSOCIATED(this%datiattr%d) .OR. &
10080 ASSOCIATED(this%datiattr%i) .OR. ASSOCIATED(this%datiattr%b) .OR. &
10081 ASSOCIATED(this%datiattr%c)
10082
10083END FUNCTION vol7d_c_e
10084
10085
10124SUBROUTINE vol7d_alloc(this, nana, ntime, nlevel, ntimerange, nnetwork, &
10125 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
10126 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
10127 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
10128 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
10129 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
10130 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc, &
10131 ini)
10132TYPE(vol7d),INTENT(inout) :: this
10133INTEGER,INTENT(in),OPTIONAL :: nana
10134INTEGER,INTENT(in),OPTIONAL :: ntime
10135INTEGER,INTENT(in),OPTIONAL :: nlevel
10136INTEGER,INTENT(in),OPTIONAL :: ntimerange
10137INTEGER,INTENT(in),OPTIONAL :: nnetwork
10139INTEGER,INTENT(in),OPTIONAL :: &
10140 nanavarr, nanavard, nanavari, nanavarb, nanavarc, &
10141 nanaattrr, nanaattrd, nanaattri, nanaattrb, nanaattrc, &
10142 nanavarattrr, nanavarattrd, nanavarattri, nanavarattrb, nanavarattrc, &
10143 ndativarr, ndativard, ndativari, ndativarb, ndativarc, &
10144 ndatiattrr, ndatiattrd, ndatiattri, ndatiattrb, ndatiattrc, &
10145 ndativarattrr, ndativarattrd, ndativarattri, ndativarattrb, ndativarattrc
10146LOGICAL,INTENT(in),OPTIONAL :: ini
10147
10148INTEGER :: i
10149LOGICAL :: linit
10150
10151IF (PRESENT(ini)) THEN
10152 linit = ini
10153ELSE
10154 linit = .false.
10155ENDIF
10156
10157! Dimensioni principali
10158IF (PRESENT(nana)) THEN
10159 IF (nana >= 0) THEN
10160 IF (ASSOCIATED(this%ana)) DEALLOCATE(this%ana)
10161 ALLOCATE(this%ana(nana))
10162 IF (linit) THEN
10163 DO i = 1, nana
10165 ENDDO
10166 ENDIF
10167 ENDIF
10168ENDIF
10169IF (PRESENT(ntime)) THEN
10170 IF (ntime >= 0) THEN
10171 IF (ASSOCIATED(this%time)) DEALLOCATE(this%time)
10172 ALLOCATE(this%time(ntime))
10173 IF (linit) THEN
10174 DO i = 1, ntime
10176 ENDDO
10177 ENDIF
10178 ENDIF
10179ENDIF
10180IF (PRESENT(nlevel)) THEN
10181 IF (nlevel >= 0) THEN
10182 IF (ASSOCIATED(this%level)) DEALLOCATE(this%level)
10183 ALLOCATE(this%level(nlevel))
10184 IF (linit) THEN
10185 DO i = 1, nlevel
10187 ENDDO
10188 ENDIF
10189 ENDIF
10190ENDIF
10191IF (PRESENT(ntimerange)) THEN
10192 IF (ntimerange >= 0) THEN
10193 IF (ASSOCIATED(this%timerange)) DEALLOCATE(this%timerange)
10194 ALLOCATE(this%timerange(ntimerange))
10195 IF (linit) THEN
10196 DO i = 1, ntimerange
10198 ENDDO
10199 ENDIF
10200 ENDIF
10201ENDIF
10202IF (PRESENT(nnetwork)) THEN
10203 IF (nnetwork >= 0) THEN
10204 IF (ASSOCIATED(this%network)) DEALLOCATE(this%network)
10205 ALLOCATE(this%network(nnetwork))
10206 IF (linit) THEN
10207 DO i = 1, nnetwork
10209 ENDDO
10210 ENDIF
10211 ENDIF
10212ENDIF
10213! Dimensioni dei tipi delle variabili
10214CALL vol7d_varvect_alloc(this%anavar, nanavarr, nanavard, &
10215 nanavari, nanavarb, nanavarc, ini)
10216CALL vol7d_varvect_alloc(this%anaattr, nanaattrr, nanaattrd, &
10217 nanaattri, nanaattrb, nanaattrc, ini)
10218CALL vol7d_varvect_alloc(this%anavarattr, nanavarattrr, nanavarattrd, &
10219 nanavarattri, nanavarattrb, nanavarattrc, ini)
10220CALL vol7d_varvect_alloc(this%dativar, ndativarr, ndativard, &
10221 ndativari, ndativarb, ndativarc, ini)
10222CALL vol7d_varvect_alloc(this%datiattr, ndatiattrr, ndatiattrd, &
10223 ndatiattri, ndatiattrb, ndatiattrc, ini)
10224CALL vol7d_varvect_alloc(this%dativarattr, ndativarattrr, ndativarattrd, &
10225 ndativarattri, ndativarattrb, ndativarattrc, ini)
10226
10227END SUBROUTINE vol7d_alloc
10228
10229
10230FUNCTION vol7d_check_alloc_ana(this)
10231TYPE(vol7d),INTENT(in) :: this
10232LOGICAL :: vol7d_check_alloc_ana
10233
10234vol7d_check_alloc_ana = ASSOCIATED(this%ana) .AND. ASSOCIATED(this%network)
10235
10236END FUNCTION vol7d_check_alloc_ana
10237
10238SUBROUTINE vol7d_force_alloc_ana(this, ini)
10239TYPE(vol7d),INTENT(inout) :: this
10240LOGICAL,INTENT(in),OPTIONAL :: ini
10241
10242! Alloco i descrittori minimi per avere un volume di anagrafica
10243IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=1, ini=ini)
10244IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=1, ini=ini)
10245
10246END SUBROUTINE vol7d_force_alloc_ana
10247
10248
10249FUNCTION vol7d_check_alloc_dati(this)
10250TYPE(vol7d),INTENT(in) :: this
10251LOGICAL :: vol7d_check_alloc_dati
10252
10253vol7d_check_alloc_dati = vol7d_check_alloc_ana(this) .AND. &
10254 ASSOCIATED(this%time) .AND. ASSOCIATED(this%level) .AND. &
10255 ASSOCIATED(this%timerange)
10256
10257END FUNCTION vol7d_check_alloc_dati
10258
10259SUBROUTINE vol7d_force_alloc_dati(this, ini)
10260TYPE(vol7d),INTENT(inout) :: this
10261LOGICAL,INTENT(in),OPTIONAL :: ini
10262
10263! Alloco i descrittori minimi per avere un volume di dati
10264CALL vol7d_force_alloc_ana(this, ini)
10265IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=1, ini=ini)
10266IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=1, ini=ini)
10267IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=1, ini=ini)
10268
10269END SUBROUTINE vol7d_force_alloc_dati
10270
10271
10272SUBROUTINE vol7d_force_alloc(this)
10273TYPE(vol7d),INTENT(inout) :: this
10274
10275! If anything really not allocated yet, allocate with size 0
10276IF (.NOT. ASSOCIATED(this%ana)) CALL vol7d_alloc(this, nana=0)
10277IF (.NOT. ASSOCIATED(this%network)) CALL vol7d_alloc(this, nnetwork=0)
10278IF (.NOT. ASSOCIATED(this%time)) CALL vol7d_alloc(this, ntime=0)
10279IF (.NOT. ASSOCIATED(this%level)) CALL vol7d_alloc(this, nlevel=0)
10280IF (.NOT. ASSOCIATED(this%timerange)) CALL vol7d_alloc(this, ntimerange=0)
10281
10282END SUBROUTINE vol7d_force_alloc
10283
10284
10285FUNCTION vol7d_check_vol(this)
10286TYPE(vol7d),INTENT(in) :: this
10287LOGICAL :: vol7d_check_vol
10288
10289vol7d_check_vol = c_e(this)
10290
10291! Anagrafica
10292IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
10293 vol7d_check_vol = .false.
10294ENDIF
10295
10296IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
10297 vol7d_check_vol = .false.
10298ENDIF
10299
10300IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
10301 vol7d_check_vol = .false.
10302ENDIF
10303
10304IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
10305 vol7d_check_vol = .false.
10306ENDIF
10307
10308IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
10309 vol7d_check_vol = .false.
10310ENDIF
10311IF (ASSOCIATED(this%anavar%r) .OR. ASSOCIATED(this%anavar%d) .OR. &
10312 ASSOCIATED(this%anavar%i) .OR. ASSOCIATED(this%anavar%b) .OR. &
10313 ASSOCIATED(this%anavar%c)) THEN
10314 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_ana(this)
10315ENDIF
10316
10317! Attributi dell'anagrafica
10318IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
10319 .NOT.ASSOCIATED(this%volanaattrr)) THEN
10320 vol7d_check_vol = .false.
10321ENDIF
10322
10323IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
10324 .NOT.ASSOCIATED(this%volanaattrd)) THEN
10325 vol7d_check_vol = .false.
10326ENDIF
10327
10328IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
10329 .NOT.ASSOCIATED(this%volanaattri)) THEN
10330 vol7d_check_vol = .false.
10331ENDIF
10332
10333IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
10334 .NOT.ASSOCIATED(this%volanaattrb)) THEN
10335 vol7d_check_vol = .false.
10336ENDIF
10337
10338IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
10339 .NOT.ASSOCIATED(this%volanaattrc)) THEN
10340 vol7d_check_vol = .false.
10341ENDIF
10342
10343! Dati
10344IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
10345 vol7d_check_vol = .false.
10346ENDIF
10347
10348IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
10349 vol7d_check_vol = .false.
10350ENDIF
10351
10352IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
10353 vol7d_check_vol = .false.
10354ENDIF
10355
10356IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
10357 vol7d_check_vol = .false.
10358ENDIF
10359
10360IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
10361 vol7d_check_vol = .false.
10362ENDIF
10363
10364! Attributi dei dati
10365IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
10366 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
10367 vol7d_check_vol = .false.
10368ENDIF
10369
10370IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
10371 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
10372 vol7d_check_vol = .false.
10373ENDIF
10374
10375IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
10376 .NOT.ASSOCIATED(this%voldatiattri)) THEN
10377 vol7d_check_vol = .false.
10378ENDIF
10379
10380IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
10381 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
10382 vol7d_check_vol = .false.
10383ENDIF
10384
10385IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
10386 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
10387 vol7d_check_vol = .false.
10388ENDIF
10389IF (ASSOCIATED(this%dativar%r) .OR. ASSOCIATED(this%dativar%d) .OR. &
10390 ASSOCIATED(this%dativar%i) .OR. ASSOCIATED(this%dativar%b) .OR. &
10391 ASSOCIATED(this%dativar%c)) THEN
10392 vol7d_check_vol = vol7d_check_vol .AND. vol7d_check_alloc_dati(this)
10393ENDIF
10394
10395END FUNCTION vol7d_check_vol
10396
10397
10412SUBROUTINE vol7d_alloc_vol(this, ini, inivol)
10413TYPE(vol7d),INTENT(inout) :: this
10414LOGICAL,INTENT(in),OPTIONAL :: ini
10415LOGICAL,INTENT(in),OPTIONAL :: inivol
10416
10417LOGICAL :: linivol
10418
10419IF (PRESENT(inivol)) THEN
10420 linivol = inivol
10421ELSE
10422 linivol = .true.
10423ENDIF
10424
10425! Anagrafica
10426IF (ASSOCIATED(this%anavar%r) .AND. .NOT.ASSOCIATED(this%volanar)) THEN
10427 CALL vol7d_force_alloc_ana(this, ini)
10428 ALLOCATE(this%volanar(SIZE(this%ana), SIZE(this%anavar%r), SIZE(this%network)))
10429 IF (linivol) this%volanar(:,:,:) = rmiss
10430ENDIF
10431
10432IF (ASSOCIATED(this%anavar%d) .AND. .NOT.ASSOCIATED(this%volanad)) THEN
10433 CALL vol7d_force_alloc_ana(this, ini)
10434 ALLOCATE(this%volanad(SIZE(this%ana), SIZE(this%anavar%d), SIZE(this%network)))
10435 IF (linivol) this%volanad(:,:,:) = rdmiss
10436ENDIF
10437
10438IF (ASSOCIATED(this%anavar%i) .AND. .NOT.ASSOCIATED(this%volanai)) THEN
10439 CALL vol7d_force_alloc_ana(this, ini)
10440 ALLOCATE(this%volanai(SIZE(this%ana), SIZE(this%anavar%i), SIZE(this%network)))
10441 IF (linivol) this%volanai(:,:,:) = imiss
10442ENDIF
10443
10444IF (ASSOCIATED(this%anavar%b) .AND. .NOT.ASSOCIATED(this%volanab)) THEN
10445 CALL vol7d_force_alloc_ana(this, ini)
10446 ALLOCATE(this%volanab(SIZE(this%ana), SIZE(this%anavar%b), SIZE(this%network)))
10447 IF (linivol) this%volanab(:,:,:) = ibmiss
10448ENDIF
10449
10450IF (ASSOCIATED(this%anavar%c) .AND. .NOT.ASSOCIATED(this%volanac)) THEN
10451 CALL vol7d_force_alloc_ana(this, ini)
10452 ALLOCATE(this%volanac(SIZE(this%ana), SIZE(this%anavar%c), SIZE(this%network)))
10453 IF (linivol) this%volanac(:,:,:) = cmiss
10454ENDIF
10455
10456! Attributi dell'anagrafica
10457IF (ASSOCIATED(this%anaattr%r) .AND. ASSOCIATED(this%anavarattr%r) .AND. &
10458 .NOT.ASSOCIATED(this%volanaattrr)) THEN
10459 CALL vol7d_force_alloc_ana(this, ini)
10460 ALLOCATE(this%volanaattrr(SIZE(this%ana), SIZE(this%anavarattr%r), &
10461 SIZE(this%network), SIZE(this%anaattr%r)))
10462 IF (linivol) this%volanaattrr(:,:,:,:) = rmiss
10463ENDIF
10464
10465IF (ASSOCIATED(this%anaattr%d) .AND. ASSOCIATED(this%anavarattr%d) .AND. &
10466 .NOT.ASSOCIATED(this%volanaattrd)) THEN
10467 CALL vol7d_force_alloc_ana(this, ini)
10468 ALLOCATE(this%volanaattrd(SIZE(this%ana), SIZE(this%anavarattr%d), &
10469 SIZE(this%network), SIZE(this%anaattr%d)))
10470 IF (linivol) this%volanaattrd(:,:,:,:) = rdmiss
10471ENDIF
10472
10473IF (ASSOCIATED(this%anaattr%i) .AND. ASSOCIATED(this%anavarattr%i) .AND. &
10474 .NOT.ASSOCIATED(this%volanaattri)) THEN
10475 CALL vol7d_force_alloc_ana(this, ini)
10476 ALLOCATE(this%volanaattri(SIZE(this%ana), SIZE(this%anavarattr%i), &
10477 SIZE(this%network), SIZE(this%anaattr%i)))
10478 IF (linivol) this%volanaattri(:,:,:,:) = imiss
10479ENDIF
10480
10481IF (ASSOCIATED(this%anaattr%b) .AND. ASSOCIATED(this%anavarattr%b) .AND. &
10482 .NOT.ASSOCIATED(this%volanaattrb)) THEN
10483 CALL vol7d_force_alloc_ana(this, ini)
10484 ALLOCATE(this%volanaattrb(SIZE(this%ana), SIZE(this%anavarattr%b), &
10485 SIZE(this%network), SIZE(this%anaattr%b)))
10486 IF (linivol) this%volanaattrb(:,:,:,:) = ibmiss
10487ENDIF
10488
10489IF (ASSOCIATED(this%anaattr%c) .AND. ASSOCIATED(this%anavarattr%c) .AND. &
10490 .NOT.ASSOCIATED(this%volanaattrc)) THEN
10491 CALL vol7d_force_alloc_ana(this, ini)
10492 ALLOCATE(this%volanaattrc(SIZE(this%ana), SIZE(this%anavarattr%c), &
10493 SIZE(this%network), SIZE(this%anaattr%c)))
10494 IF (linivol) this%volanaattrc(:,:,:,:) = cmiss
10495ENDIF
10496
10497! Dati
10498IF (ASSOCIATED(this%dativar%r) .AND. .NOT.ASSOCIATED(this%voldatir)) THEN
10499 CALL vol7d_force_alloc_dati(this, ini)
10500 ALLOCATE(this%voldatir(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10501 SIZE(this%timerange), SIZE(this%dativar%r), SIZE(this%network)))
10502 IF (linivol) this%voldatir(:,:,:,:,:,:) = rmiss
10503ENDIF
10504
10505IF (ASSOCIATED(this%dativar%d) .AND. .NOT.ASSOCIATED(this%voldatid)) THEN
10506 CALL vol7d_force_alloc_dati(this, ini)
10507 ALLOCATE(this%voldatid(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10508 SIZE(this%timerange), SIZE(this%dativar%d), SIZE(this%network)))
10509 IF (linivol) this%voldatid(:,:,:,:,:,:) = rdmiss
10510ENDIF
10511
10512IF (ASSOCIATED(this%dativar%i) .AND. .NOT.ASSOCIATED(this%voldatii)) THEN
10513 CALL vol7d_force_alloc_dati(this, ini)
10514 ALLOCATE(this%voldatii(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10515 SIZE(this%timerange), SIZE(this%dativar%i), SIZE(this%network)))
10516 IF (linivol) this%voldatii(:,:,:,:,:,:) = imiss
10517ENDIF
10518
10519IF (ASSOCIATED(this%dativar%b) .AND. .NOT.ASSOCIATED(this%voldatib)) THEN
10520 CALL vol7d_force_alloc_dati(this, ini)
10521 ALLOCATE(this%voldatib(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10522 SIZE(this%timerange), SIZE(this%dativar%b), SIZE(this%network)))
10523 IF (linivol) this%voldatib(:,:,:,:,:,:) = ibmiss
10524ENDIF
10525
10526IF (ASSOCIATED(this%dativar%c) .AND. .NOT.ASSOCIATED(this%voldatic)) THEN
10527 CALL vol7d_force_alloc_dati(this, ini)
10528 ALLOCATE(this%voldatic(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10529 SIZE(this%timerange), SIZE(this%dativar%c), SIZE(this%network)))
10530 IF (linivol) this%voldatic(:,:,:,:,:,:) = cmiss
10531ENDIF
10532
10533! Attributi dei dati
10534IF (ASSOCIATED(this%datiattr%r) .AND. ASSOCIATED(this%dativarattr%r) .AND. &
10535 .NOT.ASSOCIATED(this%voldatiattrr)) THEN
10536 CALL vol7d_force_alloc_dati(this, ini)
10537 ALLOCATE(this%voldatiattrr(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10538 SIZE(this%timerange), SIZE(this%dativarattr%r), SIZE(this%network), &
10539 SIZE(this%datiattr%r)))
10540 IF (linivol) this%voldatiattrr(:,:,:,:,:,:,:) = rmiss
10541ENDIF
10542
10543IF (ASSOCIATED(this%datiattr%d) .AND. ASSOCIATED(this%dativarattr%d) .AND. &
10544 .NOT.ASSOCIATED(this%voldatiattrd)) THEN
10545 CALL vol7d_force_alloc_dati(this, ini)
10546 ALLOCATE(this%voldatiattrd(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10547 SIZE(this%timerange), SIZE(this%dativarattr%d), SIZE(this%network), &
10548 SIZE(this%datiattr%d)))
10549 IF (linivol) this%voldatiattrd(:,:,:,:,:,:,:) = rdmiss
10550ENDIF
10551
10552IF (ASSOCIATED(this%datiattr%i) .AND. ASSOCIATED(this%dativarattr%i) .AND. &
10553 .NOT.ASSOCIATED(this%voldatiattri)) THEN
10554 CALL vol7d_force_alloc_dati(this, ini)
10555 ALLOCATE(this%voldatiattri(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10556 SIZE(this%timerange), SIZE(this%dativarattr%i), SIZE(this%network), &
10557 SIZE(this%datiattr%i)))
10558 IF (linivol) this%voldatiattri(:,:,:,:,:,:,:) = imiss
10559ENDIF
10560
10561IF (ASSOCIATED(this%datiattr%b) .AND. ASSOCIATED(this%dativarattr%b) .AND. &
10562 .NOT.ASSOCIATED(this%voldatiattrb)) THEN
10563 CALL vol7d_force_alloc_dati(this, ini)
10564 ALLOCATE(this%voldatiattrb(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10565 SIZE(this%timerange), SIZE(this%dativarattr%b), SIZE(this%network), &
10566 SIZE(this%datiattr%b)))
10567 IF (linivol) this%voldatiattrb(:,:,:,:,:,:,:) = ibmiss
10568ENDIF
10569
10570IF (ASSOCIATED(this%datiattr%c) .AND. ASSOCIATED(this%dativarattr%c) .AND. &
10571 .NOT.ASSOCIATED(this%voldatiattrc)) THEN
10572 CALL vol7d_force_alloc_dati(this, ini)
10573 ALLOCATE(this%voldatiattrc(SIZE(this%ana), SIZE(this%time), SIZE(this%level), &
10574 SIZE(this%timerange), SIZE(this%dativarattr%c), SIZE(this%network), &
10575 SIZE(this%datiattr%c)))
10576 IF (linivol) this%voldatiattrc(:,:,:,:,:,:,:) = cmiss
10577ENDIF
10578
10579! Catch-all method
10580CALL vol7d_force_alloc(this)
10581
10582! Creo gli indici var-attr
10583
10584#ifdef DEBUG
10585CALL l4f_log(l4f_debug,"calling: vol7d_set_attr_ind")
10586#endif
10587
10588CALL vol7d_set_attr_ind(this)
10589
10590
10591
10592END SUBROUTINE vol7d_alloc_vol
10593
10594
10601SUBROUTINE vol7d_set_attr_ind(this)
10602TYPE(vol7d),INTENT(inout) :: this
10603
10604INTEGER :: i
10605
10606! real
10607IF (ASSOCIATED(this%dativar%r)) THEN
10608 IF (ASSOCIATED(this%dativarattr%r)) THEN
10609 DO i = 1, SIZE(this%dativar%r)
10610 this%dativar%r(i)%r = &
10611 firsttrue(this%dativar%r(i)%btable == this%dativarattr%r(:)%btable)
10612 ENDDO
10613 ENDIF
10614
10615 IF (ASSOCIATED(this%dativarattr%d)) THEN
10616 DO i = 1, SIZE(this%dativar%r)
10617 this%dativar%r(i)%d = &
10618 firsttrue(this%dativar%r(i)%btable == this%dativarattr%d(:)%btable)
10619 ENDDO
10620 ENDIF
10621
10622 IF (ASSOCIATED(this%dativarattr%i)) THEN
10623 DO i = 1, SIZE(this%dativar%r)
10624 this%dativar%r(i)%i = &
10625 firsttrue(this%dativar%r(i)%btable == this%dativarattr%i(:)%btable)
10626 ENDDO
10627 ENDIF
10628
10629 IF (ASSOCIATED(this%dativarattr%b)) THEN
10630 DO i = 1, SIZE(this%dativar%r)
10631 this%dativar%r(i)%b = &
10632 firsttrue(this%dativar%r(i)%btable == this%dativarattr%b(:)%btable)
10633 ENDDO
10634 ENDIF
10635
10636 IF (ASSOCIATED(this%dativarattr%c)) THEN
10637 DO i = 1, SIZE(this%dativar%r)
10638 this%dativar%r(i)%c = &
10639 firsttrue(this%dativar%r(i)%btable == this%dativarattr%c(:)%btable)
10640 ENDDO
10641 ENDIF
10642ENDIF
10643! double
10644IF (ASSOCIATED(this%dativar%d)) THEN
10645 IF (ASSOCIATED(this%dativarattr%r)) THEN
10646 DO i = 1, SIZE(this%dativar%d)
10647 this%dativar%d(i)%r = &
10648 firsttrue(this%dativar%d(i)%btable == this%dativarattr%r(:)%btable)
10649 ENDDO
10650 ENDIF
10651
10652 IF (ASSOCIATED(this%dativarattr%d)) THEN
10653 DO i = 1, SIZE(this%dativar%d)
10654 this%dativar%d(i)%d = &
10655 firsttrue(this%dativar%d(i)%btable == this%dativarattr%d(:)%btable)
10656 ENDDO
10657 ENDIF
10658
10659 IF (ASSOCIATED(this%dativarattr%i)) THEN
10660 DO i = 1, SIZE(this%dativar%d)
10661 this%dativar%d(i)%i = &
10662 firsttrue(this%dativar%d(i)%btable == this%dativarattr%i(:)%btable)
10663 ENDDO
10664 ENDIF
10665
10666 IF (ASSOCIATED(this%dativarattr%b)) THEN
10667 DO i = 1, SIZE(this%dativar%d)
10668 this%dativar%d(i)%b = &
10669 firsttrue(this%dativar%d(i)%btable == this%dativarattr%b(:)%btable)
10670 ENDDO
10671 ENDIF
10672
10673 IF (ASSOCIATED(this%dativarattr%c)) THEN
10674 DO i = 1, SIZE(this%dativar%d)
10675 this%dativar%d(i)%c = &
10676 firsttrue(this%dativar%d(i)%btable == this%dativarattr%c(:)%btable)
10677 ENDDO
10678 ENDIF
10679ENDIF
10680! integer
10681IF (ASSOCIATED(this%dativar%i)) THEN
10682 IF (ASSOCIATED(this%dativarattr%r)) THEN
10683 DO i = 1, SIZE(this%dativar%i)
10684 this%dativar%i(i)%r = &
10685 firsttrue(this%dativar%i(i)%btable == this%dativarattr%r(:)%btable)
10686 ENDDO
10687 ENDIF
10688
10689 IF (ASSOCIATED(this%dativarattr%d)) THEN
10690 DO i = 1, SIZE(this%dativar%i)
10691 this%dativar%i(i)%d = &
10692 firsttrue(this%dativar%i(i)%btable == this%dativarattr%d(:)%btable)
10693 ENDDO
10694 ENDIF
10695
10696 IF (ASSOCIATED(this%dativarattr%i)) THEN
10697 DO i = 1, SIZE(this%dativar%i)
10698 this%dativar%i(i)%i = &
10699 firsttrue(this%dativar%i(i)%btable == this%dativarattr%i(:)%btable)
10700 ENDDO
10701 ENDIF
10702
10703 IF (ASSOCIATED(this%dativarattr%b)) THEN
10704 DO i = 1, SIZE(this%dativar%i)
10705 this%dativar%i(i)%b = &
10706 firsttrue(this%dativar%i(i)%btable == this%dativarattr%b(:)%btable)
10707 ENDDO
10708 ENDIF
10709
10710 IF (ASSOCIATED(this%dativarattr%c)) THEN
10711 DO i = 1, SIZE(this%dativar%i)
10712 this%dativar%i(i)%c = &
10713 firsttrue(this%dativar%i(i)%btable == this%dativarattr%c(:)%btable)
10714 ENDDO
10715 ENDIF
10716ENDIF
10717! byte
10718IF (ASSOCIATED(this%dativar%b)) THEN
10719 IF (ASSOCIATED(this%dativarattr%r)) THEN
10720 DO i = 1, SIZE(this%dativar%b)
10721 this%dativar%b(i)%r = &
10722 firsttrue(this%dativar%b(i)%btable == this%dativarattr%r(:)%btable)
10723 ENDDO
10724 ENDIF
10725
10726 IF (ASSOCIATED(this%dativarattr%d)) THEN
10727 DO i = 1, SIZE(this%dativar%b)
10728 this%dativar%b(i)%d = &
10729 firsttrue(this%dativar%b(i)%btable == this%dativarattr%d(:)%btable)
10730 ENDDO
10731 ENDIF
10732
10733 IF (ASSOCIATED(this%dativarattr%i)) THEN
10734 DO i = 1, SIZE(this%dativar%b)
10735 this%dativar%b(i)%i = &
10736 firsttrue(this%dativar%b(i)%btable == this%dativarattr%i(:)%btable)
10737 ENDDO
10738 ENDIF
10739
10740 IF (ASSOCIATED(this%dativarattr%b)) THEN
10741 DO i = 1, SIZE(this%dativar%b)
10742 this%dativar%b(i)%b = &
10743 firsttrue(this%dativar%b(i)%btable == this%dativarattr%b(:)%btable)
10744 ENDDO
10745 ENDIF
10746
10747 IF (ASSOCIATED(this%dativarattr%c)) THEN
10748 DO i = 1, SIZE(this%dativar%b)
10749 this%dativar%b(i)%c = &
10750 firsttrue(this%dativar%b(i)%btable == this%dativarattr%c(:)%btable)
10751 ENDDO
10752 ENDIF
10753ENDIF
10754! character
10755IF (ASSOCIATED(this%dativar%c)) THEN
10756 IF (ASSOCIATED(this%dativarattr%r)) THEN
10757 DO i = 1, SIZE(this%dativar%c)
10758 this%dativar%c(i)%r = &
10759 firsttrue(this%dativar%c(i)%btable == this%dativarattr%r(:)%btable)
10760 ENDDO
10761 ENDIF
10762
10763 IF (ASSOCIATED(this%dativarattr%d)) THEN
10764 DO i = 1, SIZE(this%dativar%c)
10765 this%dativar%c(i)%d = &
10766 firsttrue(this%dativar%c(i)%btable == this%dativarattr%d(:)%btable)
10767 ENDDO
10768 ENDIF
10769
10770 IF (ASSOCIATED(this%dativarattr%i)) THEN
10771 DO i = 1, SIZE(this%dativar%c)
10772 this%dativar%c(i)%i = &
10773 firsttrue(this%dativar%c(i)%btable == this%dativarattr%i(:)%btable)
10774 ENDDO
10775 ENDIF
10776
10777 IF (ASSOCIATED(this%dativarattr%b)) THEN
10778 DO i = 1, SIZE(this%dativar%c)
10779 this%dativar%c(i)%b = &
10780 firsttrue(this%dativar%c(i)%btable == this%dativarattr%b(:)%btable)
10781 ENDDO
10782 ENDIF
10783
10784 IF (ASSOCIATED(this%dativarattr%c)) THEN
10785 DO i = 1, SIZE(this%dativar%c)
10786 this%dativar%c(i)%c = &
10787 firsttrue(this%dativar%c(i)%btable == this%dativarattr%c(:)%btable)
10788 ENDDO
10789 ENDIF
10790ENDIF
10791
10792END SUBROUTINE vol7d_set_attr_ind
10793
10794
10799SUBROUTINE vol7d_merge(this, that, sort, bestdata, &
10800 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
10801TYPE(vol7d),INTENT(INOUT) :: this
10802TYPE(vol7d),INTENT(INOUT) :: that
10803LOGICAL,INTENT(IN),OPTIONAL :: sort
10804LOGICAL,INTENT(in),OPTIONAL :: bestdata
10805LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple ! experimental, please do not use outside the library now
10806
10807TYPE(vol7d) :: v7d_clean
10808
10809
10811 this = that
10813 that = v7d_clean ! destroy that without deallocating
10814ELSE ! Append that to this and destroy that
10816 ltimesimple, ltimerangesimple, llevelsimple, lanasimple)
10818ENDIF
10819
10820END SUBROUTINE vol7d_merge
10821
10822
10851SUBROUTINE vol7d_append(this, that, sort, bestdata, &
10852 ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple)
10853TYPE(vol7d),INTENT(INOUT) :: this
10854TYPE(vol7d),INTENT(IN) :: that
10855LOGICAL,INTENT(IN),OPTIONAL :: sort
10856! experimental, please do not use outside the library now, they force the use
10857! of a simplified mapping algorithm which is valid only whene the dimension
10858! content is the same in both volumes , or when one of them is empty
10859LOGICAL,INTENT(in),OPTIONAL :: bestdata
10860LOGICAL,INTENT(IN),OPTIONAL :: ltimesimple, ltimerangesimple, llevelsimple, lanasimple, lnetworksimple
10861
10862
10863TYPE(vol7d) :: v7dtmp
10864LOGICAL :: lsort, lbestdata
10865INTEGER,POINTER :: remapt1(:), remapt2(:), remaptr1(:), remaptr2(:), &
10866 remapl1(:), remapl2(:), remapa1(:), remapa2(:), remapn1(:), remapn2(:)
10867
10869IF (.NOT.vol7d_check_vol(that)) RETURN ! be safe
10872 RETURN
10873ENDIF
10874
10875IF (this%time_definition /= that%time_definition) THEN
10876 CALL l4f_log(l4f_fatal, &
10877 'in vol7d_append, cannot append volumes with different &
10878 &time definition')
10879 CALL raise_fatal_error()
10880ENDIF
10881
10882! Completo l'allocazione per avere volumi a norma
10883CALL vol7d_alloc_vol(this)
10884
10888
10889! Calcolo le mappature tra volumi vecchi e volume nuovo
10890! I puntatori remap* vengono tutti o allocati o nullificati
10891IF (optio_log(ltimesimple)) THEN
10892 CALL vol7d_remap2simple_datetime(this%time, that%time, v7dtmp%time, &
10893 lsort, remapt1, remapt2)
10894ELSE
10895 CALL vol7d_remap2_datetime(this%time, that%time, v7dtmp%time, &
10896 lsort, remapt1, remapt2)
10897ENDIF
10898IF (optio_log(ltimerangesimple)) THEN
10899 CALL vol7d_remap2simple_vol7d_timerange(this%timerange, that%timerange, &
10900 v7dtmp%timerange, lsort, remaptr1, remaptr2)
10901ELSE
10902 CALL vol7d_remap2_vol7d_timerange(this%timerange, that%timerange, &
10903 v7dtmp%timerange, lsort, remaptr1, remaptr2)
10904ENDIF
10905IF (optio_log(llevelsimple)) THEN
10906 CALL vol7d_remap2simple_vol7d_level(this%level, that%level, v7dtmp%level, &
10907 lsort, remapl1, remapl2)
10908ELSE
10909 CALL vol7d_remap2_vol7d_level(this%level, that%level, v7dtmp%level, &
10910 lsort, remapl1, remapl2)
10911ENDIF
10912IF (optio_log(lanasimple)) THEN
10913 CALL vol7d_remap2simple_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
10914 .false., remapa1, remapa2)
10915ELSE
10916 CALL vol7d_remap2_vol7d_ana(this%ana, that%ana, v7dtmp%ana, &
10917 .false., remapa1, remapa2)
10918ENDIF
10919IF (optio_log(lnetworksimple)) THEN
10920 CALL vol7d_remap2simple_vol7d_network(this%network, that%network, v7dtmp%network, &
10921 .false., remapn1, remapn2)
10922ELSE
10923 CALL vol7d_remap2_vol7d_network(this%network, that%network, v7dtmp%network, &
10924 .false., remapn1, remapn2)
10925ENDIF
10926
10927! Faccio la fusione fisica dei volumi
10928CALL vol7d_merge_finalr(this, that, v7dtmp, &
10929 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10930 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10931CALL vol7d_merge_finald(this, that, v7dtmp, &
10932 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10933 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10934CALL vol7d_merge_finali(this, that, v7dtmp, &
10935 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10936 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10937CALL vol7d_merge_finalb(this, that, v7dtmp, &
10938 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10939 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10940CALL vol7d_merge_finalc(this, that, v7dtmp, &
10941 remapa1, remapa2, remapt1, remapt2, remapl1, remapl2, &
10942 remaptr1, remaptr2, remapn1, remapn2, lbestdata)
10943
10944! Dealloco i vettori di rimappatura
10945IF (ASSOCIATED(remapt1)) DEALLOCATE(remapt1)
10946IF (ASSOCIATED(remapt2)) DEALLOCATE(remapt2)
10947IF (ASSOCIATED(remaptr1)) DEALLOCATE(remaptr1)
10948IF (ASSOCIATED(remaptr2)) DEALLOCATE(remaptr2)
10949IF (ASSOCIATED(remapl1)) DEALLOCATE(remapl1)
10950IF (ASSOCIATED(remapl2)) DEALLOCATE(remapl2)
10951IF (ASSOCIATED(remapa1)) DEALLOCATE(remapa1)
10952IF (ASSOCIATED(remapa2)) DEALLOCATE(remapa2)
10953IF (ASSOCIATED(remapn1)) DEALLOCATE(remapn1)
10954IF (ASSOCIATED(remapn2)) DEALLOCATE(remapn2)
10955
10956! Distruggo il vecchio volume e assegno il nuovo a this
10958this = v7dtmp
10959! Ricreo gli indici var-attr
10960CALL vol7d_set_attr_ind(this)
10961
10962END SUBROUTINE vol7d_append
10963
10964
10997SUBROUTINE vol7d_copy(this, that, sort, unique, miss, &
10998 lsort_time, lsort_timerange, lsort_level, &
10999 ltime, ltimerange, llevel, lana, lnetwork, &
11000 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
11001 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
11002 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
11003 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
11004 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
11005 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
11006TYPE(vol7d),INTENT(IN) :: this
11007TYPE(vol7d),INTENT(INOUT) :: that
11008LOGICAL,INTENT(IN),OPTIONAL :: sort
11009LOGICAL,INTENT(IN),OPTIONAL :: unique
11010LOGICAL,INTENT(IN),OPTIONAL :: miss
11011LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
11012LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
11013LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
11021LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
11023LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
11025LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
11027LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
11029LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
11031LOGICAL,INTENT(in),OPTIONAL :: &
11032 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
11033 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
11034 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
11035 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
11036 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
11037 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
11038
11039LOGICAL :: lsort, lunique, lmiss
11040INTEGER,POINTER :: remapt(:), remaptr(:), remapl(:), remapa(:), remapn(:)
11041
11044IF (.NOT.vol7d_check_vol(this)) RETURN ! be safe
11045
11049
11050! Calcolo le mappature tra volume vecchio e volume nuovo
11051! I puntatori remap* vengono tutti o allocati o nullificati
11052CALL vol7d_remap1_datetime(this%time, that%time, &
11053 lsort.OR.optio_log(lsort_time), lunique, lmiss, remapt, ltime)
11054CALL vol7d_remap1_vol7d_timerange(this%timerange, that%timerange, &
11055 lsort.OR.optio_log(lsort_timerange), lunique, lmiss, remaptr, ltimerange)
11056CALL vol7d_remap1_vol7d_level(this%level, that%level, &
11057 lsort.OR.optio_log(lsort_level), lunique, lmiss, remapl, llevel)
11058CALL vol7d_remap1_vol7d_ana(this%ana, that%ana, &
11059 lsort, lunique, lmiss, remapa, lana)
11060CALL vol7d_remap1_vol7d_network(this%network, that%network, &
11061 lsort, lunique, lmiss, remapn, lnetwork)
11062
11063! lanavari, lanavarb, lanavarc, &
11064! lanaattri, lanaattrb, lanaattrc, &
11065! lanavarattri, lanavarattrb, lanavarattrc, &
11066! ldativari, ldativarb, ldativarc, &
11067! ldatiattri, ldatiattrb, ldatiattrc, &
11068! ldativarattri, ldativarattrb, ldativarattrc
11069! Faccio la riforma fisica dei volumi
11070CALL vol7d_reform_finalr(this, that, &
11071 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
11072 lanavarr, lanaattrr, lanavarattrr, ldativarr, ldatiattrr, ldativarattrr)
11073CALL vol7d_reform_finald(this, that, &
11074 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
11075 lanavard, lanaattrd, lanavarattrd, ldativard, ldatiattrd, ldativarattrd)
11076CALL vol7d_reform_finali(this, that, &
11077 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
11078 lanavari, lanaattri, lanavarattri, ldativari, ldatiattri, ldativarattri)
11079CALL vol7d_reform_finalb(this, that, &
11080 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
11081 lanavarb, lanaattrb, lanavarattrb, ldativarb, ldatiattrb, ldativarattrb)
11082CALL vol7d_reform_finalc(this, that, &
11083 remapa, remapt, remapl, remaptr, remapn, lsort, lunique, lmiss, &
11084 lanavarc, lanaattrc, lanavarattrc, ldativarc, ldatiattrc, ldativarattrc)
11085
11086! Dealloco i vettori di rimappatura
11087IF (ASSOCIATED(remapt)) DEALLOCATE(remapt)
11088IF (ASSOCIATED(remaptr)) DEALLOCATE(remaptr)
11089IF (ASSOCIATED(remapl)) DEALLOCATE(remapl)
11090IF (ASSOCIATED(remapa)) DEALLOCATE(remapa)
11091IF (ASSOCIATED(remapn)) DEALLOCATE(remapn)
11092
11093! Ricreo gli indici var-attr
11094CALL vol7d_set_attr_ind(that)
11095that%time_definition = this%time_definition
11096
11097END SUBROUTINE vol7d_copy
11098
11099
11110SUBROUTINE vol7d_reform(this, sort, unique, miss, &
11111 lsort_time, lsort_timerange, lsort_level, &
11112 ltime, ltimerange, llevel, lana, lnetwork, &
11113 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
11114 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
11115 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
11116 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
11117 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
11118 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc&
11119 ,purgeana)
11120TYPE(vol7d),INTENT(INOUT) :: this
11121LOGICAL,INTENT(IN),OPTIONAL :: sort
11122LOGICAL,INTENT(IN),OPTIONAL :: unique
11123LOGICAL,INTENT(IN),OPTIONAL :: miss
11124LOGICAL,INTENT(IN),OPTIONAL :: lsort_time
11125LOGICAL,INTENT(IN),OPTIONAL :: lsort_timerange
11126LOGICAL,INTENT(IN),OPTIONAL :: lsort_level
11134LOGICAL,INTENT(IN),OPTIONAL :: ltime(:)
11135LOGICAL,INTENT(IN),OPTIONAL :: ltimerange(:)
11136LOGICAL,INTENT(IN),OPTIONAL :: llevel(:)
11137LOGICAL,INTENT(IN),OPTIONAL :: lana(:)
11138LOGICAL,INTENT(IN),OPTIONAL :: lnetwork(:)
11140LOGICAL,INTENT(in),OPTIONAL :: &
11141 lanavarr(:), lanavard(:), lanavari(:), lanavarb(:), lanavarc(:), &
11142 lanaattrr(:), lanaattrd(:), lanaattri(:), lanaattrb(:), lanaattrc(:), &
11143 lanavarattrr(:), lanavarattrd(:), lanavarattri(:), lanavarattrb(:), lanavarattrc(:), &
11144 ldativarr(:), ldativard(:), ldativari(:), ldativarb(:), ldativarc(:), &
11145 ldatiattrr(:), ldatiattrd(:), ldatiattri(:), ldatiattrb(:), ldatiattrc(:), &
11146 ldativarattrr(:), ldativarattrd(:), ldativarattri(:), ldativarattrb(:), ldativarattrc(:)
11147LOGICAL,INTENT(IN),OPTIONAL :: purgeana
11148
11149TYPE(vol7d) :: v7dtmp
11150logical,allocatable :: llana(:)
11151integer :: i
11152
11154 lsort_time, lsort_timerange, lsort_level, &
11155 ltime, ltimerange, llevel, lana, lnetwork, &
11156 lanavarr, lanavard, lanavari, lanavarb, lanavarc, &
11157 lanaattrr, lanaattrd, lanaattri, lanaattrb, lanaattrc, &
11158 lanavarattrr, lanavarattrd, lanavarattri, lanavarattrb, lanavarattrc, &
11159 ldativarr, ldativard, ldativari, ldativarb, ldativarc, &
11160 ldatiattrr, ldatiattrd, ldatiattri, ldatiattrb, ldatiattrc, &
11161 ldativarattrr, ldativarattrd, ldativarattri, ldativarattrb, ldativarattrc)
11162
11163! destroy old volume
11165
11166if (optio_log(purgeana)) then
11167 allocate(llana(size(v7dtmp%ana)))
11168 llana =.false.
11169 do i =1,size(v7dtmp%ana)
11170 if (associated(v7dtmp%voldatii)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatii(i,:,:,:,:,:)))
11171 if (associated(v7dtmp%voldatir)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatir(i,:,:,:,:,:)))
11172 if (associated(v7dtmp%voldatid)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatid(i,:,:,:,:,:)))
11173 if (associated(v7dtmp%voldatib)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatib(i,:,:,:,:,:)))
11174 if (associated(v7dtmp%voldatic)) llana(i)= llana(i) .or. any(c_e(v7dtmp%voldatic(i,:,:,:,:,:)))
11175 end do
11176 CALL vol7d_copy(v7dtmp, this,lana=llana)
11178 deallocate(llana)
11179else
11180 this=v7dtmp
11181end if
11182
11183END SUBROUTINE vol7d_reform
11184
11185
11193SUBROUTINE vol7d_smart_sort(this, lsort_time, lsort_timerange, lsort_level)
11194TYPE(vol7d),INTENT(INOUT) :: this
11195LOGICAL,OPTIONAL,INTENT(in) :: lsort_time
11196LOGICAL,OPTIONAL,INTENT(in) :: lsort_timerange
11197LOGICAL,OPTIONAL,INTENT(in) :: lsort_level
11198
11199INTEGER :: i
11200LOGICAL :: to_be_sorted
11201
11202to_be_sorted = .false.
11203CALL vol7d_alloc_vol(this) ! usual safety check
11204
11205IF (optio_log(lsort_time)) THEN
11206 DO i = 2, SIZE(this%time)
11207 IF (this%time(i) < this%time(i-1)) THEN
11208 to_be_sorted = .true.
11209 EXIT
11210 ENDIF
11211 ENDDO
11212ENDIF
11213IF (optio_log(lsort_timerange)) THEN
11214 DO i = 2, SIZE(this%timerange)
11215 IF (this%timerange(i) < this%timerange(i-1)) THEN
11216 to_be_sorted = .true.
11217 EXIT
11218 ENDIF
11219 ENDDO
11220ENDIF
11221IF (optio_log(lsort_level)) THEN
11222 DO i = 2, SIZE(this%level)
11223 IF (this%level(i) < this%level(i-1)) THEN
11224 to_be_sorted = .true.
11225 EXIT
11226 ENDIF
11227 ENDDO
11228ENDIF
11229
11230IF (to_be_sorted) CALL vol7d_reform(this, &
11231 lsort_time=lsort_time, lsort_timerange=lsort_timerange, lsort_level=lsort_level )
11232
11233END SUBROUTINE vol7d_smart_sort
11234
11242SUBROUTINE vol7d_filter(this, avl, vl, nl, s_d, e_d)
11243TYPE(vol7d),INTENT(inout) :: this
11244CHARACTER(len=*),INTENT(in),OPTIONAL :: avl(:)
11245CHARACTER(len=*),INTENT(in),OPTIONAL :: vl(:)
11246TYPE(vol7d_network),OPTIONAL :: nl(:)
11247TYPE(datetime),INTENT(in),OPTIONAL :: s_d
11248TYPE(datetime),INTENT(in),OPTIONAL :: e_d
11249
11250INTEGER :: i
11251
11252IF (PRESENT(avl)) THEN
11253 IF (SIZE(avl) > 0) THEN
11254
11255 IF (ASSOCIATED(this%anavar%r)) THEN
11256 DO i = 1, SIZE(this%anavar%r)
11257 IF (all(this%anavar%r(i)%btable /= avl)) this%anavar%r(i) = vol7d_var_miss
11258 ENDDO
11259 ENDIF
11260
11261 IF (ASSOCIATED(this%anavar%i)) THEN
11262 DO i = 1, SIZE(this%anavar%i)
11263 IF (all(this%anavar%i(i)%btable /= avl)) this%anavar%i(i) = vol7d_var_miss
11264 ENDDO
11265 ENDIF
11266
11267 IF (ASSOCIATED(this%anavar%b)) THEN
11268 DO i = 1, SIZE(this%anavar%b)
11269 IF (all(this%anavar%b(i)%btable /= avl)) this%anavar%b(i) = vol7d_var_miss
11270 ENDDO
11271 ENDIF
11272
11273 IF (ASSOCIATED(this%anavar%d)) THEN
11274 DO i = 1, SIZE(this%anavar%d)
11275 IF (all(this%anavar%d(i)%btable /= avl)) this%anavar%d(i) = vol7d_var_miss
11276 ENDDO
11277 ENDIF
11278
11279 IF (ASSOCIATED(this%anavar%c)) THEN
11280 DO i = 1, SIZE(this%anavar%c)
11281 IF (all(this%anavar%c(i)%btable /= avl)) this%anavar%c(i) = vol7d_var_miss
11282 ENDDO
11283 ENDIF
11284
11285 ENDIF
11286ENDIF
11287
11288
11289IF (PRESENT(vl)) THEN
11290 IF (size(vl) > 0) THEN
11291 IF (ASSOCIATED(this%dativar%r)) THEN
11292 DO i = 1, SIZE(this%dativar%r)
11293 IF (all(this%dativar%r(i)%btable /= vl)) this%dativar%r(i) = vol7d_var_miss
11294 ENDDO
11295 ENDIF
11296
11297 IF (ASSOCIATED(this%dativar%i)) THEN
11298 DO i = 1, SIZE(this%dativar%i)
11299 IF (all(this%dativar%i(i)%btable /= vl)) this%dativar%i(i) = vol7d_var_miss
11300 ENDDO
11301 ENDIF
11302
11303 IF (ASSOCIATED(this%dativar%b)) THEN
11304 DO i = 1, SIZE(this%dativar%b)
11305 IF (all(this%dativar%b(i)%btable /= vl)) this%dativar%b(i) = vol7d_var_miss
11306 ENDDO
11307 ENDIF
11308
11309 IF (ASSOCIATED(this%dativar%d)) THEN
11310 DO i = 1, SIZE(this%dativar%d)
11311 IF (all(this%dativar%d(i)%btable /= vl)) this%dativar%d(i) = vol7d_var_miss
11312 ENDDO
11313 ENDIF
11314
11315 IF (ASSOCIATED(this%dativar%c)) THEN
11316 DO i = 1, SIZE(this%dativar%c)
11317 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
11318 ENDDO
11319 ENDIF
11320
11321 IF (ASSOCIATED(this%dativar%c)) THEN
11322 DO i = 1, SIZE(this%dativar%c)
11323 IF (all(this%dativar%c(i)%btable /= vl)) this%dativar%c(i) = vol7d_var_miss
11324 ENDDO
11325 ENDIF
11326
11327 ENDIF
11328ENDIF
11329
11330IF (PRESENT(nl)) THEN
11331 IF (SIZE(nl) > 0) THEN
11332 DO i = 1, SIZE(this%network)
11333 IF (all(this%network(i) /= nl)) this%network(i) = vol7d_network_miss
11334 ENDDO
11335 ENDIF
11336ENDIF
11337
11338IF (PRESENT(s_d)) THEN
11340 WHERE (this%time < s_d)
11341 this%time = datetime_miss
11342 END WHERE
11343 ENDIF
11344ENDIF
11345
11346IF (PRESENT(e_d)) THEN
11348 WHERE (this%time > e_d)
11349 this%time = datetime_miss
11350 END WHERE
11351 ENDIF
11352ENDIF
11353
11354CALL vol7d_reform(this, miss=.true.)
11355
11356END SUBROUTINE vol7d_filter
11357
11358
11365SUBROUTINE vol7d_convr(this, that, anaconv)
11366TYPE(vol7d),INTENT(IN) :: this
11367TYPE(vol7d),INTENT(INOUT) :: that
11368LOGICAL,OPTIONAL,INTENT(in) :: anaconv
11369INTEGER :: i
11370LOGICAL :: fv(1)=(/.false./), tv(1)=(/.true./), acp(1), acn(1)
11371TYPE(vol7d) :: v7d_tmp
11372
11373IF (optio_log(anaconv)) THEN
11374 acp=fv
11375 acn=tv
11376ELSE
11377 acp=tv
11378 acn=fv
11379ENDIF
11380
11381! Volume con solo i dati reali e tutti gli attributi
11382! l'anagrafica e` copiata interamente se necessario
11383CALL vol7d_copy(this, that, &
11384 lanavarr=tv, lanavard=acp, lanavari=acp, lanavarb=acp, lanavarc=acp, &
11385 ldativarr=tv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=fv)
11386
11387! Volume solo di dati double
11388CALL vol7d_copy(this, v7d_tmp, &
11389 lanavarr=fv, lanavard=acn, lanavari=fv, lanavarb=fv, lanavarc=fv, &
11390 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
11391 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
11392 ldativarr=fv, ldativard=tv, ldativari=fv, ldativarb=fv, ldativarc=fv, &
11393 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
11394 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
11395
11396! converto a dati reali
11397IF (ASSOCIATED(v7d_tmp%anavar%d) .OR. ASSOCIATED(v7d_tmp%dativar%d)) THEN
11398
11399 IF (ASSOCIATED(v7d_tmp%anavar%d)) THEN
11400! alloco i dati reali e vi trasferisco i double
11401 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanad, 1), SIZE(v7d_tmp%volanad, 2), &
11402 SIZE(v7d_tmp%volanad, 3)))
11403 DO i = 1, SIZE(v7d_tmp%anavar%d)
11404 v7d_tmp%volanar(:,i,:) = &
11405 realdat(v7d_tmp%volanad(:,i,:), v7d_tmp%anavar%d(i))
11406 ENDDO
11407 DEALLOCATE(v7d_tmp%volanad)
11408! trasferisco le variabili
11409 v7d_tmp%anavar%r => v7d_tmp%anavar%d
11410 NULLIFY(v7d_tmp%anavar%d)
11411 ENDIF
11412
11413 IF (ASSOCIATED(v7d_tmp%dativar%d)) THEN
11414! alloco i dati reali e vi trasferisco i double
11415 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatid, 1), SIZE(v7d_tmp%voldatid, 2), &
11416 SIZE(v7d_tmp%voldatid, 3), SIZE(v7d_tmp%voldatid, 4), SIZE(v7d_tmp%voldatid, 5), &
11417 SIZE(v7d_tmp%voldatid, 6)))
11418 DO i = 1, SIZE(v7d_tmp%dativar%d)
11419 v7d_tmp%voldatir(:,:,:,:,i,:) = &
11420 realdat(v7d_tmp%voldatid(:,:,:,:,i,:), v7d_tmp%dativar%d(i))
11421 ENDDO
11422 DEALLOCATE(v7d_tmp%voldatid)
11423! trasferisco le variabili
11424 v7d_tmp%dativar%r => v7d_tmp%dativar%d
11425 NULLIFY(v7d_tmp%dativar%d)
11426 ENDIF
11427
11428! fondo con il volume definitivo
11429 CALL vol7d_merge(that, v7d_tmp)
11430ELSE
11432ENDIF
11433
11434
11435! Volume solo di dati interi
11436CALL vol7d_copy(this, v7d_tmp, &
11437 lanavarr=fv, lanavard=fv, lanavari=acn, lanavarb=fv, lanavarc=fv, &
11438 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
11439 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
11440 ldativarr=fv, ldativard=fv, ldativari=tv, ldativarb=fv, ldativarc=fv, &
11441 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
11442 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
11443
11444! converto a dati reali
11445IF (ASSOCIATED(v7d_tmp%anavar%i) .OR. ASSOCIATED(v7d_tmp%dativar%i)) THEN
11446
11447 IF (ASSOCIATED(v7d_tmp%anavar%i)) THEN
11448! alloco i dati reali e vi trasferisco gli interi
11449 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanai, 1), SIZE(v7d_tmp%volanai, 2), &
11450 SIZE(v7d_tmp%volanai, 3)))
11451 DO i = 1, SIZE(v7d_tmp%anavar%i)
11452 v7d_tmp%volanar(:,i,:) = &
11453 realdat(v7d_tmp%volanai(:,i,:), v7d_tmp%anavar%i(i))
11454 ENDDO
11455 DEALLOCATE(v7d_tmp%volanai)
11456! trasferisco le variabili
11457 v7d_tmp%anavar%r => v7d_tmp%anavar%i
11458 NULLIFY(v7d_tmp%anavar%i)
11459 ENDIF
11460
11461 IF (ASSOCIATED(v7d_tmp%dativar%i)) THEN
11462! alloco i dati reali e vi trasferisco gli interi
11463 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatii, 1), SIZE(v7d_tmp%voldatii, 2), &
11464 SIZE(v7d_tmp%voldatii, 3), SIZE(v7d_tmp%voldatii, 4), SIZE(v7d_tmp%voldatii, 5), &
11465 SIZE(v7d_tmp%voldatii, 6)))
11466 DO i = 1, SIZE(v7d_tmp%dativar%i)
11467 v7d_tmp%voldatir(:,:,:,:,i,:) = &
11468 realdat(v7d_tmp%voldatii(:,:,:,:,i,:), v7d_tmp%dativar%i(i))
11469 ENDDO
11470 DEALLOCATE(v7d_tmp%voldatii)
11471! trasferisco le variabili
11472 v7d_tmp%dativar%r => v7d_tmp%dativar%i
11473 NULLIFY(v7d_tmp%dativar%i)
11474 ENDIF
11475
11476! fondo con il volume definitivo
11477 CALL vol7d_merge(that, v7d_tmp)
11478ELSE
11480ENDIF
11481
11482
11483! Volume solo di dati byte
11484CALL vol7d_copy(this, v7d_tmp, &
11485 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=acn, lanavarc=fv, &
11486 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
11487 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
11488 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=tv, ldativarc=fv, &
11489 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
11490 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
11491
11492! converto a dati reali
11493IF (ASSOCIATED(v7d_tmp%anavar%b) .OR. ASSOCIATED(v7d_tmp%dativar%b)) THEN
11494
11495 IF (ASSOCIATED(v7d_tmp%anavar%b)) THEN
11496! alloco i dati reali e vi trasferisco i byte
11497 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanab, 1), SIZE(v7d_tmp%volanab, 2), &
11498 SIZE(v7d_tmp%volanab, 3)))
11499 DO i = 1, SIZE(v7d_tmp%anavar%b)
11500 v7d_tmp%volanar(:,i,:) = &
11501 realdat(v7d_tmp%volanab(:,i,:), v7d_tmp%anavar%b(i))
11502 ENDDO
11503 DEALLOCATE(v7d_tmp%volanab)
11504! trasferisco le variabili
11505 v7d_tmp%anavar%r => v7d_tmp%anavar%b
11506 NULLIFY(v7d_tmp%anavar%b)
11507 ENDIF
11508
11509 IF (ASSOCIATED(v7d_tmp%dativar%b)) THEN
11510! alloco i dati reali e vi trasferisco i byte
11511 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatib, 1), SIZE(v7d_tmp%voldatib, 2), &
11512 SIZE(v7d_tmp%voldatib, 3), SIZE(v7d_tmp%voldatib, 4), SIZE(v7d_tmp%voldatib, 5), &
11513 SIZE(v7d_tmp%voldatib, 6)))
11514 DO i = 1, SIZE(v7d_tmp%dativar%b)
11515 v7d_tmp%voldatir(:,:,:,:,i,:) = &
11516 realdat(v7d_tmp%voldatib(:,:,:,:,i,:), v7d_tmp%dativar%b(i))
11517 ENDDO
11518 DEALLOCATE(v7d_tmp%voldatib)
11519! trasferisco le variabili
11520 v7d_tmp%dativar%r => v7d_tmp%dativar%b
11521 NULLIFY(v7d_tmp%dativar%b)
11522 ENDIF
11523
11524! fondo con il volume definitivo
11525 CALL vol7d_merge(that, v7d_tmp)
11526ELSE
11528ENDIF
11529
11530
11531! Volume solo di dati character
11532CALL vol7d_copy(this, v7d_tmp, &
11533 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=fv, lanavarc=acn, &
11534 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
11535 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
11536 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=fv, ldativarc=tv, &
11537 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
11538 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
11539
11540! converto a dati reali
11541IF (ASSOCIATED(v7d_tmp%anavar%c) .OR. ASSOCIATED(v7d_tmp%dativar%c)) THEN
11542
11543 IF (ASSOCIATED(v7d_tmp%anavar%c)) THEN
11544! alloco i dati reali e vi trasferisco i character
11545 ALLOCATE(v7d_tmp%volanar(SIZE(v7d_tmp%volanac, 1), SIZE(v7d_tmp%volanac, 2), &
11546 SIZE(v7d_tmp%volanac, 3)))
11547 DO i = 1, SIZE(v7d_tmp%anavar%c)
11548 v7d_tmp%volanar(:,i,:) = &
11549 realdat(v7d_tmp%volanac(:,i,:), v7d_tmp%anavar%c(i))
11550 ENDDO
11551 DEALLOCATE(v7d_tmp%volanac)
11552! trasferisco le variabili
11553 v7d_tmp%anavar%r => v7d_tmp%anavar%c
11554 NULLIFY(v7d_tmp%anavar%c)
11555 ENDIF
11556
11557 IF (ASSOCIATED(v7d_tmp%dativar%c)) THEN
11558! alloco i dati reali e vi trasferisco i character
11559 ALLOCATE(v7d_tmp%voldatir(SIZE(v7d_tmp%voldatic, 1), SIZE(v7d_tmp%voldatic, 2), &
11560 SIZE(v7d_tmp%voldatic, 3), SIZE(v7d_tmp%voldatic, 4), SIZE(v7d_tmp%voldatic, 5), &
11561 SIZE(v7d_tmp%voldatic, 6)))
11562 DO i = 1, SIZE(v7d_tmp%dativar%c)
11563 v7d_tmp%voldatir(:,:,:,:,i,:) = &
11564 realdat(v7d_tmp%voldatic(:,:,:,:,i,:), v7d_tmp%dativar%c(i))
11565 ENDDO
11566 DEALLOCATE(v7d_tmp%voldatic)
11567! trasferisco le variabili
11568 v7d_tmp%dativar%r => v7d_tmp%dativar%c
11569 NULLIFY(v7d_tmp%dativar%c)
11570 ENDIF
11571
11572! fondo con il volume definitivo
11573 CALL vol7d_merge(that, v7d_tmp)
11574ELSE
11576ENDIF
11577
11578END SUBROUTINE vol7d_convr
11579
11580
11584SUBROUTINE vol7d_diff_only (this, that, data_only,ana)
11585TYPE(vol7d),INTENT(IN) :: this
11586TYPE(vol7d),INTENT(OUT) :: that
11587logical , optional, intent(in) :: data_only
11588logical , optional, intent(in) :: ana
11589logical :: ldata_only,lana
11590
11591IF (PRESENT(data_only)) THEN
11592 ldata_only = data_only
11593ELSE
11594 ldata_only = .false.
11595ENDIF
11596
11597IF (PRESENT(ana)) THEN
11598 lana = ana
11599ELSE
11600 lana = .false.
11601ENDIF
11602
11603
11604#undef VOL7D_POLY_ARRAY
11605#define VOL7D_POLY_ARRAY voldati
11606#include "vol7d_class_diff.F90"
11607#undef VOL7D_POLY_ARRAY
11608#define VOL7D_POLY_ARRAY voldatiattr
11609#include "vol7d_class_diff.F90"
11610#undef VOL7D_POLY_ARRAY
11611
11612if ( .not. ldata_only) then
11613
11614#define VOL7D_POLY_ARRAY volana
11615#include "vol7d_class_diff.F90"
11616#undef VOL7D_POLY_ARRAY
11617#define VOL7D_POLY_ARRAY volanaattr
11618#include "vol7d_class_diff.F90"
11619#undef VOL7D_POLY_ARRAY
11620
11621 if(lana)then
11622 where ( this%ana == that%ana )
11623 that%ana = vol7d_ana_miss
11624 end where
11625 end if
11626
11627end if
11628
11629
11630
11631END SUBROUTINE vol7d_diff_only
11632
11633
11634
11635! Creo le routine da ripetere per i vari tipi di dati di v7d
11636! tramite un template e il preprocessore
11637#undef VOL7D_POLY_TYPE
11638#undef VOL7D_POLY_TYPES
11639#define VOL7D_POLY_TYPE REAL
11640#define VOL7D_POLY_TYPES r
11641#include "vol7d_class_type_templ.F90"
11642#undef VOL7D_POLY_TYPE
11643#undef VOL7D_POLY_TYPES
11644#define VOL7D_POLY_TYPE DOUBLE PRECISION
11645#define VOL7D_POLY_TYPES d
11646#include "vol7d_class_type_templ.F90"
11647#undef VOL7D_POLY_TYPE
11648#undef VOL7D_POLY_TYPES
11649#define VOL7D_POLY_TYPE INTEGER
11650#define VOL7D_POLY_TYPES i
11651#include "vol7d_class_type_templ.F90"
11652#undef VOL7D_POLY_TYPE
11653#undef VOL7D_POLY_TYPES
11654#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
11655#define VOL7D_POLY_TYPES b
11656#include "vol7d_class_type_templ.F90"
11657#undef VOL7D_POLY_TYPE
11658#undef VOL7D_POLY_TYPES
11659#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
11660#define VOL7D_POLY_TYPES c
11661#include "vol7d_class_type_templ.F90"
11662
11663! Creo le routine da ripetere per i vari descrittori di dimensioni di v7d
11664! tramite un template e il preprocessore
11665#define VOL7D_SORT
11666#undef VOL7D_NO_ZERO_ALLOC
11667#undef VOL7D_POLY_TYPE
11668#define VOL7D_POLY_TYPE datetime
11669#include "vol7d_class_desc_templ.F90"
11670#undef VOL7D_POLY_TYPE
11671#define VOL7D_POLY_TYPE vol7d_timerange
11672#include "vol7d_class_desc_templ.F90"
11673#undef VOL7D_POLY_TYPE
11674#define VOL7D_POLY_TYPE vol7d_level
11675#include "vol7d_class_desc_templ.F90"
11676#undef VOL7D_SORT
11677#undef VOL7D_POLY_TYPE
11678#define VOL7D_POLY_TYPE vol7d_network
11679#include "vol7d_class_desc_templ.F90"
11680#undef VOL7D_POLY_TYPE
11681#define VOL7D_POLY_TYPE vol7d_ana
11682#include "vol7d_class_desc_templ.F90"
11683#define VOL7D_NO_ZERO_ALLOC
11684#undef VOL7D_POLY_TYPE
11685#define VOL7D_POLY_TYPE vol7d_var
11686#include "vol7d_class_desc_templ.F90"
11687
11697subroutine vol7d_write_on_file (this,unit,description,filename,filename_auto)
11698
11699TYPE(vol7d),INTENT(IN) :: this
11700integer,optional,intent(inout) :: unit
11701character(len=*),intent(in),optional :: filename
11702character(len=*),intent(out),optional :: filename_auto
11703character(len=*),INTENT(IN),optional :: description
11704
11705integer :: lunit
11706character(len=254) :: ldescription,arg,lfilename
11707integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
11708 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
11709 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
11710 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
11711 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
11712 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
11713 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
11714!integer :: im,id,iy
11715integer :: tarray(8)
11716logical :: opened,exist
11717
11718 nana=0
11719 ntime=0
11720 ntimerange=0
11721 nlevel=0
11722 nnetwork=0
11723 ndativarr=0
11724 ndativari=0
11725 ndativarb=0
11726 ndativard=0
11727 ndativarc=0
11728 ndatiattrr=0
11729 ndatiattri=0
11730 ndatiattrb=0
11731 ndatiattrd=0
11732 ndatiattrc=0
11733 ndativarattrr=0
11734 ndativarattri=0
11735 ndativarattrb=0
11736 ndativarattrd=0
11737 ndativarattrc=0
11738 nanavarr=0
11739 nanavari=0
11740 nanavarb=0
11741 nanavard=0
11742 nanavarc=0
11743 nanaattrr=0
11744 nanaattri=0
11745 nanaattrb=0
11746 nanaattrd=0
11747 nanaattrc=0
11748 nanavarattrr=0
11749 nanavarattri=0
11750 nanavarattrb=0
11751 nanavarattrd=0
11752 nanavarattrc=0
11753
11754
11755!call idate(im,id,iy)
11756call date_and_time(values=tarray)
11757call getarg(0,arg)
11758
11759if (present(description))then
11760 ldescription=description
11761else
11762 ldescription="Vol7d generated by: "//trim(arg)
11763end if
11764
11765if (.not. present(unit))then
11766 lunit=getunit()
11767else
11768 if (unit==0)then
11769 lunit=getunit()
11770 unit=lunit
11771 else
11772 lunit=unit
11773 end if
11774end if
11775
11776lfilename=trim(arg)//".v7d"
11778
11779if (present(filename))then
11780 if (filename /= "")then
11781 lfilename=filename
11782 end if
11783end if
11784
11785if (present(filename_auto))filename_auto=lfilename
11786
11787
11788inquire(unit=lunit,opened=opened)
11789if (.not. opened) then
11790! inquire(file=lfilename, EXIST=exist)
11791! IF (exist) THEN
11792! CALL l4f_log(L4F_FATAL, &
11793! 'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename))
11794! CALL raise_fatal_error()
11795! ENDIF
11796 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM')
11797 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
11798end if
11799
11800if (associated(this%ana)) nana=size(this%ana)
11801if (associated(this%time)) ntime=size(this%time)
11802if (associated(this%timerange)) ntimerange=size(this%timerange)
11803if (associated(this%level)) nlevel=size(this%level)
11804if (associated(this%network)) nnetwork=size(this%network)
11805
11806if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
11807if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
11808if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
11809if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
11810if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
11811
11812if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
11813if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
11814if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
11815if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
11816if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)
11817
11818if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
11819if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
11820if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
11821if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
11822if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
11823
11824if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
11825if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
11826if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
11827if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
11828if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
11829
11830if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
11831if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
11832if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
11833if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
11834if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)
11835
11836if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
11837if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
11838if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
11839if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
11840if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)
11841
11842write(unit=lunit)ldescription
11843write(unit=lunit)tarray
11844
11845write(unit=lunit)&
11846 nana, ntime, ntimerange, nlevel, nnetwork, &
11847 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
11848 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
11849 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
11850 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
11851 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
11852 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
11853 this%time_definition
11854
11855
11856!write(unit=lunit)this
11857
11858
11859!! prime 5 dimensioni
11862if (associated(this%level)) write(unit=lunit)this%level
11863if (associated(this%timerange)) write(unit=lunit)this%timerange
11864if (associated(this%network)) write(unit=lunit)this%network
11865
11866 !! 6a dimensione: variabile dell'anagrafica e dei dati
11867 !! con relativi attributi e in 5 tipi diversi
11868
11869if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r
11870if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i
11871if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b
11872if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d
11873if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c
11874
11875if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r
11876if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i
11877if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b
11878if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d
11879if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c
11880
11881if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r
11882if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i
11883if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b
11884if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d
11885if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c
11886
11887if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r
11888if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i
11889if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b
11890if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d
11891if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c
11892
11893if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r
11894if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i
11895if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b
11896if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d
11897if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c
11898
11899if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
11900if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
11901if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
11902if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
11903if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c
11904
11905!! Volumi di valori e attributi per anagrafica e dati
11906
11907if (associated(this%volanar)) write(unit=lunit)this%volanar
11908if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr
11909if (associated(this%voldatir)) write(unit=lunit)this%voldatir
11910if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr
11911
11912if (associated(this%volanai)) write(unit=lunit)this%volanai
11913if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri
11914if (associated(this%voldatii)) write(unit=lunit)this%voldatii
11915if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri
11916
11917if (associated(this%volanab)) write(unit=lunit)this%volanab
11918if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb
11919if (associated(this%voldatib)) write(unit=lunit)this%voldatib
11920if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb
11921
11922if (associated(this%volanad)) write(unit=lunit)this%volanad
11923if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd
11924if (associated(this%voldatid)) write(unit=lunit)this%voldatid
11925if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd
11926
11927if (associated(this%volanac)) write(unit=lunit)this%volanac
11928if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc
11929if (associated(this%voldatic)) write(unit=lunit)this%voldatic
11930if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc
11931
11932if (.not. present(unit)) close(unit=lunit)
11933
11934end subroutine vol7d_write_on_file
11935
11936
11943
11944
11945subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
11946
11947TYPE(vol7d),INTENT(OUT) :: this
11948integer,intent(inout),optional :: unit
11949character(len=*),INTENT(in),optional :: filename
11950character(len=*),intent(out),optional :: filename_auto
11951character(len=*),INTENT(out),optional :: description
11952integer,intent(out),optional :: tarray(8)
11953
11954
11955integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
11956 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
11957 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
11958 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
11959 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
11960 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
11961 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
11962
11963character(len=254) :: ldescription,lfilename,arg
11964integer :: ltarray(8),lunit,ios
11965logical :: opened,exist
11966
11967
11968call getarg(0,arg)
11969
11970if (.not. present(unit))then
11971 lunit=getunit()
11972else
11973 if (unit==0)then
11974 lunit=getunit()
11975 unit=lunit
11976 else
11977 lunit=unit
11978 end if
11979end if
11980
11981lfilename=trim(arg)//".v7d"
11983
11984if (present(filename))then
11985 if (filename /= "")then
11986 lfilename=filename
11987 end if
11988end if
11989
11990if (present(filename_auto))filename_auto=lfilename
11991
11992
11993inquire(unit=lunit,opened=opened)
11994IF (.NOT. opened) THEN
11995 inquire(file=lfilename,exist=exist)
11996 IF (.NOT.exist) THEN
11997 CALL l4f_log(l4f_fatal, &
11998 'in vol7d_read_from_file, file does not exists, cannot open')
11999 CALL raise_fatal_error()
12000 ENDIF
12001 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM', &
12002 status='OLD', action='READ')
12003 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
12004end if
12005
12006
12008read(unit=lunit,iostat=ios)ldescription
12009
12010if (ios < 0) then ! A negative value indicates that the End of File or End of Record
12011 call vol7d_alloc (this)
12012 call vol7d_alloc_vol (this)
12013 if (present(description))description=ldescription
12014 if (present(tarray))tarray=ltarray
12015 if (.not. present(unit)) close(unit=lunit)
12016end if
12017
12018read(unit=lunit)ltarray
12019
12020CALL l4f_log(l4f_info, 'Reading vol7d from file')
12021CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
12024
12025if (present(description))description=ldescription
12026if (present(tarray))tarray=ltarray
12027
12028read(unit=lunit)&
12029 nana, ntime, ntimerange, nlevel, nnetwork, &
12030 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
12031 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
12032 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
12033 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
12034 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
12035 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
12036 this%time_definition
12037
12038call vol7d_alloc (this, &
12039 nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,&
12040 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,&
12041 ndativard=ndativard, ndativarc=ndativarc,&
12042 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,&
12043 ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
12044 ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, &
12045 ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,&
12046 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, &
12047 nanavard=nanavard, nanavarc=nanavarc,&
12048 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,&
12049 nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
12050 nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, &
12051 nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc)
12052
12053
12056if (associated(this%level)) read(unit=lunit)this%level
12057if (associated(this%timerange)) read(unit=lunit)this%timerange
12058if (associated(this%network)) read(unit=lunit)this%network
12059
12060if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r
12061if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i
12062if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b
12063if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d
12064if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c
12065
12066if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r
12067if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i
12068if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b
12069if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d
12070if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c
12071
12072if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r
12073if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i
12074if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b
12075if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d
12076if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c
12077
12078if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r
12079if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i
12080if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b
12081if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d
12082if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c
12083
12084if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r
12085if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i
12086if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b
12087if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d
12088if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c
12089
12090if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
12091if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
12092if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
12093if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
12094if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c
12095
12096call vol7d_alloc_vol (this)
12097
12098!! Volumi di valori e attributi per anagrafica e dati
12099
12100if (associated(this%volanar)) read(unit=lunit)this%volanar
12101if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr
12102if (associated(this%voldatir)) read(unit=lunit)this%voldatir
12103if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr
12104
12105if (associated(this%volanai)) read(unit=lunit)this%volanai
12106if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri
12107if (associated(this%voldatii)) read(unit=lunit)this%voldatii
12108if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri
12109
12110if (associated(this%volanab)) read(unit=lunit)this%volanab
12111if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb
12112if (associated(this%voldatib)) read(unit=lunit)this%voldatib
12113if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb
12114
12115if (associated(this%volanad)) read(unit=lunit)this%volanad
12116if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd
12117if (associated(this%voldatid)) read(unit=lunit)this%voldatid
12118if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd
12119
12120if (associated(this%volanac)) read(unit=lunit)this%volanac
12121if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc
12122if (associated(this%voldatic)) read(unit=lunit)this%voldatic
12123if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc
12124
12125if (.not. present(unit)) close(unit=lunit)
12126
12127end subroutine vol7d_read_from_file
12128
12129
12130! to double precision
12131elemental doubleprecision function doubledatd(voldat,var)
12132doubleprecision,intent(in) :: voldat
12133type(vol7d_var),intent(in) :: var
12134
12135doubledatd=voldat
12136
12137end function doubledatd
12138
12139
12140elemental doubleprecision function doubledatr(voldat,var)
12141real,intent(in) :: voldat
12142type(vol7d_var),intent(in) :: var
12143
12145 doubledatr=dble(voldat)
12146else
12147 doubledatr=dmiss
12148end if
12149
12150end function doubledatr
12151
12152
12153elemental doubleprecision function doubledati(voldat,var)
12154integer,intent(in) :: voldat
12155type(vol7d_var),intent(in) :: var
12156
12159 doubledati=dble(voldat)/10.d0**var%scalefactor
12160 else
12161 doubledati=dble(voldat)
12162 endif
12163else
12164 doubledati=dmiss
12165end if
12166
12167end function doubledati
12168
12169
12170elemental doubleprecision function doubledatb(voldat,var)
12171integer(kind=int_b),intent(in) :: voldat
12172type(vol7d_var),intent(in) :: var
12173
12176 doubledatb=dble(voldat)/10.d0**var%scalefactor
12177 else
12178 doubledatb=dble(voldat)
12179 endif
12180else
12181 doubledatb=dmiss
12182end if
12183
12184end function doubledatb
12185
12186
12187elemental doubleprecision function doubledatc(voldat,var)
12188CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
12189type(vol7d_var),intent(in) :: var
12190
12191doubledatc = c2d(voldat)
12193 doubledatc=doubledatc/10.d0**var%scalefactor
12194end if
12195
12196end function doubledatc
12197
12198
12199! to integer
12200elemental integer function integerdatd(voldat,var)
12201doubleprecision,intent(in) :: voldat
12202type(vol7d_var),intent(in) :: var
12203
12206 integerdatd=nint(voldat*10d0**var%scalefactor)
12207 else
12208 integerdatd=nint(voldat)
12209 endif
12210else
12211 integerdatd=imiss
12212end if
12213
12214end function integerdatd
12215
12216
12217elemental integer function integerdatr(voldat,var)
12218real,intent(in) :: voldat
12219type(vol7d_var),intent(in) :: var
12220
12223 integerdatr=nint(voldat*10d0**var%scalefactor)
12224 else
12225 integerdatr=nint(voldat)
12226 endif
12227else
12228 integerdatr=imiss
12229end if
12230
12231end function integerdatr
12232
12233
12234elemental integer function integerdati(voldat,var)
12235integer,intent(in) :: voldat
12236type(vol7d_var),intent(in) :: var
12237
12238integerdati=voldat
12239
12240end function integerdati
12241
12242
12243elemental integer function integerdatb(voldat,var)
12244integer(kind=int_b),intent(in) :: voldat
12245type(vol7d_var),intent(in) :: var
12246
12248 integerdatb=voldat
12249else
12250 integerdatb=imiss
12251end if
12252
12253end function integerdatb
12254
12255
12256elemental integer function integerdatc(voldat,var)
12257CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
12258type(vol7d_var),intent(in) :: var
12259
12260integerdatc=c2i(voldat)
12261
12262end function integerdatc
12263
12264
12265! to real
12266elemental real function realdatd(voldat,var)
12267doubleprecision,intent(in) :: voldat
12268type(vol7d_var),intent(in) :: var
12269
12271 realdatd=real(voldat)
12272else
12273 realdatd=rmiss
12274end if
12275
12276end function realdatd
12277
12278
12279elemental real function realdatr(voldat,var)
12280real,intent(in) :: voldat
12281type(vol7d_var),intent(in) :: var
12282
12283realdatr=voldat
12284
12285end function realdatr
12286
12287
12288elemental real function realdati(voldat,var)
12289integer,intent(in) :: voldat
12290type(vol7d_var),intent(in) :: var
12291
12294 realdati=float(voldat)/10.**var%scalefactor
12295 else
12296 realdati=float(voldat)
12297 endif
12298else
12299 realdati=rmiss
12300end if
12301
12302end function realdati
12303
12304
12305elemental real function realdatb(voldat,var)
12306integer(kind=int_b),intent(in) :: voldat
12307type(vol7d_var),intent(in) :: var
12308
12311 realdatb=float(voldat)/10**var%scalefactor
12312 else
12313 realdatb=float(voldat)
12314 endif
12315else
12316 realdatb=rmiss
12317end if
12318
12319end function realdatb
12320
12321
12322elemental real function realdatc(voldat,var)
12323CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
12324type(vol7d_var),intent(in) :: var
12325
12326realdatc=c2r(voldat)
12328 realdatc=realdatc/10.**var%scalefactor
12329end if
12330
12331end function realdatc
12332
12333
12339FUNCTION realanavol(this, var) RESULT(vol)
12340TYPE(vol7d),INTENT(in) :: this
12341TYPE(vol7d_var),INTENT(in) :: var
12342REAL :: vol(SIZE(this%ana),size(this%network))
12343
12344CHARACTER(len=1) :: dtype
12345INTEGER :: indvar
12346
12347dtype = cmiss
12348indvar = index(this%anavar, var, type=dtype)
12349
12350IF (indvar > 0) THEN
12351 SELECT CASE (dtype)
12352 CASE("d")
12353 vol = realdat(this%volanad(:,indvar,:), var)
12354 CASE("r")
12355 vol = this%volanar(:,indvar,:)
12356 CASE("i")
12357 vol = realdat(this%volanai(:,indvar,:), var)
12358 CASE("b")
12359 vol = realdat(this%volanab(:,indvar,:), var)
12360 CASE("c")
12361 vol = realdat(this%volanac(:,indvar,:), var)
12362 CASE default
12363 vol = rmiss
12364 END SELECT
12365ELSE
12366 vol = rmiss
12367ENDIF
12368
12369END FUNCTION realanavol
12370
12371
12377FUNCTION integeranavol(this, var) RESULT(vol)
12378TYPE(vol7d),INTENT(in) :: this
12379TYPE(vol7d_var),INTENT(in) :: var
12380INTEGER :: vol(SIZE(this%ana),size(this%network))
12381
12382CHARACTER(len=1) :: dtype
12383INTEGER :: indvar
12384
12385dtype = cmiss
12386indvar = index(this%anavar, var, type=dtype)
12387
12388IF (indvar > 0) THEN
12389 SELECT CASE (dtype)
12390 CASE("d")
12391 vol = integerdat(this%volanad(:,indvar,:), var)
12392 CASE("r")
12393 vol = integerdat(this%volanar(:,indvar,:), var)
12394 CASE("i")
12395 vol = this%volanai(:,indvar,:)
12396 CASE("b")
12397 vol = integerdat(this%volanab(:,indvar,:), var)
12398 CASE("c")
12399 vol = integerdat(this%volanac(:,indvar,:), var)
12400 CASE default
12401 vol = imiss
12402 END SELECT
12403ELSE
12404 vol = imiss
12405ENDIF
12406
12407END FUNCTION integeranavol
12408
12409
12415subroutine move_datac (v7d,&
12416 indana,indtime,indlevel,indtimerange,indnetwork,&
12417 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
12418
12419TYPE(vol7d),intent(inout) :: v7d
12420
12421integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
12422integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
12423integer :: inddativar,inddativarattr
12424
12425
12426do inddativar=1,size(v7d%dativar%c)
12427
12429 .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
12430 ) then
12431
12432 ! dati
12433 v7d%voldatic &
12434 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
12435 v7d%voldatic &
12436 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
12437
12438
12439 ! attributi
12440 if (associated (v7d%dativarattr%i)) then
12441 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
12442 if (inddativarattr > 0 ) then
12443 v7d%voldatiattri &
12444 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12445 v7d%voldatiattri &
12446 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12447 end if
12448 end if
12449
12450 if (associated (v7d%dativarattr%r)) then
12451 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
12452 if (inddativarattr > 0 ) then
12453 v7d%voldatiattrr &
12454 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12455 v7d%voldatiattrr &
12456 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12457 end if
12458 end if
12459
12460 if (associated (v7d%dativarattr%d)) then
12461 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
12462 if (inddativarattr > 0 ) then
12463 v7d%voldatiattrd &
12464 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12465 v7d%voldatiattrd &
12466 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12467 end if
12468 end if
12469
12470 if (associated (v7d%dativarattr%b)) then
12471 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
12472 if (inddativarattr > 0 ) then
12473 v7d%voldatiattrb &
12474 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12475 v7d%voldatiattrb &
12476 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12477 end if
12478 end if
12479
12480 if (associated (v7d%dativarattr%c)) then
12481 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
12482 if (inddativarattr > 0 ) then
12483 v7d%voldatiattrc &
12484 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12485 v7d%voldatiattrc &
12486 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12487 end if
12488 end if
12489
12490 end if
12491
12492end do
12493
12494end subroutine move_datac
12495
12501subroutine move_datar (v7d,&
12502 indana,indtime,indlevel,indtimerange,indnetwork,&
12503 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
12504
12505TYPE(vol7d),intent(inout) :: v7d
12506
12507integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
12508integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
12509integer :: inddativar,inddativarattr
12510
12511
12512do inddativar=1,size(v7d%dativar%r)
12513
12515 .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
12516 ) then
12517
12518 ! dati
12519 v7d%voldatir &
12520 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
12521 v7d%voldatir &
12522 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
12523
12524
12525 ! attributi
12526 if (associated (v7d%dativarattr%i)) then
12527 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
12528 if (inddativarattr > 0 ) then
12529 v7d%voldatiattri &
12530 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12531 v7d%voldatiattri &
12532 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12533 end if
12534 end if
12535
12536 if (associated (v7d%dativarattr%r)) then
12537 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%r(inddativar))
12538 if (inddativarattr > 0 ) then
12539 v7d%voldatiattrr &
12540 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12541 v7d%voldatiattrr &
12542 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12543 end if
12544 end if
12545
12546 if (associated (v7d%dativarattr%d)) then
12547 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%r(inddativar))
12548 if (inddativarattr > 0 ) then
12549 v7d%voldatiattrd &
12550 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12551 v7d%voldatiattrd &
12552 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12553 end if
12554 end if
12555
12556 if (associated (v7d%dativarattr%b)) then
12557 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%r(inddativar))
12558 if (inddativarattr > 0 ) then
12559 v7d%voldatiattrb &
12560 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12561 v7d%voldatiattrb &
12562 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12563 end if
12564 end if
12565
12566 if (associated (v7d%dativarattr%c)) then
12567 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%r(inddativar))
12568 if (inddativarattr > 0 ) then
12569 v7d%voldatiattrc &
12570 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
12571 v7d%voldatiattrc &
12572 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
12573 end if
12574 end if
12575
12576 end if
12577
12578end do
12579
12580end subroutine move_datar
12581
12582
12596subroutine v7d_rounding(v7din,v7dout,level,timerange,nostatproc)
12597type(vol7d),intent(inout) :: v7din
12598type(vol7d),intent(out) :: v7dout
12599type(vol7d_level),intent(in),optional :: level(:)
12600type(vol7d_timerange),intent(in),optional :: timerange(:)
12601!logical,intent(in),optional :: merge !< if there are data on more then one almost equal levels or timeranges
12602!! will be merged POINT BY POINT with priority for the fird data found ordered by icreasing var index
12603logical,intent(in),optional :: nostatproc
12604
12605integer :: nana,nlevel,ntime,ntimerange,nnetwork,nbin
12606integer :: iana,ilevel,itimerange,indl,indt,itime,inetwork
12607type(vol7d_level) :: roundlevel(size(v7din%level))
12608type(vol7d_timerange) :: roundtimerange(size(v7din%timerange))
12609type(vol7d) :: v7d_tmp
12610
12611
12612nbin=0
12613
12614if (associated(v7din%dativar%r)) nbin = nbin + size(v7din%dativar%r)
12615if (associated(v7din%dativar%i)) nbin = nbin + size(v7din%dativar%i)
12616if (associated(v7din%dativar%d)) nbin = nbin + size(v7din%dativar%d)
12617if (associated(v7din%dativar%b)) nbin = nbin + size(v7din%dativar%b)
12618
12620
12621roundlevel=v7din%level
12622
12623if (present(level))then
12624 do ilevel = 1, size(v7din%level)
12625 if ((any(v7din%level(ilevel) .almosteq. level))) then
12626 roundlevel(ilevel)=level(1)
12627 end if
12628 end do
12629end if
12630
12631roundtimerange=v7din%timerange
12632
12633if (present(timerange))then
12634 do itimerange = 1, size(v7din%timerange)
12635 if ((any(v7din%timerange(itimerange) .almosteq. timerange))) then
12636 roundtimerange(itimerange)=timerange(1)
12637 end if
12638 end do
12639end if
12640
12641!set istantaneous values everywere
12642!preserve p1 for forecast time
12643if (optio_log(nostatproc)) then
12644 roundtimerange(:)%timerange=254
12645 roundtimerange(:)%p2=0
12646end if
12647
12648
12649nana=size(v7din%ana)
12650nlevel=count_distinct(roundlevel,back=.true.)
12651ntime=size(v7din%time)
12652ntimerange=count_distinct(roundtimerange,back=.true.)
12653nnetwork=size(v7din%network)
12654
12656
12657if (nbin == 0) then
12659else
12660 call vol7d_convr(v7din,v7d_tmp)
12661end if
12662
12663v7d_tmp%level=roundlevel
12664v7d_tmp%timerange=roundtimerange
12665
12666do ilevel=1, size(v7d_tmp%level)
12667 indl=index(v7d_tmp%level,roundlevel(ilevel))
12668 do itimerange=1,size(v7d_tmp%timerange)
12669 indt=index(v7d_tmp%timerange,roundtimerange(itimerange))
12670
12671 if (indl /= ilevel .or. indt /= itimerange) then
12672
12673 do iana=1, nana
12674 do itime=1,ntime
12675 do inetwork=1,nnetwork
12676
12677 if (nbin > 0) then
12678 call move_datar (v7d_tmp,&
12679 iana,itime,ilevel,itimerange,inetwork,&
12680 iana,itime,indl,indt,inetwork)
12681 else
12682 call move_datac (v7d_tmp,&
12683 iana,itime,ilevel,itimerange,inetwork,&
12684 iana,itime,indl,indt,inetwork)
12685 end if
12686
12687 end do
12688 end do
12689 end do
12690
12691 end if
12692
12693 end do
12694end do
12695
12696! set to missing level and time > nlevel
12697do ilevel=nlevel+1,size(v7d_tmp%level)
12699end do
12700
12701do itimerange=ntimerange+1,size(v7d_tmp%timerange)
12703end do
12704
12705!copy with remove
12708
12709!call display(v7dout)
12710
12711end subroutine v7d_rounding
12712
12713
12715
12721
12722
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 |