Merge pull request #220 from BerkeleyLab/generalize-train-cloud-micro…

…physics

Generalize train cloud microphysics

demo/app/tensor-statistics.f90

@@ -1,5 +1,27 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
+
+module ubounds_m
+  !! This module serves only to support array bounds checking in the main program below
+  implicit none
+
+  type ubounds_t
+    integer, allocatable :: ubounds_(:)
+  contains
+    procedure equals
+    generic :: operator(==) => equals
+  end type
+
+contains
+
+  elemental function equals(lhs, rhs) result(lhs_equals_rhs)
+    class(ubounds_t), intent(in) :: lhs, rhs
+    logical lhs_equals_rhs
+    lhs_equals_rhs = all(lhs%ubounds_ == rhs%ubounds_)
+  end function
+
+end module
+
 program tensor_statistics
   !! This program
   !! 1. Computes the ranges and histograms of input and output tensors saved by
@@ -9,7 +31,7 @@ program tensor_statistics
   ! External dependencies:
   use julienne_m, only : command_line_t, file_t, string_t
   use assert_m, only : assert, intrinsic_array_t
-  use fiats_m, only : ubounds_t
+  use ubounds_m, only : ubounds_t
   use ieee_arithmetic, only : ieee_is_nan
   use iso_fortran_env, only : int64, real64
 

demo/fpm.toml

@@ -5,6 +5,6 @@ maintainer = "(Please see fiats/fpm.toml.)"
 
 [dependencies]
 assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.7.0"}
-julienne = {git = "https://github.com/berkeleylab/julienne", tag = "1.2.2"}
+julienne = {git = "https://github.com/berkeleylab/julienne", tag = "1.5.3"}
 fiats = {path = "../"}
 netcdf-interfaces = {git = "https://github.com/LKedward/netcdf-interfaces.git", rev = "d2bbb71ac52b4e346b62572b1ca1620134481096"}

demo/src/NetCDF_file_m.f90

@@ -1,8 +1,5 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
-#ifndef __INTEL_FORTRAN
-!! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro
-!! effectively eliminates this file's source code when building with an Intel compiler.
 module NetCDF_file_m
   implicit none
 
@@ -52,5 +49,4 @@ module subroutine input_double_precision(self, varname, values)
 
   end interface
 
-end module NetCDF_file_m
-#endif // __INTEL_FORTRAN
+end module NetCDF_file_m

demo/src/NetCDF_file_s.f90

@@ -1,8 +1,5 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
-#ifndef __INTEL_FORTRAN
-!! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro
-!! effectively eliminates this file's source code when building with an Intel compiler.
 submodule(netCDF_file_m) netCDF_file_s
   use netcdf, only : &
      nf90_create, nf90_def_dim, nf90_def_var, nf90_enddef, nf90_put_var, nf90_inquire_dimension, & ! functions
@@ -226,5 +223,4 @@ function get_shape(ncid, varname) result(array_shape)
 
   end procedure
 
-end submodule netCDF_file_s
-#endif // __INTEL_FORTRAN
+end submodule netCDF_file_s

demo/src/NetCDF_variable_m.f90

@@ -0,0 +1,237 @@
+! Copyright (c), The Regents of the University of California
+! Terms of use are as specified in LICENSE.txt
+module NetCDF_variable_m
+  use NetCDF_file_m, only : NetCDF_file_t
+  use kind_parameters_m, only : default_real, double_precision
+  use julienne_m, only : string_t
+  use fiats_m, only : tensor_t
+  implicit none
+
+  private
+  public :: NetCDF_variable_t
+  public :: tensors
+
+  type NetCDF_variable_t(k)
+    integer, kind :: k = default_real
+    private
+    real(k), allocatable :: values_1D_(:), values_2D_(:,:), values_3D_(:,:,:), values_4D_(:,:,:,:)
+    character(len=:), allocatable :: name_
+  contains
+    generic :: input                    => default_real_input, double_precision_input, default_real_input_character_name, double_precision_input_character_name
+    procedure, private, non_overridable :: default_real_input, double_precision_input, default_real_input_character_name, double_precision_input_character_name
+    generic :: conformable_with         => default_real_conformable_with, double_precision_conformable_with
+    procedure, private, non_overridable :: default_real_conformable_with, double_precision_conformable_with
+    generic :: rank                     => default_real_rank            , double_precision_rank
+    procedure, private, non_overridable :: default_real_rank            , double_precision_rank
+    generic :: end_step                 => default_real_end_step        , double_precision_end_step
+    procedure, private, non_overridable :: default_real_end_step        , double_precision_end_step
+    generic :: any_nan                  => default_real_any_nan         , double_precision_any_nan
+    procedure, private, non_overridable :: default_real_any_nan         , double_precision_any_nan
+    generic :: minimum                  => default_real_minimum         , double_precision_minimum
+    procedure, private, non_overridable :: default_real_minimum         , double_precision_minimum
+    generic :: maximum                  => default_real_maximum         , double_precision_maximum
+    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 :: operator(/)              => default_real_divide          , double_precision_divide
+    procedure, private, non_overridable :: default_real_divide          , double_precision_divide
+    generic :: assignment(=)            => default_real_assign          , double_precision_assign
+    procedure, private, non_overridable :: default_real_assign          , double_precision_assign
+  end type
+
+  interface NetCDF_variable_t
+
+    elemental module function default_real_copy(source, rename) result(NetCDF_variable)
+      implicit none
+      type(NetCDF_variable_t), intent(in) :: source
+      type(string_t), intent(in), optional :: rename
+      type(NetCDF_variable_t) NetCDF_variable
+    end function
+
+    elemental module function default_real_copy_character_name(source, rename) result(NetCDF_variable)
+      implicit none
+      type(NetCDF_variable_t), intent(in) :: source
+      character(len=*), intent(in), optional :: rename
+      type(NetCDF_variable_t) NetCDF_variable
+    end function
+
+    elemental module function double_precision_copy(source, rename) result(NetCDF_variable)
+      implicit none
+      type(NetCDF_variable_t(double_precision)), intent(in) :: source
+      type(string_t), intent(in), optional :: rename
+      type(NetCDF_variable_t(double_precision)) NetCDF_variable
+    end function
+
+    elemental module function double_precision_copy_character_name(source, rename) result(NetCDF_variable)
+      implicit none
+      type(NetCDF_variable_t(double_precision)), intent(in) :: source
+      character(len=*), intent(in), optional :: rename
+      type(NetCDF_variable_t(double_precision)) NetCDF_variable
+    end function
+
+  end interface
+
+  interface
+
+    impure elemental module subroutine default_real_input(self, variable_name, file, rank)
+      implicit none
+      class(NetCDF_variable_t), intent(inout) :: self
+      type(string_t), intent(in) :: variable_name
+      type(NetCDF_file_t), intent(in) :: file
+      integer, intent(in) :: rank
+    end subroutine
+
+    impure elemental module subroutine double_precision_input(self, variable_name, file, rank)
+      implicit none
+      class(NetCDF_variable_t(double_precision)), intent(inout) :: self
+      type(string_t), intent(in) :: variable_name
+      type(NetCDF_file_t), intent(in) :: file
+      integer, intent(in) :: rank
+    end subroutine
+
+    impure elemental module subroutine default_real_input_character_name(self, variable_name, file, rank)
+      implicit none
+      class(NetCDF_variable_t), intent(inout) :: self
+      character(len=*), intent(in) :: variable_name
+      type(NetCDF_file_t), intent(in) :: file
+      integer, intent(in) :: rank
+    end subroutine
+
+    impure elemental module subroutine double_precision_input_character_name(self, variable_name, file, rank)
+      implicit none
+      class(NetCDF_variable_t(double_precision)), intent(inout) :: self
+      character(len=*), intent(in) :: variable_name
+      type(NetCDF_file_t), intent(in) :: file
+      integer, intent(in) :: rank
+    end subroutine
+
+    elemental module function default_real_conformable_with(self, NetCDF_variable) result(conformable)
+      implicit none
+      class(NetCDF_variable_t), intent(in) :: self, NetCDF_variable
+      logical conformable
+    end function
+
+    elemental module function double_precision_conformable_with(self, NetCDF_variable) result(conformable)
+      implicit none
+      class(NetCDF_variable_t(double_precision)), intent(in) :: self, NetCDF_variable
+      logical conformable
+    end function
+
+    elemental module function default_real_rank(self) result(my_rank)
+      implicit none
+      class(NetCDF_variable_t), intent(in) :: self
+      integer my_rank
+    end function
+
+    elemental module function double_precision_rank(self) result(my_rank)
+      implicit none
+      class(NetCDF_variable_t(double_precision)), intent(in) :: self
+      integer my_rank
+    end function
+
+    elemental module function default_real_end_step(self) result(end_step)
+      implicit none
+      class(NetCDF_variable_t), intent(inout) :: 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
+      integer end_step
+    end function
+
+    elemental module function default_real_subtract(lhs, rhs) result(difference)
+      implicit none
+      class(NetCDF_variable_t), intent(in) :: lhs, rhs
+      type(NetCDF_variable_t) difference
+    end function
+
+    elemental module function double_precision_subtract(lhs, rhs) result(difference)
+      implicit none
+      class(NetCDF_variable_t(double_precision)), intent(in) :: lhs, rhs
+      type(NetCDF_variable_t(double_precision)) difference
+    end function
+
+    elemental module function default_real_divide(lhs, rhs) result(ratio)
+      implicit none
+      class(NetCDF_variable_t), intent(in) :: lhs, rhs
+      type(NetCDF_variable_t) ratio
+    end function
+
+    elemental module function double_precision_divide(lhs, rhs) result(ratio)
+      implicit none
+      class(NetCDF_variable_t(double_precision)), intent(in) :: lhs, rhs
+      type(NetCDF_variable_t(double_precision)) ratio
+    end function
+
+    elemental module subroutine default_real_assign(lhs, rhs)
+      implicit none
+      class(NetCDF_variable_t), intent(inout) :: lhs
+      type(NetCDF_variable_t), intent(in) :: rhs
+    end subroutine
+
+    elemental module subroutine double_precision_assign(lhs, rhs)
+      implicit none
+      class(NetCDF_variable_t(double_precision)), intent(inout) :: lhs
+      type(NetCDF_variable_t(double_precision)), intent(in) :: rhs
+    end subroutine
+
+    elemental module function default_real_any_nan(self) result(any_nan)
+      implicit none
+      class(NetCDF_variable_t), intent(in) :: self
+      logical any_nan
+    end function
+
+    elemental module function double_precision_any_nan(self) result(any_nan)
+      implicit none
+      class(NetCDF_variable_t(double_precision)), intent(in) :: self
+      logical any_nan
+    end function
+
+    elemental module function default_real_minimum(self) result(minimum)
+      implicit none
+      class(NetCDF_variable_t), intent(in) :: self
+      real minimum
+    end function
+
+    elemental module function double_precision_minimum(self) result(minimum)
+      implicit none
+      class(NetCDF_variable_t(double_precision)), intent(in) :: self
+      real minimum
+    end function
+
+    elemental module function default_real_maximum(self) result(maximum)
+      implicit none
+      class(NetCDF_variable_t), intent(in) :: self
+      real maximum
+    end function
+
+    elemental module function double_precision_maximum(self) result(maximum)
+      implicit none
+      class(NetCDF_variable_t(double_precision)), intent(in) :: self
+      real maximum
+    end function
+
+    module function tensors(NetCDF_variables, step_start, step_end, step_stride)
+      implicit none
+      type(NetCDF_variable_t), intent(in) :: NetCDF_variables(:)
+      type(tensor_t), allocatable :: tensors(:)
+      integer, optional :: step_start, step_end, step_stride
+    end function
+
+    elemental module function default_real_end_time(self) result(end_time)
+      implicit none
+      class(NetCDF_variable_t), intent(inout) :: 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
+      integer end_time
+    end function
+
+  end interface
+
+end module