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 Index method with sorted array.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Costruttori per le classi datetime e timedelta.