libsim Versione 7.1.11

◆ 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 
)
private

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 2642 del file vol7d_dballe_class.F03.

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