dat_display dat_vect_display integeranavol move_datac move_datar realanavol to_char_dat v7d_rounding vol7d_alloc vol7d_alloc_vol vol7d_ana_a vol7d_ana_d vol7d_append vol7d_attr_a vol7d_attr_d vol7d_c_e vol7d_check vol7d_check_vol vol7d_convr vol7d_copy vol7d_delete vol7d_diff_only vol7d_display vol7d_filter vol7d_get_volanaattrb vol7d_get_volanaattrc vol7d_get_volanaattrd vol7d_get_volanaattri vol7d_get_volanaattrr vol7d_get_volanab vol7d_get_volanac vol7d_get_volanad vol7d_get_volanai vol7d_get_volanar vol7d_get_voldatiattrb vol7d_get_voldatiattrc vol7d_get_voldatiattrd vol7d_get_voldatiattri vol7d_get_voldatiattrr vol7d_get_voldatib vol7d_get_voldatic vol7d_get_voldatid vol7d_get_voldatii vol7d_get_voldatir vol7d_init vol7d_level_d vol7d_merge vol7d_network_a vol7d_network_d vol7d_read_from_file vol7d_reform vol7d_set_attr_ind vol7d_smart_sort vol7d_time_d vol7d_timerange_d vol7d_var_a vol7d_var_d vol7d_write_on_file

vol7d_diff_only() subroutine vol7d_class::vol7d_diff_only ( type(vol7d), intent(in)  this, type(vol7d), intent(out)  that, logical, intent(in), optional  data_only, logical, intent(in), optional  ana  ) Metodo per ottenere solo le differenze tra due oggetti vol7d. Il primo volume viene confrontato col secondo; nel secondo volume ovunque i dati confrontati siano coincidenti viene impostato valore mancante. Parametri [in] this primo volume da confrontare [out] that secondo volume da confrontare in cui eliminare i dati coincidenti [in] data_only attiva l'elaborazione dei soli dati e non dell'anagrafica (default: .false.) [in] ana attiva l'elaborazione dell'anagrafica (coordinate e ident) (default: .false.) Definizione alla linea 2501 del file vol7d_class.F90. end if lfilename=trim(arg)//".v7d" if (index(arg,'/',back=.true.) > 0) lfilename=lfilename(index(arg,'/',back=.true.)+1 : ) if (present(filename))then if (filename /= "")then lfilename=filename end if end if if (present(filename_auto))filename_auto=lfilename inquire(unit=lunit,opened=opened) if (.not. opened) then ! inquire(file=lfilename, EXIST=exist) ! IF (exist) THEN ! CALL l4f_log(L4F_FATAL, & ! 'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename)) ! CALL raise_fatal_error() ! ENDIF OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM') CALL l4f_log(l4f_info, 'opened: '//trim(lfilename)) end if if (associated(this%ana)) nana=size(this%ana) if (associated(this%time)) ntime=size(this%time) if (associated(this%timerange)) ntimerange=size(this%timerange) if (associated(this%level)) nlevel=size(this%level) if (associated(this%network)) nnetwork=size(this%network) if (associated(this%dativar%r)) ndativarr=size(this%dativar%r) if (associated(this%dativar%i)) ndativari=size(this%dativar%i) if (associated(this%dativar%b)) ndativarb=size(this%dativar%b) if (associated(this%dativar%d)) ndativard=size(this%dativar%d) if (associated(this%dativar%c)) ndativarc=size(this%dativar%c) if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r) if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i) if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b) if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d) if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c) if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r) if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i) if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b) if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d) if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c) if (associated(this%anavar%r)) nanavarr=size(this%anavar%r) if (associated(this%anavar%i)) nanavari=size(this%anavar%i) if (associated(this%anavar%b)) nanavarb=size(this%anavar%b) if (associated(this%anavar%d)) nanavard=size(this%anavar%d) if (associated(this%anavar%c)) nanavarc=size(this%anavar%c) if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r) if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i) if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b) if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d) if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c) if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r) if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i) if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b) if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d) if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c) write(unit=lunit)ldescription write(unit=lunit)tarray write(unit=lunit)& nana, ntime, ntimerange, nlevel, nnetwork, & ndativarr, ndativari, ndativarb, ndativard, ndativarc,& ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,& ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,& nanavarr, nanavari, nanavarb, nanavard, nanavarc,& nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,& nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, & this%time_definition !write(unit=lunit)this !! prime 5 dimensioni if (associated(this%ana)) call write_unit(this%ana, lunit) if (associated(this%time)) call write_unit(this%time, lunit) if (associated(this%level)) write(unit=lunit)this%level if (associated(this%timerange)) write(unit=lunit)this%timerange if (associated(this%network)) write(unit=lunit)this%network !! 6a dimensione: variabile dell'anagrafica e dei dati !! con relativi attributi e in 5 tipi diversi if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c !! Volumi di valori e attributi per anagrafica e dati if (associated(this%volanar)) write(unit=lunit)this%volanar if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr if (associated(this%voldatir)) write(unit=lunit)this%voldatir if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr if (associated(this%volanai)) write(unit=lunit)this%volanai if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri if (associated(this%voldatii)) write(unit=lunit)this%voldatii if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri if (associated(this%volanab)) write(unit=lunit)this%volanab if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb if (associated(this%voldatib)) write(unit=lunit)this%voldatib if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb if (associated(this%volanad)) write(unit=lunit)this%volanad if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd if (associated(this%voldatid)) write(unit=lunit)this%voldatid if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd if (associated(this%volanac)) write(unit=lunit)this%volanac if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc if (associated(this%voldatic)) write(unit=lunit)this%voldatic if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc if (.not. present(unit)) close(unit=lunit) end subroutine vol7d_write_on_file subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto) TYPE(vol7d),INTENT(OUT) :: this integer,intent(inout),optional :: unit character(len=*),INTENT(in),optional :: filename character(len=*),intent(out),optional :: filename_auto character(len=*),INTENT(out),optional :: description integer,intent(out),optional :: tarray(8) integer :: nana, ntime, ntimerange, nlevel, nnetwork, & ndativarr, ndativari, ndativarb, ndativard, ndativarc,& ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,& ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,& nanavarr, nanavari, nanavarb, nanavard, nanavarc,& nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,& nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc character(len=254) :: ldescription,lfilename,arg integer :: ltarray(8),lunit,ios logical :: opened,exist call getarg(0,arg) if (.not. present(unit))then lunit=getunit() else if (unit==0)then lunit=getunit() unit=lunit else lunit=unit end if end if lfilename=trim(arg)//".v7d" if (index(arg,'/',back=.true.) > 0) lfilename=lfilename(index(arg,'/',back=.true.)+1 : ) if (present(filename))then if (filename /= "")then lfilename=filename end if end if if (present(filename_auto))filename_auto=lfilename inquire(unit=lunit,opened=opened) IF (.NOT. opened) THEN inquire(file=lfilename,exist=exist) IF (.NOT.exist) THEN CALL l4f_log(l4f_fatal, & 'in vol7d_read_from_file, file does not exists, cannot open') CALL raise_fatal_error() ENDIF OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM', & status='OLD', action='READ') CALL l4f_log(l4f_info, 'opened: '//trim(lfilename)) end if call init(this) read(unit=lunit,iostat=ios)ldescription if (ios < 0) then ! A negative value indicates that the End of File or End of Record call vol7d_alloc (this) call vol7d_alloc_vol (this) if (present(description))description=ldescription if (present(tarray))tarray=ltarray if (.not. present(unit)) close(unit=lunit) end if read(unit=lunit)ltarray CALL l4f_log(l4f_info, 'Reading vol7d from file') CALL l4f_log(l4f_info, 'description: '//trim(ldescription)) CALL l4f_log(l4f_info, 'written on '//trim(to_char(ltarray(1)))//' '// & trim(to_char(ltarray(2)))//' '//trim(to_char(ltarray(3)))) if (present(description))description=ldescription if (present(tarray))tarray=ltarray read(unit=lunit)& nana, ntime, ntimerange, nlevel, nnetwork, & ndativarr, ndativari, ndativarb, ndativard, ndativarc,& ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,& ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,& nanavarr, nanavari, nanavarb, nanavard, nanavarc,& nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,& nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, & this%time_definition call vol7d_alloc (this, & nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,& ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,& ndativard=ndativard, ndativarc=ndativarc,& ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,& ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,& ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, & ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,& nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, & nanavard=nanavard, nanavarc=nanavarc,& nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,& nanaattrd=nanaattrd, nanaattrc=nanaattrc,& nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, & nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc) if (associated(this%ana)) call read_unit(this%ana, lunit) if (associated(this%time)) call read_unit(this%time, lunit) if (associated(this%level)) read(unit=lunit)this%level if (associated(this%timerange)) read(unit=lunit)this%timerange if (associated(this%network)) read(unit=lunit)this%network if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c call vol7d_alloc_vol (this) !! Volumi di valori e attributi per anagrafica e dati if (associated(this%volanar)) read(unit=lunit)this%volanar if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr if (associated(this%voldatir)) read(unit=lunit)this%voldatir if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr if (associated(this%volanai)) read(unit=lunit)this%volanai if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri if (associated(this%voldatii)) read(unit=lunit)this%voldatii if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri if (associated(this%volanab)) read(unit=lunit)this%volanab if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb if (associated(this%voldatib)) read(unit=lunit)this%voldatib if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb if (associated(this%volanad)) read(unit=lunit)this%volanad if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd if (associated(this%voldatid)) read(unit=lunit)this%voldatid if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd if (associated(this%volanac)) read(unit=lunit)this%volanac if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc if (associated(this%voldatic)) read(unit=lunit)this%voldatic if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc if (.not. present(unit)) close(unit=lunit) end subroutine vol7d_read_from_file ! to double precision elemental doubleprecision function doubledatd(voldat,var) doubleprecision,intent(in) :: voldat type(vol7d_var),intent(in) :: var doubledatd=voldat end function doubledatd elemental doubleprecision function doubledatr(voldat,var) real,intent(in) :: voldat type(vol7d_var),intent(in) :: var if (c_e(voldat))then doubledatr=dble(voldat) else doubledatr=dmiss end if end function doubledatr elemental doubleprecision function doubledati(voldat,var) integer,intent(in) :: voldat type(vol7d_var),intent(in) :: var if (c_e(voldat)) then if (c_e(var%scalefactor))then doubledati=dble(voldat)/10.d0**var%scalefactor else doubledati=dble(voldat) endif else doubledati=dmiss end if end function doubledati elemental doubleprecision function doubledatb(voldat,var) integer(kind=int_b),intent(in) :: voldat type(vol7d_var),intent(in) :: var if (c_e(voldat)) then if (c_e(var%scalefactor))then doubledatb=dble(voldat)/10.d0**var%scalefactor else doubledatb=dble(voldat) endif else doubledatb=dmiss end if end function doubledatb elemental doubleprecision function doubledatc(voldat,var) CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat type(vol7d_var),intent(in) :: var doubledatc = c2d(voldat) if (c_e(doubledatc) .and. c_e(var%scalefactor))then doubledatc=doubledatc/10.d0**var%scalefactor end if end function doubledatc ! to integer elemental integer function integerdatd(voldat,var) doubleprecision,intent(in) :: voldat type(vol7d_var),intent(in) :: var if (c_e(voldat))then if (c_e(var%scalefactor)) then integerdatd=nint(voldat*10d0**var%scalefactor) else integerdatd=nint(voldat) endif else integerdatd=imiss end if end function integerdatd elemental integer function integerdatr(voldat,var) real,intent(in) :: voldat type(vol7d_var),intent(in) :: var if (c_e(voldat))then if (c_e(var%scalefactor)) then integerdatr=nint(voldat*10d0**var%scalefactor) else integerdatr=nint(voldat) endif else integerdatr=imiss end if end function integerdatr elemental integer function integerdati(voldat,var) integer,intent(in) :: voldat type(vol7d_var),intent(in) :: var integerdati=voldat end function integerdati elemental integer function integerdatb(voldat,var) integer(kind=int_b),intent(in) :: voldat type(vol7d_var),intent(in) :: var if (c_e(voldat))then integerdatb=voldat else integerdatb=imiss end if end function integerdatb elemental integer function integerdatc(voldat,var) CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat type(vol7d_var),intent(in) :: var integerdatc=c2i(voldat) end function integerdatc ! to real elemental real function realdatd(voldat,var) doubleprecision,intent(in) :: voldat type(vol7d_var),intent(in) :: var if (c_e(voldat))then realdatd=real(voldat) else realdatd=rmiss end if end function realdatd elemental real function realdatr(voldat,var) real,intent(in) :: voldat type(vol7d_var),intent(in) :: var realdatr=voldat end function realdatr elemental real function realdati(voldat,var) integer,intent(in) :: voldat type(vol7d_var),intent(in) :: var if (c_e(voldat)) then if (c_e(var%scalefactor))then realdati=float(voldat)/10.**var%scalefactor else realdati=float(voldat) endif else realdati=rmiss end if end function realdati elemental real function realdatb(voldat,var) integer(kind=int_b),intent(in) :: voldat type(vol7d_var),intent(in) :: var if (c_e(voldat)) then if (c_e(var%scalefactor))then realdatb=float(voldat)/10**var%scalefactor else realdatb=float(voldat) endif else realdatb=rmiss end if end function realdatb elemental real function realdatc(voldat,var) CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat type(vol7d_var),intent(in) :: var realdatc=c2r(voldat) if (c_e(realdatc) .and. c_e(var%scalefactor))then realdatc=realdatc/10.**var%scalefactor end if end function realdatc FUNCTION realanavol(this, var) RESULT(vol) TYPE(vol7d),INTENT(in) :: this TYPE(vol7d_var),INTENT(in) :: var REAL :: vol(SIZE(this%ana),size(this%network)) CHARACTER(len=1) :: dtype INTEGER :: indvar dtype = cmiss indvar = index(this%anavar, var, type=dtype) IF (indvar > 0) THEN SELECT CASE (dtype) CASE("d") vol = realdat(this%volanad(:,indvar,:), var) CASE("r") vol = this%volanar(:,indvar,:) CASE("i") vol = realdat(this%volanai(:,indvar,:), var) CASE("b") vol = realdat(this%volanab(:,indvar,:), var) CASE("c") vol = realdat(this%volanac(:,indvar,:), var) CASE default vol = rmiss END SELECT ELSE vol = rmiss ENDIF END FUNCTION realanavol FUNCTION integeranavol(this, var) RESULT(vol) TYPE(vol7d),INTENT(in) :: this TYPE(vol7d_var),INTENT(in) :: var INTEGER :: vol(SIZE(this%ana),size(this%network)) CHARACTER(len=1) :: dtype INTEGER :: indvar dtype = cmiss indvar = index(this%anavar, var, type=dtype) IF (indvar > 0) THEN SELECT CASE (dtype) CASE("d") vol = integerdat(this%volanad(:,indvar,:), var) CASE("r") vol = integerdat(this%volanar(:,indvar,:), var) CASE("i") vol = this%volanai(:,indvar,:) CASE("b") vol = integerdat(this%volanab(:,indvar,:), var) CASE("c") vol = integerdat(this%volanac(:,indvar,:), var) CASE default vol = imiss END SELECT ELSE vol = imiss ENDIF END FUNCTION integeranavol subroutine move_datac (v7d,& indana,indtime,indlevel,indtimerange,indnetwork,& indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew) TYPE(vol7d),intent(inout) :: v7d integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew integer :: inddativar,inddativarattr do inddativar=1,size(v7d%dativar%c) if (c_e(v7d%voldatic(indana,indtime,indlevel,indtimerange,inddativar,indnetwork)) .and. & .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))& ) then ! dati v7d%voldatic & (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = & v7d%voldatic & (indana,indtime,indlevel,indtimerange,inddativar,indnetwork) ! attributi if (associated (v7d%dativarattr%i)) then inddativarattr = index(v7d%dativarattr%i,v7d%dativar%c(inddativar)) if (inddativarattr > 0 ) then v7d%voldatiattri & (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = & v7d%voldatiattri & (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:) end if end if if (associated (v7d%dativarattr%r)) then inddativarattr = index(v7d%dativarattr%r,v7d%dativar%c(inddativar)) if (inddativarattr > 0 ) then v7d%voldatiattrr & (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = & v7d%voldatiattrr & (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:) end if end if if (associated (v7d%dativarattr%d)) then inddativarattr = index(v7d%dativarattr%d,v7d%dativar%c(inddativar)) if (inddativarattr > 0 ) then v7d%voldatiattrd & (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = & v7d%voldatiattrd & (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:) end if end if if (associated (v7d%dativarattr%b)) then inddativarattr = index(v7d%dativarattr%b,v7d%dativar%c(inddativar)) if (inddativarattr > 0 ) then v7d%voldatiattrb & (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = & v7d%voldatiattrb & (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:) end if end if if (associated (v7d%dativarattr%c)) then inddativarattr = index(v7d%dativarattr%c,v7d%dativar%c(inddativar)) if (inddativarattr > 0 ) then v7d%voldatiattrc & (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = & v7d%voldatiattrc & (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:) end if end if end if end do end subroutine move_datac subroutine move_datar (v7d,& indana,indtime,indlevel,indtimerange,indnetwork,& indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew) TYPE(vol7d),intent(inout) :: v7d integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew integer :: inddativar,inddativarattr do inddativar=1,size(v7d%dativar%r) if (c_e(v7d%voldatir(indana,indtime,indlevel,indtimerange,inddativar,indnetwork)) .and. & .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))& ) then ! dati v7d%voldatir & (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = & v7d%voldatir & (indana,indtime,indlevel,indtimerange,inddativar,indnetwork) ! attributi if (associated (v7d%dativarattr%i)) then inddativarattr = index(v7d%dativarattr%i,v7d%dativar%r(inddativar)) if (inddativarattr > 0 ) then v7d%voldatiattri & (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = & v7d%voldatiattri &