From f6f2c8301fc550f7df54e680348804bc5b380d14 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 6 Nov 2024 09:47:45 -0800 Subject: [PATCH] add tests with array slices and fix intents --- .../test_micm_api.F90 | 102 ++-- .../test_tuvx_api.F90 | 500 +++++++++--------- fortran/tuvx/grid.F90 | 10 +- fortran/tuvx/profile.F90 | 14 +- fortran/tuvx/radiator.F90 | 12 +- 5 files changed, 328 insertions(+), 310 deletions(-) diff --git a/fortran/test/fetch_content_integration/test_micm_api.F90 b/fortran/test/fetch_content_integration/test_micm_api.F90 index 7168f853..87d1a909 100644 --- a/fortran/test/fetch_content_integration/test_micm_api.F90 +++ b/fortran/test/fetch_content_integration/test_micm_api.F90 @@ -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 @@ -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 @@ -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 diff --git a/fortran/test/fetch_content_integration/test_tuvx_api.F90 b/fortran/test/fetch_content_integration/test_tuvx_api.F90 index a8e91432..a5e660c7 100644 --- a/fortran/test/fetch_content_integration/test_tuvx_api.F90 +++ b/fortran/test/fetch_content_integration/test_tuvx_api.F90 @@ -78,36 +78,38 @@ end subroutine test_tuvx_api_invalid_config subroutine test_tuvx_solve() - type(tuvx_t), pointer :: tuvx - type(error_t) :: error - character(len=256) :: config_path - type(grid_map_t), pointer :: grids, grids_from_host - type(grid_t), pointer :: grid, height_grid, wavelength_grid - type(profile_map_t), pointer :: profiles, profiles_from_host - type(profile_t), pointer :: profile, profile_copy - type(radiator_map_t), pointer :: radiators, radiators_from_host - type(radiator_t), pointer :: radiator, radiator_copy - real*8, dimension(5), target :: edges, edge_values, temp_edge - real*8, dimension(4), target :: midpoints, midpoint_values, layer_densities, temp_midpoint - real*8 :: temp_real - integer :: num_vertical_layers, num_wavelength_bins - real*8, dimension(3,2), target :: optical_depths, temp_od - real*8, dimension(3,2), target :: single_scattering_albedos, temp_ssa - real*8, dimension(3,2,1), target :: asymmetry_factors, temp_asym - - edges = (/ 1.0, 2.0, 3.0, 4.0, 5.0 /) - midpoints = (/ 15.0, 25.0, 35.0, 45.0 /) - edge_values = (/ 10.0, 20.0, 30.0, 40.0, 50.0 /) - midpoint_values = (/ 15.0, 25.0, 35.0, 45.0 /) - layer_densities = (/ 2.0, 4.0, 1.0, 7.0 /) + type(tuvx_t), pointer :: tuvx + type(error_t) :: error + character(len=256) :: config_path + type(grid_map_t), pointer :: grids, grids_from_host + type(grid_t), pointer :: grid, height_grid, wavelength_grid + type(profile_map_t), pointer :: profiles, profiles_from_host + type(profile_t), pointer :: profile, profile_copy + type(radiator_map_t), pointer :: radiators, radiators_from_host + type(radiator_t), pointer :: radiator, radiator_copy + ! set up arrays with extra dimensions to test whether arrays passed to + ! c functions are contiguous + real*8, dimension(3,5), target :: edges, edge_values, temp_edge + real*8, dimension(2,4), target :: midpoints, midpoint_values, layer_densities, temp_midpoint + real*8 :: temp_real + integer :: num_vertical_layers, num_wavelength_bins + real*8, dimension(4,3,2), target :: optical_depths, temp_od + real*8, dimension(3,3,2), target :: single_scattering_albedos, temp_ssa + real*8, dimension(2,3,2,1), target :: asymmetry_factors, temp_asym + + edges(2,:) = (/ 1.0, 2.0, 3.0, 4.0, 5.0 /) + midpoints(2,:) = (/ 15.0, 25.0, 35.0, 45.0 /) + edge_values(2,:) = (/ 10.0, 20.0, 30.0, 40.0, 50.0 /) + midpoint_values(2,:) = (/ 15.0, 25.0, 35.0, 45.0 /) + layer_densities(2,:) = (/ 2.0, 4.0, 1.0, 7.0 /) num_vertical_layers = 3 num_wavelength_bins = 2 - optical_depths(:,1) = (/ 30.0, 20.0, 10.0 /) - optical_depths(:,2) = (/ 70.0, 80.0, 90.0 /) - single_scattering_albedos(:,1) = (/ 300.0, 200.0, 100.0 /) - single_scattering_albedos(:,2) = (/ 700.0, 800.0, 900.0 /) - asymmetry_factors(:,1,1) = (/ 3.0, 2.0, 1.0 /) - asymmetry_factors(:,2,1) = (/ 7.0, 8.0, 9.0 /) + optical_depths(2,:,1) = (/ 30.0, 20.0, 10.0 /) + optical_depths(2,:,2) = (/ 70.0, 80.0, 90.0 /) + single_scattering_albedos(2,:,1) = (/ 300.0, 200.0, 100.0 /) + single_scattering_albedos(2,:,2) = (/ 700.0, 800.0, 900.0 /) + asymmetry_factors(2,:,1,1) = (/ 3.0, 2.0, 1.0 /) + asymmetry_factors(2,:,2,1) = (/ 7.0, 8.0, 9.0 /) config_path = "examples/ts1_tsmlt.json" @@ -137,132 +139,132 @@ subroutine test_tuvx_solve() ASSERT_EQ( grid%number_of_sections( error ), 4 ) ASSERT( error%is_success() ) - call grid%set_edges( edges, error ) + call grid%set_edges( edges(2,:), error ) ASSERT( error%is_success() ) - call grid%get_edges( temp_edge, error ) + call grid%get_edges( temp_edge(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_edge(1), 1.0 ) - ASSERT_EQ( temp_edge(2), 2.0 ) - ASSERT_EQ( temp_edge(3), 3.0 ) - ASSERT_EQ( temp_edge(4), 4.0 ) - ASSERT_EQ( temp_edge(5), 5.0 ) + ASSERT_EQ( temp_edge(2,1), 1.0 ) + ASSERT_EQ( temp_edge(2,2), 2.0 ) + ASSERT_EQ( temp_edge(2,3), 3.0 ) + ASSERT_EQ( temp_edge(2,4), 4.0 ) + ASSERT_EQ( temp_edge(2,5), 5.0 ) - edges = (/ 10.0, 20.0, 30.0, 40.0, 50.0 /) + edges(2,:) = (/ 10.0, 20.0, 30.0, 40.0, 50.0 /) - call grid%set_edges( edges, error ) + call grid%set_edges( edges(2,:), error ) ASSERT( error%is_success() ) - call grid%set_midpoints( midpoints, error ) + call grid%set_midpoints( midpoints(2,:), error ) ASSERT( error%is_success() ) - call grid%get_edges( temp_edge, error ) + call grid%get_edges( temp_edge(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_edge(1), 10.0 ) - ASSERT_EQ( temp_edge(2), 20.0 ) - ASSERT_EQ( temp_edge(3), 30.0 ) - ASSERT_EQ( temp_edge(4), 40.0 ) - ASSERT_EQ( temp_edge(5), 50.0 ) + ASSERT_EQ( temp_edge(2,1), 10.0 ) + ASSERT_EQ( temp_edge(2,2), 20.0 ) + ASSERT_EQ( temp_edge(2,3), 30.0 ) + ASSERT_EQ( temp_edge(2,4), 40.0 ) + ASSERT_EQ( temp_edge(2,5), 50.0 ) - call grid%get_midpoints( temp_midpoint, error ) + call grid%get_midpoints( temp_midpoint(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_midpoint(1), 15.0 ) - ASSERT_EQ( temp_midpoint(2), 25.0 ) - ASSERT_EQ( temp_midpoint(3), 35.0 ) - ASSERT_EQ( temp_midpoint(4), 45.0 ) + ASSERT_EQ( temp_midpoint(2,1), 15.0 ) + ASSERT_EQ( temp_midpoint(2,2), 25.0 ) + ASSERT_EQ( temp_midpoint(2,3), 35.0 ) + ASSERT_EQ( temp_midpoint(2,4), 45.0 ) call grids%add( grid, error ) - edges(:) = 0.0 - midpoints(:) = 0.0 + edges(2,:) = 0.0 + midpoints(2,:) = 0.0 - call grid%get_edges( edges, error ) + call grid%get_edges( edges(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( edges(1), 10.0 ) - ASSERT_EQ( edges(2), 20.0 ) - ASSERT_EQ( edges(3), 30.0 ) - ASSERT_EQ( edges(4), 40.0 ) - ASSERT_EQ( edges(5), 50.0 ) + ASSERT_EQ( edges(2,1), 10.0 ) + ASSERT_EQ( edges(2,2), 20.0 ) + ASSERT_EQ( edges(2,3), 30.0 ) + ASSERT_EQ( edges(2,4), 40.0 ) + ASSERT_EQ( edges(2,5), 50.0 ) - call grid%get_midpoints( midpoints, error ) + call grid%get_midpoints( midpoints(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( midpoints(1), 15.0 ) - ASSERT_EQ( midpoints(2), 25.0 ) - ASSERT_EQ( midpoints(3), 35.0 ) - ASSERT_EQ( midpoints(4), 45.0 ) + ASSERT_EQ( midpoints(2,1), 15.0 ) + ASSERT_EQ( midpoints(2,2), 25.0 ) + ASSERT_EQ( midpoints(2,3), 35.0 ) + ASSERT_EQ( midpoints(2,4), 45.0 ) - edges = (/ 1.0, 2.0, 3.0, 4.0, 5.0 /) - midpoints = (/ 1.5, 2.5, 3.5, 4.5 /) + edges(2,:) = (/ 1.0, 2.0, 3.0, 4.0, 5.0 /) + midpoints(2,:) = (/ 1.5, 2.5, 3.5, 4.5 /) - call grid%set_edges( edges, error ) + call grid%set_edges( edges(2,:), error ) ASSERT( error%is_success() ) - call grid%set_midpoints( midpoints, error ) + call grid%set_midpoints( midpoints(2,:), error ) ASSERT( error%is_success() ) - edges(:) = 0.0 - midpoints(:) = 0.0 + edges(2,:) = 0.0 + midpoints(2,:) = 0.0 - call grid%get_edges( edges, error ) + call grid%get_edges( edges(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( edges(1), 1.0 ) - ASSERT_EQ( edges(2), 2.0 ) - ASSERT_EQ( edges(3), 3.0 ) - ASSERT_EQ( edges(4), 4.0 ) - ASSERT_EQ( edges(5), 5.0 ) + ASSERT_EQ( edges(2,1), 1.0 ) + ASSERT_EQ( edges(2,2), 2.0 ) + ASSERT_EQ( edges(2,3), 3.0 ) + ASSERT_EQ( edges(2,4), 4.0 ) + ASSERT_EQ( edges(2,5), 5.0 ) - call grid%get_midpoints( midpoints, error ) + call grid%get_midpoints( midpoints(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( midpoints(1), 1.5 ) - ASSERT_EQ( midpoints(2), 2.5 ) - ASSERT_EQ( midpoints(3), 3.5 ) - ASSERT_EQ( midpoints(4), 4.5 ) + ASSERT_EQ( midpoints(2,1), 1.5 ) + ASSERT_EQ( midpoints(2,2), 2.5 ) + ASSERT_EQ( midpoints(2,3), 3.5 ) + ASSERT_EQ( midpoints(2,4), 4.5 ) deallocate( grid ) grid => grids%get( "foo", "bars", error ) ASSERT( error%is_success() ) - edges(:) = 0.0 - midpoints(:) = 0.0 + edges(2,:) = 0.0 + midpoints(2,:) = 0.0 - call grid%get_edges( edges, error ) + call grid%get_edges( edges(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( edges(1), 1.0 ) - ASSERT_EQ( edges(2), 2.0 ) - ASSERT_EQ( edges(3), 3.0 ) - ASSERT_EQ( edges(4), 4.0 ) - ASSERT_EQ( edges(5), 5.0 ) + ASSERT_EQ( edges(2,1), 1.0 ) + ASSERT_EQ( edges(2,2), 2.0 ) + ASSERT_EQ( edges(2,3), 3.0 ) + ASSERT_EQ( edges(2,4), 4.0 ) + ASSERT_EQ( edges(2,5), 5.0 ) - call grid%get_midpoints( midpoints, error ) + call grid%get_midpoints( midpoints(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( midpoints(1), 1.5 ) - ASSERT_EQ( midpoints(2), 2.5 ) - ASSERT_EQ( midpoints(3), 3.5 ) - ASSERT_EQ( midpoints(4), 4.5 ) + ASSERT_EQ( midpoints(2,1), 1.5 ) + ASSERT_EQ( midpoints(2,2), 2.5 ) + ASSERT_EQ( midpoints(2,3), 3.5 ) + ASSERT_EQ( midpoints(2,4), 4.5 ) - edges = (/ 10.0, 20.0, 30.0, 40.0, 50.0 /) - midpoints = (/ 15.0, 25.0, 35.0, 45.0 /) + edges(2,:) = (/ 10.0, 20.0, 30.0, 40.0, 50.0 /) + midpoints(2,:) = (/ 15.0, 25.0, 35.0, 45.0 /) - call grid%set_edges( edges, error ) - call grid%set_midpoints( midpoints, error ) + call grid%set_edges( edges(2,:), error ) + call grid%set_midpoints( midpoints(2,:), error ) ASSERT( error%is_success() ) - edges(:) = 0.0 - midpoints(:) = 0.0 + edges(2,:) = 0.0 + midpoints(2,:) = 0.0 - call grid%get_edges( edges, error ) + call grid%get_edges( edges(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( edges(1), 10.0 ) - ASSERT_EQ( edges(2), 20.0 ) - ASSERT_EQ( edges(3), 30.0 ) - ASSERT_EQ( edges(4), 40.0 ) - ASSERT_EQ( edges(5), 50.0 ) + ASSERT_EQ( edges(2,1), 10.0 ) + ASSERT_EQ( edges(2,2), 20.0 ) + ASSERT_EQ( edges(2,3), 30.0 ) + ASSERT_EQ( edges(2,4), 40.0 ) + ASSERT_EQ( edges(2,5), 50.0 ) - call grid%get_midpoints( midpoints, error ) + call grid%get_midpoints( midpoints(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( midpoints(1), 15.0 ) - ASSERT_EQ( midpoints(2), 25.0 ) - ASSERT_EQ( midpoints(3), 35.0 ) - ASSERT_EQ( midpoints(4), 45.0 ) + ASSERT_EQ( midpoints(2,1), 15.0 ) + ASSERT_EQ( midpoints(2,2), 25.0 ) + ASSERT_EQ( midpoints(2,3), 35.0 ) + ASSERT_EQ( midpoints(2,4), 45.0 ) profiles => tuvx%get_profiles( error ) ASSERT( error%is_success() ) @@ -278,36 +280,36 @@ subroutine test_tuvx_solve() profile => profile_t( "baz", "qux", grid, error ) ASSERT( error%is_success() ) - call profile%set_edge_values( edge_values, error ) + call profile%set_edge_values( edge_values(2,:), error ) ASSERT( error%is_success() ) - call profile%get_edge_values( temp_edge, error ) + call profile%get_edge_values( temp_edge(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_edge(1), 10.0 ) - ASSERT_EQ( temp_edge(2), 20.0 ) - ASSERT_EQ( temp_edge(3), 30.0 ) - ASSERT_EQ( temp_edge(4), 40.0 ) - ASSERT_EQ( temp_edge(5), 50.0 ) + ASSERT_EQ( temp_edge(2,1), 10.0 ) + ASSERT_EQ( temp_edge(2,2), 20.0 ) + ASSERT_EQ( temp_edge(2,3), 30.0 ) + ASSERT_EQ( temp_edge(2,4), 40.0 ) + ASSERT_EQ( temp_edge(2,5), 50.0 ) - call profile%set_midpoint_values( midpoint_values, error ) + call profile%set_midpoint_values( midpoint_values(2,:), error ) ASSERT( error%is_success() ) - call profile%get_midpoint_values( temp_midpoint, error ) + call profile%get_midpoint_values( temp_midpoint(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_midpoint(1), 15.0 ) - ASSERT_EQ( temp_midpoint(2), 25.0 ) - ASSERT_EQ( temp_midpoint(3), 35.0 ) - ASSERT_EQ( temp_midpoint(4), 45.0 ) + ASSERT_EQ( temp_midpoint(2,1), 15.0 ) + ASSERT_EQ( temp_midpoint(2,2), 25.0 ) + ASSERT_EQ( temp_midpoint(2,3), 35.0 ) + ASSERT_EQ( temp_midpoint(2,4), 45.0 ) - call profile%set_layer_densities( layer_densities, error ) + call profile%set_layer_densities( layer_densities(2,:), error ) ASSERT( error%is_success() ) - call profile%get_layer_densities( temp_midpoint, error ) + call profile%get_layer_densities( temp_midpoint(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_midpoint(1), 2.0 ) - ASSERT_EQ( temp_midpoint(2), 4.0 ) - ASSERT_EQ( temp_midpoint(3), 1.0 ) - ASSERT_EQ( temp_midpoint(4), 7.0 ) + ASSERT_EQ( temp_midpoint(2,1), 2.0 ) + ASSERT_EQ( temp_midpoint(2,2), 4.0 ) + ASSERT_EQ( temp_midpoint(2,3), 1.0 ) + ASSERT_EQ( temp_midpoint(2,4), 7.0 ) call profile%set_exo_layer_density( 1.0d0, error ) ASSERT( error%is_success() ) @@ -316,12 +318,12 @@ subroutine test_tuvx_solve() ASSERT( error%is_success() ) ASSERT_EQ( temp_real, 1.0 ) - call profile%get_layer_densities( temp_midpoint, error ) + call profile%get_layer_densities( temp_midpoint(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_midpoint(1), 2.0 ) - ASSERT_EQ( temp_midpoint(2), 4.0 ) - ASSERT_EQ( temp_midpoint(3), 1.0 ) - ASSERT_EQ( temp_midpoint(4), 7.0 + 1.0 ) + ASSERT_EQ( temp_midpoint(2,1), 2.0 ) + ASSERT_EQ( temp_midpoint(2,2), 4.0 ) + ASSERT_EQ( temp_midpoint(2,3), 1.0 ) + ASSERT_EQ( temp_midpoint(2,4), 7.0 + 1.0 ) call profile%calculate_exo_layer_density( 10.0d0, error ) ASSERT( error%is_success() ) @@ -331,34 +333,34 @@ subroutine test_tuvx_solve() ! Revisit this after non-SI units are converted in the TUV-x internal functions ASSERT_EQ( temp_real, 10.0 * 7.0 * 100.0 ) - call profile%get_layer_densities( temp_midpoint, error ) + call profile%get_layer_densities( temp_midpoint(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_midpoint(1), 2.0 ) - ASSERT_EQ( temp_midpoint(2), 4.0 ) - ASSERT_EQ( temp_midpoint(3), 1.0 ) - ASSERT_EQ( temp_midpoint(4), 7.0 + 10.0 * 7.0 * 100.0 ) + ASSERT_EQ( temp_midpoint(2,1), 2.0 ) + ASSERT_EQ( temp_midpoint(2,2), 4.0 ) + ASSERT_EQ( temp_midpoint(2,3), 1.0 ) + ASSERT_EQ( temp_midpoint(2,4), 7.0 + 10.0 * 7.0 * 100.0 ) call profiles%add( profile, error ) profile_copy => profiles%get( "baz", "qux", error ) - call profile_copy%get_edge_values( temp_edge, error ) + call profile_copy%get_edge_values( temp_edge(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_edge(1), 10.0 ) - ASSERT_EQ( temp_edge(2), 20.0 ) - ASSERT_EQ( temp_edge(3), 30.0 ) - ASSERT_EQ( temp_edge(4), 40.0 ) - ASSERT_EQ( temp_edge(5), 50.0 ) + ASSERT_EQ( temp_edge(2,1), 10.0 ) + ASSERT_EQ( temp_edge(2,2), 20.0 ) + ASSERT_EQ( temp_edge(2,3), 30.0 ) + ASSERT_EQ( temp_edge(2,4), 40.0 ) + ASSERT_EQ( temp_edge(2,5), 50.0 ) - edge_values = (/ 32.0, 34.0, 36.0, 38.0, 40.0 /) - call profile_copy%set_edge_values( edge_values, error ) + edge_values(2,:) = (/ 32.0, 34.0, 36.0, 38.0, 40.0 /) + call profile_copy%set_edge_values( edge_values(2,:), error ) - call profile%get_edge_values( temp_edge, error ) + call profile%get_edge_values( temp_edge(2,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_edge(1), 32.0 ) - ASSERT_EQ( temp_edge(2), 34.0 ) - ASSERT_EQ( temp_edge(3), 36.0 ) - ASSERT_EQ( temp_edge(4), 38.0 ) - ASSERT_EQ( temp_edge(5), 40.0 ) + ASSERT_EQ( temp_edge(2,1), 32.0 ) + ASSERT_EQ( temp_edge(2,2), 34.0 ) + ASSERT_EQ( temp_edge(2,3), 36.0 ) + ASSERT_EQ( temp_edge(2,4), 38.0 ) + ASSERT_EQ( temp_edge(2,5), 40.0 ) radiators => tuvx%get_radiators( error ) ASSERT( error%is_success() ) @@ -376,118 +378,118 @@ subroutine test_tuvx_solve() radiator => radiator_t( "foo_radiator", height_grid, wavelength_grid, error ) ASSERT( error%is_success() ) - call radiator%set_optical_depths( optical_depths, error ) + call radiator%set_optical_depths( optical_depths(2,:,:), error ) ASSERT( error%is_success() ) - call radiator%get_optical_depths( temp_od, error ) + call radiator%get_optical_depths( temp_od(2,:,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_od(1,1), 30.0 ) - ASSERT_EQ( temp_od(2,1), 20.0 ) - ASSERT_EQ( temp_od(3,1), 10.0 ) - ASSERT_EQ( temp_od(1,2), 70.0 ) - ASSERT_EQ( temp_od(2,2), 80.0 ) - ASSERT_EQ( temp_od(3,2), 90.0 ) + ASSERT_EQ( temp_od(2,1,1), 30.0 ) + ASSERT_EQ( temp_od(2,2,1), 20.0 ) + ASSERT_EQ( temp_od(2,3,1), 10.0 ) + ASSERT_EQ( temp_od(2,1,2), 70.0 ) + ASSERT_EQ( temp_od(2,2,2), 80.0 ) + ASSERT_EQ( temp_od(2,3,2), 90.0 ) - call radiator%set_single_scattering_albedos( single_scattering_albedos, error ) + call radiator%set_single_scattering_albedos( single_scattering_albedos(2,:,:), error ) ASSERT( error%is_success() ) - call radiator%get_single_scattering_albedos( temp_ssa, error ) + call radiator%get_single_scattering_albedos( temp_ssa(2,:,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_ssa(1,1), 300.0 ) - ASSERT_EQ( temp_ssa(2,1), 200.0 ) - ASSERT_EQ( temp_ssa(3,1), 100.0 ) - ASSERT_EQ( temp_ssa(1,2), 700.0 ) - ASSERT_EQ( temp_ssa(2,2), 800.0 ) - ASSERT_EQ( temp_ssa(3,2), 900.0 ) + ASSERT_EQ( temp_ssa(2,1,1), 300.0 ) + ASSERT_EQ( temp_ssa(2,2,1), 200.0 ) + ASSERT_EQ( temp_ssa(2,3,1), 100.0 ) + ASSERT_EQ( temp_ssa(2,1,2), 700.0 ) + ASSERT_EQ( temp_ssa(2,2,2), 800.0 ) + ASSERT_EQ( temp_ssa(2,3,2), 900.0 ) - call radiator%set_asymmetry_factors( asymmetry_factors, error ) + call radiator%set_asymmetry_factors( asymmetry_factors(2,:,:,:), error ) ASSERT( error%is_success() ) - call radiator%get_asymmetry_factors( temp_asym, error ) + call radiator%get_asymmetry_factors( temp_asym(2,:,:,:), error ) ASSERT( error%is_success() ) - ASSERT_EQ( temp_asym(1,1,1), 3.0 ) - ASSERT_EQ( temp_asym(2,1,1), 2.0 ) - ASSERT_EQ( temp_asym(3,1,1), 1.0 ) - ASSERT_EQ( temp_asym(1,2,1), 7.0 ) - ASSERT_EQ( temp_asym(2,2,1), 8.0 ) - ASSERT_EQ( temp_asym(3,2,1), 9.0 ) + ASSERT_EQ( temp_asym(2,1,1,1), 3.0 ) + ASSERT_EQ( temp_asym(2,2,1,1), 2.0 ) + ASSERT_EQ( temp_asym(2,3,1,1), 1.0 ) + ASSERT_EQ( temp_asym(2,1,2,1), 7.0 ) + ASSERT_EQ( temp_asym(2,2,2,1), 8.0 ) + ASSERT_EQ( temp_asym(2,3,2,1), 9.0 ) ! call radiators%add( radiator, error ) radiator_copy => radiators%get( "foo_radiator", error ) - optical_depths(:,:) = 0.0 - single_scattering_albedos(:,:) = 0.0 - asymmetry_factors(:,:,:) = 0.0 - - call radiator_copy%get_optical_depths( optical_depths, error ) - ASSERT( error%is_success() ) - ASSERT_EQ( optical_depths(1,1), 30.0 ) - ASSERT_EQ( optical_depths(2,1), 20.0 ) - ASSERT_EQ( optical_depths(3,1), 10.0 ) - ASSERT_EQ( optical_depths(1,2), 70.0 ) - ASSERT_EQ( optical_depths(2,2), 80.0 ) - ASSERT_EQ( optical_depths(3,2), 90.0 ) - - call radiator_copy%get_single_scattering_albedos( single_scattering_albedos, error ) - ASSERT( error%is_success() ) - ASSERT_EQ( single_scattering_albedos(1,1), 300.0 ) - ASSERT_EQ( single_scattering_albedos(2,1), 200.0 ) - ASSERT_EQ( single_scattering_albedos(3,1), 100.0 ) - ASSERT_EQ( single_scattering_albedos(1,2), 700.0 ) - ASSERT_EQ( single_scattering_albedos(2,2), 800.0 ) - ASSERT_EQ( single_scattering_albedos(3,2), 900.0 ) - - call radiator_copy%get_asymmetry_factors( asymmetry_factors, error ) - ASSERT( error%is_success() ) - ASSERT_EQ( asymmetry_factors(1,1,1), 3.0 ) - ASSERT_EQ( asymmetry_factors(2,1,1), 2.0 ) - ASSERT_EQ( asymmetry_factors(3,1,1), 1.0 ) - ASSERT_EQ( asymmetry_factors(1,2,1), 7.0 ) - ASSERT_EQ( asymmetry_factors(2,2,1), 8.0 ) - ASSERT_EQ( asymmetry_factors(3,2,1), 9.0 ) - - optical_depths(:,1) = (/ 90.0, 80.0, 70.0 /) - optical_depths(:,2) = (/ 75.0, 85.0, 95.0 /) - single_scattering_albedos(:,1) = (/ 900.0, 800.0, 700.0 /) - single_scattering_albedos(:,2) = (/ 750.0, 850.0, 950.0 /) - asymmetry_factors(:,1,1) = (/ 9.0, 8.0, 7.0 /) - asymmetry_factors(:,2,1) = (/ 5.0, 4.0, 3.0 /) - - call radiator_copy%set_optical_depths( optical_depths, error ) - call radiator_copy%set_single_scattering_albedos( single_scattering_albedos, error ) - call radiator_copy%set_asymmetry_factors( asymmetry_factors, error ) - ASSERT( error%is_success() ) - - optical_depths(:,:) = 0.0 - single_scattering_albedos(:,:) = 0.0 - asymmetry_factors(:,:,:) = 0.0 - - call radiator%get_optical_depths( optical_depths, error ) - ASSERT( error%is_success() ) - ASSERT_EQ( optical_depths(1,1), 90.0 ) - ASSERT_EQ( optical_depths(2,1), 80.0 ) - ASSERT_EQ( optical_depths(3,1), 70.0 ) - ASSERT_EQ( optical_depths(1,2), 75.0 ) - ASSERT_EQ( optical_depths(2,2), 85.0 ) - ASSERT_EQ( optical_depths(3,2), 95.0 ) - - call radiator%get_single_scattering_albedos( single_scattering_albedos, error ) - ASSERT( error%is_success() ) - ASSERT_EQ( single_scattering_albedos(1,1), 900.0 ) - ASSERT_EQ( single_scattering_albedos(2,1), 800.0 ) - ASSERT_EQ( single_scattering_albedos(3,1), 700.0 ) - ASSERT_EQ( single_scattering_albedos(1,2), 750.0 ) - ASSERT_EQ( single_scattering_albedos(2,2), 850.0 ) - ASSERT_EQ( single_scattering_albedos(3,2), 950.0 ) - - call radiator%get_asymmetry_factors( asymmetry_factors, error ) - ASSERT( error%is_success() ) - ASSERT_EQ( asymmetry_factors(1,1,1), 9.0 ) - ASSERT_EQ( asymmetry_factors(2,1,1), 8.0 ) - ASSERT_EQ( asymmetry_factors(3,1,1), 7.0 ) - ASSERT_EQ( asymmetry_factors(1,2,1), 5.0 ) - ASSERT_EQ( asymmetry_factors(2,2,1), 4.0 ) - ASSERT_EQ( asymmetry_factors(3,2,1), 3.0 ) + optical_depths(2,:,:) = 0.0 + single_scattering_albedos(2,:,:) = 0.0 + asymmetry_factors(2,:,:,:) = 0.0 + + call radiator_copy%get_optical_depths( optical_depths(2,:,:), error ) + ASSERT( error%is_success() ) + ASSERT_EQ( optical_depths(2,1,1), 30.0 ) + ASSERT_EQ( optical_depths(2,2,1), 20.0 ) + ASSERT_EQ( optical_depths(2,3,1), 10.0 ) + ASSERT_EQ( optical_depths(2,1,2), 70.0 ) + ASSERT_EQ( optical_depths(2,2,2), 80.0 ) + ASSERT_EQ( optical_depths(2,3,2), 90.0 ) + + call radiator_copy%get_single_scattering_albedos( single_scattering_albedos(2,:,:), error ) + ASSERT( error%is_success() ) + ASSERT_EQ( single_scattering_albedos(2,1,1), 300.0 ) + ASSERT_EQ( single_scattering_albedos(2,2,1), 200.0 ) + ASSERT_EQ( single_scattering_albedos(2,3,1), 100.0 ) + ASSERT_EQ( single_scattering_albedos(2,1,2), 700.0 ) + ASSERT_EQ( single_scattering_albedos(2,2,2), 800.0 ) + ASSERT_EQ( single_scattering_albedos(2,3,2), 900.0 ) + + call radiator_copy%get_asymmetry_factors( asymmetry_factors(2,:,:,:), error ) + ASSERT( error%is_success() ) + ASSERT_EQ( asymmetry_factors(2,1,1,1), 3.0 ) + ASSERT_EQ( asymmetry_factors(2,2,1,1), 2.0 ) + ASSERT_EQ( asymmetry_factors(2,3,1,1), 1.0 ) + ASSERT_EQ( asymmetry_factors(2,1,2,1), 7.0 ) + ASSERT_EQ( asymmetry_factors(2,2,2,1), 8.0 ) + ASSERT_EQ( asymmetry_factors(2,3,2,1), 9.0 ) + + optical_depths(2,:,1) = (/ 90.0, 80.0, 70.0 /) + optical_depths(2,:,2) = (/ 75.0, 85.0, 95.0 /) + single_scattering_albedos(2,:,1) = (/ 900.0, 800.0, 700.0 /) + single_scattering_albedos(2,:,2) = (/ 750.0, 850.0, 950.0 /) + asymmetry_factors(2,:,1,1) = (/ 9.0, 8.0, 7.0 /) + asymmetry_factors(2,:,2,1) = (/ 5.0, 4.0, 3.0 /) + + call radiator_copy%set_optical_depths( optical_depths(2,:,:), error ) + call radiator_copy%set_single_scattering_albedos( single_scattering_albedos(2,:,:), error ) + call radiator_copy%set_asymmetry_factors( asymmetry_factors(2,:,:,:), error ) + ASSERT( error%is_success() ) + + optical_depths(:,:,:) = 0.0 + single_scattering_albedos(:,:,:) = 0.0 + asymmetry_factors(:,:,:,:) = 0.0 + + call radiator%get_optical_depths( optical_depths(2,:,:), error ) + ASSERT( error%is_success() ) + ASSERT_EQ( optical_depths(2,1,1), 90.0 ) + ASSERT_EQ( optical_depths(2,2,1), 80.0 ) + ASSERT_EQ( optical_depths(2,3,1), 70.0 ) + ASSERT_EQ( optical_depths(2,1,2), 75.0 ) + ASSERT_EQ( optical_depths(2,2,2), 85.0 ) + ASSERT_EQ( optical_depths(2,3,2), 95.0 ) + + call radiator%get_single_scattering_albedos( single_scattering_albedos(2,:,:), error ) + ASSERT( error%is_success() ) + ASSERT_EQ( single_scattering_albedos(2,1,1), 900.0 ) + ASSERT_EQ( single_scattering_albedos(2,2,1), 800.0 ) + ASSERT_EQ( single_scattering_albedos(2,3,1), 700.0 ) + ASSERT_EQ( single_scattering_albedos(2,1,2), 750.0 ) + ASSERT_EQ( single_scattering_albedos(2,2,2), 850.0 ) + ASSERT_EQ( single_scattering_albedos(2,3,2), 950.0 ) + + call radiator%get_asymmetry_factors( asymmetry_factors(2,:,:,:), error ) + ASSERT( error%is_success() ) + ASSERT_EQ( asymmetry_factors(2,1,1,1), 9.0 ) + ASSERT_EQ( asymmetry_factors(2,2,1,1), 8.0 ) + ASSERT_EQ( asymmetry_factors(2,3,1,1), 7.0 ) + ASSERT_EQ( asymmetry_factors(2,1,2,1), 5.0 ) + ASSERT_EQ( asymmetry_factors(2,2,2,1), 4.0 ) + ASSERT_EQ( asymmetry_factors(2,3,2,1), 3.0 ) deallocate( grid ) deallocate( grids ) diff --git a/fortran/tuvx/grid.F90 b/fortran/tuvx/grid.F90 index ddecf954..2311ff08 100644 --- a/fortran/tuvx/grid.F90 +++ b/fortran/tuvx/grid.F90 @@ -157,7 +157,7 @@ integer function number_of_sections(this, error) result( n_sections ) use musica_util, only: error_t, error_t_c ! Arguments - class(grid_t), intent(inout) :: this + class(grid_t), intent(in) :: this type(error_t), intent(inout) :: error ! Local variables @@ -197,8 +197,8 @@ subroutine get_edges(this, edges, error) use musica_util, only: error_t, error_t_c, dk => musica_dk ! Arguments - class(grid_t), intent(inout) :: this - real(dk), target, contiguous, intent(inout) :: edges(:) + class(grid_t), intent(in) :: this + real(dk), target, contiguous, intent(out) :: edges(:) type(error_t), intent(inout) :: error ! Local variables @@ -241,8 +241,8 @@ subroutine get_midpoints(this, midpoints, error) use musica_util, only: error_t, error_t_c, dk => musica_dk ! Arguments - class(grid_t), intent(inout) :: this - real(dk), target, contiguous, intent(inout) :: midpoints(:) + class(grid_t), intent(in) :: this + real(dk), target, contiguous, intent(out) :: midpoints(:) type(error_t), intent(inout) :: error ! Local variables diff --git a/fortran/tuvx/profile.F90 b/fortran/tuvx/profile.F90 index e246894c..15bf6bb3 100644 --- a/fortran/tuvx/profile.F90 +++ b/fortran/tuvx/profile.F90 @@ -228,8 +228,8 @@ subroutine get_edge_values(this, edge_values, error) use musica_util, only: error_t, error_t_c, dk => musica_dk ! Arguments - class(profile_t), intent(inout) :: this - real(dk), target, contiguous, intent(inout) :: edge_values(:) + class(profile_t), intent(in) :: this + real(dk), target, contiguous, intent(out) :: edge_values(:) type(error_t), intent(inout) :: error ! Local variables @@ -274,8 +274,8 @@ subroutine get_midpoint_values(this, midpoint_values, error) use musica_util, only: error_t, error_t_c, dk => musica_dk ! Arguments - class(profile_t), intent(inout) :: this - real(dk), target, contiguous, intent(inout) :: midpoint_values(:) + class(profile_t), intent(in) :: this + real(dk), target, contiguous, intent(out) :: midpoint_values(:) type(error_t), intent(inout) :: error ! Local variables @@ -320,8 +320,8 @@ subroutine get_layer_densities(this, layer_densities, error) use musica_util, only: error_t, error_t_c, dk => musica_dk ! Arguments - class(profile_t), intent(inout) :: this - real(dk), target, contiguous, intent(inout) :: layer_densities(:) + class(profile_t), intent(in) :: this + real(dk), target, contiguous, intent(out) :: layer_densities(:) type(error_t), intent(inout) :: error ! Local variables @@ -383,7 +383,7 @@ function get_exo_layer_density(this, error) result(exo_layer_density) use musica_util, only: error_t, error_t_c, dk => musica_dk ! Arguments - class(profile_t), intent(inout) :: this + class(profile_t), intent(in) :: this type(error_t), intent(inout) :: error ! Return value diff --git a/fortran/tuvx/radiator.F90 b/fortran/tuvx/radiator.F90 index 0238ca4f..9ebd0b27 100644 --- a/fortran/tuvx/radiator.F90 +++ b/fortran/tuvx/radiator.F90 @@ -207,8 +207,8 @@ subroutine get_optical_depths(this, optical_depths, error) use musica_util, only: error_t, error_t_c, dk => musica_dk ! Arguments - class(radiator_t), intent(inout) :: this - real(dk), target, contiguous, intent(in) :: optical_depths(:,:) + class(radiator_t), intent(in) :: this + real(dk), target, contiguous, intent(out) :: optical_depths(:,:) type(error_t), intent(inout) :: error ! Local variables @@ -260,8 +260,8 @@ subroutine get_single_scattering_albedos(this, single_scattering_albedos, & use musica_util, only: error_t, error_t_c, dk => musica_dk ! Arguments - class(radiator_t), intent(inout) :: this - real(dk), target, contiguous, intent(in) :: single_scattering_albedos(:,:) + class(radiator_t), intent(in) :: this + real(dk), target, contiguous, intent(out) :: single_scattering_albedos(:,:) type(error_t), intent(inout) :: error ! Local variables @@ -313,8 +313,8 @@ subroutine get_asymmetry_factors(this, asymmetry_factors, error) use musica_util, only: error_t, error_t_c, dk => musica_dk ! Arguments - class(radiator_t), intent(inout) :: this - real(dk), target, contiguous, intent(in) :: asymmetry_factors(:,:,:) + class(radiator_t), intent(in) :: this + real(dk), target, contiguous, intent(out) :: asymmetry_factors(:,:,:) type(error_t), intent(inout) :: error ! Local variables