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
then
844 allocate(starvars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr
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 if (.not. c_e(metaanddatav(i)%metadata%datetime%datetime))
then
859 if (metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat%btable
then
860 allocate(anastarvars%dcv(n)%dat,source=metaanddatav(i)%dataattrv%dataattr
881 allocate (tmpnetwork(
size(metaanddatav(:))),&
882 source=metaanddatav(:)%metadata%network%vol7d_network)
883 call sort(tmpnetwork)
884 nnetwork = count_distinct_sorted(tmpnetwork)
889 allocate (tmptime(
size(metaanddatav(:))),&
890 source=metaanddatav(:)%metadata%datetime%datetime)
892 ntime = count_distinct_sorted(tmptime,mask=c_e(tmptime))
896 allocate (tmptimerange(
size(metaanddatav(:))),&
897 source=metaanddatav(:)%metadata%timerange%vol7d_timerange)
899 ntimerange = count_distinct_sorted(tmptimerange,mask=c_e(tmptimerange))
903 allocate (tmplevel(
size(metaanddatav(:))),&
904 source=metaanddatav(:)%metadata%level%vol7d_level)
906 nlevel = count_distinct_sorted(tmplevel,mask=c_e(tmplevel))
909 allocate (tmpana(
size(metaanddatav(:))),&
910 source=metaanddatav(:)%metadata%ana%vol7d_ana)
912 nana = count_distinct_sorted(tmpana)
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
1037 if (ndatiattri > 0 ) ndativarattri=ndativarr+ndativari+ndativarb+ndativard
1038 if (ndatiattrb > 0 ) ndativarattrb=ndativarr+ndativari+ndativarb+ndativard
1039 if (ndatiattrd > 0 ) ndativarattrd=ndativarr+ndativari+ndativarb+ndativard
1040 if (ndatiattrc > 0 ) ndativarattrc=ndativarr+ndativari+ndativarb+ndativard
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
1072 nana=nana, ntime=ntime, ntimerange=ntimerange, &
1073 nlevel=nlevel, nnetwork=nnetwork, &
1074 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb, ndativard
1075 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb, ndatiattrd
1076 ndativarattrr=ndativarattrr, &
1077 ndativarattri=ndativarattri, &
1078 ndativarattrb=ndativarattrb, &
1079 ndativarattrd=ndativarattrd, &
1080 ndativarattrc=ndativarattrc,&
1081 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, nanavard=nanavard
1082 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb, nanaattrd
1083 nanavarattrr=nanavarattrr, &
1084 nanavarattri=nanavarattri, &
1085 nanavarattrb=nanavarattrb, &
1086 nanavarattrd=nanavarattrd, &
1087 nanavarattrc=nanavarattrc)
1094 this%ana=pack_distinct_sorted(tmpana, nana)
1102 this%time=pack_distinct_sorted(tmptime, ntime,mask=c_e(tmptime))
1110 this%timerange=pack_distinct_sorted(tmptimerange, ntimerange,mask=c_e(tmptimerange
1111 deallocate(tmptimerange)
1118 this%level=pack_distinct_sorted(tmplevel, nlevel,mask=c_e(tmplevel))
1119 deallocate(tmplevel)
1124 ALLOCATE(this%network(1))
1125 this%network(1)=set_network
1129 this%network=pack_distinct_sorted(tmpnetwork, nnetwork)
1130 deallocate(tmpnetwork)
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)
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
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 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
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
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
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
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
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
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
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 &
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
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'
1566 END SUBROUTINE vol7d_dballe_import_dballevar
1573 subroutine vol7d_dballe_set_var_du(this)
1577 type(vol7d_var),
pointer :: 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)