Skip to content

Commit

Permalink
Merge pull request #165 from BerkeleyLab/add-arguments
Browse files Browse the repository at this point in the history
Feature: add arguments to example & rm redundant allocations
  • Loading branch information
rouson authored Dec 24, 2023
2 parents c0c7f43 + f4a3166 commit f10d219
Show file tree
Hide file tree
Showing 8 changed files with 38 additions and 20 deletions.
27 changes: 25 additions & 2 deletions example/time-paradigm.f90
Original file line number Diff line number Diff line change
Expand Up @@ -4,13 +4,36 @@ program time_paradigm_m
!! Time various alternative programming paradigms
use subdomain_m, only : subdomain_t
use assert_m, only : assert
use sourcery_m, only : string_t, file_t, command_line_t, bin_t, csv
use iso_fortran_env, only : int64
implicit none
integer, parameter :: steps = 1000, resolution=256

real, parameter :: alpha=1., T_internal_initial=1., T_boundary=0., T_steady=T_boundary, tolerance = 1.E-03
character(len=:), allocatable :: steps_string, resolution_string
type(command_line_t) command_line
integer(int64) counter_start, counter_end, clock_rate
integer :: steps=200, resolution=64

associate(me => this_image())
if (me==1) print *,"Starting functional solver."
if (command_line%argument_present(["--help"])) then
print *, &
new_line('a') // new_line('a') // &
'Usage: fpm run --example time-paradigm -- [--steps <integer>] [--resolution <integer>]' // &
new_line('a') // new_line('a') // &
'where square brackets indicate optional arguments'
stop
end if

steps_string = string_t(command_line%flag_value("--steps"))
resolution_string = string_t(command_line%flag_value("--resolution"))
if (len(steps_string)/=0) read(steps_string,*) steps
if (len(resolution_string)/=0) read(resolution_string,*) resolution

if (me==1) then
print *,"Number of steps to execute: ",steps
print *,"Number of grid points in each coordinate direction: ",resolution
print *,"Starting functional solver."
end if
associate(t_functional => functional_programming_time())
if (me==1) print *,"Starting procedural solver."
associate(t_procedural => functional_programming_time())
Expand Down
4 changes: 2 additions & 2 deletions fpm.toml
Original file line number Diff line number Diff line change
Expand Up @@ -10,5 +10,5 @@ source-dir="app"
main = "main.F90"

[dependencies]
assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.4.0"}
sourcery = {git = "https://github.com/sourceryinstitute/sourcery", tag = "3.8.0"}
assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.5.0"}
sourcery = {git = "https://github.com/sourceryinstitute/sourcery", tag = "4.5.0"}
15 changes: 7 additions & 8 deletions src/matcha/subdomain_s.f90
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
submodule(subdomain_m) subdomain_s
use data_partition_m, only : data_partition_t
use sourcery_m, only : data_partition_t
use assert_m, only : assert
use intrinsic_array_m, only : intrinsic_array_t
implicit none
Expand All @@ -11,6 +11,7 @@

real dx_, dy_, dz_
integer my_nx, nx, ny, nz, me, num_subdomains, my_internal_west, my_internal_east
real, allocatable :: increment(:,:,:)

contains

Expand Down Expand Up @@ -138,14 +139,12 @@

module procedure step

real, allocatable :: increment(:,:,:)

call assert(allocated(self%s_), "subdomain_t%laplacian: allocated(rhs%s_)")
call assert(allocated(halo_x), "subdomain_t%laplacian: allocated(halo_x)")
call assert(my_internal_west+1<=my_nx,"laplacian: westernmost subdomain too small")
call assert(my_internal_east-1>0,"laplacian: easternmost subdomain too small")

allocate(increment(my_nx,ny,nz))
if (.not. allocated(increment)) allocate(increment(my_nx,ny,nz))

call internal_points(increment)
call edge_points(increment)
Expand All @@ -164,9 +163,9 @@ subroutine internal_points(ds)

do concurrent(i=my_internal_west+1:my_internal_east-1, j=2:ny-1, k=2:nz-1)
ds(i,j,k) = alpha_dt*( &
(self%s_(i-1,j ,k ) - 2*self%s_(i,j,k) + self%s_(i+1,j,k ))/dx_**2 + &
(self%s_(i ,j-1,k ) - 2*self%s_(i,j,k) + self%s_(i,j+1,k ))/dy_**2 + &
(self%s_(i ,j ,k-1) - 2*self%s_(i,j,k) + self%s_(i,j ,k+1))/dz_**2 &
(self%s_(i-1,j ,k ) - 2*self%s_(i,j,k) + self%s_(i+1,j ,k ))/dx_**2 + &
(self%s_(i ,j-1,k ) - 2*self%s_(i,j,k) + self%s_(i ,j+1,k ))/dy_**2 + &
(self%s_(i ,j ,k-1) - 2*self%s_(i,j,k) + self%s_(i ,j ,k+1))/dz_**2 &
)
end do
end subroutine
Expand Down Expand Up @@ -202,7 +201,7 @@ subroutine apply_boundary_condition(ds)
real, intent(inout) :: ds(:,:,:)
integer i, j

ds(:,1:ny:ny-1,: ) = 0.
ds(:,1:ny:ny-1, : ) = 0.
ds(:, : ,1:nz:nz-1) = 0.
if (me==1) ds(1,:,:) = 0.
if (me==num_subdomains) ds(my_nx,:,:) = 0.
Expand Down
1 change: 0 additions & 1 deletion src/matcha_m.f90
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,6 @@ module matcha_m
use distribution_m, only : distribution_t
use input_m, only : input_t
use output_m, only : output_t
use data_partition_m, only : data_partition_t
use subdomain_m, only : subdomain_t

implicit none
Expand Down
2 changes: 1 addition & 1 deletion src/matcha_s.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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 data_partition_m, only : data_partition_t
use sourcery_m, only : data_partition_t
implicit none

contains
Expand Down
3 changes: 1 addition & 2 deletions test/matcha_test_m.f90
Original file line number Diff line number Diff line change
@@ -1,8 +1,7 @@
! Copyright (c), The Regents of the University of California
! Terms of use are as specified in LICENSE.txt
module matcha_test_m
use test_m, only : test_t
use test_result_m, only : test_result_t
use sourcery_m, only : test_t, test_result_t
use input_m, only : input_t
use output_m, only : output_t
use matcha_m, only : matcha
Expand Down
3 changes: 1 addition & 2 deletions test/subdomain_test_m.f90
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,7 @@
! Terms of use are as specified in LICENSE.txt
module subdomain_test_m
!! Define subdomain tests and procedures required for reporting results
use test_m, only : test_t
use test_result_m, only : test_result_t
use sourcery_m, only : test_t, test_result_t
use subdomain_m, only : subdomain_t
use assert_m, only : assert
implicit none
Expand Down
3 changes: 1 addition & 2 deletions test/t_cell_collection_test_m.f90
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,7 @@
! Terms of use are as specified in LICENSE.txt
module t_cell_collection_test_m
!! Define t_cell_collection tests and procedures required for reporting results
use test_m, only : test_t
use test_result_m, only : test_result_t
use sourcery_m, only : test_t, test_result_t
use t_cell_collection_m, only : t_cell_collection_t
use iso_fortran_env, only : output_unit
use input_m, only : input_t
Expand Down

0 comments on commit f10d219

Please sign in to comment.