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_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 2490 del file vol7d_class.F90. 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 (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 !>\brief Lettura da file di un volume Vol7d. !! Lettura da file unformatted di un intero volume Vol7d. !! Questa subroutine comprende vol7d_alloc e vol7d_alloc_vol. !! Il file puo' essere aperto opzionalmente dall'utente. Si possono passare !! opzionalmente unità e nome del file altrimenti assegnati internamente a dei default; se assegnati internamente !! tali parametri saranno in output. subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto) TYPE(vol7d),INTENT(OUT) :: this !< Volume vol7d da leggere integer,intent(inout),optional :: unit !< unità su cui è stato aperto un file; se =0 rielaborato internamente (default = elaborato internamente con getunit) character(len=*),INTENT(in),optional :: filename !< nome del file eventualmente da aprire (default = (nome dell'eseguibile)//.v7d ) character(len=*),intent(out),optional :: filename_auto !< nome del file generato se "filename" è omesso character(len=*),INTENT(out),optional :: description !< descrizione del volume letto integer,intent(out),optional :: tarray(8) !< vettore come definito da "date_and_time" della data di scrittura del volume 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 !> Return an ana volume of a requested variable as real data. !! It returns a 2-d array of the proper shape (ana x network) for the !! ana variable requested, converted to real type. If the conversion !! fails or if the variable is not contained in the ana volume, !! missing data are returned. FUNCTION realanavol(this, var) RESULT(vol) TYPE(vol7d),INTENT(in) :: this !< the \a vol7d object to query, the method \a vol7d_alloc_vol must have been called for it otherwise progam may abort TYPE(vol7d_var),INTENT(in) :: var !< the ana variable to be returned 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 !> Return an ana volume of a requested variable as integer data. !! It returns a 2-d array of the proper shape (ana x network) for the !! ana variable requested, converted to integer type. If the conversion !! fails or if the variable is not contained in the ana volume, !! missing data are returned. FUNCTION integeranavol(this, var) RESULT(vol) TYPE(vol7d),INTENT(in) :: this !< the \a vol7d object to query, the method \a vol7d_alloc_vol must have been called for it otherwise progam may abort TYPE(vol7d_var),INTENT(in) :: var !< the ana variable to be returned 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 !> Move data for all variables from one coordinate in the character 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. subroutine move_datac (v7d,& indana,indtime,indlevel,indtimerange,indnetwork,& indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew) TYPE(vol7d),intent(inout) :: v7d !< data in form of character in this object will be moved integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork !< source coordinate of the data integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew !< destination coordinate of data 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 !> 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. subroutine move_datar (v7d,& indana,indtime,indlevel,indtimerange,indnetwork,& indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew) TYPE(vol7d),intent(inout) :: v7d !< data in form of character in this object will be moved integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork !< source coordinate of the data integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew !< destination coordinate of data 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 &