libsim Versione 7.2.1

◆ vol7d_dballe_export_old()

subroutine vol7d_dballe_export_old ( type(vol7d_dballe), intent(inout)  this,
character(len=network_name_len), intent(in), optional  network,
type(geo_coord), intent(in), optional  coordmin,
type(geo_coord), intent(in), optional  coordmax,
type(datetime), intent(in), optional  timei,
type(datetime), intent(in), optional  timef,
type(vol7d_level), intent(in), optional  level,
type(vol7d_timerange), intent(in), optional  timerange,
character(len=*), dimension(:), intent(in), optional  var,
character(len=*), dimension(:), intent(in), optional  attr,
character(len=*), dimension(:), intent(in), optional  anavar,
character(len=*), dimension(:), intent(in), optional  anaattr,
type(vol7d_ana), intent(inout), optional  ana,
logical, intent(in), optional  dataonly,
logical, intent(in), optional  anaonly,
character(len=*), intent(in), optional  template,
logical, intent(in), optional  attr_only 
)

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.

Parametri
[in,out]thisoggetto contenente il volume e altre info per l'accesso al DSN
[in]networknetwork da exportare
[in]coordmincoordinate minime e massime che definiscono il rettangolo di estrazione per l'esportazione
[in]coordmaxcoordinate minime e massime che definiscono il rettangolo di estrazione per l'esportazione
[in]timeiestremi temporali dei dati da esportare
[in]timefestremi temporali dei dati da esportare
[in]levellivello selezionato per l'esportazione
[in]timerangetimerange selezionato per l'esportazione
[in]varvariabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica
[in]attrvariabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica
[in]anavarvariabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica
[in]anaattrvariabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica
[in,out]anaidentificativo della stazione da exportare
[in]dataonlyset to .true. to export data only
[in]anaonlyset to .true. to export ana only
[in]templatespecificando category.subcategory.localcategory oppure un alias ("synop", "metar","temp","generic") forza l'exportazione ad uno specifico template BUFR/CREX" 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
[in]attr_onlyset to .true. to export attr only (no data)

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
2714
2715MODULE vol7d_dballe_class
2716
2717USE dballe_class
2719USE vol7d_class
2721use log4fortran
2723!use list_mix
2725use list_linkchar
2726use vol7d_serialize_dballe_class
2727
2728IMPLICIT NONE
2729
2730character (len=255),parameter:: subcategory="vol7d_dballe_class"
2731
2738
2739TYPE vol7d_dballe
2740
2741 TYPE(vol7d) :: vol7d
2742 type(dbaconnection) :: idbhandle
2743 type(dbasession) :: handle
2746 integer ,pointer :: data_id(:,:,:,:,:)
2747 integer :: time_definition
2748 integer :: category = 0
2749 logical :: file
2750
2751END TYPE vol7d_dballe
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
2767INTERFACE init
2768 MODULE PROCEDURE vol7d_dballe_init
2769END INTERFACE init
2770
2772INTERFACE delete
2773 MODULE PROCEDURE vol7d_dballe_delete
2774END INTERFACE delete
2775
2776
2778INTERFACE import
2779 MODULE PROCEDURE vol7d_dballe_importvvnv,vol7d_dballe_import, vol7d_dballe_import_old, dba2v7d
2780END INTERFACE import
2781
2783INTERFACE export
2784 MODULE PROCEDURE vol7d_dballe_export_old,vol7d_dballe_export, v7d2dba
2785END INTERFACE export
2786
2787
2788PRIVATE
2789PUBLIC vol7d_dballe, init, delete, import, export, vol7d_dballe_import_dballevar, vol7d_dballe_set_var_du
2790
2791CONTAINS
2792
2793
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
2800character(len=*), INTENT(in),OPTIONAL :: dsn
2801character(len=*), INTENT(in),OPTIONAL :: user
2802character(len=*), INTENT(in),OPTIONAL :: password
2803logical,INTENT(in),OPTIONAL :: write
2804logical,INTENT(in),OPTIONAL :: wipe
2805character(len=*), INTENT(in),OPTIONAL :: repinfo
2806character(len=*),intent(inout),optional :: filename
2807character(len=*),intent(in),optional :: format
2808logical,INTENT(in),OPTIONAL :: file
2809character(len=*),INTENT(in),OPTIONAL :: categoryappend
2810integer,INTENT(in),OPTIONAL :: time_definition
2811integer,INTENT(in),OPTIONAL :: idbhandle
2814character(len=*),intent(in),optional :: template
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
2833CALL l4f_category_log(this%category,l4f_debug,'vol7d_dballe_init start')
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)
2850 if (index(arg,'/',back=.true.) > 0) lfilename=lfilename(index(arg,'/',back=.true.)+1 : )
2851
2852 if (present(filename))then
2853 if (c_e(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
2881CALL init(this%vol7d, time_definition)
2882this%time_definition = optio_i(time_definition)
2883
2884#ifdef DEBUG
2885CALL l4f_category_log(this%category,l4f_debug,'vol7d_dballe_init end')
2886#endif
2887
2888END SUBROUTINE vol7d_dballe_init
2889
2890
2891
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
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
2916 CALL import(this, var, coordmin=coordmin, coordmax=coordmax, timei=timei, &
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
2922 CALL init(this%vol7d)
2923 v7ddbatmp = this ! shallow copy
2924 DO i = 1, SIZE(network)
2925 CALL import(v7ddbatmp, var, network(i), coordmin, coordmax, timei, timef, &
2926 level,timerange, set_network, attr,anavar,anaattr, varkind, attrkind, &
2927 anavarkind, anaattrkind, anaonly, dataonly, ana)
2928 CALL vol7d_merge(this%vol7d, v7ddbatmp%vol7d, sort=.true.)
2929 ENDDO
2930ENDIF
2931
2932END SUBROUTINE vol7d_dballe_importvvnv
2933
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
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
2979CALL l4f_category_log(this%category,l4f_debug,'inizio')
2980#endif
2981
2982
2983IF (PRESENT(set_network)) THEN
2984 if (c_e(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)
3021 if (c_e(var(i)))then
3022 if (present(varkind))then
3023 select case (varkind(i))
3024 case("r")
3025 allocate (vars%dcv(i)%dat,source=dbadatar(var(i)))
3026 case("i")
3027 allocate (vars%dcv(i)%dat,source=dbadatai(var(i)))
3028 case("b")
3029 allocate (vars%dcv(i)%dat,source=dbadatab(var(i)))
3030 case("d")
3031 allocate (vars%dcv(i)%dat,source=dbadatad(var(i)))
3032 case("c")
3033 allocate (vars%dcv(i)%dat,source=dbadatac(var(i)))
3034 case default
3035 call l4f_category_log(this%category,l4f_error,"var and varkind mismach")
3036 CALL raise_fatal_error()
3037 end select
3038 else
3039 allocate (vars%dcv(i)%dat,source=dbadatac(var(i))) !char is default
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)
3051 if (c_e(anavar(i)))then
3052 if (present(anavarkind))then
3053 select case (anavarkind(i))
3054 case("r")
3055 allocate (anavars%dcv(i)%dat,source=dbadatar(anavar(i)))
3056 case("i")
3057 allocate (anavars%dcv(i)%dat,source=dbadatai(anavar(i)))
3058 case("b")
3059 allocate (anavars%dcv(i)%dat,source=dbadatab(anavar(i)))
3060 case("d")
3061 allocate (anavars%dcv(i)%dat,source=dbadatad(anavar(i)))
3062 case("c")
3063 allocate (anavars%dcv(i)%dat,source=dbadatac(anavar(i)))
3064 case default
3065 call l4f_category_log(this%category,l4f_error,"anavar and anavarkind mismach")
3066 CALL raise_fatal_error()
3067 end select
3068 else
3069 allocate (anavars%dcv(i)%dat,source=dbadatac(anavar(i))) !char is default
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)
3085 if (c_e(attr(i)))then
3086 if (present(attrkind))then
3087 select case (attrkind(i))
3088 case("r")
3089 allocate (starvars%dcv(i)%dat,source=dbadatar(attr(i)))
3090 case("i")
3091 allocate (starvars%dcv(i)%dat,source=dbadatai(attr(i)))
3092 case("b")
3093 allocate (starvars%dcv(i)%dat,source=dbadatab(attr(i)))
3094 case("d")
3095 allocate (starvars%dcv(i)%dat,source=dbadatad(attr(i)))
3096 case("c")
3097 allocate (starvars%dcv(i)%dat,source=dbadatac(attr(i)))
3098 case default
3099 call l4f_category_log(this%category,l4f_error,"attr and attrkind mismach")
3100 CALL raise_fatal_error()
3101 end select
3102 else
3103 allocate (starvars%dcv(i)%dat,source=dbadatac(attr(i))) !char is default
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)
3120 if (c_e(anaattr(i)))then
3121 if (present(anaattrkind))then
3122 select case (anaattrkind(i))
3123 case("r")
3124 allocate (anastarvars%dcv(i)%dat,source=dbadatar(anaattr(i)))
3125 case("i")
3126 allocate (anastarvars%dcv(i)%dat,source=dbadatai(anaattr(i)))
3127 case("b")
3128 allocate (anastarvars%dcv(i)%dat,source=dbadatab(anaattr(i)))
3129 case("d")
3130 allocate (anastarvars%dcv(i)%dat,source=dbadatad(anaattr(i)))
3131 case("c")
3132 allocate (anastarvars%dcv(i)%dat,source=dbadatac(anaattr(i)))
3133 case default
3134 call l4f_category_log(this%category,l4f_error,"attr and attrkind mismach")
3135 CALL raise_fatal_error()
3136 end select
3137 else
3138 allocate (anastarvars%dcv(i)%dat,source=dbadatac(anaattr(i))) !char is default
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
3176call import(this,filter,set_network)
3177
3178
3179END SUBROUTINE vol7d_dballe_import_old
3180
3181
3182
3184subroutine vol7d_dballe_import(this,filter,set_network)
3185
3186TYPE(vol7d_dballe),INTENT(inout) :: this
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
3194CALL l4f_category_log(this%category,l4f_debug,'start import vol7d_dballe')
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)
3205 CALL l4f_category_log(this%category,l4f_debug,'end import vol7d_dballe ingest')
3206 CALL l4f_category_log(this%category,l4f_debug,'start import vol7d_dballe dba2v7d')
3207 call dba2v7d(this%vol7d, metaanddatav,this%time_definition,set_network)
3208 CALL l4f_category_log(this%category,l4f_debug,'end import vol7d_dballe dba2v7d')
3209
3210 deallocate (metaanddatav)
3211
3212else
3213 ! empty volume
3214 call init(this%vol7d)
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)
3230 CALL l4f_category_log(this%category,l4f_debug,'end import vol7d_dballe ingest')
3231 CALL l4f_category_log(this%category,l4f_debug,'start import vol7d_dballe dba2v7d')
3232 call dba2v7d(vol7dtmp,metaanddatav,this%time_definition,set_network)
3233 CALL l4f_category_log(this%category,l4f_debug,'end import vol7d_dballe dba2v7d')
3234
3235 deallocate (metaanddatav)
3236
3237 CALL vol7d_merge(this%vol7d, vol7dtmp, sort=.true.) ! Smart merge
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
3284CALL l4f_category_log(this%category,l4f_debug,'end import vol7d_dballe')
3285
3286end subroutine vol7d_dballe_import
3287
3288
3289
3291
3292SUBROUTINE vol7d_dballe_delete(this, preserveidbhandle)
3293TYPE(vol7d_dballe) :: this
3294logical,intent(in), optional :: preserveidbhandle
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
3307CALL delete(this%vol7d)
3308
3309 !chiudo il logger
3310call l4f_category_delete(this%category)
3311 !ier=l4f_fini()
3312
3313END SUBROUTINE vol7d_dballe_delete
3314
3315
3316
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
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)
3364if (.not. c_e(ltime_definition)) ltime_definition = 1
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
3377 if (c_e(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)
3396 if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
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)
3423 if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
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)
3436 if (.not. c_e(metaanddatav(i)%metadata%datetime%datetime)) then
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)
3450 if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
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)
3479 if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
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)
3495 if (.not. c_e(metaanddatav(i)%metadata%datetime%datetime)) then
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)
3520 call sort(tmpnetwork)
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)
3528call sort(tmptime)
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)
3535call sort(tmptimerange)
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)
3542call sort(tmplevel)
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)
3548call sort(tmpana)
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)
3572 type is (dbadatar)
3573 ndativarr = ndativarr + 1
3574 type is (dbadatai)
3575 ndativari = ndativari + 1
3576 type is (dbadatab)
3577 ndativarb = ndativarb + 1
3578 type is (dbadatad)
3579 ndativard = ndativard + 1
3580 type is (dbadatac)
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)
3598 type is (dbadatar)
3599 ndatiattrr = ndatiattrr + 1
3600 type is (dbadatai)
3601 ndatiattri = ndatiattri + 1
3602 type is (dbadatab)
3603 ndatiattrb = ndatiattrb + 1
3604 type is (dbadatad)
3605 ndatiattrd = ndatiattrd + 1
3606 type is (dbadatac)
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
3693CALL init(this,time_definition=ltime_definition)
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
3784 call init (this%dativar%r(ndativarr), btable=dato%btable)
3785 type is (dbadatai)
3786 ndativari = ndativari + 1
3787 call init (this%dativar%i(ndativari), btable=dato%btable)
3788 type is (dbadatab)
3789 ndativarb = ndativarb + 1
3790 call init (this%dativar%b(ndativarb), btable=dato%btable)
3791 type is (dbadatad)
3792 ndativard = ndativard + 1
3793 call init (this%dativar%d(ndativard), btable=dato%btable)
3794 type is (dbadatac)
3795 ndativarc = ndativarc + 1
3796 call init (this%dativar%c(ndativarc), btable=dato%btable)
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
3815 call init (this%datiattr%r(ndatiattrr), btable=dato%btable)
3816 type is (dbadatai)
3817 ndatiattri = ndatiattri + 1
3818 call init (this%datiattr%i(ndatiattri), btable=dato%btable)
3819 type is (dbadatab)
3820 ndatiattrb = ndatiattrb + 1
3821 call init (this%datiattr%b(ndatiattrb), btable=dato%btable)
3822 type is (dbadatad)
3823 ndatiattrd = ndatiattrd + 1
3824 call init (this%datiattr%d(ndatiattrd), btable=dato%btable)
3825 type is (dbadatac)
3826 ndatiattrc = ndatiattrc + 1
3827 call init (this%datiattr%c(ndatiattrc), btable=dato%btable)
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
3846 call init (this%anavar%r(nanavarr), btable=dato%btable)
3847 type is (dbadatai)
3848 nanavari = nanavari + 1
3849 call init (this%anavar%i(nanavari), btable=dato%btable)
3850 type is (dbadatab)
3851 nanavarb = nanavarb + 1
3852 call init (this%anavar%b(nanavarb), btable=dato%btable)
3853 type is (dbadatad)
3854 nanavard = nanavard + 1
3855 call init (this%anavar%d(nanavard), btable=dato%btable)
3856 type is (dbadatac)
3857 nanavarc = nanavarc + 1
3858 call init (this%anavar%c(nanavarc), btable=dato%btable)
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
3877 call init (this%anaattr%r(nanaattrr), btable=dato%btable)
3878 type is (dbadatai)
3879 nanaattri = nanaattri + 1
3880 call init (this%anaattr%i(nanaattri), btable=dato%btable)
3881 type is (dbadatab)
3882 nanaattrb = nanaattrb + 1
3883 call init (this%anaattr%b(nanaattrb), btable=dato%btable)
3884 type is (dbadatad)
3885 nanaattrd = nanaattrd + 1
3886 call init (this%anaattr%d(nanaattrd), btable=dato%btable)
3887 type is (dbadatac)
3888 nanaattrc = nanaattrc + 1
3889 call init (this%anaattr%c(nanaattrc), btable=dato%btable)
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)
3898 if ( ndativarattri > 0 ) call init(this%dativarattr%i(i),btable=dato%btable)
3899 if ( ndativarattrr > 0 ) call init(this%dativarattr%r(i),btable=dato%btable)
3900 if ( ndativarattrd > 0 ) call init(this%dativarattr%d(i),btable=dato%btable)
3901 if ( ndativarattrb > 0 ) call init(this%dativarattr%b(i),btable=dato%btable)
3902 if ( ndativarattrc > 0 ) call init(this%dativarattr%c(i),btable=dato%btable)
3903 end associate
3904end do
3905
3906do i =1, size(anavars%dcv)
3907 associate(dato => anavars%dcv(i)%dat)
3908 if ( nanavarattri > 0 ) call init(this%anavarattr%i(i),btable=dato%btable)
3909 if ( nanavarattrr > 0 ) call init(this%anavarattr%r(i),btable=dato%btable)
3910 if ( nanavarattrd > 0 ) call init(this%anavarattr%d(i),btable=dato%btable)
3911 if ( nanavarattrb > 0 ) call init(this%anavarattr%b(i),btable=dato%btable)
3912 if ( nanavarattrc > 0 ) call init(this%anavarattr%c(i),btable=dato%btable)
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
4209
4210subroutine vol7d_dballe_set_var_du(this)
4211
4212TYPE(vol7d) :: this
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
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
4405character(len=network_name_len),INTENT(in),optional :: network
4408TYPE(geo_coord),INTENT(in),optional :: coordmin,coordmax
4410TYPE(datetime),INTENT(in),optional :: timei, timef
4411TYPE(vol7d_level),INTENT(in),optional :: level
4412TYPE(vol7d_timerange),INTENT(in),optional :: timerange
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
4421logical, intent(in),optional :: dataonly
4422logical, intent(in),optional :: anaonly
4425character(len=*),intent(in),optional :: template
4426logical, intent(in),optional :: attr_only
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()
4518if (present(network)) call init(mydbanetwork%vol7d_network,name=network)
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
4532call export (this, filter,template,attr_only)
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
4540type(dbafilter),intent(in) :: filter
4543character(len=*),intent(in),optional :: template
4544logical, intent(in),optional :: attr_only
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
4611end MODULE vol7d_dballe_class
4612
4616
4621
Index method.
Emit log message for a category with specific priority.
This module defines usefull general purpose function and subroutine.
Utilities for CHARACTER variables.
class for import and export data from e to DB-All.e.
Classes for handling georeferenced sparse points in geographical corodinates.
class to use character lists in fortran 2003 WARNING !!!! CHAR LEN IS FIXED TO listcharmaxlen.
class to manage links for lists in fortran 2003.
classe per la gestione del logging
Classe per la gestione di un volume completo di dati osservati.
classe per import ed export di volumi da e in DB-All.e
manage connection handle to a DSN
fortran 2003 interface to geo_coord
byte version for dbadata
character version for dbadata
doubleprecision version for dbadata
integer version for dbadata
real version for dbadata
filter to apply before ingest data
manage session handle
Oggetto per import ed export da DB-All.e.

Generated with Doxygen.