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 == 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)
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)
898 call sort(tmptimerange)
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+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)
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)
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)
1280 call vol7d_set_attr_ind(this)
1282 call vol7d_alloc_vol (this)
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(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 &
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" 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(:)
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