libsim  Versione 7.1.9

◆ vol7d_diff_only()

subroutine vol7d_class::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 2495 del file vol7d_class.F90.

2496  unit=lunit
2497  else
2498  lunit=unit
2499  end if
2500 end if
2501 
2502 lfilename=trim(arg)//".v7d"
2503 if (index(arg,'/',back=.true.) > 0) lfilename=lfilename(index(arg,'/',back=.true.)+1 : )
2504 
2505 if (present(filename))then
2506  if (filename /= "")then
2507  lfilename=filename
2508  end if
2509 end if
2510 
2511 if (present(filename_auto))filename_auto=lfilename
2512 
2513 
2514 inquire(unit=lunit,opened=opened)
2515 if (.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))
2524 end if
2525 
2526 if (associated(this%ana)) nana=size(this%ana)
2527 if (associated(this%time)) ntime=size(this%time)
2528 if (associated(this%timerange)) ntimerange=size(this%timerange)
2529 if (associated(this%level)) nlevel=size(this%level)
2530 if (associated(this%network)) nnetwork=size(this%network)
2531 
2532 if (associated(this%dativar%r)) ndativarr=size(this%dativar%r)
2533 if (associated(this%dativar%i)) ndativari=size(this%dativar%i)
2534 if (associated(this%dativar%b)) ndativarb=size(this%dativar%b)
2535 if (associated(this%dativar%d)) ndativard=size(this%dativar%d)
2536 if (associated(this%dativar%c)) ndativarc=size(this%dativar%c)
2537 
2538 if (associated(this%datiattr%r)) ndatiattrr=size(this%datiattr%r)
2539 if (associated(this%datiattr%i)) ndatiattri=size(this%datiattr%i)
2540 if (associated(this%datiattr%b)) ndatiattrb=size(this%datiattr%b)
2541 if (associated(this%datiattr%d)) ndatiattrd=size(this%datiattr%d)
2542 if (associated(this%datiattr%c)) ndatiattrc=size(this%datiattr%c)
2543 
2544 if (associated(this%dativarattr%r)) ndativarattrr=size(this%dativarattr%r)
2545 if (associated(this%dativarattr%i)) ndativarattri=size(this%dativarattr%i)
2546 if (associated(this%dativarattr%b)) ndativarattrb=size(this%dativarattr%b)
2547 if (associated(this%dativarattr%d)) ndativarattrd=size(this%dativarattr%d)
2548 if (associated(this%dativarattr%c)) ndativarattrc=size(this%dativarattr%c)
2549 
2550 if (associated(this%anavar%r)) nanavarr=size(this%anavar%r)
2551 if (associated(this%anavar%i)) nanavari=size(this%anavar%i)
2552 if (associated(this%anavar%b)) nanavarb=size(this%anavar%b)
2553 if (associated(this%anavar%d)) nanavard=size(this%anavar%d)
2554 if (associated(this%anavar%c)) nanavarc=size(this%anavar%c)
2555 
2556 if (associated(this%anaattr%r)) nanaattrr=size(this%anaattr%r)
2557 if (associated(this%anaattr%i)) nanaattri=size(this%anaattr%i)
2558 if (associated(this%anaattr%b)) nanaattrb=size(this%anaattr%b)
2559 if (associated(this%anaattr%d)) nanaattrd=size(this%anaattr%d)
2560 if (associated(this%anaattr%c)) nanaattrc=size(this%anaattr%c)
2561 
2562 if (associated(this%anavarattr%r)) nanavarattrr=size(this%anavarattr%r)
2563 if (associated(this%anavarattr%i)) nanavarattri=size(this%anavarattr%i)
2564 if (associated(this%anavarattr%b)) nanavarattrb=size(this%anavarattr%b)
2565 if (associated(this%anavarattr%d)) nanavarattrd=size(this%anavarattr%d)
2566 if (associated(this%anavarattr%c)) nanavarattrc=size(this%anavarattr%c)
2567 
2568 write(unit=lunit)ldescription
2569 write(unit=lunit)tarray
2570 
2571 write(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
2586 if (associated(this%ana)) call write_unit(this%ana, lunit)
2587 if (associated(this%time)) call write_unit(this%time, lunit)
2588 if (associated(this%level)) write(unit=lunit)this%level
2589 if (associated(this%timerange)) write(unit=lunit)this%timerange
2590 if (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 
2595 if (associated(this%anavar%r)) write(unit=lunit)this%anavar%r
2596 if (associated(this%anavar%i)) write(unit=lunit)this%anavar%i
2597 if (associated(this%anavar%b)) write(unit=lunit)this%anavar%b
2598 if (associated(this%anavar%d)) write(unit=lunit)this%anavar%d
2599 if (associated(this%anavar%c)) write(unit=lunit)this%anavar%c
2600 
2601 if (associated(this%anaattr%r)) write(unit=lunit)this%anaattr%r
2602 if (associated(this%anaattr%i)) write(unit=lunit)this%anaattr%i
2603 if (associated(this%anaattr%b)) write(unit=lunit)this%anaattr%b
2604 if (associated(this%anaattr%d)) write(unit=lunit)this%anaattr%d
2605 if (associated(this%anaattr%c)) write(unit=lunit)this%anaattr%c
2606 
2607 if (associated(this%anavarattr%r)) write(unit=lunit)this%anavarattr%r
2608 if (associated(this%anavarattr%i)) write(unit=lunit)this%anavarattr%i
2609 if (associated(this%anavarattr%b)) write(unit=lunit)this%anavarattr%b
2610 if (associated(this%anavarattr%d)) write(unit=lunit)this%anavarattr%d
2611 if (associated(this%anavarattr%c)) write(unit=lunit)this%anavarattr%c
2612 
2613 if (associated(this%dativar%r)) write(unit=lunit)this%dativar%r
2614 if (associated(this%dativar%i)) write(unit=lunit)this%dativar%i
2615 if (associated(this%dativar%b)) write(unit=lunit)this%dativar%b
2616 if (associated(this%dativar%d)) write(unit=lunit)this%dativar%d
2617 if (associated(this%dativar%c)) write(unit=lunit)this%dativar%c
2618 
2619 if (associated(this%datiattr%r)) write(unit=lunit)this%datiattr%r
2620 if (associated(this%datiattr%i)) write(unit=lunit)this%datiattr%i
2621 if (associated(this%datiattr%b)) write(unit=lunit)this%datiattr%b
2622 if (associated(this%datiattr%d)) write(unit=lunit)this%datiattr%d
2623 if (associated(this%datiattr%c)) write(unit=lunit)this%datiattr%c
2624 
2625 if (associated(this%dativarattr%r)) write(unit=lunit)this%dativarattr%r
2626 if (associated(this%dativarattr%i)) write(unit=lunit)this%dativarattr%i
2627 if (associated(this%dativarattr%b)) write(unit=lunit)this%dativarattr%b
2628 if (associated(this%dativarattr%d)) write(unit=lunit)this%dativarattr%d
2629 if (associated(this%dativarattr%c)) write(unit=lunit)this%dativarattr%c
2630 
2631 !! Volumi di valori e attributi per anagrafica e dati
2632 
2633 if (associated(this%volanar)) write(unit=lunit)this%volanar
2634 if (associated(this%volanaattrr)) write(unit=lunit)this%volanaattrr
2635 if (associated(this%voldatir)) write(unit=lunit)this%voldatir
2636 if (associated(this%voldatiattrr)) write(unit=lunit)this%voldatiattrr
2637 
2638 if (associated(this%volanai)) write(unit=lunit)this%volanai
2639 if (associated(this%volanaattri)) write(unit=lunit)this%volanaattri
2640 if (associated(this%voldatii)) write(unit=lunit)this%voldatii
2641 if (associated(this%voldatiattri)) write(unit=lunit)this%voldatiattri
2642 
2643 if (associated(this%volanab)) write(unit=lunit)this%volanab
2644 if (associated(this%volanaattrb)) write(unit=lunit)this%volanaattrb
2645 if (associated(this%voldatib)) write(unit=lunit)this%voldatib
2646 if (associated(this%voldatiattrb)) write(unit=lunit)this%voldatiattrb
2647 
2648 if (associated(this%volanad)) write(unit=lunit)this%volanad
2649 if (associated(this%volanaattrd)) write(unit=lunit)this%volanaattrd
2650 if (associated(this%voldatid)) write(unit=lunit)this%voldatid
2651 if (associated(this%voldatiattrd)) write(unit=lunit)this%voldatiattrd
2652 
2653 if (associated(this%volanac)) write(unit=lunit)this%volanac
2654 if (associated(this%volanaattrc)) write(unit=lunit)this%volanaattrc
2655 if (associated(this%voldatic)) write(unit=lunit)this%voldatic
2656 if (associated(this%voldatiattrc)) write(unit=lunit)this%voldatiattrc
2657 
2658 if (.not. present(unit)) close(unit=lunit)
2659 
2660 end subroutine vol7d_write_on_file
2661 
2662 
2669 
2670 
2671 subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
2672 
2673 TYPE(vol7d),INTENT(OUT) :: this
2674 integer,intent(inout),optional :: unit
2675 character(len=*),INTENT(in),optional :: filename
2676 character(len=*),intent(out),optional :: filename_auto
2677 character(len=*),INTENT(out),optional :: description
2678 integer,intent(out),optional :: tarray(8)
2679 
2680 
2681 integer :: 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 
2689 character(len=254) :: ldescription,lfilename,arg
2690 integer :: ltarray(8),lunit,ios
2691 logical :: opened,exist
2692 
2693 
2694 call getarg(0,arg)
2695 
2696 if (.not. present(unit))then
2697  lunit=getunit()
2698 else
2699  if (unit==0)then
2700  lunit=getunit()
2701  unit=lunit
2702  else
2703  lunit=unit
2704  end if
2705 end if
2706 
2707 lfilename=trim(arg)//".v7d"
2708 if (index(arg,'/',back=.true.) > 0) lfilename=lfilename(index(arg,'/',back=.true.)+1 : )
2709 
2710 if (present(filename))then
2711  if (filename /= "")then
2712  lfilename=filename
2713  end if
2714 end if
2715 
2716 if (present(filename_auto))filename_auto=lfilename
2717 
2718 
2719 inquire(unit=lunit,opened=opened)
2720 IF (.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))
2730 end if
2731 
2732 
2733 call init(this)
2734 read(unit=lunit,iostat=ios)ldescription
2735 
2736 if (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)
2742 end if
2743 
2744 read(unit=lunit)ltarray
2745 
2746 CALL l4f_log(l4f_info, 'Reading vol7d from file')
2747 CALL l4f_log(l4f_info, 'description: '//trim(ldescription))
2748 CALL l4f_log(l4f_info, 'written on '//trim(to_char(ltarray(1)))//' '// &
2749  trim(to_char(ltarray(2)))//' '//trim(to_char(ltarray(3))))
2750 
2751 if (present(description))description=ldescription
2752 if (present(tarray))tarray=ltarray
2753 
2754 read(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 
2764 call 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 
2780 if (associated(this%ana)) call read_unit(this%ana, lunit)
2781 if (associated(this%time)) call read_unit(this%time, lunit)
2782 if (associated(this%level)) read(unit=lunit)this%level
2783 if (associated(this%timerange)) read(unit=lunit)this%timerange
2784 if (associated(this%network)) read(unit=lunit)this%network
2785 
2786 if (associated(this%anavar%r)) read(unit=lunit)this%anavar%r
2787 if (associated(this%anavar%i)) read(unit=lunit)this%anavar%i
2788 if (associated(this%anavar%b)) read(unit=lunit)this%anavar%b
2789 if (associated(this%anavar%d)) read(unit=lunit)this%anavar%d
2790 if (associated(this%anavar%c)) read(unit=lunit)this%anavar%c
2791 
2792 if (associated(this%anaattr%r)) read(unit=lunit)this%anaattr%r
2793 if (associated(this%anaattr%i)) read(unit=lunit)this%anaattr%i
2794 if (associated(this%anaattr%b)) read(unit=lunit)this%anaattr%b
2795 if (associated(this%anaattr%d)) read(unit=lunit)this%anaattr%d
2796 if (associated(this%anaattr%c)) read(unit=lunit)this%anaattr%c
2797 
2798 if (associated(this%anavarattr%r)) read(unit=lunit)this%anavarattr%r
2799 if (associated(this%anavarattr%i)) read(unit=lunit)this%anavarattr%i
2800 if (associated(this%anavarattr%b)) read(unit=lunit)this%anavarattr%b
2801 if (associated(this%anavarattr%d)) read(unit=lunit)this%anavarattr%d
2802 if (associated(this%anavarattr%c)) read(unit=lunit)this%anavarattr%c
2803 
2804 if (associated(this%dativar%r)) read(unit=lunit)this%dativar%r
2805 if (associated(this%dativar%i)) read(unit=lunit)this%dativar%i
2806 if (associated(this%dativar%b)) read(unit=lunit)this%dativar%b
2807 if (associated(this%dativar%d)) read(unit=lunit)this%dativar%d
2808 if (associated(this%dativar%c)) read(unit=lunit)this%dativar%c
2809 
2810 if (associated(this%datiattr%r)) read(unit=lunit)this%datiattr%r
2811 if (associated(this%datiattr%i)) read(unit=lunit)this%datiattr%i
2812 if (associated(this%datiattr%b)) read(unit=lunit)this%datiattr%b
2813 if (associated(this%datiattr%d)) read(unit=lunit)this%datiattr%d
2814 if (associated(this%datiattr%c)) read(unit=lunit)this%datiattr%c
2815 
2816 if (associated(this%dativarattr%r)) read(unit=lunit)this%dativarattr%r
2817 if (associated(this%dativarattr%i)) read(unit=lunit)this%dativarattr%i
2818 if (associated(this%dativarattr%b)) read(unit=lunit)this%dativarattr%b
2819 if (associated(this%dativarattr%d)) read(unit=lunit)this%dativarattr%d
2820 if (associated(this%dativarattr%c)) read(unit=lunit)this%dativarattr%c
2821 
2822 call vol7d_alloc_vol (this)
2823 
2824 !! Volumi di valori e attributi per anagrafica e dati
2825 
2826 if (associated(this%volanar)) read(unit=lunit)this%volanar
2827 if (associated(this%volanaattrr)) read(unit=lunit)this%volanaattrr
2828 if (associated(this%voldatir)) read(unit=lunit)this%voldatir
2829 if (associated(this%voldatiattrr)) read(unit=lunit)this%voldatiattrr
2830 
2831 if (associated(this%volanai)) read(unit=lunit)this%volanai
2832 if (associated(this%volanaattri)) read(unit=lunit)this%volanaattri
2833 if (associated(this%voldatii)) read(unit=lunit)this%voldatii
2834 if (associated(this%voldatiattri)) read(unit=lunit)this%voldatiattri
2835 
2836 if (associated(this%volanab)) read(unit=lunit)this%volanab
2837 if (associated(this%volanaattrb)) read(unit=lunit)this%volanaattrb
2838 if (associated(this%voldatib)) read(unit=lunit)this%voldatib
2839 if (associated(this%voldatiattrb)) read(unit=lunit)this%voldatiattrb
2840 
2841 if (associated(this%volanad)) read(unit=lunit)this%volanad
2842 if (associated(this%volanaattrd)) read(unit=lunit)this%volanaattrd
2843 if (associated(this%voldatid)) read(unit=lunit)this%voldatid
2844 if (associated(this%voldatiattrd)) read(unit=lunit)this%voldatiattrd
2845 
2846 if (associated(this%volanac)) read(unit=lunit)this%volanac
2847 if (associated(this%volanaattrc)) read(unit=lunit)this%volanaattrc
2848 if (associated(this%voldatic)) read(unit=lunit)this%voldatic
2849 if (associated(this%voldatiattrc)) read(unit=lunit)this%voldatiattrc
2850 
2851 if (.not. present(unit)) close(unit=lunit)
2852 
2853 end subroutine vol7d_read_from_file
2854 
2855 
2856 ! to double precision
2857 elemental doubleprecision function doubledatd(voldat,var)
2858 doubleprecision,intent(in) :: voldat
2859 type(vol7d_var),intent(in) :: var
2860 
2861 doubledatd=voldat
2862 
2863 end function doubledatd
2864 
2865 
2866 elemental doubleprecision function doubledatr(voldat,var)
2867 real,intent(in) :: voldat
2868 type(vol7d_var),intent(in) :: var
2869 
2870 if (c_e(voldat))then
2871  doubledatr=dble(voldat)
2872 else
2873  doubledatr=dmiss
2874 end if
2875 
2876 end function doubledatr
2877 
2878 
2879 elemental doubleprecision function doubledati(voldat,var)
2880 integer,intent(in) :: voldat
2881 type(vol7d_var),intent(in) :: var
2882 
2883 if (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
2889 else
2890  doubledati=dmiss
2891 end if
2892 
2893 end function doubledati
2894 
2895 
2896 elemental doubleprecision function doubledatb(voldat,var)
2897 integer(kind=int_b),intent(in) :: voldat
2898 type(vol7d_var),intent(in) :: var
2899 
2900 if (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
2906 else
2907  doubledatb=dmiss
2908 end if
2909 
2910 end function doubledatb
2911 
2912 
2913 elemental doubleprecision function doubledatc(voldat,var)
2914 CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
2915 type(vol7d_var),intent(in) :: var
2916 
2917 doubledatc = c2d(voldat)
2918 if (c_e(doubledatc) .and. c_e(var%scalefactor))then
2919  doubledatc=doubledatc/10.d0**var%scalefactor
2920 end if
2921 
2922 end function doubledatc
2923 
2924 
2925 ! to integer
2926 elemental integer function integerdatd(voldat,var)
2927 doubleprecision,intent(in) :: voldat
2928 type(vol7d_var),intent(in) :: var
2929 
2930 if (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
2936 else
2937  integerdatd=imiss
2938 end if
2939 
2940 end function integerdatd
2941 
2942 
2943 elemental integer function integerdatr(voldat,var)
2944 real,intent(in) :: voldat
2945 type(vol7d_var),intent(in) :: var
2946 
2947 if (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
2953 else
2954  integerdatr=imiss
2955 end if
2956 
2957 end function integerdatr
2958 
2959 
2960 elemental integer function integerdati(voldat,var)
2961 integer,intent(in) :: voldat
2962 type(vol7d_var),intent(in) :: var
2963 
2964 integerdati=voldat
2965 
2966 end function integerdati
2967 
2968 
2969 elemental integer function integerdatb(voldat,var)
2970 integer(kind=int_b),intent(in) :: voldat
2971 type(vol7d_var),intent(in) :: var
2972 
2973 if (c_e(voldat))then
2974  integerdatb=voldat
2975 else
2976  integerdatb=imiss
2977 end if
2978 
2979 end function integerdatb
2980 
2981 
2982 elemental integer function integerdatc(voldat,var)
2983 CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
2984 type(vol7d_var),intent(in) :: var
2985 
2986 integerdatc=c2i(voldat)
2987 
2988 end function integerdatc
2989 
2990 
2991 ! to real
2992 elemental real function realdatd(voldat,var)
2993 doubleprecision,intent(in) :: voldat
2994 type(vol7d_var),intent(in) :: var
2995 
2996 if (c_e(voldat))then
2997  realdatd=real(voldat)
2998 else
2999  realdatd=rmiss
3000 end if
3001 
3002 end function realdatd
3003 
3004 
3005 elemental real function realdatr(voldat,var)
3006 real,intent(in) :: voldat
3007 type(vol7d_var),intent(in) :: var
3008 
3009 realdatr=voldat
3010 
3011 end function realdatr
3012 
3013 
3014 elemental real function realdati(voldat,var)
3015 integer,intent(in) :: voldat
3016 type(vol7d_var),intent(in) :: var
3017 
3018 if (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
3024 else
3025  realdati=rmiss
3026 end if
3027 
3028 end function realdati
3029 
3030 
3031 elemental real function realdatb(voldat,var)
3032 integer(kind=int_b),intent(in) :: voldat
3033 type(vol7d_var),intent(in) :: var
3034 
3035 if (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
3041 else
3042  realdatb=rmiss
3043 end if
3044 
3045 end function realdatb
3046 
3047 
3048 elemental real function realdatc(voldat,var)
3049 CHARACTER(len=vol7d_cdatalen),intent(in) :: voldat
3050 type(vol7d_var),intent(in) :: var
3051 
3052 realdatc=c2r(voldat)
3053 if (c_e(realdatc) .and. c_e(var%scalefactor))then
3054  realdatc=realdatc/10.**var%scalefactor
3055 end if
3056 
3057 end function realdatc
3058 
3059 
3065 FUNCTION realanavol(this, var) RESULT(vol)
3066 TYPE(vol7d),INTENT(in) :: this
3067 TYPE(vol7d_var),INTENT(in) :: var
3068 REAL :: vol(SIZE(this%ana),size(this%network))
3069 
3070 CHARACTER(len=1) :: dtype
3071 INTEGER :: indvar
3072 
3073 dtype = cmiss
3074 indvar = index(this%anavar, var, type=dtype)
3075 
3076 IF (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
3091 ELSE
3092  vol = rmiss
3093 ENDIF
3094 
3095 END FUNCTION realanavol
3096 
3097 
3103 FUNCTION integeranavol(this, var) RESULT(vol)
3104 TYPE(vol7d),INTENT(in) :: this
3105 TYPE(vol7d_var),INTENT(in) :: var
3106 INTEGER :: vol(SIZE(this%ana),size(this%network))
3107 
3108 CHARACTER(len=1) :: dtype
3109 INTEGER :: indvar
3110 
3111 dtype = cmiss
3112 indvar = index(this%anavar, var, type=dtype)
3113 
3114 IF (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
3129 ELSE
3130  vol = imiss
3131 ENDIF
3132 
3133 END FUNCTION integeranavol
3134 
3135 
3141 subroutine move_datac (v7d,&
3142  indana,indtime,indlevel,indtimerange,indnetwork,&
3143  indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
3144 
3145 TYPE(vol7d),intent(inout) :: v7d
3146 
3147 integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
3148 integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
3149 integer :: inddativar,inddativarattr
3150 
3151 
3152 do 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 
3218 end do
3219 
3220 end subroutine move_datac
3221 
3227 subroutine move_datar (v7d,&
3228  indana,indtime,indlevel,indtimerange,indnetwork,&
3229  indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
3230 
3231 TYPE(vol7d),intent(inout) :: v7d
3232 
3233 integer,intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
3234 integer,intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
3235 integer :: inddativar,inddativarattr
3236 
3237 
3238 do 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 &
3248  (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
3249 
3250 
3251  ! attributi
3252  if (associated (v7d%dativarattr%i)) then
3253  inddativarattr = index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
Index method.

Generated with Doxygen.