Il primo volume viene confrontato col secondo; nel secondo volume ovunque i dati confrontati siano coincidenti viene impostato valore mancante.
2502 lfilename=trim(arg)//
".v7d" 2503 if (
index(arg,
'/',back=.true.) > 0) lfilename=lfilename(
index(arg,
'/',back=.true.)+1 : )
2505 if (
present(filename))
then 2506 if (filename /=
"")
then 2511 if (
present(filename_auto))filename_auto=lfilename
2514 inquire(unit=lunit,opened=opened)
2515 if (.not. opened)
then 2522 OPEN(unit=lunit, file=lfilename, form=
'UNFORMATTED', access=
'STREAM')
2523 CALL l4f_log(l4f_info,
'opened: '//trim(lfilename))
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)
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)
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)
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)
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)
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)
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)
2568 write(unit=lunit)ldescription
2569 write(unit=lunit)tarray
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
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
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
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
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
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
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
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
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
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
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
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
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
2658 if (.not.
present(unit))
close(unit=lunit)
2660 end subroutine vol7d_write_on_file
2671 subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
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)
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
2689 character(len=254) :: ldescription,lfilename,arg
2690 integer :: ltarray(8),lunit,ios
2691 logical :: opened,exist
2696 if (.not.
present(unit))
then 2707 lfilename=trim(arg)//
".v7d" 2708 if (
index(arg,
'/',back=.true.) > 0) lfilename=lfilename(
index(arg,
'/',back=.true.)+1 : )
2710 if (
present(filename))
then 2711 if (filename /=
"")
then 2716 if (
present(filename_auto))filename_auto=lfilename
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()
2727 OPEN(unit=lunit, file=lfilename, form=
'UNFORMATTED', access=
'STREAM', &
2728 status=
'OLD', action=
'READ')
2729 CALL l4f_log(l4f_info,
'opened: '//trim(lfilename))
2734 read(unit=lunit,iostat=ios)ldescription
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)
2744 read(unit=lunit)ltarray
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))))
2751 if (
present(description))description=ldescription
2752 if (
present(tarray))tarray=ltarray
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
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)
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
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
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
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
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
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
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
2822 call vol7d_alloc_vol (this)
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
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
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
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
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
2851 if (.not.
present(unit))
close(unit=lunit)
2853 end subroutine vol7d_read_from_file
2857 elemental doubleprecision function doubledatd(voldat,var)
2858 doubleprecision,
intent(in) :: voldat
2859 type(vol7d_var),
intent(in) :: var
2863 end function doubledatd
2866 elemental doubleprecision function doubledatr(voldat,var)
2867 real,
intent(in) :: voldat
2868 type(vol7d_var),
intent(in) :: var
2870 if (c_e(voldat))
then 2871 doubledatr=dble(voldat)
2876 end function doubledatr
2879 elemental doubleprecision function doubledati(voldat,var)
2880 integer,
intent(in) :: voldat
2881 type(vol7d_var),
intent(in) :: var
2883 if (c_e(voldat))
then 2884 if (c_e(var%scalefactor))
then 2885 doubledati=dble(voldat)/10.d0**var%scalefactor
2887 doubledati=dble(voldat)
2893 end function doubledati
2896 elemental doubleprecision function doubledatb(voldat,var)
2897 integer(kind=int_b),
intent(in) :: voldat
2898 type(vol7d_var),
intent(in) :: var
2900 if (c_e(voldat))
then 2901 if (c_e(var%scalefactor))
then 2902 doubledatb=dble(voldat)/10.d0**var%scalefactor
2904 doubledatb=dble(voldat)
2910 end function doubledatb
2913 elemental doubleprecision function doubledatc(voldat,var)
2914 CHARACTER(len=vol7d_cdatalen),
intent(in) :: voldat
2915 type(vol7d_var),
intent(in) :: var
2917 doubledatc = c2d(voldat)
2918 if (c_e(doubledatc) .and. c_e(var%scalefactor))
then 2919 doubledatc=doubledatc/10.d0**var%scalefactor
2922 end function doubledatc
2926 elemental integer function integerdatd(voldat,var)
2927 doubleprecision,
intent(in) :: voldat
2928 type(vol7d_var),
intent(in) :: var
2930 if (c_e(voldat))
then 2931 if (c_e(var%scalefactor))
then 2932 integerdatd=nint(voldat*10d0**var%scalefactor)
2934 integerdatd=nint(voldat)
2940 end function integerdatd
2943 elemental integer function integerdatr(voldat,var)
2944 real,
intent(in) :: voldat
2945 type(vol7d_var),
intent(in) :: var
2947 if (c_e(voldat))
then 2948 if (c_e(var%scalefactor))
then 2949 integerdatr=nint(voldat*10d0**var%scalefactor)
2951 integerdatr=nint(voldat)
2957 end function integerdatr
2960 elemental integer function integerdati(voldat,var)
2961 integer,
intent(in) :: voldat
2962 type(vol7d_var),
intent(in) :: var
2966 end function integerdati
2969 elemental integer function integerdatb(voldat,var)
2970 integer(kind=int_b),
intent(in) :: voldat
2971 type(vol7d_var),
intent(in) :: var
2973 if (c_e(voldat))
then 2979 end function integerdatb
2982 elemental integer function integerdatc(voldat,var)
2983 CHARACTER(len=vol7d_cdatalen),
intent(in) :: voldat
2984 type(vol7d_var),
intent(in) :: var
2986 integerdatc=c2i(voldat)
2988 end function integerdatc
2992 elemental real function realdatd(voldat,var)
2993 doubleprecision,
intent(in) :: voldat
2994 type(vol7d_var),
intent(in) :: var
2996 if (c_e(voldat))
then 2997 realdatd=
real(voldat)
3002 end function realdatd
3005 elemental real function realdatr(voldat,var)
3006 real,
intent(in) :: voldat
3007 type(vol7d_var),
intent(in) :: var
3011 end function realdatr
3014 elemental real function realdati(voldat,var)
3015 integer,
intent(in) :: voldat
3016 type(vol7d_var),
intent(in) :: var
3018 if (c_e(voldat))
then 3019 if (c_e(var%scalefactor))
then 3020 realdati=float(voldat)/10.**var%scalefactor
3022 realdati=float(voldat)
3028 end function realdati
3031 elemental real function realdatb(voldat,var)
3032 integer(kind=int_b),
intent(in) :: voldat
3033 type(vol7d_var),
intent(in) :: var
3035 if (c_e(voldat))
then 3036 if (c_e(var%scalefactor))
then 3037 realdatb=float(voldat)/10**var%scalefactor
3039 realdatb=float(voldat)
3045 end function realdatb
3048 elemental real function realdatc(voldat,var)
3049 CHARACTER(len=vol7d_cdatalen),
intent(in) :: voldat
3050 type(vol7d_var),
intent(in) :: var
3052 realdatc=c2r(voldat)
3053 if (c_e(realdatc) .and. c_e(var%scalefactor))
then 3054 realdatc=realdatc/10.**var%scalefactor
3057 end function realdatc
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))
3070 CHARACTER(len=1) :: dtype
3074 indvar =
index(this%anavar, var, type=dtype)
3076 IF (indvar > 0)
THEN 3079 vol = realdat(this%volanad(:,indvar,:), var)
3081 vol = this%volanar(:,indvar,:)
3083 vol = realdat(this%volanai(:,indvar,:), var)
3085 vol = realdat(this%volanab(:,indvar,:), var)
3087 vol = realdat(this%volanac(:,indvar,:), var)
3095 END FUNCTION realanavol
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))
3108 CHARACTER(len=1) :: dtype
3112 indvar =
index(this%anavar, var, type=dtype)
3114 IF (indvar > 0)
THEN 3117 vol = integerdat(this%volanad(:,indvar,:), var)
3119 vol = integerdat(this%volanar(:,indvar,:), var)
3121 vol = this%volanai(:,indvar,:)
3123 vol = integerdat(this%volanab(:,indvar,:), var)
3125 vol = integerdat(this%volanac(:,indvar,:), var)
3133 END FUNCTION integeranavol
3141 subroutine move_datac (v7d,&
3142 indana,indtime,indlevel,indtimerange,indnetwork,&
3143 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
3145 TYPE(vol7d),
intent(inout) :: v7d
3147 integer,
intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
3148 integer,
intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
3149 integer :: inddativar,inddativarattr
3152 do inddativar=1,
size(v7d%dativar%c)
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))&
3160 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
3162 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
3166 if (
associated (v7d%dativarattr%i))
then 3167 inddativarattr =
index(v7d%dativarattr%i,v7d%dativar%c(inddativar))
3168 if (inddativarattr > 0 )
then 3170 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3172 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3176 if (
associated (v7d%dativarattr%r))
then 3177 inddativarattr =
index(v7d%dativarattr%r,v7d%dativar%c(inddativar))
3178 if (inddativarattr > 0 )
then 3180 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3182 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3186 if (
associated (v7d%dativarattr%d))
then 3187 inddativarattr =
index(v7d%dativarattr%d,v7d%dativar%c(inddativar))
3188 if (inddativarattr > 0 )
then 3190 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3192 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3196 if (
associated (v7d%dativarattr%b))
then 3197 inddativarattr =
index(v7d%dativarattr%b,v7d%dativar%c(inddativar))
3198 if (inddativarattr > 0 )
then 3200 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3202 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3206 if (
associated (v7d%dativarattr%c))
then 3207 inddativarattr =
index(v7d%dativarattr%c,v7d%dativar%c(inddativar))
3208 if (inddativarattr > 0 )
then 3210 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &
3212 (indana,indtime,indlevel,indtimerange,inddativarattr,indnetwork,:)
3220 end subroutine move_datac
3227 subroutine move_datar (v7d,&
3228 indana,indtime,indlevel,indtimerange,indnetwork,&
3229 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
3231 TYPE(vol7d),
intent(inout) :: v7d
3233 integer,
intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
3234 integer,
intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
3235 integer :: inddativar,inddativarattr
3238 do inddativar=1,
size(v7d%dativar%r)
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))&
3246 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativar,indnetworknew) = &
3248 (indana,indtime,indlevel,indtimerange,inddativar,indnetwork)
3252 if (
associated (v7d%dativarattr%i))
then 3253 inddativarattr =
index(v7d%dativarattr%i,v7d%dativar%r(inddativar))
3254 if (inddativarattr > 0 )
then 3256 (indananew,indtimenew,indlevelnew,indtimerangenew,inddativarattr,indnetworknew,:) = &