libsim Versione 7.2.1

◆ vol7d_diff_only()

subroutine vol7d_diff_only ( type(vol7d), intent(in)  this,
type(vol7d), intent(out)  that,
logical, intent(in), optional  data_only,
logical, intent(in), optional  ana 
)

Metodo per ottenere solo le differenze tra due oggetti vol7d.

Il primo volume viene confrontato col secondo; nel secondo volume ovunque i dati confrontati siano coincidenti viene impostato valore mancante.

Parametri
[in]thisprimo volume da confrontare
[out]thatsecondo volume da confrontare in cui eliminare i dati coincidenti
[in]data_onlyattiva l'elaborazione dei soli dati e non dell'anagrafica (default: .false.)
[in]anaattiva l'elaborazione dell'anagrafica (coordinate e ident) (default: .false.)

Definizione alla linea 2489 del file vol7d_class.F90.

2490
2491if (.not. present(unit))then
2492 lunit=getunit()
2493else
2494 if (unit==0)then
2495 lunit=getunit()
2496 unit=lunit
2497 else
2498 lunit=unit
2499 end if
2500end if
2501
2502lfilename=trim(arg)//".v7d"
2503if (index(arg,'/',back=.true.) > 0) lfilename=lfilename(index(arg,'/',back=.true.)+1 : )
2504
2505if (present(filename))then
2506 if (filename /= "")then
2507 lfilename=filename
2508 end if
2509end if
2510
2511if (present(filename_auto))filename_auto=lfilename
2512
2513
2514inquire(unit=lunit,opened=opened)
2515if (.not. opened) then
2516! inquire(file=lfilename, EXIST=exist)
2517! IF (exist) THEN
2518! CALL l4f_log(L4F_FATAL, &
2519! 'in vol7d_write_on_file, file exists, cannot open file '//TRIM(lfilename))
2520! CALL raise_fatal_error()
2521! ENDIF
2522 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM')
2523 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
2524end if
2525
2526if (associated(this%ana)) nana=size(this%ana)
2527if (associated(this%time)) ntime=size(this%time)
2528if (associated(this%timerange)) ntimerange=size(this%timerange)
2529if (associated(this%level)) nlevel=size(this%level)
2530if (associated(this%network)) nnetwork=size(this%network)
2531
2532if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
2533if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
2534if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
2535if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
2536if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
2537
2538if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
2539if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
2540if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
2541if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
2542if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)
2543
2544if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
2545if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
2546if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
2547if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
2548if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
2549
2550if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
2551if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
2552if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
2553if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
2554if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
2555
2556if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
2557if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
2558if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
2559if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
2560if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)
2561
2562if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
2563if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
2564if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
2565if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
2566if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)
2567
2568write(unit=lunit)ldescription
2569write(unit=lunit)tarray
2570
2571write(unit=lunit)&
2572 nana, ntime, ntimerange, nlevel, nnetwork, &
2573 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
2574 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
2575 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
2576 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
2577 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
2578 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
2579 this%time_definition
2580
2581
2582!write(unit=lunit)this
2583
2584
2585!! prime 5 dimensioni
2586if (associated(this%ana)) call write_unit(this%ana, lunit)
2587if (associated(this%time)) call write_unit(this%time, lunit)
2588if (associated(this%level)) write(unit=lunit)this%level
2589if (associated(this%timerange)) write(unit=lunit)this%timerange
2590if (associated(this%network)) write(unit=lunit)this%network
2591
2592 !! 6a dimensione: variabile dell'anagrafica e dei dati
2593 !! con relativi attributi e in 5 tipi diversi
2594
2595if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r
2596if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i
2597if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b
2598if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d
2599if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c
2600
2601if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r
2602if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i
2603if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b
2604if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d
2605if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c
2606
2607if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r
2608if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i
2609if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b
2610if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d
2611if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c
2612
2613if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r
2614if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i
2615if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b
2616if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d
2617if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c
2618
2619if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r
2620if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i
2621if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b
2622if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d
2623if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c
2624
2625if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
2626if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
2627if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
2628if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
2629if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c
2630
2631!! Volumi di valori e attributi per anagrafica e dati
2632
2633if (associated(this%volanar)) write(unit=lunit)this%volanar
2634if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr
2635if (associated(this%voldatir)) write(unit=lunit)this%voldatir
2636if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr
2637
2638if (associated(this%volanai)) write(unit=lunit)this%volanai
2639if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri
2640if (associated(this%voldatii)) write(unit=lunit)this%voldatii
2641if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri
2642
2643if (associated(this%volanab)) write(unit=lunit)this%volanab
2644if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb
2645if (associated(this%voldatib)) write(unit=lunit)this%voldatib
2646if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb
2647
2648if (associated(this%volanad)) write(unit=lunit)this%volanad
2649if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd
2650if (associated(this%voldatid)) write(unit=lunit)this%voldatid
2651if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd
2652
2653if (associated(this%volanac)) write(unit=lunit)this%volanac
2654if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc
2655if (associated(this%voldatic)) write(unit=lunit)this%voldatic
2656if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc
2657
2658if (.not. present(unit)) close(unit=lunit)
2659
2660end subroutine vol7d_write_on_file
2661
2662
2669
2670
2671subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
2672
2673TYPE(vol7d),INTENT(OUT) :: this
2674integer,intent(inout),optional :: unit
2675character(len=*),INTENT(in),optional :: filename
2676character(len=*),intent(out),optional :: filename_auto
2677character(len=*),INTENT(out),optional :: description
2678integer,intent(out),optional :: tarray(8)
2679
2680
2681integer :: nana, ntime, ntimerange, nlevel, nnetwork, &
2682 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
2683 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
2684 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
2685 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
2686 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
2687 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc
2688
2689character(len=254) :: ldescription,lfilename,arg
2690integer :: ltarray(8),lunit,ios
2691logical :: opened,exist
2692
2693
2694call getarg(0,arg)
2695
2696if (.not. present(unit))then
2697 lunit=getunit()
2698else
2699 if (unit==0)then
2700 lunit=getunit()
2701 unit=lunit
2702 else
2703 lunit=unit
2704 end if
2705end if
2706
2707lfilename=trim(arg)//".v7d"
2708if (index(arg,'/',back=.true.) > 0) lfilename=lfilename(index(arg,'/',back=.true.)+1 : )
2709
2710if (present(filename))then
2711 if (filename /= "")then
2712 lfilename=filename
2713 end if
2714end if
2715
2716if (present(filename_auto))filename_auto=lfilename
2717
2718
2719inquire(unit=lunit,opened=opened)
2720IF (.NOT. opened) THEN
2721 inquire(file=lfilename,exist=exist)
2722 IF (.NOT.exist) THEN
2723 CALL l4f_log(l4f_fatal, &
2724 'in vol7d_read_from_file, file does not exists, cannot open')
2725 CALL raise_fatal_error()
2726 ENDIF
2727 OPEN(unit=lunit, file=lfilename, form='UNFORMATTED', access='STREAM', &
2728 status='OLD', action='READ')
2729 CALL l4f_log(l4f_info, 'opened: '//trim(lfilename))
2730end if
2731
2732
2733call init(this)
2734read(unit=lunit,iostat=ios)ldescription
2735
2736if (ios < 0) then ! A negative value indicates that the End of File or End of Record
2737 call vol7d_alloc (this)
2738 call vol7d_alloc_vol (this)
2739 if (present(description))description=ldescription
2740 if (present(tarray))tarray=ltarray
2741 if (.not. present(unit)) close(unit=lunit)
2742end if
2743
2744read(unit=lunit)ltarray
2745
2746CALL l4f_log(l4f_info, 'Reading vol7d from file')
2747CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
2748CALL l4f_log(l4f_info, 'written on '//trim(to_char(ltarray(1)))//' '// &
2749 trim(to_char(ltarray(2)))//' '//trim(to_char(ltarray(3))))
2750
2751if (present(description))description=ldescription
2752if (present(tarray))tarray=ltarray
2753
2754read(unit=lunit)&
2755 nana, ntime, ntimerange, nlevel, nnetwork, &
2756 ndativarr, ndativari, ndativarb, ndativard, ndativarc,&
2757 ndatiattrr, ndatiattri, ndatiattrb, ndatiattrd, ndatiattrc,&
2758 ndativarattrr, ndativarattri, ndativarattrb, ndativarattrd, ndativarattrc,&
2759 nanavarr, nanavari, nanavarb, nanavard, nanavarc,&
2760 nanaattrr, nanaattri, nanaattrb, nanaattrd, nanaattrc,&
2761 nanavarattrr, nanavarattri, nanavarattrb, nanavarattrd, nanavarattrc, &
2762 this%time_definition
2763
2764call vol7d_alloc (this, &
2765 nana=nana, ntime=ntime, ntimerange=ntimerange, nlevel=nlevel, nnetwork=nnetwork,&
2766 ndativarr=ndativarr, ndativari=ndativari, ndativarb=ndativarb,&
2767 ndativard=ndativard, ndativarc=ndativarc,&
2768 ndatiattrr=ndatiattrr, ndatiattri=ndatiattri, ndatiattrb=ndatiattrb,&
2769 ndatiattrd=ndatiattrd, ndatiattrc=ndatiattrc,&
2770 ndativarattrr=ndativarattrr, ndativarattri=ndativarattri, ndativarattrb=ndativarattrb, &
2771 ndativarattrd=ndativarattrd, ndativarattrc=ndativarattrc,&
2772 nanavarr=nanavarr, nanavari=nanavari, nanavarb=nanavarb, &
2773 nanavard=nanavard, nanavarc=nanavarc,&
2774 nanaattrr=nanaattrr, nanaattri=nanaattri, nanaattrb=nanaattrb,&
2775 nanaattrd=nanaattrd, nanaattrc=nanaattrc,&
2776 nanavarattrr=nanavarattrr, nanavarattri=nanavarattri, nanavarattrb=nanavarattrb, &
2777 nanavarattrd=nanavarattrd, nanavarattrc=nanavarattrc)
2778
2779
2780if (associated(this%ana)) call read_unit(this%ana, lunit)
2781if (associated(this%time)) call read_unit(this%time, lunit)
2782if (associated(this%level)) read(unit=lunit)this%level
2783if (associated(this%timerange)) read(unit=lunit)this%timerange
2784if (associated(this%network)) read(unit=lunit)this%network
2785
2786if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r
2787if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i
2788if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b
2789if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d
2790if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c
2791
2792if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r
2793if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i
2794if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b
2795if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d
2796if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c
2797
2798if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r
2799if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i
2800if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b
2801if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d
2802if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c
2803
2804if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r
2805if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i
2806if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b
2807if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d
2808if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c
2809
2810if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r
2811if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i
2812if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b
2813if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d
2814if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c
2815
2816if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
2817if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
2818if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
2819if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
2820if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c
2821
2822call vol7d_alloc_vol (this)
2823
2824!! Volumi di valori e attributi per anagrafica e dati
2825
2826if (associated(this%volanar)) read(unit=lunit)this%volanar
2827if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr
2828if (associated(this%voldatir)) read(unit=lunit)this%voldatir
2829if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr
2830
2831if (associated(this%volanai)) read(unit=lunit)this%volanai
2832if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri
2833if (associated(this%voldatii)) read(unit=lunit)this%voldatii
2834if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri
2835
2836if (associated(this%volanab)) read(unit=lunit)this%volanab
2837if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb
2838if (associated(this%voldatib)) read(unit=lunit)this%voldatib
2839if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb
2840
2841if (associated(this%volanad)) read(unit=lunit)this%volanad
2842if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd
2843if (associated(this%voldatid)) read(unit=lunit)this%voldatid
2844if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd
2845
2846if (associated(this%volanac)) read(unit=lunit)this%volanac
2847if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc
2848if (associated(this%voldatic)) read(unit=lunit)this%voldatic
2849if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc
2850
2851if (.not. present(unit)) close(unit=lunit)
2852
2853end subroutine vol7d_read_from_file
2854
2855
2856! to double precision
2857elemental doubleprecision function doubledatd(voldat,var)
2858doubleprecision,intent(in) :: voldat
2859type(vol7d_var),intent(in) :: var
2860
2861doubledatd=voldat
2862
2863end function doubledatd
2864
2865
2866elemental doubleprecision function doubledatr(voldat,var)
2867real,intent(in) :: voldat
2868type(vol7d_var),intent(in) :: var
2869
2870if (c_e(voldat))then
2871 doubledatr=dble(voldat)
2872else
2873 doubledatr=dmiss
2874end if
2875
2876end function doubledatr
2877
2878
2879elemental doubleprecision function doubledati(voldat,var)
2880integer,intent(in) :: voldat
2881type(vol7d_var),intent(in) :: var
2882
2883if (c_e(voldat)) then
2884 if (c_e(var%scalefactor))then
2885 doubledati=dble(voldat)/10.d0**var%scalefactor
2886 else
2887 doubledati=dble(voldat)
2888 endif
2889else
2890 doubledati=dmiss
2891end if
2892
2893end function doubledati
2894
2895
2896elemental doubleprecision function doubledatb(voldat,var)
2897integer(kind=int_b),intent(in) :: voldat
2898type(vol7d_var),intent(in) :: var
2899
2900if (c_e(voldat)) then
2901 if (c_e(var%scalefactor))then
2902 doubledatb=dble(voldat)/10.d0**var%scalefactor
2903 else
2904 doubledatb=dble(voldat)
2905 endif
2906else
2907 doubledatb=dmiss
2908end if
2909
2910end function doubledatb
2911
2912
2913elemental doubleprecision function doubledatc(voldat,var)
2914CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
2915type(vol7d_var),intent(in) :: var
2916
2917doubledatc = c2d(voldat)
2918if (c_e(doubledatc) .and. c_e(var%scalefactor))then
2919 doubledatc=doubledatc/10.d0**var%scalefactor
2920end if
2921
2922end function doubledatc
2923
2924
2925! to integer
2926elemental integer function integerdatd(voldat,var)
2927doubleprecision,intent(in) :: voldat
2928type(vol7d_var),intent(in) :: var
2929
2930if (c_e(voldat))then
2931 if (c_e(var%scalefactor)) then
2932 integerdatd=nint(voldat*10d0**var%scalefactor)
2933 else
2934 integerdatd=nint(voldat)
2935 endif
2936else
2937 integerdatd=imiss
2938end if
2939
2940end function integerdatd
2941
2942
2943elemental integer function integerdatr(voldat,var)
2944real,intent(in) :: voldat
2945type(vol7d_var),intent(in) :: var
2946
2947if (c_e(voldat))then
2948 if (c_e(var%scalefactor)) then
2949 integerdatr=nint(voldat*10d0**var%scalefactor)
2950 else
2951 integerdatr=nint(voldat)
2952 endif
2953else
2954 integerdatr=imiss
2955end if
2956
2957end function integerdatr
2958
2959
2960elemental integer function integerdati(voldat,var)
2961integer,intent(in) :: voldat
2962type(vol7d_var),intent(in) :: var
2963
2964integerdati=voldat
2965
2966end function integerdati
2967
2968
2969elemental integer function integerdatb(voldat,var)
2970integer(kind=int_b),intent(in) :: voldat
2971type(vol7d_var),intent(in) :: var
2972
2973if (c_e(voldat))then
2974 integerdatb=voldat
2975else
2976 integerdatb=imiss
2977end if
2978
2979end function integerdatb
2980
2981
2982elemental integer function integerdatc(voldat,var)
2983CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
2984type(vol7d_var),intent(in) :: var
2985
2986integerdatc=c2i(voldat)
2987
2988end function integerdatc
2989
2990
2991! to real
2992elemental real function realdatd(voldat,var)
2993doubleprecision,intent(in) :: voldat
2994type(vol7d_var),intent(in) :: var
2995
2996if (c_e(voldat))then
2997 realdatd=real(voldat)
2998else
2999 realdatd=rmiss
3000end if
3001
3002end function realdatd
3003
3004
3005elemental real function realdatr(voldat,var)
3006real,intent(in) :: voldat
3007type(vol7d_var),intent(in) :: var
3008
3009realdatr=voldat
3010
3011end function realdatr
3012
3013
3014elemental real function realdati(voldat,var)
3015integer,intent(in) :: voldat
3016type(vol7d_var),intent(in) :: var
3017
3018if (c_e(voldat)) then
3019 if (c_e(var%scalefactor))then
3020 realdati=float(voldat)/10.**var%scalefactor
3021 else
3022 realdati=float(voldat)
3023 endif
3024else
3025 realdati=rmiss
3026end if
3027
3028end function realdati
3029
3030
3031elemental real function realdatb(voldat,var)
3032integer(kind=int_b),intent(in) :: voldat
3033type(vol7d_var),intent(in) :: var
3034
3035if (c_e(voldat)) then
3036 if (c_e(var%scalefactor))then
3037 realdatb=float(voldat)/10**var%scalefactor
3038 else
3039 realdatb=float(voldat)
3040 endif
3041else
3042 realdatb=rmiss
3043end if
3044
3045end function realdatb
3046
3047
3048elemental real function realdatc(voldat,var)
3049CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
3050type(vol7d_var),intent(in) :: var
3051
3052realdatc=c2r(voldat)
3053if (c_e(realdatc) .and. c_e(var%scalefactor))then
3054 realdatc=realdatc/10.**var%scalefactor
3055end if
3056
3057end function realdatc
3058
3059
3065FUNCTION realanavol(this, var) RESULT(vol)
3066TYPE(vol7d),INTENT(in) :: this
3067TYPE(vol7d_var),INTENT(in) :: var
3068REAL :: vol(SIZE(this%ana),size(this%network))
3069
3070CHARACTER(len=1) :: dtype
3071INTEGER :: indvar
3072
3073dtype = cmiss
3074indvar = index(this%anavar, var, type=dtype)
3075
3076IF (indvar > 0) THEN
3077 SELECT CASE (dtype)
3078 CASE("d")
3079 vol = realdat(this%volanad(:,indvar,:), var)
3080 CASE("r")
3081 vol = this%volanar(:,indvar,:)
3082 CASE("i")
3083 vol = realdat(this%volanai(:,indvar,:), var)
3084 CASE("b")
3085 vol = realdat(this%volanab(:,indvar,:), var)
3086 CASE("c")
3087 vol = realdat(this%volanac(:,indvar,:), var)
3088 CASE default
3089 vol = rmiss
3090 END SELECT
3091ELSE
3092 vol = rmiss
3093ENDIF
3094
3095END FUNCTION realanavol
3096
3097
3103FUNCTION integeranavol(this, var) RESULT(vol)
3104TYPE(vol7d),INTENT(in) :: this
3105TYPE(vol7d_var),INTENT(in) :: var
3106INTEGER :: vol(SIZE(this%ana),size(this%network))
3107
3108CHARACTER(len=1) :: dtype
3109INTEGER :: indvar
3110
3111dtype = cmiss
3112indvar = index(this%anavar, var, type=dtype)
3113
3114IF (indvar > 0) THEN
3115 SELECT CASE (dtype)
3116 CASE("d")
3117 vol = integerdat(this%volanad(:,indvar,:), var)
3118 CASE("r")
3119 vol = integerdat(this%volanar(:,indvar,:), var)
3120 CASE("i")
3121 vol = this%volanai(:,indvar,:)
3122 CASE("b")
3123 vol = integerdat(this%volanab(:,indvar,:), var)
3124 CASE("c")
3125 vol = integerdat(this%volanac(:,indvar,:), var)
3126 CASE default
3127 vol = imiss
3128 END SELECT
3129ELSE
3130 vol = imiss
3131ENDIF
3132
3133END FUNCTION integeranavol
3134
3135
3141subroutine move_datac (v7d,&
3142 indana,indtime,indlevel,indtimerange,indnetwork,&
3143 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
3144
3145TYPE(vol7d),intent(inout) :: v7d
3146
3147integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
3148integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
3149integer :: inddativar,inddativarattr
3150
3151
3152do inddativar=1,size(v7d%dativar%c)
3153
3154 if (c_e(v7d%voldatic(indana,indtime,indlevel,indtimerange,inddativar,indnetwork)) .and. &
3155 .not. c_e(v7d%voldatic(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
3156 ) then
3157
3158 ! dati
3159 v7d%voldatic &
3160 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
3161 v7d%voldatic &
3162 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
3163
3164
3165 ! attributi
3166 if (associated (v7d%dativarattr%i)) then
3167 inddativarattr = index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
3168 if (inddativarattr > 0 ) then
3169 v7d%voldatiattri &
3170 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3171 v7d%voldatiattri &
3172 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3173 end if
3174 end if
3175
3176 if (associated (v7d%dativarattr%r)) then
3177 inddativarattr = index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
3178 if (inddativarattr > 0 ) then
3179 v7d%voldatiattrr &
3180 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3181 v7d%voldatiattrr &
3182 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3183 end if
3184 end if
3185
3186 if (associated (v7d%dativarattr%d)) then
3187 inddativarattr = index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
3188 if (inddativarattr > 0 ) then
3189 v7d%voldatiattrd &
3190 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3191 v7d%voldatiattrd &
3192 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3193 end if
3194 end if
3195
3196 if (associated (v7d%dativarattr%b)) then
3197 inddativarattr = index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
3198 if (inddativarattr > 0 ) then
3199 v7d%voldatiattrb &
3200 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3201 v7d%voldatiattrb &
3202 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3203 end if
3204 end if
3205
3206 if (associated (v7d%dativarattr%c)) then
3207 inddativarattr = index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
3208 if (inddativarattr > 0 ) then
3209 v7d%voldatiattrc &
3210 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3211 v7d%voldatiattrc &
3212 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3213 end if
3214 end if
3215
3216 end if
3217
3218end do
3219
3220end subroutine move_datac
3221
3227subroutine move_datar (v7d,&
3228 indana,indtime,indlevel,indtimerange,indnetwork,&
3229 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
3230
3231TYPE(vol7d),intent(inout) :: v7d
3232
3233integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
3234integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
3235integer :: inddativar,inddativarattr
3236
3237
3238do inddativar=1,size(v7d%dativar%r)
3239
3240 if (c_e(v7d%voldatir(indana,indtime,indlevel,indtimerange,inddativar,indnetwork)) .and. &
3241 .not. c_e(v7d%voldatir(indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew))&
3242 ) then
3243
3244 ! dati
3245 v7d%voldatir &
3246 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
3247 v7d%voldatir &
Index method.

Generated with Doxygen.