libsim  Versione6.3.0

◆ vol7d_dballe_importvvns_dba()

subroutine vol7d_dballeold_class::vol7d_dballe_importvvns_dba ( type(vol7d_dballe), intent(inout)  this,
character(len=*), dimension(:), intent(in), optional  var,
type(vol7d_network), intent(in), optional  network,
type(geo_coord), intent(inout), optional  coordmin,
type(geo_coord), intent(inout), optional  coordmax,
type(datetime), intent(in), optional  timei,
type(datetime), intent(in), optional  timef,
type(vol7d_level), intent(in), optional  level,
type(vol7d_timerange), intent(in), optional  timerange,
type(vol7d_network), intent(in), optional  set_network,
character(len=*), dimension(:), intent(in), optional  attr,
character(len=*), dimension(:), intent(in), optional  anavar,
character(len=*), dimension(:), intent(in), optional  anaattr,
character(len=*), dimension(:), intent(in), optional  varkind,
character(len=*), dimension(:), intent(in), optional  attrkind,
character(len=*), dimension(:), intent(in), optional  anavarkind,
character(len=*), dimension(:), intent(in), optional  anaattrkind,
logical, intent(in), optional  anaonly,
type(vol7d_ana), intent(inout), optional  ana 
)
private

Identica a vol7d_dballe_importvsns con var vettore.

import da DB-all.e

Parametri
[in,out]thisoggetto vol7d_dballe
Da fare:
sostituire qui sotto con struttura case:

Definizione alla linea 761 del file vol7d_dballeold_class.F90.

761 
762 if (present(timef)) then
763  if (c_e(timef)) then
764 #ifdef DEBUG
765  CALL l4f_category_log(this%category,l4f_debug,'query timef:'//to_char(timef))
766 #endif
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)
770  !print *,"datemax",year,month,day,hour,minute,sec
771  end if
772 end if
773 
774 
775 nvar=0
776 
777 !if (any(c_e(lvar)) .and. .not. optio_log(anaonly)) then
778 if (any(c_e(lvar)) .and. .not. optio_log(anaonly)) then
779  !usefull for anaonly starting from dballe 6.6
780 
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()
784  ENDIF
785 
786  ! creo la stringa con l'elenco
787  varlist = ''
788  DO i = 1, SIZE(lvar)
789  nvar = nvar + 1
790  IF (nvar > 1) varlist(len_trim(varlist)+1:) = ','
791  varlist(len_trim(varlist)+1:) = trim(lvar(i))
792  ENDDO
793  !print *,"varlist",varlist
794 
795 #ifdef DEBUG
796  CALL l4f_category_log(this%category,l4f_debug,'query varlist:'//t2c(SIZE(lvar))//":"//varlist)
797 #endif
798  if (varlist /= '' ) ier=idba_set(this%handle, "varlist",varlist )
799 
800 end if
801 
802 if (c_e(ltimerange))then
803 #ifdef DEBUG
804  CALL l4f_category_log(this%category,l4f_debug,'query timerange:'//to_char(timerange))
805 #endif
806  ier=idba_settimerange(this%handle, timerange%timerange, timerange%p1, timerange%p2)
807 end if
808 
809 if (c_e(llevel))then
810 #ifdef DEBUG
811  CALL l4f_category_log(this%category,l4f_debug,'query level:'//to_char(level))
812 #endif
813  ier=idba_setlevel(this%handle, level%level1, level%l1,level%level2, level%l2)
814 end if
815 
816 ier=idba_voglioquesto(this%handle,n)
817 !print*,"numero di dati ",N
818 #ifdef DEBUG
819 CALL l4f_category_log(this%category,l4f_debug,'numero di dati:'//t2c(n))
820 #endif
821 
822 if (optio_log(anaonly)) n=0
823 
824 !ora che so quanti dati ho alloco la memoria per buffer
825 allocate(buffer(n),stat=istat)
826 IF (istat/= 0) THEN
827  CALL l4f_category_log(this%category,l4f_error,'cannot allocate ' &
828  //trim(to_char(n))//' buffer elements')
829  CALL raise_fatal_error()
830 ENDIF
831 
832 
833 ! dammi tutti i dati
834 do i=1,n
835 
836  ier=idba_dammelo(this%handle,btable)
837 
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)
843  !print *,"trovato network",rep_memo
844 
845  !nbtable=btable_numerico(btable)
846  ! ind = firsttrue(qccli%v7d%dativar%r(:)%btable == nbtable)
847  ! IF (ind<1) cycle ! non c'e'
848 
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
854 
855  if (any(c_e(lvar)).and. present(varkind))then
856  ii= index_c(lvar, btable)
857  if (ii > 0)then
858  !print*, "indici",ii, btable,(varkind(ii))
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)
864  end if
865  else
866  ier=idba_enq(this%handle,btable,buffer(i)%datoc) !char is default
867  end if
868 
869  !metto in memoria l'identificatore numerico dei dati
870  !print*,buffer(i)%data_id
871  ier=idba_enq(this%handle,"context_id",buffer(i)%data_id)
872 
873  !recupero i dati di anagrafica
874  ier=idba_enq(this%handle,"lat", ilat)
875  ier=idba_enq(this%handle,"lon", ilon)
876  ier=idba_enq(this%handle,"ident",ident)
877 
878 !!$ print*,"ident",ident
879 !!$ do ier=1,len(ident)
880 !!$ print *,iachar(ident(ier:ier))
881 !!$ end do
882 
883  !bufferizzo il contesto
884  !print *,"lat,lon,ident",lat,lon,ident
885  !print*,year,month,day,hour,minute,sec
886  !print*,btable,dato,buffer(i)%datiattrb
887 
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
894 
895  ! take in account time_definition
896  if (this%vol7d%time_definition == 0) buffer(i)%time = buffer(i)%time - &
897  timedelta_new(sec=buffer(i)%timerange%p1)
898 
899 end do
900 
901 ! ----------------> anagrafica
902 
903 !ora legge tutti i dati di anagrafica e li mette in bufferana
904 
905 ier=idba_unsetall(this%handle_staz)
906 #ifdef DEBUG
907 CALL l4f_category_log(this%category,l4f_debug,'unsetall handle_staz')
908 #endif
909 
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")
912 
913 if (present(coordmin)) then
914 ! CALL geo_coord_to_geo(coordmin)
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)
918 end if
919 
920 if (present(coordmax)) then
921 ! CALL geo_coord_to_geo(coordmax)
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)
925 end if
926 
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)
933 ! mobile ignored
934  ier=idba_set(this%handle_staz,"mobile",1)
935  else
936  ier=idba_set(this%handle_staz,"mobile",0)
937  end if
938 end if
939 
940 nanavar=0
941 
942 if (size (lanavar) > 0 ) then
943  ! creo la stringa con l'elenco
944  varlist = ''
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))
949  ENDDO
950 !!$ print *,"varlist :",trim(varlist)
951 !!$ ier=idba_set(this%handle_staz, "varlist",trim(varlist))
952 
953 end if
954 
955 
956 ier=idba_setcontextana(this%handle_staz)
957 ier=idba_voglioquesto(this%handle_staz,n_ana)
958 !!$print*,"numero di dati ",N_ana
959 
960 !ora che so quanti dati ho alloco la memoria per bufferana
961 allocate(bufferana(n_ana),stat=istat)
962 if (istat/= 0) THEN
963  CALL l4f_category_log(this%category,l4f_error,'cannot allocate ' &
964  //trim(to_char(n_ana))//' bufferana elements')
965  CALL raise_fatal_error()
966 ENDIF
967 
968 
969 ! dammi tutti i dati di anagrafica
970 do i=1,n_ana
971  call init(bufferana(i)%ana)
972  call init(bufferana(i)%network)
973 
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
980 
981  ier=idba_dammelo(this%handle_staz,btable)
982 
983 
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)
989  !print *,"trovato network",rep_memo
990  !nbtable=btable_numerico(btable)
991  ! ind = firsttrue(qccli%v7d%dativar%r(:)%btable == nbtable)
992  ! IF (ind<1) cycle ! non c'e'
993 
994 
995  !metto in memoria l'identificatore numerico dei dati
996  !print*,bufferana(i)%data_id
997  ier=idba_enq(this%handle_staz,"context_id",bufferana(i)%data_id)
998 
999  !recupero i dati di anagrafica
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)
1003 
1004 
1005  !bufferizzo il contesto
1006 
1007  call init(bufferana(i)%ana,ilat=ilat,ilon=ilon,ident=ident)
1008  call init(bufferana(i)%network, rep_memo)
1009 
1010  !salto lat lon e ident e network
1011  if (btable == "B05001" .or. btable == "B06001" .or. btable == "B01011" .or. btable == "B01194" ) cycle
1012 
1013  if ( size(lanavar) > 0 .and. present(anavarkind))then
1014  ii= index_c(lanavar, btable)
1015  if (ii > 0)then
1016  !print*, "indici",ii, btable,(varkind(ii))
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)
1022  end if
1023  else
1024  ier=idba_enq(this%handle_staz,btable,bufferana(i)%datoc) !char is default
1025  !print*,"dato anagrafica",btable," ",bufferana(i)%dator
1026  end if
1027 
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
1032 
1033 end do
1034 
1035 ! ----------------> anagrafica fine
1036 
1037 if (.not. any(c_e(lvar)))then
1038  nvar = count_distinct(buffer%btable, back=.true.)
1039 end if
1040 
1041 if (optio_log(anaonly)) then
1042  nana = count_distinct(bufferana%ana, back=.true.)
1043 else
1044  nana = count_distinct(buffer%ana, back=.true.)
1045 end if
1046 
1047 if(ldegnet) then
1048  nnetwork=1
1049 else
1050  if (optio_log(anaonly)) then
1051  nnetwork = count_distinct(bufferana%network, back=.true.)
1052  else
1053  nnetwork = count_distinct(buffer%network, back=.true.)
1054  end if
1055 end if
1056 
1057 
1058 ntime = count_distinct(buffer%time, back=.true.)
1059 ntimerange = count_distinct(buffer%timerange, back=.true.)
1060 nlevel = count_distinct(buffer%level, back=.true.)
1061 
1062 
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")
1069 
1070 else
1071  ndativarr= 0
1072  ndativari= 0
1073  ndativarb= 0
1074  ndativard= 0
1075  ndativarc= nvar
1076 end if
1077 
1078 !print *, "nana=",nana," ntime=",ntime," ntimerange=",ntimerange, &
1079 !" nlevel=",nlevel," nnetwork=",nnetwork," ndativarr=",ndativarr
1080 
1081 if (lattr)then
1082 
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")
1089 
1090  else
1091  ndatiattrr= 0
1092  ndatiattri= 0
1093  ndatiattrb= 0
1094  ndatiattrd= 0
1095  ndatiattrc= size(attr)
1096  end if
1097 
1098 else
1099  ndatiattrr=0
1100  ndatiattri=0
1101  ndatiattrb=0
1102  ndatiattrd=0
1103  ndatiattrc=0
1104 end if
1105 
1106 ndativarattrr=0
1107 ndativarattri=0
1108 ndativarattrb=0
1109 ndativarattrd=0
1110 ndativarattrc=0
1111 
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
1117 
1118 
1119 ! ----------------> anagrafica
1120 
1121 if ( size(lanavar) == 0 )then
1122  nanavar = count_distinct(bufferana%btable, back=.true.,mask=(bufferana%btable /= dba_mvc))
1123 end if
1124 
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")
1131 
1132 else
1133  nanavarr= 0
1134  nanavari= 0
1135  nanavarb= 0
1136  nanavard= 0
1137  nanavarc= nanavar
1138 end if
1139 
1140 !print *, "nana=",nana," ntime=",ntime," ntimerange=",ntimerange, &
1141 !" nlevel=",nlevel," nnetwork=",nnetwork," ndativarr=",ndativarr
1142 
1143 if (lanaattr)then
1144 
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")
1151 
1152  else
1153  nanaattrr= 0
1154  nanaattri= 0
1155  nanaattrb= 0
1156  nanaattrd= 0
1157  nanaattrc= size(anaattr)
1158  end if
1159 
1160 else
1161  nanaattrr=0
1162  nanaattri=0
1163  nanaattrb=0
1164  nanaattrd=0
1165  nanaattrc=0
1166 end if
1167 
1168 nanavarattrr=0
1169 nanavarattri=0
1170 nanavarattrb=0
1171 nanavarattrd=0
1172 nanavarattrc=0
1173 
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
1179 
1180 ! ----------------> anagrafica fine
1181 
1182 
1183 CALL init(vol7dtmp,time_definition=this%vol7d%time_definition)
1184 
1185 !print*,"ho fatto init"
1186 
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)
1204 
1205 !!$print *, "nana=",nana, "ntime=",ntime, "ntimerange=",ntimerange, &
1206 !!$ "nlevel=",nlevel, "nnetwork=",nnetwork, &
1207 !!$ "ndativarr=",ndativarr, "ndativari=",ndativari, &
1208 !!$ "ndativarb=",ndativarb, "ndativard=",ndativard, "ndativarc=",ndativarc,&
1209 !!$ "ndatiattrr=",ndatiattrr, "ndatiattri=",ndatiattri, "ndatiattrb=",ndatiattrb,&
1210 !!$ "ndatiattrd=",ndatiattrd, "ndatiattrc=",ndatiattrc,&
1211 !!$ "ndativarattrr=",ndativarattrr, "ndativarattri=",ndativarattri, "ndativarattrb=",ndativarattrb,&
1212 !!$ "ndativarattrd=",ndativarattrd, "ndativarattrc=",ndativarattrc
1213 !!$print*,"ho fatto alloc"
1214 
1215 if (optio_log(anaonly)) then
1216  vol7dtmp%ana=pack_distinct(bufferana%ana, nana, back=.true.)
1217 else
1218  vol7dtmp%ana=pack_distinct(buffer%ana, nana, back=.true.)
1219 endif
1220 
1221 vol7dtmp%time=pack_distinct(buffer%time, ntime, back=.true.)
1222 call sort(vol7dtmp%time)
1223 
1224 vol7dtmp%timerange=pack_distinct(buffer%timerange, ntimerange, back=.true.)
1225 call sort(vol7dtmp%timerange)
1226 
1227 vol7dtmp%level=pack_distinct(buffer%level, nlevel, back=.true.)
1228 call sort(vol7dtmp%level)
1229 
1230 if(ldegnet)then
1231  vol7dtmp%network(1)=set_network
1232 else
1233  if (optio_log(anaonly)) then
1234  vol7dtmp%network=pack_distinct(bufferana%network, nnetwork, back=.true.)
1235  else
1236  vol7dtmp%network=pack_distinct(buffer%network, nnetwork, back=.true.)
1237  end if
1238 end if
1239 
1240 !print*,"reti presenti", vol7dtmp%network%name,buffer%network%name
1241 
1242 if (any(c_e(lvar)).and. present(varkind))then
1243 
1244  ir=0
1245  ii=0
1246  ib=0
1247  id=0
1248  ic=0
1249 
1250  do i=1,size(varkind)
1251  if (varkind(i) == "r") then
1252  ir=ir+1
1253  call init (vol7dtmp%dativar%r(ir), btable=var(i))
1254  end if
1255  if (varkind(i) == "i") then
1256  ii=ii+1
1257  call init (vol7dtmp%dativar%i(ii), btable=var(i))
1258  end if
1259  if (varkind(i) == "b") then
1260  ib=ib+1
1261  call init (vol7dtmp%dativar%b(ib), btable=var(i))
1262  end if
1263  if (varkind(i) == "d") then
1264  id=id+1
1265  call init (vol7dtmp%dativar%d(id), btable=var(i))
1266  end if
1267  if (varkind(i) == "c") then
1268  ic=ic+1
1269  call init (vol7dtmp%dativar%c(ic), btable=var(i))
1270  end if
1271  end do
1272 else if (any(c_e(lvar)))then
1273  do i=1, nvar
1274  call init (vol7dtmp%dativar%c(i), btable=var(i))
1275  end do
1276 else
1277 
1278  do i=1,ndativarc
1279  call init(vol7dtmp%dativar%c(i))
1280  end do
1281 
1282  if (ndativarc > 0) then
1283  call pack_distinct_c(buffer%btable, vol7dtmp%dativar%c%btable, back=.true.,mask=(buffer%btable /= dba_mvc))
1284  end if
1285 
1286 end if
1287 
1288 
1289 
1290 if ( present(attrkind).and. present(attr).and. any(c_e(lvar)))then
1291 
1292  ir=0
1293  ii=0
1294  ib=0
1295  id=0
1296  ic=0
1297 
1298  do i=1,size(lvar)
1299 
1300  if ( ndativarattrr > 0 )then
1301  ir=ir+1
1302  call init (vol7dtmp%dativarattr%r(ir), btable=lvar(i))
1303  end if
1304 
1305  if ( ndativarattri > 0 )then
1306  ii=ii+1
1307  call init (vol7dtmp%dativarattr%i(ii), btable=lvar(i))
1308  end if
1309 
1310  if ( ndativarattrb > 0 )then
1311  ib=ib+1
1312  call init (vol7dtmp%dativarattr%b(ib), btable=lvar(i))
1313  end if
1314 
1315  if ( ndativarattrd > 0 )then
1316  id=id+1
1317  call init (vol7dtmp%dativarattr%d(id), btable=lvar(i))
1318  end if
1319 
1320  if ( ndativarattrc > 0 )then
1321  ic=ic+1
1322  call init (vol7dtmp%dativarattr%c(ic), btable=lvar(i))
1323  end if
1324 
1325  end do
1326 
1327 else if (present(attr).and. any(c_e(lvar)))then
1328 
1329  do i=1,size(lvar)
1330  if ( ndativarattrc > 0 )call init (vol7dtmp%dativarattr%c(i), btable=lvar(i))
1331  end do
1332 
1333 else if (associated(vol7dtmp%dativarattr%c).and. associated(vol7dtmp%dativar%c)) then
1334 
1335  vol7dtmp%dativarattr%c=vol7dtmp%dativar%c
1336 
1337 end if
1338 
1339 
1340 if (present(attrkind).and. lattr)then
1341 
1342  ir=0
1343  ii=0
1344  ib=0
1345  id=0
1346  ic=0
1347 
1348  do i=1,size(attrkind)
1349 
1350  if (attrkind(i) == "r") then
1351  ir=ir+1
1352  call init (vol7dtmp%datiattr%r(ir), btable=attr(i))
1353  end if
1354  if (attrkind(i) == "i") then
1355  ii=ii+1
1356  call init (vol7dtmp%datiattr%i(ii), btable=attr(i))
1357  end if
1358  if (attrkind(i) == "b") then
1359  ib=ib+1
1360  call init (vol7dtmp%datiattr%b(ib), btable=attr(i))
1361  end if
1362  if (attrkind(i) == "d") then
1363  id=id+1
1364  call init (vol7dtmp%datiattr%d(id), btable=attr(i))
1365  end if
1366  if (attrkind(i) == "c") then
1367  ic=ic+1
1368  call init (vol7dtmp%datiattr%c(ic), btable=attr(i))
1369  end if
1370  end do
1371 else if (present(attr))then
1372 
1373  do i=1, size(attr)
1374  call init (vol7dtmp%datiattr%c(i), btable=attr(i))
1375  end do
1376 
1377 end if
1378 
1379 !-----------------------> anagrafica
1380 
1381 if ( size(lanavar) > 0 .and. present(anavarkind))then
1382 
1383  ir=0
1384  ii=0
1385  ib=0
1386  id=0
1387  ic=0
1388 
1389  do i=1,size(anavarkind)
1390  if (anavarkind(i) == "r") then
1391  ir=ir+1
1392  call init (vol7dtmp%anavar%r(ir), btable=anavar(i))
1393  end if
1394  if (anavarkind(i) == "i") then
1395  ii=ii+1
1396  call init (vol7dtmp%anavar%i(ii), btable=anavar(i))
1397  end if
1398  if (anavarkind(i) == "b") then
1399  ib=ib+1
1400  call init (vol7dtmp%anavar%b(ib), btable=anavar(i))
1401  end if
1402  if (anavarkind(i) == "d") then
1403  id=id+1
1404  call init (vol7dtmp%anavar%d(id), btable=anavar(i))
1405  end if
1406  if (anavarkind(i) == "c") then
1407  ic=ic+1
1408  call init (vol7dtmp%anavar%c(ic), btable=anavar(i))
1409  end if
1410  end do
1411 else if ( size(lanavar) > 0 )then
1412 
1413  do i=1, nanavar
1414  call init (vol7dtmp%anavar%c(i), btable=anavar(i))
1415  end do
1416 
1417 else
1418 
1419  do i=1,nanavarc
1420  call init(vol7dtmp%anavar%c(i))
1421  end do
1422  if (nanavarc > 0) then
1423  call pack_distinct_c(bufferana%btable, vol7dtmp%anavar%c%btable, back=.true.,mask=(bufferana%btable /= dba_mvc))
1424  end if
1425 end if
1426 
1427 
1428 
1429 if ( present(anaattrkind) .and. present(anaattr) .and. size(anavar) > 0 )then
1430 
1431  ir=0
1432  ii=0
1433  ib=0
1434  id=0
1435  ic=0
1436 
1437  do i=1,size(anavar)
1438 
1439  if ( nanavarattrr > 0 )then
1440  ir=ir+1
1441  call init (vol7dtmp%anavarattr%r(ir), btable=anavar(i))
1442  end if
1443 
1444  if ( nanavarattri > 0 )then
1445  ii=ii+1
1446  call init (vol7dtmp%anavarattr%i(ii), btable=anavar(i))
1447  end if
1448 
1449  if ( nanavarattrb > 0 )then
1450  ib=ib+1
1451  call init (vol7dtmp%anavarattr%b(ib), btable=anavar(i))
1452  end if
1453 
1454  if ( nanavarattrd > 0 )then
1455  id=id+1
1456  call init (vol7dtmp%anavarattr%d(id), btable=anavar(i))
1457  end if
1458 
1459  if ( nanavarattrc > 0 )then
1460  ic=ic+1
1461  call init (vol7dtmp%anavarattr%c(ic), btable=anavar(i))
1462  end if
1463 
1464  end do
1465 
1466 else if (present(anaattr) .and. size(anavar) > 0 )then
1467 
1468  do i=1,size(anavar)
1469  if ( nanavarattrc > 0 )call init(vol7dtmp%anavarattr%c(i), btable=anavar(i))
1470  end do
1471 
1472 else if (associated(vol7dtmp%anavarattr%c) .and. associated(vol7dtmp%anavar%c)) then
1473 
1474  vol7dtmp%anavarattr%c=vol7dtmp%anavar%c
1475 
1476 end if
1477 
1478 
1479 if (present(anaattrkind).and. present(anaattr))then
1480 
1481  ir=0
1482  ii=0
1483  ib=0
1484  id=0
1485  ic=0
1486 
1487  do i=1,size(anaattrkind)
1488 
1489  if (anaattrkind(i) == "r") then
1490  ir=ir+1
1491  call init (vol7dtmp%anaattr%r(ir), btable=anaattr(i))
1492  end if
1493  if (anaattrkind(i) == "i") then
1494  ii=ii+1
1495  call init (vol7dtmp%anaattr%i(ii), btable=anaattr(i))
1496  end if
1497  if (anaattrkind(i) == "b") then
1498  ib=ib+1
1499  call init (vol7dtmp%anaattr%b(ib), btable=anaattr(i))
1500  end if
1501  if (anaattrkind(i) == "d") then
1502  id=id+1
1503  call init (vol7dtmp%anaattr%d(id), btable=anaattr(i))
1504  end if
1505  if (anaattrkind(i) == "c") then
1506  ic=ic+1
1507  call init (vol7dtmp%anaattr%c(ic), btable=anaattr(i))
1508  end if
1509  end do
1510 else if (present(anaattr))then
1511 
1512  do i=1, size(anaattr)
1513  call init (vol7dtmp%anaattr%c(i), btable=anaattr(i))
1514  end do
1515 
1516 end if
1517 
1518 
1519 !print*,"numero variabili anagrafica",size(vol7dtmp%anavar%r)
1520 !do i=1,size(vol7dtmp%anavar%r)
1521 ! print*,"elenco variabili anagrafica>",vol7dtmp%anavar%r(i)%btable,"<fine"
1522 !end do
1523 
1524 !-----------------------> anagrafica fine
1525 
1526 call vol7d_alloc_vol (vol7dtmp)
1527 
1528 if (lattr) then
1529 
1530  allocate (this%data_id( nana, ntime, nlevel, ntimerange, nnetwork),stat=istat)
1531  if (istat/= 0) THEN
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()
1535 
1536  ENDIF
1537 
1538  this%data_id=dba_mvi
1539 
1540 else
1541 
1542  nullify(this%data_id)
1543 
1544 end if
1545 
1546 !vol7dtmp%voldatir=DBA_MVR
1547 !vol7dtmp%voldatii=DBA_MVI
1548 !vol7dtmp%voldatib=DBA_MVB
1549 !vol7dtmp%voldatid=DBA_MVD
1550 !vol7dtmp%voldatic=DBA_MVC
1551 !vol7dtmp%voldatiattrr=DBA_MVR
1552 !vol7dtmp%voldatiattri=DBA_MVI
1553 !vol7dtmp%voldatiattrb=DBA_MVB
1554 !vol7dtmp%voldatiattrd=DBA_MVD
1555 !vol7dtmp%voldatiattrc=DBA_MVC
1556 
1557 if (lattr)then
1558 
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()
1562  ENDIF
1563 
1564  ! creo la stringa con l'elenco delle variabili di attributo
1565  starvarlist = ''
1566  nvarattr=0
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))
1571  ENDDO
1572  !print *,"starvarlist",starvarlist
1573 
1574 end if
1575 
1576 do i =1, n
1577 
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)
1582  if (ldegnet)then
1583  indnetwork=1
1584  else
1585  indnetwork = firsttrue(buffer(i)%network == vol7dtmp%network)
1586  endif
1587  !print *, indana,indtime,indlevel,indtimerange,indnetwork
1588 
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 &
1593  ) = buffer(i)%dator
1594  end if
1595 
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 &
1600  ) = buffer(i)%datoi
1601  end if
1602 
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 &
1607  ) = buffer(i)%datob
1608  end if
1609 
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 &
1614  ) = buffer(i)%datod
1615  end if
1616 
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 &
1621  ) = buffer(i)%datoc
1622  end if
1623 
1624  if (lattr)then
1625 
1626  !memorizzo data_id
1627 #ifdef DEBUG
1628  !CALL l4f_category_log(this%category,L4F_DEBUG,"data_id: "//trim(to_char(buffer(i)%data_id)))
1629 #endif
1630 
1631  this%data_id(indana,indtime,indlevel,indtimerange,indnetwork)=buffer(i)%data_id
1632 
1633  ier=idba_unsetall(this%handle)
1634 #ifdef DEBUG
1635  CALL l4f_category_log(this%category,l4f_debug,'unsetall handle')
1636 #endif
1637  ier=idba_set(this%handle,"*context_id",buffer(i)%data_id)
1638  ier=idba_set(this%handle,"*var_related",buffer(i)%btable)
1639  !per ogni dato ora lavoro sugli attributi
1640  ier=idba_set(this%handle, "*varlist",starvarlist )
1641  ier=idba_voglioancora(this%handle,nn)
1642  !print*,buffer(i)%btable," numero attributi",nn
1643 
1644  do ii=1,nn ! Se ho piu` di 1 attributo devo forse trovare l'indice (ii)
1645  ier=idba_ancora(this%handle,starbtable)
1646  !print *, starbtable
1647  indattr = firsttrue(attr == starbtable)
1648  IF (indattr<1) cycle ! non c'e'
1649 
1650  call init (var_tmp, btable=starbtable)
1651 
1652  if (present(attrkind))then
1653  iii=( firsttrue(attr == starbtable))
1654  !print *,"ho letto indice attributo ",starbtable,iii
1655  if (iii > 0)then
1656 
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))
1664  end if
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))
1671  end if
1672  if(attrkind(iii) == "b") then
1673  inddativarattr = firsttrue(buffer(i)%btable == vol7dtmp%dativarattr%b%btable)
1674  inddatiattr = firsttrue(var_tmp == vol7dtmp%datiattr%b)
1675  !print *,"indici voldatiattr ",indana,indtime,indlevel,indtimerange,&
1676  !inddativarattr,indnetwork,inddatiattr
1677  ier=idba_enq(this%handle,starbtable,&
1678  vol7dtmp%voldatiattrb(indana,indtime,indlevel,indtimerange,&
1679  inddativarattr,indnetwork,inddatiattr))
1680  end if
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))
1687  end if
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))
1694  end if
1695  end if
1696  else
1697 
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)) !char is default
1703  !print*,starbtable,vol7dtmp%voldatiattrc(indana,indtime,indlevel,indtimerange,&
1704  ! inddativarattr,indnetwork,inddatiattr)
1705  end if
1706 
1707  end do
1708  end if
1709 
1710 !( voldati*(nana,ntime,nlevel,ntimerange,ndativar*,nnetwork)
1711 ! voldatiattr*(nana,ntime,nlevel,ntimerange,ndativarattr*,network,ndatiattr*) )
1712 
1713  end do
1714 
1715 !------------------------- anagrafica
1716 
1717 
1718 if (lanaattr)then
1719  ! creo la stringa con l'elenco variabili attributi di anagrafica
1720  starvarlist = ''
1721  nanavarattr=0
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))
1726  ENDDO
1727  !print *,"starvarlist",starvarlist
1728 end if
1729 
1730 
1731 do i =1, n_ana
1732 
1733  indana = firsttrue(bufferana(i)%ana == vol7dtmp%ana)
1734 
1735  if (ldegnet)then
1736  indnetwork=1
1737  else
1738  indnetwork = firsttrue(bufferana(i)%network == vol7dtmp%network)
1739  endif
1740 
1741  if (indana < 1 .or. indnetwork < 1 )cycle
1742 
1743  !print *, indana,indtime,indlevel,indtimerange,indnetwork
1744 
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
1748  end if
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
1752  end if
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
1756  end if
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
1760  end if
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
1764  end if
1765 
1766 
1767  if (lanaattr)then
1768 
1769 #ifdef DEBUG
1770  CALL l4f_category_log(this%category,l4f_debug,'unsetall handle_staz')
1771 #endif
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)
1775 
1776  !per ogni dato ora lavoro sugli attributi
1777  ier=idba_set(this%handle_staz, "*varlist",starvarlist )
1778  ier=idba_voglioancora(this%handle_staz,nn)
1779  !print*,buffer(i)%dativar%btable," numero attributi",nn
1780 
1781  do ii=1,nn ! Se ho piu` di 1 attributo devo forse trovare l'indice (ii)
1782  ier=idba_ancora(this%handle_staz,starbtable)
1783  !print *, starbtable
1784  indattr = firsttrue(anaattr == starbtable)
1785  IF (indattr<1) cycle ! non c'e'
1786 
1787 
1788  call init (var_tmp, btable=starbtable)
1789 
1790 
1791  if (present(anaattrkind))then
1792  iii=( firsttrue(anaattr == starbtable))
1793  !print *,"ho letto indice attributo ",starbtable,iii
1794  if (iii > 0)then
1795 
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))
1801  end if
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))
1807  end if
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))
1813  end if
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))
1819  end if
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))
1825  end if
1826 
1827  end if
1828  else
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)) !char is default
1833  end if
1834 
1835  end do
1836  end if
1837 
1838  end do
1839 
1840 !------------------------- anagrafica fine
1841 
1842 deallocate (buffer)
1843 deallocate (bufferana)
1844 
1845 ! Smart merge
1846 CALL vol7d_merge(this%vol7d, vol7dtmp, sort=.true.)
1847 ! should we sort separately in case no merge is done?
1848 !CALL vol7d_smart_sort(this%vol7d, ltime=.TRUE., ltimerange=.TRUE., llevel=.TRUE,)
1849 
1850 call vol7d_set_attr_ind(this%vol7d)
1851 
1852 call vol7d_dballe_set_var_du(this%vol7d)
1853 
1854 !print *,"R-R",this%vol7d%dativar%r(:)%r
1855 !print *,"R-I",this%vol7d%dativar%r(:)%i
1856 !print *,"R-B",this%vol7d%dativar%r(:)%b
1857 !print *,"R-D",this%vol7d%dativar%r(:)%d
1858 !print *,"R-C",this%vol7d%dativar%r(:)%c
1859 
1860 !print *,"I-R",this%vol7d%dativar%i(:)%r
1861 !print *,"I-I",this%vol7d%dativar%i(:)%i
1862 !print *,"I-B",this%vol7d%dativar%i(:)%b
1863 !print *,"I-D",this%vol7d%dativar%i(:)%d
1864 !print *,"I-C",this%vol7d%dativar%i(:)%c
1865 
1866 deallocate(lvar,lanavar)
1867 
1868 
1869 END SUBROUTINE vol7d_dballe_importvvns_dba
1870 
1871 
1880 SUBROUTINE vol7d_dballe_export(this, network, coordmin, coordmax,&
1881  timei, timef,level,timerange,var,attr,anavar,anaattr,attr_only,template,ana)
1882 
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
1903 
1904 !!$ Conversazioni con spanezz@jabber.linux.it su gio 27 mag 2010 09:38:52 CEST:
1905 !!$ (09:39:00) pat1@jabber.linux.it/Home:
1906 !!$ ho una domanda
1907 !!$ scrivo dei bufr generici
1908 !!$ quando setto query a "message" viene chiuso un bufr
1909 !!$ posso scrive migliaia di cose senza mai mettere query a message
1910 !!$ il bufr viene piu' piccolo
1911 !!$ quindi nel generico mi conviene scrivere dopo un sensato uso di memoria ?
1912 !!$ (09:41:54) spanezz@jabber.linux.it:
1913 !!$ dipende da cosa vuoi mettere nel messaggio
1914 !!$ (09:42:21) spanezz@jabber.linux.it:
1915 !!$ puoi salvare tutto in un unico genericone se vuoi
1916 !!$ poi se lo archivi quando queri queri sempre tutto
1917 !!$ (09:42:40) pat1@jabber.linux.it/Home:
1918 !!$ nel caso sto scrivendo un volume v7d di dati
1919 !!$ posso farne solo un bufr oppure migliaia
1920 !!$ (09:48:14) spanezz@jabber.linux.it:
1921 !!$ se non scrivi generici lui mette nel messaggio solo quello che ci sta nel template, ovviamente
1922 !!$ quindi ci sono solo un certo numero di dati che puoi settare e finiscono nell'output
1923 !!$ (09:49:38) pat1@jabber.linux.it/Home:
1924 !!$ quindi ad esempio se scrivo generici e cambio stazione me ne POSSO fregare e mettere un solo "query=message"
1925 !!$ alla fine di tutto
1926 !!$ ma se scrivo synop e faccio lo stesso scrivo solo l'ultima stazione ?
1927 !!$ (09:50:04) spanezz@jabber.linux.it:
1928 !!$ ni
1929 !!$ (09:51:41) spanezz@jabber.linux.it:
1930 !!$ la roba in cui scrivi temporaneamente i dati non è una versione in memoria di dballe (del DB di dballe intendo)
1931 !!$ in particolare, una un unico livello di anagrafica in cui ci sta una stazione e un'orario solo
1932 !!$ in particolare, ha un unico livello di anagrafica in cui ci sta una stazione e un'orario solo
1933 !!$ quindi se metti due stazioni, sovrascrivi la seconda
1934 !!$ è indicizzato per (livello, scadenza, codice variabile)
1935 !!$ se fai due prendilo con gli stessi (livello, scadenza, codice variabile), la seconda sovrascrive la prima
1936 !!$ e data ora stazione report vanno nel (livello, scadenza) di "anagrafica" (257,0, 0,0, 0,0,0)
1937 !!$ (09:56:43) pat1@jabber.linux.it/Home:
1938 !!$ quindi per scrivere N^N roba
1939 !!$ devo ciclare su (livello, scadenza, codice variabile) e ogni volta fare una prendilo
1940 !!$ poi all'esterno devo ciclare su tutto il resto e fare una prendilo con query="message"
1941 
1942 !REAL(kind=fp_geo) :: latmin,latmax,lonmin,lonmax
1943 logical, allocatable :: lnetwork(:),llevel(:),ltimerange(:)
1944 integer,allocatable :: ana_id(:,:)
1945 logical :: write,writeattr,lattr_only, generic_frag
1946 character(len=80) :: ltemplate
1947 
1948 !CHARACTER(len=6) :: btable
1949 !CHARACTER(len=7) ::starbtable
1950 
1951 integer :: year,month,day,hour,minute,sec,msec
1952 integer :: nstaz,ntime,ntimerange,nlevel,nnetwork
1953 
1954 
1955 INTEGER :: i,ii,iii,iiii,iiiii,iiiiii,a,ind,inddatiattr,indanaattr,ier
1956 
1957 INTEGER(kind=int_l) :: ilat,ilon
1958 !INTEGER(kind=int_b)::attrdatib
1959 
1960 
1961 integer :: ndativarr,ndatiattrr
1962 integer :: ndativari,ndatiattri
1963 integer :: ndativarb,ndatiattrb
1964 integer :: ndativard,ndatiattrd
1965 integer :: ndativarc,ndatiattrc
1966 
1967 integer :: nanavarr,nanaattrr
1968 integer :: nanavari,nanaattri
1969 integer :: nanavarb,nanaattrb
1970 integer :: nanavard,nanaattrd
1971 integer :: nanavarc,nanaattrc
1972 
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(:)
1978 
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(:)
1984 
1985 
1986 ndativarr=0
1987 ndatiattrr=0
1988 ndativari=0
1989 ndatiattri=0
1990 ndativarb=0
1991 ndatiattrb=0
1992 ndativard=0
1993 ndatiattrd=0
1994 ndativarc=0
1995 ndatiattrc=0
1996 
1997 nanavarr=0
1998 nanaattrr=0
1999 nanavari=0
2000 nanaattri=0
2001 nanavarb=0
2002 nanaattrb=0
2003 nanavard=0
2004 nanaattrd=0
2005 nanavarc=0
2006 nanaattrc=0
2007 
2008 call vol7d_alloc_vol(this%vol7d) ! be safe
2009 nstaz=size(this%vol7d%ana(:))
2010 
2011 ntimerange=size(this%vol7d%timerange(:))
2012 allocate (ltimerange(ntimerange))
2013 ltimerange=.false.
2014 
2015 if (present(timerange))then
2016  where (timerange == this%vol7d%timerange(:))
2017  ltimerange(:)=.true.
2018  end where
2019 else
2020  ltimerange=.true.
2021 end if
2022 
2023 nlevel=size(this%vol7d%level(:))
2024 allocate (llevel(nlevel))
2025 llevel=.false.
2026 
2027 if (present(level))then
2028  where (level == this%vol7d%level(:))
2029  llevel(:)=.true.
2030  end where
2031 else
2032  llevel=.true.
2033 end if
2034 
2035 if (present(attr_only))then
2036  lattr_only=attr_only
2037 else
2038  lattr_only=.false.
2039 end if
2040 
2041 if ( .not. associated(this%data_id))then
2042  lattr_only=.false.
2043 end if
2044 
2045 
2046 nnetwork=size(this%vol7d%network(:))
2047 ntime=size(this%vol7d%time(:))
2048 
2049 allocate (lnetwork(nnetwork))
2050 lnetwork=.false.
2051 allocate (ana_id(nstaz,nnetwork))
2052 ana_id=dba_mvi
2053 
2054 
2055 if (present(network))then
2056  where (network == this%vol7d%network(:)%name)
2057  lnetwork(:)=.true.
2058  end where
2059 else
2060  lnetwork=.true.
2061 end if
2062 
2063 ltemplate=optio_c(template,len(ltemplate))
2064 if (template == "generic-frag") then
2065  ltemplate="generic"
2066  generic_frag=.true.
2067 else
2068  ltemplate=template
2069  generic_frag=.false.
2070 end if
2071 
2072 
2073 
2074 !!!!! anagrafica
2075 
2076 #undef VOL7D_POLY_TYPES_V
2077 #define VOL7D_POLY_TYPES_V r
2078 #ifdef DEBUG
2079 call l4f_category_log(this%category,l4f_debug,"macro nana tipo r")
2080 #endif
2081 #include "vol7d_dballe_class_nana.F90"
Functions that return a trimmed CHARACTER representation of the input variable.
Restituiscono il valore dell&#39;oggetto in forma di stringa stampabile.
Restituiscono il valore dell&#39;oggetto nella forma desiderata.
Costruttori per le classi datetime e timedelta.

Generated with Doxygen.