Skip to content

Commit

Permalink
fix(test): parallel tests pass for 3D subdomain_t
Browse files Browse the repository at this point in the history
  • Loading branch information
@rouson
rouson committed Dec 21, 2023
1 parent d85487e commit 662c800
Show file tree
Hide file tree
Showing 3 changed files with 84 additions and 74 deletions.
2 changes: 1 addition & 1 deletion test/matcha_test_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ module matcha_test_m

pure function subject() result(specimen)
character(len=:), allocatable :: specimen
specimen = "A matcha_t"
specimen = "A matcha_t object"
end function

function results() result(test_results)
Expand Down
154 changes: 82 additions & 72 deletions test/subdomain_test_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@ module subdomain_test_m
use test_m, only : test_t
use test_result_m, only : test_result_t
use subdomain_m, only : subdomain_t
use assert_m, only : assert
use iso_fortran_env, only : output_unit
implicit none

Expand All @@ -21,24 +22,30 @@ module subdomain_test_m

pure function subject() result(specimen)
character(len=:), allocatable :: specimen
specimen = "A subdomain_t"
specimen = "A subdomain_t object"
end function

function results() result(test_results)
type(test_result_t), allocatable :: test_results(:)
integer, parameter :: longest_len = len("computing a correctly shaped Laplacian for a 2D flat-topped, step-like plateau")

test_results = test_result_t( &
[ character(len=longest_len) :: &
"computing a correctly shaped Laplacian for a 2D flat-topped, step-like plateau", &
"reaching the correct steady state solution", &
"functional pattern results matching procedural results" &
], &
[ correctly_shaped_laplacian(), &
correct_steady_state(), &
functional_matches_procedural() &
] &
integer, parameter :: longest_len = &
len("computing a concave Laplacian for a spatially constant operand with a step down at boundaries")

associate( &
descriptions => &
[character(len=longest_len) :: &
"computing a concave Laplacian for a spatially constant operand with a step down at boundaries", &
"reaching the correct steady state solution", &
"functional pattern results matching procedural results" &
], &
outcomes => &
[concave_laplacian(), &
correct_steady_state(), &
functional_matches_procedural() &
] &
)
call assert(size(descriptions) == size(outcomes),"subdomain_test_m(results): size(descriptions) == size(outcomes)")
test_results = test_result_t(descriptions, outcomes)
end associate
end function

subroutine output(v)
Expand All @@ -55,17 +62,17 @@ subroutine output(v)
sync all
end subroutine

function correctly_shaped_laplacian() result(test_passes)
function concave_laplacian() result(test_passes)
logical test_passes
type(subdomain_t) f, laplacian_f
real, allocatable :: lap_f_vals(:,:,:)

call f%define(side=1., boundary_val=1., internal_val=2., n=6) ! internally constant subdomain with a step down at all surfaces
call f%define(side=1., boundary_val=1., internal_val=2., n=21) ! internally constant subdomain with a step down at all surfaces
laplacian_f = .laplacian. f
lap_f_vals = laplacian_f%values()

block
real, parameter :: tolerance = 1.0E-06
real, parameter :: tolerance = 1.0E-01
logical internally_zero, concave_at_faces, doubly_concave_at_edges, triply_concave_in_corners, constant_away_from_edges

associate(me=>this_image(), n_subdomains=>num_images(), nx=>size(lap_f_vals,1), ny=>size(lap_f_vals,2),nz=>size(lap_f_vals,3))
Expand All @@ -81,63 +88,66 @@ function correctly_shaped_laplacian() result(test_passes)
bottom_z_adjacent => lap_f_vals(3:nx-2, 3:ny-2, 2), &
top_z_adjacent => lap_f_vals(3:nx-2, 3:ny-2, nz-1) &
)
constant_away_from_edges = &
all(abs(bottom_x_adjacent(1,1) - bottom_x_adjacent) < tolerance) .and. &
all(abs( top_x_adjacent(1,1) - bottom_x_adjacent) < tolerance) .and. &
all(abs(bottom_y_adjacent(1,1) - bottom_y_adjacent) < tolerance) .and. &
all(abs( top_y_adjacent(1,1) - bottom_y_adjacent) < tolerance) .and. &
all(abs(bottom_z_adjacent(1,1) - bottom_z_adjacent) < tolerance) .and. &
all(abs( top_z_adjacent(1,1) - bottom_z_adjacent) < tolerance)

concave_at_faces = &
all(bottom_y_adjacent < 0) .and. &
all( top_y_adjacent < 0) .and. &
all(bottom_z_adjacent < 0) .and. &
all( top_z_adjacent < 0) .and. &
merge(all(bottom_x_adjacent < 0), .true., me==1) .and. &
merge(all( top_x_adjacent < 0), .true., me==n_subdomains)

associate( &
lo_y_lo_z_edge => lap_f_vals(3:nx-2, 2, 2), &
hi_y_lo_z_edge => lap_f_vals(3:nx-2, ny-1, 2), &
lo_y_hi_z_edge => lap_f_vals(3:nx-2, 2, nz-1), &
hi_y_hi_z_edge => lap_f_vals(3:nx-2, ny-1, nz-1), &
lo_x_lo_z_edge => lap_f_vals( 2, 3:ny-2, 2), &
hi_x_lo_z_edge => lap_f_vals( nx-1, 3:ny-2, 2), &
lo_x_hi_z_edge => lap_f_vals( 2, 3:ny-2, nz-1), &
hi_x_hi_z_edge => lap_f_vals( nx-1, 3:ny-2, nz-1), &
lo_x_lo_y_edge => lap_f_vals( 2, 2, 3:nz-2), &
hi_x_lo_y_edge => lap_f_vals( nx-1, 2, 3:nz-2), &
lo_x_hi_y_edge => lap_f_vals( 2, ny-1, 3:nz-2), &
hi_x_hi_y_edge => lap_f_vals( nx-1, ny-1, 3:nz-2) &
)
doubly_concave_at_edges = &
all(abs(lo_y_lo_z_edge - 2.*bottom_x_adjacent(1,1)) < tolerance) .and. &
all(abs(hi_y_lo_z_edge - 2.*bottom_x_adjacent(1,1)) < tolerance) .and. &
all(abs(lo_y_hi_z_edge - 2.*bottom_x_adjacent(1,1)) < tolerance) .and. &
all(abs(hi_y_hi_z_edge - 2.*bottom_x_adjacent(1,1)) < tolerance) .and. &
all(abs(lo_x_lo_z_edge - 2.*bottom_x_adjacent(1,1)) < tolerance) .and. &
all(abs(hi_x_lo_z_edge - 2.*bottom_x_adjacent(1,1)) < tolerance) .and. &
all(abs(lo_x_hi_z_edge - 2.*bottom_x_adjacent(1,1)) < tolerance) .and. &
all(abs(hi_x_hi_z_edge - 2.*bottom_x_adjacent(1,1)) < tolerance) .and. &
all(abs(lo_x_lo_y_edge - 2.*bottom_x_adjacent(1,1)) < tolerance) .and. &
all(abs(hi_x_lo_y_edge - 2.*bottom_x_adjacent(1,1)) < tolerance) .and. &
all(abs(lo_x_hi_y_edge - 2.*bottom_x_adjacent(1,1)) < tolerance) .and. &
all(abs(hi_x_hi_y_edge - 2.*bottom_x_adjacent(1,1)) < tolerance)

triply_concave_in_corners = &
(abs(lap_f_vals( 2, 2, 2) - 3.*bottom_x_adjacent(1,1)) < tolerance) .and. &
(abs(lap_f_vals(nx-1, 2, 2) - 3.*bottom_x_adjacent(1,1)) < tolerance) .and. &
(abs(lap_f_vals( 2,ny-1, 2) - 3.*bottom_x_adjacent(1,1)) < tolerance) .and. &
(abs(lap_f_vals(nx-1,ny-1, 2) - 3.*bottom_x_adjacent(1,1)) < tolerance) .and. &
(abs(lap_f_vals( 2, 2,nz-1) - 3.*bottom_x_adjacent(1,1)) < tolerance) .and. &
(abs(lap_f_vals(nx-1, 2,nz-1) - 3.*bottom_x_adjacent(1,1)) < tolerance) .and. &
(abs(lap_f_vals( 2,ny-1,nz-1) - 3.*bottom_x_adjacent(1,1)) < tolerance) .and. &
(abs(lap_f_vals(nx-1,ny-1,nz-1) - 3.*bottom_x_adjacent(1,1)) < tolerance)
associate(curvature => bottom_y_adjacent(1,1))
constant_away_from_edges = &
merge(all(abs(bottom_x_adjacent - curvature) < tolerance), .true., me==1 ) .and. &
merge(all(abs( top_x_adjacent - curvature) < tolerance), .true., me==n_subdomains) .and. &
all(abs(bottom_y_adjacent - curvature) < tolerance) .and. &
all(abs( top_y_adjacent - curvature) < tolerance) .and. &
all(abs(bottom_z_adjacent - curvature) < tolerance) .and. &
all(abs( top_z_adjacent - curvature) < tolerance)

concave_at_faces = &
all(bottom_y_adjacent < 0) .and. &
all( top_y_adjacent < 0) .and. &
all(bottom_z_adjacent < 0) .and. &
all( top_z_adjacent < 0) .and. &
merge(all(bottom_x_adjacent < 0), .true., me==1) .and. &
merge(all( top_x_adjacent < 0), .true., me==n_subdomains)

associate( &
lo_y_lo_z_edge => lap_f_vals(3:nx-2, 2, 2), &
hi_y_lo_z_edge => lap_f_vals(3:nx-2, ny-1, 2), &
lo_y_hi_z_edge => lap_f_vals(3:nx-2, 2, nz-1), &
hi_y_hi_z_edge => lap_f_vals(3:nx-2, ny-1, nz-1), &
lo_x_lo_z_edge => lap_f_vals( 2, 3:ny-2, 2), &
hi_x_lo_z_edge => lap_f_vals( nx-1, 3:ny-2, 2), &
lo_x_hi_z_edge => lap_f_vals( 2, 3:ny-2, nz-1), &
hi_x_hi_z_edge => lap_f_vals( nx-1, 3:ny-2, nz-1), &
lo_x_lo_y_edge => lap_f_vals( 2, 2, 3:nz-2), &
hi_x_lo_y_edge => lap_f_vals( nx-1, 2, 3:nz-2), &
lo_x_hi_y_edge => lap_f_vals( 2, ny-1, 3:nz-2), &
hi_x_hi_y_edge => lap_f_vals( nx-1, ny-1, 3:nz-2) &
)
doubly_concave_at_edges = &
merge(all(abs(lo_x_lo_z_edge - 2.*curvature) < tolerance), .true., me==1) .and. &
merge(all(abs(lo_x_hi_z_edge - 2.*curvature) < tolerance), .true., me==1) .and. &
merge(all(abs(lo_x_lo_y_edge - 2.*curvature) < tolerance), .true., me==1) .and. &
merge(all(abs(lo_x_hi_y_edge - 2.*curvature) < tolerance), .true., me==1) .and. &
merge(all(abs(hi_x_lo_z_edge - 2.*curvature) < tolerance), .true., me==n_subdomains) .and. &
merge(all(abs(hi_x_hi_z_edge - 2.*curvature) < tolerance), .true., me==n_subdomains) .and. &
merge(all(abs(hi_x_lo_y_edge - 2.*curvature) < tolerance), .true., me==n_subdomains) .and. &
merge(all(abs(hi_x_hi_y_edge - 2.*curvature) < tolerance), .true., me==n_subdomains) .and. &
all(abs(lo_y_lo_z_edge - 2*curvature) < tolerance) .and. &
all(abs(hi_y_lo_z_edge - 2*curvature) < tolerance) .and. &
all(abs(lo_y_hi_z_edge - 2*curvature) < tolerance) .and. &
all(abs(hi_y_hi_z_edge - 2*curvature) < tolerance)

triply_concave_in_corners = &
merge((abs(lap_f_vals( 2, 2, 2) - 3.*curvature) < tolerance), .true., me==1) .and. &
merge((abs(lap_f_vals( 2,ny-1, 2) - 3.*curvature) < tolerance), .true., me==1) .and. &
merge((abs(lap_f_vals( 2, 2,nz-1) - 3.*curvature) < tolerance), .true., me==1) .and. &
merge((abs(lap_f_vals( 2,ny-1,nz-1) - 3.*curvature) < tolerance), .true., me==1) .and. &
merge((abs(lap_f_vals(nx-1, 2, 2) - 3.*curvature) < tolerance), .true., me==n_subdomains) .and. &
merge((abs(lap_f_vals(nx-1,ny-1, 2) - 3.*curvature) < tolerance), .true., me==n_subdomains) .and. &
merge((abs(lap_f_vals(nx-1, 2,nz-1) - 3.*curvature) < tolerance), .true., me==n_subdomains) .and. &
merge((abs(lap_f_vals(nx-1,ny-1,nz-1) - 3.*curvature) < tolerance), .true., me==n_subdomains)
end associate
end associate
end associate
end associate


test_passes = &
all([internally_zero, constant_away_from_edges, concave_at_faces, doubly_concave_at_edges, triply_concave_in_corners])
end block
Expand All @@ -148,10 +158,10 @@ function correct_steady_state() result(test_passes)
logical test_passes
type(subdomain_t) T
real, parameter :: T_boundary = 1., T_initial = 2., tolerance = 0.01, T_steady = T_boundary, alpha = 1.
integer, parameter :: steps = 500
integer, parameter :: steps = 6000
integer step

call T%define(side=1., boundary_val=T_boundary, internal_val=T_initial, n=6) ! const. internally with a step down at boundaries
call T%define(side=1., boundary_val=T_boundary, internal_val=T_initial, n=21) ! const. internally with a step down at boundaries

associate(dt => T%dx()*T%dy()*T%dz()/(4*alpha))
do step = 1, steps
Expand All @@ -167,7 +177,7 @@ function correct_steady_state() result(test_passes)
function functional_matches_procedural() result(test_passes)
logical test_passes
real, parameter :: tolerance = 0.1
integer, parameter :: steps = 500, n=6
integer, parameter :: steps = 6000, n=21
real, parameter :: alpha = 1.
real, parameter :: side=1., boundary_val=1., internal_val=2.

Expand Down
2 changes: 1 addition & 1 deletion test/t_cell_collection_test_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ module t_cell_collection_test_m

pure function subject() result(specimen)
character(len=:), allocatable :: specimen
specimen = "A t_cell_collection_t"
specimen = "A t_cell_collection_t object"
end function

function results() result(test_results)
Expand Down

0 comments on commit 662c800

Please sign in to comment.