Identica a vol7d_dballe_importvsns con var vettore.
762 if (
present(timef))
then 765 CALL l4f_category_log(this%category,l4f_debug,
'query timef:'//
to_char(timef))
767 CALL getval(timef, year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
768 sec=nint(float(msec)/1000.)
769 ier=idba_setdatemax(this%handle,year,month,day,hour,minute,sec)
778 if (any(
c_e(lvar)) .and. .not. optio_log(anaonly))
then 781 IF (
SIZE(lvar) > maxvarlist)
THEN 782 CALL l4f_category_log(this%category,l4f_error,
"too many variables requested: "//
t2c(
SIZE(lvar)))
783 call raise_fatal_error()
790 IF (nvar > 1) varlist(len_trim(varlist)+1:) =
',' 791 varlist(len_trim(varlist)+1:) = trim(lvar(i))
796 CALL l4f_category_log(this%category,l4f_debug,
'query varlist:'//
t2c(
SIZE(lvar))//
":"//varlist)
798 if (varlist /=
'' ) ier=idba_set(this%handle,
"varlist",varlist )
802 if (
c_e(ltimerange))
then 804 CALL l4f_category_log(this%category,l4f_debug,
'query timerange:'//
to_char(timerange))
806 ier=idba_settimerange(this%handle, timerange%timerange, timerange%p1, timerange%p2)
811 CALL l4f_category_log(this%category,l4f_debug,
'query level:'//
to_char(level))
813 ier=idba_setlevel(this%handle, level%level1, level%l1,level%level2, level%l2)
816 ier=idba_voglioquesto(this%handle,n)
819 CALL l4f_category_log(this%category,l4f_debug,
'numero di dati:'//
t2c(n))
822 if (optio_log(anaonly)) n=0
825 allocate(buffer(n),stat=istat)
827 CALL l4f_category_log(this%category,l4f_error,
'cannot allocate ' &
828 //trim(
to_char(n))//
' buffer elements')
829 CALL raise_fatal_error()
836 ier=idba_dammelo(this%handle,btable)
838 ier=idba_enqdate(this%handle,year,month,day,hour,minute,sec)
839 IF (.NOT.
c_e(sec)) sec = 0
840 ier=idba_enqlevel(this%handle, rlevel1, rl1, rlevel2,rl2)
841 ier=idba_enqtimerange(this%handle, rtimerange, p1, p2)
842 ier=idba_enq(this%handle,
"rep_memo",rep_memo)
849 buffer(i)%dator=dba_mvr
850 buffer(i)%datoi=dba_mvi
851 buffer(i)%datob=dba_mvb
852 buffer(i)%datod=dba_mvd
853 buffer(i)%datoc=dba_mvc
855 if (any(
c_e(lvar)).and.
present(varkind))
then 856 ii= index_c(lvar, btable)
859 if(varkind(ii) ==
"r") ier=idba_enq(this%handle,btable,buffer(i)%dator)
860 if(varkind(ii) ==
"i") ier=idba_enq(this%handle,btable,buffer(i)%datoi)
861 if(varkind(ii) ==
"b") ier=idba_enq(this%handle,btable,buffer(i)%datob)
862 if(varkind(ii) ==
"d") ier=idba_enq(this%handle,btable,buffer(i)%datod)
863 if(varkind(ii) ==
"c") ier=idba_enq(this%handle,btable,buffer(i)%datoc)
866 ier=idba_enq(this%handle,btable,buffer(i)%datoc)
871 ier=idba_enq(this%handle,
"context_id",buffer(i)%data_id)
874 ier=idba_enq(this%handle,
"lat", ilat)
875 ier=idba_enq(this%handle,
"lon", ilon)
876 ier=idba_enq(this%handle,
"ident",ident)
888 call init(buffer(i)%ana,ilat=ilat,ilon=ilon,ident=ident)
889 call init(buffer(i)%time, year=year, month=month, day=day, hour=hour, minute=minute,msec=sec*1000)
890 call init(buffer(i)%level, rlevel1,rl1,rlevel2,rl2)
891 call init(buffer(i)%timerange, rtimerange, p1, p2)
892 call init(buffer(i)%network, rep_memo)
893 buffer(i)%btable = btable
896 if (this%vol7d%time_definition == 0) buffer(i)%time = buffer(i)%time - &
897 timedelta_new(sec=buffer(i)%timerange%p1)
905 ier=idba_unsetall(this%handle_staz)
907 CALL l4f_category_log(this%category,l4f_debug,
'unsetall handle_staz')
910 if(
c_e(lnetwork))ier=idba_set(this%handle_staz,
"rep_memo",lnetwork%name)
911 if(ldegnet)ier=idba_set(this%handle_staz,
"query",
"best")
913 if (
present(coordmin))
then 915 CALL getval(coordmin, ilat=ilat,ilon=ilon)
916 ier=idba_set(this%handle_staz,
"lonmin",ilon)
917 ier=idba_set(this%handle_staz,
"latmin",ilat)
920 if (
present(coordmax))
then 922 CALL getval(coordmax, ilat=ilat,ilon=ilon)
923 ier=idba_set(this%handle_staz,
"lonmax",ilon)
924 ier=idba_set(this%handle_staz,
"latmax",ilat)
927 if (
present(ana))
then 928 CALL getval(ana%coord, ilat=ilat,ilon=ilon)
929 ier=idba_set(this%handle_staz,
"lon",ilon)
930 ier=idba_set(this%handle_staz,
"lat",ilat)
931 if (
c_e(ana%ident))
then 932 ier=idba_set(this%handle_staz,
"ident",ana%ident)
934 ier=idba_set(this%handle_staz,
"mobile",1)
936 ier=idba_set(this%handle_staz,
"mobile",0)
942 if (
size (lanavar) > 0 )
then 945 DO i = 1,
SIZE(lanavar)
946 nanavar = nanavar + 1
947 IF (nanavar > 1) varlist(len_trim(varlist)+1:) =
',' 948 varlist(len_trim(varlist)+1:) = trim(lanavar(i))
956 ier=idba_setcontextana(this%handle_staz)
957 ier=idba_voglioquesto(this%handle_staz,n_ana)
961 allocate(bufferana(n_ana),stat=istat)
963 CALL l4f_category_log(this%category,l4f_error,
'cannot allocate ' &
964 //trim(
to_char(n_ana))//
' bufferana elements')
965 CALL raise_fatal_error()
971 call init(bufferana(i)%ana)
972 call init(bufferana(i)%network)
974 bufferana(i)%dator=dba_mvr
975 bufferana(i)%datoi=dba_mvi
976 bufferana(i)%datob=dba_mvb
977 bufferana(i)%datod=dba_mvd
978 bufferana(i)%datoc=dba_mvc
979 bufferana(i)%btable = dba_mvc
981 ier=idba_dammelo(this%handle_staz,btable)
984 ier=idba_enqdate(this%handle_staz,year,month,day,hour,minute,sec)
985 IF (.NOT.
c_e(sec)) sec = 0
986 ier=idba_enqlevel(this%handle_staz, rlevel1, rl1, rlevel2,rl2)
987 ier=idba_enqtimerange(this%handle_staz, rtimerange, p1, p2)
988 ier=idba_enq(this%handle_staz,
"rep_memo",rep_memo)
997 ier=idba_enq(this%handle_staz,
"context_id",bufferana(i)%data_id)
1000 ier=idba_enq(this%handle_staz,
"lat", ilat)
1001 ier=idba_enq(this%handle_staz,
"lon", ilon)
1002 ier=idba_enq(this%handle_staz,
"ident",ident)
1007 call init(bufferana(i)%ana,ilat=ilat,ilon=ilon,ident=ident)
1008 call init(bufferana(i)%network, rep_memo)
1011 if (btable ==
"B05001" .or. btable ==
"B06001" .or. btable ==
"B01011" .or. btable ==
"B01194" ) cycle
1013 if (
size(lanavar) > 0 .and.
present(anavarkind))
then 1014 ii= index_c(lanavar, btable)
1017 if(anavarkind(ii) ==
"r") ier=idba_enq(this%handle_staz,btable,bufferana(i)%dator)
1018 if(anavarkind(ii) ==
"i") ier=idba_enq(this%handle_staz,btable,bufferana(i)%datoi)
1019 if(anavarkind(ii) ==
"b") ier=idba_enq(this%handle_staz,btable,bufferana(i)%datob)
1020 if(anavarkind(ii) ==
"d") ier=idba_enq(this%handle_staz,btable,bufferana(i)%datod)
1021 if(anavarkind(ii) ==
"c") ier=idba_enq(this%handle_staz,btable,bufferana(i)%datoc)
1024 ier=idba_enq(this%handle_staz,btable,bufferana(i)%datoc)
1028 call init(bufferana(i)%time, year=year, month=month, day=day, hour=hour, minute=minute,msec=sec*1000)
1029 call init(bufferana(i)%level, rlevel1,rl1,rlevel2,rl2)
1030 call init(bufferana(i)%timerange, rtimerange, p1, p2)
1031 bufferana(i)%btable = btable
1037 if (.not. any(
c_e(lvar)))
then 1038 nvar = count_distinct(buffer%btable, back=.true.)
1041 if (optio_log(anaonly))
then 1042 nana = count_distinct(bufferana%ana, back=.true.)
1044 nana = count_distinct(buffer%ana, back=.true.)
1050 if (optio_log(anaonly))
then 1051 nnetwork = count_distinct(bufferana%network, back=.true.)
1053 nnetwork = count_distinct(buffer%network, back=.true.)
1058 ntime = count_distinct(buffer%time, back=.true.)
1059 ntimerange = count_distinct(buffer%timerange, back=.true.)
1060 nlevel = count_distinct(buffer%level, back=.true.)
1063 if (
present(varkind))
then 1064 ndativarr= count(varkind ==
"r")
1065 ndativari= count(varkind ==
"i")
1066 ndativarb= count(varkind ==
"b")
1067 ndativard= count(varkind ==
"d")
1068 ndativarc= count(varkind ==
"c")
1083 if (
present(attrkind))
then 1084 ndatiattrr= count(attrkind ==
"r")
1085 ndatiattri= count(attrkind ==
"i")
1086 ndatiattrb= count(attrkind ==
"b")
1087 ndatiattrd= count(attrkind ==
"d")
1088 ndatiattrc= count(attrkind ==
"c")
1095 ndatiattrc=
size(attr)
1112 if (ndatiattrr > 0 ) ndativarattrr=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1113 if (ndatiattri > 0 ) ndativarattri=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1114 if (ndatiattrb > 0 ) ndativarattrb=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1115 if (ndatiattrd > 0 ) ndativarattrd=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1116 if (ndatiattrc > 0 ) ndativarattrc=ndativarr+ndativari+ndativarb+ndativard+ndativarc
1121 if (
size(lanavar) == 0 )
then 1122 nanavar = count_distinct(bufferana%btable, back=.true.,mask=(bufferana%btable /= dba_mvc))
1125 if (
present(anavarkind))
then 1126 nanavarr= count(anavarkind ==
"r")
1127 nanavari= count(anavarkind ==
"i")
1128 nanavarb= count(anavarkind ==
"b")
1129 nanavard= count(anavarkind ==
"d")
1130 nanavarc= count(anavarkind ==
"c")
1145 if (
present(anaattrkind))
then 1146 nanaattrr= count(anaattrkind ==
"r")
1147 nanaattri= count(anaattrkind ==
"i")
1148 nanaattrb= count(anaattrkind ==
"b")
1149 nanaattrd= count(anaattrkind ==
"d")
1150 nanaattrc= count(anaattrkind ==
"c")
1157 nanaattrc=
size(anaattr)
1174 if (nanaattrr > 0 ) nanavarattrr=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1175 if (nanaattri > 0 ) nanavarattri=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1176 if (nanaattrb > 0 ) nanavarattrb=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1177 if (nanaattrd > 0 ) nanavarattrd=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1178 if (nanaattrc > 0 ) nanavarattrc=nanavarr+nanavari+nanavarb+nanavard+nanavarc
1183 CALL init(vol7dtmp,time_definition=this%vol7d%time_definition)
1187 call vol7d_alloc (vol7dtmp, &
1188 nana=nana, ntime=ntime, ntimerange=ntimerange, &
1189 nlevel=nlevel, nnetwork=nnetwork, &
1190 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb, ndativard=ndativard, ndativarc=ndativarc,&
1191 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb, ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
1192 ndativarattrr=ndativarattrr, &
1193 ndativarattri=ndativarattri, &
1194 ndativarattrb=ndativarattrb, &
1195 ndativarattrd=ndativarattrd, &
1196 ndativarattrc=ndativarattrc,&
1197 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, nanavard=nanavard, nanavarc=nanavarc,&
1198 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb, nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
1199 nanavarattrr=nanavarattrr, &
1200 nanavarattri=nanavarattri, &
1201 nanavarattrb=nanavarattrb, &
1202 nanavarattrd=nanavarattrd, &
1203 nanavarattrc=nanavarattrc)
1215 if (optio_log(anaonly))
then 1216 vol7dtmp%ana=pack_distinct(bufferana%ana, nana, back=.true.)
1218 vol7dtmp%ana=pack_distinct(buffer%ana, nana, back=.true.)
1221 vol7dtmp%time=pack_distinct(buffer%time, ntime, back=.true.)
1222 call sort(vol7dtmp%time)
1224 vol7dtmp%timerange=pack_distinct(buffer%timerange, ntimerange, back=.true.)
1225 call sort(vol7dtmp%timerange)
1227 vol7dtmp%level=pack_distinct(buffer%level, nlevel, back=.true.)
1228 call sort(vol7dtmp%level)
1231 vol7dtmp%network(1)=set_network
1233 if (optio_log(anaonly))
then 1234 vol7dtmp%network=pack_distinct(bufferana%network, nnetwork, back=.true.)
1236 vol7dtmp%network=pack_distinct(buffer%network, nnetwork, back=.true.)
1242 if (any(
c_e(lvar)).and.
present(varkind))
then 1250 do i=1,
size(varkind)
1251 if (varkind(i) ==
"r")
then 1253 call init (vol7dtmp%dativar%r(ir), btable=var(i))
1255 if (varkind(i) ==
"i")
then 1257 call init (vol7dtmp%dativar%i(ii), btable=var(i))
1259 if (varkind(i) ==
"b")
then 1261 call init (vol7dtmp%dativar%b(ib), btable=var(i))
1263 if (varkind(i) ==
"d")
then 1265 call init (vol7dtmp%dativar%d(id), btable=var(i))
1267 if (varkind(i) ==
"c")
then 1269 call init (vol7dtmp%dativar%c(ic), btable=var(i))
1272 else if (any(
c_e(lvar)))
then 1274 call init (vol7dtmp%dativar%c(i), btable=var(i))
1279 call init(vol7dtmp%dativar%c(i))
1282 if (ndativarc > 0)
then 1283 call pack_distinct_c(buffer%btable, vol7dtmp%dativar%c%btable, back=.true.,mask=(buffer%btable /= dba_mvc))
1290 if (
present(attrkind).and.
present(attr).and. any(
c_e(lvar)))
then 1300 if ( ndativarattrr > 0 )
then 1302 call init (vol7dtmp%dativarattr%r(ir), btable=lvar(i))
1305 if ( ndativarattri > 0 )
then 1307 call init (vol7dtmp%dativarattr%i(ii), btable=lvar(i))
1310 if ( ndativarattrb > 0 )
then 1312 call init (vol7dtmp%dativarattr%b(ib), btable=lvar(i))
1315 if ( ndativarattrd > 0 )
then 1317 call init (vol7dtmp%dativarattr%d(id), btable=lvar(i))
1320 if ( ndativarattrc > 0 )
then 1322 call init (vol7dtmp%dativarattr%c(ic), btable=lvar(i))
1327 else if (
present(attr).and. any(
c_e(lvar)))
then 1330 if ( ndativarattrc > 0 )
call init (vol7dtmp%dativarattr%c(i), btable=lvar(i))
1333 else if (
associated(vol7dtmp%dativarattr%c).and.
associated(vol7dtmp%dativar%c))
then 1335 vol7dtmp%dativarattr%c=vol7dtmp%dativar%c
1340 if (
present(attrkind).and. lattr)
then 1348 do i=1,
size(attrkind)
1350 if (attrkind(i) ==
"r")
then 1352 call init (vol7dtmp%datiattr%r(ir), btable=attr(i))
1354 if (attrkind(i) ==
"i")
then 1356 call init (vol7dtmp%datiattr%i(ii), btable=attr(i))
1358 if (attrkind(i) ==
"b")
then 1360 call init (vol7dtmp%datiattr%b(ib), btable=attr(i))
1362 if (attrkind(i) ==
"d")
then 1364 call init (vol7dtmp%datiattr%d(id), btable=attr(i))
1366 if (attrkind(i) ==
"c")
then 1368 call init (vol7dtmp%datiattr%c(ic), btable=attr(i))
1371 else if (
present(attr))
then 1374 call init (vol7dtmp%datiattr%c(i), btable=attr(i))
1381 if (
size(lanavar) > 0 .and.
present(anavarkind))
then 1389 do i=1,
size(anavarkind)
1390 if (anavarkind(i) ==
"r")
then 1392 call init (vol7dtmp%anavar%r(ir), btable=anavar(i))
1394 if (anavarkind(i) ==
"i")
then 1396 call init (vol7dtmp%anavar%i(ii), btable=anavar(i))
1398 if (anavarkind(i) ==
"b")
then 1400 call init (vol7dtmp%anavar%b(ib), btable=anavar(i))
1402 if (anavarkind(i) ==
"d")
then 1404 call init (vol7dtmp%anavar%d(id), btable=anavar(i))
1406 if (anavarkind(i) ==
"c")
then 1408 call init (vol7dtmp%anavar%c(ic), btable=anavar(i))
1411 else if (
size(lanavar) > 0 )
then 1414 call init (vol7dtmp%anavar%c(i), btable=anavar(i))
1420 call init(vol7dtmp%anavar%c(i))
1422 if (nanavarc > 0)
then 1423 call pack_distinct_c(bufferana%btable, vol7dtmp%anavar%c%btable, back=.true.,mask=(bufferana%btable /= dba_mvc))
1429 if (
present(anaattrkind) .and.
present(anaattr) .and.
size(anavar) > 0 )
then 1439 if ( nanavarattrr > 0 )
then 1441 call init (vol7dtmp%anavarattr%r(ir), btable=anavar(i))
1444 if ( nanavarattri > 0 )
then 1446 call init (vol7dtmp%anavarattr%i(ii), btable=anavar(i))
1449 if ( nanavarattrb > 0 )
then 1451 call init (vol7dtmp%anavarattr%b(ib), btable=anavar(i))
1454 if ( nanavarattrd > 0 )
then 1456 call init (vol7dtmp%anavarattr%d(id), btable=anavar(i))
1459 if ( nanavarattrc > 0 )
then 1461 call init (vol7dtmp%anavarattr%c(ic), btable=anavar(i))
1466 else if (
present(anaattr) .and.
size(anavar) > 0 )
then 1469 if ( nanavarattrc > 0 )
call init(vol7dtmp%anavarattr%c(i), btable=anavar(i))
1472 else if (
associated(vol7dtmp%anavarattr%c) .and.
associated(vol7dtmp%anavar%c))
then 1474 vol7dtmp%anavarattr%c=vol7dtmp%anavar%c
1479 if (
present(anaattrkind).and.
present(anaattr))
then 1487 do i=1,
size(anaattrkind)
1489 if (anaattrkind(i) ==
"r")
then 1491 call init (vol7dtmp%anaattr%r(ir), btable=anaattr(i))
1493 if (anaattrkind(i) ==
"i")
then 1495 call init (vol7dtmp%anaattr%i(ii), btable=anaattr(i))
1497 if (anaattrkind(i) ==
"b")
then 1499 call init (vol7dtmp%anaattr%b(ib), btable=anaattr(i))
1501 if (anaattrkind(i) ==
"d")
then 1503 call init (vol7dtmp%anaattr%d(id), btable=anaattr(i))
1505 if (anaattrkind(i) ==
"c")
then 1507 call init (vol7dtmp%anaattr%c(ic), btable=anaattr(i))
1510 else if (
present(anaattr))
then 1512 do i=1,
size(anaattr)
1513 call init (vol7dtmp%anaattr%c(i), btable=anaattr(i))
1526 call vol7d_alloc_vol (vol7dtmp)
1530 allocate (this%data_id( nana, ntime, nlevel, ntimerange, nnetwork),stat=istat)
1532 CALL l4f_category_log(this%category,l4f_error,
'cannot allocate ' &
1533 //trim(
to_char(nana*ntime*nlevel*ntimerange*nnetwork))//
' data_id elements')
1534 CALL raise_fatal_error()
1538 this%data_id=dba_mvi
1542 nullify(this%data_id)
1559 IF (
SIZE(attr) > maxvarlist)
THEN 1560 CALL l4f_category_log(this%category,l4f_error,
"too many attributes requested: "//
t2c(
SIZE(attr)))
1561 call raise_fatal_error()
1567 DO ii = 1,
SIZE(attr)
1568 nvarattr = nvarattr + 1
1569 IF (nvarattr > 1) starvarlist(len_trim(starvarlist)+1:) =
',' 1570 starvarlist(len_trim(starvarlist)+1:) = trim(attr(ii))
1578 indana = firsttrue(buffer(i)%ana == vol7dtmp%ana)
1579 indtime = firsttrue(buffer(i)%time == vol7dtmp%time)
1580 indtimerange = firsttrue(buffer(i)%timerange == vol7dtmp%timerange)
1581 indlevel = firsttrue(buffer(i)%level == vol7dtmp%level)
1585 indnetwork = firsttrue(buffer(i)%network == vol7dtmp%network)
1589 if(
c_e(buffer(i)%dator))
then 1590 inddativar = firsttrue(buffer(i)%btable == vol7dtmp%dativar%r%btable)
1591 vol7dtmp%voldatir( &
1592 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1596 if(
c_e(buffer(i)%datoi))
then 1597 inddativar = firsttrue(buffer(i)%btable == vol7dtmp%dativar%i%btable)
1598 vol7dtmp%voldatii( &
1599 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1603 if(
c_e(buffer(i)%datob))
then 1604 inddativar = firsttrue(buffer(i)%btable == vol7dtmp%dativar%b%btable)
1605 vol7dtmp%voldatib( &
1606 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1610 if(
c_e(buffer(i)%datod))
then 1611 inddativar = firsttrue(buffer(i)%btable == vol7dtmp%dativar%d%btable)
1612 vol7dtmp%voldatid( &
1613 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1617 if(
c_e(buffer(i)%datoc))
then 1618 inddativar = firsttrue(buffer(i)%btable == vol7dtmp%dativar%c%btable)
1619 vol7dtmp%voldatic( &
1620 indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
1631 this%data_id(indana,indtime,indlevel,indtimerange,indnetwork)=buffer(i)%data_id
1633 ier=idba_unsetall(this%handle)
1635 CALL l4f_category_log(this%category,l4f_debug,
'unsetall handle')
1637 ier=idba_set(this%handle,
"*context_id",buffer(i)%data_id)
1638 ier=idba_set(this%handle,
"*var_related",buffer(i)%btable)
1640 ier=idba_set(this%handle,
"*varlist",starvarlist )
1641 ier=idba_voglioancora(this%handle,nn)
1645 ier=idba_ancora(this%handle,starbtable)
1647 indattr = firsttrue(attr == starbtable)
1648 IF (indattr<1) cycle
1650 call init (var_tmp, btable=starbtable)
1652 if (
present(attrkind))
then 1653 iii=( firsttrue(attr == starbtable))
1658 if(attrkind(iii) ==
"r")
then 1659 inddativarattr = firsttrue(buffer(i)%btable == vol7dtmp%dativarattr%r%btable)
1660 inddatiattr = firsttrue(var_tmp == vol7dtmp%datiattr%r)
1661 ier=idba_enq(this%handle,starbtable,&
1662 vol7dtmp%voldatiattrr(indana,indtime,indlevel,indtimerange,&
1663 inddativarattr,indnetwork,inddatiattr))
1665 if(attrkind(iii) ==
"i")
then 1666 inddativarattr = firsttrue(buffer(i)%btable == vol7dtmp%dativarattr%i%btable)
1667 inddatiattr = firsttrue(var_tmp == vol7dtmp%datiattr%i)
1668 ier=idba_enq(this%handle,starbtable,&
1669 vol7dtmp%voldatiattri(indana,indtime,indlevel,indtimerange,&
1670 inddativarattr,indnetwork,inddatiattr))
1672 if(attrkind(iii) ==
"b")
then 1673 inddativarattr = firsttrue(buffer(i)%btable == vol7dtmp%dativarattr%b%btable)
1674 inddatiattr = firsttrue(var_tmp == vol7dtmp%datiattr%b)
1677 ier=idba_enq(this%handle,starbtable,&
1678 vol7dtmp%voldatiattrb(indana,indtime,indlevel,indtimerange,&
1679 inddativarattr,indnetwork,inddatiattr))
1681 if(attrkind(iii) ==
"d")
then 1682 inddativarattr = firsttrue(buffer(i)%btable == vol7dtmp%dativarattr%d%btable)
1683 inddatiattr = firsttrue(var_tmp == vol7dtmp%datiattr%d)
1684 ier=idba_enq(this%handle,starbtable,&
1685 vol7dtmp%voldatiattrd(indana,indtime,indlevel,indtimerange,&
1686 inddativarattr,indnetwork,inddatiattr))
1688 if(attrkind(iii) ==
"c")
then 1689 inddativarattr = firsttrue(buffer(i)%btable == vol7dtmp%dativarattr%c%btable)
1690 inddatiattr = firsttrue(var_tmp == vol7dtmp%datiattr%c)
1691 ier=idba_enq(this%handle,starbtable,&
1692 vol7dtmp%voldatiattrc(indana,indtime,indlevel,indtimerange,&
1693 inddativarattr,indnetwork,inddatiattr))
1698 inddativarattr = firsttrue(buffer(i)%btable == vol7dtmp%dativarattr%c%btable)
1699 inddatiattr = firsttrue(var_tmp == vol7dtmp%datiattr%c)
1700 ier=idba_enq(this%handle,starbtable,&
1701 vol7dtmp%voldatiattrc(indana,indtime,indlevel,indtimerange,&
1702 inddativarattr,indnetwork,inddatiattr))
1722 DO ii = 1,
SIZE(anaattr)
1723 nanavarattr = nanavarattr + 1
1724 IF (nanavarattr > 1) starvarlist(len_trim(starvarlist)+1:) =
',' 1725 starvarlist(len_trim(starvarlist)+1:) = trim(anaattr(ii))
1733 indana = firsttrue(bufferana(i)%ana == vol7dtmp%ana)
1738 indnetwork = firsttrue(bufferana(i)%network == vol7dtmp%network)
1741 if (indana < 1 .or. indnetwork < 1 )cycle
1745 if(
c_e(bufferana(i)%dator))
then 1746 indanavar = firsttrue(bufferana(i)%btable == vol7dtmp%anavar%r%btable)
1747 vol7dtmp%volanar( indana,indanavar,indnetwork ) = bufferana(i)%dator
1749 if(
c_e(bufferana(i)%datoi))
then 1750 indanavar = firsttrue(bufferana(i)%btable == vol7dtmp%anavar%i%btable)
1751 vol7dtmp%volanai( indana,indanavar,indnetwork ) = bufferana(i)%datoi
1753 if(
c_e(bufferana(i)%datob))
then 1754 indanavar = firsttrue(bufferana(i)%btable == vol7dtmp%anavar%b%btable)
1755 vol7dtmp%volanab( indana,indanavar,indnetwork ) = bufferana(i)%datob
1757 if(
c_e(bufferana(i)%datod))
then 1758 indanavar = firsttrue(bufferana(i)%btable == vol7dtmp%anavar%d%btable)
1759 vol7dtmp%volanad( indana,indanavar,indnetwork ) = bufferana(i)%datod
1761 if(
c_e(bufferana(i)%datoc))
then 1762 indanavar = firsttrue(bufferana(i)%btable == vol7dtmp%anavar%c%btable)
1763 vol7dtmp%volanac( indana,indanavar,indnetwork ) = bufferana(i)%datoc
1770 CALL l4f_category_log(this%category,l4f_debug,
'unsetall handle_staz')
1772 ier=idba_unsetall(this%handle_staz)
1773 ier=idba_set(this%handle_staz,
"*context_id",bufferana(i)%data_id)
1774 ier=idba_set(this%handle_staz,
"*var_related",bufferana(i)%btable)
1777 ier=idba_set(this%handle_staz,
"*varlist",starvarlist )
1778 ier=idba_voglioancora(this%handle_staz,nn)
1782 ier=idba_ancora(this%handle_staz,starbtable)
1784 indattr = firsttrue(anaattr == starbtable)
1785 IF (indattr<1) cycle
1788 call init (var_tmp, btable=starbtable)
1791 if (
present(anaattrkind))
then 1792 iii=( firsttrue(anaattr == starbtable))
1796 if(anaattrkind(iii) ==
"r")
then 1797 indanavarattr = firsttrue(bufferana(i)%btable == vol7dtmp%anavarattr%r%btable)
1798 indanaattr = firsttrue(var_tmp == vol7dtmp%anaattr%r)
1799 ier=idba_enq(this%handle_staz,starbtable,&
1800 vol7dtmp%volanaattrr(indana,indanavarattr,indnetwork,indanaattr))
1802 if(anaattrkind(iii) ==
"i")
then 1803 indanavarattr = firsttrue(bufferana(i)%btable == vol7dtmp%anavarattr%i%btable)
1804 indanaattr = firsttrue(var_tmp == vol7dtmp%anaattr%i)
1805 ier=idba_enq(this%handle_staz,starbtable,&
1806 vol7dtmp%volanaattri(indana,indanavarattr,indnetwork,indanaattr))
1808 if(anaattrkind(iii) ==
"b")
then 1809 indanavarattr = firsttrue(bufferana(i)%btable == vol7dtmp%anavarattr%b%btable)
1810 indanaattr = firsttrue(var_tmp == vol7dtmp%anaattr%b)
1811 ier=idba_enq(this%handle_staz,starbtable,&
1812 vol7dtmp%volanaattrb(indana,indanavarattr,indnetwork,indanaattr))
1814 if(anaattrkind(iii) ==
"d")
then 1815 indanavarattr = firsttrue(bufferana(i)%btable == vol7dtmp%anavarattr%d%btable)
1816 indanaattr = firsttrue(var_tmp == vol7dtmp%anaattr%d)
1817 ier=idba_enq(this%handle_staz,starbtable,&
1818 vol7dtmp%volanaattrd(indana,indanavarattr,indnetwork,indanaattr))
1820 if(anaattrkind(iii) ==
"c")
then 1821 indanavarattr = firsttrue(bufferana(i)%btable == vol7dtmp%anavarattr%c%btable)
1822 indanaattr = firsttrue(var_tmp == vol7dtmp%anaattr%c)
1823 ier=idba_enq(this%handle_staz,starbtable,&
1824 vol7dtmp%volanaattrc(indana,indanavarattr,indnetwork,indanaattr))
1829 indanavarattr = firsttrue(bufferana(i)%btable == vol7dtmp%anavarattr%c%btable)
1830 indanaattr = firsttrue(var_tmp == vol7dtmp%anaattr%c)
1831 ier=idba_enq(this%handle,starbtable,&
1832 vol7dtmp%volanaattrc(indana,indanavarattr,indnetwork,indanaattr))
1843 deallocate (bufferana)
1846 CALL vol7d_merge(this%vol7d, vol7dtmp,
sort=.true.)
1850 call vol7d_set_attr_ind(this%vol7d)
1852 call vol7d_dballe_set_var_du(this%vol7d)
1866 deallocate(lvar,lanavar)
1869 END SUBROUTINE vol7d_dballe_importvvns_dba
1880 SUBROUTINE vol7d_dballe_export(this, network, coordmin, coordmax,&
1881 timei, timef,level,timerange,var,attr,anavar,anaattr,attr_only,template,ana)
1883 TYPE(vol7d_dballe),
INTENT(inout) :: this
1884 character(len=network_name_len),
INTENT(in),
optional :: network
1887 TYPE(geo_coord),
INTENT(in),
optional :: coordmin,coordmax
1888 TYPE(vol7d_ana),
INTENT(inout),
optional :: ana
1890 TYPE(datetime),
INTENT(in),
optional :: timei, timef
1891 TYPE(vol7d_level),
INTENT(in),
optional :: level
1892 TYPE(vol7d_timerange),
INTENT(in),
optional :: timerange
1895 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: var(:),attr(:),anavar(:),anaattr(:)
1899 logical,
intent(in),
optional :: attr_only
1902 character(len=*),
intent(in),
optional :: template
1943 logical,
allocatable :: lnetwork(:),llevel(:),ltimerange(:)
1944 integer,
allocatable :: ana_id(:,:)
1945 logical :: write,writeattr,lattr_only, generic_frag
1946 character(len=80) :: ltemplate
1951 integer :: year,month,day,hour,minute,sec,msec
1952 integer :: nstaz,ntime,ntimerange,nlevel,nnetwork
1955 INTEGER :: i,ii,iii,iiii,iiiii,iiiiii,a,ind,inddatiattr,indanaattr,ier
1957 INTEGER(kind=int_l) :: ilat,ilon
1961 integer :: ndativarr,ndatiattrr
1962 integer :: ndativari,ndatiattri
1963 integer :: ndativarb,ndatiattrb
1964 integer :: ndativard,ndatiattrd
1965 integer :: ndativarc,ndatiattrc
1967 integer :: nanavarr,nanaattrr
1968 integer :: nanavari,nanaattri
1969 integer :: nanavarb,nanaattrb
1970 integer :: nanavard,nanaattrd
1971 integer :: nanavarc,nanaattrc
1973 logical,
allocatable :: lvarr(:),lattrr(:)
1974 logical,
allocatable :: lvari(:),lattri(:)
1975 logical,
allocatable :: lvarb(:),lattrb(:)
1976 logical,
allocatable :: lvard(:),lattrd(:)
1977 logical,
allocatable :: lvarc(:),lattrc(:)
1979 logical,
allocatable :: lanavarr(:),lanaattrr(:)
1980 logical,
allocatable :: lanavari(:),lanaattri(:)
1981 logical,
allocatable :: lanavarb(:),lanaattrb(:)
1982 logical,
allocatable :: lanavard(:),lanaattrd(:)
1983 logical,
allocatable :: lanavarc(:),lanaattrc(:)
2008 call vol7d_alloc_vol(this%vol7d)
2009 nstaz=
size(this%vol7d%ana(:))
2011 ntimerange=
size(this%vol7d%timerange(:))
2012 allocate (ltimerange(ntimerange))
2015 if (
present(timerange))
then 2016 where (timerange == this%vol7d%timerange(:))
2017 ltimerange(:)=.true.
2023 nlevel=
size(this%vol7d%level(:))
2024 allocate (llevel(nlevel))
2027 if (
present(level))
then 2028 where (level == this%vol7d%level(:))
2035 if (
present(attr_only))
then 2036 lattr_only=attr_only
2041 if ( .not.
associated(this%data_id))
then 2046 nnetwork=
size(this%vol7d%network(:))
2047 ntime=
size(this%vol7d%time(:))
2049 allocate (lnetwork(nnetwork))
2051 allocate (ana_id(nstaz,nnetwork))
2055 if (
present(network))
then 2056 where (network == this%vol7d%network(:)%name)
2063 ltemplate=optio_c(template,len(ltemplate))
2064 if (template ==
"generic-frag")
then 2069 generic_frag=.false.
2076 #undef VOL7D_POLY_TYPES_V 2077 #define VOL7D_POLY_TYPES_V r 2079 call l4f_category_log(this%category,l4f_debug,
"macro nana tipo r")
2081 #include "vol7d_dballe_class_nana.F90" Functions that return a trimmed CHARACTER representation of the input variable.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Restituiscono il valore dell'oggetto nella forma desiderata.
Costruttori per le classi datetime e timedelta.