2148 DEALLOCATE(v7d_tmp%voldatid)
2150 v7d_tmp%dativar%r => v7d_tmp%dativar%d
2151 NULLIFY(v7d_tmp%dativar%d)
2155 CALL vol7d_merge(that, v7d_tmp)
2162CALL vol7d_copy(this, v7d_tmp, &
2163 lanavarr=fv, lanavard=fv, lanavari=acn, lanavarb=fv, lanavarc=fv, &
2164 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
2165 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
2166 ldativarr=fv, ldativard=fv, ldativari=tv, ldativarb=fv, ldativarc=fv, &
2167 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
2168 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
2171IF (
ASSOCIATED(v7d_tmp%anavar%i) .OR.
ASSOCIATED(v7d_tmp%dativar%i))
THEN
2173 IF (
ASSOCIATED(v7d_tmp%anavar%i))
THEN
2175 ALLOCATE(v7d_tmp%volanar(
SIZE(v7d_tmp%volanai, 1),
SIZE(v7d_tmp%volanai, 2), &
2176 SIZE(v7d_tmp%volanai, 3)))
2177 DO i = 1,
SIZE(v7d_tmp%anavar%i)
2178 v7d_tmp%volanar(:,i,:) = &
2179 realdat(v7d_tmp%volanai(:,i,:), v7d_tmp%anavar%i(i))
2181 DEALLOCATE(v7d_tmp%volanai)
2183 v7d_tmp%anavar%r => v7d_tmp%anavar%i
2184 NULLIFY(v7d_tmp%anavar%i)
2187 IF (
ASSOCIATED(v7d_tmp%dativar%i))
THEN
2189 ALLOCATE(v7d_tmp%voldatir(
SIZE(v7d_tmp%voldatii, 1),
SIZE(v7d_tmp%voldatii, 2), &
2190 SIZE(v7d_tmp%voldatii, 3),
SIZE(v7d_tmp%voldatii, 4),
SIZE(v7d_tmp%voldatii, 5), &
2191 SIZE(v7d_tmp%voldatii, 6)))
2192 DO i = 1,
SIZE(v7d_tmp%dativar%i)
2193 v7d_tmp%voldatir(:,:,:,:,i,:) = &
2194 realdat(v7d_tmp%voldatii(:,:,:,:,i,:), v7d_tmp%dativar%i(i))
2196 DEALLOCATE(v7d_tmp%voldatii)
2198 v7d_tmp%dativar%r => v7d_tmp%dativar%i
2199 NULLIFY(v7d_tmp%dativar%i)
2203 CALL vol7d_merge(that, v7d_tmp)
2210CALL vol7d_copy(this, v7d_tmp, &
2211 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=acn, lanavarc=fv, &
2212 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
2213 lanavarattrr=fv, lanavarattrd=fv, lanavarattri=fv, lanavarattrb=fv, lanavarattrc=fv, &
2214 ldativarr=fv, ldativard=fv, ldativari=fv, ldativarb=tv, ldativarc=fv, &
2215 ldatiattrr=fv, ldatiattrd=fv, ldatiattri=fv, ldatiattrb=fv, ldatiattrc=fv, &
2216 ldativarattrr=fv, ldativarattrd=fv, ldativarattri=fv, ldativarattrb=fv, ldativarattrc=fv)
2219IF (
ASSOCIATED(v7d_tmp%anavar%b) .OR.
ASSOCIATED(v7d_tmp%dativar%b))
THEN
2221 IF (
ASSOCIATED(v7d_tmp%anavar%b))
THEN
2223 ALLOCATE(v7d_tmp%volanar(
SIZE(v7d_tmp%volanab, 1),
SIZE(v7d_tmp%volanab, 2), &
2224 SIZE(v7d_tmp%volanab, 3)))
2225 DO i = 1,
SIZE(v7d_tmp%anavar%b)
2226 v7d_tmp%volanar(:,i,:) = &
2227 realdat(v7d_tmp%volanab(:,i,:), v7d_tmp%anavar%b(i))
2229 DEALLOCATE(v7d_tmp%volanab)
2231 v7d_tmp%anavar%r => v7d_tmp%anavar%b
2232 NULLIFY(v7d_tmp%anavar%b)
2235 IF (
ASSOCIATED(v7d_tmp%dativar%b))
THEN
2237 ALLOCATE(v7d_tmp%voldatir(
SIZE(v7d_tmp%voldatib, 1),
SIZE(v7d_tmp%voldatib, 2), &
2238 SIZE(v7d_tmp%voldatib, 3),
SIZE(v7d_tmp%voldatib, 4),
SIZE(v7d_tmp%voldatib, 5), &
2239 SIZE(v7d_tmp%voldatib, 6)))
2240 DO i = 1,
SIZE(v7d_tmp%dativar%b)
2241 v7d_tmp%voldatir(:,:,:,:,i,:) = &
2242 realdat(v7d_tmp%voldatib(:,:,:,:,i,:), v7d_tmp%dativar%b(i))
2244 DEALLOCATE(v7d_tmp%voldatib)
2246 v7d_tmp%dativar%r => v7d_tmp%dativar%b
2247 NULLIFY(v7d_tmp%dativar%b)
2251 CALL vol7d_merge(that, v7d_tmp)
2258CALL vol7d_copy(this, v7d_tmp, &
2259 lanavarr=fv, lanavard=fv, lanavari=fv, lanavarb=fv, lanavarc=acn, &
2260 lanaattrr=fv, lanaattrd=fv, lanaattri=fv, lanaattrb=fv, lanaattrc=fv, &
2491if (.not.
present(unit))
then
2502lfilename=trim(arg)//
".v7d"
2503if (
index(arg,
'/',back=.true.) > 0) lfilename=lfilename(
index(arg,
'/',back=.true.)+1 : )
2505if (
present(filename))
then
2506 if (filename /=
"")
then
2511if (
present(filename_auto))filename_auto=lfilename
2514inquire(unit=lunit,opened=opened)
2515if (.not. opened)
then
2522 OPEN(unit=lunit, file=lfilename, form=
'UNFORMATTED', access=
'STREAM')
2523 CALL l4f_log(l4f_info,
'opened: '//trim(lfilename))
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)
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)
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)
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)
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)
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)
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)
2568write(unit=lunit)ldescription
2569write(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
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
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
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
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
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
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
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
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
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
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
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
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
2658if (.not.
present(unit))
close(unit=lunit)
2660end subroutine vol7d_write_on_file
2671subroutine vol7d_read_from_file (this,unit,filename,description,tarray,filename_auto)
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)
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
2689character(len=254) :: ldescription,lfilename,arg
2690integer :: ltarray(8),lunit,ios
2691logical :: opened,exist
2696if (.not.
present(unit))
then
2707lfilename=trim(arg)//
".v7d"
2708if (
index(arg,
'/',back=.true.) > 0) lfilename=lfilename(
index(arg,
'/',back=.true.)+1 : )
2710if (
present(filename))
then
2711 if (filename /=
"")
then
2716if (
present(filename_auto))filename_auto=lfilename
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()
2727 OPEN(unit=lunit, file=lfilename, form=
'UNFORMATTED', access=
'STREAM', &
2728 status=
'OLD', action=
'READ')
2729 CALL l4f_log(l4f_info,
'opened: '//trim(lfilename))
2734read(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)
2744read(unit=lunit)ltarray
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)))//
' '// &
2751if (
present(description))description=ldescription
2752if (
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
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)
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
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
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
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
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
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
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
2822call vol7d_alloc_vol (this)
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
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
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
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
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
2851if (.not.
present(unit))
close(unit=lunit)
2853end subroutine vol7d_read_from_file
2857elemental doubleprecision function doubledatd(voldat,var)
2858doubleprecision,
intent(in) :: voldat
2859type(vol7d_var),
intent(in) :: var
2863end function doubledatd
2866elemental doubleprecision function doubledatr(voldat,var)
2867real,
intent(in) :: voldat
2868type(vol7d_var),
intent(in) :: var
2871 doubledatr=dble(voldat)
2876end function doubledatr
2879elemental doubleprecision function doubledati(voldat,var)
2880integer,
intent(in) :: voldat
2881type(vol7d_var),
intent(in) :: var
2883if (
c_e(voldat))
then
2884 if (
c_e(var%scalefactor))
then
2885 doubledati=dble(voldat)/10.d0**var%scalefactor
2887 doubledati=dble(voldat)
2893end function doubledati
2896elemental doubleprecision function doubledatb(voldat,var)
2897integer(kind=int_b),
intent(in) :: voldat
2898type(vol7d_var),
intent(in) :: var
2900if (
c_e(voldat))
then
2901 if (
c_e(var%scalefactor))
then
2902 doubledatb=dble(voldat)/10.d0**var%scalefactor
2904 doubledatb=dble(voldat)
2910end function doubledatb
2913elemental doubleprecision function doubledatc(voldat,var)
2914CHARACTER(len=vol7d_cdatalen),
intent(in) :: voldat
2915type(vol7d_var),
intent(in) :: var
2917doubledatc = c2d(voldat)
2918if (
c_e(doubledatc) .and.
c_e(var%scalefactor))
then
2919 doubledatc=doubledatc/10.d0**var%scalefactor
2922end function doubledatc
2926elemental integer function integerdatd(voldat,var)
2927doubleprecision,
intent(in) :: voldat
2928type(vol7d_var),
intent(in) :: var
2931 if (
c_e(var%scalefactor))
then
2932 integerdatd=nint(voldat*10d0**var%scalefactor)
2934 integerdatd=nint(voldat)
2940end function integerdatd
2943elemental integer function integerdatr(voldat,var)
2944real,
intent(in) :: voldat
2945type(vol7d_var),
intent(in) :: var
2948 if (
c_e(var%scalefactor))
then
2949 integerdatr=nint(voldat*10d0**var%scalefactor)
2951 integerdatr=nint(voldat)
2957end function integerdatr
2960elemental integer function integerdati(voldat,var)
2961integer,
intent(in) :: voldat
2962type(vol7d_var),
intent(in) :: var
2966end function integerdati
2969elemental integer function integerdatb(voldat,var)
2970integer(kind=int_b),
intent(in) :: voldat
2971type(vol7d_var),
intent(in) :: var
2979end function integerdatb
2982elemental integer function integerdatc(voldat,var)
2983CHARACTER(len=vol7d_cdatalen),
intent(in) :: voldat
2984type(vol7d_var),
intent(in) :: var
2986integerdatc=c2i(voldat)
2988end function integerdatc
2992elemental real function realdatd(voldat,var)
2993doubleprecision,
intent(in) :: voldat
2994type(vol7d_var),
intent(in) :: var
2997 realdatd=real(voldat)
3002end function realdatd
3005elemental real function realdatr(voldat,var)
3006real,
intent(in) :: voldat
3007type(vol7d_var),
intent(in) :: var
3011end function realdatr
3014elemental real function realdati(voldat,var)
3015integer,
intent(in) :: voldat
3016type(vol7d_var),
intent(in) :: var
3018if (
c_e(voldat))
then
3019 if (
c_e(var%scalefactor))
then
3020 realdati=float(voldat)/10.**var%scalefactor
3022 realdati=float(voldat)
3028end function realdati
3031elemental real function realdatb(voldat,var)
3032integer(kind=int_b),
intent(in) :: voldat
3033type(vol7d_var),
intent(in) :: var
3035if (
c_e(voldat))
then
3036 if (
c_e(var%scalefactor))
then
3037 realdatb=float(voldat)/10**var%scalefactor
3039 realdatb=float(voldat)
3045end function realdatb
3048elemental real function realdatc(voldat,var)
3049CHARACTER(len=vol7d_cdatalen),
intent(in) :: voldat
3050type(vol7d_var),
intent(in) :: var
3053if (
c_e(realdatc) .and.
c_e(var%scalefactor))
then
3054 realdatc=realdatc/10.**var%scalefactor
3057end function realdatc
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))
3070CHARACTER(len=1) :: dtype
3074indvar =
index(this%anavar, var, type=dtype)
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)
3095END FUNCTION realanavol
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))
3108CHARACTER(len=1) :: dtype
3112indvar =
index(this%anavar, var, type=dtype)
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)
3133END FUNCTION integeranavol
3141subroutine move_datac (v7d,&
3142 indana,indtime,indlevel,indtimerange,indnetwork,&
3143 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
3145TYPE(
vol7d),
intent(inout) :: v7d
3147integer,
intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
3148integer,
intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
3149integer :: inddativar,inddativarattr
3152do 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,:)
3220end subroutine move_datac
3227subroutine move_datar (v7d,&
3228 indana,indtime,indlevel,indtimerange,indnetwork,&
3229 indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew)
3231TYPE(
vol7d),
intent(inout) :: v7d
3233integer,
intent(in) :: indana,indtime,indlevel,indtimerange,indnetwork
3234integer,
intent(in) :: indananew,indtimenew,indlevelnew,indtimerangenew,indnetworknew
3235integer :: inddativar,inddativarattr
3238do 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) = &