2212if (
present(vars))
then
2213 if (
allocated(vars%dcv))
then
2214 allocate(dbafilter_init%vars%dcv(
size(vars%dcv)))
2215 do i =1,
size(vars%dcv)
2216 allocate(dbafilter_init%vars%dcv(i)%dat,source=vars%dcv(i)%dat)
2219 dbafilter_init%varlist=
""
2220 do i=1,
size(vars%dcv)
2221 dbafilter_init%varlist=trim(dbafilter_init%varlist)//vars%dcv(i)%dat%btable
2222 if (i /=
size(vars%dcv)) dbafilter_init%varlist=trim(dbafilter_init%varlist)//
","
2227if (
present(starvars))
then
2228 if (
allocated(starvars%dcv))
then
2229 allocate(dbafilter_init%starvars%dcv(
size(starvars%dcv)))
2230 do i =1,
size(starvars%dcv)
2231 allocate(dbafilter_init%starvars%dcv(i)%dat,source=starvars%dcv(i)%dat)
2234 dbafilter_init%starvarlist=
""
2235 do i=1,
size(starvars%dcv)
2236 dbafilter_init%starvarlist=trim(dbafilter_init%starvarlist)//starvars%dcv(i)%dat%btable
2237 if (i /=
size(starvars%dcv)) dbafilter_init%starvarlist=trim(dbafilter_init%starvarlist)//
","
2243if (
present(anavars))
then
2244 if (
allocated(anavars%dcv))
then
2245 allocate(dbafilter_init%anavars%dcv(
size(anavars%dcv)))
2246 do i =1,
size(anavars%dcv)
2247 allocate(dbafilter_init%anavars%dcv(i)%dat,source=anavars%dcv(i)%dat)
2250 dbafilter_init%anavarlist=
""
2251 do i=1,
size(anavars%dcv)
2252 dbafilter_init%anavarlist=trim(dbafilter_init%anavarlist)//anavars%dcv(i)%dat%btable
2253 if (i /=
size(anavars%dcv)) dbafilter_init%anavarlist=trim(dbafilter_init%anavarlist)//
","
2258if (
present(anastarvars))
then
2259 if (
allocated(anastarvars%dcv))
then
2260 allocate(dbafilter_init%anastarvars%dcv(
size(anastarvars%dcv)))
2261 do i =1,
size(anastarvars%dcv)
2262 allocate(dbafilter_init%anastarvars%dcv(i)%dat,source=anastarvars%dcv(i)%dat)
2265 dbafilter_init%anastarvarlist=
""
2266 do i=1,
size(anastarvars%dcv)
2267 dbafilter_init%anastarvarlist=trim(dbafilter_init%anastarvarlist)//anastarvars%dcv(i)%dat%btable
2268 if (i /=
size(anastarvars%dcv)) dbafilter_init%anastarvarlist=trim(dbafilter_init%anastarvarlist)//
","
2273if (
present(priority))
then
2274 dbafilter_init%priority=priority
2275else if (nopreserve)
then
2276 dbafilter_init%priority=imiss
2279if (
present(priomin))
then
2280 dbafilter_init%priomin=priomax
2281else if (nopreserve)
then
2282 dbafilter_init%priomin=imiss
2285if (
present(priomax))
then
2286 dbafilter_init%priomax=priomax
2287else if (nopreserve)
then
2288 dbafilter_init%priomax=imiss
2291if (
present(contextana))
then
2292 dbafilter_init%contextana=contextana
2293else if (nopreserve)
then
2294 dbafilter_init%contextana=.false.
2297if (
present(anaonly))
then
2298 dbafilter_init%anaonly=anaonly
2299else if (nopreserve)
then
2300 dbafilter_init%anaonly=.false.
2302if (
present(dataonly))
then
2303 dbafilter_init%dataonly=dataonly
2304else if (nopreserve)
then
2305 dbafilter_init%dataonly=.false.
2308if (
present(query))
then
2309 dbafilter_init%query=query
2310else if (nopreserve)
then
2311 dbafilter_init%query=cmiss
2314end function dbafilter_init
2317subroutine dbafilter_display(filter)
2320print *,
"------------------ filter ---------------"
2321call filter%ana%display()
2322call filter%datetime%display()
2323call filter%level%display()
2324call filter%timerange%display()
2325call filter%network%display()
2326print *,
" >>>> minimum:"
2327call filter%datetimemin%display()
2328call filter%coordmin%display()
2329print *,
" >>>> maximum:"
2330call filter%datetimemax%display()
2331call filter%coordmax%display()
2332print *,
" >>>> vars:"
2333call filter%vars%display()
2334print *,
" >>>> starvars:"
2335call filter%starvars%display()
2336print *,
" >>>> anavars:"
2337call filter%anavars%display()
2338print *,
" >>>> anastarvars:"
2339call filter%anastarvars%display()
2340print *,
"var=",filter%var
2341print *,
"limit=",filter%limit
2342print *,
"ana_filter=",trim(filter%ana_filter)
2343print *,
"data_filter=",trim(filter%data_filter)
2344print *,
"attr_filter=",trim(filter%attr_filter)
2345print *,
"varlist=",trim(filter%varlist)
2346print *,
"*varlist=",trim(filter%starvarlist)
2347print *,
"anavarlist=",trim(filter%anavarlist)
2348print *,
"ana*varlist=",trim(filter%anastarvarlist)
2349print *,
"priority=",filter%priority
2350print *,
"priomin=",filter%priomin
2351print *,
"priomax=",filter%priomax
2352print *,
"contextana=",filter%contextana
2353print *,
"anaonly=",filter%anaonly
2354print *,
"dataonly=",filter%dataonly
2355print *,
"query=",trim(filter%query)
2357print *,
"-----------------------------------------"
2359end subroutine dbafilter_display
2362subroutine dbafilter_set(filter,session)
2366integer :: ier,year,month,day,hour,minute,sec,msec
2368call session%unsetall()
2370call filter%ana%dbaset(session)
2371call filter%network%dbaset(session)
2372ier = idba_set(session%sehandle,
"var",filter%var)
2374ier = idba_set(session%sehandle,
"limit",filter%limit)
2375ier = idba_set(session%sehandle,
"priority",filter%priority)
2376ier = idba_set(session%sehandle,
"priomin",filter%priomin)
2377ier = idba_set(session%sehandle,
"priomax",filter%priomax)
2379ier = idba_set(session%sehandle,
"latmin",getilat(filter%coordmin%geo_coord))
2380ier = idba_set(session%sehandle,
"lonmin",getilon(filter%coordmin%geo_coord))
2381ier = idba_set(session%sehandle,
"latmax",getilat(filter%coordmax%geo_coord))
2382ier = idba_set(session%sehandle,
"lonmax",getilon(filter%coordmax%geo_coord))
2384ier = idba_set(session%sehandle,
"ana_filter",filter%ana_filter)
2385ier = idba_set(session%sehandle,
"data_filter",filter%data_filter)
2386ier = idba_set(session%sehandle,
"attr_filter",filter%attr_filter)
2388ier = idba_set(session%sehandle,
"query",filter%query)
2390if (filter%contextana)
then
2392 call session%setcontextana()
2394 ier = idba_set(session%sehandle,
"varlist",filter%anavarlist)
2395 ier = idba_set(session%sehandle,
"*varlist",filter%anastarvarlist)
2399 if (c_e(filter%datetime%datetime))
call filter%datetime%dbaset(session)
2400 if (c_e(filter%level%vol7d_level))
call filter%level%dbaset(session)
2401 if (c_e(filter%timerange%vol7d_timerange))
call filter%timerange%dbaset(session)
2403 CALL getval(filter%datetimemin%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
2405 sec=nint(float(msec)/1000.)
2410 ier = idba_set(session%sehandle,
"yearmin",year)
2411 ier = idba_set(session%sehandle,
"monthmin",month)
2412 ier = idba_set(session%sehandle,
"daymin",day)
2413 ier = idba_set(session%sehandle,
"hourmin",hour)
2414 ier = idba_set(session%sehandle,
"minumin",minute)
2415 ier = idba_set(session%sehandle,
"secmin",sec)
2417 CALL getval(filter%datetimemax%datetime, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
2420 sec=nint(float(msec)/1000.)
2425 ier = idba_set(session%sehandle,
"yearmax",year)
2426 ier = idba_set(session%sehandle,
"monthmax",month)
2427 ier = idba_set(session%sehandle,
"daymax",day)
2428 ier = idba_set(session%sehandle,
"hourmax",hour)
2429 ier = idba_set(session%sehandle,
"minumax",minute)
2430 ier = idba_set(session%sehandle,
"secmax",sec)
2433 ier = idba_set(session%sehandle,
"varlist",filter%varlist)
2434 ier = idba_set(session%sehandle,
"*varlist",filter%starvarlist)
2437end subroutine dbafilter_set
2441type(
dbametadata) function dbametadata_contextana(metadata)
2448select type(metadata)
2450 dbametadata_contextana=metadata
2453dbametadata_contextana%datetime=datetime%dbacontextana()
2454dbametadata_contextana%level=level%dbacontextana()
2455dbametadata_contextana%timerange=timerange%dbacontextana()
2457end function dbametadata_contextana
2461subroutine dbametaanddata_display(metaanddata)
2464call metaanddata%metadata%display()
2465call metaanddata%dataattrv%display()
2467end subroutine dbametaanddata_display
2470subroutine dbametaanddata_extrude(metaanddata,session,noattr,filter,attronly,template)
2473logical,
intent(in),
optional :: noattr
2474type(
dbafilter),
intent(in),
optional :: filter
2475logical,
intent(in),
optional :: attronly
2476character(len=*),
intent(in),
optional :: template
2484myfilter=
dbafilter(filter=filter,contextana=.false.)
2485call extrude(metaanddata,session,noattr,myfilter,attronly,template)
2488myfilter=
dbafilter(filter=filter,contextana=.true.)
2489call extrude(metaanddata,session,noattr,myfilter,attronly,template)
2493subroutine extrude(metaanddata,session,noattr,filter,attronly,template)
2496logical,
intent(in),
optional :: noattr
2498logical,
intent(in),
optional :: attronly
2499character(len=*),
intent(in),
optional :: template
2501if (.not. filter == metaanddata%metadata)
return
2998call data%metadata%display()
2999call data%dbadatab%display()
3001end subroutine dbametaanddatab_display
3004subroutine dbametaanddatad_display(data)
3007call data%metadata%display()
3008call data%dbadatad%display()
3010end subroutine dbametaanddatad_display
3013subroutine dbametaanddatar_display(data)
3016call data%metadata%display()
3017call data%dbadatar%display()
3019end subroutine dbametaanddatar_display
3023subroutine dbametaanddatac_display(data)
3026call data%metadata%display()
3027call data%dbadatac%display()
3029end subroutine dbametaanddatac_display
3033subroutine dbametaanddatai_extrude(metaanddatai,session)
3037call session%unsetall()
3039call session%set(metadata=metaanddatai%metadata)
3041call session%set(data=metaanddatai%dbadatai)
3043if (metaanddatai%dbadatai%c_e())
then
3044 call session%prendilo()
3046 call session%dimenticami()
3049end subroutine dbametaanddatai_extrude
3052subroutine dbametaanddatab_extrude(metaanddatab,session)
3056call session%unsetall()
3058call session%set(metadata=metaanddatab%metadata)
3060call session%set(data=metaanddatab%dbadatab)
3062if (metaanddatab%dbadatab%c_e())
then
3063 call session%prendilo()
3065 call session%dimenticami()
3068end subroutine dbametaanddatab_extrude
3071subroutine dbametaanddatad_extrude(metaanddatad,session)
3075call session%unsetall()
3077call session%set(metadata=metaanddatad%metadata)
3079call session%set(data=metaanddatad%dbadatad)
3081if (metaanddatad%dbadatad%c_e())
then
3082 call session%prendilo()
3084 call session%dimenticami()
3087end subroutine dbametaanddatad_extrude
3090subroutine dbametaanddatar_extrude(metaanddatar,session)
3094call session%unsetall()
3096call session%set(metadata=metaanddatar%metadata)
3098call session%set(data=metaanddatar%dbadatar)
3100if (metaanddatar%dbadatar%c_e())
then
3101 call session%prendilo()
3103 call session%dimenticami()
3106end subroutine dbametaanddatar_extrude
3109subroutine dbametaanddatac_extrude(metaanddatac,session)
3113call session%unsetall()
3115call session%set(metadata=metaanddatac%metadata)
3117call session%set(data=metaanddatac%dbadatac)
3119if (metaanddatac%dbadatac%c_e())
then
3120 call session%prendilo()
3122 call session%dimenticami()
3125end subroutine dbametaanddatac_extrude
3128subroutine dbasession_ingest_ana(session,ana)
3130type(
dbaana),
intent(out),
optional :: ana
3134if (.not.
present(ana))
then
3135 ier = idba_quantesono(session%sehandle, session%count)
3138 ier = idba_elencamele(session%sehandle)
3139 call ana%dbaenq(session)
3140 session%count=session%count-1
3143end subroutine dbasession_ingest_ana
3147subroutine dbasession_ingest_anav(session,anav)
3149type(
dbaana),
intent(out),
allocatable :: anav(:)
3152call session%ingest_ana()
3154if (c_e(session%count))
then
3155 allocate(anav(session%count))
3157 do while (session%count >0)
3159 call session%ingest_ana(anav(i))
3165end subroutine dbasession_ingest_anav
3169subroutine dbasession_ingest_anal(session,anal)
3174call session%ingest_ana()
3175do while (c_e(session%count) .and. session%count >0)
3176 call session%ingest_ana(element)
3177 call anal%append(element)
3178 call session%ingest_ana()
3180end subroutine dbasession_ingest_anal
3184subroutine dbasession_ingest_metaanddata(session,metaanddata,noattr,filter)
3187logical,
intent(in),
optional :: noattr
3188type(
dbafilter),
intent(in),
optional :: filter
3191integer :: ier,acount,i,j,k
3192character(len=9) :: btable
3193character(255) :: value
3194logical :: lvars,lstarvars
3195type(
dbadcv) :: vars,starvars
3199if (.not.
present(metaanddata))
then
3200 ier = idba_voglioquesto(session%sehandle, session%count)
3203 if (c_e(session%count) .and. session%count > 0)
then
3204 ier = idba_dammelo(session%sehandle, btable)
3211 if (
allocated(metaanddata%dataattrv%dataattr))
then
3212 deallocate (metaanddata%dataattrv%dataattr)
3217 if (
present(filter))
then
3219 if (filter%contextana)
then
3222 if (
allocated(filter%anavars%dcv))
then
3224 allocate(vars%dcv(
size(filter%anavars%dcv)))
3225 do i =1,
size(filter%anavars%dcv)
3226 allocate(vars%dcv(i)%dat,source=filter%anavars%dcv(i)%dat)
3230 if (
allocated(filter%anastarvars%dcv))
then
3232 allocate(starvars%dcv(
size(filter%anastarvars%dcv)))
3233 do i =1,
size(filter%anastarvars%dcv)
3234 allocate(starvars%dcv(i)%dat,source=filter%anastarvars%dcv(i)%dat)
3240 if (
allocated(filter%vars%dcv))
then
3242 allocate(vars%dcv(
size(filter%vars%dcv)))
3243 do i =1,
size(filter%vars%dcv)
3244 allocate(vars%dcv(i)%dat,source=filter%vars%dcv(i)%dat)
3248 if (
allocated(filter%starvars%dcv))
then
3250 allocate(starvars%dcv(
size(filter%starvars%dcv)))
3251 do i =1,
size(filter%starvars%dcv)
3252 allocate(starvars%dcv(i)%dat,source=filter%starvars%dcv(i)%dat)
3263 allocate (metaanddata%dataattrv%dataattr(
size(vars%dcv)))
3264 do i = 1,
size(vars%dcv)
3265 allocate (metaanddata%dataattrv%dataattr(i)%dat,source=vars%dcv(i)%dat)
3269 call metaanddata%metadata%dbaenq(session)
3271 call metadata%dbaenq(session)
3274 do while ( metaanddata%metadata == metadata )
3275 ier = idba_enq(session%sehandle,
"var",btable)
3276 do i=1,
size(metaanddata%dataattrv%dataattr)
3277 if (metaanddata%dataattrv%dataattr(i)%dat%btable == btable)
then
3279 select type ( dat => metaanddata%dataattrv%dataattr(i)%dat )
3281 ier = idba_enq(session%sehandle, btable,dat%value)
3283 ier = idba_enq(session%sehandle, btable,dat%value)
3285 ier = idba_enq(session%sehandle, btable,dat%value)
3287 ier = idba_enq(session%sehandle, btable,dat%value)
3289 ier = idba_enq(session%sehandle, btable,dat%value)
3292 if (optio_log(noattr))
then
3294 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
3300 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(
size(starvars%dcv)))
3301 do j = 1,
size(starvars%dcv)
3302 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=starvars%dcv(j)%dat)
3305 if (c_e(session%count) .and. session%count > 0)
then
3307 ier = idba_voglioancora(session%sehandle, acount)
3309 ier = idba_ancora(session%sehandle, btable)
3310 ier = idba_enq(session%sehandle, btable,
value)
3312 do j=1,
size(metaanddata%dataattrv%dataattr(i)%attrv%dcv)
3314 if (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat%btable == btable)
then
3316 select type ( dat => metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat )
3318 ier = idba_enq(session%sehandle, btable,dat%value)
3320 ier = idba_enq(session%sehandle, btable,dat%value)
3322 ier = idba_enq(session%sehandle, btable,dat%value)
3324 ier = idba_enq(session%sehandle, btable,dat%value)
3326 ier = idba_enq(session%sehandle, btable,dat%value)
3334 if (c_e(session%count) .and. session%count > 0)
then
3335 ier = idba_voglioancora(session%sehandle, acount)
3337 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(acount))
3339 ier = idba_ancora(session%sehandle, btable)
3340 ier = idba_enq(session%sehandle, btable,
value)
3341 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(j)%dat,source=
dbadatac(btable,
value))
3344 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
3351 if (c_e(session%count)) session%count=session%count-1
3353 if (c_e(session%count) .and. session%count > 0 )
then
3354 ier = idba_dammelo(session%sehandle, btable)
3355 call metadata%dbaenq(session)
3362 allocate (metaanddata%dataattrv%dataattr(1))
3363 ier = idba_enq(session%sehandle,
"var",btable)
3364 ier = idba_enq(session%sehandle, btable,
value)
3365 allocate (metaanddata%dataattrv%dataattr(1)%dat,source=
dbadatac(btable,
value))
3366 call metaanddata%metadata%dbaenq(session)
3369 if (optio_log(noattr))
then
3371 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(0))
3377 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(
size(starvars%dcv)))
3378 do j = 1,
size(starvars%dcv)
3379 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat,source=starvars%dcv(j)%dat)
3382 if (c_e(session%count) .and. session%count > 0)
then
3384 ier = idba_voglioancora(session%sehandle, acount)
3386 ier = idba_ancora(session%sehandle, btable)
3387 ier = idba_enq(session%sehandle, btable,
value)
3389 do j=1,
size(metaanddata%dataattrv%dataattr(1)%attrv%dcv)
3391 if (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat%btable == btable)
then
3393 select type ( dat => metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat )
3395 ier = idba_enq(session%sehandle, btable,dat%value)
3397 ier = idba_enq(session%sehandle, btable,dat%value)
3399 ier = idba_enq(session%sehandle, btable,dat%value)
3401 ier = idba_enq(session%sehandle, btable,dat%value)
3403 ier = idba_enq(session%sehandle, btable,dat%value)
3411 if (c_e(session%count) .and. session%count > 0)
then
3412 ier = idba_voglioancora(session%sehandle, acount)
3414 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(acount))
3416 ier = idba_ancora(session%sehandle, btable)
3417 ier = idba_enq(session%sehandle, btable,
value)
3418 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(j)%dat,source=
dbadatac(btable,
value))
3421 allocate (metaanddata%dataattrv%dataattr(1)%attrv%dcv(0))
3426 if (c_e(session%count))
then
3427 session%count=session%count-1
3429 if (session%count > 0 )
then
3430 ier = idba_dammelo(session%sehandle, btable)
3436 do i=1,
size(metaanddata%dataattrv%dataattr)
3437 if (.not.
allocated(metaanddata%dataattrv%dataattr(i)%attrv%dcv))
then
3438 allocate (metaanddata%dataattrv%dataattr(i)%attrv%dcv(0))
3444end subroutine dbasession_ingest_metaanddata
3448subroutine dbasession_ingest_metaanddatav(session,metaanddatav,noattr,filter)
3450type(
dbametaanddata),
intent(inout),
allocatable :: metaanddatav(:)
3451logical,
intent(in),
optional :: noattr
3452type(
dbafilter),
intent(in),
optional :: filter
3458if (
present(filter))
then
3459 call filter%dbaset(session)
3461 call session%unsetall()
3464call session%ingest()
3467if (c_e(session%count))
then
3469 allocate(metaanddatavbuf(session%count))
3471 do while (session%count >0)
3473 call session%ingest(metaanddatavbuf(i),noattr=noattr,filter=filter)
3477 IF (
SIZE(metaanddatavbuf) == i)
THEN
3479 CALL move_alloc(metaanddatavbuf, metaanddatav)
3482 metaanddatav=metaanddatavbuf(:i)
3483 DEALLOCATE(metaanddatavbuf)
3487 if (
allocated(metaanddatav))
deallocate(metaanddatav)
3488 allocate(metaanddatav(0))
3492end subroutine dbasession_ingest_metaanddatav
3496subroutine dbasession_ingest_metaanddatal(session,metaanddatal,noattr,filter)
3499logical,
intent(in),
optional :: noattr
3500type(
dbafilter),
intent(in),
optional :: filter
3505if (session%memdb .and. .not. session%loadfile)
then
3507 do while (session%messages_read_next())
3508 call session%set(filter=filter)
3509 call session%ingest()
3510 call session%ingest(metaanddatavbuf,noattr=noattr,filter=filter)
3511 do i=1,
size(metaanddatavbuf)
3512 call metaanddatal%append(metaanddatavbuf(i))
3515 call session%remove_all()
3516 deallocate (metaanddatavbuf)
3521 call session%ingest()
3523 do while (c_e(session%count) .and. session%count >0)
3524 call session%ingest(metaanddatavbuf,noattr=noattr,filter=filter)
3525 do i=1,
size(metaanddatavbuf)
3526 if (
present(filter))
then
3528 if (filter%contextana)
then
3529 if (datetime_new() /= metaanddatavbuf(i)%metadata%datetime%datetime) cycle
3532 call metaanddatal%append(metaanddatavbuf(i))
3534 if (session%file)
call session%ingest()
3535 deallocate (metaanddatavbuf)
3539end subroutine dbasession_ingest_metaanddatal
3542subroutine dbasession_ingest_metaanddatai(session,metaanddata)
3547character(len=9) :: btable
3550if (.not.
present(metaanddata))
then
3551 ier = idba_voglioquesto(session%sehandle, session%count)
3553 ier = idba_dammelo(session%sehandle, btable)
3554 ier = idba_enq(session%sehandle, btable,
value)
3555 metaanddata%dbadatai=
dbadatai(btable,
value)
3556 call metaanddata%metadata%dbaenq(session)
3557 session%count=session%count-1
3559end subroutine dbasession_ingest_metaanddatai
3563subroutine dbasession_ingest_metaanddataiv(session,metaanddatav)
3569call session%ingest_metaanddatai()
3570if (c_e(session%count))
then
3571 allocate(metaanddatav(session%count))
3573 do while (session%count >0)
3575 call session%ingest_metaanddatai(metaanddatav(i))
3578 allocate(metaanddatav(0))
3581end subroutine dbasession_ingest_metaanddataiv
3585subroutine dbasession_ingest_metaanddatab(session,metaanddata)
3590character(len=9) :: btable
3591integer(kind=int_b) :: value
3593if (.not.
present(metaanddata))
then
3594 ier = idba_voglioquesto(session%sehandle, session%count)
3596 ier = idba_dammelo(session%sehandle, btable)
3597 ier = idba_enq(session%sehandle, btable,
value)
3598 metaanddata%dbadatab=
dbadatab(btable,
value)
3599 call metaanddata%metadata%dbaenq(session)
3600 session%count=session%count-1
3602end subroutine dbasession_ingest_metaanddatab
3606subroutine dbasession_ingest_metaanddatabv(session,metaanddatav)
3612call session%ingest_metaanddatab()
3613if (c_e(session%count))
then
3614 allocate(metaanddatav(session%count))
3616 do while (session%count >0)
3618 call session%ingest_metaanddatab(metaanddatav(i))
3621 allocate(metaanddatav(0))
3624end subroutine dbasession_ingest_metaanddatabv
3628subroutine dbasession_ingest_metaanddatad(session,metaanddata)
3633character(len=9) :: btable
3634doubleprecision :: value
3636if (.not.
present(metaanddata))
then
3637 ier = idba_voglioquesto(session%sehandle, session%count)
3639 ier = idba_dammelo(session%sehandle, btable)
3640 ier = idba_enq(session%sehandle, btable,
value)
3641 metaanddata%dbadatad=
dbadatad(btable,
value)
3642 call metaanddata%metadata%dbaenq(session)
3643 session%count=session%count-1
3645end subroutine dbasession_ingest_metaanddatad
3649subroutine dbasession_ingest_metaanddatadv(session,metaanddatav)
3655call session%ingest_metaanddatad()
3656if (c_e(session%count))
then
3657 allocate(metaanddatav(session%count))
3659 do while (session%count >0)
3661 call session%ingest_metaanddatad(metaanddatav(i))
3664 allocate(metaanddatav(0))
3666end subroutine dbasession_ingest_metaanddatadv
3670subroutine dbasession_ingest_metaanddatar(session,metaanddata)
3675character(len=9) :: btable
3678if (.not.
present(metaanddata))
then
3679 ier = idba_voglioquesto(session%sehandle, session%count)
3681 ier = idba_dammelo(session%sehandle, btable)
3682 ier = idba_enq(session%sehandle, btable,
value)
3683 metaanddata%dbadatar=
dbadatar(btable,
value)
3684 call metaanddata%metadata%dbaenq(session)
3685 session%count=session%count-1
3687end subroutine dbasession_ingest_metaanddatar
3691subroutine dbasession_ingest_metaanddatarv(session,metaanddatav)
3697call session%ingest_metaanddatar()
3698if (c_e(session%count))
then
3699 allocate(metaanddatav(session%count))
3701 do while (session%count >0)
3703 call session%ingest_metaanddatar(metaanddatav(i))
3706 allocate(metaanddatav(0))
3708end subroutine dbasession_ingest_metaanddatarv
3713subroutine dbasession_ingest_metaanddatac(session,metaanddata)
3718character(len=9) :: btable
3719character(len=255) :: value
3721if (.not.
present(metaanddata))
then
3722 ier = idba_voglioquesto(session%sehandle, session%count)
3724 ier = idba_dammelo(session%sehandle, btable)
3725 ier = idba_enq(session%sehandle, btable,
value)
3726 metaanddata%dbadatac=
dbadatac(btable,
value)
3727 call metaanddata%metadata%dbaenq(session)
3728 session%count=session%count-1
3730end subroutine dbasession_ingest_metaanddatac
3734subroutine dbasession_ingest_metaanddatacv(session,metaanddatav)
3740call session%ingest_metaanddatac()
3741if (c_e(session%count))
then
3742 allocate(metaanddatav(session%count))
3744 do while (session%count >0)
3746 call session%ingest_metaanddatac(metaanddatav(i))
3749 allocate(metaanddatav(session%count))
3751end subroutine dbasession_ingest_metaanddatacv
3755type(
dbaconnection) function dbaconnection_init(dsn, user, password,categoryappend,idbhandle)
3756character (len=*),
intent(in),
optional :: dsn
3757character (len=*),
intent(in),
optional :: user
3758character (len=*),
intent(in),
optional :: password
3759character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
3760integer,
INTENT(in),
OPTIONAL :: idbhandle
3763character(len=512) :: a_name,quidsn
3765if (
present(categoryappend))
then
3766 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
3768 call l4f_launcher(a_name,a_name_append=trim(subcategory))
3770dbaconnection_init%category=l4f_category_get(a_name)
3773ier=idba_error_set_callback(0,c_funloc(dballe_error_handler), &
3774 dbaconnection_init%category,dbaconnection_init%handle_err)
3775if (.not. c_e(optio_i(idbhandle)))
then
3778 IF (
PRESENT(dsn))
THEN
3779 IF (c_e(dsn)) quidsn = dsn
3782 ier=idba_presentati(dbaconnection_init%dbhandle,quidsn)
3784 dbaconnection_init%dbhandle=optio_i(idbhandle)
3787end function dbaconnection_init
3790subroutine dbaconnection_delete(handle)
3791#ifdef F2003_FULL_FEATURES
3792type (dbaconnection),
intent(inout) :: handle
3799if (c_e(handle%dbhandle))
then
3800 ier = idba_arrivederci(handle%dbhandle)
3801 ier = idba_error_remove_callback(handle%handle_err)
3804end subroutine dbaconnection_delete
3808recursive type(
dbasession) function dbasession_init(connection,anaflag, dataflag, attrflag,&
3809 filename,mode,format,template,write,wipe,repinfo,simplified,memdb,loadfile,categoryappend)
3811character (len=*),
intent(in),
optional :: anaflag
3812character (len=*),
intent(in),
optional :: dataflag
3813character (len=*),
intent(in),
optional :: attrflag
3814character (len=*),
intent(in),
optional :: filename
3815character (len=*),
intent(in),
optional :: mode
3816character (len=*),
intent(in),
optional :: template
3817logical,
INTENT(in),
OPTIONAL :: write
3818logical,
INTENT(in),
OPTIONAL :: wipe
3819character(len=*),
INTENT(in),
OPTIONAL :: repinfo
3820character(len=*),
intent(in),
optional :: format
3821logical,
intent(in),
optional :: simplified
3822logical,
intent(in),
optional :: memdb
3823logical,
intent(in),
optional :: loadfile
3824character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
3827character (len=5) :: lanaflag,ldataflag,lattrflag
3828character (len=1) :: lmode
3829logical :: lwrite,lwipe
3830character(len=255) :: lrepinfo
3831character(len=40) :: lformat
3832logical :: exist,lsimplified,read_next,lfile,lmemdb,lloadfile
3833character(len=512) :: a_name
3834character(len=40) :: ltemplate
3842if (
present(categoryappend))
then
3843 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
3845 call l4f_launcher(a_name,a_name_append=trim(subcategory))
3847dbasession_init%category=l4f_category_get(a_name)
3851if (
present(write))
then
3857if (
present(wipe))
then
3859 if (
present(repinfo))
then
3868if (
present(template))
then
3875if (
present(simplified))
then
3876 lsimplified=simplified
3880if (
present(format))
then
3886if (
present(filename))
then
3890 IF (filename ==
'')
THEN
3894 INQUIRE(file=filename,exist=exist)
3898 if (lwipe.or..not.exist)
then
3902 call l4f_category_log(dbasession_init%category,l4f_info,
"file exists; appending data to file")
3905 if (.not.exist)
then
3906 call l4f_category_log(dbasession_init%category,l4f_error,
"file does not exist; cannot open file for read")
3907 CALL raise_fatal_error()
3911 if (
present(mode)) lmode = mode
3913 if (.not.
present(memdb))
then
3914 dbasession_init%memdb=.true.
3917 if (.not.
present(loadfile))
then
3918 dbasession_init%loadfile=.true.
3923if (
present(memdb))
then
3927if (
present(loadfile))
then
3932call optio(anaflag,lanaflag)
3933if (.not. c_e(lanaflag))
then
3941call optio(dataflag,ldataflag)
3942if (.not. c_e(ldataflag))
then
3950call optio(attrflag,lattrflag)
3951if (.not. c_e(lattrflag))
then
3967 if (
present(anaflag).or.
present(dataflag).or.
present( attrflag))
then
3968 call l4f_category_log(dbasession_init%category,l4f_error,
"option anaflag, dataflag, attrflag defined with filename access")
3974 if(.not.
present(connection))
then
3975 call l4f_category_log(dbasession_init%category,l4f_error,
"connection not present accessing DBA")
3979 if (
present(mode).or.
present(format).or.
present(template).or.
present(simplified))
then
3980 call l4f_category_log(dbasession_init%category,l4f_error,&
3981 "option mode or format or template or simplified defined without filename")
3989if (
present(filename))
then
3991 if (.not.
present(connection))
then
3995 dbasession_init=
dbasession(dbasession_init%memconnection,&
3996 write=.true.,wipe=lwrite,repinfo=lrepinfo,&
3997 memdb=lmemdb,loadfile=lloadfile)
4000 dbasession_init%memconnection=connection
4002 dbasession_init=
dbasession(dbasession_init%memconnection,&
4003 write=.true.,wipe=lwrite,repinfo=lrepinfo,&
4004 memdb=lmemdb,loadfile=lloadfile)
4008 if (lmode ==
"r")
then
4009 call dbasession_init%messages_open_input(filename=filename,mode=lmode,&
4010 format=lformat,simplified=lsimplified)
4013 read_next = dbasession_init%messages_read_next()
4014 do while (read_next)
4015 read_next = dbasession_init%messages_read_next()
4020 call dbasession_init%messages_open_output(filename=filename,&
4021 mode=lmode,format=lformat)
4027 ier = idba_messaggi(dbasession_init%sehandle,filename, lmode, lformat)
4033 ier = idba_preparati(connection%dbhandle,dbasession_init%sehandle, lanaflag, ldataflag, lattrflag)
4034 if (lwipe)ier=idba_scopa(dbasession_init%sehandle,lrepinfo)
4038dbasession_init%file=lfile
4039if (dbasession_init%file) dbasession_init%filename=filename
4040dbasession_init%mode=lmode
4041dbasession_init%format=lformat
4042dbasession_init%simplified=lsimplified
4043dbasession_init%memdb=lmemdb
4044dbasession_init%loadfile=lloadfile
4045dbasession_init%template=ltemplate
4058end function dbasession_init
4062subroutine dbasession_unsetall(session)
4066if (c_e(session%sehandle))
then
4067 ier = idba_unsetall(session%sehandle)
4070end subroutine dbasession_unsetall
4074subroutine dbasession_remove_all(session)
4078if (c_e(session%sehandle))
then
4079 ier = idba_remove_all(session%sehandle)
4082end subroutine dbasession_remove_all
4086subroutine dbasession_prendilo(session)
4090if (c_e(session%sehandle))
then
4091 ier = idba_prendilo(session%sehandle)
4094end subroutine dbasession_prendilo
4097subroutine dbasession_var_related(session,btable)
4099character(len=*),
INTENT(IN) :: btable
4102if (c_e(session%sehandle))
then
4103 ier = idba_set(session%sehandle,
"*var_related",btable)
4106end subroutine dbasession_var_related
4109subroutine dbasession_setcontextana(session)
4113if (c_e(session%sehandle))
then
4114 ier = idba_setcontextana(session%sehandle)
4117end subroutine dbasession_setcontextana
4120subroutine dbasession_dimenticami(session)
4124if (c_e(session%sehandle))
then
4125 ier = idba_dimenticami(session%sehandle)
4128end subroutine dbasession_dimenticami
4131subroutine dbasession_critica(session)
4135if (c_e(session%sehandle))
then
4136 ier = idba_critica(session%sehandle)
4139end subroutine dbasession_critica
4142subroutine dbasession_scusa(session)
4146if (c_e(session%sehandle))
then
4147 ier = idba_scusa(session%sehandle)
4150end subroutine dbasession_scusa
4153subroutine dbasession_set(session,metadata,datav,data,datetime,ana,network,level,timerange,filter)
4156class(
dbadcv),
optional :: datav
4157class(
dbadata),
optional :: data
4159type (
dbaana),
optional :: ana
4165if (
present(metadata))
then
4166 call metadata%dbaset(session)
4169if (
present(datetime))
then
4170 call datetime%dbaset(session)
4173if (
present(ana))
then
4174 call ana%dbaset(session)
4177if (
present(network))
then
4178 call network%dbaset(session)
4181if (
present(level))
then
4182 call level%dbaset(session)
4185if (
present(timerange))
then
4186 call timerange%dbaset(session)
4189if (
present(datav))
then
4190 call datav%dbaset(session)
4193if (
present(data))
then
4194 call data%dbaset(session)
4197if (
present(filter))
then
4198 call filter%dbaset(session)
4201end subroutine dbasession_set
4359# ifndef F2003_FULL_FEATURES
4361subroutine dbasession_delete(session)
4366if (c_e(session%sehandle))
then
4367 ier = idba_fatto(session%sehandle)
4370call session%memconnection%delete()
4372select type (session)
4374 session = defsession
4388end subroutine dbasession_delete
4393subroutine dbasession_delete(session)
4394type (dbasession),
intent(inout) :: session
4397if (c_e(session%sehandle))
then
4398 ier = idba_fatto(session%sehandle)
4412end subroutine dbasession_delete
4419subroutine dbasession_filerewind(session)
4423if (c_e(session%sehandle).and. session%file)
then
4424 ier = idba_fatto(session%sehandle)
4425 ier = idba_messaggi(session%sehandle,session%filename,session%mode,session%format)
4435end subroutine dbasession_filerewind
4438FUNCTION dballe_error_handler(category)
4439INTEGER :: category, code, l4f_level
4440INTEGER :: dballe_error_handler
4442CHARACTER(len=1000) :: message, buf
4444code = idba_error_code()
4447if (code == 13 )
then
4453call idba_error_message(message)
4454call l4f_category_log(category,l4f_level,trim(message))
4456call idba_error_context(buf)
4458call l4f_category_log(category,l4f_level,trim(buf))
4460call idba_error_details(buf)
4461call l4f_category_log(category,l4f_info,trim(buf))
4465if (l4f_level == l4f_error )
CALL raise_fatal_error(
"dballe: "//message)
4467dballe_error_handler = 0
4470END FUNCTION dballe_error_handler