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,filename=lfilename,template=template,&
229 memdb=.true.,loadfile=loadfile)
234 this%idbhandle=
dbaconnection(dsn,user,password,idbhandle=idbhandle)
235 this%handle=
dbasession(this%idbhandle,wipe=wipe,write=quiwrite,repinfo=repinfo)
239 this%time_definition = optio_i(time_definition)
245 END SUBROUTINE vol7d_dballe_init
253 SUBROUTINE vol7d_dballe_importvvnv(this, var, network, coordmin,coordmax, timei, timef, level,timerange,set_network,&
254 attr,anavar,anaattr, varkind,attrkind,anavarkind,anaattrkind,anaonly,dataonly,ana)
255 TYPE(vol7d_dballe),
INTENT(inout) :: this
256 CHARACTER(len=*),
INTENT(in) :: var(:)
257 TYPE(geo_coord),
INTENT(inout),
optional :: coordmin,coordmax
258 TYPE(vol7d_ana),
INTENT(inout),
optional :: ana
259 TYPE(datetime),
INTENT(in),
optional :: timei, timef
260 TYPE(vol7d_network),
INTENT(in) :: network(:)
261 TYPE(vol7d_network),
INTENT(in),
OPTIONAL :: set_network
262 TYPE(vol7d_level),
INTENT(in),
optional :: level
263 TYPE(vol7d_timerange),
INTENT(in),
optional :: timerange
264 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: attr(:),anavar(:),anaattr(:)
265 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: varkind(:),attrkind(:),anavarkind(:),anaattrkind(:)
266 logical,
intent(in),
optional :: anaonly
267 LOGICAL,
INTENT(in),
OPTIONAL :: dataonly
268 TYPE(vol7d_dballe) :: v7ddbatmp
272 IF (
SIZE(network) == 0 )
THEN 273 CALL import(this, var, coordmin=coordmin, coordmax=coordmax, timei=timei, &
274 timef=timef, level=level, timerange=timerange, set_network=set_network, &
275 attr=attr, anavar=anavar, anaattr=anaattr, varkind=varkind, attrkind=attrkind, &
276 anavarkind=anavarkind, anaattrkind=anaattrkind, anaonly=anaonly, &
277 dataonly=dataonly, ana=ana)
279 CALL init(this%vol7d)
281 DO i = 1,
SIZE(network)
282 CALL import(v7ddbatmp, var, network(i), coordmin, coordmax, timei, timef, &
283 level,timerange, set_network, attr,anavar,anaattr, varkind, attrkind, &
284 anavarkind, anaattrkind, anaonly, dataonly, ana)
285 CALL vol7d_merge(this%vol7d, v7ddbatmp%vol7d,
sort=.true.)
289 END SUBROUTINE vol7d_dballe_importvvnv
292 SUBROUTINE vol7d_dballe_import_old(this, var, network, coordmin, coordmax, timei, timef,level,timerange, set_network,&
293 attr,anavar,anaattr, varkind,attrkind,anavarkind,anaattrkind,anaonly,dataonly,ana)
295 TYPE(vol7d_dballe),
INTENT(inout) :: this
296 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: var(:)
297 TYPE(geo_coord),
INTENT(inout),
optional :: coordmin,coordmax
298 TYPE(vol7d_ana),
INTENT(inout),
optional :: ana
299 TYPE(datetime),
INTENT(in),
OPTIONAL :: timei, timef
300 TYPE(vol7d_network),
INTENT(in),
OPTIONAL :: network,set_network
301 TYPE(vol7d_level),
INTENT(in),
optional :: level
302 TYPE(vol7d_timerange),
INTENT(in),
optional :: timerange
303 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: attr(:),anavar(:),anaattr(:)
304 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: varkind(:),attrkind(:),anavarkind(:),anaattrkind(:)
305 logical,
intent(in),
optional :: anaonly
306 logical,
intent(in),
optional :: dataonly
309 INTEGER,
PARAMETER :: maxvarlist=100
322 type(
dbadcv) :: vars,starvars,anavars,anastarvars
331 integer :: nanaattr,nattr
333 character(len=40) :: query
340 IF (
PRESENT(set_network))
THEN 341 if (
c_e(set_network))
then 373 if (
present(var))
then 376 allocate (vars%dcv(nvar))
379 if (
present(varkind))
then 380 select case (varkind(i))
382 allocate (vars%dcv(i)%dat,source=
dbadatar(var(i)))
384 allocate (vars%dcv(i)%dat,source=
dbadatai(var(i)))
386 allocate (vars%dcv(i)%dat,source=
dbadatab(var(i)))
388 allocate (vars%dcv(i)%dat,source=
dbadatad(var(i)))
390 allocate (vars%dcv(i)%dat,source=
dbadatac(var(i)))
393 CALL raise_fatal_error()
396 allocate (vars%dcv(i)%dat,source=
dbadatac(var(i)))
403 if (
present(anavar))
then 404 nanavar=count(
c_e(anavar))
405 if (nanavar > 0)
then 406 allocate (anavars%dcv(nanavar))
408 if (
c_e(anavar(i)))
then 409 if (
present(anavarkind))
then 410 select case (anavarkind(i))
412 allocate (anavars%dcv(i)%dat,source=
dbadatar(anavar(i)))
414 allocate (anavars%dcv(i)%dat,source=
dbadatai(anavar(i)))
416 allocate (anavars%dcv(i)%dat,source=
dbadatab(anavar(i)))
418 allocate (anavars%dcv(i)%dat,source=
dbadatad(anavar(i)))
420 allocate (anavars%dcv(i)%dat,source=
dbadatac(anavar(i)))
422 call l4f_category_log(this%category,l4f_error,
"anavar and anavarkind mismach")
423 CALL raise_fatal_error()
426 allocate (anavars%dcv(i)%dat,source=
dbadatac(anavar(i)))
433 if (
present(attr))
then 436 allocate (starvars%dcv(nattr))
438 nattr=count(
c_e(attr))
440 allocate (starvars%dcv(nattr))
442 if (
c_e(attr(i)))
then 443 if (
present(attrkind))
then 444 select case (attrkind(i))
446 allocate (starvars%dcv(i)%dat,source=
dbadatar(attr(i)))
448 allocate (starvars%dcv(i)%dat,source=
dbadatai(attr(i)))
450 allocate (starvars%dcv(i)%dat,source=
dbadatab(attr(i)))
452 allocate (starvars%dcv(i)%dat,source=
dbadatad(attr(i)))
454 allocate (starvars%dcv(i)%dat,source=
dbadatac(attr(i)))
457 CALL raise_fatal_error()
460 allocate (starvars%dcv(i)%dat,source=
dbadatac(attr(i)))
468 if (
present(anaattr))
then 469 nanaattr=
size(anaattr)
470 if (nanaattr == 0)
then 471 allocate (anastarvars%dcv(nanaattr))
473 nanaattr=count(
c_e(anaattr))
474 if (nanaattr > 0)
then 475 allocate (anastarvars%dcv(nanaattr))
477 if (
c_e(anaattr(i)))
then 478 if (
present(anaattrkind))
then 479 select case (anaattrkind(i))
481 allocate (anastarvars%dcv(i)%dat,source=
dbadatar(anaattr(i)))
483 allocate (anastarvars%dcv(i)%dat,source=
dbadatai(anaattr(i)))
485 allocate (anastarvars%dcv(i)%dat,source=
dbadatab(anaattr(i)))
487 allocate (anastarvars%dcv(i)%dat,source=
dbadatad(anaattr(i)))
489 allocate (anastarvars%dcv(i)%dat,source=
dbadatac(anaattr(i)))
492 CALL raise_fatal_error()
495 allocate (anastarvars%dcv(i)%dat,source=
dbadatac(anaattr(i)))
506 if (
present(coordmin)) mydbacoordmin%geo_coord=coordmin
508 if (
present(coordmax)) mydbacoordmax%geo_coord=coordmax
510 if (
present(ana)) mydbaana%vol7d_ana=ana
512 if (
present(timei)) mydatetimemin%datetime=timei
514 if (
present(timef)) mydatetimemax%datetime=timef
516 if (
present(timerange)) mydbatimerange%vol7d_timerange=timerange
518 if (
present(level)) mydbalevel%vol7d_level=level
520 if (
present(network)) mydbanetwork%vol7d_network=network
525 filter=
dbafilter(coordmin=mydbacoordmin,coordmax=mydbacoordmax,ana=mydbaana, &
526 datetimemin=mydatetimemin,datetimemax=mydatetimemax, &
527 timerange=mydbatimerange,level=mydbalevel,network=mydbanetwork,query=query,&
528 vars=vars,starvars=starvars,anavars=anavars,anastarvars=anastarvars,&
529 dataonly=dataonly,anaonly=anaonly)
533 call import(this,filter,set_network)
536 END SUBROUTINE vol7d_dballe_import_old
541 subroutine vol7d_dballe_import(this,filter,set_network)
543 TYPE(vol7d_dballe),
INTENT(inout) :: this
544 type(dbafilter),
INTENT(in) :: filter
545 TYPE(vol7d_network),
INTENT(in),
OPTIONAL :: set_network
547 TYPE(vol7d) :: vol7dtmp
548 type(dbametaanddata),
allocatable :: metaanddatav(:)
549 type(dbafilter) :: myfilter
553 if ( .not. filter%dataonly)
then 555 myfilter=
dbafilter(filter=filter,contextana=.true.,query=cmiss)
559 CALL l4f_category_log(this%category,l4f_debug,
'start import vol7d_dballe ingest for constant station data')
561 call this%handle%ingest(metaanddatav,filter=myfilter)
562 CALL l4f_category_log(this%category,l4f_debug,
'end import vol7d_dballe ingest')
563 CALL l4f_category_log(this%category,l4f_debug,
'start import vol7d_dballe dba2v7d')
564 call dba2v7d(this%vol7d, metaanddatav,this%time_definition,set_network)
565 CALL l4f_category_log(this%category,l4f_debug,
'end import vol7d_dballe dba2v7d')
567 deallocate (metaanddatav)
571 call init(this%vol7d)
572 call vol7d_alloc(this%vol7d)
573 call vol7d_alloc_vol(this%vol7d)
577 if ( .not. filter%anaonly)
then 579 myfilter=
dbafilter(filter=filter,contextana=.false.)
584 CALL l4f_category_log(this%category,l4f_debug,
'start import vol7d_dballe ingest for station data')
586 call this%handle%ingest(metaanddatav,filter=myfilter)
587 CALL l4f_category_log(this%category,l4f_debug,
'end import vol7d_dballe ingest')
588 CALL l4f_category_log(this%category,l4f_debug,
'start import vol7d_dballe dba2v7d')
589 call dba2v7d(vol7dtmp,metaanddatav,this%time_definition,set_network)
590 CALL l4f_category_log(this%category,l4f_debug,
'end import vol7d_dballe dba2v7d')
592 deallocate (metaanddatav)
594 CALL vol7d_merge(this%vol7d, vol7dtmp,
sort=.true.)
600 call vol7d_dballe_set_var_du(this%vol7d)
619 nullify(this%data_id)
629 this%data_id(indana,indtime,indlevel,indtimerange,indnetwork)=buffer(i)%data_id
632 ier=idba_set(this%handle,
"*context_id",buffer(i)%data_id)
633 ier=idba_set(this%handle,
"*var_related",buffer(i)%btable)
635 ier=idba_set(this%handle,
"*varlist",starvarlist )
636 ier=idba_voglioancora(this%handle,nn)
643 end subroutine vol7d_dballe_import
649 SUBROUTINE vol7d_dballe_delete(this, preserveidbhandle)
650 TYPE(vol7d_dballe) :: this
651 logical,
intent(in),
optional :: preserveidbhandle
653 call this%handle%delete()
655 if (.not. optio_log(preserveidbhandle))
call this%idbhandle%delete()
665 call l4f_category_delete(this%category)
668 END SUBROUTINE vol7d_dballe_delete
674 subroutine dba2v7d(this,metaanddatav,time_definition, set_network)
676 type(dbametaanddata),
intent(inout) :: metaanddatav(:)
677 TYPE(vol7d),
INTENT(inout) :: this
678 integer,
INTENT(in),
OPTIONAL :: time_definition
679 TYPE(vol7d_network),
INTENT(in),
OPTIONAL :: set_network
681 type(dbadcv) :: starvars
682 type(dbadcv) :: anavars
683 type(dbadcv) :: anastarvars
687 integer :: indana,indtime,indlevel,indtimerange,inddativar,indnetwork,indattrvar
689 integer :: nana,ntime,ntimerange,nlevel,nnetwork
691 INTEGER :: i, j, k, n
692 integer :: inddativarattr
693 integer :: nanavar, indanavar,indanavarattr,nanavarattr
695 integer :: ndativarr, ndativari, ndativarb, ndativard, ndativarc
696 integer :: ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc
697 integer :: ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc
699 integer :: nanavarr, nanavari, nanavarb, nanavard, nanavarc
700 integer :: nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc
701 integer :: nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
703 integer :: ndativar,ndativarattr
705 type(characterlist) :: dativarl,dativarattrl,anavarl,anavarattrl
707 character(len=listcharmaxlen),
allocatable :: dativara(:),dativarattra(:),anavara(:),anavarattra(:)
709 integer :: ltime_definition
711 type(datetime),
allocatable :: tmptime(:)
712 type(vol7d_network),
allocatable :: tmpnetwork(:)
713 type(vol7d_level),
allocatable :: tmplevel(:)
714 type(vol7d_timerange),
allocatable :: tmptimerange(:)
715 type(vol7d_ana),
allocatable :: tmpana(:)
718 ltime_definition=optio_i(time_definition)
719 if (.not.
c_e(ltime_definition)) ltime_definition = 1
722 if (ltime_definition == 0)
then 723 do i =1,
size(metaanddatav)
724 metaanddatav(i)%metadata%datetime%datetime = &
725 metaanddatav(i)%metadata%datetime%datetime - &
726 timedelta_new(sec=metaanddatav(i)%metadata%timerange%vol7d_timerange%p1)
731 IF (
PRESENT(set_network))
THEN 732 if (
c_e(set_network))
then 749 do i =1,
size(metaanddatav)
750 do j=1,
size(metaanddatav(i)%dataattrv%dataattr)
751 if (
c_e(metaanddatav(i)%metadata%datetime%datetime))
then 753 call dativarl%append(metaanddatav(i)%dataattrv%dataattr(j)%dat%btable)
756 call anavarl%append(metaanddatav(i)%dataattrv%dataattr(j)%dat%btable)
762 ndativar = count_distinct(toarray_charl(dativarl) , back=.true.)
763 allocate(dativara(ndativar))
764 call pack_distinct_c (toarray_charl(dativarl) , dativara , back=.true.)
765 status = dativarl%delete()
766 allocate (vars%dcv(ndativar))
768 nanavar = count_distinct(toarray_charl(anavarl) , back=.true.)
769 allocate(anavara(nanavar))
770 call pack_distinct_c (toarray_charl(anavarl) , anavara , back=.true.)
771 status = anavarl%delete()
772 allocate (anavars%dcv(nanavar))
776 do i =1,
size(metaanddatav)
777 do j=1,
size(metaanddatav(i)%dataattrv%dataattr)
778 if (
c_e(metaanddatav(i)%metadata%datetime%datetime))
then 779 if (metaanddatav(i)%dataattrv%dataattr(j)%dat%btable == dativara(n))
then 780 allocate(vars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%dat)
789 do i =1,
size(metaanddatav)
790 do j=1,
size(metaanddatav(i)%dataattrv%dataattr)
791 if (.not.
c_e(metaanddatav(i)%metadata%datetime%datetime))
then 792 if (metaanddatav(i)%dataattrv%dataattr(j)%dat%btable == anavara(n))
then 793 allocate(anavars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%dat)
802 do i =1,
size(metaanddatav)
803 do j=1,
size(metaanddatav(i)%dataattrv%dataattr)
804 do k=1,
size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
805 if (
c_e(metaanddatav(i)%metadata%datetime%datetime))
then 807 call dativarattrl%append(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable)
810 call anavarattrl%append(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable)
817 ndativarattr = count_distinct(toarray_charl(dativarattrl), back=.true.)
818 allocate(dativarattra(ndativarattr))
819 call pack_distinct_c (toarray_charl(dativarattrl), dativarattra, back=.true.)
820 status = dativarattrl%delete()
821 allocate(starvars%dcv(ndativarattr))
823 nanavarattr = count_distinct(toarray_charl(anavarattrl) , back=.true.)
824 allocate(anavarattra(nanavarattr))
825 call pack_distinct_c (toarray_charl(anavarattrl) , anavarattra , back=.true.)
826 status = anavarattrl%delete()
827 allocate(anastarvars%dcv(nanavarattr))
830 cn:
do n=1,ndativarattr
831 do i =1,
size(metaanddatav)
832 do j=1,
size(metaanddatav(i)%dataattrv%dataattr)
833 do k=1,
size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
834 if (
c_e(metaanddatav(i)%metadata%datetime%datetime))
then 835 if (metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable == dativarattra(n))
then 836 allocate(starvars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
846 dn:
do n=1,nanavarattr
847 do i =1,
size(metaanddatav)
848 do j=1,
size(metaanddatav(i)%dataattrv%dataattr)
849 do k=1,
size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
850 if (.not.
c_e(metaanddatav(i)%metadata%datetime%datetime))
then 851 if (metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable == anavarattra(n))
then 852 allocate(anastarvars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
873 allocate (tmpnetwork(
size(metaanddatav(:))),&
874 source=metaanddatav(:)%metadata%network%vol7d_network)
875 call sort(tmpnetwork)
876 nnetwork = count_distinct_sorted(tmpnetwork)
881 allocate (tmptime(
size(metaanddatav(:))),&
882 source=metaanddatav(:)%metadata%datetime%datetime)
884 ntime = count_distinct_sorted(tmptime,mask=
c_e(tmptime))
888 allocate (tmptimerange(
size(metaanddatav(:))),&
889 source=metaanddatav(:)%metadata%timerange%vol7d_timerange)
890 call sort(tmptimerange)
891 ntimerange = count_distinct_sorted(tmptimerange,mask=
c_e(tmptimerange))
895 allocate (tmplevel(
size(metaanddatav(:))),&
896 source=metaanddatav(:)%metadata%level%vol7d_level)
898 nlevel = count_distinct_sorted(tmplevel,mask=
c_e(tmplevel))
901 allocate (tmpana(
size(metaanddatav(:))),&
902 source=metaanddatav(:)%metadata%ana%vol7d_ana)
904 nana = count_distinct_sorted(tmpana)
924 do i =1 ,
size(vars%dcv)
925 associate(dato => vars%dcv(i)%dat)
928 ndativarr = ndativarr + 1
930 ndativari = ndativari + 1
932 ndativarb = ndativarb + 1
934 ndativard = ndativard + 1
936 ndativarc = ndativarc + 1
950 do i =1 ,
size(starvars%dcv)
951 associate(dato => starvars%dcv(i)%dat)
954 ndatiattrr = ndatiattrr + 1
956 ndatiattri = ndatiattri + 1
958 ndatiattrb = ndatiattrb + 1
960 ndatiattrd = ndatiattrd + 1
962 ndatiattrc = ndatiattrc + 1
976 do i =1 ,
size(anavars%dcv)
977 associate(dato => anavars%dcv(i)%dat)
980 nanavarr = nanavarr + 1
982 nanavari = nanavari + 1
984 nanavarb = nanavarb + 1
986 nanavard = nanavard + 1
988 nanavarc = nanavarc + 1
1002 do i =1 ,
size(anastarvars%dcv)
1003 associate(dato => anastarvars%dcv(i)%dat)
1006 nanaattrr = nanaattrr + 1
1008 nanaattri = nanaattri + 1
1010 nanaattrb = nanaattrb + 1
1012 nanaattrd = nanaattrd + 1
1014 nanaattrc = nanaattrc + 1
1028 if (ndatiattrr > 0 ) ndativarattrr=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1029 if (ndatiattri > 0 ) ndativarattri=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1030 if (ndatiattrb > 0 ) ndativarattrb=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1031 if (ndatiattrd > 0 ) ndativarattrd=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1032 if (ndatiattrc > 0 ) ndativarattrc=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1041 if (nanaattrr > 0 ) nanavarattrr=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1042 if (nanaattri > 0 ) nanavarattri=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1043 if (nanaattrb > 0 ) nanavarattrb=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1044 if (nanaattrd > 0 ) nanavarattrd=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1045 if (nanaattrc > 0 ) nanavarattrc=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1048 CALL init(this,time_definition=ltime_definition)
1063 call vol7d_alloc (this, &
1064 nana=nana, ntime=ntime, ntimerange=ntimerange, &
1065 nlevel=nlevel, nnetwork=nnetwork, &
1066 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb, ndativard=ndativard, ndativarc=ndativarc,&
1067 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb, ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
1068 ndativarattrr=ndativarattrr, &
1069 ndativarattri=ndativarattri, &
1070 ndativarattrb=ndativarattrb, &
1071 ndativarattrd=ndativarattrd, &
1072 ndativarattrc=ndativarattrc,&
1073 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, nanavard=nanavard, nanavarc=nanavarc,&
1074 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb, nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
1075 nanavarattrr=nanavarattrr, &
1076 nanavarattri=nanavarattri, &
1077 nanavarattrb=nanavarattrb, &
1078 nanavarattrd=nanavarattrd, &
1079 nanavarattrc=nanavarattrc)
1086 this%ana=pack_distinct_sorted(tmpana, nana)
1094 this%time=pack_distinct_sorted(tmptime, ntime,mask=c_e(tmptime))
1102 this%timerange=pack_distinct_sorted(tmptimerange, ntimerange,mask=c_e(tmptimerange))
1103 deallocate(tmptimerange)
1110 this%level=pack_distinct_sorted(tmplevel, nlevel,mask=c_e(tmplevel))
1111 deallocate(tmplevel)
1116 ALLOCATE(this%network(1))
1117 this%network(1)=set_network
1121 this%network=pack_distinct_sorted(tmpnetwork, nnetwork)
1122 deallocate(tmpnetwork)
1134 do i =1 ,
size(vars%dcv)
1135 associate(dato => vars%dcv(i)%dat)
1138 ndativarr = ndativarr + 1
1139 call init (this%dativar%r(ndativarr), btable=dato%btable)
1141 ndativari = ndativari + 1
1142 call init (this%dativar%i(ndativari), btable=dato%btable)
1144 ndativarb = ndativarb + 1
1145 call init (this%dativar%b(ndativarb), btable=dato%btable)
1147 ndativard = ndativard + 1
1148 call init (this%dativar%d(ndativard), btable=dato%btable)
1150 ndativarc = ndativarc + 1
1151 call init (this%dativar%c(ndativarc), btable=dato%btable)
1165 do i =1 ,
size(starvars%dcv)
1166 associate(dato => starvars%dcv(i)%dat)
1169 ndatiattrr = ndatiattrr + 1
1170 call init (this%datiattr%r(ndatiattrr), btable=dato%btable)
1172 ndatiattri = ndatiattri + 1
1173 call init (this%datiattr%i(ndatiattri), btable=dato%btable)
1175 ndatiattrb = ndatiattrb + 1
1176 call init (this%datiattr%b(ndatiattrb), btable=dato%btable)
1178 ndatiattrd = ndatiattrd + 1
1179 call init (this%datiattr%d(ndatiattrd), btable=dato%btable)
1181 ndatiattrc = ndatiattrc + 1
1182 call init (this%datiattr%c(ndatiattrc), btable=dato%btable)
1196 do i =1 ,
size(anavars%dcv)
1197 associate(dato => anavars%dcv(i)%dat)
1200 nanavarr = nanavarr + 1
1201 call init (this%anavar%r(nanavarr), btable=dato%btable)
1203 nanavari = nanavari + 1
1204 call init (this%anavar%i(nanavari), btable=dato%btable)
1206 nanavarb = nanavarb + 1
1207 call init (this%anavar%b(nanavarb), btable=dato%btable)
1209 nanavard = nanavard + 1
1210 call init (this%anavar%d(nanavard), btable=dato%btable)
1212 nanavarc = nanavarc + 1
1213 call init (this%anavar%c(nanavarc), btable=dato%btable)
1227 do i =1 ,
size(anastarvars%dcv)
1228 associate(dato => anastarvars%dcv(i)%dat)
1231 nanaattrr = nanaattrr + 1
1232 call init (this%anaattr%r(nanaattrr), btable=dato%btable)
1234 nanaattri = nanaattri + 1
1235 call init (this%anaattr%i(nanaattri), btable=dato%btable)
1237 nanaattrb = nanaattrb + 1
1238 call init (this%anaattr%b(nanaattrb), btable=dato%btable)
1240 nanaattrd = nanaattrd + 1
1241 call init (this%anaattr%d(nanaattrd), btable=dato%btable)
1243 nanaattrc = nanaattrc + 1
1244 call init (this%anaattr%c(nanaattrc), btable=dato%btable)
1251 do i =1,
size(vars%dcv)
1252 associate(dato => vars%dcv(i)%dat)
1253 if ( ndativarattri > 0 )
call init(this%dativarattr%i(i),btable=dato%btable)
1254 if ( ndativarattrr > 0 )
call init(this%dativarattr%r(i),btable=dato%btable)
1255 if ( ndativarattrd > 0 )
call init(this%dativarattr%d(i),btable=dato%btable)
1256 if ( ndativarattrb > 0 )
call init(this%dativarattr%b(i),btable=dato%btable)
1257 if ( ndativarattrc > 0 )
call init(this%dativarattr%c(i),btable=dato%btable)
1261 do i =1,
size(anavars%dcv)
1262 associate(dato => anavars%dcv(i)%dat)
1263 if ( nanavarattri > 0 )
call init(this%anavarattr%i(i),btable=dato%btable)
1264 if ( nanavarattrr > 0 )
call init(this%anavarattr%r(i),btable=dato%btable)
1265 if ( nanavarattrd > 0 )
call init(this%anavarattr%d(i),btable=dato%btable)
1266 if ( nanavarattrb > 0 )
call init(this%anavarattr%b(i),btable=dato%btable)
1267 if ( nanavarattrc > 0 )
call init(this%anavarattr%c(i),btable=dato%btable)
1272 call vol7d_set_attr_ind(this)
1274 call vol7d_alloc_vol (this)
1283 do i =1,
size(metaanddatav)
1285 indana = index_sorted(this%ana, metaanddatav(i)%metadata%ana%vol7d_ana)
1290 indnetwork = index_sorted(this%network, metaanddatav(i)%metadata%network%vol7d_network)
1293 if (c_e(metaanddatav(i)%metadata%datetime%datetime) .and. &
1294 c_e(metaanddatav(i)%metadata%timerange%vol7d_timerange) .and. &
1295 c_e(metaanddatav(i)%metadata%level%vol7d_level) )
then 1297 indtime = index_sorted(this%time, metaanddatav(i)%metadata%datetime%datetime)
1298 indtimerange = index_sorted(this%timerange, metaanddatav(i)%metadata%timerange%vol7d_timerange)
1299 indlevel = index_sorted(this%level, metaanddatav(i)%metadata%level%vol7d_level)
1301 do j=1,
size(metaanddatav(i)%dataattrv%dataattr)
1303 associate(dato => metaanddatav(i)%dataattrv%dataattr(j)%dat)
1306 inddativar = firsttrue(dato%btable == this%dativar%i%btable)
1308 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1312 inddativar = firsttrue(dato%btable == this%dativar%r%btable)
1314 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1318 inddativar = firsttrue(dato%btable == this%dativar%d%btable)
1320 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1324 inddativar = firsttrue(dato%btable == this%dativar%b%btable)
1326 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1330 inddativar = firsttrue(dato%btable == this%dativar%c%btable)
1332 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1339 do k=1,
size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
1340 associate(attr => metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
1344 inddativarattr = firsttrue(dato%btable == this%dativarattr%i%btable)
1345 indattrvar = firsttrue(attr%btable == this%datiattr%i%btable)
1346 this%voldatiattri( &
1347 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
1350 inddativarattr = firsttrue(dato%btable == this%dativarattr%r%btable)
1351 indattrvar = firsttrue(attr%btable == this%datiattr%r%btable)
1352 this%voldatiattrr( &
1353 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
1356 inddativarattr = firsttrue(dato%btable == this%dativarattr%d%btable)
1357 indattrvar = firsttrue(attr%btable == this%datiattr%d%btable)
1358 this%voldatiattrd( &
1359 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
1362 inddativarattr = firsttrue(dato%btable == this%dativarattr%b%btable)
1363 indattrvar = firsttrue(attr%btable == this%datiattr%b%btable)
1364 this%voldatiattrb( &
1365 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
1368 inddativarattr = firsttrue(dato%btable == this%dativarattr%c%btable)
1369 indattrvar = firsttrue(attr%btable == this%datiattr%c%btable)
1370 this%voldatiattrc( &
1371 indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,indattrvar &
1382 do j=1,
size(metaanddatav(i)%dataattrv%dataattr)
1384 associate(dato => metaanddatav(i)%dataattrv%dataattr(j)%dat)
1387 indanavar = firsttrue(dato%btable == this%anavar%i%btable)
1389 indana,indanavar,indnetwork &
1393 indanavar = firsttrue(dato%btable == this%anavar%r%btable)
1395 indana,indanavar,indnetwork &
1399 indanavar = firsttrue(dato%btable == this%anavar%d%btable)
1401 indana,indanavar,indnetwork &
1405 indanavar = firsttrue(dato%btable == this%anavar%b%btable)
1407 indana,indanavar,indnetwork &
1411 indanavar = firsttrue(dato%btable == this%anavar%c%btable)
1413 indana,indanavar,indnetwork &
1420 do k=1,
size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
1421 associate(attr => metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
1425 indanavarattr = firsttrue(dato%btable == this%anavarattr%i%btable)
1426 indattrvar = firsttrue(attr%btable == this%anaattr%i%btable)
1428 indana,indanavarattr,indnetwork,indattrvar &
1431 indanavarattr = firsttrue(dato%btable == this%anavarattr%r%btable)
1432 indattrvar = firsttrue(attr%btable == this%anaattr%r%btable)
1434 indana,indanavarattr,indnetwork,indattrvar &
1437 indanavarattr = firsttrue(dato%btable == this%anavarattr%d%btable)
1438 indattrvar = firsttrue(attr%btable == this%anaattr%d%btable)
1440 indana,indanavarattr,indnetwork,indattrvar &
1443 indanavarattr = firsttrue(dato%btable == this%anavarattr%b%btable)
1444 indattrvar = firsttrue(attr%btable == this%anaattr%b%btable)
1446 indana,indanavarattr,indnetwork,indattrvar &
1449 indanavarattr = firsttrue(dato%btable == this%anavarattr%c%btable)
1450 indattrvar = firsttrue(attr%btable == this%anaattr%c%btable)
1452 indana,indanavarattr,indnetwork,indattrvar &
1507 end subroutine dba2v7d
1510 subroutine vol7d_dballe_import_dballevar(this)
1512 type(vol7d_var),
pointer :: this(:)
1515 IF (
associated(this))
return 1516 IF (
allocated(blocal))
then 1517 ALLOCATE(this(
size(blocal)))
1522 un = open_dballe_file(
'dballe.txt', filetype_data)
1525 call l4f_log(l4f_error,
"error open_dballe_file: dballe.txt")
1526 CALL raise_error(
"error open_dballe_file: dballe.txt")
1541 readline:
do i = 1 ,n
1542 READ(un,
'(1x,A6,1x,a65,a24,i4)')blocal(i)%btable,blocal(i)%description,blocal(i)%unit,&
1543 blocal(i)%scalefactor
1544 blocal(i)%btable(:1)=
"B" 1551 CALL l4f_log(l4f_info,
'Found '//trim(to_char(i-1))//
' variables in dballe master table')
1558 END SUBROUTINE vol7d_dballe_import_dballevar
1565 subroutine vol7d_dballe_set_var_du(this)
1569 type(vol7d_var),
pointer :: dballevar(:)
1572 call vol7d_dballe_import_dballevar(dballevar)
1574 #undef VOL7D_POLY_NAME 1575 #define VOL7D_POLY_NAME dativar 1578 #undef VOL7D_POLY_TYPES_V 1579 #define VOL7D_POLY_TYPES_V r 1580 #include "vol7d_dballe_class_var_du.F90" 1581 #undef VOL7D_POLY_TYPES_V 1582 #define VOL7D_POLY_TYPES_V i 1583 #include "vol7d_dballe_class_var_du.F90" 1584 #undef VOL7D_POLY_TYPES_V 1585 #define VOL7D_POLY_TYPES_V b 1586 #include "vol7d_dballe_class_var_du.F90" 1587 #undef VOL7D_POLY_TYPES_V 1588 #define VOL7D_POLY_TYPES_V d 1589 #include "vol7d_dballe_class_var_du.F90" 1590 #undef VOL7D_POLY_TYPES_V 1591 #define VOL7D_POLY_TYPES_V c 1592 #include "vol7d_dballe_class_var_du.F90" 1593 #undef VOL7D_POLY_TYPES_V 1595 #undef VOL7D_POLY_NAME 1596 #define VOL7D_POLY_NAME anavar 1599 #undef VOL7D_POLY_TYPES_V 1600 #define VOL7D_POLY_TYPES_V r 1601 #include "vol7d_dballe_class_var_du.F90" 1602 #undef VOL7D_POLY_TYPES_V 1603 #define VOL7D_POLY_TYPES_V i 1604 #include "vol7d_dballe_class_var_du.F90" 1605 #undef VOL7D_POLY_TYPES_V 1606 #define VOL7D_POLY_TYPES_V b 1607 #include "vol7d_dballe_class_var_du.F90" 1608 #undef VOL7D_POLY_TYPES_V 1609 #define VOL7D_POLY_TYPES_V d 1610 #include "vol7d_dballe_class_var_du.F90" 1611 #undef VOL7D_POLY_TYPES_V 1612 #define VOL7D_POLY_TYPES_V c 1613 #include "vol7d_dballe_class_var_du.F90" 1614 #undef VOL7D_POLY_TYPES_V 1617 #undef VOL7D_POLY_NAME 1618 #define VOL7D_POLY_NAME datiattr 1621 #undef VOL7D_POLY_TYPES_V 1622 #define VOL7D_POLY_TYPES_V r 1623 #include "vol7d_dballe_class_var_du.F90" 1624 #undef VOL7D_POLY_TYPES_V 1625 #define VOL7D_POLY_TYPES_V i 1626 #include "vol7d_dballe_class_var_du.F90" 1627 #undef VOL7D_POLY_TYPES_V 1628 #define VOL7D_POLY_TYPES_V b 1629 #include "vol7d_dballe_class_var_du.F90" 1630 #undef VOL7D_POLY_TYPES_V 1631 #define VOL7D_POLY_TYPES_V d 1632 #include "vol7d_dballe_class_var_du.F90" 1633 #undef VOL7D_POLY_TYPES_V 1634 #define VOL7D_POLY_TYPES_V c 1635 #include "vol7d_dballe_class_var_du.F90" 1636 #undef VOL7D_POLY_TYPES_V 1639 #undef VOL7D_POLY_NAME 1640 #define VOL7D_POLY_NAME anaattr 1643 #undef VOL7D_POLY_TYPES_V 1644 #define VOL7D_POLY_TYPES_V r 1645 #include "vol7d_dballe_class_var_du.F90" 1646 #undef VOL7D_POLY_TYPES_V 1647 #define VOL7D_POLY_TYPES_V i 1648 #include "vol7d_dballe_class_var_du.F90" 1649 #undef VOL7D_POLY_TYPES_V 1650 #define VOL7D_POLY_TYPES_V b 1651 #include "vol7d_dballe_class_var_du.F90" 1652 #undef VOL7D_POLY_TYPES_V 1653 #define VOL7D_POLY_TYPES_V d 1654 #include "vol7d_dballe_class_var_du.F90" 1655 #undef VOL7D_POLY_TYPES_V 1656 #define VOL7D_POLY_TYPES_V c 1657 #include "vol7d_dballe_class_var_du.F90" 1658 #undef VOL7D_POLY_TYPES_V 1661 deallocate(dballevar)
1665 end subroutine vol7d_dballe_set_var_du
1669 FUNCTION get_dballe_filepath(filename, filetype)
RESULT(path)
1670 CHARACTER(len=*),
INTENT(in) :: filename
1671 INTEGER,
INTENT(in) :: filetype
1674 CHARACTER(len=512) :: path
1677 IF (dballe_name ==
' ')
THEN 1678 CALL getarg(0, dballe_name)
1682 IF (filetype < 1 .OR. filetype > nftype)
THEN 1684 CALL l4f_log(l4f_error,
'dballe file type '//trim(to_char(filetype))// &
1691 CALL getenv(trim(dballe_name_env), path)
1692 IF (path /=
' ')
THEN 1694 path=trim(path)//
'/'//filename
1695 INQUIRE(file=path, exist=exist)
1697 CALL l4f_log(l4f_info,
'dballe file '//trim(path)//
' found')
1702 DO j = 1,
SIZE(pathlist,1)
1703 IF (pathlist(j,filetype) ==
' ')
EXIT 1704 path=trim(pathlist(j,filetype))//
'/'//trim(dballe_name)//
'/'//filename
1705 INQUIRE(file=path, exist=exist)
1707 CALL l4f_log(l4f_info,
'dballe file '//trim(path)//
' found')
1711 CALL l4f_log(l4f_error,
'dballe file '//trim(filename)//
' not found')
1715 END FUNCTION get_dballe_filepath
1718 FUNCTION open_dballe_file(filename, filetype)
RESULT(unit)
1719 CHARACTER(len=*),
INTENT(in) :: filename
1720 INTEGER,
INTENT(in) :: filetype
1723 CHARACTER(len=512) :: path
1726 path=get_dballe_filepath(filename, filetype)
1727 IF (path ==
'')
RETURN 1730 IF (unit == -1)
RETURN 1732 OPEN(unit, file=path, status=
'old', iostat = i)
1734 CALL l4f_log(l4f_info,
'dballe file '//trim(path)//
' opened')
1738 CALL l4f_log(l4f_error,
'dballe file '//trim(filename)//
' not found')
1742 END FUNCTION open_dballe_file
1756 SUBROUTINE vol7d_dballe_export_old(this, network, coordmin, coordmax,&
1757 timei, timef,level,timerange,var,attr,anavar,anaattr,ana,dataonly,anaonly,template,attr_only)
1760 character(len=network_name_len),
INTENT(in),
optional :: network
1763 TYPE(geo_coord),
INTENT(in),
optional :: coordmin,coordmax
1765 TYPE(datetime),
INTENT(in),
optional :: timei, timef
1766 TYPE(vol7d_level),
INTENT(in),
optional :: level
1767 TYPE(vol7d_timerange),
INTENT(in),
optional :: timerange
1770 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: var(:),attr(:),anavar(:),anaattr(:)
1775 TYPE(vol7d_ana),
INTENT(inout),
optional :: ana
1776 logical,
intent(in),
optional :: dataonly
1777 logical,
intent(in),
optional :: anaonly
1780 character(len=*),
intent(in),
optional :: template
1781 logical,
intent(in),
optional :: attr_only
1784 type(dbadcv) :: vars,starvars,anavars,anastarvars
1785 type(dbafilter) :: filter
1786 type(dbacoord) :: mydbacoordmin, mydbacoordmax
1787 type(dbaana) :: mydbaana
1788 type(dbadatetime) :: mydatetimemin, mydatetimemax
1789 type(dbatimerange) :: mydbatimerange
1790 type(dbalevel) :: mydbalevel
1791 type(dbanetwork) :: mydbanetwork
1794 LOGICAL :: lattr, lanaattr
1795 integer :: nanaattr,nattr,nanavar,nvar
1804 if (
present(var))
then 1805 nvar=count(c_e(var))
1807 allocate (vars%dcv(nvar))
1809 if (c_e(var(i)))
then 1810 allocate (vars%dcv(i)%dat,source=dbadatac(var(i)))
1816 if (
present(anavar))
then 1817 nanavar=count(c_e(anavar))
1818 if (nanavar > 0)
then 1819 allocate (anavars%dcv(nanavar))
1821 if (c_e(anavar(i)))
then 1822 allocate (anavars%dcv(i)%dat,source=dbadatac(anavar(i)))
1829 if (
present(attr))
then 1830 nattr=count(c_e(attr))
1833 allocate (starvars%dcv(nattr))
1835 if (c_e(attr(i)))
then 1836 allocate (starvars%dcv(i)%dat,source=dbadatac(attr(i)))
1843 if (
present(anaattr))
then 1844 nanaattr=count(c_e(anaattr))
1845 if (nanaattr > 0)
then 1847 allocate (anastarvars%dcv(nanaattr))
1848 do i=1,
size(anaattr)
1849 if (c_e(anaattr(i)))
then 1850 allocate (anastarvars%dcv(i)%dat,source=dbadatac(anaattr(i)))
1858 mydbacoordmin=dbacoord()
1859 if (
present(coordmin)) mydbacoordmin%geo_coord=coordmin
1860 mydbacoordmax=dbacoord()
1861 if (
present(coordmax)) mydbacoordmax%geo_coord=coordmax
1863 if (
present(ana)) mydbaana%vol7d_ana=ana
1864 mydatetimemin=dbadatetime()
1865 if (
present(timei)) mydatetimemin%datetime=timei
1866 mydatetimemax=dbadatetime()
1867 if (
present(timef)) mydatetimemax%datetime=timef
1868 mydbatimerange=dbatimerange()
1869 if (
present(timerange)) mydbatimerange%vol7d_timerange=timerange
1870 mydbalevel=dbalevel()
1871 if (
present(level)) mydbalevel%vol7d_level=level
1872 mydbanetwork=dbanetwork()
1873 if (
present(network))
call init(mydbanetwork%vol7d_network,name=network)
1878 filter=dbafilter(coordmin=mydbacoordmin,coordmax=mydbacoordmax,ana=mydbaana, &
1879 datetimemin=mydatetimemin,datetimemax=mydatetimemax, &
1880 timerange=mydbatimerange,level=mydbalevel,network=mydbanetwork,&
1881 vars=vars,starvars=starvars,anavars=anavars,anastarvars=anastarvars,&
1882 dataonly=dataonly,anaonly=anaonly)
1887 call export (this, filter,template,attr_only)
1889 end SUBROUTINE vol7d_dballe_export_old
1892 subroutine vol7d_dballe_export (this, filter, template, attr_only)
1895 type(dbafilter),
intent(in) :: filter
1898 character(len=*),
intent(in),
optional :: template
1899 logical,
intent(in),
optional :: attr_only
1901 character(len=40) :: ltemplate
1903 type(dbametaanddatalist) :: metaanddatal
1906 metaanddatal=dbametaanddatalist()
1908 call v7d2dba(this%vol7d,metaanddatal)
1912 if (this%file)
call this%handle%remove_all()
1915 call metaanddatal%extrude(session=this%handle,filter=filter,attronly=attr_only,template=template)
1928 call filter%dbaset(this%handle)
1930 ltemplate=this%handle%template
1931 if (
present(template))
then 1935 call this%handle%messages_write_next(ltemplate)
1938 call this%handle%remove_all()
1942 stat = metaanddatal%delete()
1944 end subroutine vol7d_dballe_export
1947 subroutine v7d2dba(v7d,metaanddatal)
1948 TYPE(vol7d),
INTENT(in) :: v7d
1949 type(dbametaanddatalist),
intent(inout) :: metaanddatal
1951 TYPE(vol7d_serialize_dballe) :: serialize
1953 serialize = vol7d_serialize_dballe_new()
1954 serialize%anaonly=.true.
1955 call serialize%vol7d_serialize_setup(v7d)
1956 call serialize%vol7d_serialize_export(metaanddatal)
1958 serialize = vol7d_serialize_dballe_new()
1959 serialize%dataonly=.true.
1960 call serialize%vol7d_serialize_setup(v7d)
1961 call serialize%vol7d_serialize_export(metaanddatal)
1963 end subroutine v7d2dba
Oggetto per import ed export da DB-All.e.
vector of container of dbadata
classe per import ed export di volumi da e in DB-All.e
character version for dbadata
doubleprecision version for dbadata
class to manage links for lists in fortran 2003.
Test for a missing volume.
Classes for handling georeferenced sparse points in geographical corodinates.
filter to apply before ingest data
class to use lists in fortran 2003.
manage connection handle to a DSN
Classe per la gestione di un volume completo di dati osservati.
This module defines usefull general purpose function and subroutine.
class to use character lists in fortran 2003 WARNING !!!! CHAR LEN IS FIXED TO listcharmaxlen.
integer version for dbadata
class for import and export data from e to DB-All.e.
classe per la gestione del logging
Utilities for CHARACTER variables.
Emit log message for a category with specific priority.
fortran 2003 interface to geo_coord