Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add contiguous attribute for arrays passed to c functions #242

Merged
merged 3 commits into from
Nov 6, 2024
Merged

Add contiguous attribute for arrays passed to c functions #242

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
af7ce33
add contiguous attribute for arrays passed to c functions
mattldawson Nov 6, 2024
f6f2c83
add tests with array slices and fix intents
mattldawson Nov 6, 2024
7cfcd6f
revert to previous intel image to avoid gfortran ICE
mattldawson Nov 6, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion docker/Dockerfile.fortran-intel
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
# versions and sizes from here: https://hub.docker.com/r/intel/oneapi-hpckit/tags
FROM intel/oneapi-hpckit:latest
FROM intel/oneapi-hpckit:2024.0.1-devel-ubuntu22.04

# Based off of this: https://dgpu-docs.intel.com/driver/installation.html#repository-public-key-used-for-package-and-repository-signing
# however those docs (at the time of this writing are incorrect) and this is the correct url
Expand Down
20 changes: 10 additions & 10 deletions fortran/micm.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -252,16 +252,16 @@ subroutine solve_arrays(this, time_step, temperature, pressure, air_density, &
use iso_c_binding, only: c_loc
use iso_fortran_env, only: real64
use musica_util, only: string_t, string_t_c, error_t_c, error_t
class(micm_t), intent(in) :: this
real(real64), intent(in) :: time_step
real(real64), target, intent(in) :: temperature(:)
real(real64), target, intent(in) :: pressure(:)
real(real64), target, intent(in) :: air_density(:)
real(real64), target, intent(inout) :: concentrations(:,:)
real(real64), target, intent(in) :: user_defined_reaction_rates(:,:)
type(string_t), intent(out) :: solver_state
type(solver_stats_t), intent(out) :: solver_stats
type(error_t), intent(out) :: error
class(micm_t), intent(in) :: this
real(real64), intent(in) :: time_step
real(real64), target, contiguous, intent(in) :: temperature(:)
real(real64), target, contiguous, intent(in) :: pressure(:)
real(real64), target, contiguous, intent(in) :: air_density(:)
real(real64), target, contiguous, intent(inout) :: concentrations(:,:)
real(real64), target, contiguous, intent(in) :: user_defined_reaction_rates(:,:)
type(string_t), intent(out) :: solver_state
type(solver_stats_t), intent(out) :: solver_stats
type(error_t), intent(out) :: error

type(string_t_c) :: solver_state_c
type(solver_stats_t_c) :: solver_stats_c
Expand Down
102 changes: 59 additions & 43 deletions fortran/test/fetch_content_integration/test_micm_api.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -182,13 +182,18 @@ subroutine test_vector_multiple_grid_cells(micm, NUM_GRID_CELLS, time_step, test

integer, parameter :: NUM_SPECIES = 6
integer, parameter :: NUM_USER_DEFINED_REACTION_RATES = 2
real(real64), target :: temperature(NUM_GRID_CELLS)
real(real64), target :: pressure(NUM_GRID_CELLS)
real(real64), target :: air_density(NUM_GRID_CELLS)
real(real64), target :: concentrations(NUM_GRID_CELLS,NUM_SPECIES)
! set up arrays to pass to MICM as slices to ensure contiguous memory is passed to c functions
real(real64), target :: temperature(2,NUM_GRID_CELLS)
real(real64), target :: temperature_c_ptrs(NUM_GRID_CELLS)
real(real64), target :: pressure(2,NUM_GRID_CELLS)
real(real64), target :: pressure_c_ptrs(NUM_GRID_CELLS)
real(real64), target :: air_density(3,NUM_GRID_CELLS)
real(real64), target :: air_density_c_ptrs(NUM_GRID_CELLS)
real(real64), target :: concentrations(4,NUM_GRID_CELLS,NUM_SPECIES)
real(real64), target :: concentrations_c_ptrs(NUM_GRID_CELLS,NUM_SPECIES)
real(real64), target :: initial_concentrations(NUM_GRID_CELLS,NUM_SPECIES)
real(real64), target :: user_defined_reaction_rates(NUM_GRID_CELLS,NUM_USER_DEFINED_REACTION_RATES)
real(real64), target :: initial_concentrations(4,NUM_GRID_CELLS,NUM_SPECIES)
real(real64), target :: user_defined_reaction_rates(3,NUM_GRID_CELLS,NUM_USER_DEFINED_REACTION_RATES)
real(real64), target :: user_defined_reaction_rates_c_ptrs(NUM_GRID_CELLS,NUM_USER_DEFINED_REACTION_RATES)
type(string_t) :: solver_state
type(solver_stats_t) :: solver_stats
integer :: solver_type
Expand Down Expand Up @@ -221,51 +226,62 @@ subroutine test_vector_multiple_grid_cells(micm, NUM_GRID_CELLS, time_step, test
R2_index = micm%user_defined_reaction_rates%index( "USER.reaction 2", error )
ASSERT( error%is_success() )

temperature(:,:) = 1.0e300_real64
pressure(:,:) = 1.0e300_real64
air_density(:,:) = 1.0e300_real64
concentrations(:,:,:) = 1.0e300_real64
user_defined_reaction_rates(:,:,:) = 1.0e300_real64
do i_cell = 1, NUM_GRID_CELLS
call random_number( temp )
temperature(i_cell) = 265.0 + temp * 20.0
temperature(2,i_cell) = 265.0 + temp * 20.0
call random_number( temp )
pressure(i_cell) = 100753.3 + temp * 1000.0
air_density(i_cell) = pressure(i_cell) / ( GAS_CONSTANT * temperature(i_cell) )
pressure(2,i_cell) = 100753.3 + temp * 1000.0
air_density(2,i_cell) = pressure(2,i_cell) / ( GAS_CONSTANT * temperature(2,i_cell) )
call random_number( temp )
concentrations(i_cell,A_index) = 0.7 + temp * 0.1
concentrations(i_cell,B_index) = 0.0
concentrations(2,i_cell,A_index) = 0.7 + temp * 0.1
concentrations(2,i_cell,B_index) = 0.0
call random_number( temp )
concentrations(i_cell,C_index) = 0.35 + temp * 0.1
concentrations(2,i_cell,C_index) = 0.35 + temp * 0.1
call random_number( temp )
concentrations(i_cell,D_index) = 0.75 + temp * 0.1
concentrations(i_cell,E_index) = 0.0
concentrations(2,i_cell,D_index) = 0.75 + temp * 0.1
concentrations(2,i_cell,E_index) = 0.0
call random_number( temp )
concentrations(i_cell,F_index) = 0.05 + temp * 0.1
concentrations(2,i_cell,F_index) = 0.05 + temp * 0.1
call random_number( temp )
user_defined_reaction_rates(i_cell,R1_index) = 0.0005 + temp * 0.0001
user_defined_reaction_rates(2,i_cell,R1_index) = 0.0005 + temp * 0.0001
call random_number( temp )
user_defined_reaction_rates(i_cell,R2_index) = 0.0015 + temp * 0.0001
user_defined_reaction_rates(2,i_cell,R2_index) = 0.0015 + temp * 0.0001
end do
initial_concentrations(:,:) = concentrations(:,:)
concentrations_c_ptrs(:,:) = concentrations(:,:)
initial_concentrations(:,:,:) = concentrations(:,:,:)
concentrations_c_ptrs(:,:) = concentrations(2,:,:)
user_defined_reaction_rates_c_ptrs(:,:) = user_defined_reaction_rates(2,:,:)
temperature_c_ptrs(:) = temperature(2,:)
pressure_c_ptrs(:) = pressure(2,:)
air_density_c_ptrs(:) = air_density(2,:)

! solve by passing fortran arrays
call micm%solve(time_step, temperature, pressure, air_density, concentrations, &
user_defined_reaction_rates, solver_state, solver_stats, error)
call micm%solve(time_step, temperature(2,:), pressure(2,:), air_density(2,:), &
concentrations(2,:,:), user_defined_reaction_rates(2,:,:), &
solver_state, solver_stats, error)
ASSERT( error%is_success() )
ASSERT_EQ(solver_state%get_char_array(), "Converged")

! solve by passing C pointers
call micm%solve(time_step, c_loc(temperature), c_loc(pressure), c_loc(air_density), &
c_loc(concentrations_c_ptrs), c_loc(user_defined_reaction_rates), &
call micm%solve(time_step, c_loc(temperature_c_ptrs), c_loc(pressure_c_ptrs), &
c_loc(air_density_c_ptrs), c_loc(concentrations_c_ptrs), &
c_loc(user_defined_reaction_rates_c_ptrs), &
solver_state, solver_stats, error)
ASSERT( error%is_success() )
ASSERT_EQ(solver_state%get_char_array(), "Converged")

! check concentrations
do i_cell = 1, NUM_GRID_CELLS
ASSERT_EQ(concentrations(i_cell,A_index), concentrations_c_ptrs(i_cell,A_index))
ASSERT_EQ(concentrations(i_cell,B_index), concentrations_c_ptrs(i_cell,B_index))
ASSERT_EQ(concentrations(i_cell,C_index), concentrations_c_ptrs(i_cell,C_index))
ASSERT_EQ(concentrations(i_cell,D_index), concentrations_c_ptrs(i_cell,D_index))
ASSERT_EQ(concentrations(i_cell,E_index), concentrations_c_ptrs(i_cell,E_index))
ASSERT_EQ(concentrations(i_cell,F_index), concentrations_c_ptrs(i_cell,F_index))
ASSERT_EQ(concentrations(2,i_cell,A_index), concentrations_c_ptrs(i_cell,A_index))
ASSERT_EQ(concentrations(2,i_cell,B_index), concentrations_c_ptrs(i_cell,B_index))
ASSERT_EQ(concentrations(2,i_cell,C_index), concentrations_c_ptrs(i_cell,C_index))
ASSERT_EQ(concentrations(2,i_cell,D_index), concentrations_c_ptrs(i_cell,D_index))
ASSERT_EQ(concentrations(2,i_cell,E_index), concentrations_c_ptrs(i_cell,E_index))
ASSERT_EQ(concentrations(2,i_cell,F_index), concentrations_c_ptrs(i_cell,F_index))
end do

r1%A_ = 0.004
Expand All @@ -277,26 +293,26 @@ subroutine test_vector_multiple_grid_cells(micm, NUM_GRID_CELLS, time_step, test
r2%E_ = 1.0e-6

do i_cell = 1, NUM_GRID_CELLS
initial_A = initial_concentrations(i_cell,A_index)
initial_C = initial_concentrations(i_cell,C_index)
initial_D = initial_concentrations(i_cell,D_index)
initial_F = initial_concentrations(i_cell,F_index)
k1 = user_defined_reaction_rates(i_cell,R1_index)
k2 = user_defined_reaction_rates(i_cell,R2_index)
k3 = calculate_arrhenius( r1, temperature(i_cell), pressure(i_cell) )
k4 = calculate_arrhenius( r2, temperature(i_cell), pressure(i_cell) )
initial_A = initial_concentrations(2,i_cell,A_index)
initial_C = initial_concentrations(2,i_cell,C_index)
initial_D = initial_concentrations(2,i_cell,D_index)
initial_F = initial_concentrations(2,i_cell,F_index)
k1 = user_defined_reaction_rates(2,i_cell,R1_index)
k2 = user_defined_reaction_rates(2,i_cell,R2_index)
k3 = calculate_arrhenius( r1, temperature(2,i_cell), pressure(2,i_cell) )
k4 = calculate_arrhenius( r2, temperature(2,i_cell), pressure(2,i_cell) )
A = initial_A * exp( -k3 * time_step )
B = initial_A * (k3 / (k4 - k3)) * (exp(-k3 * time_step) - exp(-k4 * time_step))
C = initial_C + initial_A * (1.0 + (k3 * exp(-k4 * time_step) - k4 * exp(-k3 * time_step)) / (k4 - k3))
D = initial_D * exp( -k1 * time_step )
E = initial_D * (k1 / (k2 - k1)) * (exp(-k1 * time_step) - exp(-k2 * time_step))
F = initial_F + initial_D * (1.0 + (k1 * exp(-k2 * time_step) - k2 * exp(-k1 * time_step)) / (k2 - k1))
ASSERT_NEAR(concentrations(i_cell,A_index), A, test_accuracy)
ASSERT_NEAR(concentrations(i_cell,B_index), B, test_accuracy)
ASSERT_NEAR(concentrations(i_cell,C_index), C, test_accuracy)
ASSERT_NEAR(concentrations(i_cell,D_index), D, test_accuracy)
ASSERT_NEAR(concentrations(i_cell,E_index), E, test_accuracy)
ASSERT_NEAR(concentrations(i_cell,F_index), F, test_accuracy)
ASSERT_NEAR(concentrations(2,i_cell,A_index), A, test_accuracy)
ASSERT_NEAR(concentrations(2,i_cell,B_index), B, test_accuracy)
ASSERT_NEAR(concentrations(2,i_cell,C_index), C, test_accuracy)
ASSERT_NEAR(concentrations(2,i_cell,D_index), D, test_accuracy)
ASSERT_NEAR(concentrations(2,i_cell,E_index), E, test_accuracy)
ASSERT_NEAR(concentrations(2,i_cell,F_index), F, test_accuracy)
end do

end subroutine test_vector_multiple_grid_cells
Expand Down
Loading
Loading