libsim  Versione 7.2.6

◆ dba2v7d()

subroutine vol7d_dballe_class::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 844 del file vol7d_dballe_class.F03.

845  cycle cn
846  end if
847  end if
848  end do
849  end do
850  end do
851 end do cn
852 
853 
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)
861  cycle dn
862  end if
863  end if
864  end do
865  end do
866  end do
867 end do dn
868 
869 
870 !!--------------------------------------------------------------------------
871 
872 
873 !!
874 !! count all unique metadata
875 !!
876 
877 if(ldegnet) then
878  nnetwork=1
879 else
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)
885 end if
886 
887 !ntime = count_distinct(metaanddatav(:)%metadata%datetime%datetime, &
888 ! mask=c_e(metaanddatav(:)%metadata%datetime%datetime),back=.TRUE.)
889 allocate (tmptime(size(metaanddatav(:))),&
890  source=metaanddatav(:)%metadata%datetime%datetime)
891 call sort(tmptime)
892 ntime = 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.)
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))
900 
901 !nlevel = count_distinct(metaanddatav(:)%metadata%level%vol7d_level, &
902 ! mask=c_e(metaanddatav(:)%metadata%level%vol7d_level),back=.TRUE.)
903 allocate (tmplevel(size(metaanddatav(:))),&
904  source=metaanddatav(:)%metadata%level%vol7d_level)
905 call sort(tmplevel)
906 nlevel = count_distinct_sorted(tmplevel,mask=c_e(tmplevel))
907 
908 !nana = count_distinct(metaanddatav(:)%metadata%ana%vol7d_ana, back=.TRUE.)
909 allocate (tmpana(size(metaanddatav(:))),&
910  source=metaanddatav(:)%metadata%ana%vol7d_ana)
911 call sort(tmpana)
912 nana = 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 
926 ndativarr = 0
927 ndativari = 0
928 ndativarb = 0
929 ndativard = 0
930 ndativarc = 0
931 
932 do 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
947 end do
948 
949 
950  !attr
951 
952 ndatiattrr = 0
953 ndatiattri = 0
954 ndatiattrb = 0
955 ndatiattrd = 0
956 ndatiattrc = 0
957 
958 do 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
973 end do
974 
975 
976  ! ana var
977 
978 nanavarr = 0
979 nanavari = 0
980 nanavarb = 0
981 nanavard = 0
982 nanavarc = 0
983 
984 do 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
999 end do
1000 
1001 
1002  ! ana attr
1003 
1004 nanaattrr = 0
1005 nanaattri = 0
1006 nanaattrb = 0
1007 nanaattrd = 0
1008 nanaattrc = 0
1009 
1010 do 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
1025 end do
1026 
1027 
1028  !refine
1029 
1030 ndativarattrr=0
1031 ndativarattri=0
1032 ndativarattrb=0
1033 ndativarattrd=0
1034 ndativarattrc=0
1035 
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
1041 
1042 
1043 nanavarattrr=0
1044 nanavarattri=0
1045 nanavarattrb=0
1046 nanavarattrd=0
1047 nanavarattrc=0
1048 
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
1054 
1055 
1056 CALL 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 
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)
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.)
1094 this%ana=pack_distinct_sorted(tmpana, nana)
1095 deallocate(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.)
1102 this%time=pack_distinct_sorted(tmptime, ntime,mask=c_e(tmptime))
1103 deallocate(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.)
1110 this%timerange=pack_distinct_sorted(tmptimerange, ntimerange,mask=c_e(tmptimerange))
1111 deallocate(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.)
1118 this%level=pack_distinct_sorted(tmplevel, nlevel,mask=c_e(tmplevel))
1119 deallocate(tmplevel)
1120 !call sort(this%level)
1121 
1122 if(ldegnet)then
1123  nnetwork=1
1124  ALLOCATE(this%network(1))
1125  this%network(1)=set_network
1126 else
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)
1131 end if
1132 !call sort(this%network)
1133 
1134  ! var
1135 
1136 ndativarr = 0
1137 ndativari = 0
1138 ndativarb = 0
1139 ndativard = 0
1140 ndativarc = 0
1141 
1142 do 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
1162 end do
1163 
1164 
1165  !attr
1166 
1167 ndatiattrr = 0
1168 ndatiattri = 0
1169 ndatiattrb = 0
1170 ndatiattrd = 0
1171 ndatiattrc = 0
1172 
1173 do 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
1193 end do
1194 
1195 
1196  ! ana var
1197 
1198 nanavarr = 0
1199 nanavari = 0
1200 nanavarb = 0
1201 nanavard = 0
1202 nanavarc = 0
1203 
1204 do 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
1224 end do
1225 
1226 
1227  ! ana attr
1228 
1229 nanaattrr = 0
1230 nanaattri = 0
1231 nanaattrb = 0
1232 nanaattrd = 0
1233 nanaattrc = 0
1234 
1235 do 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
1255 end do
1256 
1257 
1258  ! here we colcolate the link from attributes and vars
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)
1266  end associate
1267 end do
1268 
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)
1276  end associate
1277 end do
1278 
1279  ! set index in dativaratt*
1280 call vol7d_set_attr_ind(this)
1281 
1282 call vol7d_alloc_vol (this)
1283 
1284  ! Ora qui bisogna metterci dentro idati
1285 indana = 0
1286 indtime = 0
1287 indnetwork = 0
1288 indtime = 0
1289 indtimerange = 0
1290 indlevel = 0
1291 do 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
1469 end do
1470 
1471 contains
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 
1515 end subroutine dba2v7d
1516 
1517 
1518 subroutine vol7d_dballe_import_dballevar(this)
1519 
1520 type(vol7d_var),pointer :: this(:)
1521 INTEGER :: i,un,n
1522 
1523 IF (associated(this)) return
1524 IF (allocated(blocal)) then
1525  ALLOCATE(this(size(blocal)))
1526  this=blocal
1527  return
1528 end if
1529 
1530 un = open_dballe_file('dballe.txt', filetype_data)
1531 IF (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
1536 end if
1537 
1538 n = 0
1539 DO WHILE(.true.)
1540  READ(un,*,END=100)
1541  n = n + 1
1542 ENDDO
1543 100 CONTINUE
1544 
1545 IF (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 
1563 ENDIF
1564 CLOSE(un)
1565 
1566 END SUBROUTINE vol7d_dballe_import_dballevar
1567 
1568 
1569 
1572 
1573 subroutine vol7d_dballe_set_var_du(this)
1574 
1575 TYPE(vol7d) :: this
1576 integer :: i,j
1577 type(vol7d_var),pointer :: dballevar(:)
1578 
1579 nullify(dballevar)
1580 call 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
1667 
1668 
1669 deallocate(dballevar)
1670 
1671 return
1672 
1673 end subroutine vol7d_dballe_set_var_du
1674 
1675 
1676 

Generated with Doxygen.