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)))
512if (
present(coordmin)) mydbacoordmin%geo_coord=coordmin
514if (
present(coordmax)) mydbacoordmax%geo_coord=coordmax
516if (
present(ana)) mydbaana%vol7d_ana=ana
518if (
present(timei)) mydatetimemin%datetime=timei
520if (
present(timef)) mydatetimemax%datetime=timef
522if (
present(timerange)) mydbatimerange%vol7d_timerange=timerange
524if (
present(level)) mydbalevel%vol7d_level=level
526if (
present(network)) mydbanetwork%vol7d_network=network
531filter=
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)
539call import(this,filter,set_network)
542END SUBROUTINE vol7d_dballe_import_old
547subroutine vol7d_dballe_import(this,filter,set_network)
551TYPE(vol7d_network),
INTENT(in),
OPTIONAL :: set_network
553TYPE(
vol7d) :: vol7dtmp
559if ( .not. filter%dataonly)
then
561 myfilter=
dbafilter(filter=filter,contextana=.true.,query=cmiss)
565 CALL l4f_category_log(this%category,l4f_debug,
'start import vol7d_dballe ingest for constant station data')
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)
583if ( .not. filter%anaonly)
then
585 myfilter=
dbafilter(filter=filter,contextana=.false.)
590 CALL l4f_category_log(this%category,l4f_debug,
'start import vol7d_dballe ingest for station data')
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.)
606call vol7d_dballe_set_var_du(this%vol7d)
635this%data_id(indana,indtime,indlevel,indtimerange,indnetwork)=buffer(i)%data_id
638ier=idba_set(this%handle,
"*context_id",buffer(i)%data_id)
639ier=idba_set(this%handle,
"*var_related",buffer(i)%btable)
641ier=idba_set(this%handle,
"*varlist",starvarlist )
642ier=idba_voglioancora(this%handle,nn)
649end subroutine vol7d_dballe_import
655SUBROUTINE vol7d_dballe_delete(this, preserveidbhandle)
657logical,
intent(in),
optional :: preserveidbhandle
659# ifndef F2003_FULL_FEATURES
660call this%handle%delete()
662if (.not. optio_log(preserveidbhandle))
call this%idbhandle%delete()
673call l4f_category_delete(this%category)
676END SUBROUTINE vol7d_dballe_delete
682subroutine dba2v7d(this,metaanddatav,time_definition, set_network)
685TYPE(
vol7d),
INTENT(inout) :: this
686integer,
INTENT(in),
OPTIONAL :: time_definition
687TYPE(vol7d_network),
INTENT(in),
OPTIONAL :: set_network
691type(
dbadcv) :: anastarvars
695integer :: indana,indtime,indlevel,indtimerange,inddativar,indnetwork,indattrvar
697integer :: nana,ntime,ntimerange,nlevel,nnetwork
700integer :: inddativarattr
701integer :: nanavar, indanavar,indanavarattr,nanavarattr
703integer :: ndativarr, ndativari, ndativarb, ndativard, ndativarc
704integer :: ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc
705integer :: ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc
707integer :: nanavarr, nanavari, nanavarb, nanavard, nanavarc
708integer :: nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc
709integer :: nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
711integer :: ndativar,ndativarattr
713type(
characterlist) :: dativarl,dativarattrl,anavarl,anavarattrl
715character(len=listcharmaxlen),
allocatable :: dativara(:),dativarattra(:),anavara(:),anavarattra(:)
717integer :: ltime_definition
719type(datetime),
allocatable :: tmptime(:)
720type(vol7d_network),
allocatable :: tmpnetwork(:)
721type(vol7d_level),
allocatable :: tmplevel(:)
722type(vol7d_timerange),
allocatable :: tmptimerange(:)
723type(vol7d_ana),
allocatable :: tmpana(:)
726ltime_definition=optio_i(time_definition)
727if (.not.
c_e(ltime_definition)) ltime_definition = 1
834status = anavarattrl%delete()
835allocate(anastarvars%dcv(nanavarattr))
838cn:
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)
854dn:
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 if (.not.
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)
881 allocate (tmpnetwork(
size(metaanddatav(:))),&
882 source=metaanddatav(:)%metadata%network%vol7d_network)
883 call sort(tmpnetwork)
884 nnetwork = count_distinct_sorted(tmpnetwork)
889allocate (tmptime(
size(metaanddatav(:))),&
890 source=metaanddatav(:)%metadata%datetime%datetime)
892ntime = count_distinct_sorted(tmptime,mask=
c_e(tmptime))
896allocate (tmptimerange(
size(metaanddatav(:))),&
897 source=metaanddatav(:)%metadata%timerange%vol7d_timerange)
898call sort(tmptimerange)
899ntimerange = count_distinct_sorted(tmptimerange,mask=
c_e(tmptimerange))
903allocate (tmplevel(
size(metaanddatav(:))),&
904 source=metaanddatav(:)%metadata%level%vol7d_level)
906nlevel = count_distinct_sorted(tmplevel,mask=
c_e(tmplevel))
909allocate (tmpana(
size(metaanddatav(:))),&
910 source=metaanddatav(:)%metadata%ana%vol7d_ana)
912nana = count_distinct_sorted(tmpana)
932do 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
958do 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
984do 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
1010do 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
1036if (ndatiattrr > 0 ) ndativarattrr=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1037if (ndatiattri > 0 ) ndativarattri=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1038if (ndatiattrb > 0 ) ndativarattrb=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1039if (ndatiattrd > 0 ) ndativarattrd=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1040if (ndatiattrc > 0 ) ndativarattrc=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1049if (nanaattrr > 0 ) nanavarattrr=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1050if (nanaattri > 0 ) nanavarattri=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1051if (nanaattrb > 0 ) nanavarattrb=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1052if (nanaattrd > 0 ) nanavarattrd=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1053if (nanaattrc > 0 ) nanavarattrc=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1056CALL init(this,time_definition=ltime_definition)
1071call vol7d_alloc (this, &
1072nana=nana, ntime=ntime, ntimerange=ntimerange, &
1073nlevel=nlevel, nnetwork=nnetwork, &
1074ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb, ndativard=ndativard, ndativarc=ndativarc,&
1075ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb, ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
1076ndativarattrr=ndativarattrr, &
1077ndativarattri=ndativarattri, &
1078ndativarattrb=ndativarattrb, &
1079ndativarattrd=ndativarattrd, &
1080ndativarattrc=ndativarattrc,&
1081nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, nanavard=nanavard, nanavarc=nanavarc,&
1082nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb, nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
1083nanavarattrr=nanavarattrr, &
1084nanavarattri=nanavarattri, &
1085nanavarattrb=nanavarattrb, &
1086nanavarattrd=nanavarattrd, &
1087nanavarattrc=nanavarattrc)
1094this%ana=pack_distinct_sorted(tmpana, nana)
1102this%time=pack_distinct_sorted(tmptime, ntime,mask=c_e(tmptime))
1110this%timerange=pack_distinct_sorted(tmptimerange, ntimerange,mask=c_e(tmptimerange))
1111deallocate(tmptimerange)
1118this%level=pack_distinct_sorted(tmplevel, nlevel,mask=c_e(tmplevel))
1124 ALLOCATE(this%network(1))
1125 this%network(1)=set_network
1129 this%network=pack_distinct_sorted(tmpnetwork, nnetwork)
1130 deallocate(tmpnetwork)
1142do 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)
1173do 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)
1204do 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)
1235do 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)
1259do 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)
1269do 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)
1280call vol7d_set_attr_ind(this)
1282call vol7d_alloc_vol (this)
1291do 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 if (c_e(metaanddatav(i)%metadata%datetime%datetime) .and. &
1302 c_e(metaanddatav(i)%metadata%timerange%vol7d_timerange) .and. &
1303 c_e(metaanddatav(i)%metadata%level%vol7d_level) )
then
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 &
1515end subroutine dba2v7d
1518subroutine vol7d_dballe_import_dballevar(this)
1520type(vol7d_var),
pointer :: this(:)
1523IF (
associated(this))
return
1524IF (
allocated(blocal))
then
1525 ALLOCATE(this(
size(blocal)))
1530un = 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"
1559 CALL l4f_log(l4f_info,
'Found '//trim(to_char(i-1))//
' variables in dballe master table')
1566END SUBROUTINE vol7d_dballe_import_dballevar
1573subroutine vol7d_dballe_set_var_du(this)
1577type(vol7d_var),
pointer :: dballevar(:)
1580call 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
1726FUNCTION open_dballe_file(filename, filetype)
RESULT(unit)
1727CHARACTER(len=*),
INTENT(in) :: filename
1728INTEGER,
INTENT(in) :: filetype
1731CHARACTER(len=512) :: path
1734path=get_dballe_filepath(filename, filetype)
1735IF (path ==
'')
RETURN
1738IF (unit == -1)
RETURN
1740OPEN(unit, file=path, status=
'old', iostat = i)
1742 CALL l4f_log(l4f_info,
'dballe file '//trim(path)//
' opened')
1746CALL l4f_log(l4f_error,
'dballe file '//trim(filename)//
' not found')
1750END FUNCTION open_dballe_file
1764SUBROUTINE vol7d_dballe_export_old(this, network, coordmin, coordmax,&
1765 timei, timef,level,timerange,var,attr,anavar,anaattr,ana,dataonly,anaonly,template,attr_only)
1768character(len=network_name_len),
INTENT(in),
optional :: network
1771TYPE(geo_coord),
INTENT(in),
optional :: coordmin,coordmax
1773TYPE(datetime),
INTENT(in),
optional :: timei, timef
1774TYPE(vol7d_level),
INTENT(in),
optional :: level
1775TYPE(vol7d_timerange),
INTENT(in),
optional :: timerange
1778CHARACTER(len=*),
INTENT(in),
OPTIONAL :: var(:),attr(:),anavar(:),anaattr(:)
1783TYPE(vol7d_ana),
INTENT(inout),
optional :: ana
1784logical,
intent(in),
optional :: dataonly
1785logical,
intent(in),
optional :: anaonly
1788character(len=*),
intent(in),
optional :: template
1789logical,
intent(in),
optional :: attr_only
1792type(dbadcv) :: vars,starvars,anavars,anastarvars
1793type(dbafilter) :: filter
1794type(dbacoord) :: mydbacoordmin, mydbacoordmax
1795type(dbaana) :: mydbaana
1796type(dbadatetime) :: mydatetimemin, mydatetimemax
1797type(dbatimerange) :: mydbatimerange
1798type(dbalevel) :: mydbalevel
1799type(dbanetwork) :: mydbanetwork
1802LOGICAL :: lattr, lanaattr
1803integer :: nanaattr,nattr,nanavar,nvar
1812if (
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)))
1824if (
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)))
1837if (
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)))
1851if (
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)))
1866mydbacoordmin=dbacoord()
1867if (
present(coordmin)) mydbacoordmin%geo_coord=coordmin
1868mydbacoordmax=dbacoord()
1869if (
present(coordmax)) mydbacoordmax%geo_coord=coordmax
1871if (
present(ana)) mydbaana%vol7d_ana=ana
1872mydatetimemin=dbadatetime()
1873if (
present(timei)) mydatetimemin%datetime=timei
1874mydatetimemax=dbadatetime()
1875if (
present(timef)) mydatetimemax%datetime=timef
1876mydbatimerange=dbatimerange()
1877if (
present(timerange)) mydbatimerange%vol7d_timerange=timerange
1878mydbalevel=dbalevel()
1879if (
present(level)) mydbalevel%vol7d_level=level
1880mydbanetwork=dbanetwork()
1881if (
present(network))
call init(mydbanetwork%vol7d_network,name=network)
1886filter=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)
1895call export (this, filter,template,attr_only)
1897end SUBROUTINE vol7d_dballe_export_old
1900subroutine vol7d_dballe_export (this, filter, template, attr_only)
1903type(dbafilter),
intent(in) :: filter
1906character(len=*),
intent(in),
optional :: template
1907logical,
intent(in),
optional :: attr_only
1909character(len=40) :: ltemplate
1911type(dbametaanddatalist) :: metaanddatal
1914metaanddatal=dbametaanddatalist()
1916call v7d2dba(this%vol7d,metaanddatal)
1920if (this%file)
call this%handle%remove_all()
1923call 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()
1950stat = metaanddatal%delete()
1952end subroutine vol7d_dballe_export
1955subroutine v7d2dba(v7d,metaanddatal)
1956TYPE(vol7d),
INTENT(in) :: v7d
1957type(dbametaanddatalist),
intent(inout) :: metaanddatal
1959TYPE(vol7d_serialize_dballe) :: serialize
1961serialize = vol7d_serialize_dballe_new()
1962serialize%anaonly=.true.
1963call serialize%vol7d_serialize_setup(v7d)
1964call serialize%vol7d_serialize_export(metaanddatal)
1966serialize = vol7d_serialize_dballe_new()
1967serialize%dataonly=.true.
1968call serialize%vol7d_serialize_setup(v7d)
1969call serialize%vol7d_serialize_export(metaanddatal)
1971end subroutine v7d2dba