89 use vol7d_serialize_dballe_class
93 character (len=255),
parameter:: subcategory=
"vol7d_dballe_class"
105 type(dbaconnection) :: idbhandle
106 type(dbasession) :: handle
109 integer ,
pointer :: data_id(:,:,:,:,:)
110 integer :: time_definition
111 integer :: category = 0
116 INTEGER,
PARAMETER,
PRIVATE :: nftype = 2
117 CHARACTER(len=16),
PARAMETER,
PRIVATE :: &
118 pathlist(2,nftype) = reshape((/ &
119 '/usr/share ',
'/usr/local/share', &
120 '/etc ',
'/usr/local/etc ' /), &
124 type(vol7d_var),
allocatable,
private :: blocal(:)
126 CHARACTER(len=20),
PRIVATE :: dballe_name=
'wreport', dballe_name_env=
'DBA_TABLES'
131 MODULE PROCEDURE vol7d_dballe_init
136 MODULE PROCEDURE vol7d_dballe_delete
142 MODULE PROCEDURE vol7d_dballe_importvvnv,vol7d_dballe_import, vol7d_dballe_import_old, dba2v7d
147 MODULE PROCEDURE vol7d_dballe_export_old,vol7d_dballe_export, v7d2dba
158 SUBROUTINE vol7d_dballe_init(this,dsn,user,password,write,wipe,repinfo,&
159 filename,format,file,categoryappend,time_definition,idbhandle,template)
162 TYPE(vol7d_dballe),
INTENT(out) :: this
163 character(len=*),
INTENT(in),
OPTIONAL :: dsn
164 character(len=*),
INTENT(in),
OPTIONAL :: user
165 character(len=*),
INTENT(in),
OPTIONAL :: password
166 logical,
INTENT(in),
OPTIONAL :: write
167 logical,
INTENT(in),
OPTIONAL :: wipe
168 character(len=*),
INTENT(in),
OPTIONAL :: repinfo
169 character(len=*),
intent(inout),
optional :: filename
170 character(len=*),
intent(in),
optional :: format
171 logical,
INTENT(in),
OPTIONAL :: file
172 character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
173 integer,
INTENT(in),
OPTIONAL :: time_definition
174 integer,
INTENT(in),
OPTIONAL :: idbhandle
177 character(len=*),
intent(in),
optional :: template
179 logical :: quiwrite,loadfile
180 character(len=512) :: a_name
181 character(len=254) :: arg,lfilename,lformat
184 if (
present(write))
then
188 if (
present(categoryappend))
then
189 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
191 call l4f_launcher(a_name,a_name_append=trim(subcategory))
193 this%category=l4f_category_get(a_name)
199 nullify(this%data_id)
201 if (optio_log(file))
then
206 if (
present(format))
then
212 lfilename=trim(arg)//
"."//trim(lformat)
213 if (
index(arg,
'/',back=.true.) > 0) lfilename=lfilename(
index(arg,
'/',back=.true.)+1 : )
215 if (
present(filename))
then
216 if (
c_e(filename))
then
228 this%handle=
dbasession(wipe=wipe,write=quiwrite,repinfo=repinfo, &
229 filename=lfilename,format=lformat,template=template, &
230 memdb=.true.,loadfile=loadfile)
235 this%idbhandle=
dbaconnection(dsn,user,password,idbhandle=idbhandle)
236 this%handle=
dbasession(this%idbhandle,wipe=wipe,write=quiwrite,repinfo=repinfo)
244 CALL init(this%vol7d, time_definition)
245 this%time_definition = optio_i(time_definition)
251 END SUBROUTINE vol7d_dballe_init
259 SUBROUTINE vol7d_dballe_importvvnv(this, var, network, coordmin,coordmax, timei, timef, level,timerange,set_network,&
260 attr,anavar,anaattr, varkind,attrkind,anavarkind,anaattrkind,anaonly,dataonly,ana)
261 TYPE(vol7d_dballe),
INTENT(inout) :: this
262 CHARACTER(len=*),
INTENT(in) :: var(:)
263 TYPE(geo_coord),
INTENT(inout),
optional :: coordmin,coordmax
264 TYPE(vol7d_ana),
INTENT(inout),
optional :: ana
265 TYPE(datetime),
INTENT(in),
optional :: timei, timef
266 TYPE(vol7d_network),
INTENT(in) :: network(:)
267 TYPE(vol7d_network),
INTENT(in),
OPTIONAL :: set_network
268 TYPE(vol7d_level),
INTENT(in),
optional :: level
269 TYPE(vol7d_timerange),
INTENT(in),
optional :: timerange
270 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: attr(:),anavar(:),anaattr(:)
271 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: varkind(:),attrkind(:),anavarkind(:),anaattrkind(:)
272 logical,
intent(in),
optional :: anaonly
273 LOGICAL,
INTENT(in),
OPTIONAL :: dataonly
274 TYPE(vol7d_dballe) :: v7ddbatmp
278 IF (
SIZE(network) == 0 )
THEN
279 CALL import(this, var, coordmin=coordmin, coordmax=coordmax, timei=timei, &
280 timef=timef, level=level, timerange=timerange, set_network=set_network, &
281 attr=attr, anavar=anavar, anaattr=anaattr, varkind=varkind, attrkind=attrkind, &
282 anavarkind=anavarkind, anaattrkind=anaattrkind, anaonly=anaonly, &
283 dataonly=dataonly, ana=ana)
285 CALL init(this%vol7d)
287 DO i = 1,
SIZE(network)
288 CALL import(v7ddbatmp, var, network(i), coordmin, coordmax, timei, timef, &
289 level,timerange, set_network, attr,anavar,anaattr, varkind, attrkind, &
290 anavarkind, anaattrkind, anaonly, dataonly, ana)
291 CALL vol7d_merge(this%vol7d, v7ddbatmp%vol7d,
sort=.true.)
295 END SUBROUTINE vol7d_dballe_importvvnv
298 SUBROUTINE vol7d_dballe_import_old(this, var, network, coordmin, coordmax, timei, timef,level,timerange, set_network,&
299 attr,anavar,anaattr, varkind,attrkind,anavarkind,anaattrkind,anaonly,dataonly,ana)
301 TYPE(vol7d_dballe),
INTENT(inout) :: this
302 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: var(:)
303 TYPE(
geo_coord),
INTENT(inout),
optional :: coordmin,coordmax
304 TYPE(vol7d_ana),
INTENT(inout),
optional :: ana
305 TYPE(datetime),
INTENT(in),
OPTIONAL :: timei, timef
306 TYPE(vol7d_network),
INTENT(in),
OPTIONAL :: network,set_network
307 TYPE(vol7d_level),
INTENT(in),
optional :: level
308 TYPE(vol7d_timerange),
INTENT(in),
optional :: timerange
309 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: attr(:),anavar(:),anaattr(:)
310 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: varkind(:),attrkind(:),anavarkind(:),anaattrkind(:)
311 logical,
intent(in),
optional :: anaonly
312 logical,
intent(in),
optional :: dataonly
315 INTEGER,
PARAMETER :: maxvarlist=100
328 type(dbadcv) :: vars,starvars,anavars,anastarvars
329 type(dbafilter) :: filter
330 type(dbacoord) :: mydbacoordmin, mydbacoordmax
331 type(dbaana) :: mydbaana
332 type(dbadatetime) :: mydatetimemin, mydatetimemax
333 type(dbatimerange) :: mydbatimerange
334 type(dbalevel) :: mydbalevel
335 type(dbanetwork) :: mydbanetwork
337 integer :: nanaattr,nattr
339 character(len=40) :: query
346 IF (
PRESENT(set_network))
THEN
347 if (
c_e(set_network))
then
379 if (
present(var))
then
382 allocate (vars%dcv(nvar))
385 if (
present(varkind))
then
386 select case (varkind(i))
388 allocate (vars%dcv(i)%dat,source=
dbadatar(var(i)))
390 allocate (vars%dcv(i)%dat,source=
dbadatai(var(i)))
392 allocate (vars%dcv(i)%dat,source=
dbadatab(var(i)))
394 allocate (vars%dcv(i)%dat,source=
dbadatad(var(i)))
396 allocate (vars%dcv(i)%dat,source=
dbadatac(var(i)))
399 CALL raise_fatal_error()
402 allocate (vars%dcv(i)%dat,source=
dbadatac(var(i)))
409 if (
present(anavar))
then
410 nanavar=count(
c_e(anavar))
411 if (nanavar > 0)
then
412 allocate (anavars%dcv(nanavar))
414 if (
c_e(anavar(i)))
then
415 if (
present(anavarkind))
then
416 select case (anavarkind(i))
418 allocate (anavars%dcv(i)%dat,source=
dbadatar(anavar(i)))
420 allocate (anavars%dcv(i)%dat,source=
dbadatai(anavar(i)))
422 allocate (anavars%dcv(i)%dat,source=
dbadatab(anavar(i)))
424 allocate (anavars%dcv(i)%dat,source=
dbadatad(anavar(i)))
426 allocate (anavars%dcv(i)%dat,source=
dbadatac(anavar(i)))
428 call l4f_category_log(this%category,l4f_error,
"anavar and anavarkind mismach")
429 CALL raise_fatal_error()
432 allocate (anavars%dcv(i)%dat,source=
dbadatac(anavar(i)))
439 if (
present(attr))
then
442 allocate (starvars%dcv(nattr))
444 nattr=count(
c_e(attr))
446 allocate (starvars%dcv(nattr))
448 if (
c_e(attr(i)))
then
449 if (
present(attrkind))
then
450 select case (attrkind(i))
452 allocate (starvars%dcv(i)%dat,source=
dbadatar(attr(i)))
454 allocate (starvars%dcv(i)%dat,source=
dbadatai(attr(i)))
456 allocate (starvars%dcv(i)%dat,source=
dbadatab(attr(i)))
458 allocate (starvars%dcv(i)%dat,source=
dbadatad(attr(i)))
460 allocate (starvars%dcv(i)%dat,source=
dbadatac(attr(i)))
463 CALL raise_fatal_error()
466 allocate (starvars%dcv(i)%dat,source=
dbadatac(attr(i)))
474 if (
present(anaattr))
then
475 nanaattr=
size(anaattr)
476 if (nanaattr == 0)
then
477 allocate (anastarvars%dcv(nanaattr))
479 nanaattr=count(
c_e(anaattr))
480 if (nanaattr > 0)
then
481 allocate (anastarvars%dcv(nanaattr))
483 if (
c_e(anaattr(i)))
then
484 if (
present(anaattrkind))
then
485 select case (anaattrkind(i))
487 allocate (anastarvars%dcv(i)%dat,source=
dbadatar(anaattr(i)))
489 allocate (anastarvars%dcv(i)%dat,source=
dbadatai(anaattr(i)))
491 allocate (anastarvars%dcv(i)%dat,source=
dbadatab(anaattr(i)))
493 allocate (anastarvars%dcv(i)%dat,source=
dbadatad(anaattr(i)))
495 allocate (anastarvars%dcv(i)%dat,source=
dbadatac(anaattr(i)))
498 CALL raise_fatal_error()
501 allocate (anastarvars%dcv(i)%dat,source=
dbadatac(anaattr(i)))
512 if (
present(coordmin)) mydbacoordmin%geo_coord=coordmin
514 if (
present(coordmax)) mydbacoordmax%geo_coord=coordmax
516 if (
present(ana)) mydbaana%vol7d_ana=ana
518 if (
present(timei)) mydatetimemin%datetime=timei
520 if (
present(timef)) mydatetimemax%datetime=timef
522 if (
present(timerange)) mydbatimerange%vol7d_timerange=timerange
524 if (
present(level)) mydbalevel%vol7d_level=level
526 if (
present(network)) mydbanetwork%vol7d_network=network
531 filter=
dbafilter(coordmin=mydbacoordmin,coordmax=mydbacoordmax,ana=mydbaana, &
532 datetimemin=mydatetimemin,datetimemax=mydatetimemax, &
533 timerange=mydbatimerange,level=mydbalevel,network=mydbanetwork,query=query,&
534 vars=vars,starvars=starvars,anavars=anavars,anastarvars=anastarvars,&
535 dataonly=dataonly,anaonly=anaonly)
539 call import(this,filter,set_network)
542 END SUBROUTINE vol7d_dballe_import_old
547 subroutine vol7d_dballe_import(this,filter,set_network)
551 TYPE(vol7d_network),
INTENT(in),
OPTIONAL :: set_network
553 TYPE(
vol7d) :: vol7dtmp
559 .not.
if ( filter%dataonly) then
560 ! ----------------> constant station data
561 myfilter=dbafilter(filter=filter,contextana=.TRUE.,query=cmiss)
563 ! call this%handle%set(filter=myfilter)
565 CALL l4f_category_log(this%category,L4F_DEBUG,'start
import vol7d_dballe ingest for constant station data
')
566 ! call this%handle%ingest(filter=myfilter)
567 call this%handle%ingest(metaanddatav,filter=myfilter)
568 CALL l4f_category_log(this%category,L4F_DEBUG,'end
import vol7d_dballe ingest
')
569 CALL l4f_category_log(this%category,L4F_DEBUG,'start
import vol7d_dballe dba2v7d
')
570 call dba2v7d(this%vol7d, metaanddatav,this%time_definition,set_network)
571 CALL l4f_category_log(this%category,L4F_DEBUG,'end
import vol7d_dballe dba2v7d
')
573 deallocate (metaanddatav)
577 call init(this%vol7d)
578 call vol7d_alloc(this%vol7d)
579 call vol7d_alloc_vol(this%vol7d)
581 ! ----------------> constant station data end
583 .not.
if ( filter%anaonly) then
584 ! ----------------> working on data
585 myfilter=dbafilter(filter=filter,contextana=.false.)
587 ! call this%handle%set(filter=myfilter)
590 CALL l4f_category_log(this%category,L4F_DEBUG,'start
import vol7d_dballe ingest for station data
')
591 ! call this%handle%ingest(filter=myfilter)
592 call this%handle%ingest(metaanddatav,filter=myfilter)
593 CALL l4f_category_log(this%category,L4F_DEBUG,'end
import vol7d_dballe ingest
')
594 CALL l4f_category_log(this%category,L4F_DEBUG,'start
import vol7d_dballe dba2v7d
')
595 call dba2v7d(vol7dtmp,metaanddatav,this%time_definition,set_network)
596 CALL l4f_category_log(this%category,L4F_DEBUG,'end
import vol7d_dballe dba2v7d
')
598 deallocate (metaanddatav)
600 CALL vol7d_merge(this%vol7d, vol7dtmp, sort=.TRUE.) ! Smart merge
602 !!$ ! should we sort separately in case no merge is done?
603 !!$ CALL vol7d_smart_sort(this%vol7d, lsort_time=.TRUE., lsort_timerange=.TRUE., lsort_level=.TRUE.)
606 call vol7d_dballe_set_var_du(this%vol7d)
613 !!$ allocate (this%data_id( nana, ntime, nlevel, ntimerange, nnetwork),stat=istat)
614 !!$ if (istat/= 0) THEN
615 !!$ CALL l4f_category_log(this%category,L4F_ERROR,'cannot allocate
' &
616 !!$ //TRIM(to_char(nana*ntime*nlevel*ntimerange*nnetwork))//' data_id elements
')
617 !!$ CALL raise_fatal_error()
621 !!$ this%data_id=DBA_MVI
625 nullify(this%data_id)
632 !CALL l4f_category_log(this%category,L4F_DEBUG,"data_id: "//trim(to_char(buffer(i)%data_id)))
635 this%data_id(indana,indtime,indlevel,indtimerange,indnetwork)=buffer(i)%data_id
638 ier=idba_set (this%handle,"*context_id",buffer(i)%data_id)
639 ier=idba_set (this%handle,"*var_related",buffer(i)%btable)
640 !per ogni dato ora lavoro sugli attributi
641 ier=idba_set(this%handle, "*varlist",starvarlist )
642 ier=idba_voglioancora (this%handle,nn)
643 !print*,buffer(i)%btable," numero attributi",nn
647 CALL l4f_category_log(this%category,L4F_DEBUG,'end
import vol7d_dballe')
649 importend subroutine vol7d_dballe_
653 !>\brief Cancella l'oggetto
!>\brief Cancella l'
655 SUBROUTINE vol7d_dballe_delete(this, preserveidbhandle)
656 TYPE(vol7d_dballe) :: this !< oggetto da cancellare
657 logical,intent(in), optional :: preserveidbhandle !< do not close connection to dsn
659 # ifndef F2003_FULL_FEATURES
660 call this%handle%delete()
662 .not.
if ( optio_log(preserveidbhandle)) call this%idbhandle%delete()
665 !!$if (associated(this%data_id)) then
666 !!$ deallocate (this%data_id)
667 !!$ nullify(this%data_id)
670 CALL delete(this%vol7d)
673 call l4f_category_delete(this%category)
676 END SUBROUTINE vol7d_dballe_delete
680 import dba objects in
vol7d !>\brief
681 !subroutine dba2v7d(this,metaanddatav,vars,starvars,anavars,anastarvars,time_definition, set_network)
682 subroutine dba2v7d(this,metaanddatav,time_definition, set_network)
684 type(dbametaanddata),intent(inout) :: metaanddatav(:) ! change value in datetime reguard timedefinition
685 TYPE(vol7d),INTENT(inout) :: this
686 integer,INTENT(in),OPTIONAL :: time_definition !< 0=time is reference time ; 1=time is validity time (default=1)
687 TYPE(vol7d_network),INTENT(in),OPTIONAL :: set_network
689 type(dbadcv) :: starvars
690 type(dbadcv) :: anavars
691 type(dbadcv) :: anastarvars
695 integer :: indana,indtime,indlevel,indtimerange,inddativar,indnetwork,indattrvar
697 integer :: nana,ntime,ntimerange,nlevel,nnetwork
699 INTEGER :: i, j, k, n
700 integer :: inddativarattr
701 integer :: nanavar, indanavar,indanavarattr,nanavarattr
703 integer :: ndativarr, ndativari, ndativarb, ndativard, ndativarc
704 integer :: ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc
705 integer :: ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc
707 integer :: nanavarr, nanavari, nanavarb, nanavard, nanavarc
708 integer :: nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc
709 integer :: nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
711 integer :: ndativar,ndativarattr
713 type(characterlist) :: dativarl,dativarattrl,anavarl,anavarattrl
715 character(len=listcharmaxlen),allocatable :: dativara(:),dativarattra(:),anavara(:),anavarattra(:)
717 integer :: ltime_definition
719 type(datetime),allocatable :: tmptime(:)
720 type(vol7d_network),allocatable :: tmpnetwork(:)
721 type(vol7d_level),allocatable :: tmplevel(:)
722 type(vol7d_timerange),allocatable :: tmptimerange(:)
723 type(vol7d_ana),allocatable :: tmpana(:)
726 ltime_definition=optio_i(time_definition)
727 .not.
if ( c_e(ltime_definition)) ltime_definition = 1
729 ! take in account time_definition
730 if (ltime_definition == 0) then
731 do i =1,size(metaanddatav)
732 metaanddatav(i)%metadata%datetime%datetime = &
733 metaanddatav(i)%metadata%datetime%datetime - &
734 timedelta_new(sec=metaanddatav(i)%metadata%timerange%vol7d_timerange%p1)
739 IF (PRESENT(set_network)) THEN
740 if (c_e(set_network)) then
751 !!--------------------------------------------------------------------------
752 !! find vars, starvars, anavars, anastarvars
755 ! create lists of all
757 do i =1, size(metaanddatav)
758 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
759 if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
760 !print *,"dativarl: ", metaanddatav(i)%dataattrv%dataattr(j)%dat%btable
761 call dativarl%append(metaanddatav(i)%dataattrv%dataattr(j)%dat%btable)
763 !print *,"anavarl: ", metaanddatav(i)%dataattrv%dataattr(j)%dat%btable
764 call anavarl%append(metaanddatav(i)%dataattrv%dataattr(j)%dat%btable)
769 !count and put in vector of unuique key
770 ndativar = count_distinct (toarray_charl(dativarl) , back=.TRUE.)
771 allocate(dativara(ndativar))
772 call pack_distinct_c (toarray_charl(dativarl) , dativara , back=.TRUE.)
773 status = dativarl%delete()
774 allocate (vars%dcv(ndativar))
776 nanavar = count_distinct (toarray_charl(anavarl) , back=.TRUE.)
777 allocate(anavara(nanavar))
778 call pack_distinct_c (toarray_charl(anavarl) , anavara , back=.TRUE.)
779 status = anavarl%delete()
780 allocate (anavars%dcv(nanavar))
784 do i =1, size(metaanddatav)
785 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
786 if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
787 if (metaanddatav(i)%dataattrv%dataattr(j)%dat%btable == dativara(n)) then
788 allocate(vars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%dat)
797 do i =1, size(metaanddatav)
798 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
799 .not.
if ( c_e(metaanddatav(i)%metadata%datetime%datetime)) then
800 if (metaanddatav(i)%dataattrv%dataattr(j)%dat%btable == anavara(n)) then
801 allocate(anavars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%dat)
810 do i =1, size(metaanddatav)
811 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
812 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
813 if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
814 !print *,"dativarattrl: ", metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable
815 call dativarattrl%append(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable)
817 !print *,"anavarattrl: ", metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable
818 call anavarattrl%append(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable)
825 ndativarattr = count_distinct (toarray_charl(dativarattrl), back=.TRUE.)
826 allocate(dativarattra(ndativarattr))
827 call pack_distinct_c (toarray_charl(dativarattrl), dativarattra, back=.TRUE.)
828 status = dativarattrl%delete()
829 allocate(starvars%dcv(ndativarattr))
831 nanavarattr = count_distinct (toarray_charl(anavarattrl) , back=.TRUE.)
832 allocate(anavarattra(nanavarattr))
833 call pack_distinct_c (toarray_charl(anavarattrl) , anavarattra , back=.TRUE.)
834 status = anavarattrl%delete()
835 allocate(anastarvars%dcv(nanavarattr))
838 cn: do n=1,ndativarattr
839 do i =1, size(metaanddatav)
840 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
841 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
842 if (c_e(metaanddatav(i)%metadata%datetime%datetime)) then
843 if (metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable == dativarattra(n))then
844 allocate(starvars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
854 dn: do n=1,nanavarattr
855 do i =1, size(metaanddatav)
856 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
857 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
858 .not.
if ( c_e(metaanddatav(i)%metadata%datetime%datetime)) then
859 if (metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable == anavarattra(n))then
860 allocate(anastarvars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
870 !!--------------------------------------------------------------------------
874 !! count all unique metadata
880 !nnetwork = count_distinct(metaanddatav(:)%metadata%network%vol7d_network, back=.TRUE.)
881 allocate (tmpnetwork(size(metaanddatav(:))),&
882 source=metaanddatav(:)%metadata%network%vol7d_network)
883 call sort(tmpnetwork)
884 nnetwork = count_distinct_sorted(tmpnetwork)
887 !ntime = count_distinct(metaanddatav(:)%metadata%datetime%datetime, &
888 ! mask=c_e(metaanddatav(:)%metadata%datetime%datetime),back=.TRUE.)
889 allocate (tmptime(size(metaanddatav(:))),&
890 source=metaanddatav(:)%metadata%datetime%datetime)
892 ntime = count_distinct_sorted(tmptime,mask=c_e(tmptime))
894 !ntimerange = count_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange, &
895 ! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
896 allocate (tmptimerange(size(metaanddatav(:))),&
897 source=metaanddatav(:)%metadata%timerange%vol7d_timerange)
898 call sort(tmptimerange)
899 ntimerange = count_distinct_sorted(tmptimerange,mask=c_e(tmptimerange))
901 !nlevel = count_distinct(metaanddatav(:)%metadata%level%vol7d_level, &
902 ! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level),back=.TRUE.)
903 allocate (tmplevel(size(metaanddatav(:))),&
904 source=metaanddatav(:)%metadata%level%vol7d_level)
906 nlevel = count_distinct_sorted(tmplevel,mask=c_e(tmplevel))
908 !nana = count_distinct(metaanddatav(:)%metadata%ana%vol7d_ana, back=.TRUE.)
909 allocate (tmpana(size(metaanddatav(:))),&
910 source=metaanddatav(:)%metadata%ana%vol7d_ana)
912 nana = count_distinct_sorted(tmpana)
917 !!$ nnetwork = size(metaanddatav(:)%metadata%network%vol7d_network)
919 !!$ntime = size(metaanddatav(:)%metadata%datetime%datetime)
920 !!$ntimerange = size(metaanddatav(:)%metadata%timerange%vol7d_timerange)
921 !!$nlevel = size(metaanddatav(:)%metadata%level%vol7d_level)
922 !!$nana = size(metaanddatav(:)%metadata%ana%vol7d_ana)
932 do i =1 ,size(vars%dcv)
933 associate (dato => vars%dcv(i)%dat)
936 ndativarr = ndativarr + 1
938 ndativari = ndativari + 1
940 ndativarb = ndativarb + 1
942 ndativard = ndativard + 1
944 ndativarc = ndativarc + 1
958 do i =1 ,size(starvars%dcv)
959 associate (dato => starvars%dcv(i)%dat)
962 ndatiattrr = ndatiattrr + 1
964 ndatiattri = ndatiattri + 1
966 ndatiattrb = ndatiattrb + 1
968 ndatiattrd = ndatiattrd + 1
970 ndatiattrc = ndatiattrc + 1
984 do i =1 ,size(anavars%dcv)
985 associate (dato => anavars%dcv(i)%dat)
988 nanavarr = nanavarr + 1
990 nanavari = nanavari + 1
992 nanavarb = nanavarb + 1
994 nanavard = nanavard + 1
996 nanavarc = nanavarc + 1
1010 do i =1 ,size(anastarvars%dcv)
1011 associate (dato => anastarvars%dcv(i)%dat)
1014 nanaattrr = nanaattrr + 1
1016 nanaattri = nanaattri + 1
1018 nanaattrb = nanaattrb + 1
1020 nanaattrd = nanaattrd + 1
1022 nanaattrc = nanaattrc + 1
1036 if (ndatiattrr > 0 ) ndativarattrr=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1037 if (ndatiattri > 0 ) ndativarattri=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1038 if (ndatiattrb > 0 ) ndativarattrb=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1039 if (ndatiattrd > 0 ) ndativarattrd=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1040 if (ndatiattrc > 0 ) ndativarattrc=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1049 if (nanaattrr > 0 ) nanavarattrr=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1050 if (nanaattri > 0 ) nanavarattri=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1051 if (nanaattrb > 0 ) nanavarattrb=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1052 if (nanaattrd > 0 ) nanavarattrd=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1053 if (nanaattrc > 0 ) nanavarattrc=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1056 CALL init(this,time_definition=ltime_definition)
1058 !!$print *, "nana=",nana, "ntime=",ntime, "ntimerange=",ntimerange, &
1059 !!$ "nlevel=",nlevel, "nnetwork=",nnetwork, &
1060 !!$ "ndativarr=",ndativarr, "ndativari=",ndativari, &
1061 !!$ "ndativarb=",ndativarb, "ndativard=",ndativard, "ndativarc=",ndativarc,&
1062 !!$ "ndatiattrr=",ndatiattrr, "ndatiattri=",ndatiattri, "ndatiattrb=",ndatiattrb,&
1063 !!$ "ndatiattrd=",ndatiattrd, "ndatiattrc=",ndatiattrc,&
1064 !!$ "ndativarattrr=",ndativarattrr, "ndativarattri=",ndativarattri, "ndativarattrb=",ndativarattrb,&
1065 !!$ "ndativarattrd=",ndativarattrd, "ndativarattrc=",ndativarattrc
1067 !!$print *,"nanaattrr,nanaattri,nanaattrb,nanaattrd,nanaattrc"
1068 !!$print *,nanaattrr,nanaattri,nanaattrb,nanaattrd,nanaattrc
1071 call vol7d_alloc (this, &
1072 nana=nana, ntime=ntime, ntimerange=ntimerange, &
1073 nlevel=nlevel, nnetwork=nnetwork, &
1074 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb, ndativard=ndativard, ndativarc=ndativarc,&
1075 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb, ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
1076 ndativarattrr=ndativarattrr, &
1077 ndativarattri=ndativarattri, &
1078 ndativarattrb=ndativarattrb, &
1079 ndativarattrd=ndativarattrd, &
1080 ndativarattrc=ndativarattrc,&
1081 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, nanavard=nanavard, nanavarc=nanavarc,&
1082 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb, nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
1083 nanavarattrr=nanavarattrr, &
1084 nanavarattri=nanavarattri, &
1085 nanavarattrb=nanavarattrb, &
1086 nanavarattrd=nanavarattrd, &
1087 nanavarattrc=nanavarattrc)
1090 ! fill metadata removing contextana metadata
1092 !nana=count_and_pack_distinct(metaanddatav(:)%metadata%ana%vol7d_ana,this%ana, back=.TRUE.)
1093 !this%ana=pack_distinct(metaanddatav(:)%metadata%ana%vol7d_ana, nana, back=.TRUE.)
1094 this%ana=pack_distinct_sorted(tmpana, nana)
1096 !call sort(this%ana)
1098 !ntime=count_and_pack_distinct(metaanddatav(:)%metadata%datetime%datetime,this%time, &
1099 ! mask=c_e(metaanddatav(:)%metadata%datetime%datetime), back=.TRUE.)
1100 !this%time=pack_distinct(metaanddatav(:)%metadata%datetime%datetime, ntime, &
1101 ! mask=c_e(metaanddatav(:)%metadata%datetime%datetime),back=.TRUE.)
1102 this%time=pack_distinct_sorted(tmptime, ntime,mask=c_e(tmptime))
1104 !call sort(this%time)
1106 !ntimerange=count_and_pack_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange,this%timerange, &
1107 ! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
1108 !this%timerange=pack_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange, ntimerange, &
1109 ! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
1110 this%timerange=pack_distinct_sorted(tmptimerange, ntimerange,mask=c_e(tmptimerange))
1111 deallocate(tmptimerange)
1112 !call sort(this%timerange)
1114 !nlevel=count_and_pack_distinct(metaanddatav(:)%metadata%level%vol7d_level,this%level, &
1115 ! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level), back=.TRUE.)
1116 !this%level=pack_distinct(metaanddatav(:)%metadata%level%vol7d_level, nlevel, &
1117 ! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level), back=.TRUE.)
1118 this%level=pack_distinct_sorted(tmplevel, nlevel,mask=c_e(tmplevel))
1119 deallocate(tmplevel)
1120 !call sort(this%level)
1124 ALLOCATE(this%network(1))
1125 this%network(1)=set_network
1127 !nnetwork=count_and_pack_distinct(metaanddatav(:)%metadata%network%vol7d_network,this%network, back=.TRUE.)
1128 !this%network=pack_distinct(metaanddatav(:)%metadata%network%vol7d_network, nnetwork, back=.TRUE.)
1129 this%network=pack_distinct_sorted(tmpnetwork, nnetwork)
1130 deallocate(tmpnetwork)
1132 !call sort(this%network)
1142 do i =1 ,size(vars%dcv)
1143 associate (dato => vars%dcv(i)%dat)
1146 ndativarr = ndativarr + 1
1147 call init (this%dativar%r(ndativarr), btable=dato%btable)
1149 ndativari = ndativari + 1
1150 call init (this%dativar%i(ndativari), btable=dato%btable)
1152 ndativarb = ndativarb + 1
1153 call init (this%dativar%b(ndativarb), btable=dato%btable)
1155 ndativard = ndativard + 1
1156 call init (this%dativar%d(ndativard), btable=dato%btable)
1158 ndativarc = ndativarc + 1
1159 call init (this%dativar%c(ndativarc), btable=dato%btable)
1173 do i =1 ,size(starvars%dcv)
1174 associate (dato => starvars%dcv(i)%dat)
1177 ndatiattrr = ndatiattrr + 1
1178 call init (this%datiattr%r(ndatiattrr), btable=dato%btable)
1180 ndatiattri = ndatiattri + 1
1181 call init (this%datiattr%i(ndatiattri), btable=dato%btable)
1183 ndatiattrb = ndatiattrb + 1
1184 call init (this%datiattr%b(ndatiattrb), btable=dato%btable)
1186 ndatiattrd = ndatiattrd + 1
1187 call init (this%datiattr%d(ndatiattrd), btable=dato%btable)
1189 ndatiattrc = ndatiattrc + 1
1190 call init (this%datiattr%c(ndatiattrc), btable=dato%btable)
1204 do i =1 ,size(anavars%dcv)
1205 associate (dato => anavars%dcv(i)%dat)
1208 nanavarr = nanavarr + 1
1209 call init (this%anavar%r(nanavarr), btable=dato%btable)
1211 nanavari = nanavari + 1
1212 call init (this%anavar%i(nanavari), btable=dato%btable)
1214 nanavarb = nanavarb + 1
1215 call init (this%anavar%b(nanavarb), btable=dato%btable)
1217 nanavard = nanavard + 1
1218 call init (this%anavar%d(nanavard), btable=dato%btable)
1220 nanavarc = nanavarc + 1
1221 call init (this%anavar%c(nanavarc), btable=dato%btable)
1235 do i =1 ,size(anastarvars%dcv)
1236 associate (dato => anastarvars%dcv(i)%dat)
1239 nanaattrr = nanaattrr + 1
1240 call init (this%anaattr%r(nanaattrr), btable=dato%btable)
1242 nanaattri = nanaattri + 1
1243 call init (this%anaattr%i(nanaattri), btable=dato%btable)
1245 nanaattrb = nanaattrb + 1
1246 call init (this%anaattr%b(nanaattrb), btable=dato%btable)
1248 nanaattrd = nanaattrd + 1
1249 call init (this%anaattr%d(nanaattrd), btable=dato%btable)
1251 nanaattrc = nanaattrc + 1
1252 call init (this%anaattr%c(nanaattrc), btable=dato%btable)
1258 ! here we colcolate the link from attributes and vars
1259 do i =1, size(vars%dcv)
1260 associate (dato => vars%dcv(i)%dat)
1261 if ( ndativarattri > 0 ) call init(this%dativarattr%i(i),btable=dato%btable)
1262 if ( ndativarattrr > 0 ) call init(this%dativarattr%r(i),btable=dato%btable)
1263 if ( ndativarattrd > 0 ) call init(this%dativarattr%d(i),btable=dato%btable)
1264 if ( ndativarattrb > 0 ) call init(this%dativarattr%b(i),btable=dato%btable)
1265 if ( ndativarattrc > 0 ) call init(this%dativarattr%c(i),btable=dato%btable)
1269 do i =1, size(anavars%dcv)
1270 associate (dato => anavars%dcv(i)%dat)
1271 if ( nanavarattri > 0 ) call init(this%anavarattr%i(i),btable=dato%btable)
1272 if ( nanavarattrr > 0 ) call init(this%anavarattr%r(i),btable=dato%btable)
1273 if ( nanavarattrd > 0 ) call init(this%anavarattr%d(i),btable=dato%btable)
1274 if ( nanavarattrb > 0 ) call init(this%anavarattr%b(i),btable=dato%btable)
1275 if ( nanavarattrc > 0 ) call init(this%anavarattr%c(i),btable=dato%btable)
1279 ! set index in dativaratt*
1280 call vol7d_set_attr_ind(this)
1282 call vol7d_alloc_vol (this)
1284 ! Ora qui bisogna metterci dentro idati
1291 do i =1, size(metaanddatav)
1293 indana = INDEX_sorted(this%ana, metaanddatav(i)%metadata%ana%vol7d_ana)
1298 indnetwork = INDEX_sorted(this%network, metaanddatav(i)%metadata%network%vol7d_network)
1301 .and.
if (c_e(metaanddatav(i)%metadata%datetime%datetime) &
1302 .and.
c_e(metaanddatav(i)%metadata%timerange%vol7d_timerange) &
1303 c_e(metaanddatav(i)%metadata%level%vol7d_level) ) then ! dati
1305 indtime = INDEX_sorted(this%time, metaanddatav(i)%metadata%datetime%datetime)
1306 indtimerange = INDEX_sorted(this%timerange, metaanddatav(i)%metadata%timerange%vol7d_timerange)
1307 indlevel = INDEX_sorted(this%level, metaanddatav(i)%metadata%level%vol7d_level)
1309 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
1311 associate (dato => metaanddatav(i)%dataattrv%dataattr(j)%dat)
1314 inddativar = firsttrue(dato%btable == this%dativar%i%btable)
1316 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1320 inddativar = firsttrue(dato%btable == this%dativar%r%btable)
1322 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1326 inddativar = firsttrue(dato%btable == this%dativar%d%btable)
1328 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1332 inddativar = firsttrue(dato%btable == this%dativar%b%btable)
1334 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1338 inddativar = firsttrue(dato%btable == this%dativar%c%btable)
1340 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1347 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
1348 associate (attr => metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
1352 inddativarattr = firsttrue(dato%btable == this%dativarattr%i%btable)
1353 indattrvar = firsttrue(attr%btable == this%datiattr%i%btable)
1354 this%voldatiattri( &
1355 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
1358 inddativarattr = firsttrue(dato%btable == this%dativarattr%r%btable)
1359 indattrvar = firsttrue(attr%btable == this%datiattr%r%btable)
1360 this%voldatiattrr( &
1361 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
1364 inddativarattr = firsttrue(dato%btable == this%dativarattr%d%btable)
1365 indattrvar = firsttrue(attr%btable == this%datiattr%d%btable)
1366 this%voldatiattrd( &
1367 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
1370 inddativarattr = firsttrue(dato%btable == this%dativarattr%b%btable)
1371 indattrvar = firsttrue(attr%btable == this%datiattr%b%btable)
1372 this%voldatiattrb( &
1373 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
1376 inddativarattr = firsttrue(dato%btable == this%dativarattr%c%btable)
1377 indattrvar = firsttrue(attr%btable == this%datiattr%c%btable)
1378 this%voldatiattrc( &
1379 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
1390 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
1392 associate (dato => metaanddatav(i)%dataattrv%dataattr(j)%dat)
1395 indanavar = firsttrue(dato%btable == this%anavar%i%btable)
1397 indana,indanavar,indnetwork &
1401 indanavar = firsttrue(dato%btable == this%anavar%r%btable)
1403 indana,indanavar,indnetwork &
1407 indanavar = firsttrue(dato%btable == this%anavar%d%btable)
1409 indana,indanavar,indnetwork &
1413 indanavar = firsttrue(dato%btable == this%anavar%b%btable)
1415 indana,indanavar,indnetwork &
1419 indanavar = firsttrue(dato%btable == this%anavar%c%btable)
1421 indana,indanavar,indnetwork &
1428 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
1429 associate (attr => metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
1433 indanavarattr = firsttrue(dato%btable == this%anavarattr%i%btable)
1434 indattrvar = firsttrue(attr%btable == this%anaattr%i%btable)
1436 indana,indanavarattr,indnetwork,indattrvar &
1439 indanavarattr = firsttrue(dato%btable == this%anavarattr%r%btable)
1440 indattrvar = firsttrue(attr%btable == this%anaattr%r%btable)
1442 indana,indanavarattr,indnetwork,indattrvar &
1445 indanavarattr = firsttrue(dato%btable == this%anavarattr%d%btable)
1446 indattrvar = firsttrue(attr%btable == this%anaattr%d%btable)
1448 indana,indanavarattr,indnetwork,indattrvar &
1451 indanavarattr = firsttrue(dato%btable == this%anavarattr%b%btable)
1452 indattrvar = firsttrue(attr%btable == this%anaattr%b%btable)
1454 indana,indanavarattr,indnetwork,indattrvar &
1457 indanavarattr = firsttrue(dato%btable == this%anavarattr%c%btable)
1458 indattrvar = firsttrue(attr%btable == this%anaattr%c%btable)
1460 indana,indanavarattr,indnetwork,indattrvar &
1473 !!$!> /brief Return an dbadcv from a mixlist with dbadata* type
1474 !!$function todcv_dbadat(this)
1475 !!$type(dbadcv) :: todcv_dbadat !< array
1476 !!$type(mixlist) :: this
1480 !!$allocate (todcv_dbadat%dcv(this%countelements()))
1482 !!$call this%rewind()
1484 !!$do while(this%element())
1487 !!$ associate (dato => this%current())
1488 !!$ select type (dato)
1489 !!$ type is (dbadatar)
1490 !!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
1491 !!$ type is (dbadatai)
1492 !!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
1493 !!$ type is (dbadatab)
1494 !!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
1495 !!$ type is (dbadatad)
1496 !!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
1497 !!$ type is (dbadatac)
1498 !!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
1502 !!$ call this%next()
1504 !!$end function todcv_dbadat
1506 !!$! Definisce le funzioni count_distinct e pack_distinct
1507 !!$#define VOL7D_POLY_TYPE TYPE(dbadata)
1508 !!$#define VOL7D_POLY_TYPES _dbadata
1509 !!$#undef ENABLE_SORT
1510 !!$#include "array_utilities_inc.F90"
1511 !!$#undef VOL7D_POLY_TYPE
1512 !!$#undef VOL7D_POLY_TYPES
1515 end subroutine dba2v7d
1518 subroutine vol7d_dballe_import_dballevar(this)
1520 type(vol7d_var),pointer :: this(:)
1523 IF (associated(this)) return
1524 IF (allocated(blocal)) then
1525 ALLOCATE(this(size(blocal)))
1530 un = open_dballe_file('dballe.txt
', filetype_data)
1533 call l4f_log(L4F_ERROR,"error open_dballe_file: dballe.txt")
1534 CALL raise_error("error open_dballe_file: dballe.txt")
1549 readline: do i = 1 ,n
1550 READ(un,'(1x,a6,1x,a65,a24,i4)
')blocal(i)%btable,blocal(i)%description,blocal(i)%unit,&
1551 blocal(i)%scalefactor
1552 blocal(i)%btable(:1)="B"
1553 !print*,"B=",blocal(i)%btable
1554 !print*," D=",blocal(i)%description
1555 !PRINT*," U=",blocal(i)%unit
1556 !PRINT*," D=",blocal(i)%scalefactor
1559 CALL l4f_log(L4F_INFO,'found
'//TRIM(to_char(i-1))//' variables in dballe master table
')
1566 END SUBROUTINE vol7d_dballe_import_dballevar
1570 à
!> \brief Integra il vettore delle variabili in vol7d con le descrizioni e le unit di misura
1571 !!eventualmente mancanti.
1573 subroutine vol7d_dballe_set_var_du(this)
1575 TYPE(vol7d) :: this !< oggetto vol7d con le variabili da completare
1577 type(vol7d_var),pointer :: dballevar(:)
1580 call vol7d_dballe_import_dballevar(dballevar)
1582 #undef VOL7D_POLY_NAME
1583 #define VOL7D_POLY_NAME dativar
1586 #undef VOL7D_POLY_TYPES_V
1587 #define VOL7D_POLY_TYPES_V r
1588 #include "vol7d_dballe_class_var_du.F90"
1589 #undef VOL7D_POLY_TYPES_V
1590 #define VOL7D_POLY_TYPES_V i
1591 #include "vol7d_dballe_class_var_du.F90"
1592 #undef VOL7D_POLY_TYPES_V
1593 #define VOL7D_POLY_TYPES_V b
1594 #include "vol7d_dballe_class_var_du.F90"
1595 #undef VOL7D_POLY_TYPES_V
1596 #define VOL7D_POLY_TYPES_V d
1597 #include "vol7d_dballe_class_var_du.F90"
1598 #undef VOL7D_POLY_TYPES_V
1599 #define VOL7D_POLY_TYPES_V c
1600 #include "vol7d_dballe_class_var_du.F90"
1601 #undef VOL7D_POLY_TYPES_V
1603 #undef VOL7D_POLY_NAME
1604 #define VOL7D_POLY_NAME anavar
1607 #undef VOL7D_POLY_TYPES_V
1608 #define VOL7D_POLY_TYPES_V r
1609 #include "vol7d_dballe_class_var_du.F90"
1610 #undef VOL7D_POLY_TYPES_V
1611 #define VOL7D_POLY_TYPES_V i
1612 #include "vol7d_dballe_class_var_du.F90"
1613 #undef VOL7D_POLY_TYPES_V
1614 #define VOL7D_POLY_TYPES_V b
1615 #include "vol7d_dballe_class_var_du.F90"
1616 #undef VOL7D_POLY_TYPES_V
1617 #define VOL7D_POLY_TYPES_V d
1618 #include "vol7d_dballe_class_var_du.F90"
1619 #undef VOL7D_POLY_TYPES_V
1620 #define VOL7D_POLY_TYPES_V c
1621 #include "vol7d_dballe_class_var_du.F90"
1622 #undef VOL7D_POLY_TYPES_V
1625 #undef VOL7D_POLY_NAME
1626 #define VOL7D_POLY_NAME datiattr
1629 #undef VOL7D_POLY_TYPES_V
1630 #define VOL7D_POLY_TYPES_V r
1631 #include "vol7d_dballe_class_var_du.F90"
1632 #undef VOL7D_POLY_TYPES_V
1633 #define VOL7D_POLY_TYPES_V i
1634 #include "vol7d_dballe_class_var_du.F90"
1635 #undef VOL7D_POLY_TYPES_V
1636 #define VOL7D_POLY_TYPES_V b
1637 #include "vol7d_dballe_class_var_du.F90"
1638 #undef VOL7D_POLY_TYPES_V
1639 #define VOL7D_POLY_TYPES_V d
1640 #include "vol7d_dballe_class_var_du.F90"
1641 #undef VOL7D_POLY_TYPES_V
1642 #define VOL7D_POLY_TYPES_V c
1643 #include "vol7d_dballe_class_var_du.F90"
1644 #undef VOL7D_POLY_TYPES_V
1647 #undef VOL7D_POLY_NAME
1648 #define VOL7D_POLY_NAME anaattr
1651 #undef VOL7D_POLY_TYPES_V
1652 #define VOL7D_POLY_TYPES_V r
1653 #include "vol7d_dballe_class_var_du.F90"
1654 #undef VOL7D_POLY_TYPES_V
1655 #define VOL7D_POLY_TYPES_V i
1656 #include "vol7d_dballe_class_var_du.F90"
1657 #undef VOL7D_POLY_TYPES_V
1658 #define VOL7D_POLY_TYPES_V b
1659 #include "vol7d_dballe_class_var_du.F90"
1660 #undef VOL7D_POLY_TYPES_V
1661 #define VOL7D_POLY_TYPES_V d
1662 #include "vol7d_dballe_class_var_du.F90"
1663 #undef VOL7D_POLY_TYPES_V
1664 #define VOL7D_POLY_TYPES_V c
1665 #include "vol7d_dballe_class_var_du.F90"
1666 #undef VOL7D_POLY_TYPES_V
1669 deallocate(dballevar)
1673 end subroutine vol7d_dballe_set_var_du
1677 FUNCTION get_dballe_filepath(filename, filetype) RESULT(path)
1678 CHARACTER(len=*), INTENT(in) :: filename
1679 INTEGER, INTENT(in) :: filetype
1682 CHARACTER(len=512) :: path
1685 IF (dballe_name == ' ') THEN
1686 CALL getarg(0, dballe_name)
1690 .OR.
IF (filetype < 1 filetype > nftype) THEN
1692 CALL l4f_log(L4F_ERROR, 'dballe file
type '//TRIM(to_char(filetype))// &
1698 ! try with environment variable
1699 CALL getenv(TRIM(dballe_name_env), path)
1700 IF (path /= ' ') THEN
1702 path=TRIM(path)//'/
'//filename
1703 INQUIRE(file=path, exist=exist)
1705 CALL l4f_log(L4F_INFO, 'dballe file
'//TRIM(path)//' found
')
1710 DO j = 1, SIZE(pathlist,1)
1711 IF (pathlist(j,filetype) == ' ') EXIT
1712 path=TRIM(pathlist(j,filetype))//'/
'//TRIM(dballe_name)//'/
'//filename
1713 INQUIRE(file=path, exist=exist)
1715 CALL l4f_log(L4F_INFO, 'dballe file
'//TRIM(path)//' found
')
1719 CALL l4f_log(L4F_ERROR, 'dballe file
'//TRIM(filename)//' not found
')
1723 END FUNCTION get_dballe_filepath
1726 FUNCTION open_dballe_file(filename, filetype) RESULT(unit)
1727 CHARACTER(len=*), INTENT(in) :: filename
1728 INTEGER, INTENT(in) :: filetype
1731 CHARACTER(len=512) :: path
1734 path=get_dballe_filepath(filename, filetype)
1735 IF (path == '') RETURN
1738 IF (unit == -1) RETURN
1740 OPEN(unit, file=path, status='old
', iostat = i)
1742 CALL l4f_log(L4F_INFO, 'dballe file
'//TRIM(path)//' opened
')
1746 CALL l4f_log(L4F_ERROR, 'dballe file
'//TRIM(filename)//' not found
')
1750 END FUNCTION open_dballe_file
1753 !> \brief Exporta un volume dati a un DSN DB-all.e
1755 à
!! Riscrive i dati nel DSN di DB-All.e con la possibilit di attivare
1756 !! una serie di filtri.
1759 !!! TODO manage attr_only
1760 !!! attention template migrated in init
1761 !SUBROUTINE vol7d_dballe_export(this, network, coordmin, coordmax,&
1762 ! timei, timef,level,timerange,var,attr,anavar,anaattr,attr_only,ana,dataonly)
1764 SUBROUTINE vol7d_dballe_export_old(this, network, coordmin, coordmax,&
1765 timei, timef,level,timerange,var,attr,anavar,anaattr,ana,dataonly,anaonly,template,attr_only)
1767 TYPE(vol7d_dballe),INTENT(inout) :: this !< oggetto contenente il volume e altre info per l'accesso al dsn
1768 character(len=network_name_len),
INTENT(in),
optional :: network
1771 TYPE(
geo_coord),
INTENT(in),
optional :: coordmin,coordmax
1773 TYPE(datetime),
INTENT(in),
optional :: timei, timef
1774 TYPE(vol7d_level),
INTENT(in),
optional :: level
1775 TYPE(vol7d_timerange),
INTENT(in),
optional :: timerange
1778 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: var(:),attr(:),anavar(:),anaattr(:)
1783 TYPE(vol7d_ana),
INTENT(inout),
optional :: ana
1784 logical,
intent(in),
optional :: dataonly
1785 logical,
intent(in),
optional :: anaonly
1788 character(len=*),
intent(in),
optional :: template
1789 logical,
intent(in),
optional :: attr_only
1792 type(
dbadcv) :: vars,starvars,anavars,anastarvars
1794 type(
dbacoord) :: mydbacoordmin, mydbacoordmax
1802 LOGICAL :: lattr, lanaattr
1803 integer :: nanaattr,nattr,nanavar,nvar
1812 if (
present(var))
then
1813 nvar=count(
c_e(var))
1815 allocate (vars%dcv(nvar))
1817 if (
c_e(var(i)))
then
1818 allocate (vars%dcv(i)%dat,source=
dbadatac(var(i)))
1824 if (
present(anavar))
then
1825 nanavar=count(
c_e(anavar))
1826 if (nanavar > 0)
then
1827 allocate (anavars%dcv(nanavar))
1829 if (
c_e(anavar(i)))
then
1830 allocate (anavars%dcv(i)%dat,source=
dbadatac(anavar(i)))
1837 if (
present(attr))
then
1838 nattr=count(
c_e(attr))
1841 allocate (starvars%dcv(nattr))
1843 if (
c_e(attr(i)))
then
1844 allocate (starvars%dcv(i)%dat,source=
dbadatac(attr(i)))
1851 if (
present(anaattr))
then
1852 nanaattr=count(
c_e(anaattr))
1853 if (nanaattr > 0)
then
1855 allocate (anastarvars%dcv(nanaattr))
1856 do i=1,
size(anaattr)
1857 if (
c_e(anaattr(i)))
then
1858 allocate (anastarvars%dcv(i)%dat,source=
dbadatac(anaattr(i)))
1867 if (
present(coordmin)) mydbacoordmin%geo_coord=coordmin
1869 if (
present(coordmax)) mydbacoordmax%geo_coord=coordmax
1871 if (
present(ana)) mydbaana%vol7d_ana=ana
1873 if (
present(timei)) mydatetimemin%datetime=timei
1875 if (
present(timef)) mydatetimemax%datetime=timef
1877 if (
present(timerange)) mydbatimerange%vol7d_timerange=timerange
1879 if (
present(level)) mydbalevel%vol7d_level=level
1881 if (
present(network))
call init(mydbanetwork%vol7d_network,name=network)
1886 filter=
dbafilter(coordmin=mydbacoordmin,coordmax=mydbacoordmax,ana=mydbaana, &
1887 datetimemin=mydatetimemin,datetimemax=mydatetimemax, &
1888 timerange=mydbatimerange,level=mydbalevel,network=mydbanetwork,&
1889 vars=vars,starvars=starvars,anavars=anavars,anastarvars=anastarvars,&
1890 dataonly=dataonly,anaonly=anaonly)
1895 call export (this, filter,template,attr_only)
1897 end SUBROUTINE vol7d_dballe_export_old
1900 subroutine vol7d_dballe_export (this, filter, template, attr_only)
1906 character(len=*),
intent(in),
optional :: template
1907 logical,
intent(in),
optional :: attr_only
1909 character(len=40) :: ltemplate
1916 call v7d2dba(this%vol7d,metaanddatal)
1920 if (this%file)
call this%handle%remove_all()
1923 call metaanddatal%extrude(session=this%handle,filter=filter,attronly=attr_only,template=template)
1936 call filter%dbaset(this%handle)
1938 ltemplate=this%handle%template
1939 if (
present(template))
then
1943 call this%handle%messages_write_next(ltemplate)
1946 call this%handle%remove_all()
1950 stat = metaanddatal%delete()
1952 end subroutine vol7d_dballe_export
1955 subroutine v7d2dba(v7d,metaanddatal)
1956 TYPE(
vol7d),
INTENT(in) :: v7d
1959 TYPE(vol7d_serialize_dballe) :: serialize
1961 serialize = vol7d_serialize_dballe_new()
1962 serialize%anaonly=.true.
1963 call serialize%vol7d_serialize_setup(v7d)
1964 call serialize%vol7d_serialize_export(metaanddatal)
1966 serialize = vol7d_serialize_dballe_new()
1967 serialize%dataonly=.true.
1968 call serialize%vol7d_serialize_setup(v7d)
1969 call serialize%vol7d_serialize_export(metaanddatal)
1971 end subroutine v7d2dba
Emit log message for a category with specific priority.
Test for a missing volume.
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
character version for dbadata
doubleprecision version for dbadata
integer version for dbadata
vector of container of dbadata
filter to apply before ingest data
Derived type defining an isolated georeferenced point on Earth in polar geographical coordinates.
Definisce un oggetto contenente i volumi anagrafica e dati e tutti i descrittori delle loro dimension...
Oggetto per import ed export da DB-All.e.