Merge pull request #178 from BerkeleyLab/julienne-2.4.0

Use Julienne 2.4.0 idioms in subdomain_t unit tests

Author: rouson

fpm.toml

@@ -1,10 +1,5 @@
 name = "matcha"
-version = "0.1.0"
-license = "see LICENSE.txt"
-author = "Damian Rouson, David Torres,  Dominick Martinez, Jeremiah Bailey, and Brad Richardson"
-maintainer = "rouson@lbl.gov"
 
 [dependencies]
 assert = {git = "https://github.com/berkeleylab/assert", tag = "2.1.0"}
-julienne = {git = "https://github.com/BerkeleyLab/julienne", tag = "2.0.0"}
-sourcery = {git = "https://github.com/sourceryinstitute/sourcery", tag = "4.5.1"}
+julienne = {git = "https://github.com/BerkeleyLab/julienne", tag = "2.4.0"}

include/language-support.F90

@@ -5,19 +5,28 @@
   ! Define whether the compiler supports associating a procedure pointer dummy argument with an
   ! actual argument that is a valid target for the pointer dummy in a procedure assignment, a
   ! feature introduced in Fortran 2008 and described in Fortran 2023 clause 15.5.2.10 paragraph 5.
-#if defined(_CRAYFTN) || defined(__INTEL_COMPILER) || defined(NAGFOR) || defined(__flang__)
-#define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 1
-#else
-#define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0
+#  if defined(_CRAYFTN) || defined(__INTEL_COMPILER) || defined(NAGFOR) || defined(__flang__)
+#    define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 1
+#  else
+#    define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0
+#  endif
 #endif
+
+#ifndef HAVE_CRITICAL
+  ! Define whether the compiler supports the `critical` and `end critical` statements
+#  if defined(_CRAYFTN) || defined(__INTEL_COMPILER) || defined(NAGFOR) || defined(__GFORTRAN__)
+#    define HAVE_CRITICAL 1
+#  else
+#    define HAVE_CRITICAL 0
+#  endif
 #endif
 
 #ifndef HAVE_MULTI_IMAGE_SUPPORT
   ! Define whether the compiler supports the statements and intrinsic procedures that support
   ! multi-image execution, e.g., this_image(), sync all, etc.
-#if defined(_CRAYFTN) || defined(__INTEL_COMPILER) || defined(NAGFOR) || defined(__GFORTRAN__)
-#define HAVE_MULTI_IMAGE_SUPPORT 1
-#else
-#define HAVE_MULTI_IMAGE_SUPPORT 0
-#endif
+#  if defined(_CRAYFTN) || defined(__INTEL_COMPILER) || defined(NAGFOR) || defined(__GFORTRAN__)
+#    define HAVE_MULTI_IMAGE_SUPPORT 1
+#  else
+#    define HAVE_MULTI_IMAGE_SUPPORT 0
+#  endif
 #endif

src/matcha/subdomain_s.F90

@@ -5,15 +5,13 @@
 
 submodule(subdomain_m) subdomain_s
   use assert_m
-  use sourcery_m, only : data_partition_t
+  use julienne_m, only : bin_t
   use intrinsic_array_m, only : intrinsic_array_t
   implicit none
 
   real, allocatable :: halo_x(:,:,:)[:]
   integer, parameter :: west=1, east=2
 
-  type(data_partition_t) data_partition
-
   real dx_, dy_, dz_
   integer my_nx, nx, ny, nz, me, num_subdomains, my_internal_west, my_internal_east
   real, allocatable :: increment(:,:,:)
@@ -44,8 +42,9 @@
     me = this_image()
     num_subdomains = num_images()
 
-    call data_partition%define_partitions(nx)
-    my_nx = data_partition%last(me) - data_partition%first(me) + 1
+    associate(bin => bin_t(num_items=nx, num_bins=num_subdomains, bin_number=me))
+      my_nx = bin%last() - bin%first() + 1
+    end associate
 
     if (allocated(self%s_)) deallocate(self%s_)
     allocate(self%s_(my_nx, ny, nz))

src/matcha_s.F90

@@ -3,7 +3,7 @@
 submodule(matcha_m) matcha_s
   use t_cell_collection_m, only : t_cell_collection_t
   use distribution_m, only : distribution_t
-  use sourcery_m, only : data_partition_t
+  use julienne_m, only : bin_t
   implicit none
 
 contains
@@ -25,12 +25,10 @@
         type(distribution_t) distribution
         integer, parameter :: nveldim = 4
         integer step
-        type(data_partition_t) data_partition
 
-        call data_partition%define_partitions(cardinality=ncells)
-    
         associate(me => this_image())
-          associate(my_num_cells => data_partition%last(me) - data_partition%first(me) + 1)
+          associate(bin => bin_t(num_items=ncells, num_bins=num_images(), bin_number=me))
+          associate(my_num_cells => bin%last() - bin%first() + 1)
 
             call random_init(repeatable=.true., image_distinct=.true.)
 
@@ -55,6 +53,7 @@
               end associate
             end associate
           end associate  
+          end associate  
         end associate    
       end block
     end associate

test/subdomain_test_m.F90

@@ -1,10 +1,19 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
+
+#include "language-support.F90"
+
 module subdomain_test_m
   !! Define subdomain tests and procedures required for reporting results
   use julienne_m, only : &
      diagnosis_function_i &
+    ,operator(.all.) &
+    ,operator(.approximates.) &
+    ,operator(.and.) &
     ,operator(.csv.) &
+    ,operator(.isAtLeast.) &
+    ,operator(.isAtMost.) &
+    ,operator(.within.) &
     ,string_t &
     ,test_t &
     ,test_description_t &
@@ -38,7 +47,7 @@ function results() result(test_results)
     test_descriptions = [ &
        test_description_t("computing a concave Laplacian for a spatially constant operand with a step down at boundaries", concave_laplacian) &
       ,test_description_t("reaching the correct steady state solution", correct_steady_state) &
-      ,test_description_t("functional pattern results matching procedural results" functional_matches_procedural) &
+      ,test_description_t("functional pattern results matching procedural results", functional_matches_procedural) &
     ]
 #else
     procedure(diagnosis_function_i), pointer :: &
@@ -63,13 +72,17 @@ subroutine output(v)
     real, intent(in) :: v(:,:,:)
     integer j, k
     sync all
+#ifdef HAVE_CRITICAL
     critical
+#endif
       do j = 1, size(v,2)
         do k = 1, size(v,3)
           print *,"image ",this_image(),": ",j,k,v(:,j,k)
         end do
       end do
+#ifdef HAVE_CRITICAL
     end critical
+#endif
     sync all
   end subroutine
 
@@ -184,10 +197,7 @@ function correct_steady_state() result(test_diagnosis)
     end associate
 
     associate(residual => T%values() - T_steady)
-      test_diagnosis = test_diagnosis_t( &
-        test_passed = all(residual >= 0. .and. residual <= tolerance) &
-       ,diagnostics_string = "expected 0 <= " &  ! // string_t(residual) // "<= "// string_t(tolerance) &
-      )
+      test_diagnosis = .all. ((residual .isAtLeast. 0.) .and. (residual .isAtMost. tolerance))
     end associate
   end function
 
@@ -200,13 +210,10 @@ function functional_matches_procedural() result(test_diagnosis)
 
     associate( T_f => T_functional(), T_p => T_procedural())
       associate(L_infinity_norm => maxval(abs(T_f - T_p)))
-        test_diagnosis = test_diagnosis_t( &  
-           test_passed = L_infinity_norm < tolerance &
-          ,diagnostics_string = "expected " // string_t(L_infinity_norm) // " < " // string_t(tolerance) &
-        )
+        test_diagnosis = .all. (T_f .approximates. T_p .within. tolerance)
       end associate
     end associate
-&
+
   contains
 
     function T_functional()