libsim Versione 7.2.6
|
◆ vol7d_dballe_export_old()
Exporta un volume dati a un DSN DB-all.e. Riscrive i dati nel DSN di DB-All.e con la possibilità di attivare una serie di filtri.
Definizione alla linea 2636 del file vol7d_dballe_class.F03. 2638! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2639! authors:
2640! Davide Cesari <dcesari@arpa.emr.it>
2641! Paolo Patruno <ppatruno@arpa.emr.it>
2642
2643! This program is free software; you can redistribute it and/or
2644! modify it under the terms of the GNU General Public License as
2645! published by the Free Software Foundation; either version 2 of
2646! the License, or (at your option) any later version.
2647
2648! This program is distributed in the hope that it will be useful,
2649! but WITHOUT ANY WARRANTY; without even the implied warranty of
2650! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2651! GNU General Public License for more details.
2652
2653! You should have received a copy of the GNU General Public License
2654! along with this program. If not, see <http://www.gnu.org/licenses/>.
2655
2656#include "config.h"
2657
2658!> \brief classe per import ed export di volumi da e in DB-All.e
2659!!
2660!!Questo modulo definisce gli oggetti e i metodi per gestire
2661!!l'importazione e l'esportazione di volumi dal database per dati sparsi
2662!!DB-All.e
2663!!
2664!!Il tutto funziona intorno all'oggetto vol7d_dballe che aggiunge ad un
2665!!oggetto vol7d ulteriori informazioni.
2666!!
2667!!Con la chiamata init vengono definiti i parametri di accesso alla DSN
2668!!(database) di DB-All.e. oppure da file bufr/crex
2669!!
2670!!Con import è possibile acquisire nel prorio programma i dati presenti
2671!!nel DSN o su file; l'allocazione di memoria è automatica. Import è in grado di
2672!!importare dati senza nessuna ulteriore specificazione: vengono
2673!!acquisite tutte le stazioni senza limiti di tempo o di spazio, per
2674!!tutti i dati, compresi quelli di anagrafica; solo gli attributi
2675!!vengono tralasciati se non specificati. Se non specificato i dati sono
2676!!in forma character che permette di essere conservativi su tutti i tipi
2677!!di dato archiviabile in DB-all.e. Aumentando i parametri
2678!!all'intefaccia import è possibile specificare sottoinsiemi temporali e
2679!!spaziali, elenchi di variabili e attributi. E' possibile anche
2680!!specificare il tipo per ogni variabile o attributo richiesto. E'
2681!!fornito un set di routine per avere la possibilità di estrarre un
2682!!vettore di variabili e un vettore di reti. E' possibile anche specificare
2683!!una singola stazione. vol7d_dballe%%data_id
2684!!contiene un vettore di servizio con gli id interni del database che
2685!!indirizzano direttamente i dati. Una particolare opzione permette di
2686!!attivare l'opzione query di tipo best in DB-All.e per avere in una
2687!!unica rete i dati migliori presenti nel DB.
2688!!
2689!!Con export si riscrivono i dati nel DSN di DB-All.e potendo attivare
2690!!una serie di filtri.
2691!!
2692!!Con delete si elimina definitvamente l'oggetto vol7d_dballe.
2693!!
2694!!Mantenendo lo stesso oggetto nella sequenza init, import, export,
2695!!delete si sovrascrive lo stesso DSN di DB-All.e. Il vettore
2696!!vol7d_dballe%%data_id in export permette di sovrascrivere solo gli
2697!!attributi; eventualmente possono essere sovrascritti i soli attributi
2698!!relativi agli elementi data_id non mancanti.
2699!!
2700!! E' da notare che se si attiva l'opzione "anaonly" solo ma tutte le stazioni e
2701!! i dati di anagrafica vengono importati secondo i parametri di query selezionati.
2702!! Se l'opzione "anaonly" è disattivata solo le stazioni con i dati richiesti presenti
2703!! saranno caricati nella sezione anagrafica
2704!!
2705!!Utilizzando due differenti oggetti uno per import e uno per export è
2706!!possibile tramite l'associazione del puntatore in essi contenuto
2707!!relativo al volume vol7d ricopiare contenuti in altri DSN senza
2708!!sprechi di memoria.
2709!!
2710!!Programma esempio
2711!!\include esempio_v7ddballe.f90
2712!!
2713!!\ingroup vol7d
2714
2716
2723!use list_mix
2726use vol7d_serialize_dballe_class
2727
2728IMPLICIT NONE
2729
2730character (len=255),parameter:: subcategory="vol7d_dballe_class"
2731
2732 !>\brief Oggetto per import ed export da DB-All.e
2733!!
2734!!L'oggetto è costituito da un oggetto vol7d attorniato dalle
2735!!informazioni necessarie per l'accesso al DSN di DB-All.e
2736!! e da una matrice necessaria per l'ottimizzazione della scrittura dei
2737!!degli attributi dei dati in export
2738
2740
2741 TYPE(vol7d) :: vol7d !< volume vol7d
2742 type(dbaconnection) :: idbhandle !< handle della connessioni al DSN DB-All.e
2743 type(dbasession) :: handle !< handle della sessione connessa al DSN DB-All.e
2744 !> memorizza gli id interni al database DB-All.e per
2745 !!ottimizzare le riscritture degli attributi ai dati
2746 integer ,pointer :: data_id(:,:,:,:,:)
2747 integer :: time_definition
2748 integer :: category = 0 !< log4fortran
2749 logical :: file !<
2750
2752
2753INTEGER, PARAMETER, PRIVATE :: nftype = 2
2754CHARACTER(len=16), PARAMETER, PRIVATE :: &
2755 pathlist(2,nftype) = reshape((/ &
2756 '/usr/share ', '/usr/local/share', &
2757 '/etc ', '/usr/local/etc ' /), &
2758 (/2,nftype/))
2759
2760
2761type(vol7d_var),allocatable,private :: blocal(:) ! cache of dballe.txt
2762
2763CHARACTER(len=20),PRIVATE :: dballe_name='wreport', dballe_name_env='DBA_TABLES'
2764
2765
2766 !>\brief inizializza
2768 MODULE PROCEDURE vol7d_dballe_init
2770
2771 !>\brief cancella
2773 MODULE PROCEDURE vol7d_dballe_delete
2775
2776
2777 !>\brief importa
2778INTERFACE import
2779 MODULE PROCEDURE vol7d_dballe_importvvnv,vol7d_dballe_import, vol7d_dballe_import_old, dba2v7d
2780END INTERFACE import
2781
2782 !>\brief exporta
2784 MODULE PROCEDURE vol7d_dballe_export_old,vol7d_dballe_export, v7d2dba
2786
2787
2788PRIVATE
2789PUBLIC vol7d_dballe, init, delete, import, export, vol7d_dballe_import_dballevar, vol7d_dballe_set_var_du
2790
2791CONTAINS
2792
2793
2794 !>\brief inizializza l'oggetto
2795SUBROUTINE vol7d_dballe_init(this,dsn,user,password,write,wipe,repinfo,&
2796 filename,format,file,categoryappend,time_definition,idbhandle,template)
2797
2798
2799TYPE(vol7d_dballe),INTENT(out) :: this !< l'oggetto da inizializzare
2800character(len=*), INTENT(in),OPTIONAL :: dsn !< per l'accesso al DSN ( default="test" )
2801character(len=*), INTENT(in),OPTIONAL :: user !< per l'accesso al DSN ( default="test" )
2802character(len=*), INTENT(in),OPTIONAL :: password !< per l'accesso al DSN ( default="" )
2803logical,INTENT(in),OPTIONAL :: write !< abilita la scrittura sul DSN/file ( default=.false. )
2804logical,INTENT(in),OPTIONAL :: wipe !< svuota il DSN/file e/o lo prepara per una scrittura ( default=.false. )
2805character(len=*), INTENT(in),OPTIONAL :: repinfo !< eventuale file repinfo.csv usato con wipe ( default="" )
2806character(len=*),intent(inout),optional :: filename !< nome dell'eventuale file da utilizzare in alternativa a dsn when file is true; se passato ="" ritorna un valore di deafult elaborato
2807character(len=*),intent(in),optional :: format !< the file format when file is true. It can be "BUFR", "CREX" or "JSON" (default="BUFR")
2808logical,INTENT(in),OPTIONAL :: file !< switch to use file or data base ( default=.false )
2809character(len=*),INTENT(in),OPTIONAL :: categoryappend !< appennde questo suffisso al namespace category di log4fortran
2810integer,INTENT(in),OPTIONAL :: time_definition !< 0=time is reference time ; 1=time is validity time (default=1)
2811integer,INTENT(in),OPTIONAL :: idbhandle !< dsn connection; if present it will be used
2812!> specificando category.subcategory.localcategory oppure un alias ("synop", "metar","temp","generic") forza l'exportazione ad uno specifico template BUFR/CREX"
2813!! the special value "generic-frag is used to generate bufr on file where ana data is reported only once at beginning and data in other bufr after
2814character(len=*),intent(in),optional :: template !< default template to use exporting to file; can be overwritten by export
2815
2816logical :: quiwrite,loadfile
2817character(len=512) :: a_name
2818character(len=254) :: arg,lfilename,lformat
2819
2820quiwrite=.false.
2821if (present(write))then
2822 quiwrite=write
2823endif
2824
2825if (present(categoryappend))then
2826 call l4f_launcher(a_name,a_name_append=trim(subcategory)//"."//trim(categoryappend))
2827else
2828 call l4f_launcher(a_name,a_name_append=trim(subcategory))
2829endif
2830this%category=l4f_category_get(a_name)
2831
2832#ifdef DEBUG
2834#endif
2835
2836nullify(this%data_id)
2837
2838if (optio_log(file)) then
2839
2840 this%file=.true.
2841
2842 lformat="BUFR"
2843 if (present(format))then
2844 lformat=format
2845 end if
2846
2847 CALL getarg(0,arg)
2848
2849 lfilename=trim(arg)//"."//trim(lformat)
2851
2852 if (present(filename))then
2854 lfilename=filename
2855 end if
2856 end if
2857
2858 if(quiwrite)then
2859 ! this for write in memdb and write file on export
2860 loadfile=.false.
2861 else
2862 loadfile=.true.
2863 end if
2864
2865 this%handle=dbasession(wipe=wipe,write=quiwrite,repinfo=repinfo, &
2866 filename=lfilename,format=lformat,template=template, &
2867 memdb=.true.,loadfile=loadfile)
2868
2869else
2870
2871 this%file=.false.
2872 this%idbhandle=dbaconnection(dsn,user,password,idbhandle=idbhandle)
2873 this%handle=dbasession(this%idbhandle,wipe=wipe,write=quiwrite,repinfo=repinfo)
2874
2875endif
2876
2877! this init has been added here for cleaningness, this%vol7d gets
2878! reinitialised afterwards in dba2v7d and this%vol7d%time_definition is
2879! overwritten by this%time_definition, this duplication is required in
2880! order to pass time_definition down to dba2v7d
2882this%time_definition = optio_i(time_definition)
2883
2884#ifdef DEBUG
2886#endif
2887
2888END SUBROUTINE vol7d_dballe_init
2889
2890
2891
2892 !>\brief Identica a vol7d_dballe_importvsns con var e network vettore.
2893!!
2894!!import da DB-all.e
2895
2896SUBROUTINE vol7d_dballe_importvvnv(this, var, network, coordmin,coordmax, timei, timef, level,timerange,set_network,&
2897 attr,anavar,anaattr, varkind,attrkind,anavarkind,anaattrkind,anaonly,dataonly,ana)
2898TYPE(vol7d_dballe),INTENT(inout) :: this !< oggetto vol7d_dballe
2899CHARACTER(len=*),INTENT(in) :: var(:)
2900TYPE(geo_coord),INTENT(inout),optional :: coordmin,coordmax
2901TYPE(vol7d_ana),INTENT(inout),optional :: ana
2902TYPE(datetime),INTENT(in),optional :: timei, timef
2903TYPE(vol7d_network),INTENT(in) :: network(:)
2904TYPE(vol7d_network),INTENT(in),OPTIONAL :: set_network
2905TYPE(vol7d_level),INTENT(in),optional :: level
2906TYPE(vol7d_timerange),INTENT(in),optional :: timerange
2907CHARACTER(len=*),INTENT(in),OPTIONAL :: attr(:),anavar(:),anaattr(:)
2908CHARACTER(len=*),INTENT(in),OPTIONAL :: varkind(:),attrkind(:),anavarkind(:),anaattrkind(:)
2909logical,intent(in),optional :: anaonly
2910LOGICAL,INTENT(in),OPTIONAL :: dataonly
2911TYPE(vol7d_dballe) :: v7ddbatmp
2912
2913INTEGER :: i
2914
2915IF (SIZE(network) == 0 )THEN
2917 timef=timef, level=level, timerange=timerange, set_network=set_network, &
2918 attr=attr, anavar=anavar, anaattr=anaattr, varkind=varkind, attrkind=attrkind, &
2919 anavarkind=anavarkind, anaattrkind=anaattrkind, anaonly=anaonly, &
2920 dataonly=dataonly, ana=ana)
2921ELSE
2923 v7ddbatmp = this ! shallow copy
2924 DO i = 1, SIZE(network)
2926 level,timerange, set_network, attr,anavar,anaattr, varkind, attrkind, &
2927 anavarkind, anaattrkind, anaonly, dataonly, ana)
2929 ENDDO
2930ENDIF
2931
2932END SUBROUTINE vol7d_dballe_importvvnv
2933
2934!>import da DB-all.e
2935SUBROUTINE vol7d_dballe_import_old(this, var, network, coordmin, coordmax, timei, timef,level,timerange, set_network,&
2936 attr,anavar,anaattr, varkind,attrkind,anavarkind,anaattrkind,anaonly,dataonly,ana)
2937
2938TYPE(vol7d_dballe),INTENT(inout) :: this !< oggetto vol7d_dballe
2939CHARACTER(len=*),INTENT(in),OPTIONAL :: var(:)
2940TYPE(geo_coord),INTENT(inout),optional :: coordmin,coordmax
2941TYPE(vol7d_ana),INTENT(inout),optional :: ana
2942TYPE(datetime),INTENT(in),OPTIONAL :: timei, timef
2943TYPE(vol7d_network),INTENT(in),OPTIONAL :: network,set_network
2944TYPE(vol7d_level),INTENT(in),optional :: level
2945TYPE(vol7d_timerange),INTENT(in),optional :: timerange
2946CHARACTER(len=*),INTENT(in),OPTIONAL :: attr(:),anavar(:),anaattr(:)
2947CHARACTER(len=*),INTENT(in),OPTIONAL :: varkind(:),attrkind(:),anavarkind(:),anaattrkind(:)
2948logical,intent(in),optional :: anaonly
2949logical,intent(in),optional :: dataonly
2950
2951
2952INTEGER,PARAMETER :: maxvarlist=100
2953 !TYPE(vol7d) :: v7d
2954 ! da non fare (con gfortran?)!!!!!
2955 !CHARACTER(len=SIZE(var)*7) :: varlist
2956 !CHARACTER(len=SIZE(attr)*8) :: starvarlist
2957
2958LOGICAL :: ldegnet
2959
2960INTEGER :: i
2961integer :: nvar
2962integer :: nanavar
2963
2964 !CHARACTER(len=10),allocatable :: lvar(:), lanavar(:)
2965type(dbadcv) :: vars,starvars,anavars,anastarvars
2966type(dbafilter) :: filter
2967type(dbacoord) :: mydbacoordmin, mydbacoordmax
2968type(dbaana) :: mydbaana
2969type(dbadatetime) :: mydatetimemin, mydatetimemax
2970type(dbatimerange) :: mydbatimerange
2971type(dbalevel) :: mydbalevel
2972type(dbanetwork) :: mydbanetwork
2973
2974integer :: nanaattr,nattr
2975
2976character(len=40) :: query
2977
2978#ifdef DEBUG
2980#endif
2981
2982
2983IF (PRESENT(set_network)) THEN
2985 ldegnet = .true.
2986 else
2987 ldegnet = .false.
2988 end if
2989ELSE
2990 ldegnet = .false.
2991ENDIF
2992
2993if(ldegnet) then
2994 query = "best"
2995else
2996 query=cmiss
2997end if
2998
2999
3000 ! uncommenti this if you want compatibility API with old import
3001
3002!!$ if (allocated(starvars%dcv)) then
3003!!$ ldataonly=.false.
3004!!$ else
3005!!$ ldataonly=.true.
3006!!$ end if
3007
3008
3009!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3010 ! ------------- prepare filter options
3011
3012!!
3013!! translate import option for dballe2003 api
3014!!
3015
3016if (present(var)) then
3017 nvar=count(c_e(var))
3018 if (nvar > 0) then
3019 allocate (vars%dcv(nvar))
3020 do i=1,size(var)
3022 if (present(varkind))then
3023 select case (varkind(i))
3024 case("r")
3026 case("i")
3028 case("b")
3030 case("d")
3032 case("c")
3034 case default
3036 CALL raise_fatal_error()
3037 end select
3038 else
3040 end if
3041 end if
3042 end do
3043 end if
3044end if
3045
3046if (present(anavar)) then
3047 nanavar=count(c_e(anavar))
3048 if (nanavar > 0) then
3049 allocate (anavars%dcv(nanavar))
3050 do i=1,size(anavar)
3052 if (present(anavarkind))then
3053 select case (anavarkind(i))
3054 case("r")
3056 case("i")
3058 case("b")
3060 case("d")
3062 case("c")
3064 case default
3066 CALL raise_fatal_error()
3067 end select
3068 else
3070 end if
3071 end if
3072 end do
3073 end if
3074end if
3075
3076if (present(attr)) then
3077 nattr=size(attr)
3078 if (nattr == 0) then
3079 allocate (starvars%dcv(nattr))
3080 else
3081 nattr=count(c_e(attr))
3082 if (nattr > 0) then
3083 allocate (starvars%dcv(nattr))
3084 do i=1,size(attr)
3086 if (present(attrkind))then
3087 select case (attrkind(i))
3088 case("r")
3090 case("i")
3092 case("b")
3094 case("d")
3096 case("c")
3098 case default
3100 CALL raise_fatal_error()
3101 end select
3102 else
3104 end if
3105 end if
3106 end do
3107 end if
3108 endif
3109end if
3110
3111if (present(anaattr)) then
3112 nanaattr=size(anaattr)
3113 if (nanaattr == 0) then
3114 allocate (anastarvars%dcv(nanaattr))
3115 else
3116 nanaattr=count(c_e(anaattr))
3117 if (nanaattr > 0) then
3118 allocate (anastarvars%dcv(nanaattr))
3119 do i=1,size(anaattr)
3121 if (present(anaattrkind))then
3122 select case (anaattrkind(i))
3123 case("r")
3125 case("i")
3127 case("b")
3129 case("d")
3131 case("c")
3133 case default
3135 CALL raise_fatal_error()
3136 end select
3137 else
3139 end if
3140 end if
3141 end do
3142 end if
3143 end if
3144end if
3145
3146
3147 ! like a cast
3148mydbacoordmin=dbacoord()
3149if (present(coordmin)) mydbacoordmin%geo_coord=coordmin
3150mydbacoordmax=dbacoord()
3151if (present(coordmax)) mydbacoordmax%geo_coord=coordmax
3152mydbaana=dbaana()
3153if (present(ana)) mydbaana%vol7d_ana=ana
3154mydatetimemin=dbadatetime()
3155if (present(timei)) mydatetimemin%datetime=timei
3156mydatetimemax=dbadatetime()
3157if (present(timef)) mydatetimemax%datetime=timef
3158mydbatimerange=dbatimerange()
3159if (present(timerange)) mydbatimerange%vol7d_timerange=timerange
3160mydbalevel=dbalevel()
3161if (present(level)) mydbalevel%vol7d_level=level
3162mydbanetwork=dbanetwork()
3163if (present(network)) mydbanetwork%vol7d_network=network
3164
3165!!
3166!! here we have options ready for filter
3167!!
3168filter=dbafilter(coordmin=mydbacoordmin,coordmax=mydbacoordmax,ana=mydbaana, &
3169 datetimemin=mydatetimemin,datetimemax=mydatetimemax, &
3170 timerange=mydbatimerange,level=mydbalevel,network=mydbanetwork,query=query,&
3171 vars=vars,starvars=starvars,anavars=anavars,anastarvars=anastarvars,&
3172 dataonly=dataonly,anaonly=anaonly)
3173!!$ print *, "filter:"
3174!!$ call filter%display()
3175
3177
3178
3179END SUBROUTINE vol7d_dballe_import_old
3180
3181
3182
3183!>import da DB-all.e
3184subroutine vol7d_dballe_import(this,filter,set_network)
3185
3186TYPE(vol7d_dballe),INTENT(inout) :: this !< oggetto vol7d_dballe
3187type(dbafilter),INTENT(in) :: filter
3188TYPE(vol7d_network),INTENT(in),OPTIONAL :: set_network
3189
3190TYPE(vol7d) :: vol7dtmp
3191type(dbametaanddata),allocatable :: metaanddatav(:)
3192type(dbafilter) :: myfilter
3193
3195
3196if ( .not. filter%dataonly) then
3197 ! ----------------> constant station data
3198 myfilter=dbafilter(filter=filter,contextana=.true.,query=cmiss)
3199! ! set filter
3200! call this%handle%set(filter=myfilter)
3201 ! estrude the data
3202 CALL l4f_category_log(this%category,l4f_debug,'start import vol7d_dballe ingest for constant station data')
3203! call this%handle%ingest(filter=myfilter)
3204 call this%handle%ingest(metaanddatav,filter=myfilter)
3207 call dba2v7d(this%vol7d, metaanddatav,this%time_definition,set_network)
3209
3210 deallocate (metaanddatav)
3211
3212else
3213 ! empty volume
3215 call vol7d_alloc(this%vol7d)
3216 call vol7d_alloc_vol(this%vol7d)
3217end if
3218 ! ----------------> constant station data end
3219
3220if ( .not. filter%anaonly) then
3221 ! ----------------> working on data
3222 myfilter=dbafilter(filter=filter,contextana=.false.)
3223! ! set filter
3224! call this%handle%set(filter=myfilter)
3225 ! estrude the data
3226
3227 CALL l4f_category_log(this%category,l4f_debug,'start import vol7d_dballe ingest for station data')
3228! call this%handle%ingest(filter=myfilter)
3229 call this%handle%ingest(metaanddatav,filter=myfilter)
3232 call dba2v7d(vol7dtmp,metaanddatav,this%time_definition,set_network)
3234
3235 deallocate (metaanddatav)
3236
3238!!$else
3239!!$ ! should we sort separately in case no merge is done?
3240!!$ CALL vol7d_smart_sort(this%vol7d, lsort_time=.TRUE., lsort_timerange=.TRUE., lsort_level=.TRUE.)
3241end if
3242
3243call vol7d_dballe_set_var_du(this%vol7d)
3244
3245
3246#ifdef NONE
3247
3248!!$if (lattr) then
3249!!$
3250!!$ allocate (this%data_id( nana, ntime, nlevel, ntimerange, nnetwork),stat=istat)
3251!!$ if (istat/= 0) THEN
3252!!$ CALL l4f_category_log(this%category,L4F_ERROR,'cannot allocate ' &
3253!!$ //TRIM(to_char(nana*ntime*nlevel*ntimerange*nnetwork))//' data_id elements')
3254!!$ CALL raise_fatal_error()
3255!!$
3256!!$ ENDIF
3257!!$
3258!!$ this%data_id=DBA_MVI
3259!!$
3260!!$else
3261
3262nullify(this%data_id)
3263
3264!!$end if
3265
3266
3267 !memorizzo data_id
3268#ifdef DEBUG
3269 !CALL l4f_category_log(this%category,L4F_DEBUG,"data_id: "//trim(to_char(buffer(i)%data_id)))
3270#endif
3271
3272this%data_id(indana,indtime,indlevel,indtimerange,indnetwork)=buffer(i)%data_id
3273
3274
3275ier=idba_set(this%handle,"*context_id",buffer(i)%data_id)
3276ier=idba_set(this%handle,"*var_related",buffer(i)%btable)
3277 !per ogni dato ora lavoro sugli attributi
3278ier=idba_set(this%handle, "*varlist",starvarlist )
3279ier=idba_voglioancora(this%handle,nn)
3280 !print*,buffer(i)%btable," numero attributi",nn
3281
3282#endif
3283
3285
3286end subroutine vol7d_dballe_import
3287
3288
3289
3290 !>\brief Cancella l'oggetto
3291
3292SUBROUTINE vol7d_dballe_delete(this, preserveidbhandle)
3293TYPE(vol7d_dballe) :: this !< oggetto da cancellare
3294logical,intent(in), optional :: preserveidbhandle !< do not close connection to dsn
3295
3296# ifndef F2003_FULL_FEATURES
3297call this%handle%delete()
3298
3299if (.not. optio_log(preserveidbhandle)) call this%idbhandle%delete()
3300# endif
3301
3302!!$if (associated(this%data_id)) then
3303!!$ deallocate (this%data_id)
3304!!$ nullify(this%data_id)
3305!!$end if
3306
3308
3309 !chiudo il logger
3310call l4f_category_delete(this%category)
3311 !ier=l4f_fini()
3312
3313END SUBROUTINE vol7d_dballe_delete
3314
3315
3316
3317 !>\brief import dba objects in vol7d
3318!subroutine dba2v7d(this,metaanddatav,vars,starvars,anavars,anastarvars,time_definition, set_network)
3319subroutine dba2v7d(this,metaanddatav,time_definition, set_network)
3320
3321type(dbametaanddata),intent(inout) :: metaanddatav(:) ! change value in datetime reguard timedefinition
3322TYPE(vol7d),INTENT(inout) :: this
3323integer,INTENT(in),OPTIONAL :: time_definition !< 0=time is reference time ; 1=time is validity time (default=1)
3324TYPE(vol7d_network),INTENT(in),OPTIONAL :: set_network
3325type(dbadcv) :: vars
3326type(dbadcv) :: starvars
3327type(dbadcv) :: anavars
3328type(dbadcv) :: anastarvars
3329
3330
3331LOGICAL :: ldegnet
3332integer :: indana,indtime,indlevel,indtimerange,inddativar,indnetwork,indattrvar
3333
3334integer :: nana,ntime,ntimerange,nlevel,nnetwork
3335
3336INTEGER :: i, j, k, n
3337integer :: inddativarattr
3338integer :: nanavar, indanavar,indanavarattr,nanavarattr
3339
3340integer :: ndativarr, ndativari, ndativarb, ndativard, ndativarc
3341integer :: ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc
3342integer :: ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc
3343
3344integer :: nanavarr, nanavari, nanavarb, nanavard, nanavarc
3345integer :: nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc
3346integer :: nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
3347
3348integer :: ndativar,ndativarattr
3349
3350type(characterlist) :: dativarl,dativarattrl,anavarl,anavarattrl
3351
3352character(len=listcharmaxlen),allocatable :: dativara(:),dativarattra(:),anavara(:),anavarattra(:)
3353logical :: status
3354integer :: ltime_definition
3355
3356type(datetime),allocatable :: tmptime(:)
3357type(vol7d_network),allocatable :: tmpnetwork(:)
3358type(vol7d_level),allocatable :: tmplevel(:)
3359type(vol7d_timerange),allocatable :: tmptimerange(:)
3360type(vol7d_ana),allocatable :: tmpana(:)
3361
3362
3363ltime_definition=optio_i(time_definition)
3365
3366 ! take in account time_definition
3367if (ltime_definition == 0) then
3368 do i =1,size(metaanddatav)
3369 metaanddatav(i)%metadata%datetime%datetime = &
3370 metaanddatav(i)%metadata%datetime%datetime - &
3371 timedelta_new(sec=metaanddatav(i)%metadata%timerange%vol7d_timerange%p1)
3372 end do
3373end if
3374
3375
3376IF (PRESENT(set_network)) THEN
3378 ldegnet = .true.
3379 else
3380 ldegnet = .false.
3381 end if
3382ELSE
3383 ldegnet = .false.
3384ENDIF
3385
3386
3387
3388!!--------------------------------------------------------------------------
3389!! find vars, starvars, anavars, anastarvars
3390!!
3391
3392! create lists of all
3393 ! data
3394do i =1, size(metaanddatav)
3395 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
3397 !print *,"dativarl: ", metaanddatav(i)%dataattrv%dataattr(j)%dat%btable
3398 call dativarl%append(metaanddatav(i)%dataattrv%dataattr(j)%dat%btable)
3399 else
3400 !print *,"anavarl: ", metaanddatav(i)%dataattrv%dataattr(j)%dat%btable
3401 call anavarl%append(metaanddatav(i)%dataattrv%dataattr(j)%dat%btable)
3402 end if
3403 end do
3404end do
3405
3406!count and put in vector of unuique key
3407ndativar = count_distinct(toarray_charl(dativarl) , back=.true.)
3408allocate(dativara(ndativar))
3409call pack_distinct_c (toarray_charl(dativarl) , dativara , back=.true.)
3410status = dativarl%delete()
3411allocate (vars%dcv(ndativar))
3412
3413nanavar = count_distinct(toarray_charl(anavarl) , back=.true.)
3414allocate(anavara(nanavar))
3415call pack_distinct_c (toarray_charl(anavarl) , anavara , back=.true.)
3416status = anavarl%delete()
3417allocate (anavars%dcv(nanavar))
3418
3419
3420an: do n=1,ndativar
3421 do i =1, size(metaanddatav)
3422 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
3424 if (metaanddatav(i)%dataattrv%dataattr(j)%dat%btable == dativara(n)) then
3425 allocate(vars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%dat)
3426 cycle an
3427 end if
3428 end if
3429 end do
3430 end do
3431end do an
3432
3433bn: do n=1,nanavar
3434 do i =1, size(metaanddatav)
3435 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
3437 if (metaanddatav(i)%dataattrv%dataattr(j)%dat%btable == anavara(n)) then
3438 allocate(anavars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%dat)
3439 cycle bn
3440 end if
3441 end if
3442 end do
3443 end do
3444end do bn
3445
3446 ! attributes
3447do i =1, size(metaanddatav)
3448 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
3449 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
3451 !print *,"dativarattrl: ", metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable
3452 call dativarattrl%append(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable)
3453 else
3454 !print *,"anavarattrl: ", metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable
3455 call anavarattrl%append(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable)
3456 end if
3457 end do
3458 end do
3459end do
3460
3461
3462ndativarattr = count_distinct(toarray_charl(dativarattrl), back=.true.)
3463allocate(dativarattra(ndativarattr))
3464call pack_distinct_c (toarray_charl(dativarattrl), dativarattra, back=.true.)
3465status = dativarattrl%delete()
3466allocate(starvars%dcv(ndativarattr))
3467
3468nanavarattr = count_distinct(toarray_charl(anavarattrl) , back=.true.)
3469allocate(anavarattra(nanavarattr))
3470call pack_distinct_c (toarray_charl(anavarattrl) , anavarattra , back=.true.)
3471status = anavarattrl%delete()
3472allocate(anastarvars%dcv(nanavarattr))
3473
3474
3475cn: do n=1,ndativarattr
3476 do i =1, size(metaanddatav)
3477 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
3478 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
3480 if (metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable == dativarattra(n))then
3481 allocate(starvars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
3482 cycle cn
3483 end if
3484 end if
3485 end do
3486 end do
3487 end do
3488end do cn
3489
3490
3491dn: do n=1,nanavarattr
3492 do i =1, size(metaanddatav)
3493 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
3494 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
3496 if (metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable == anavarattra(n))then
3497 allocate(anastarvars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
3498 cycle dn
3499 end if
3500 end if
3501 end do
3502 end do
3503 end do
3504end do dn
3505
3506
3507!!--------------------------------------------------------------------------
3508
3509
3510!!
3511!! count all unique metadata
3512!!
3513
3514if(ldegnet) then
3515 nnetwork=1
3516else
3517 !nnetwork = count_distinct(metaanddatav(:)%metadata%network%vol7d_network, back=.TRUE.)
3518 allocate (tmpnetwork(size(metaanddatav(:))),&
3519 source=metaanddatav(:)%metadata%network%vol7d_network)
3521 nnetwork = count_distinct_sorted(tmpnetwork)
3522end if
3523
3524!ntime = count_distinct(metaanddatav(:)%metadata%datetime%datetime, &
3525! mask=c_e(metaanddatav(:)%metadata%datetime%datetime),back=.TRUE.)
3526allocate (tmptime(size(metaanddatav(:))),&
3527 source=metaanddatav(:)%metadata%datetime%datetime)
3529ntime = count_distinct_sorted(tmptime,mask=c_e(tmptime))
3530
3531!ntimerange = count_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange, &
3532! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
3533allocate (tmptimerange(size(metaanddatav(:))),&
3534 source=metaanddatav(:)%metadata%timerange%vol7d_timerange)
3536ntimerange = count_distinct_sorted(tmptimerange,mask=c_e(tmptimerange))
3537
3538!nlevel = count_distinct(metaanddatav(:)%metadata%level%vol7d_level, &
3539! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level),back=.TRUE.)
3540allocate (tmplevel(size(metaanddatav(:))),&
3541 source=metaanddatav(:)%metadata%level%vol7d_level)
3543nlevel = count_distinct_sorted(tmplevel,mask=c_e(tmplevel))
3544
3545!nana = count_distinct(metaanddatav(:)%metadata%ana%vol7d_ana, back=.TRUE.)
3546allocate (tmpana(size(metaanddatav(:))),&
3547 source=metaanddatav(:)%metadata%ana%vol7d_ana)
3549nana = count_distinct_sorted(tmpana)
3550
3551!!$if(ldegnet) then
3552!!$ nnetwork=1
3553!!$else
3554!!$ nnetwork = size(metaanddatav(:)%metadata%network%vol7d_network)
3555!!$end if
3556!!$ntime = size(metaanddatav(:)%metadata%datetime%datetime)
3557!!$ntimerange = size(metaanddatav(:)%metadata%timerange%vol7d_timerange)
3558!!$nlevel = size(metaanddatav(:)%metadata%level%vol7d_level)
3559!!$nana = size(metaanddatav(:)%metadata%ana%vol7d_ana)
3560
3561 ! var
3562
3563ndativarr = 0
3564ndativari = 0
3565ndativarb = 0
3566ndativard = 0
3567ndativarc = 0
3568
3569do i =1 ,size(vars%dcv)
3570 associate(dato => vars%dcv(i)%dat)
3571 select type (dato)
3573 ndativarr = ndativarr + 1
3575 ndativari = ndativari + 1
3577 ndativarb = ndativarb + 1
3579 ndativard = ndativard + 1
3581 ndativarc = ndativarc + 1
3582 end select
3583 end associate
3584end do
3585
3586
3587 !attr
3588
3589ndatiattrr = 0
3590ndatiattri = 0
3591ndatiattrb = 0
3592ndatiattrd = 0
3593ndatiattrc = 0
3594
3595do i =1 ,size(starvars%dcv)
3596 associate(dato => starvars%dcv(i)%dat)
3597 select type (dato)
3599 ndatiattrr = ndatiattrr + 1
3601 ndatiattri = ndatiattri + 1
3603 ndatiattrb = ndatiattrb + 1
3605 ndatiattrd = ndatiattrd + 1
3607 ndatiattrc = ndatiattrc + 1
3608 end select
3609 end associate
3610end do
3611
3612
3613 ! ana var
3614
3615nanavarr = 0
3616nanavari = 0
3617nanavarb = 0
3618nanavard = 0
3619nanavarc = 0
3620
3621do i =1 ,size(anavars%dcv)
3622 associate(dato => anavars%dcv(i)%dat)
3623 select type (dato)
3624 type is (dbadatar)
3625 nanavarr = nanavarr + 1
3626 type is (dbadatai)
3627 nanavari = nanavari + 1
3628 type is (dbadatab)
3629 nanavarb = nanavarb + 1
3630 type is (dbadatad)
3631 nanavard = nanavard + 1
3632 type is (dbadatac)
3633 nanavarc = nanavarc + 1
3634 end select
3635 end associate
3636end do
3637
3638
3639 ! ana attr
3640
3641nanaattrr = 0
3642nanaattri = 0
3643nanaattrb = 0
3644nanaattrd = 0
3645nanaattrc = 0
3646
3647do i =1 ,size(anastarvars%dcv)
3648 associate(dato => anastarvars%dcv(i)%dat)
3649 select type (dato)
3650 type is (dbadatar)
3651 nanaattrr = nanaattrr + 1
3652 type is (dbadatai)
3653 nanaattri = nanaattri + 1
3654 type is (dbadatab)
3655 nanaattrb = nanaattrb + 1
3656 type is (dbadatad)
3657 nanaattrd = nanaattrd + 1
3658 type is (dbadatac)
3659 nanaattrc = nanaattrc + 1
3660 end select
3661 end associate
3662end do
3663
3664
3665 !refine
3666
3667ndativarattrr=0
3668ndativarattri=0
3669ndativarattrb=0
3670ndativarattrd=0
3671ndativarattrc=0
3672
3673if (ndatiattrr > 0 ) ndativarattrr=ndativarr+ndativari+ndativarb+ndativard+ndativarc
3674if (ndatiattri > 0 ) ndativarattri=ndativarr+ndativari+ndativarb+ndativard+ndativarc
3675if (ndatiattrb > 0 ) ndativarattrb=ndativarr+ndativari+ndativarb+ndativard+ndativarc
3676if (ndatiattrd > 0 ) ndativarattrd=ndativarr+ndativari+ndativarb+ndativard+ndativarc
3677if (ndatiattrc > 0 ) ndativarattrc=ndativarr+ndativari+ndativarb+ndativard+ndativarc
3678
3679
3680nanavarattrr=0
3681nanavarattri=0
3682nanavarattrb=0
3683nanavarattrd=0
3684nanavarattrc=0
3685
3686if (nanaattrr > 0 ) nanavarattrr=nanavarr+nanavari+nanavarb+nanavard+nanavarc
3687if (nanaattri > 0 ) nanavarattri=nanavarr+nanavari+nanavarb+nanavard+nanavarc
3688if (nanaattrb > 0 ) nanavarattrb=nanavarr+nanavari+nanavarb+nanavard+nanavarc
3689if (nanaattrd > 0 ) nanavarattrd=nanavarr+nanavari+nanavarb+nanavard+nanavarc
3690if (nanaattrc > 0 ) nanavarattrc=nanavarr+nanavari+nanavarb+nanavard+nanavarc
3691
3692
3694
3695!!$print *, "nana=",nana, "ntime=",ntime, "ntimerange=",ntimerange, &
3696!!$ "nlevel=",nlevel, "nnetwork=",nnetwork, &
3697!!$ "ndativarr=",ndativarr, "ndativari=",ndativari, &
3698!!$ "ndativarb=",ndativarb, "ndativard=",ndativard, "ndativarc=",ndativarc,&
3699!!$ "ndatiattrr=",ndatiattrr, "ndatiattri=",ndatiattri, "ndatiattrb=",ndatiattrb,&
3700!!$ "ndatiattrd=",ndatiattrd, "ndatiattrc=",ndatiattrc,&
3701!!$ "ndativarattrr=",ndativarattrr, "ndativarattri=",ndativarattri, "ndativarattrb=",ndativarattrb,&
3702!!$ "ndativarattrd=",ndativarattrd, "ndativarattrc=",ndativarattrc
3703!!$
3704!!$print *,"nanaattrr,nanaattri,nanaattrb,nanaattrd,nanaattrc"
3705!!$print *,nanaattrr,nanaattri,nanaattrb,nanaattrd,nanaattrc
3706
3707
3708call vol7d_alloc (this, &
3709nana=nana, ntime=ntime, ntimerange=ntimerange, &
3710nlevel=nlevel, nnetwork=nnetwork, &
3711ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb, ndativard=ndativard, ndativarc=ndativarc,&
3712ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb, ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
3713ndativarattrr=ndativarattrr, &
3714ndativarattri=ndativarattri, &
3715ndativarattrb=ndativarattrb, &
3716ndativarattrd=ndativarattrd, &
3717ndativarattrc=ndativarattrc,&
3718nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, nanavard=nanavard, nanavarc=nanavarc,&
3719nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb, nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
3720nanavarattrr=nanavarattrr, &
3721nanavarattri=nanavarattri, &
3722nanavarattrb=nanavarattrb, &
3723nanavarattrd=nanavarattrd, &
3724nanavarattrc=nanavarattrc)
3725
3726
3727! fill metadata removing contextana metadata
3728
3729!nana=count_and_pack_distinct(metaanddatav(:)%metadata%ana%vol7d_ana,this%ana, back=.TRUE.)
3730!this%ana=pack_distinct(metaanddatav(:)%metadata%ana%vol7d_ana, nana, back=.TRUE.)
3731this%ana=pack_distinct_sorted(tmpana, nana)
3732deallocate(tmpana)
3733!call sort(this%ana)
3734
3735!ntime=count_and_pack_distinct(metaanddatav(:)%metadata%datetime%datetime,this%time, &
3736! mask=c_e(metaanddatav(:)%metadata%datetime%datetime), back=.TRUE.)
3737!this%time=pack_distinct(metaanddatav(:)%metadata%datetime%datetime, ntime, &
3738! mask=c_e(metaanddatav(:)%metadata%datetime%datetime),back=.TRUE.)
3739this%time=pack_distinct_sorted(tmptime, ntime,mask=c_e(tmptime))
3740deallocate(tmptime)
3741!call sort(this%time)
3742
3743!ntimerange=count_and_pack_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange,this%timerange, &
3744! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
3745!this%timerange=pack_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange, ntimerange, &
3746! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
3747this%timerange=pack_distinct_sorted(tmptimerange, ntimerange,mask=c_e(tmptimerange))
3748deallocate(tmptimerange)
3749!call sort(this%timerange)
3750
3751!nlevel=count_and_pack_distinct(metaanddatav(:)%metadata%level%vol7d_level,this%level, &
3752! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level), back=.TRUE.)
3753!this%level=pack_distinct(metaanddatav(:)%metadata%level%vol7d_level, nlevel, &
3754! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level), back=.TRUE.)
3755this%level=pack_distinct_sorted(tmplevel, nlevel,mask=c_e(tmplevel))
3756deallocate(tmplevel)
3757!call sort(this%level)
3758
3759if(ldegnet)then
3760 nnetwork=1
3761 ALLOCATE(this%network(1))
3762 this%network(1)=set_network
3763else
3764 !nnetwork=count_and_pack_distinct(metaanddatav(:)%metadata%network%vol7d_network,this%network, back=.TRUE.)
3765 !this%network=pack_distinct(metaanddatav(:)%metadata%network%vol7d_network, nnetwork, back=.TRUE.)
3766 this%network=pack_distinct_sorted(tmpnetwork, nnetwork)
3767 deallocate(tmpnetwork)
3768end if
3769!call sort(this%network)
3770
3771 ! var
3772
3773ndativarr = 0
3774ndativari = 0
3775ndativarb = 0
3776ndativard = 0
3777ndativarc = 0
3778
3779do i =1 ,size(vars%dcv)
3780 associate(dato => vars%dcv(i)%dat)
3781 select type (dato)
3782 type is (dbadatar)
3783 ndativarr = ndativarr + 1
3785 type is (dbadatai)
3786 ndativari = ndativari + 1
3788 type is (dbadatab)
3789 ndativarb = ndativarb + 1
3791 type is (dbadatad)
3792 ndativard = ndativard + 1
3794 type is (dbadatac)
3795 ndativarc = ndativarc + 1
3797 end select
3798 end associate
3799end do
3800
3801
3802 !attr
3803
3804ndatiattrr = 0
3805ndatiattri = 0
3806ndatiattrb = 0
3807ndatiattrd = 0
3808ndatiattrc = 0
3809
3810do i =1 ,size(starvars%dcv)
3811 associate(dato => starvars%dcv(i)%dat)
3812 select type (dato)
3813 type is (dbadatar)
3814 ndatiattrr = ndatiattrr + 1
3816 type is (dbadatai)
3817 ndatiattri = ndatiattri + 1
3819 type is (dbadatab)
3820 ndatiattrb = ndatiattrb + 1
3822 type is (dbadatad)
3823 ndatiattrd = ndatiattrd + 1
3825 type is (dbadatac)
3826 ndatiattrc = ndatiattrc + 1
3828 end select
3829 end associate
3830end do
3831
3832
3833 ! ana var
3834
3835nanavarr = 0
3836nanavari = 0
3837nanavarb = 0
3838nanavard = 0
3839nanavarc = 0
3840
3841do i =1 ,size(anavars%dcv)
3842 associate(dato => anavars%dcv(i)%dat)
3843 select type (dato)
3844 type is (dbadatar)
3845 nanavarr = nanavarr + 1
3847 type is (dbadatai)
3848 nanavari = nanavari + 1
3850 type is (dbadatab)
3851 nanavarb = nanavarb + 1
3853 type is (dbadatad)
3854 nanavard = nanavard + 1
3856 type is (dbadatac)
3857 nanavarc = nanavarc + 1
3859 end select
3860 end associate
3861end do
3862
3863
3864 ! ana attr
3865
3866nanaattrr = 0
3867nanaattri = 0
3868nanaattrb = 0
3869nanaattrd = 0
3870nanaattrc = 0
3871
3872do i =1 ,size(anastarvars%dcv)
3873 associate(dato => anastarvars%dcv(i)%dat)
3874 select type (dato)
3875 type is (dbadatar)
3876 nanaattrr = nanaattrr + 1
3878 type is (dbadatai)
3879 nanaattri = nanaattri + 1
3881 type is (dbadatab)
3882 nanaattrb = nanaattrb + 1
3884 type is (dbadatad)
3885 nanaattrd = nanaattrd + 1
3887 type is (dbadatac)
3888 nanaattrc = nanaattrc + 1
3890 end select
3891 end associate
3892end do
3893
3894
3895 ! here we colcolate the link from attributes and vars
3896do i =1, size(vars%dcv)
3897 associate(dato => vars%dcv(i)%dat)
3903 end associate
3904end do
3905
3906do i =1, size(anavars%dcv)
3907 associate(dato => anavars%dcv(i)%dat)
3913 end associate
3914end do
3915
3916 ! set index in dativaratt*
3917call vol7d_set_attr_ind(this)
3918
3919call vol7d_alloc_vol (this)
3920
3921 ! Ora qui bisogna metterci dentro idati
3922indana = 0
3923indtime = 0
3924indnetwork = 0
3925indtime = 0
3926indtimerange = 0
3927indlevel = 0
3928do i =1, size(metaanddatav)
3929
3930 indana = index_sorted(this%ana, metaanddatav(i)%metadata%ana%vol7d_ana)
3931
3932 if (ldegnet)then
3933 indnetwork=1
3934 else
3935 indnetwork = index_sorted(this%network, metaanddatav(i)%metadata%network%vol7d_network)
3936 endif
3937
3938 if (c_e(metaanddatav(i)%metadata%datetime%datetime) .and. &
3939 c_e(metaanddatav(i)%metadata%timerange%vol7d_timerange) .and. &
3940 c_e(metaanddatav(i)%metadata%level%vol7d_level) ) then ! dati
3941
3942 indtime = index_sorted(this%time, metaanddatav(i)%metadata%datetime%datetime)
3943 indtimerange = index_sorted(this%timerange, metaanddatav(i)%metadata%timerange%vol7d_timerange)
3944 indlevel = index_sorted(this%level, metaanddatav(i)%metadata%level%vol7d_level)
3945
3946 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
3947
3948 associate(dato => metaanddatav(i)%dataattrv%dataattr(j)%dat)
3949 select type (dato)
3950 type is (dbadatai)
3951 inddativar = firsttrue(dato%btable == this%dativar%i%btable)
3952 this%voldatii( &
3953 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
3954 ) = dato%value
3955
3956 type is (dbadatar)
3957 inddativar = firsttrue(dato%btable == this%dativar%r%btable)
3958 this%voldatir( &
3959 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
3960 ) = dato%value
3961
3962 type is (dbadatad)
3963 inddativar = firsttrue(dato%btable == this%dativar%d%btable)
3964 this%voldatid( &
3965 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
3966 ) = dato%value
3967
3968 type is (dbadatab)
3969 inddativar = firsttrue(dato%btable == this%dativar%b%btable)
3970 this%voldatib( &
3971 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
3972 ) = dato%value
3973
3974 type is (dbadatac)
3975 inddativar = firsttrue(dato%btable == this%dativar%c%btable)
3976 this%voldatic( &
3977 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
3978 ) = dato%value
3979
3980 end select
3981
3982
3983 ! dati attributes
3984 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
3985 associate(attr => metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
3986 select type (attr)
3987
3988 type is (dbadatai)
3989 inddativarattr = firsttrue(dato%btable == this%dativarattr%i%btable)
3990 indattrvar = firsttrue(attr%btable == this%datiattr%i%btable)
3991 this%voldatiattri( &
3992 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
3993 ) = attr%value
3994 type is (dbadatar)
3995 inddativarattr = firsttrue(dato%btable == this%dativarattr%r%btable)
3996 indattrvar = firsttrue(attr%btable == this%datiattr%r%btable)
3997 this%voldatiattrr( &
3998 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
3999 ) = attr%value
4000 type is (dbadatad)
4001 inddativarattr = firsttrue(dato%btable == this%dativarattr%d%btable)
4002 indattrvar = firsttrue(attr%btable == this%datiattr%d%btable)
4003 this%voldatiattrd( &
4004 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
4005 ) = attr%value
4006 type is (dbadatab)
4007 inddativarattr = firsttrue(dato%btable == this%dativarattr%b%btable)
4008 indattrvar = firsttrue(attr%btable == this%datiattr%b%btable)
4009 this%voldatiattrb( &
4010 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
4011 ) = attr%value
4012 type is (dbadatac)
4013 inddativarattr = firsttrue(dato%btable == this%dativarattr%c%btable)
4014 indattrvar = firsttrue(attr%btable == this%datiattr%c%btable)
4015 this%voldatiattrc( &
4016 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
4017 ) = attr%value
4018
4019 end select
4020 end associate
4021 end do
4022 end associate
4023 end do
4024
4025 else
4026 ! ana
4027 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
4028
4029 associate(dato => metaanddatav(i)%dataattrv%dataattr(j)%dat)
4030 select type (dato)
4031 type is (dbadatai)
4032 indanavar = firsttrue(dato%btable == this%anavar%i%btable)
4033 this%volanai( &
4034 indana,indanavar,indnetwork &
4035 ) = dato%value
4036
4037 type is (dbadatar)
4038 indanavar = firsttrue(dato%btable == this%anavar%r%btable)
4039 this%volanar( &
4040 indana,indanavar,indnetwork &
4041 ) = dato%value
4042
4043 type is (dbadatad)
4044 indanavar = firsttrue(dato%btable == this%anavar%d%btable)
4045 this%volanad( &
4046 indana,indanavar,indnetwork &
4047 ) = dato%value
4048
4049 type is (dbadatab)
4050 indanavar = firsttrue(dato%btable == this%anavar%b%btable)
4051 this%volanab( &
4052 indana,indanavar,indnetwork &
4053 ) = dato%value
4054
4055 type is (dbadatac)
4056 indanavar = firsttrue(dato%btable == this%anavar%c%btable)
4057 this%volanac( &
4058 indana,indanavar,indnetwork &
4059 ) = dato%value
4060
4061 end select
4062
4063
4064 ! ana attributes
4065 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
4066 associate(attr => metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
4067 select type (attr)
4068
4069 type is (dbadatai)
4070 indanavarattr = firsttrue(dato%btable == this%anavarattr%i%btable)
4071 indattrvar = firsttrue(attr%btable == this%anaattr%i%btable)
4072 this%volanaattri( &
4073 indana,indanavarattr,indnetwork,indattrvar &
4074 ) = attr%value
4075 type is (dbadatar)
4076 indanavarattr = firsttrue(dato%btable == this%anavarattr%r%btable)
4077 indattrvar = firsttrue(attr%btable == this%anaattr%r%btable)
4078 this%volanaattrr( &
4079 indana,indanavarattr,indnetwork,indattrvar &
4080 ) = attr%value
4081 type is (dbadatad)
4082 indanavarattr = firsttrue(dato%btable == this%anavarattr%d%btable)
4083 indattrvar = firsttrue(attr%btable == this%anaattr%d%btable)
4084 this%volanaattrd( &
4085 indana,indanavarattr,indnetwork,indattrvar &
4086 ) = attr%value
4087 type is (dbadatab)
4088 indanavarattr = firsttrue(dato%btable == this%anavarattr%b%btable)
4089 indattrvar = firsttrue(attr%btable == this%anaattr%b%btable)
4090 this%volanaattrb( &
4091 indana,indanavarattr,indnetwork,indattrvar &
4092 ) = attr%value
4093 type is (dbadatac)
4094 indanavarattr = firsttrue(dato%btable == this%anavarattr%c%btable)
4095 indattrvar = firsttrue(attr%btable == this%anaattr%c%btable)
4096 this%volanaattrc( &
4097 indana,indanavarattr,indnetwork,indattrvar &
4098 ) = attr%value
4099
4100 end select
4101 end associate
4102 end do
4103 end associate
4104 end do
4105 end if
4106end do
4107
4108contains
4109
4110!!$!> /brief Return an dbadcv from a mixlist with dbadata* type
4111!!$function todcv_dbadat(this)
4112!!$type(dbadcv) :: todcv_dbadat !< array
4113!!$type(mixlist) :: this
4114!!$
4115!!$integer :: i
4116!!$
4117!!$allocate (todcv_dbadat%dcv(this%countelements()))
4118!!$
4119!!$call this%rewind()
4120!!$i=0
4121!!$do while(this%element())
4122!!$ i=i+1
4123!!$
4124!!$ associate (dato => this%current())
4125!!$ select type (dato)
4126!!$ type is (dbadatar)
4127!!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
4128!!$ type is (dbadatai)
4129!!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
4130!!$ type is (dbadatab)
4131!!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
4132!!$ type is (dbadatad)
4133!!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
4134!!$ type is (dbadatac)
4135!!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
4136!!$ end select
4137!!$ end associate
4138!!$
4139!!$ call this%next()
4140!!$end do
4141!!$end function todcv_dbadat
4142
4143!!$! Definisce le funzioni count_distinct e pack_distinct
4144!!$#define VOL7D_POLY_TYPE TYPE(dbadata)
4145!!$#define VOL7D_POLY_TYPES _dbadata
4146!!$#undef ENABLE_SORT
4147!!$#include "array_utilities_inc.F90"
4148!!$#undef VOL7D_POLY_TYPE
4149!!$#undef VOL7D_POLY_TYPES
4150
4151
4152end subroutine dba2v7d
4153
4154
4155subroutine vol7d_dballe_import_dballevar(this)
4156
4157type(vol7d_var),pointer :: this(:)
4158INTEGER :: i,un,n
4159
4160IF (associated(this)) return
4161IF (allocated(blocal)) then
4162 ALLOCATE(this(size(blocal)))
4163 this=blocal
4164 return
4165end if
4166
4167un = open_dballe_file('dballe.txt', filetype_data)
4168IF (un < 0) then
4169
4170 call l4f_log(l4f_error,"error open_dballe_file: dballe.txt")
4171 CALL raise_error("error open_dballe_file: dballe.txt")
4172 return
4173end if
4174
4175n = 0
4176DO WHILE(.true.)
4177 READ(un,*,END=100)
4178 n = n + 1
4179ENDDO
4180100 CONTINUE
4181
4182IF (n > 0) THEN
4183 ALLOCATE(this(n))
4184 ALLOCATE(blocal(n))
4185 rewind(un)
4186 readline: do i = 1 ,n
4187 READ(un,'(1x,A6,1x,a65,a24,i4)')blocal(i)%btable,blocal(i)%description,blocal(i)%unit,&
4188 blocal(i)%scalefactor
4189 blocal(i)%btable(:1)="B"
4190 !print*,"B=",blocal(i)%btable
4191 !print*," D=",blocal(i)%description
4192 !PRINT*," U=",blocal(i)%unit
4193 !PRINT*," D=",blocal(i)%scalefactor
4194 ENDDO readline
4195
4196 CALL l4f_log(l4f_info,'Found '//trim(to_char(i-1))//' variables in dballe master table')
4197
4198 this=blocal
4199
4200ENDIF
4201CLOSE(un)
4202
4203END SUBROUTINE vol7d_dballe_import_dballevar
4204
4205
4206
4207!> \brief Integra il vettore delle variabili in vol7d con le descrizioni e le unità di misura
4208!!eventualmente mancanti.
4209
4210subroutine vol7d_dballe_set_var_du(this)
4211
4212TYPE(vol7d) :: this !< oggetto vol7d con le variabili da completare
4213integer :: i,j
4214type(vol7d_var),pointer :: dballevar(:)
4215
4216nullify(dballevar)
4217call vol7d_dballe_import_dballevar(dballevar)
4218
4219#undef VOL7D_POLY_NAME
4220#define VOL7D_POLY_NAME dativar
4221
4222
4223#undef VOL7D_POLY_TYPES_V
4224#define VOL7D_POLY_TYPES_V r
4225#include "vol7d_dballe_class_var_du.F90"
4226#undef VOL7D_POLY_TYPES_V
4227#define VOL7D_POLY_TYPES_V i
4228#include "vol7d_dballe_class_var_du.F90"
4229#undef VOL7D_POLY_TYPES_V
4230#define VOL7D_POLY_TYPES_V b
4231#include "vol7d_dballe_class_var_du.F90"
4232#undef VOL7D_POLY_TYPES_V
4233#define VOL7D_POLY_TYPES_V d
4234#include "vol7d_dballe_class_var_du.F90"
4235#undef VOL7D_POLY_TYPES_V
4236#define VOL7D_POLY_TYPES_V c
4237#include "vol7d_dballe_class_var_du.F90"
4238#undef VOL7D_POLY_TYPES_V
4239
4240#undef VOL7D_POLY_NAME
4241#define VOL7D_POLY_NAME anavar
4242
4243
4244#undef VOL7D_POLY_TYPES_V
4245#define VOL7D_POLY_TYPES_V r
4246#include "vol7d_dballe_class_var_du.F90"
4247#undef VOL7D_POLY_TYPES_V
4248#define VOL7D_POLY_TYPES_V i
4249#include "vol7d_dballe_class_var_du.F90"
4250#undef VOL7D_POLY_TYPES_V
4251#define VOL7D_POLY_TYPES_V b
4252#include "vol7d_dballe_class_var_du.F90"
4253#undef VOL7D_POLY_TYPES_V
4254#define VOL7D_POLY_TYPES_V d
4255#include "vol7d_dballe_class_var_du.F90"
4256#undef VOL7D_POLY_TYPES_V
4257#define VOL7D_POLY_TYPES_V c
4258#include "vol7d_dballe_class_var_du.F90"
4259#undef VOL7D_POLY_TYPES_V
4260
4261
4262#undef VOL7D_POLY_NAME
4263#define VOL7D_POLY_NAME datiattr
4264
4265
4266#undef VOL7D_POLY_TYPES_V
4267#define VOL7D_POLY_TYPES_V r
4268#include "vol7d_dballe_class_var_du.F90"
4269#undef VOL7D_POLY_TYPES_V
4270#define VOL7D_POLY_TYPES_V i
4271#include "vol7d_dballe_class_var_du.F90"
4272#undef VOL7D_POLY_TYPES_V
4273#define VOL7D_POLY_TYPES_V b
4274#include "vol7d_dballe_class_var_du.F90"
4275#undef VOL7D_POLY_TYPES_V
4276#define VOL7D_POLY_TYPES_V d
4277#include "vol7d_dballe_class_var_du.F90"
4278#undef VOL7D_POLY_TYPES_V
4279#define VOL7D_POLY_TYPES_V c
4280#include "vol7d_dballe_class_var_du.F90"
4281#undef VOL7D_POLY_TYPES_V
4282
4283
4284#undef VOL7D_POLY_NAME
4285#define VOL7D_POLY_NAME anaattr
4286
4287
4288#undef VOL7D_POLY_TYPES_V
4289#define VOL7D_POLY_TYPES_V r
4290#include "vol7d_dballe_class_var_du.F90"
4291#undef VOL7D_POLY_TYPES_V
4292#define VOL7D_POLY_TYPES_V i
4293#include "vol7d_dballe_class_var_du.F90"
4294#undef VOL7D_POLY_TYPES_V
4295#define VOL7D_POLY_TYPES_V b
4296#include "vol7d_dballe_class_var_du.F90"
4297#undef VOL7D_POLY_TYPES_V
4298#define VOL7D_POLY_TYPES_V d
4299#include "vol7d_dballe_class_var_du.F90"
4300#undef VOL7D_POLY_TYPES_V
4301#define VOL7D_POLY_TYPES_V c
4302#include "vol7d_dballe_class_var_du.F90"
4303#undef VOL7D_POLY_TYPES_V
4304
4305
4306deallocate(dballevar)
4307
4308return
4309
4310end subroutine vol7d_dballe_set_var_du
4311
4312
4313
4314FUNCTION get_dballe_filepath(filename, filetype) RESULT(path)
4315CHARACTER(len=*), INTENT(in) :: filename
4316INTEGER, INTENT(in) :: filetype
4317
4318INTEGER :: j
4319CHARACTER(len=512) :: path
4320LOGICAL :: exist
4321
4322IF (dballe_name == ' ') THEN
4323 CALL getarg(0, dballe_name)
4324 ! dballe_name_env
4325ENDIF
4326
4327IF (filetype < 1 .OR. filetype > nftype) THEN
4328 path = ""
4329 CALL l4f_log(l4f_error, 'dballe file type '//trim(to_char(filetype))// &
4330 ' not valid')
4331 CALL raise_error()
4332 RETURN
4333ENDIF
4334
4335! try with environment variable
4336CALL getenv(trim(dballe_name_env), path)
4337IF (path /= ' ') THEN
4338
4339 path=trim(path)//'/'//filename
4340 INQUIRE(file=path, exist=exist)
4341 IF (exist) THEN
4342 CALL l4f_log(l4f_info, 'dballe file '//trim(path)//' found')
4343 RETURN
4344 ENDIF
4345ENDIF
4346! try with pathlist
4347DO j = 1, SIZE(pathlist,1)
4348 IF (pathlist(j,filetype) == ' ') EXIT
4349 path=trim(pathlist(j,filetype))//'/'//trim(dballe_name)//'/'//filename
4350 INQUIRE(file=path, exist=exist)
4351 IF (exist) THEN
4352 CALL l4f_log(l4f_info, 'dballe file '//trim(path)//' found')
4353 RETURN
4354 ENDIF
4355ENDDO
4356CALL l4f_log(l4f_error, 'dballe file '//trim(filename)//' not found')
4357CALL raise_error()
4358path = ""
4359
4360END FUNCTION get_dballe_filepath
4361
4362
4363FUNCTION open_dballe_file(filename, filetype) RESULT(unit)
4364CHARACTER(len=*), INTENT(in) :: filename
4365INTEGER, INTENT(in) :: filetype
4366INTEGER :: unit,i
4367
4368CHARACTER(len=512) :: path
4369
4370unit = -1
4371path=get_dballe_filepath(filename, filetype)
4372IF (path == '') RETURN
4373
4374unit = getunit()
4375IF (unit == -1) RETURN
4376
4377OPEN(unit, file=path, status='old', iostat = i)
4378IF (i == 0) THEN
4379 CALL l4f_log(l4f_info, 'dballe file '//trim(path)//' opened')
4380 RETURN
4381ENDIF
4382
4383CALL l4f_log(l4f_error, 'dballe file '//trim(filename)//' not found')
4384CALL raise_error()
4385unit = -1
4386
4387END FUNCTION open_dballe_file
4388
4389
4390!> \brief Exporta un volume dati a un DSN DB-all.e
4391!!
4392!! Riscrive i dati nel DSN di DB-All.e con la possibilità di attivare
4393!! una serie di filtri.
4394
4395
4396!!! TODO manage attr_only
4397!!! attention template migrated in init
4398!SUBROUTINE vol7d_dballe_export(this, network, coordmin, coordmax,&
4399! timei, timef,level,timerange,var,attr,anavar,anaattr,attr_only,ana,dataonly)
4400
4401SUBROUTINE vol7d_dballe_export_old(this, network, coordmin, coordmax,&
4402 timei, timef,level,timerange,var,attr,anavar,anaattr,ana,dataonly,anaonly,template,attr_only)
4403
4404TYPE(vol7d_dballe),INTENT(inout) :: this !< oggetto contenente il volume e altre info per l'accesso al DSN
4405character(len=network_name_len),INTENT(in),optional :: network !< network da exportare
4406!> coordinate minime e massime che definiscono il
4407!! rettangolo di estrazione per l'esportazione
4408TYPE(geo_coord),INTENT(in),optional :: coordmin,coordmax
4409!>estremi temporali dei dati da esportare
4410TYPE(datetime),INTENT(in),optional :: timei, timef
4411TYPE(vol7d_level),INTENT(in),optional :: level !< livello selezionato per l'esportazione
4412TYPE(vol7d_timerange),INTENT(in),optional :: timerange !< timerange selezionato per l'esportazione
4413!> variabili da exportare secondo la tabella B locale o alias relative a dati, attributi,
4414!! anagrafica e attributi dell'anagrafica
4415CHARACTER(len=*),INTENT(in),OPTIONAL :: var(:),attr(:),anavar(:),anaattr(:)
4416!!$!> permette di riscrivere su un DSN letto precedentemente, modificando solo gli attributi ai dati,
4417!!$!! ottimizzando enormente le prestazioni: gli attributi riscritti saranno quelli con this%data_id definito
4418!!$!! (solitamente ricopiato dall'oggetto letto)
4419!!$logical,intent(in),optional :: attr_only
4420TYPE(vol7d_ana),INTENT(inout),optional :: ana !< identificativo della stazione da exportare
4421logical, intent(in),optional :: dataonly !< set to .true. to export data only
4422logical, intent(in),optional :: anaonly !< set to .true. to export ana only
4423!> specificando category.subcategory.localcategory oppure un alias ("synop", "metar","temp","generic") forza l'exportazione ad uno specifico template BUFR/CREX"
4424!! the special value "generic-frag is used to generate bufr on file where ana data is reported only once at beginning and data in other bufr after
4425character(len=*),intent(in),optional :: template
4426logical, intent(in),optional :: attr_only !< set to .true. to export attr only (no data)
4427
4428
4429type(dbadcv) :: vars,starvars,anavars,anastarvars
4430type(dbafilter) :: filter
4431type(dbacoord) :: mydbacoordmin, mydbacoordmax
4432type(dbaana) :: mydbaana
4433type(dbadatetime) :: mydatetimemin, mydatetimemax
4434type(dbatimerange) :: mydbatimerange
4435type(dbalevel) :: mydbalevel
4436type(dbanetwork) :: mydbanetwork
4437
4438integer :: i
4439LOGICAL :: lattr, lanaattr
4440integer :: nanaattr,nattr,nanavar,nvar
4441
4442
4443 ! ------------- prepare filter options
4444
4445!!
4446!! translate export option for dballe2003 api
4447!!
4448
4449if (present(var)) then
4450 nvar=count(c_e(var))
4451 if (nvar > 0) then
4452 allocate (vars%dcv(nvar))
4453 do i=1,size(var)
4454 if (c_e(var(i)))then
4455 allocate (vars%dcv(i)%dat,source=dbadatac(var(i))) !char is default
4456 end if
4457 end do
4458 end if
4459end if
4460
4461if (present(anavar)) then
4462 nanavar=count(c_e(anavar))
4463 if (nanavar > 0) then
4464 allocate (anavars%dcv(nanavar))
4465 do i=1,size(anavar)
4466 if (c_e(anavar(i)))then
4467 allocate (anavars%dcv(i)%dat,source=dbadatac(anavar(i))) !char is default
4468 end if
4469 end do
4470 end if
4471end if
4472
4473lattr = .false.
4474if (present(attr)) then
4475 nattr=count(c_e(attr))
4476 if (nattr > 0) then
4477 lattr = .true.
4478 allocate (starvars%dcv(nattr))
4479 do i=1,size(attr)
4480 if (c_e(attr(i)))then
4481 allocate (starvars%dcv(i)%dat,source=dbadatac(attr(i))) !char is default
4482 end if
4483 end do
4484 end if
4485end if
4486
4487lanaattr = .false.
4488if (present(anaattr)) then
4489 nanaattr=count(c_e(anaattr))
4490 if (nanaattr > 0) then
4491 lanaattr = .true.
4492 allocate (anastarvars%dcv(nanaattr))
4493 do i=1,size(anaattr)
4494 if (c_e(anaattr(i)))then
4495 allocate (anastarvars%dcv(i)%dat,source=dbadatac(anaattr(i))) !char is default
4496 end if
4497 end do
4498 end if
4499end if
4500
4501
4502 ! like a cast
4503mydbacoordmin=dbacoord()
4504if (present(coordmin)) mydbacoordmin%geo_coord=coordmin
4505mydbacoordmax=dbacoord()
4506if (present(coordmax)) mydbacoordmax%geo_coord=coordmax
4507mydbaana=dbaana()
4508if (present(ana)) mydbaana%vol7d_ana=ana
4509mydatetimemin=dbadatetime()
4510if (present(timei)) mydatetimemin%datetime=timei
4511mydatetimemax=dbadatetime()
4512if (present(timef)) mydatetimemax%datetime=timef
4513mydbatimerange=dbatimerange()
4514if (present(timerange)) mydbatimerange%vol7d_timerange=timerange
4515mydbalevel=dbalevel()
4516if (present(level)) mydbalevel%vol7d_level=level
4517mydbanetwork=dbanetwork()
4519
4520!!
4521!! here we have options ready for filter
4522!!
4523filter=dbafilter(coordmin=mydbacoordmin,coordmax=mydbacoordmax,ana=mydbaana, &
4524 datetimemin=mydatetimemin,datetimemax=mydatetimemax, &
4525 timerange=mydbatimerange,level=mydbalevel,network=mydbanetwork,&
4526 vars=vars,starvars=starvars,anavars=anavars,anastarvars=anastarvars,&
4527 dataonly=dataonly,anaonly=anaonly)
4528
4529!!$ print *, "filter:"
4530!!$ call filter%display()
4531
4533
4534end SUBROUTINE vol7d_dballe_export_old
4535
4536
4537subroutine vol7d_dballe_export (this, filter, template, attr_only)
4538
4539TYPE(vol7d_dballe),INTENT(inout) :: this !< oggetto contenente il volume e altre info per l'accesso al DSN
4540type(dbafilter),intent(in) :: filter !< filter o use
4541!> specificando category.subcategory.localcategory oppure un alias ("synop", "metar","temp","generic") forza l'exportazione ad uno specifico template BUFR/CREX"
4542!! the special value "generic-frag is used to generate bufr on file where ana data is reported only once at beginning and data in other bufr after
4543character(len=*),intent(in),optional :: template
4544logical, intent(in),optional :: attr_only !< set to .true. to export attr only (no data)
4545
4546character(len=40) :: ltemplate
4547
4548type(dbametaanddatalist) :: metaanddatal
4549logical :: stat
4550
4551metaanddatal=dbametaanddatalist()
4552
4553call v7d2dba(this%vol7d,metaanddatal)
4554!call metaanddatal%display()
4555
4556!clean memdb
4557if (this%file) call this%handle%remove_all()
4558
4559! using filter here can limit memory use for memdb
4560call metaanddatal%extrude(session=this%handle,filter=filter,attronly=attr_only,template=template)
4561
4562if (this%file) then
4563 !!!!! this if we have written in memdb and now we have to write the file
4564
4565 !filter is already in extrude
4566 !this%handle%set(filter=filter)
4567
4568 ! export to file
4569 !! TODO : revert template from init to export !!!!!!!!!!!!!!!!!!!!!
4570 !!call this%handle%messages_write_next(template)
4571
4572 ! note that you can use unsetall hera because the filter was used in extrude
4573 call filter%dbaset(this%handle)
4574
4575 ltemplate=this%handle%template
4576 if (present(template))then
4577 ltemplate=template
4578 end if
4579
4580 call this%handle%messages_write_next(ltemplate)
4581
4582 !clean memdb
4583 call this%handle%remove_all()
4584
4585end if
4586
4587stat = metaanddatal%delete()
4588
4589end subroutine vol7d_dballe_export
4590
4591
4592subroutine v7d2dba(v7d,metaanddatal)
4593TYPE(vol7d),INTENT(in) :: v7d !!!!!! dovrebbe essere intent(in)
4594type(dbametaanddatalist),intent(inout) :: metaanddatal
4595
4596TYPE(vol7d_serialize_dballe) :: serialize
4597
4598serialize = vol7d_serialize_dballe_new()
4599serialize%anaonly=.true.
4600call serialize%vol7d_serialize_setup(v7d)
4601call serialize%vol7d_serialize_export(metaanddatal)
4602
4603serialize = vol7d_serialize_dballe_new()
4604serialize%dataonly=.true.
4605call serialize%vol7d_serialize_setup(v7d)
4606call serialize%vol7d_serialize_export(metaanddatal)
4607
4608end subroutine v7d2dba
4609
4610
4612
4613!>\example esempio_v7ddballe.f90
4614!!/brief Programma esempio semplice per l'uso di vol7d con DB-All.e
4615!!
4616
4617!>\example esempio_v7ddballe_multi.f90
4618!!/brief Programma esempio per l'uso di vol7d con DB-All.e
4619!!
4620!!Vengono estratte più reti
4621
4622!>\example esempio_v7ddballe_import_export.f90
4623!!\brief Esempio di utilizzo della classe vol7d_dballe_class
4624!!
4625!! Vengono estratti i dati e riscritti in un nuovo DSN
Emit log message for a category with specific priority. Definition log4fortran.F90:457 This module defines usefull general purpose function and subroutine. Definition array_utilities.F90:212 Classes for handling georeferenced sparse points in geographical corodinates. Definition geo_coord_class.F90:216 class to use character lists in fortran 2003 WARNING ! Definition list_character.F03:58 Classe per la gestione di un volume completo di dati osservati. Definition vol7d_class.F90:273 classe per import ed export di volumi da e in DB-All.e Definition vol7d_dballe_class.F03:266 Oggetto per import ed export da DB-All.e. Definition vol7d_dballe_class.F03:290 |