libsim  Versione6.3.0

◆ vol7d_dballe_export()

subroutine vol7d_dballeold_class::vol7d_dballe_export ( type(vol7d_dballe), intent(inout)  this,
character(len=network_name_len), intent(in), optional  network,
type(geo_coord), intent(in), optional  coordmin,
type(geo_coord), intent(in), 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,
character(len=*), dimension(:), intent(in), optional  var,
character(len=*), dimension(:), intent(in), optional  attr,
character(len=*), dimension(:), intent(in), optional  anavar,
character(len=*), dimension(:), intent(in), optional  anaattr,
logical, intent(in), optional  attr_only,
character(len=*), intent(in), optional  template,
type(vol7d_ana), intent(inout), optional  ana 
)
private

Exporta un volume dati a un DSN DB-all.e.

Riscrive i dati nel DSN di DB-All.e con la possibilità di attivare una serie di filtri. Try to make the better work: if write on file and template is generic write ana data and attribute in separate bufr befor data if write on file and template is not generic write ana and data in the same bufr if write on db write ana and use ana_id to insert data

Parametri
[in,out]thisoggetto contenente il volume e altre info per l'accesso al DSN
[in]networknetwork da exportare
[in]coordmincoordinate minime e massime che definiscono il rettangolo di estrazione per l'esportazione
[in]coordmaxcoordinate minime e massime che definiscono il rettangolo di estrazione per l'esportazione
[in,out]anaidentificativo della stazione da exportare
[in]timeiestremi temporali dei dati da esportare
[in]timefestremi temporali dei dati da esportare
[in]levellivello selezionato per l'esportazione
[in]timerangetimerange selezionato per l'esportazione
[in]varvariabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica
[in]attrvariabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica
[in]anavarvariabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica
[in]anaattrvariabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica
[in]attr_onlypermette di riscrivere su un DSN letto precedentemente, modificando solo gli attributi ai dati, ottimizzando enormente le prestazioni: gli attributi riscritti saranno quelli con thisdata_id definito (solitamente ricopiato dall'oggetto letto)
[in]templatespecificando category.subcategory.localcategory oppure un alias ("synop", "metar","temp","generic") forza l'exportazione ad uno specifico template BUFR/CREX" the special value "generic-frag is used to generate bufr on file where ana data is reported only once at beginning and data in other bufr after
Da fare:
optimize setting and unsetting in the right place

Definizione alla linea 2095 del file vol7d_dballeold_class.F90.

2095 #define VOL7D_POLY_TYPES_V d
2096 #ifdef DEBUG
2097 call l4f_category_log(this%category,L4F_DEBUG,"macro nana tipo d")
2098 #endif
2099 #include "vol7d_dballe_class_nana.F90"
2100 #undef VOL7D_POLY_TYPES_V
2101 #define VOL7D_POLY_TYPES_V c
2102 #ifdef DEBUG
2103 call l4f_category_log(this%category,L4F_DEBUG,"macro nana tipo c")
2104 #endif
2105 #include "vol7d_dballe_class_nana.F90"
2106 #undef VOL7D_POLY_TYPES_V
2107 
2108 
2109 !!!!!!! dati
2110 
2111 #undef VOL7D_POLY_TYPES_V
2112 #define VOL7D_POLY_TYPES_V r
2113 #ifdef DEBUG
2114 call l4f_category_log(this%category,L4F_DEBUG,"macro ndati tipo r")
2115 #endif
2116 #include "vol7d_dballe_class_ndati.F90"
2117 #undef VOL7D_POLY_TYPES_V
2118 #define VOL7D_POLY_TYPES_V i
2119 #ifdef DEBUG
2120 call l4f_category_log(this%category,L4F_DEBUG,"macro ndati tipo i")
2121 #endif
2122 #include "vol7d_dballe_class_ndati.F90"
2123 #undef VOL7D_POLY_TYPES_V
2124 #define VOL7D_POLY_TYPES_V b
2125 #ifdef DEBUG
2126 call l4f_category_log(this%category,L4F_DEBUG,"macro ndati tipo b")
2127 #endif
2128 #include "vol7d_dballe_class_ndati.F90"
2129 #undef VOL7D_POLY_TYPES_V
2130 #define VOL7D_POLY_TYPES_V d
2131 #ifdef DEBUG
2132 call l4f_category_log(this%category,L4F_DEBUG,"macro ndati tipo d")
2133 #endif
2134 #include "vol7d_dballe_class_ndati.F90"
2135 #undef VOL7D_POLY_TYPES_V
2136 #define VOL7D_POLY_TYPES_V c
2137 #ifdef DEBUG
2138 call l4f_category_log(this%category,L4F_DEBUG,"macro ndati tipo c")
2139 #endif
2140 #include "vol7d_dballe_class_ndati.F90"
2141 #undef VOL7D_POLY_TYPES_V
2142 
2143 
2144 ! vital statistics data
2145 
2146 !print *,"nstaz,ntime,nlevel,ntimerange,nnetwork",nstaz,ntime,nlevel,ntimerange,nnetwork
2147 
2148 do iiiiii=1, nnetwork
2149  if (.not.lnetwork(iiiiii))cycle
2150 
2151 ! l'anagrafica su file la scrivo solo per i generici_frag or for ana_only datasets
2152  if (this%file .and. .not. generic_frag .and. ntime > 0 ) cycle
2153 
2154  do i=1, nstaz
2155 
2156  if (present(coordmin).and.present(coordmax))then
2157  if (.not. inside(this%vol7d%ana(i)%coord,coordmin,coordmax)) cycle
2158  end if
2159 
2160  CALL getval(this%vol7d%ana(i)%coord, ilat=ilat,ilon=ilon)
2161  ier=idba_unsetall(this%handle)
2162 #ifdef DEBUG
2163  CALL l4f_category_log(this%category,l4f_debug,'unsetall handle')
2164 #endif
2165  ier=idba_setcontextana(this%handle)
2166 
2167  ier=idba_set(this%handle,"lat",ilat)
2168  ier=idba_set(this%handle,"lon",ilon)
2169 
2170  if (present(ana))then
2171  if (c_e(ana%ident) .and. ana%ident /= this%vol7d%ana(i)%ident ) cycle
2172  if (c_e(ana%coord) .and. ana%coord /= this%vol7d%ana(i)%coord ) cycle
2173  end if
2174 
2175 ! this%vol7d%ana(i)%ident=cmiss
2176 
2177 !!$ print*,"ident",this%vol7d%ana(i)%ident
2178 !!$ do ier=1,len(this%vol7d%ana(i)%ident)
2179 !!$ print *,iachar(this%vol7d%ana(i)%ident(ier:ier))
2180 !!$ end do
2181 
2182  if ( c_e(this%vol7d%ana(i)%ident)) then
2183 #ifdef DEBUG
2184  call l4f_category_log(this%category,l4f_debug,"I have found a mobile station! ident: "//&
2185  this%vol7d%ana(i)%ident)
2186 #endif
2187  ier=idba_set(this%handle,"ident",this%vol7d%ana(i)%ident)
2188  ier=idba_set(this%handle,"mobile",1)
2189  else
2190  ier=idba_set(this%handle,"mobile",0)
2191  end if
2192 
2193  ier=idba_set(this%handle,"rep_memo",this%vol7d%network(iiiiii)%name)
2194 
2195  write=.false.
2196 
2197 #undef VOL7D_POLY_TYPES_V
2198 #define VOL7D_POLY_TYPES_V r
2199 !print*,"ana macro tipo r"
2200 #include "vol7d_dballe_class_ana.F90"
2201 #undef VOL7D_POLY_TYPES_V
2202 #define VOL7D_POLY_TYPES_V i
2203 !print*,"ana macro tipo i"
2204 #include "vol7d_dballe_class_ana.F90"
2205 #undef VOL7D_POLY_TYPES_V
2206 #define VOL7D_POLY_TYPES_V b
2207 !print*,"ana macro tipo b"
2208 #include "vol7d_dballe_class_ana.F90"
2209 #undef VOL7D_POLY_TYPES_V
2210 #define VOL7D_POLY_TYPES_V d
2211 !print*,"ana macro tipo d"
2212 #include "vol7d_dballe_class_ana.F90"
2213 #undef VOL7D_POLY_TYPES_V
2214 #define VOL7D_POLY_TYPES_V c
2215 !print*,"ana macro tipo c"
2216 #include "vol7d_dballe_class_ana.F90"
2217 #undef VOL7D_POLY_TYPES_V
2218 
2219 
2220  if (this%file)then
2221  if (write .or. generic_frag) then
2222 
2223  if (c_e(ltemplate)) then
2224  ier=idba_set(this%handle,"query","message "//trim(ltemplate))
2225  else
2226  ier=idba_set(this%handle,"query","message")
2227  end if
2228 
2229 #ifdef DEBUG
2230  call l4f_category_log(this%category,l4f_debug,"eseguo una main prendilo di anagrafica")
2231 #endif
2232  ier=idba_prendilo(this%handle)
2233  end if
2234 
2235  else
2236 
2237  !se NON ho dati di anagrafica (ma solo lat e long ..) devo fare comunque una prendilo
2238 #ifdef DEBUG
2239  call l4f_category_log(this%category,l4f_debug,"eseguo una main prendilo di anagrafica")
2240 #endif
2241  ier=idba_prendilo(this%handle)
2242  ier=idba_enq(this%handle,"*ana_id",ana_id(i,iiiiii))
2243 
2244  end if
2245 
2246  do ii=1,nanavarr
2247  if (c_e(this%vol7d%anavar%r(ii)%btable))ier=idba_unset(this%handle,this%vol7d%anavar%r(ii)%btable )
2248 #ifdef DEBUG
2249  call l4f_category_log(this%category,l4f_debug,"unset ana: "//this%vol7d%anavar%r(ii)%btable)
2250 #endif
2251  end do
2252  do ii=1,nanavari
2253  if (c_e(this%vol7d%anavar%i(ii)%btable))ier=idba_unset(this%handle,this%vol7d%anavar%i(ii)%btable )
2254 #ifdef DEBUG
2255  call l4f_category_log(this%category,l4f_debug,"unset ana: "//this%vol7d%anavar%i(ii)%btable)
2256 #endif
2257  end do
2258  do ii=1,nanavarb
2259  if (c_e(this%vol7d%anavar%b(ii)%btable))ier=idba_unset(this%handle,this%vol7d%anavar%b(ii)%btable )
2260 #ifdef DEBUG
2261  call l4f_category_log(this%category,l4f_debug,"unset ana: "//this%vol7d%anavar%b(ii)%btable)
2262 #endif
2263  end do
2264  do ii=1,nanavard
2265  if (c_e(this%vol7d%anavar%d(ii)%btable))ier=idba_unset(this%handle,this%vol7d%anavar%d(ii)%btable )
2266 #ifdef DEBUG
2267  call l4f_category_log(this%category,l4f_debug,"unset ana: "//this%vol7d%anavar%d(ii)%btable)
2268 #endif
2269  end do
2270  do ii=1,nanavarc
2271  if (c_e(this%vol7d%anavar%c(ii)%btable))ier=idba_unset(this%handle,this%vol7d%anavar%c(ii)%btable )
2272 #ifdef DEBUG
2273  call l4f_category_log(this%category,l4f_debug,"unset ana: "//this%vol7d%anavar%c(ii)%btable)
2274 #endif
2275  end do
2276 
2277  end do
2278 end do
2279 
2280 
2281 ! data
2282 !print *,"nstaz,ntime,nlevel,ntimerange,nnetwork",nstaz,ntime,nlevel,ntimerange,nnetwork
2283 
2284 
2285 do iiiiii=1, nnetwork
2286  if (.not.lnetwork(iiiiii))cycle
2287 
2288  do i=1, nstaz
2289 
2290  if ( (.not. this%file) .and. (.not. c_e(ana_id(i,iiiiii))) ) cycle
2291  if (present(coordmin).and.present(coordmax))then
2292  if (.not. inside(this%vol7d%ana(i)%coord,coordmin,coordmax)) cycle
2293  end if
2294 
2295  do ii=1,ntime
2296  if (present(timei) )then
2297  if ( this%vol7d%time(ii) < timei ) cycle
2298  endif
2299  if (present(timef) )then
2300  if ( this%vol7d%time(ii) > timef ) cycle
2301  endif
2303 
2304  ier=idba_unsetall(this%handle)
2305 #ifdef DEBUG
2306  CALL l4f_category_log(this%category,l4f_debug,'unsetall handle')
2307 #endif
2308 
2309  ier=idba_set(this%handle,"rep_memo",this%vol7d%network(iiiiii)%name)
2310 #ifdef DEBUG
2311  CALL l4f_category_log(this%category,l4f_debug,'set rep_memo:'//this%vol7d%network(iiiiii)%name)
2312 #endif
2313 
2314  if (this%file)then
2315  ! writing on file cannot use ana_id
2316  call getval(this%vol7d%ana(i)%coord, ilat=ilat,ilon=ilon)
2317  ier=idba_set(this%handle,"lat",ilat)
2318  ier=idba_set(this%handle,"lon",ilon)
2319 #ifdef DEBUG
2320  call l4f_category_log(this%category,l4f_debug,"dati riferiti a lat: "//to_char(ilat)//" lon: "//to_char(ilon))
2321 #endif
2322 
2323  if (present(ana))then
2324  if (c_e(ana%ident) .and. ana%ident /= this%vol7d%ana(i)%ident ) cycle
2325  if (c_e(ana%coord) .and. ana%coord /= this%vol7d%ana(i)%coord ) cycle
2326  end if
2327 
2328  if ( c_e(this%vol7d%ana(i)%ident)) then
2329  ier=idba_set(this%handle,"ident",this%vol7d%ana(i)%ident)
2330  ier=idba_set(this%handle,"mobile",1)
2331 #ifdef DEBUG
2332  call l4f_category_log(this%category,l4f_debug,"there is a mobile station! identity: "&
2333  //this%vol7d%ana(i)%ident)
2334 #endif
2335  else
2336  ier=idba_set(this%handle,"mobile",0)
2337  end if
2338 
2339 
2340 ! l'anagrafica su file la scrivo solo per i non generici_frag
2341  if (.not. generic_frag) then
2342 
2343 #ifdef DEBUG
2344  call l4f_category_log(this%category,l4f_debug,"setcontextana")
2345 #endif
2346  ier=idba_setcontextana(this%handle)
2347 
2348  write=.false.
2349 
2350 #undef VOL7D_POLY_TYPES_V
2351 #define VOL7D_POLY_TYPES_V r
2352 !print*,"ana macro tipo r"
2353 #include "vol7d_dballe_class_ana.F90"
2354 #undef VOL7D_POLY_TYPES_V
2355 #define VOL7D_POLY_TYPES_V i
2356 !print*,"ana macro tipo i"
2357 #include "vol7d_dballe_class_ana.F90"
2358 #undef VOL7D_POLY_TYPES_V
2359 #define VOL7D_POLY_TYPES_V b
2360 !print*,"ana macro tipo b"
2361 #include "vol7d_dballe_class_ana.F90"
2362 #undef VOL7D_POLY_TYPES_V
2363 #define VOL7D_POLY_TYPES_V d
2364 !print*,"ana macro tipo d"
2365 #include "vol7d_dballe_class_ana.F90"
2366 #undef VOL7D_POLY_TYPES_V
2367 #define VOL7D_POLY_TYPES_V c
2368 !print*,"ana macro tipo c"
2369 #include "vol7d_dballe_class_ana.F90"
2370 #undef VOL7D_POLY_TYPES_V
2371 
2372 
2373  if (write) then
2374 #ifdef DEBUG
2375  call l4f_category_log(this%category,l4f_debug,"eseguo una main prendilo di anagrafica")
2376 #endif
2377  ier=idba_prendilo(this%handle)
2378  end if
2379 
2380  end if
2381  else
2382 #ifdef DEBUG
2383  call l4f_category_log(this%category,l4f_debug,"specify ana_id: "&
2384  //to_char(ana_id(i,iiiiii)))
2385 #endif
2386  ier=idba_set(this%handle,"ana_id",ana_id(i,iiiiii))
2387  end if
2388 
2389  CALL getval(this%vol7d%time(ii), year=year, month=month, day=day, hour=hour, minute=minute,msec=msec)
2390  sec=nint(float(msec)/1000.)
2391 #ifdef DEBUG
2392  call l4f_category_log(this%category,l4f_debug,"setdate: "&
2393  //t2c(year)//t2c(month)//t2c(day)//t2c(hour)//t2c(minute)//t2c(sec))
2394 #endif
2395  ier=idba_setdate(this%handle,year,month,day,hour,minute,sec)
2396 
2397  do iii=1,nlevel
2398  if (.not.llevel(iii))cycle
2399 
2400  do iiii=1,ntimerange
2401  if (.not.ltimerange(iiii))cycle
2402 
2403  if (.not. lattr_only) then
2404 
2405 
2406  ier=idba_setlevel(this%handle, this%vol7d%level(iii)%level1, this%vol7d%level(iii)%l1,&
2407  this%vol7d%level(iii)%level2, this%vol7d%level(iii)%l2)
2408 
2409 #ifdef DEBUG
2410  call l4f_category_log(this%category,l4f_debug,"level1: "//to_char(this%vol7d%level(iii)%level1))
2411  call l4f_category_log(this%category,l4f_debug,"l1: "//to_char(this%vol7d%level(iii)%l1))
2412  call l4f_category_log(this%category,l4f_debug,"level2: "//to_char(this%vol7d%level(iii)%level2))
2413  call l4f_category_log(this%category,l4f_debug,"l2: "//to_char(this%vol7d%level(iii)%l2))
2414 #endif
2415 
2416  ier=idba_settimerange(this%handle, this%vol7d%timerange(iiii)%timerange, &
2417  this%vol7d%timerange(iiii)%p1, this%vol7d%timerange(iiii)%p2)
2418 
2419 #ifdef DEBUG
2420  call l4f_category_log(this%category,l4f_debug,"timerange: "//to_char(this%vol7d%timerange(iiii)%timerange))
2421  call l4f_category_log(this%category,l4f_debug,"T1: "//to_char(this%vol7d%timerange(iiii)%p1))
2422  call l4f_category_log(this%category,l4f_debug,"T2: "//to_char(this%vol7d%timerange(iiii)%p2))
2423 #endif
2424 
2425  end if
2426 
2427  !print *, ">>>>> ",ana_id(i,iiiiii),this%vol7d%network(iiiiii)%name
2428  !print *, year,month,day,hour,minute
2429  !print *, this%vol7d%level(iii)%level1, this%vol7d%level(iii)%l1, this%vol7d%level(iii)%l2
2430  !print *, this%vol7d%timerange(iiii)%timerange,this%vol7d%timerange(iiii)%p1, this%vol7d%timerange(iiii)%p2
2431 
2432 
2433  write=.false.
2434 
2435 #undef VOL7D_POLY_TYPES_V
2436 #define VOL7D_POLY_TYPES_V r
2437 #ifdef DEBUG
2438  call l4f_category_log(this%category,l4f_debug,"macro tipo r")
2439 #endif
2440 #include "vol7d_dballe_class_dati.F90"
2441 #undef VOL7D_POLY_TYPES_V
2442 #define VOL7D_POLY_TYPES_V i
2443 #ifdef DEBUG
2444  call l4f_category_log(this%category,l4f_debug,"macro tipo i")
2445 #endif
2446 #include "vol7d_dballe_class_dati.F90"
2447 #undef VOL7D_POLY_TYPES_V
2448 #define VOL7D_POLY_TYPES_V b
2449 #ifdef DEBUG
2450  call l4f_category_log(this%category,l4f_debug,"macro tipo b")
2451 #endif
2452 #include "vol7d_dballe_class_dati.F90"
2453 #undef VOL7D_POLY_TYPES_V
2454 #define VOL7D_POLY_TYPES_V d
2455 #ifdef DEBUG
2456  call l4f_category_log(this%category,l4f_debug,"macro tipo d")
2457 #endif
2458 #include "vol7d_dballe_class_dati.F90"
2459 #undef VOL7D_POLY_TYPES_V
2460 #define VOL7D_POLY_TYPES_V c
2461 #ifdef DEBUG
2462  call l4f_category_log(this%category,l4f_debug,"macro tipo c")
2463 #endif
2464 #include "vol7d_dballe_class_dati.F90"
2465 #undef VOL7D_POLY_TYPES_V
2466 
2467 
2468  if (write) then
2469 
2470 ! if (.not. this%file)then
2471 !
2472 ! !!!!!!!!!!! workaround to dballe fortran api bug
2473 ! ! TODO remove this duplicated set of ana_id
2474 !#ifdef DEBUG
2475 ! call l4f_category_log(this%category,L4F_DEBUG,"rispecify ana_id: "&
2476 ! //to_char(ana_id(i,iiiiii)))
2477 !#endif
2478 ! ier=idba_set (this%handle,"ana_id",ana_id(i,iiiiii))
2479 ! end if
2480 
2481  !print*,"eseguo una main prendilo"
2482 #ifdef DEBUG
2483  call l4f_category_log(this%category,l4f_debug,"eseguo una main prendilo sui dati")
2484 #endif
2485  ier=idba_prendilo(this%handle)
2486 
2487  end if
2488 
2489 
2490 !ana
2491 
2492  if (this%file .and. .not. generic_frag) then
2493 
2494  do a=1,nanavarr
2495  if (c_e(this%vol7d%anavar%r(a)%btable))ier=idba_unset(this%handle,this%vol7d%anavar%r(a)%btable )
2496 #ifdef DEBUG
2497  call l4f_category_log(this%category,l4f_debug,"unset ana: "//this%vol7d%anavar%r(a)%btable)
2498 #endif
2499  end do
2500  do a=1,nanavari
2501  if (c_e(this%vol7d%anavar%i(a)%btable))ier=idba_unset(this%handle,this%vol7d%anavar%i(a)%btable )
2502 #ifdef DEBUG
2503  call l4f_category_log(this%category,l4f_debug,"unset ana: "//this%vol7d%anavar%i(a)%btable)
2504 #endif
2505  end do
2506  do a=1,nanavarb
2507  if (c_e(this%vol7d%anavar%b(a)%btable))ier=idba_unset(this%handle,this%vol7d%anavar%b(a)%btable )
2508 #ifdef DEBUG
2509  call l4f_category_log(this%category,l4f_debug,"unset ana: "//this%vol7d%anavar%b(a)%btable)
2510 #endif
2511  end do
2512  do a=1,nanavard
2513  if (c_e(this%vol7d%anavar%d(a)%btable))ier=idba_unset(this%handle,this%vol7d%anavar%d(a)%btable )
2514 #ifdef DEBUG
2515  call l4f_category_log(this%category,l4f_debug,"unset ana: "//this%vol7d%anavar%d(a)%btable)
2516 #endif
2517  end do
2518  do a=1,nanavarc
2519  if (c_e(this%vol7d%anavar%c(a)%btable))ier=idba_unset(this%handle,this%vol7d%anavar%c(a)%btable )
2520 #ifdef DEBUG
2521  call l4f_category_log(this%category,l4f_debug,"unset ana: "//this%vol7d%anavar%c(a)%btable)
2522 #endif
2523  end do
2524 
2525  end if
2526 
2527 ! data
2528 
2529  do iiiii=1,ndativarr
2530  if(c_e(this%vol7d%dativar%r(iiiii)%btable))ier=idba_unset(this%handle,this%vol7d%dativar%r(iiiii)%btable )
2531 #ifdef DEBUG
2532  call l4f_category_log(this%category,l4f_debug,"unset dati: "//this%vol7d%dativar%r(iiiii)%btable)
2533 #endif
2534  end do
2535  do iiiii=1,ndativari
2536  if(c_e(this%vol7d%dativar%i(iiiii)%btable))ier=idba_unset(this%handle,this%vol7d%dativar%i(iiiii)%btable )
2537 #ifdef DEBUG
2538  call l4f_category_log(this%category,l4f_debug,"unset dati: "//this%vol7d%dativar%i(iiiii)%btable)
2539 #endif
2540  end do
2541  do iiiii=1,ndativarb
2542  if(c_e(this%vol7d%dativar%b(iiiii)%btable))ier=idba_unset(this%handle,this%vol7d%dativar%b(iiiii)%btable )
2543 #ifdef DEBUG
2544  call l4f_category_log(this%category,l4f_debug,"unset dati: "//this%vol7d%dativar%b(iiiii)%btable)
2545 #endif
2546  end do
2547  do iiiii=1,ndativard
2548  if(c_e(this%vol7d%dativar%d(iiiii)%btable))ier=idba_unset(this%handle,this%vol7d%dativar%d(iiiii)%btable )
2549 #ifdef DEBUG
2550  call l4f_category_log(this%category,l4f_debug,"unset dati: "//this%vol7d%dativar%d(iiiii)%btable)
2551 #endif
2552  end do
2553  do iiiii=1,ndativarc
2554  if(c_e(this%vol7d%dativar%c(iiiii)%btable))ier=idba_unset(this%handle,this%vol7d%dativar%c(iiiii)%btable )
2555 #ifdef DEBUG
2556  call l4f_category_log(this%category,l4f_debug,"unset dati: "//this%vol7d%dativar%c(iiiii)%btable)
2557 #endif
2558  end do
2559 
2560 
2561  end do
2562  end do
2563 
2564  if (this%file)then
2565  if (c_e(ltemplate)) then
2566  ier=idba_set(this%handle,"query","message "//trim(ltemplate))
2567  else
2568  ier=idba_set(this%handle,"query","message")
2569  end if
2570 #ifdef DEBUG
2571  call l4f_category_log(this%category,l4f_debug,"close message ")
2572 
2573  !print*,"eseguo una main prendilo"
2574  call l4f_category_log(this%category,l4f_debug,"eseguo una main prendilo sui dati")
2575 #endif
2576  ier=idba_prendilo(this%handle)
2577 
2578  end if
2579  end do
2580  end do
2581 end do
2582 
2583 END SUBROUTINE vol7d_dballe_export
2584 
2585 
2587 
2588 SUBROUTINE vol7d_dballe_delete(this, preserveidbhandle)
2589 TYPE(vol7d_dballe) :: this
2590 logical,intent(in), optional :: preserveidbhandle
2591 integer :: ier
2592 
2593 if (this%file)then
2594 
2595  ier=idba_fatto(this%handle)
2596 
2597 else
2598 
2599  ier=idba_fatto(this%handle)
2600  ier=idba_fatto(this%handle_staz)
2601  if (.not. optio_log(preserveidbhandle)) ier=idba_arrivederci(this%idbhandle)
2602 
2603 end if
2604 
2605 ier=idba_error_remove_callback(this%handle_err)
2606 
2607 !this%dsn=cmiss
2608 !this%user=cmiss
2609 !this%password=cmiss
2610 this%idbhandle=imiss
2611 this%handle=imiss
2612 this%handle_err=imiss
2613 this%handle_staz=imiss
2614 
2615 if (associated(this%data_id)) then
2616  deallocate (this%data_id)
2617  nullify(this%data_id)
2618 end if
2619 CALL delete(this%vol7d)
2620 
2621 !chiudo il logger
2622 call l4f_category_delete(this%category)
2623 !ier=l4f_fini()
2624 
2625 END SUBROUTINE vol7d_dballe_delete
2626 
2627 
2628 
2629 subroutine vol7d_dballe_import_dballevar(this)
2630 
2631 type(vol7d_var),pointer :: this(:)
2632 INTEGER :: i,un,n
2633 
2634 IF (associated(this)) return
2635 IF (allocated(blocal)) then
2636  ALLOCATE(this(size(blocal)))
2637  this=blocal
2638  return
2639 end if
2640 
2641 un = open_dballe_file('dballe.txt', filetype_data)
2642 IF (un < 0) then
2643 
2644  call l4f_log(l4f_error,"error open_dballe_file: dballe.txt")
2645  CALL raise_error("error open_dballe_file: dballe.txt")
2646  return
2647 end if
2648 
2649 n = 0
2650 DO WHILE(.true.)
2651  READ(un,*,end=100)
2652  n = n + 1
2653 ENDDO
2654 100 CONTINUE
2655 
2656 IF (n > 0) THEN
2657  ALLOCATE(this(n))
2658  ALLOCATE(blocal(n))
2659  rewind(un)
2660  readline: do i = 1 ,n
2661  READ(un,'(1x,A6,1x,a65,a24,i4)')blocal(i)%btable,blocal(i)%description,blocal(i)%unit,&
2662  blocal(i)%scalefactor
2663  blocal(i)%btable(:1)="B"
2664  !print*,"B=",blocal(i)%btable
2665  !print*," D=",blocal(i)%description
2666  !PRINT*," U=",blocal(i)%unit
2667  !PRINT*," D=",blocal(i)%scalefactor
2668  ENDDO readline
2669 
2670  CALL l4f_log(l4f_info,'Found '//trim(to_char(i-1))//' variables in dballe master table')
2671 
2672  this=blocal
2673 
2674 ENDIF
2675 CLOSE(un)
2676 
2677 END SUBROUTINE vol7d_dballe_import_dballevar
2678 
2679 
2680 
2683 
2684 subroutine vol7d_dballe_set_var_du(this)
2685 
2686 TYPE(vol7d) :: this
2687 integer :: i,j
2688 type(vol7d_var),pointer :: dballevar(:)
2689 
2690 
2691 call vol7d_dballe_import_dballevar(dballevar)
2692 
2693 #undef VOL7D_POLY_NAME
2694 #define VOL7D_POLY_NAME dativar
2695 
2696 
2697 #undef VOL7D_POLY_TYPES_V
2698 #define VOL7D_POLY_TYPES_V r
2699 #include "vol7d_dballe_class_var_du.F90"
2700 #undef VOL7D_POLY_TYPES_V
2701 #define VOL7D_POLY_TYPES_V i
2702 #include "vol7d_dballe_class_var_du.F90"
2703 #undef VOL7D_POLY_TYPES_V
2704 #define VOL7D_POLY_TYPES_V b
2705 #include "vol7d_dballe_class_var_du.F90"
2706 #undef VOL7D_POLY_TYPES_V
2707 #define VOL7D_POLY_TYPES_V d
2708 #include "vol7d_dballe_class_var_du.F90"
2709 #undef VOL7D_POLY_TYPES_V
2710 #define VOL7D_POLY_TYPES_V c
2711 #include "vol7d_dballe_class_var_du.F90"
2712 #undef VOL7D_POLY_TYPES_V
2713 
2714 #undef VOL7D_POLY_NAME
2715 #define VOL7D_POLY_NAME anavar
2716 
2717 
2718 #undef VOL7D_POLY_TYPES_V
2719 #define VOL7D_POLY_TYPES_V r
2720 #include "vol7d_dballe_class_var_du.F90"
2721 #undef VOL7D_POLY_TYPES_V
2722 #define VOL7D_POLY_TYPES_V i
2723 #include "vol7d_dballe_class_var_du.F90"
2724 #undef VOL7D_POLY_TYPES_V
2725 #define VOL7D_POLY_TYPES_V b
2726 #include "vol7d_dballe_class_var_du.F90"
2727 #undef VOL7D_POLY_TYPES_V
2728 #define VOL7D_POLY_TYPES_V d
2729 #include "vol7d_dballe_class_var_du.F90"
2730 #undef VOL7D_POLY_TYPES_V
2731 #define VOL7D_POLY_TYPES_V c
2732 #include "vol7d_dballe_class_var_du.F90"
2733 #undef VOL7D_POLY_TYPES_V
2734 
2735 
2736 #undef VOL7D_POLY_NAME
2737 #define VOL7D_POLY_NAME datiattr
2738 
2739 
2740 #undef VOL7D_POLY_TYPES_V
2741 #define VOL7D_POLY_TYPES_V r
2742 #include "vol7d_dballe_class_var_du.F90"
2743 #undef VOL7D_POLY_TYPES_V
2744 #define VOL7D_POLY_TYPES_V i
2745 #include "vol7d_dballe_class_var_du.F90"
2746 #undef VOL7D_POLY_TYPES_V
2747 #define VOL7D_POLY_TYPES_V b
2748 #include "vol7d_dballe_class_var_du.F90"
2749 #undef VOL7D_POLY_TYPES_V
2750 #define VOL7D_POLY_TYPES_V d
2751 #include "vol7d_dballe_class_var_du.F90"
2752 #undef VOL7D_POLY_TYPES_V
2753 #define VOL7D_POLY_TYPES_V c
2754 #include "vol7d_dballe_class_var_du.F90"
2755 #undef VOL7D_POLY_TYPES_V
2756 
2757 
2758 #undef VOL7D_POLY_NAME
2759 #define VOL7D_POLY_NAME anaattr
2760 
2761 
2762 #undef VOL7D_POLY_TYPES_V
2763 #define VOL7D_POLY_TYPES_V r
2764 #include "vol7d_dballe_class_var_du.F90"
2765 #undef VOL7D_POLY_TYPES_V
2766 #define VOL7D_POLY_TYPES_V i
2767 #include "vol7d_dballe_class_var_du.F90"
2768 #undef VOL7D_POLY_TYPES_V
2769 #define VOL7D_POLY_TYPES_V b
2770 #include "vol7d_dballe_class_var_du.F90"
2771 #undef VOL7D_POLY_TYPES_V
2772 #define VOL7D_POLY_TYPES_V d
2773 #include "vol7d_dballe_class_var_du.F90"
2774 #undef VOL7D_POLY_TYPES_V
2775 #define VOL7D_POLY_TYPES_V c
2776 #include "vol7d_dballe_class_var_du.F90"
2777 #undef VOL7D_POLY_TYPES_V
2778 
2779 
2780 deallocate(dballevar)
2781 
2782 return
2783 
2784 end subroutine vol7d_dballe_set_var_du
2785 
2786 
2787 
2788 FUNCTION get_dballe_filepath(filename, filetype) RESULT(path)
2789 CHARACTER(len=*), INTENT(in) :: filename
2790 INTEGER, INTENT(in) :: filetype
2791 
2792 INTEGER :: j
2793 CHARACTER(len=512) :: path
2794 LOGICAL :: exist
2795 
2796 IF (dballe_name == ' ') THEN
2797  CALL getarg(0, dballe_name)
2798  ! dballe_name_env
2799 ENDIF
2800 
2801 IF (filetype < 1 .OR. filetype > nftype) THEN
2802  path = ""
2803  CALL l4f_log(l4f_error, 'dballe file type '//trim(to_char(filetype))// &
2804  ' not valid')
2805  CALL raise_error()
2806  RETURN
2807 ENDIF
2808 
2809 ! try with environment variable
2810 CALL getenv(TRIM(dballe_name_env), path)
2811 IF (path /= ' ') THEN
2812 
2813  path=trim(path)//'/'//filename
2814  INQUIRE(file=path, exist=exist)
2815  IF (exist) THEN
2816  CALL l4f_log(l4f_info, 'dballe file '//trim(path)//' found')
2817  RETURN
2818  ENDIF
2819 ENDIF
2820 ! try with pathlist
2821 DO j = 1, SIZE(pathlist,1)
2822  IF (pathlist(j,filetype) == ' ') EXIT
2823  path=trim(pathlist(j,filetype))//'/'//trim(dballe_name)//'/'//filename
2824  INQUIRE(file=path, exist=exist)
2825  IF (exist) THEN
2826  CALL l4f_log(l4f_info, 'dballe file '//trim(path)//' found')
2827  RETURN
2828  ENDIF
2829 ENDDO
2830 CALL l4f_log(L4F_ERROR, 'dballe file '//TRIM(filename)//' not found')
2831 CALL raise_error()
2832 path = ""
2833 
2834 END FUNCTION get_dballe_filepath
2835 
2836 
2837 FUNCTION open_dballe_file(filename, filetype) RESULT(unit)
2838 CHARACTER(len=*), INTENT(in) :: filename
2839 INTEGER, INTENT(in) :: filetype
2840 INTEGER :: unit,i
2841 
2842 CHARACTER(len=512) :: path
2843 
2844 unit = -1
2845 path=get_dballe_filepath(filename, filetype)
2846 IF (path == '') RETURN
2847 
2848 unit = getunit()
2849 IF (unit == -1) RETURN
2850 
2851 OPEN(unit, file=path, status='old', iostat = i)
2852 IF (i == 0) THEN
2853  CALL l4f_log(l4f_info, 'dballe file '//trim(path)//' opened')
2854  RETURN
2855 ENDIF
2856 
2857 CALL l4f_log(L4F_ERROR, 'dballe file '//TRIM(filename)//' not found')
2858 CALL raise_error()
2859 unit = -1
2860 
2861 END FUNCTION open_dballe_file
2862 
2863 
2864 
2865 FUNCTION v7d_dballe_error_handler(category)
2866 INTEGER :: category, code, l4f_level
2867 INTEGER :: v7d_dballe_error_handler
2868 
2869 CHARACTER(len=1000) :: message, buf
2870 
2871 code = idba_error_code()
2872 
2873 ! check if "Value outside acceptable domain"
2874 if (code == 13 ) then
2875  l4f_level=l4f_warn
2876 else
2877  l4f_level=l4f_error
2878 end if
2879 
2880 call idba_error_message(message)
2881 call l4f_category_log(category,l4f_level,message)
2882 
2883 call idba_error_context(buf)
2884 
2885 call l4f_category_log(category,l4f_level,trim(buf))
2886 
2887 call idba_error_details(buf)
2888 call l4f_category_log(category,L4F_INFO,trim(buf))
2889 
2890 
2891 ! if "Value outside acceptable domain" do not raise error
2892 if (l4f_level == l4f_error ) CALL raise_fatal_error("dballe: "//message)
2893 
2894 v7d_dballe_error_handler = 0
2895 return
2896 
2897 END FUNCTION v7d_dballe_error_handler
2898 
2899 
2900 
2905 
2906 #ifndef F2003_EXTENDED_FEATURES
2907 !! Attributes will not be imported at all.
2908 #endif
2909 
2910 SUBROUTINE vol7d_dballe_importvvns_file(this, var, network, coordmin, coordmax, timei, timef,level,timerange, set_network,&
2911  attr,anavar,anaattr, varkind,attrkind,anavarkind,anaattrkind,anaonly,ana)
2912 
2913 TYPE(vol7d_dballe),INTENT(inout) :: this
2914 CHARACTER(len=*),INTENT(in),OPTIONAL :: var(:)
2915 TYPE(geo_coord),INTENT(inout),optional :: coordmin,coordmax
2916 TYPE(vol7d_ana),INTENT(inout),optional :: ana
2917 TYPE(datetime),INTENT(in),OPTIONAL :: timei, timef
2918 TYPE(vol7d_network),INTENT(in),OPTIONAL :: network,set_network
2919 TYPE(vol7d_level),INTENT(in),optional :: level
2920 TYPE(vol7d_timerange),INTENT(in),optional :: timerange
2921 CHARACTER(len=*),INTENT(in),OPTIONAL :: attr(:),anavar(:),anaattr(:)
2922 CHARACTER(len=*),INTENT(in),OPTIONAL :: varkind(:),attrkind(:),anavarkind(:),anaattrkind(:)
2923 logical,intent(in),optional :: anaonly
2924 
2925 !TYPE(vol7d) :: v7d
2926 !CHARACTER(len=SIZE(var)*7) :: varlist
2927 !CHARACTER(len=SIZE(attr)*8) :: starvarlist
2928 CHARACTER(len=6) :: btable
2929 
2930 LOGICAL :: ldegnet, lanaonly
2931 integer :: year,month,day,hour,minute,sec
2932 integer :: rlevel1, rl1,rlevel2, rl2
2933 integer :: rtimerange, p1, p2
2934 character(len=network_name_len) ::rep_memo
2935 integer :: indana,indtime,indlevel,indtimerange,inddativar,indnetwork
2936 
2937 
2938 integer :: nana,ntime,ntimerange,nlevel,nnetwork
2939 TYPE(vol7d_network),ALLOCATABLE :: networktmp(:)
2940 
2941 INTEGER :: i,ii, n, na, nd
2942 integer :: nvar, nanavar ,indanavar
2943 
2944 INTEGER(kind=int_l) :: ilat,ilon,latmin,latmax,lonmin,lonmax,ilata,ilona
2945 CHARACTER(len=vol7d_ana_lenident) :: ident
2946 !INTEGER(kind=int_b)::attrdatib
2947 
2948 integer :: ndativarr, ndativari, ndativarb, ndativard, ndativarc
2949 integer :: ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc
2950 integer :: ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc
2951 
2952 integer :: nanavarr, nanavari, nanavarb, nanavard, nanavarc
2953 integer :: nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc
2954 integer :: nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
2955 
2956 integer :: ir,ib,id,ic,ier
2957 
2958 TYPE(datetime) :: timee
2959 TYPE(vol7d_level) :: levele
2960 TYPE(vol7d_timerange) :: timerangee
2961 
2962 TYPE(vol7d_network) :: lnetwork
2963 TYPE(vol7d_level) :: llevel
2964 TYPE(vol7d_timerange) :: ltimerange
2965 logical :: lattr
2966 
2967 !TYPE(datetime) :: odatetime
2968 ! nobs, ntime, nana, nvout, nvin, nvbt, &
2969 ! datai(3), orai(2), dataf(3), oraf(2),ist
2970 !CHARACTER(len=12),ALLOCATABLE :: tmtmp(:)
2971 !INTEGER,ALLOCATABLE :: anatmp(:), vartmp(:), mapdatao(:)
2972 !LOGICAL :: found, non_valid, varbt_req(SIZE(vartable))
2973 
2974 
2975 TYPE(vol7d) :: vol7dtmp
2976 
2977 type(record),pointer :: buffer(:),bufferana(:)
2978 
2979 !!! CALL print_info('Estratte dall''archivio '//TRIM(to_char(nobs)) // ' osservazioni')
2980 
2981 call optio(anaonly,lanaonly)
2982 
2983 
2984 IF (PRESENT(set_network)) THEN
2985  if (c_e(set_network)) then
2986  ldegnet = .true.
2987  call l4f_category_log(this%category,l4f_info,&
2988  "set_network is not fully implemented in bufr/crex import: priority will be ignored")
2989  else
2990  ldegnet = .FALSE.
2991  end if
2992 ELSE
2993  ldegnet = .FALSE.
2994 ENDIF
2995 
2996 if (present(attr))then
2997  if (size(attr) > 0 )then
2998  lattr=.true.
2999  else
3000  lattr=.false.
3001  end if
3002 else
3003  lattr=.false.
3004 end if
3005 
3006 .or..or..or.if ( lattr present(anaattr) present(attrkind) present(anaattrkind))then
3007  call l4f_category_log(this%category,L4F_ERROR,"attributes not managed in bufr/crex import: try --disable-qc when is possible")
3008  CALL raise_error()
3009 end if
3010 
3011 
3012 if (present(network)) then
3013  lnetwork=network
3014 else
3015  call init(lnetwork)
3016 end if
3017 
3018 if (present(level)) then
3019  llevel=level
3020 else
3021  call init(llevel)
3022 end if
3023 
3024 if (present(timerange)) then
3025  ltimerange=timerange
3026 else
3027  call init(ltimerange)
3028 end if
3029 
3030 
3031 ier=idba_unsetall(this%handle)
3032 #ifdef DEBUG
3033 CALL l4f_category_log(this%category,L4F_DEBUG,'unsetall handle')
3034 #endif
3035 
3036 N=1
3037 nd=0
3038 na=0
3039 
3040 call mem_acquire( buffer,nd,1000,this%category )
3041 call mem_acquire( bufferana,na,100,this%category )
3042 
3043 ier=idba_setcontextana (this%handle)
3044 do while ( .true. )
3045 
3046  ier=idba_voglioquesto (this%handle,N)
3047  if (ier /= 0) then
3048  call l4f_category_log(this%category,L4F_ERROR,"voglioquesto return error status")
3049  N=1 ! I do not want terminate while loop
3050  cycle
3051  end if
3052 
3053  call l4f_category_log(this%category,L4F_debug,"numero dati voglioquesto:"//to_char(n))
3054 
3055 .not. if ( c_e(N)) exit
3056 
3057 #ifdef DBALLELT67
3058  if (N == 0) exit ! use only with dballe svn <= 4266
3059 #endif
3060 
3061  ! dammi tutti i dati
3062  do i=1,N
3063 
3064  ier=idba_dammelo (this%handle,btable)
3065 
3066  ier=idba_enqdate (this%handle,year,month,day,hour,minute,sec)
3067 .NOT. IF (c_e(sec)) sec = 0
3068  ier=idba_enqlevel(this%handle, rlevel1, rl1, rlevel2,rl2)
3069  ier=idba_enqtimerange(this%handle, rtimerange, p1, p2)
3070  ier=idba_enq(this%handle, "rep_memo",rep_memo)
3071  !print *,"trovato network",rep_memo
3072 
3073  !nbtable=btable_numerico(btable)
3074  ! ind = firsttrue(qccli%v7d%dativar%r(:)%btable == nbtable)
3075  ! IF (ind<1) cycle ! non c'e'
3076 
3077  !recupero i dati di anagrafica
3078  ier=idba_enq (this%handle,"lat", ilat)
3079  ier=idba_enq (this%handle,"lon", ilon)
3080  ier=idba_enq (this%handle,"ident",ident)
3081 
3082 !!$ print*,"ident",ident
3083 !!$ do ier=1,len(ident)
3084 !!$ print *,iachar(ident(ier:ier))
3085 !!$ end do
3086 
3087  ! inizio la serie dei test con i parametri richiesti
3088 
3089  if(c_e(lnetwork)) then
3090  if (rep_memo /= lnetwork%name) cycle
3091  end if
3092 
3093 ! in alternativa si trattano insieme
3094 !!$ call init(ana,lat=lat,lon=lon,ident=ident)
3095 !!$
3096 .and.!!$ if (present(coordmin)present(coordmax))then
3097 !!$
3098 .not.!!$ if ( inside(this%vol7d%ana(i)%coord,coordmin,coordmax)) cycle
3099 !!$ !print * ,"sei dentro, ok"
3100 !!$ end if
3101 
3102 
3103  if (present(coordmin)) then
3104 ! CALL geo_coord_to_geo(coordmin)
3105  if (c_e(coordmin)) then
3106  CALL getval(coordmin, ilat=latmin,ilon=lonmin)
3107  if (lonmin > ilon) cycle
3108  if (latmin > ilat) cycle
3109  end if
3110  end if
3111 
3112  if (present(coordmax)) then
3113 ! CALL geo_coord_to_geo(coordmax)
3114  if (c_e(coordmax)) then
3115  CALL getval(coordmax, ilat=latmax,ilon=lonmax)
3116  if (lonmax < ilon) cycle
3117  if (latmax < ilat) cycle
3118  end if
3119  end if
3120 
3121 
3122  if (present(ana)) then
3123  if (c_e(ana%coord)) then
3124  CALL getval(ana%coord, ilat=ilata,ilon=ilona)
3125  if (ilona /= ilon) cycle
3126  if (ilata /= ilat) cycle
3127  end if
3128  if (c_e(ana%ident)) then
3129  if (ana%ident /= ident) cycle
3130  end if
3131  end if
3132 
3133  call init(timee, year=year, month=month, day=day, hour=hour, minute=minute,msec=sec*1000)
3134 
3135  if (present(timei)) then
3136 .and. if (c_e(timei) timee < timei) cycle
3137  end if
3138 
3139  if (present(timef)) then
3140 .and. if (c_e(timef) timee > timef) cycle
3141  end if
3142 
3143  if (c_e(ltimerange))then
3144  call init(timerangee, timerange%timerange, timerange%p1, timerange%p2)
3145  if (timerangee /= ltimerange) cycle
3146  end if
3147 
3148  if (c_e(llevel))then
3149  call init (levele, rlevel1, rl1,rlevel2, rl2)
3150  if (levele /= llevel) cycle
3151  end if
3152 
3153  if (rlevel1 /= 257)then
3154  ! dati
3155 
3156  if (present (var)) then
3157 ! nvar=count(c_e(var))
3158 .and. if (any(c_e(var)) (all(btable /= var))) cycle
3159  end if
3160 
3161  ! fine test
3162 
3163 
3164  nd =nd+1
3165 #ifdef DEBUG
3166  call l4f_category_log(this%category,L4F_DEBUG,"numero dati dati:"//to_char(nd)//btable)
3167 #endif
3168  call mem_acquire( buffer,nd,0,this%category )
3169 
3170  buffer(nd)%dator=DBA_MVR
3171  buffer(nd)%datoi=DBA_MVI
3172  buffer(nd)%datob=DBA_MVB
3173  buffer(nd)%datod=DBA_MVD
3174  buffer(nd)%datoc=DBA_MVC
3175 
3176 .and. if (present(var) present(varkind))then
3177  ii=( firsttrue(var == btable))
3178  if (ii > 0)then
3179  !print*, "indici",ii, btable,(varkind(ii))
3180  if(varkind(ii) == "r") ier=idba_enq (this%handle,btable,buffer(nd)%dator)
3181  if(varkind(ii) == "i") ier=idba_enq (this%handle,btable,buffer(nd)%datoi)
3182  if(varkind(ii) == "b") ier=idba_enq (this%handle,btable,buffer(nd)%datob)
3183  if(varkind(ii) == "d") ier=idba_enq (this%handle,btable,buffer(nd)%datod)
3184  if(varkind(ii) == "c") ier=idba_enq (this%handle,btable,buffer(nd)%datoc)
3185  end if
3186  else
3187  ier=idba_enq (this%handle,btable,buffer(nd)%datoc) !char is default
3188  end if
3189 
3190  !bufferizzo il contesto
3191  !print *,"lat,lon,ident",lat,lon,ident
3192  !print*,year,month,day,hour,minute,sec
3193  !print*,btable,dato,buffer(nd)%datiattrb
3194 
3195 
3196  call init(buffer(nd)%ana,ilat=ilat,ilon=ilon,ident=ident)
3197  call init(buffer(nd)%time, year=year, month=month, day=day, hour=hour, minute=minute,msec=sec*1000)
3198  call init(buffer(nd)%level, rlevel1,rl1,rlevel2,rl2)
3199  call init(buffer(nd)%timerange, rtimerange, p1, p2)
3200  call init(buffer(nd)%network, rep_memo)
3201  buffer(nd)%btable = btable
3202 
3203  ! take in account time_definition
3204  IF (this%vol7d%time_definition == 0) buffer(nd)%time = buffer(nd)%time - &
3205  timedelta_new(sec=buffer(nd)%timerange%p1)
3206 
3207  ! put ana in bufferana becouse we can have no station data but we need ana
3208  !todo ; we have to do the same for network but I am tired ....
3209  if ( index(bufferana%ana,buffer(nd)%ana) <= 0) then
3210  na=na+1
3211  call mem_acquire( bufferana,na,0,this%category )
3212 
3213  call init(bufferana(na)%ana,ilat=ilat,ilon=ilon,ident=ident)
3214  call init(bufferana(na)%time, year=year, month=month, day=day, hour=hour, minute=minute,msec=sec*1000)
3215  call init(bufferana(na)%level, rlevel1,rl1,rlevel2,rl2)
3216  call init(bufferana(na)%timerange, rtimerange, p1, p2)
3217  call init(bufferana(na)%network, rep_memo)
3218 
3219  bufferana(na)%dator=DBA_MVR
3220  bufferana(na)%datoi=DBA_MVI
3221  bufferana(na)%datob=DBA_MVB
3222  bufferana(na)%datod=DBA_MVD
3223  bufferana(na)%datoc=DBA_MVC
3224  bufferana(na)%btable = DBA_MVC
3225 
3226  end if
3227 
3228 
3229  else
3230 
3231  ! ----------------> anagrafica
3232 
3233 
3234  !ora legge tutti i dati di anagrafica e li mette in bufferana
3235 
3236 
3237  !anno mese giorno
3238  if (btable == "b04001.or." btable == "b04002.or." btable == "b04003") cycle
3239  !ora minuti secondi
3240  if (btable == "b04004.or." btable == "b04005.or." btable == "b04006") cycle
3241  ! network
3242  if (btable == "b01193.or." btable == "b01194") cycle
3243 
3244 
3245  if (present (anavar)) then
3246 .and. if (any(c_e(anavar)) (all(btable /= anavar))) btable=DBA_MVC
3247  end if
3248 
3249 
3250 .not. if ( lanaonly)then
3251  !salto lat lon e ident
3252  if (btable == "b05001.or." btable == "b06001.or." btable == "b01011.or." btable == "b01194") btable=DBA_MVC
3253 
3254  end if
3255 
3256  na=na+1
3257  call l4f_category_log(this%category,L4F_debug,"numero dati ana:"//to_char(na)//btable)
3258 
3259  call mem_acquire( bufferana,na,0,this%category )
3260 
3261  bufferana(na)%dator=DBA_MVR
3262  bufferana(na)%datoi=DBA_MVI
3263  bufferana(na)%datob=DBA_MVB
3264  bufferana(na)%datod=DBA_MVD
3265  bufferana(na)%datoc=DBA_MVC
3266  bufferana(na)%btable = DBA_MVC
3267 
3268 
3269  if (c_e(btable)) then
3270 
3271 .and. if (present(anavar) present(anavarkind))then
3272  ii=( firsttrue(anavar == btable))
3273  if (ii > 0)then
3274  !print*, "indici",ii, btable,(varkind(ii))
3275  if(anavarkind(ii) == "r") ier=idba_enq (this%handle,btable,bufferana(na)%dator)
3276  if(anavarkind(ii) == "i") ier=idba_enq (this%handle,btable,bufferana(na)%datoi)
3277  if(anavarkind(ii) == "b") ier=idba_enq (this%handle,btable,bufferana(na)%datob)
3278  if(anavarkind(ii) == "d") ier=idba_enq (this%handle,btable,bufferana(na)%datod)
3279  if(anavarkind(ii) == "c") ier=idba_enq (this%handle,btable,bufferana(na)%datoc)
3280  end if
3281  else
3282  ier=idba_enq (this%handle,btable,bufferana(na)%datoc) !char is default
3283  !print*,"dato anagrafica",btable," ",bufferana(na)%dator
3284  end if
3285  end if
3286  !bufferizzo il contesto
3287  !print *,"lat,lon",lat,lon
3288  !print*,year,month,day,hour,minute,sec
3289  !print*,btable,na
3290 
3291  call init(bufferana(na)%ana,ilat=ilat,ilon=ilon,ident=ident)
3292  call init(bufferana(na)%time, year=year, month=month, day=day, hour=hour, minute=minute,msec=sec*1000)
3293  call init(bufferana(na)%level, rlevel1,rl1,rlevel2,rl2)
3294  call init(bufferana(na)%timerange, rtimerange, p1, p2)
3295  call init(bufferana(na)%network, rep_memo)
3296  bufferana(na)%btable = btable
3297 
3298  end if
3299  end do
3300 end do
3301 
3302 ! ----------------> anagrafica fine
3303 
3304 .not.if ( present(var))then
3305  nvar = count_distinct(buffer(:nd)%btable, back=.TRUE.)
3306 else
3307 .not. if ( all( c_e(var))) then
3308  nvar = count_distinct(buffer(:nd)%btable, back=.TRUE.)
3309  else
3310  nvar=count(c_e(var))
3311  end if
3312 end if
3313 
3314 nana = count_distinct(bufferana(:na)%ana, back=.TRUE.)
3315 !nana = count_distinct(buffer(:nd)%ana, back=.TRUE.)
3316 ntime = count_distinct(buffer(:nd)%time, back=.TRUE.)
3317 ntimerange = count_distinct(buffer(:nd)%timerange, back=.TRUE.)
3318 nlevel = count_distinct(buffer(:nd)%level, back=.TRUE.)
3319 if (ldegnet) then
3320  nnetwork=1
3321 else
3322  ALLOCATE(networktmp(na+nd))
3323  networktmp(1:nd) = buffer(1:nd)%network
3324  networktmp(nd+1:na+nd) = bufferana(1:na)%network
3325  nnetwork = count_distinct(networktmp, back=.TRUE.)
3326 endif
3327 
3328 
3329 if (present(varkind))then
3330  ndativarr= count(varkind == "r")
3331  ndativari= count(varkind == "i")
3332  ndativarb= count(varkind == "b")
3333  ndativard= count(varkind == "d")
3334  ndativarc= count(varkind == "c")
3335 
3336 else
3337  ndativarr= 0
3338  ndativari= 0
3339  ndativarb= 0
3340  ndativard= 0
3341  ndativarc= nvar
3342 end if
3343 
3344 !!$print *, "nana=",nana," ntime=",ntime," ntimerange=",ntimerange, &
3345 !!$ " nlevel=",nlevel," nnetwork=",nnetwork," ndativarr=",ndativarr
3346 
3347 ndatiattrr=0
3348 ndatiattri=0
3349 ndatiattrb=0
3350 ndatiattrd=0
3351 ndatiattrc=0
3352 
3353 ndativarattrr=0
3354 ndativarattri=0
3355 ndativarattrb=0
3356 ndativarattrd=0
3357 ndativarattrc=0
3358 
3359 ! ----------------> anagrafica
3360 
3361 .not.if ( present(anavar))then
3362  nanavar = count_distinct(bufferana(:na)%btable, back=.TRUE.,mask=(bufferana(:na)%btable /= DBA_MVC))
3363 else
3364 .not. if (all( c_e(anavar))) then
3365  nanavar = count_distinct(bufferana(:na)%btable, back=.TRUE.,mask=(bufferana(:na)%btable /= DBA_MVC))
3366  else
3367  nanavar = count(c_e(anavar))
3368  end if
3369 end if
3370 
3371 if (present(anavarkind))then
3372  nanavarr= count(anavarkind == "r")
3373  nanavari= count(anavarkind == "i")
3374  nanavarb= count(anavarkind == "b")
3375  nanavard= count(anavarkind == "d")
3376  nanavarc= count(anavarkind == "c")
3377 
3378 else
3379  nanavarr= 0
3380  nanavari= 0
3381  nanavarb= 0
3382  nanavard= 0
3383  nanavarc= nanavar
3384 end if
3385 
3386 
3387 nanaattrr=0
3388 nanaattri=0
3389 nanaattrb=0
3390 nanaattrd=0
3391 nanaattrc=0
3392 
3393 nanavarattrr=0
3394 nanavarattri=0
3395 nanavarattrb=0
3396 nanavarattrd=0
3397 nanavarattrc=0
3398 
3399 
3400 ! ----------------> anagrafica fine
3401 
3402 
3403 CALL init(vol7dtmp,time_definition=this%vol7d%time_definition)
3404 
3405 if (lanaonly)then
3406 
3407  ! qui faccio le operazioni minime per avere solo l'anagrafica utile per certe operazioni
3408 
3409  CALL vol7d_alloc (vol7dtmp, nana=nana, nnetwork=nnetwork)
3410  call vol7d_alloc_vol(vol7dtmp)
3411  vol7dtmp%ana=pack_distinct(bufferana(:na)%ana, nana, back=.TRUE.)
3412 
3413  ! Release memory
3414  deallocate (buffer)
3415  deallocate (bufferana)
3416 
3417  if(ldegnet)then
3418  vol7dtmp%network(1)=set_network
3419  else
3420  vol7dtmp%network=pack_distinct(networktmp, nnetwork, back=.TRUE.)
3421  DEALLOCATE(networktmp)
3422  end if
3423 
3424  ! Smart merge
3425  CALL vol7d_merge(this%vol7d, vol7dtmp)
3426 
3427  return
3428 
3429 end if
3430 
3431 
3432 call vol7d_alloc (vol7dtmp, &
3433  nana=nana, ntime=ntime, ntimerange=ntimerange, &
3434  nlevel=nlevel, nnetwork=nnetwork, &
3435  ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb, ndativard=ndativard, ndativarc=ndativarc,&
3436  ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb, ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
3437  ndativarattrr=ndativarattrr, &
3438  ndativarattri=ndativarattri, &
3439  ndativarattrb=ndativarattrb, &
3440  ndativarattrd=ndativarattrd, &
3441  ndativarattrc=ndativarattrc,&
3442  nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, nanavard=nanavard, nanavarc=nanavarc,&
3443  nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb, nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
3444  nanavarattrr=nanavarattrr, &
3445  nanavarattri=nanavarattri, &
3446  nanavarattrb=nanavarattrb, &
3447  nanavarattrd=nanavarattrd, &
3448  nanavarattrc=nanavarattrc)
3449 
3450 vol7dtmp%ana=pack_distinct(bufferana(:na)%ana, nana, back=.TRUE.)
3451 !vol7dtmp%ana=pack_distinct(buffer(:nd)%ana, nana, back=.TRUE.)
3452 vol7dtmp%time=pack_distinct(buffer(:nd)%time, ntime, back=.TRUE.)
3453 call sort(vol7dtmp%time)
3454 vol7dtmp%timerange=pack_distinct(buffer(:nd)%timerange, ntimerange, back=.TRUE.)
3455 call sort(vol7dtmp%timerange)
3456 vol7dtmp%level=pack_distinct(buffer(:nd)%level, nlevel, back=.TRUE.)
3457 call sort(vol7dtmp%level)
3458 
3459 if(ldegnet)then
3460  vol7dtmp%network(1)=set_network
3461 else
3462  vol7dtmp%network=pack_distinct(networktmp, nnetwork, back=.TRUE.)
3463  DEALLOCATE(networktmp)
3464 end if
3465 
3466 !print*,"reti presenti", vol7dtmp%network%name,buffer%network%name
3467 
3468 .and.if (present(var) present(varkind))then
3469 
3470  ir=0
3471  ii=0
3472  ib=0
3473  id=0
3474  ic=0
3475 
3476  do i=1,size(varkind)
3477  if (varkind(i) == "r") then
3478  ir=ir+1
3479  call init (vol7dtmp%dativar%r(ir), btable=var(i))
3480  end if
3481  if (varkind(i) == "i") then
3482  ii=ii+1
3483  call init (vol7dtmp%dativar%i(ii), btable=var(i))
3484  end if
3485  if (varkind(i) == "b") then
3486  ib=ib+1
3487  call init (vol7dtmp%dativar%b(ib), btable=var(i))
3488  end if
3489  if (varkind(i) == "d") then
3490  id=id+1
3491  call init (vol7dtmp%dativar%d(id), btable=var(i))
3492  end if
3493  if (varkind(i) == "c") then
3494  ic=ic+1
3495  call init (vol7dtmp%dativar%c(ic), btable=var(i))
3496  end if
3497  end do
3498 else if (present(var))then
3499  if (any(c_e(var))) then
3500  do i=1, nvar
3501  call init (vol7dtmp%dativar%c(i), btable=var(i))
3502  end do
3503 
3504  else
3505 
3506  do i=1,ndativarc
3507  call init(vol7dtmp%dativar%c(i))
3508  end do
3509  if (ndativarc > 0) then
3510  call pack_distinct_c(buffer(:nd)%btable,vol7dtmp%dativar%c%btable, back=.TRUE.)
3511  end if
3512  end if
3513 
3514 else
3515  do i=1,ndativarc
3516  call init(vol7dtmp%dativar%c(i))
3517  end do
3518  if (ndativarc > 0) then
3519  call pack_distinct_c(buffer(:nd)%btable,vol7dtmp%dativar%c%btable, back=.TRUE.)
3520  end if
3521 end if
3522 
3523 
3524 !-----------------------> anagrafica
3525 
3526 .and.if (present(anavar) present(anavarkind))then
3527 
3528  ir=0
3529  ii=0
3530  ib=0
3531  id=0
3532  ic=0
3533 
3534  do i=1,size(anavarkind)
3535  if (anavarkind(i) == "r") then
3536  ir=ir+1
3537  call init (vol7dtmp%anavar%r(ir), btable=anavar(i))
3538  end if
3539  if (anavarkind(i) == "i") then
3540  ii=ii+1
3541  call init (vol7dtmp%anavar%i(ii), btable=anavar(i))
3542  end if
3543  if (anavarkind(i) == "b") then
3544  ib=ib+1
3545  call init (vol7dtmp%anavar%b(ib), btable=anavar(i))
3546  end if
3547  if (anavarkind(i) == "d") then
3548  id=id+1
3549  call init (vol7dtmp%anavar%d(id), btable=anavar(i))
3550  end if
3551  if (anavarkind(i) == "c") then
3552  ic=ic+1
3553  call init (vol7dtmp%anavar%c(ic), btable=anavar(i))
3554  end if
3555  end do
3556 else if (present(anavar))then
3557 
3558  IF (ANY(c_e(anavar))) THEN
3559  DO i=1, nanavar
3560  CALL init (vol7dtmp%anavar%c(i), btable=anavar(i))
3561  END DO
3562  ELSE
3563 
3564  do i=1,nanavarc
3565  call init(vol7dtmp%anavar%c(i))
3566  end do
3567 
3568  if (nanavarc > 0) then ! we can have only lat lon and ident and not btables at all (so here we can get a strange segfault)
3569  call pack_distinct_c(bufferana(:na)%btable,vol7dtmp%anavar%c%btable, back=.TRUE.,&
3570  mask=(bufferana(:na)%btable /= DBA_MVC))
3571  end if
3572 
3573  ENDIF
3574 
3575 else
3576 
3577  do i=1,nanavarc
3578  call init(vol7dtmp%anavar%c(i))
3579  end do
3580 
3581  if (nanavarc > 0) then ! we can have only lat lon and ident and not btables at all (so here we can get a strange segfault)
3582  call pack_distinct_c(bufferana(:na)%btable,vol7dtmp%anavar%c%btable, back=.TRUE.,&
3583  mask=(bufferana(:na)%btable /= DBA_MVC))
3584  end if
3585 end if
3586 
3587 !-----------------------> anagrafica fine
3588 
3589 call vol7d_alloc_vol (vol7dtmp)
3590 
3591 do i =1, nd
3592 
3593  indana = firsttrue(buffer(i)%ana == vol7dtmp%ana)
3594  indtime = firsttrue(buffer(i)%time == vol7dtmp%time)
3595  indtimerange = firsttrue(buffer(i)%timerange == vol7dtmp%timerange)
3596  indlevel = firsttrue(buffer(i)%level == vol7dtmp%level)
3597  if (ldegnet)then
3598  indnetwork=1
3599  else
3600  indnetwork = firsttrue(buffer(i)%network == vol7dtmp%network)
3601  endif
3602  !print *, indana,indtime,indlevel,indtimerange,indnetwork
3603 
3604  if(c_e(buffer(i)%dator))then
3605  inddativar = firsttrue(buffer(i)%btable == vol7dtmp%dativar%r%btable)
3606  vol7dtmp%voldatir( &
3607  indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
3608  ) = buffer(i)%dator
3609  end if
3610 
3611  if(c_e(buffer(i)%datoi)) then
3612  inddativar = firsttrue(buffer(i)%btable == vol7dtmp%dativar%i%btable)
3613  vol7dtmp%voldatii( &
3614  indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
3615  ) = buffer(i)%datoi
3616  end if
3617 
3618  if(c_e(buffer(i)%datob)) then
3619  inddativar = firsttrue(buffer(i)%btable == vol7dtmp%dativar%b%btable)
3620  vol7dtmp%voldatib( &
3621  indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
3622  ) = buffer(i)%datob
3623  end if
3624 
3625  if(c_e(buffer(i)%datod)) then
3626  inddativar = firsttrue(buffer(i)%btable == vol7dtmp%dativar%d%btable)
3627  vol7dtmp%voldatid( &
3628  indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
3629  ) = buffer(i)%datod
3630  end if
3631 
3632  if(c_e(buffer(i)%datoc)) then
3633  inddativar = firsttrue(buffer(i)%btable == vol7dtmp%dativar%c%btable)
3634  vol7dtmp%voldatic( &
3635  indana,indtime,indlevel,indtimerange,inddativar,indnetwork &
3636  ) = buffer(i)%datoc
3637  end if
3638 
3639 end do
3640 
3641 !------------------------- anagrafica
3642 
3643 
3644 do i =1, Na
3645 
3646  indana = firsttrue(bufferana(i)%ana == vol7dtmp%ana)
3647 
3648  if (ldegnet)then
3649  indnetwork=1
3650  else
3651  indnetwork = firsttrue(bufferana(i)%network == vol7dtmp%network)
3652  endif
3653 
3654 .or. if (indana < 1 indnetwork < 1 )cycle
3655 
3656  !print *, indana,indtime,indlevel,indtimerange,indnetwork
3657 
3658  if(c_e(bufferana(i)%dator))then
3659  indanavar = firsttrue(bufferana(i)%btable == vol7dtmp%anavar%r%btable)
3660  vol7dtmp%volanar( indana,indanavar,indnetwork ) = bufferana(i)%dator
3661  end if
3662  if(c_e(bufferana(i)%datoi))then
3663  indanavar = firsttrue(bufferana(i)%btable == vol7dtmp%anavar%i%btable)
3664  vol7dtmp%volanai( indana,indanavar,indnetwork ) = bufferana(i)%datoi
3665  end if
3666  if(c_e(bufferana(i)%datob))then
3667  indanavar = firsttrue(bufferana(i)%btable == vol7dtmp%anavar%b%btable)
3668  vol7dtmp%volanab( indana,indanavar,indnetwork ) = bufferana(i)%datob
3669  end if
3670  if(c_e(bufferana(i)%datod))then
3671  indanavar = firsttrue(bufferana(i)%btable == vol7dtmp%anavar%d%btable)
3672  vol7dtmp%volanad( indana,indanavar,indnetwork ) = bufferana(i)%datod
3673  end if
3674  if (nanavarc > 0) then
3675  if(c_e(bufferana(i)%datoc))then
3676  indanavar = firsttrue(bufferana(i)%btable == vol7dtmp%anavar%c%btable)
3677  vol7dtmp%volanac( indana,indanavar,indnetwork ) = bufferana(i)%datoc
3678  end if
3679  end if
3680 
3681  end do
3682 
3683 !------------------------- anagrafica fine
3684 
3685 !
3686 ! Release memory
3687 !
3688 
3689 deallocate (buffer)
3690 deallocate (bufferana)
3691 
3692 ! Smart merge
3693 CALL vol7d_merge(this%vol7d, vol7dtmp, sort=.TRUE.)
3694 ! should we sort separately in case no merge is done?
3695 !CALL vol7d_smart_sort(this%vol7d, ltime=.TRUE., ltimerange=.TRUE., llevel=.TRUE,)
3696 
3697 call vol7d_set_attr_ind(this%vol7d)
3698 
3699 call vol7d_dballe_set_var_du(this%vol7d)
3700 
3701 !print *,"r-r",this%vol7d%dativar%r(:)%r
3702 !print *,"r-i",this%vol7d%dativar%r(:)%i
3703 !print *,"r-b",this%vol7d%dativar%r(:)%b
3704 !print *,"r-d",this%vol7d%dativar%r(:)%d
3705 !print *,"r-c",this%vol7d%dativar%r(:)%c
3706 
3707 !print *,"i-r",this%vol7d%dativar%i(:)%r
3708 !print *,"i-i",this%vol7d%dativar%i(:)%i
3709 !print *,"i-b",this%vol7d%dativar%i(:)%b
3710 !print *,"i-d",this%vol7d%dativar%i(:)%d
3711 !print *,"i-c",this%vol7d%dativar%i(:)%c
3712 
3713 
3714 END SUBROUTINE vol7d_dballe_importvvns_file
3715 
3716 
3717 
3718 subroutine mem_acquire( buffer,n,npool,category )
3719 
3720 INTEGER :: n,mem,npool,category,istat
3721 type(record),pointer :: buffer(:)
3722 type(record),pointer :: buffertmp(:)
3723 
3724 
3725 if ( n == 0 ) then
3726 
3727  allocate (buffer(npool))
3728  return
3729 
3730 end if
3731 
3732 mem=size(buffer)
3733 
3734 !call l4f_category_log(category,L4F_DEBUG,"mem_acquire dimension of buffer: "//to_char(mem)//" "//to_char(n))
3735 
3736 if (n > mem) then
3737 
3738  ALLOCATE (buffertmp(max(mem*2,n)),stat=istat)
3739  IF (istat /= 0) THEN
3740  CALL l4f_category_log(category,L4F_ERROR,'mem_acquire, cannot allocate ' &
3741  //TRIM(to_char(mem*2))//' buffer elements')
3742  CALL raise_fatal_error()
3743  endif
3744 
3745  buffertmp(:mem)=buffer(:)
3746 
3747  deallocate (buffer)
3748 
3749  buffer=>buffertmp
3750 
3751 end if
3752 
3753 end subroutine mem_acquire
3754 
3755 
3756 end MODULE vol7d_dballeold_class
3757 
3758 !>\example esempio_v7ddballe.f90
3759 !!/brief Programma esempio semplice per l'uso di vol7d con DB-All.e
3760 !!
3761 
3762 !>\example esempio_v7ddballe_multi.f90
3763 !!/brief Programma esempio per l'uso di vol7d con DB-All.e
3764 !!
3765 !!Vengono estratte più reti
3766 
3767 !>\example esempio_v7ddballe_import_export.f90
3768 !!\brief Esempio di utilizzo della classe vol7d_dballe_class
3769 !!
3770 !! Vengono estratti i dati e riscritti in un nuovo DSN
3771 
3772 
3773 
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.

Generated with Doxygen.