diff --git a/fpm.toml b/fpm.toml index 3a806d20..28dc5ba3 100644 --- a/fpm.toml +++ b/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"} diff --git a/include/language-support.F90 b/include/language-support.F90 index e787f378..b85b1de7 100644 --- a/include/language-support.F90 +++ b/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 diff --git a/src/matcha/subdomain_s.F90 b/src/matcha/subdomain_s.F90 index 9889d210..28eaa930 100644 --- a/src/matcha/subdomain_s.F90 +++ b/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)) diff --git a/src/matcha_s.F90 b/src/matcha_s.F90 index 4735efc2..a4f9dabf 100644 --- a/src/matcha_s.F90 +++ b/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 diff --git a/test/subdomain_test_m.F90 b/test/subdomain_test_m.F90 index b15a5bec..b6e53f5e 100644 --- a/test/subdomain_test_m.F90 +++ b/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()