|
◆ 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] | this | oggetto contenente il volume e altre info per l'accesso al DSN |
[in] | network | network da exportare |
[in] | coordmin | coordinate minime e massime che definiscono il rettangolo di estrazione per l'esportazione |
[in] | coordmax | coordinate minime e massime che definiscono il rettangolo di estrazione per l'esportazione |
[in,out] | ana | identificativo della stazione da exportare |
[in] | timei | estremi temporali dei dati da esportare |
[in] | timef | estremi temporali dei dati da esportare |
[in] | level | livello selezionato per l'esportazione |
[in] | timerange | timerange selezionato per l'esportazione |
[in] | var | variabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica |
[in] | attr | variabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica |
[in] | anavar | variabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica |
[in] | anaattr | variabili da exportare secondo la tabella B locale o alias relative a dati, attributi, anagrafica e attributi dell'anagrafica |
[in] | attr_only | permette 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] | template | specificando 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 2099 #include "vol7d_dballe_class_nana.F90" 2100 #undef VOL7D_POLY_TYPES_V 2101 #define VOL7D_POLY_TYPES_V c 2105 #include "vol7d_dballe_class_nana.F90" 2106 #undef VOL7D_POLY_TYPES_V 2111 #undef VOL7D_POLY_TYPES_V 2112 #define VOL7D_POLY_TYPES_V r 2116 #include "vol7d_dballe_class_ndati.F90" 2117 #undef VOL7D_POLY_TYPES_V 2118 #define VOL7D_POLY_TYPES_V i 2122 #include "vol7d_dballe_class_ndati.F90" 2123 #undef VOL7D_POLY_TYPES_V 2124 #define VOL7D_POLY_TYPES_V b 2128 #include "vol7d_dballe_class_ndati.F90" 2129 #undef VOL7D_POLY_TYPES_V 2130 #define VOL7D_POLY_TYPES_V d 2134 #include "vol7d_dballe_class_ndati.F90" 2135 #undef VOL7D_POLY_TYPES_V 2136 #define VOL7D_POLY_TYPES_V c 2140 #include "vol7d_dballe_class_ndati.F90" 2141 #undef VOL7D_POLY_TYPES_V 2148 do iiiiii=1, nnetwork 2149 if (.not.lnetwork(iiiiii))cycle 2152 if (this%file .and. .not. generic_frag .and. ntime > 0 ) cycle 2156 if ( present(coordmin).and. present(coordmax)) then 2157 if (.not. inside(this%vol7d%ana(i)%coord,coordmin,coordmax)) cycle 2160 CALL getval(this%vol7d%ana(i)%coord, ilat=ilat,ilon=ilon) 2161 ier=idba_unsetall(this%handle) 2163 CALL l4f_category_log(this%category,l4f_debug, 'unsetall handle') 2165 ier=idba_setcontextana(this%handle) 2167 ier=idba_set(this%handle, "lat",ilat) 2168 ier=idba_set(this%handle, "lon",ilon) 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 2182 if ( c_e(this%vol7d%ana(i)%ident)) then 2184 call l4f_category_log(this%category,l4f_debug, "I have found a mobile station! ident: " 2187 ier=idba_set(this%handle, "ident",this%vol7d%ana(i)%ident) 2188 ier=idba_set(this%handle, "mobile",1) 2190 ier=idba_set(this%handle, "mobile",0) 2193 ier=idba_set(this%handle, "rep_memo",this%vol7d%network(iiiiii)%name) 2197 #undef VOL7D_POLY_TYPES_V 2198 #define VOL7D_POLY_TYPES_V r 2200 #include "vol7d_dballe_class_ana.F90" 2201 #undef VOL7D_POLY_TYPES_V 2202 #define VOL7D_POLY_TYPES_V i 2204 #include "vol7d_dballe_class_ana.F90" 2205 #undef VOL7D_POLY_TYPES_V 2206 #define VOL7D_POLY_TYPES_V b 2208 #include "vol7d_dballe_class_ana.F90" 2209 #undef VOL7D_POLY_TYPES_V 2210 #define VOL7D_POLY_TYPES_V d 2212 #include "vol7d_dballe_class_ana.F90" 2213 #undef VOL7D_POLY_TYPES_V 2214 #define VOL7D_POLY_TYPES_V c 2216 #include "vol7d_dballe_class_ana.F90" 2217 #undef VOL7D_POLY_TYPES_V 2221 if ( write .or. generic_frag) then 2223 if ( c_e(ltemplate)) then 2224 ier=idba_set(this%handle, "query", "message "//trim(ltemplate)) 2226 ier=idba_set(this%handle, "query", "message") 2230 call l4f_category_log(this%category,l4f_debug, "eseguo una main prendilo di anagrafica" 2232 ier=idba_prendilo(this%handle) 2239 call l4f_category_log(this%category,l4f_debug, "eseguo una main prendilo di anagrafica" 2241 ier=idba_prendilo(this%handle) 2242 ier=idba_enq(this%handle, "*ana_id",ana_id(i,iiiiii)) 2247 if ( c_e(this%vol7d%anavar%r(ii)%btable))ier=idba_unset(this%handle 2249 call l4f_category_log(this%category,l4f_debug, "unset ana: "//this%vol7d%anavar%r 2253 if ( c_e(this%vol7d%anavar%i(ii)%btable))ier=idba_unset(this%handle 2255 call l4f_category_log(this%category,l4f_debug, "unset ana: "//this%vol7d%anavar%i 2259 if ( c_e(this%vol7d%anavar%b(ii)%btable))ier=idba_unset(this%handle 2261 call l4f_category_log(this%category,l4f_debug, "unset ana: "//this%vol7d%anavar%b 2265 if ( c_e(this%vol7d%anavar%d(ii)%btable))ier=idba_unset(this%handle 2267 call l4f_category_log(this%category,l4f_debug, "unset ana: "//this%vol7d%anavar%d 2271 if ( c_e(this%vol7d%anavar%c(ii)%btable))ier=idba_unset(this%handle 2273 call l4f_category_log(this%category,l4f_debug, "unset ana: "//this%vol7d%anavar%c 2285 do iiiiii=1, nnetwork 2286 if (.not.lnetwork(iiiiii))cycle 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 2296 if ( present(timei) ) then 2297 if ( this%vol7d%time(ii) < timei ) cycle 2299 if ( present(timef) ) then 2300 if ( this%vol7d%time(ii) > timef ) cycle 2304 ier=idba_unsetall(this%handle) 2306 CALL l4f_category_log(this%category,l4f_debug, 'unsetall handle') 2309 ier=idba_set(this%handle, "rep_memo",this%vol7d%network(iiiiii)%name 2311 CALL l4f_category_log(this%category,l4f_debug, 'set rep_memo:'//this%vol7d%network 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) 2320 call l4f_category_log(this%category,l4f_debug, "dati riferiti a lat: "" lon: " 2323 if ( present(ana)) then 2324 if ( c_e(ana%ident) .and. ana%ident /= this%vol7d%ana(i)%ident 2325 if ( c_e(ana%coord) .and. ana%coord /= this%vol7d%ana(i)%coord 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) 2332 call l4f_category_log(this%category,l4f_debug, "there is a mobile station! identity: " 2336 ier=idba_set(this%handle, "mobile",0) 2341 if (.not. generic_frag) then 2344 call l4f_category_log(this%category,l4f_debug, "setcontextana") 2346 ier=idba_setcontextana(this%handle) 2350 #undef VOL7D_POLY_TYPES_V 2351 #define VOL7D_POLY_TYPES_V r 2353 #include "vol7d_dballe_class_ana.F90" 2354 #undef VOL7D_POLY_TYPES_V 2355 #define VOL7D_POLY_TYPES_V i 2357 #include "vol7d_dballe_class_ana.F90" 2358 #undef VOL7D_POLY_TYPES_V 2359 #define VOL7D_POLY_TYPES_V b 2361 #include "vol7d_dballe_class_ana.F90" 2362 #undef VOL7D_POLY_TYPES_V 2363 #define VOL7D_POLY_TYPES_V d 2365 #include "vol7d_dballe_class_ana.F90" 2366 #undef VOL7D_POLY_TYPES_V 2367 #define VOL7D_POLY_TYPES_V c 2369 #include "vol7d_dballe_class_ana.F90" 2370 #undef VOL7D_POLY_TYPES_V 2375 call l4f_category_log(this%category,l4f_debug, "eseguo una main prendilo di anagrafica" 2377 ier=idba_prendilo(this%handle) 2383 call l4f_category_log(this%category,l4f_debug, "specify ana_id: " 2386 ier=idba_set(this%handle, "ana_id",ana_id(i,iiiiii)) 2389 CALL getval(this%vol7d%time(ii), year=year, month=month, day=day, hour 2392 call l4f_category_log(this%category,l4f_debug, "setdate: "& 2395 ier=idba_setdate(this%handle,year,month,day,hour,minute,sec) 2398 if (.not.llevel(iii))cycle 2400 do iiii=1,ntimerange 2401 if (.not.ltimerange(iiii))cycle 2403 if (.not. lattr_only) then 2406 ier=idba_setlevel(this%handle, this%vol7d%level(iii)%level1, 2410 call l4f_category_log(this%category,l4f_debug, "level1: "// to_char 2411 call l4f_category_log(this%category,l4f_debug, "l1: "// to_char 2412 call l4f_category_log(this%category,l4f_debug, "level2: "// to_char 2413 call l4f_category_log(this%category,l4f_debug, "l2: "// to_char 2416 ier=idba_settimerange(this%handle, this%vol7d%timerange(iiii 2420 call l4f_category_log(this%category,l4f_debug, "timerange: "/ 2421 call l4f_category_log(this%category,l4f_debug, "T1: "// to_char 2422 call l4f_category_log(this%category,l4f_debug, "T2: "// to_char 2435 #undef VOL7D_POLY_TYPES_V 2436 #define VOL7D_POLY_TYPES_V r 2438 call l4f_category_log(this%category,l4f_debug, "macro tipo r") 2440 #include "vol7d_dballe_class_dati.F90" 2441 #undef VOL7D_POLY_TYPES_V 2442 #define VOL7D_POLY_TYPES_V i 2444 call l4f_category_log(this%category,l4f_debug, "macro tipo i") 2446 #include "vol7d_dballe_class_dati.F90" 2447 #undef VOL7D_POLY_TYPES_V 2448 #define VOL7D_POLY_TYPES_V b 2450 call l4f_category_log(this%category,l4f_debug, "macro tipo b") 2452 #include "vol7d_dballe_class_dati.F90" 2453 #undef VOL7D_POLY_TYPES_V 2454 #define VOL7D_POLY_TYPES_V d 2456 call l4f_category_log(this%category,l4f_debug, "macro tipo d") 2458 #include "vol7d_dballe_class_dati.F90" 2459 #undef VOL7D_POLY_TYPES_V 2460 #define VOL7D_POLY_TYPES_V c 2462 call l4f_category_log(this%category,l4f_debug, "macro tipo c") 2464 #include "vol7d_dballe_class_dati.F90" 2465 #undef VOL7D_POLY_TYPES_V 2483 call l4f_category_log(this%category,l4f_debug, "eseguo una main prendilo sui dati" 2485 ier=idba_prendilo(this%handle) 2492 if (this%file .and. .not. generic_frag) then 2495 if ( c_e(this%vol7d%anavar%r(a)%btable))ier=idba_unset(this%handle 2497 call l4f_category_log(this%category,l4f_debug, "unset ana: " 2501 if ( c_e(this%vol7d%anavar%i(a)%btable))ier=idba_unset(this%handle 2503 call l4f_category_log(this%category,l4f_debug, "unset ana: " 2507 if ( c_e(this%vol7d%anavar%b(a)%btable))ier=idba_unset(this%handle 2509 call l4f_category_log(this%category,l4f_debug, "unset ana: " 2513 if ( c_e(this%vol7d%anavar%d(a)%btable))ier=idba_unset(this%handle 2515 call l4f_category_log(this%category,l4f_debug, "unset ana: " 2519 if ( c_e(this%vol7d%anavar%c(a)%btable))ier=idba_unset(this%handle 2521 call l4f_category_log(this%category,l4f_debug, "unset ana: " 2529 do iiiii=1,ndativarr 2530 if( c_e(this%vol7d%dativar%r(iiiii)%btable))ier=idba_unset(this%handle 2532 call l4f_category_log(this%category,l4f_debug, "unset dati: " 2535 do iiiii=1,ndativari 2536 if( c_e(this%vol7d%dativar%i(iiiii)%btable))ier=idba_unset(this%handle 2538 call l4f_category_log(this%category,l4f_debug, "unset dati: " 2541 do iiiii=1,ndativarb 2542 if( c_e(this%vol7d%dativar%b(iiiii)%btable))ier=idba_unset(this%handle 2544 call l4f_category_log(this%category,l4f_debug, "unset dati: " 2547 do iiiii=1,ndativard 2548 if( c_e(this%vol7d%dativar%d(iiiii)%btable))ier=idba_unset(this%handle 2550 call l4f_category_log(this%category,l4f_debug, "unset dati: " 2553 do iiiii=1,ndativarc 2554 if( c_e(this%vol7d%dativar%c(iiiii)%btable))ier=idba_unset(this%handle 2556 call l4f_category_log(this%category,l4f_debug, "unset dati: " 2565 if ( c_e(ltemplate)) then 2566 ier=idba_set(this%handle, "query", "message "//trim(ltemplate)) 2568 ier=idba_set(this%handle, "query", "message") 2571 call l4f_category_log(this%category,l4f_debug, "close message ") 2574 call l4f_category_log(this%category,l4f_debug, "eseguo una main prendilo sui dati" 2576 ier=idba_prendilo(this%handle) 2583 END SUBROUTINE vol7d_dballe_export 2588 SUBROUTINE vol7d_dballe_delete(this, preserveidbhandle) 2589 TYPE(vol7d_dballe) :: this 2590 logical, intent(in), optional :: preserveidbhandle 2595 ier=idba_fatto(this%handle) 2599 ier=idba_fatto(this%handle) 2600 ier=idba_fatto(this%handle_staz) 2601 if (.not. optio_log(preserveidbhandle)) ier=idba_arrivederci(this%idbhandle 2605 ier=idba_error_remove_callback(this%handle_err) 2610 this%idbhandle=imiss 2612 this%handle_err=imiss 2613 this%handle_staz=imiss 2615 if ( associated(this%data_id)) then 2616 deallocate (this%data_id) 2617 nullify(this%data_id) 2625 END SUBROUTINE vol7d_dballe_delete 2629 subroutine vol7d_dballe_import_dballevar(this) 2631 type(vol7d_var), pointer :: this(:) 2634 IF ( associated(this)) return 2635 IF ( allocated(blocal)) then 2636 ALLOCATE(this( size(blocal))) 2641 un = open_dballe_file( 'dballe.txt', filetype_data) 2644 call l4f_log(l4f_error, "error open_dballe_file: dballe.txt") 2645 CALL raise_error( "error open_dballe_file: dballe.txt") 2660 readline: do i = 1 ,n 2661 READ(un, '(1x,A6,1x,a65,a24,i4)')blocal(i)%btable,blocal(i)%description 2670 CALL l4f_log(l4f_info, 'Found '//trim( to_char(i-1))// ' variables in dballe master table' 2677 END SUBROUTINE vol7d_dballe_import_dballevar 2684 subroutine vol7d_dballe_set_var_du(this) 2688 type(vol7d_var), pointer :: dballevar(:) 2693 #undef VOL7D_POLY_NAME 2694 #define VOL7D_POLY_NAME dativar 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 2714 #undef VOL7D_POLY_NAME 2715 #define VOL7D_POLY_NAME anavar 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 2736 #undef VOL7D_POLY_NAME 2737 #define VOL7D_POLY_NAME datiattr 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 2758 #undef VOL7D_POLY_NAME 2759 #define VOL7D_POLY_NAME anaattr 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 2780 deallocate(dballevar) 2784 end subroutine vol7d_dballe_set_var_du 2788 FUNCTION get_dballe_filepath(filename, filetype) RESULT(path) 2790 INTEGER, INTENT(in) :: filetype 2796 IF (dballe_name == ' ') THEN 2797 CALL getarg(0, dballe_name) 2801 IF (filetype < 1 .OR. filetype > nftype) THEN 2803 CALL l4f_log(l4f_error, 'dballe file type '//trim( to_char(filetype))// 2811 IF (path /= ' ') THEN 2813 path=trim(path)// '/'//filename 2814 INQUIRE(file=path, exist=exist) 2816 CALL l4f_log(l4f_info, 'dballe file '//trim(path)// ' found') 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) 2826 CALL l4f_log(l4f_info, 'dballe file '//trim(path)// ' found') 2834 END FUNCTION get_dballe_filepath 2837 FUNCTION open_dballe_file(filename, filetype) RESULT(unit) 2839 INTEGER, INTENT(in) :: filetype 2845 path=get_dballe_filepath(filename, filetype) 2846 IF (path == '') RETURN 2849 IF (unit == -1) RETURN 2851 OPEN(unit, file=path, status= 'old', iostat = i) 2853 CALL l4f_log(l4f_info, 'dballe file '//trim(path)// ' opened') 2861 END FUNCTION open_dballe_file 2865 FUNCTION v7d_dballe_error_handler(category) 2866 INTEGER :: category, code, l4f_level 2867 INTEGER :: v7d_dballe_error_handler 2874 if (code == 13 ) then 2892 if (l4f_level == l4f_error ) CALL raise_fatal_error( "dballe: "//message) 2894 v7d_dballe_error_handler = 0 2897 END FUNCTION v7d_dballe_error_handler 2906 #ifndef F2003_EXTENDED_FEATURES 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) 2913 TYPE(vol7d_dballe), INTENT(inout) :: this 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 2923 logical, intent(in), optional :: anaonly 2930 LOGICAL :: ldegnet, lanaonly 2931 integer :: year,month,day,hour,minute,sec 2932 integer :: rlevel1, rl1,rlevel2, rl2 2933 integer :: rtimerange, p1, p2 2935 integer :: indana,indtime,indlevel,indtimerange,inddativar,indnetwork 2938 integer :: nana,ntime,ntimerange,nlevel,nnetwork 2939 TYPE(vol7d_network), ALLOCATABLE :: networktmp(:) 2941 INTEGER :: i,ii, n, na, nd 2942 integer :: nvar, nanavar ,indanavar 2944 INTEGER(kind=int_l) :: ilat,ilon,latmin,latmax,lonmin,lonmax,ilata,ilona 2948 integer :: ndativarr, ndativari, ndativarb, ndativard, ndativarc 2949 integer :: ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc 2950 integer :: ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc 2952 integer :: nanavarr, nanavari, nanavarb, nanavard, nanavarc 2953 integer :: nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc 2954 integer :: nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc 2956 integer :: ir,ib,id,ic,ier 2958 TYPE(datetime) :: timee 2959 TYPE(vol7d_level) :: levele 2960 TYPE(vol7d_timerange) :: timerangee 2962 TYPE(vol7d_network) :: lnetwork 2963 TYPE(vol7d_level) :: llevel 2964 TYPE(vol7d_timerange) :: ltimerange 2975 TYPE(vol7d) :: vol7dtmp 2977 type(record), pointer :: buffer(:),bufferana(:) 2984 IF ( PRESENT(set_network)) THEN 2985 if ( c_e(set_network)) then 2987 call l4f_category_log(this%category,l4f_info,& 2988 "set_network is not fully implemented in bufr/crex import: priority ") 2996 if (present(attr))then 2997 if (size(attr) > 0 )then 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 ") 3012 if (present(network)) then 3018 if (present(level)) then 3024 if (present(timerange)) then 3025 ltimerange=timerange 3027 call init(ltimerange) 3031 ier=idba_unsetall(this%handle) 3043 ier=idba_setcontextana (this%handle) 3046 ier=idba_voglioquesto (this%handle,N) 3048 call l4f_category_log(this%category,L4F_ERROR,"voglioquesto return error ") 3049 N=1 ! I do not want terminate while loop 3053 call l4f_category_log(this%category,L4F_debug,"numero dati voglioquesto "//to_char(n)) 3055 .not. if ( c_e(N)) exit 3058 if (N == 0) exit ! use only with dballe svn <= 4266 3061 ! dammi tutti i dati 3064 ier=idba_dammelo (this%handle,btable) 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 3073 !nbtable=btable_numerico(btable) 3074 ! ind = firsttrue(qccli%v7d%dativar%r(:)%btable == nbtable) 3075 ! IF (ind<1) cycle ! non c'e' 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) 3082 !!$ print*,"ident ",ident 3083 !!$ do ier=1,len(ident) 3084 !!$ print *,iachar(ident(ier:ier)) 3087 ! inizio la serie dei test con i parametri richiesti 3089 if(c_e(lnetwork)) then 3090 if (rep_memo /= lnetwork%name) cycle 3093 ! in alternativa si trattano insieme 3094 !!$ call init(ana,lat=lat,lon=lon,ident=ident) 3096 .and. !!$ if (present(coordmin)present(coordmax))then 3098 .not. !!$ if ( inside(this%vol7d%ana(i)%coord,coordmin,coordmax)) cycle 3099 !!$ !print * ,"sei dentro, ok " 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 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 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 3128 if (c_e(ana%ident)) then 3129 if (ana%ident /= ident) cycle 3133 call init(timee, year=year, month=month, day=day, hour=hour, minute=minute,msec=sec*1000) 3135 if (present(timei)) then 3136 .and. if (c_e(timei) timee < timei) cycle 3139 if (present(timef)) then 3140 .and. if (c_e(timef) timee > timef) cycle 3143 if (c_e(ltimerange))then 3144 call init(timerangee, timerange%timerange, timerange%p1, timerange%p2) 3145 if (timerangee /= ltimerange) cycle 3148 if (c_e(llevel))then 3149 call init (levele, rlevel1, rl1,rlevel2, rl2) 3150 if (levele /= llevel) cycle 3153 if (rlevel1 /= 257)then 3156 if (present (var)) then 3157 ! nvar=count(c_e(var)) 3158 .and. if (any(c_e(var)) (all(btable /= var))) cycle 3166 call l4f_category_log(this%category,L4F_DEBUG,"numero dati dati: "//to_char(nd)//btable) 3168 call mem_acquire( buffer,nd,0,this%category ) 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 3176 .and. if (present(var) present(varkind))then 3177 ii=( firsttrue(var == btable)) 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) 3187 ier=idba_enq (this%handle,btable,buffer(nd)%datoc) !char is default 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 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 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) 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 3211 call mem_acquire( bufferana,na,0,this%category ) 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) 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 3231 ! ----------------> anagrafica 3234 !ora legge tutti i dati di anagrafica e li mette in bufferana 3238 if (btable == "b04001.or. " btable == "b04002.or. " btable == "b04003 ") cycle 3240 if (btable == "b04004.or. " btable == "b04005.or. " btable == "b04006 ") cycle 3242 if (btable == "b01193.or. " btable == "b01194 ") cycle 3245 if (present (anavar)) then 3246 .and. if (any(c_e(anavar)) (all(btable /= anavar))) btable=DBA_MVC 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 3257 call l4f_category_log(this%category,L4F_debug,"numero dati ana: "//to_char(na)//btable) 3259 call mem_acquire( bufferana,na,0,this%category ) 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 3269 if (c_e(btable)) then 3271 .and. if (present(anavar) present(anavarkind))then 3272 ii=( firsttrue(anavar == btable)) 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) 3282 ier=idba_enq (this%handle,btable,bufferana(na)%datoc) !char is default 3283 !print*,"dato anagrafica ",btable," ",bufferana(na)%dator 3286 !bufferizzo il contesto 3287 !print *,"lat,lon ",lat,lon 3288 !print*,year,month,day,hour,minute,sec 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 3302 ! ----------------> anagrafica fine 3304 .not. if ( present(var))then 3305 nvar = count_distinct(buffer(:nd)%btable, back=.TRUE.) 3307 .not. if ( all( c_e(var))) then 3308 nvar = count_distinct(buffer(:nd)%btable, back=.TRUE.) 3310 nvar=count(c_e(var)) 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.) 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.) 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 ") 3344 !!$print *, "nana= ",nana," ntime= ",ntime," ntimerange= ",ntimerange, & 3345 !!$ " nlevel= ",nlevel," nnetwork= ",nnetwork," ndativarr= ",ndativarr 3359 ! ----------------> anagrafica 3361 .not. if ( present(anavar))then 3362 nanavar = count_distinct(bufferana(:na)%btable, back=.TRUE.,mask=(bufferana(:na)%btable /= DBA_MVC)) 3364 .not. if (all( c_e(anavar))) then 3365 nanavar = count_distinct(bufferana(:na)%btable, back=.TRUE.,mask=(bufferana(:na)%btable /= DBA_MVC)) 3367 nanavar = count(c_e(anavar)) 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 ") 3400 ! ----------------> anagrafica fine 3407 ! qui faccio le operazioni minime per avere solo l'anagrafica utile per certe operazioni 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.) 3415 deallocate (bufferana) 3418 vol7dtmp%network(1)=set_network 3420 vol7dtmp%network=pack_distinct(networktmp, nnetwork, back=.TRUE.) 3421 DEALLOCATE(networktmp) 3425 CALL vol7d_merge(this%vol7d, 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) 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.) 3454 vol7dtmp%timerange=pack_distinct(buffer(:nd)%timerange, ntimerange, back=.TRUE.) 3456 vol7dtmp%level=pack_distinct(buffer(:nd)%level, nlevel, back=.TRUE.) 3460 vol7dtmp%network(1)=set_network 3462 vol7dtmp%network=pack_distinct(networktmp, nnetwork, back=.TRUE.) 3463 DEALLOCATE(networktmp) 3466 !print*,"reti presenti ", vol7dtmp%network%name,buffer%network%name 3468 .and. if (present(var) present(varkind))then 3476 do i=1,size(varkind) 3477 if (varkind(i) == "r ") then 3479 call init (vol7dtmp%dativar%r(ir), btable=var(i)) 3481 if (varkind(i) == "i ") then 3483 call init (vol7dtmp%dativar%i(ii), btable=var(i)) 3485 if (varkind(i) == "b ") then 3487 call init (vol7dtmp%dativar%b(ib), btable=var(i)) 3489 if (varkind(i) == "d ") then 3491 call init (vol7dtmp%dativar%d(id), btable=var(i)) 3493 if (varkind(i) == "c ") then 3495 call init (vol7dtmp%dativar%c(ic), btable=var(i)) 3498 else if (present(var))then 3499 if (any(c_e(var))) then 3501 call init (vol7dtmp%dativar%c(i), btable=var(i)) 3507 call init(vol7dtmp%dativar%c(i)) 3509 if (ndativarc > 0) then 3510 call pack_distinct_c(buffer(:nd)%btable,vol7dtmp%dativar%c%btable, back=.TRUE.) 3516 call init(vol7dtmp%dativar%c(i)) 3518 if (ndativarc > 0) then 3519 call pack_distinct_c(buffer(:nd)%btable,vol7dtmp%dativar%c%btable, back=.TRUE.) 3524 !-----------------------> anagrafica 3526 .and. if (present(anavar) present(anavarkind))then 3534 do i=1,size(anavarkind) 3535 if (anavarkind(i) == "r ") then 3537 call init (vol7dtmp%anavar%r(ir), btable=anavar(i)) 3539 if (anavarkind(i) == "i ") then 3541 call init (vol7dtmp%anavar%i(ii), btable=anavar(i)) 3543 if (anavarkind(i) == "b ") then 3545 call init (vol7dtmp%anavar%b(ib), btable=anavar(i)) 3547 if (anavarkind(i) == "d ") then 3549 call init (vol7dtmp%anavar%d(id), btable=anavar(i)) 3551 if (anavarkind(i) == "c ") then 3553 call init (vol7dtmp%anavar%c(ic), btable=anavar(i)) 3556 else if (present(anavar))then 3558 IF (ANY(c_e(anavar))) THEN 3560 CALL init (vol7dtmp%anavar%c(i), btable=anavar(i)) 3565 call init(vol7dtmp%anavar%c(i)) 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)) 3578 call init(vol7dtmp%anavar%c(i)) 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)) 3587 !-----------------------> anagrafica fine 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) 3600 indnetwork = firsttrue(buffer(i)%network == vol7dtmp%network) 3602 !print *, indana,indtime,indlevel,indtimerange,indnetwork 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 & 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 & 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 & 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 & 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 & 3641 !------------------------- anagrafica 3646 indana = firsttrue(bufferana(i)%ana == vol7dtmp%ana) 3651 indnetwork = firsttrue(bufferana(i)%network == vol7dtmp%network) 3654 .or. if (indana < 1 indnetwork < 1 )cycle 3656 !print *, indana,indtime,indlevel,indtimerange,indnetwork 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 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 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 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 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 3683 !------------------------- anagrafica fine 3690 deallocate (bufferana) 3694 ! should we sort separately in case no merge is done? 3695 !CALL vol7d_smart_sort(this%vol7d, ltime=.TRUE., ltimerange=.TRUE., llevel=.TRUE,) 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 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 3714 END SUBROUTINE vol7d_dballe_importvvns_file 3718 subroutine mem_acquire( buffer,n,npool,category ) 3720 INTEGER :: n,mem,npool,category,istat 3721 type(record),pointer :: buffer(:) 3722 type(record),pointer :: buffertmp(:) 3727 allocate (buffer(npool)) 3734 !call l4f_category_log(category,L4F_DEBUG,"mem_acquire dimension of buffer "//to_char(mem)//""//to_char(n)) 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() 3745 buffertmp(:mem)=buffer(:) 3753 end subroutine mem_acquire 3756 end MODULE vol7d_dballeold_class 3758 !>\example esempio_v7ddballe.f90 3759 !!/brief Programma esempio semplice per l'uso di vol7d con DB-All.e 3762 !>\example esempio_v7ddballe_multi.f90 3763 !!/brief Programma esempio per l'uso di vol7d con DB-All.e 3765 !!Vengono estratte più reti 3767 !>\example esempio_v7ddballe_import_export.f90 3768 !!\brief Esempio di utilizzo della classe vol7d_dballe_class 3770 !! Vengono estratti i dati e riscritti in un nuovo DSN 3773 Functions that return a trimmed CHARACTER representation of the input variable.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Restituiscono il valore dell'oggetto nella forma desiderata.
|