Demo: multi-file histograms

demo/app/plot-raw-histograms.gnu → demo/app/histogram-plot.gnu

@@ -4,11 +4,11 @@ set term png size 2600, 1200
 set output "input-tensor-histograms.png"
 set multiplot layout 3,3
 do for [name in "potential_temperature pressure qc qr qs qv temperature"] {
-  filename = name . ".plt"
+  filename = name . "-inputs.plt"
   set title sprintf("Histogram for %s",name)
   plot filename using 1:2 with linespoints title columnheader
 }
-print "\n Output-tensor histograms have been written to the graphics file 'output-tensor-histograms.png'."
+print " Input-tensor histograms have been written to the graphics file 'input-tensor-histograms.png'.\n"
 
 unset multiplot
 
@@ -19,4 +19,4 @@ do for [name in "dpotential_temperature_dt dqc_dt dqr_dt dqs_dt dqv_dt"] {
   set title sprintf("Histogram for %s",name)
   plot filename using 1:2 with linespoints title columnheader
 }
-print " Input-tensor histograms have been written to the graphics file 'input-tensor-histograms.png'.\n"
+print "\n Output-tensor histograms have been written to the graphics file 'output-tensor-histograms.png'."

demo/src/NetCDF_variable_m.f90

@@ -12,6 +12,7 @@ module NetCDF_variable_m
   public :: NetCDF_variable_t
   public :: tensors
   public :: time_derivative_t
+  public :: histogram
 
   type NetCDF_variable_t(k)
     integer, kind :: k = default_real
@@ -35,8 +36,6 @@ module NetCDF_variable_m
     procedure, private, non_overridable :: default_real_maximum         , double_precision_maximum
     generic :: operator(-)              => default_real_subtract        , double_precision_subtract
     procedure, private, non_overridable :: default_real_subtract        , double_precision_subtract
-    generic :: histogram                => default_real_histogram       , double_precision_histogram
-    procedure, private, non_overridable :: default_real_histogram       , double_precision_histogram
     generic :: compare                  => default_real_compare         , double_precision_compare
     procedure, private, non_overridable :: default_real_compare         , double_precision_compare
   end type
@@ -148,13 +147,13 @@ elemental module function double_precision_rank(self) result(my_rank)
 
     elemental module function default_real_end_step(self) result(end_step)
       implicit none
-      class(NetCDF_variable_t), intent(inout) :: self
+      class(NetCDF_variable_t), intent(in) :: self
       integer end_step
     end function
 
     elemental module function double_precision_end_step(self) result(end_step)
       implicit none
-      class(NetCDF_variable_t(double_precision)), intent(inout) :: self
+      class(NetCDF_variable_t(double_precision)), intent(in) :: self
       integer end_step
     end function
 
@@ -215,32 +214,38 @@ module function tensors(NetCDF_variables, step_start, step_end, step_stride)
 
     elemental module function default_real_end_time(self) result(end_time)
       implicit none
-      class(NetCDF_variable_t), intent(inout) :: self
+      class(NetCDF_variable_t), intent(in) :: self
       integer end_time
     end function
 
     elemental module function double_precision_end_time(self) result(end_time)
       implicit none
-      class(NetCDF_variable_t), intent(inout) :: self
+      class(NetCDF_variable_t), intent(in) :: self
       integer end_time
     end function
 
-    elemental module function default_real_histogram(self, num_bins, raw) result(histogram)
+  end interface
+
+  interface histogram
+
+    module function default_real_histogram(variables, num_bins) result(aggregate)
       implicit none
-      class(NetCDF_variable_t), intent(inout) :: self
+      class(NetCDF_variable_t), intent(in), target :: variables(:)
       integer, intent(in) :: num_bins
-      logical, intent(in) :: raw
-      type(histogram_t) histogram
+      type(histogram_t) aggregate
     end function
 
-    elemental module function double_precision_histogram(self, num_bins, raw) result(histogram)
+    module function double_precision_histogram(variables, num_bins) result(aggregate)
       implicit none
-      class(NetCDF_variable_t(double_precision)), intent(inout) :: self
+      class(NetCDF_variable_t(double_precision)), intent(in) :: variables
       integer, intent(in) :: num_bins
-      logical, intent(in) :: raw
-      type(histogram_t) histogram
+      type(histogram_t) aggregate
     end function
 
+  end interface
+
+  interface
+
     module subroutine default_real_compare(self, values)
       implicit none
       class(NetCDF_variable_t), intent(in) :: self

demo/src/NetCDF_variable_s.F90

@@ -6,7 +6,10 @@
 submodule(NetCDF_variable_m) NetCDF_variable_s
   use ieee_arithmetic, only : ieee_is_nan
   use kind_parameters_m, only : default_real
-  use julienne_m, only : call_julienne_assert_, operator(.equalsExpected.)
+  use julienne_m, only : &
+     call_julienne_assert_ &
+    ,operator(.all.) &
+    ,operator(.equalsExpected.)
   use default_m, only : default_or_present_value
   implicit none
 
@@ -66,16 +69,22 @@
    end procedure
 
   module procedure default_real_histogram
-    select case(self%rank())
+
+    integer v
+
+    call_julienne_assert(.all. (variables(1)%rank() .equalsExpected.   variables%rank()))
+    call_julienne_assert(.all. (variables(1)%name_  .equalsExpected. [(variables(v)%name_, v = 1, size(variables))]))
+
+    select case(variables(1)%rank())
     case (4)
-      histogram = histogram_t(self%values_4D_ , self%name_, num_bins, raw)
+      aggregate = histogram_t([(variables(v)%values_4D_, v = 1, size(variables))], variables(1)%name_, num_bins)
     case default
       error stop 'NetCDF_variable_s(default_real_histogram): unsupported rank'
     end select 
   end procedure 
 
   module procedure double_precision_histogram
-      error stop 'NetCDF_variable_s(double_precision_histogram): unsupported rank'
+      error stop 'NetCDF_variable_s(double_precision_histogram): unsupported kind'
   end procedure 
 
   module procedure default_real_copy

demo/src/histogram_m.f90

@@ -12,26 +12,30 @@ module histogram_m
     !! encapsulate the primary data associated with histograms
     private
     character(len=:), allocatable :: variable_name_
-    real unmapped_min_, unmapped_max_
-    real, allocatable :: bin_frequency_(:), bin_value_(:)
+    real variable_min_, variable_max_
+    real, allocatable :: bin_value_(:)
+    integer, allocatable :: bin_count_(:)
   contains
     procedure variable_name
-    procedure unmapped_range
-    procedure unmapped_min
-    procedure unmapped_max
-    procedure num_bins
-    procedure bin_value
     procedure bin_frequency
+    procedure bin_count
   end type
 
   interface histogram_t
 
-    pure module function construct(v, variable_name, num_bins, raw) result(histogram)
+    module function construct(v, variable_name, num_bins) result(histogram)
       implicit none
-      real, intent(in) :: v(:,:,:,:)
+      real, intent(in) :: v(:)
+      character(len=*), intent(in) :: variable_name
+      integer, intent(in) :: num_bins
+      type(histogram_t) histogram
+    end function
+
+    pure module function construct_in_range(v, variable_name, num_bins, v_min, v_max) result(histogram)
+      implicit none
+      real, intent(in) :: v(:), v_min, v_max
       character(len=*), intent(in) :: variable_name
       integer, intent(in) :: num_bins
-      logical, intent(in) :: raw
       type(histogram_t) histogram
     end function
 
@@ -55,49 +59,23 @@ pure module function to_common_file(histograms) result(file)
 
   interface
 
-    pure module function num_bins(self) result(bins)
-      implicit none
-      class(histogram_t), intent(in) :: self
-      integer bins
-    end function
-
     pure module function variable_name(self) result(name)
       implicit none
       class(histogram_t), intent(in) :: self
       character(len=:), allocatable :: name
     end function
 
-    pure module function unmapped_range(self) result(raw_range)
-      implicit none
-      class(histogram_t), intent(in) :: self
-      integer, parameter :: num_end_points = 2
-      real raw_range(num_end_points)
-    end function
-
-    elemental module function unmapped_min(self) result(range_minimum)
-      implicit none
-      class(histogram_t), intent(in) :: self
-      real range_minimum
-    end function
-
-    elemental module function unmapped_max(self) result(range_maximum)
-      implicit none
-      class(histogram_t), intent(in) :: self
-      real range_maximum
-    end function
-
-    elemental module function bin_value(self, bin) result(v)
+    pure module function bin_frequency(self, bin) result(frequency)
       implicit none
       class(histogram_t), intent(in) :: self
       integer, intent(in) :: bin
-      real v
+      real frequency
     end function
 
-    pure module function bin_frequency(self, bin) result(frequency)
+    pure module function bin_count(self) result(counts)
       implicit none
       class(histogram_t), intent(in) :: self
-      integer, intent(in) :: bin
-      real frequency
+      integer, allocatable :: counts(:)
     end function
 
   end interface