libsim Versione 7.2.1

◆ dba2v7d()

subroutine dba2v7d ( type(vol7d), intent(inout)  this,
type(dbametaanddata), dimension(:), intent(inout)  metaanddatav,
integer, intent(in), optional  time_definition,
type(vol7d_network), intent(in), optional  set_network 
)
private

import dba objects in vol7d

Parametri
[in]time_definition0=time is reference time ; 1=time is validity time (default=1)

Definizione alla linea 834 del file vol7d_dballe_class.F03.

835allocate(anastarvars%dcv(nanavarattr))
836
837
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)
845 cycle cn
846 end if
847 end if
848 end do
849 end do
850 end do
851end do cn
852
853
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)
861 cycle dn
862 end if
863 end if
864 end do
865 end do
866 end do
867end do dn
868
869
870!!--------------------------------------------------------------------------
871
872
873!!
874!! count all unique metadata
875!!
876
877if(ldegnet) then
878 nnetwork=1
879else
880 !nnetwork = count_distinct(metaanddatav(:)%metadata%network%vol7d_network, back=.TRUE.)
881 allocate (tmpnetwork(size(metaanddatav(:))),&
882 source=metaanddatav(:)%metadata%network%vol7d_network)
883 call sort(tmpnetwork)
884 nnetwork = count_distinct_sorted(tmpnetwork)
885end if
886
887!ntime = count_distinct(metaanddatav(:)%metadata%datetime%datetime, &
888! mask=c_e(metaanddatav(:)%metadata%datetime%datetime),back=.TRUE.)
889allocate (tmptime(size(metaanddatav(:))),&
890 source=metaanddatav(:)%metadata%datetime%datetime)
891call sort(tmptime)
892ntime = count_distinct_sorted(tmptime,mask=c_e(tmptime))
893
894!ntimerange = count_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange, &
895! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
896allocate (tmptimerange(size(metaanddatav(:))),&
897 source=metaanddatav(:)%metadata%timerange%vol7d_timerange)
898call sort(tmptimerange)
899ntimerange = count_distinct_sorted(tmptimerange,mask=c_e(tmptimerange))
900
901!nlevel = count_distinct(metaanddatav(:)%metadata%level%vol7d_level, &
902! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level),back=.TRUE.)
903allocate (tmplevel(size(metaanddatav(:))),&
904 source=metaanddatav(:)%metadata%level%vol7d_level)
905call sort(tmplevel)
906nlevel = count_distinct_sorted(tmplevel,mask=c_e(tmplevel))
907
908!nana = count_distinct(metaanddatav(:)%metadata%ana%vol7d_ana, back=.TRUE.)
909allocate (tmpana(size(metaanddatav(:))),&
910 source=metaanddatav(:)%metadata%ana%vol7d_ana)
911call sort(tmpana)
912nana = count_distinct_sorted(tmpana)
913
914!!$if(ldegnet) then
915!!$ nnetwork=1
916!!$else
917!!$ nnetwork = size(metaanddatav(:)%metadata%network%vol7d_network)
918!!$end if
919!!$ntime = size(metaanddatav(:)%metadata%datetime%datetime)
920!!$ntimerange = size(metaanddatav(:)%metadata%timerange%vol7d_timerange)
921!!$nlevel = size(metaanddatav(:)%metadata%level%vol7d_level)
922!!$nana = size(metaanddatav(:)%metadata%ana%vol7d_ana)
923
924 ! var
925
926ndativarr = 0
927ndativari = 0
928ndativarb = 0
929ndativard = 0
930ndativarc = 0
931
932do i =1 ,size(vars%dcv)
933 associate(dato => vars%dcv(i)%dat)
934 select type (dato)
935 type is (dbadatar)
936 ndativarr = ndativarr + 1
937 type is (dbadatai)
938 ndativari = ndativari + 1
939 type is (dbadatab)
940 ndativarb = ndativarb + 1
941 type is (dbadatad)
942 ndativard = ndativard + 1
943 type is (dbadatac)
944 ndativarc = ndativarc + 1
945 end select
946 end associate
947end do
948
949
950 !attr
951
952ndatiattrr = 0
953ndatiattri = 0
954ndatiattrb = 0
955ndatiattrd = 0
956ndatiattrc = 0
957
958do i =1 ,size(starvars%dcv)
959 associate(dato => starvars%dcv(i)%dat)
960 select type (dato)
961 type is (dbadatar)
962 ndatiattrr = ndatiattrr + 1
963 type is (dbadatai)
964 ndatiattri = ndatiattri + 1
965 type is (dbadatab)
966 ndatiattrb = ndatiattrb + 1
967 type is (dbadatad)
968 ndatiattrd = ndatiattrd + 1
969 type is (dbadatac)
970 ndatiattrc = ndatiattrc + 1
971 end select
972 end associate
973end do
974
975
976 ! ana var
977
978nanavarr = 0
979nanavari = 0
980nanavarb = 0
981nanavard = 0
982nanavarc = 0
983
984do i =1 ,size(anavars%dcv)
985 associate(dato => anavars%dcv(i)%dat)
986 select type (dato)
987 type is (dbadatar)
988 nanavarr = nanavarr + 1
989 type is (dbadatai)
990 nanavari = nanavari + 1
991 type is (dbadatab)
992 nanavarb = nanavarb + 1
993 type is (dbadatad)
994 nanavard = nanavard + 1
995 type is (dbadatac)
996 nanavarc = nanavarc + 1
997 end select
998 end associate
999end do
1000
1001
1002 ! ana attr
1003
1004nanaattrr = 0
1005nanaattri = 0
1006nanaattrb = 0
1007nanaattrd = 0
1008nanaattrc = 0
1009
1010do i =1 ,size(anastarvars%dcv)
1011 associate(dato => anastarvars%dcv(i)%dat)
1012 select type (dato)
1013 type is (dbadatar)
1014 nanaattrr = nanaattrr + 1
1015 type is (dbadatai)
1016 nanaattri = nanaattri + 1
1017 type is (dbadatab)
1018 nanaattrb = nanaattrb + 1
1019 type is (dbadatad)
1020 nanaattrd = nanaattrd + 1
1021 type is (dbadatac)
1022 nanaattrc = nanaattrc + 1
1023 end select
1024 end associate
1025end do
1026
1027
1028 !refine
1029
1030ndativarattrr=0
1031ndativarattri=0
1032ndativarattrb=0
1033ndativarattrd=0
1034ndativarattrc=0
1035
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
1041
1042
1043nanavarattrr=0
1044nanavarattri=0
1045nanavarattrb=0
1046nanavarattrd=0
1047nanavarattrc=0
1048
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
1054
1055
1056CALL init(this,time_definition=ltime_definition)
1057
1058!!$print *, "nana=",nana, "ntime=",ntime, "ntimerange=",ntimerange, &
1059!!$ "nlevel=",nlevel, "nnetwork=",nnetwork, &
1060!!$ "ndativarr=",ndativarr, "ndativari=",ndativari, &
1061!!$ "ndativarb=",ndativarb, "ndativard=",ndativard, "ndativarc=",ndativarc,&
1062!!$ "ndatiattrr=",ndatiattrr, "ndatiattri=",ndatiattri, "ndatiattrb=",ndatiattrb,&
1063!!$ "ndatiattrd=",ndatiattrd, "ndatiattrc=",ndatiattrc,&
1064!!$ "ndativarattrr=",ndativarattrr, "ndativarattri=",ndativarattri, "ndativarattrb=",ndativarattrb,&
1065!!$ "ndativarattrd=",ndativarattrd, "ndativarattrc=",ndativarattrc
1066!!$
1067!!$print *,"nanaattrr,nanaattri,nanaattrb,nanaattrd,nanaattrc"
1068!!$print *,nanaattrr,nanaattri,nanaattrb,nanaattrd,nanaattrc
1069
1070
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)
1088
1089
1090! fill metadata removing contextana metadata
1091
1092!nana=count_and_pack_distinct(metaanddatav(:)%metadata%ana%vol7d_ana,this%ana, back=.TRUE.)
1093!this%ana=pack_distinct(metaanddatav(:)%metadata%ana%vol7d_ana, nana, back=.TRUE.)
1094this%ana=pack_distinct_sorted(tmpana, nana)
1095deallocate(tmpana)
1096!call sort(this%ana)
1097
1098!ntime=count_and_pack_distinct(metaanddatav(:)%metadata%datetime%datetime,this%time, &
1099! mask=c_e(metaanddatav(:)%metadata%datetime%datetime), back=.TRUE.)
1100!this%time=pack_distinct(metaanddatav(:)%metadata%datetime%datetime, ntime, &
1101! mask=c_e(metaanddatav(:)%metadata%datetime%datetime),back=.TRUE.)
1102this%time=pack_distinct_sorted(tmptime, ntime,mask=c_e(tmptime))
1103deallocate(tmptime)
1104!call sort(this%time)
1105
1106!ntimerange=count_and_pack_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange,this%timerange, &
1107! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
1108!this%timerange=pack_distinct(metaanddatav(:)%metadata%timerange%vol7d_timerange, ntimerange, &
1109! mask=c_e(metaanddatav(:)%metadata%timerange%vol7d_timerange), back=.TRUE.)
1110this%timerange=pack_distinct_sorted(tmptimerange, ntimerange,mask=c_e(tmptimerange))
1111deallocate(tmptimerange)
1112!call sort(this%timerange)
1113
1114!nlevel=count_and_pack_distinct(metaanddatav(:)%metadata%level%vol7d_level,this%level, &
1115! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level), back=.TRUE.)
1116!this%level=pack_distinct(metaanddatav(:)%metadata%level%vol7d_level, nlevel, &
1117! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level), back=.TRUE.)
1118this%level=pack_distinct_sorted(tmplevel, nlevel,mask=c_e(tmplevel))
1119deallocate(tmplevel)
1120!call sort(this%level)
1121
1122if(ldegnet)then
1123 nnetwork=1
1124 ALLOCATE(this%network(1))
1125 this%network(1)=set_network
1126else
1127 !nnetwork=count_and_pack_distinct(metaanddatav(:)%metadata%network%vol7d_network,this%network, back=.TRUE.)
1128 !this%network=pack_distinct(metaanddatav(:)%metadata%network%vol7d_network, nnetwork, back=.TRUE.)
1129 this%network=pack_distinct_sorted(tmpnetwork, nnetwork)
1130 deallocate(tmpnetwork)
1131end if
1132!call sort(this%network)
1133
1134 ! var
1135
1136ndativarr = 0
1137ndativari = 0
1138ndativarb = 0
1139ndativard = 0
1140ndativarc = 0
1141
1142do i =1 ,size(vars%dcv)
1143 associate(dato => vars%dcv(i)%dat)
1144 select type (dato)
1145 type is (dbadatar)
1146 ndativarr = ndativarr + 1
1147 call init (this%dativar%r(ndativarr), btable=dato%btable)
1148 type is (dbadatai)
1149 ndativari = ndativari + 1
1150 call init (this%dativar%i(ndativari), btable=dato%btable)
1151 type is (dbadatab)
1152 ndativarb = ndativarb + 1
1153 call init (this%dativar%b(ndativarb), btable=dato%btable)
1154 type is (dbadatad)
1155 ndativard = ndativard + 1
1156 call init (this%dativar%d(ndativard), btable=dato%btable)
1157 type is (dbadatac)
1158 ndativarc = ndativarc + 1
1159 call init (this%dativar%c(ndativarc), btable=dato%btable)
1160 end select
1161 end associate
1162end do
1163
1164
1165 !attr
1166
1167ndatiattrr = 0
1168ndatiattri = 0
1169ndatiattrb = 0
1170ndatiattrd = 0
1171ndatiattrc = 0
1172
1173do i =1 ,size(starvars%dcv)
1174 associate(dato => starvars%dcv(i)%dat)
1175 select type (dato)
1176 type is (dbadatar)
1177 ndatiattrr = ndatiattrr + 1
1178 call init (this%datiattr%r(ndatiattrr), btable=dato%btable)
1179 type is (dbadatai)
1180 ndatiattri = ndatiattri + 1
1181 call init (this%datiattr%i(ndatiattri), btable=dato%btable)
1182 type is (dbadatab)
1183 ndatiattrb = ndatiattrb + 1
1184 call init (this%datiattr%b(ndatiattrb), btable=dato%btable)
1185 type is (dbadatad)
1186 ndatiattrd = ndatiattrd + 1
1187 call init (this%datiattr%d(ndatiattrd), btable=dato%btable)
1188 type is (dbadatac)
1189 ndatiattrc = ndatiattrc + 1
1190 call init (this%datiattr%c(ndatiattrc), btable=dato%btable)
1191 end select
1192 end associate
1193end do
1194
1195
1196 ! ana var
1197
1198nanavarr = 0
1199nanavari = 0
1200nanavarb = 0
1201nanavard = 0
1202nanavarc = 0
1203
1204do i =1 ,size(anavars%dcv)
1205 associate(dato => anavars%dcv(i)%dat)
1206 select type (dato)
1207 type is (dbadatar)
1208 nanavarr = nanavarr + 1
1209 call init (this%anavar%r(nanavarr), btable=dato%btable)
1210 type is (dbadatai)
1211 nanavari = nanavari + 1
1212 call init (this%anavar%i(nanavari), btable=dato%btable)
1213 type is (dbadatab)
1214 nanavarb = nanavarb + 1
1215 call init (this%anavar%b(nanavarb), btable=dato%btable)
1216 type is (dbadatad)
1217 nanavard = nanavard + 1
1218 call init (this%anavar%d(nanavard), btable=dato%btable)
1219 type is (dbadatac)
1220 nanavarc = nanavarc + 1
1221 call init (this%anavar%c(nanavarc), btable=dato%btable)
1222 end select
1223 end associate
1224end do
1225
1226
1227 ! ana attr
1228
1229nanaattrr = 0
1230nanaattri = 0
1231nanaattrb = 0
1232nanaattrd = 0
1233nanaattrc = 0
1234
1235do i =1 ,size(anastarvars%dcv)
1236 associate(dato => anastarvars%dcv(i)%dat)
1237 select type (dato)
1238 type is (dbadatar)
1239 nanaattrr = nanaattrr + 1
1240 call init (this%anaattr%r(nanaattrr), btable=dato%btable)
1241 type is (dbadatai)
1242 nanaattri = nanaattri + 1
1243 call init (this%anaattr%i(nanaattri), btable=dato%btable)
1244 type is (dbadatab)
1245 nanaattrb = nanaattrb + 1
1246 call init (this%anaattr%b(nanaattrb), btable=dato%btable)
1247 type is (dbadatad)
1248 nanaattrd = nanaattrd + 1
1249 call init (this%anaattr%d(nanaattrd), btable=dato%btable)
1250 type is (dbadatac)
1251 nanaattrc = nanaattrc + 1
1252 call init (this%anaattr%c(nanaattrc), btable=dato%btable)
1253 end select
1254 end associate
1255end do
1256
1257
1258 ! here we colcolate the link from attributes and vars
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)
1266 end associate
1267end do
1268
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)
1276 end associate
1277end do
1278
1279 ! set index in dativaratt*
1280call vol7d_set_attr_ind(this)
1281
1282call vol7d_alloc_vol (this)
1283
1284 ! Ora qui bisogna metterci dentro idati
1285indana = 0
1286indtime = 0
1287indnetwork = 0
1288indtime = 0
1289indtimerange = 0
1290indlevel = 0
1291do i =1, size(metaanddatav)
1292
1293 indana = index_sorted(this%ana, metaanddatav(i)%metadata%ana%vol7d_ana)
1294
1295 if (ldegnet)then
1296 indnetwork=1
1297 else
1298 indnetwork = index_sorted(this%network, metaanddatav(i)%metadata%network%vol7d_network)
1299 endif
1300
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 ! dati
1304
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)
1308
1309 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
1310
1311 associate(dato => metaanddatav(i)%dataattrv%dataattr(j)%dat)
1312 select type (dato)
1313 type is (dbadatai)
1314 inddativar = firsttrue(dato%btable == this%dativar%i%btable)
1315 this%voldatii( &
1316 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1317 ) = dato%value
1318
1319 type is (dbadatar)
1320 inddativar = firsttrue(dato%btable == this%dativar%r%btable)
1321 this%voldatir( &
1322 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1323 ) = dato%value
1324
1325 type is (dbadatad)
1326 inddativar = firsttrue(dato%btable == this%dativar%d%btable)
1327 this%voldatid( &
1328 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1329 ) = dato%value
1330
1331 type is (dbadatab)
1332 inddativar = firsttrue(dato%btable == this%dativar%b%btable)
1333 this%voldatib( &
1334 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1335 ) = dato%value
1336
1337 type is (dbadatac)
1338 inddativar = firsttrue(dato%btable == this%dativar%c%btable)
1339 this%voldatic( &
1340 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1341 ) = dato%value
1342
1343 end select
1344
1345
1346 ! dati attributes
1347 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
1348 associate(attr => metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
1349 select type (attr)
1350
1351 type is (dbadatai)
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 &
1356 ) = attr%value
1357 type is (dbadatar)
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 &
1362 ) = attr%value
1363 type is (dbadatad)
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 &
1368 ) = attr%value
1369 type is (dbadatab)
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 &
1374 ) = attr%value
1375 type is (dbadatac)
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 &
1380 ) = attr%value
1381
1382 end select
1383 end associate
1384 end do
1385 end associate
1386 end do
1387
1388 else
1389 ! ana
1390 do j=1, size(metaanddatav(i)%dataattrv%dataattr)
1391
1392 associate(dato => metaanddatav(i)%dataattrv%dataattr(j)%dat)
1393 select type (dato)
1394 type is (dbadatai)
1395 indanavar = firsttrue(dato%btable == this%anavar%i%btable)
1396 this%volanai( &
1397 indana,indanavar,indnetwork &
1398 ) = dato%value
1399
1400 type is (dbadatar)
1401 indanavar = firsttrue(dato%btable == this%anavar%r%btable)
1402 this%volanar( &
1403 indana,indanavar,indnetwork &
1404 ) = dato%value
1405
1406 type is (dbadatad)
1407 indanavar = firsttrue(dato%btable == this%anavar%d%btable)
1408 this%volanad( &
1409 indana,indanavar,indnetwork &
1410 ) = dato%value
1411
1412 type is (dbadatab)
1413 indanavar = firsttrue(dato%btable == this%anavar%b%btable)
1414 this%volanab( &
1415 indana,indanavar,indnetwork &
1416 ) = dato%value
1417
1418 type is (dbadatac)
1419 indanavar = firsttrue(dato%btable == this%anavar%c%btable)
1420 this%volanac( &
1421 indana,indanavar,indnetwork &
1422 ) = dato%value
1423
1424 end select
1425
1426
1427 ! ana attributes
1428 do k=1, size(metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv)
1429 associate(attr => metaanddatav(i)%dataattrv%dataattr(j)%attrv%dcv(k)%dat)
1430 select type (attr)
1431
1432 type is (dbadatai)
1433 indanavarattr = firsttrue(dato%btable == this%anavarattr%i%btable)
1434 indattrvar = firsttrue(attr%btable == this%anaattr%i%btable)
1435 this%volanaattri( &
1436 indana,indanavarattr,indnetwork,indattrvar &
1437 ) = attr%value
1438 type is (dbadatar)
1439 indanavarattr = firsttrue(dato%btable == this%anavarattr%r%btable)
1440 indattrvar = firsttrue(attr%btable == this%anaattr%r%btable)
1441 this%volanaattrr( &
1442 indana,indanavarattr,indnetwork,indattrvar &
1443 ) = attr%value
1444 type is (dbadatad)
1445 indanavarattr = firsttrue(dato%btable == this%anavarattr%d%btable)
1446 indattrvar = firsttrue(attr%btable == this%anaattr%d%btable)
1447 this%volanaattrd( &
1448 indana,indanavarattr,indnetwork,indattrvar &
1449 ) = attr%value
1450 type is (dbadatab)
1451 indanavarattr = firsttrue(dato%btable == this%anavarattr%b%btable)
1452 indattrvar = firsttrue(attr%btable == this%anaattr%b%btable)
1453 this%volanaattrb( &
1454 indana,indanavarattr,indnetwork,indattrvar &
1455 ) = attr%value
1456 type is (dbadatac)
1457 indanavarattr = firsttrue(dato%btable == this%anavarattr%c%btable)
1458 indattrvar = firsttrue(attr%btable == this%anaattr%c%btable)
1459 this%volanaattrc( &
1460 indana,indanavarattr,indnetwork,indattrvar &
1461 ) = attr%value
1462
1463 end select
1464 end associate
1465 end do
1466 end associate
1467 end do
1468 end if
1469end do
1470
1471contains
1472
1473!!$!> /brief Return an dbadcv from a mixlist with dbadata* type
1474!!$function todcv_dbadat(this)
1475!!$type(dbadcv) :: todcv_dbadat !< array
1476!!$type(mixlist) :: this
1477!!$
1478!!$integer :: i
1479!!$
1480!!$allocate (todcv_dbadat%dcv(this%countelements()))
1481!!$
1482!!$call this%rewind()
1483!!$i=0
1484!!$do while(this%element())
1485!!$ i=i+1
1486!!$
1487!!$ associate (dato => this%current())
1488!!$ select type (dato)
1489!!$ type is (dbadatar)
1490!!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
1491!!$ type is (dbadatai)
1492!!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
1493!!$ type is (dbadatab)
1494!!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
1495!!$ type is (dbadatad)
1496!!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
1497!!$ type is (dbadatac)
1498!!$ allocate(todcv_dbadat%dcv(i)%dat,source=dato)
1499!!$ end select
1500!!$ end associate
1501!!$
1502!!$ call this%next()
1503!!$end do
1504!!$end function todcv_dbadat
1505
1506!!$! Definisce le funzioni count_distinct e pack_distinct
1507!!$#define VOL7D_POLY_TYPE TYPE(dbadata)
1508!!$#define VOL7D_POLY_TYPES _dbadata
1509!!$#undef ENABLE_SORT
1510!!$#include "array_utilities_inc.F90"
1511!!$#undef VOL7D_POLY_TYPE
1512!!$#undef VOL7D_POLY_TYPES
1513
1514
1515end subroutine dba2v7d
1516
1517
1518subroutine vol7d_dballe_import_dballevar(this)
1519
1520type(vol7d_var),pointer :: this(:)
1521INTEGER :: i,un,n
1522
1523IF (associated(this)) return
1524IF (allocated(blocal)) then
1525 ALLOCATE(this(size(blocal)))
1526 this=blocal
1527 return
1528end if
1529
1530un = open_dballe_file('dballe.txt', filetype_data)
1531IF (un < 0) then
1532
1533 call l4f_log(l4f_error,"error open_dballe_file: dballe.txt")
1534 CALL raise_error("error open_dballe_file: dballe.txt")
1535 return
1536end if
1537
1538n = 0
1539DO WHILE(.true.)
1540 READ(un,*,END=100)
1541 n = n + 1
1542ENDDO
1543100 CONTINUE
1544
1545IF (n > 0) THEN
1546 ALLOCATE(this(n))
1547 ALLOCATE(blocal(n))
1548 rewind(un)
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"
1553 !print*,"B=",blocal(i)%btable
1554 !print*," D=",blocal(i)%description
1555 !PRINT*," U=",blocal(i)%unit
1556 !PRINT*," D=",blocal(i)%scalefactor
1557 ENDDO readline
1558
1559 CALL l4f_log(l4f_info,'Found '//trim(to_char(i-1))//' variables in dballe master table')
1560
1561 this=blocal
1562
1563ENDIF
1564CLOSE(un)
1565
1566END SUBROUTINE vol7d_dballe_import_dballevar
1567
1568
1569
1572
1573subroutine vol7d_dballe_set_var_du(this)
1574
1575TYPE(vol7d) :: this
1576integer :: i,j
1577type(vol7d_var),pointer :: dballevar(:)
1578
1579nullify(dballevar)
1580call vol7d_dballe_import_dballevar(dballevar)
1581
1582#undef VOL7D_POLY_NAME
1583#define VOL7D_POLY_NAME dativar
1584
1585
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
1602
1603#undef VOL7D_POLY_NAME
1604#define VOL7D_POLY_NAME anavar
1605
1606
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
1623
1624
1625#undef VOL7D_POLY_NAME
1626#define VOL7D_POLY_NAME datiattr
1627
1628
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
1645
1646
1647#undef VOL7D_POLY_NAME
1648#define VOL7D_POLY_NAME anaattr
1649
1650
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

Generated with Doxygen.