diff --git a/schemes/musica/micm/musica_ccpp_micm.F90 b/schemes/musica/micm/musica_ccpp_micm.F90 index 1406115..b34ab96 100644 --- a/schemes/musica/micm/musica_ccpp_micm.F90 +++ b/schemes/musica/micm/musica_ccpp_micm.F90 @@ -16,8 +16,8 @@ module musica_ccpp_micm contains - !> Register MICM constituents with the CCPP - subroutine micm_register(solver_type, num_grid_cells, constituents, errmsg, errcode) + !> Register MICM constituent properties with the CCPP + subroutine micm_register(solver_type, num_grid_cells, constituent_props, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_micm, only: Rosenbrock, RosenbrockStandardOrder use musica_util, only: error_t @@ -25,26 +25,23 @@ subroutine micm_register(solver_type, num_grid_cells, constituents, errmsg, errc integer(c_int), intent(in) :: solver_type integer(c_int), intent(in) :: num_grid_cells - type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituents(:) + type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode ! local variables type(error_t) :: error real(kind=kind_phys) :: molar_mass - character(len=:), allocatable :: species_name !TODO(jiwon) test withouth allocatable + character(len=:), allocatable :: species_name logical :: is_advected integer :: i, species_index - errcode = 0 - errmsg = '' - micm => micm_t(filename_of_micm_configuration, solver_type, num_grid_cells, error) if (has_error_occurred(error, errmsg, errcode)) return - allocate(constituents(micm%species_ordering%size()), stat=errcode) + allocate(constituent_props(micm%species_ordering%size()), stat=errcode) if (errcode /= 0) then - errmsg = "[MUSICA Error] Failed to allocate memory for constituents." + errmsg = "[MUSICA Error] Failed to allocate memory for constituent properties." return end if @@ -62,7 +59,7 @@ subroutine micm_register(solver_type, num_grid_cells, constituents, errmsg, errc error) if (has_error_occurred(error, errmsg, errcode)) return - call constituents(species_index)%instantiate( & + call constituent_props(species_index)%instantiate( & std_name = species_name, & long_name = species_name, & units = 'kg kg-1', & @@ -84,8 +81,8 @@ subroutine micm_init(errmsg, errcode) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode - errcode = 0 errmsg = '' + errcode = 0 end subroutine micm_init @@ -112,8 +109,6 @@ subroutine micm_run(time_step, temperature, pressure, dry_air_density, & real(c_double) :: c_time_step integer :: i_elem - errcode = 0 - errmsg = '' c_time_step = real(time_step, c_double) call micm%solve(c_time_step, & @@ -134,8 +129,8 @@ subroutine micm_final(errmsg, errcode) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode - errcode = 0 errmsg = '' + errcode = 0 end subroutine micm_final diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index c0e0101..ab43e5c 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -36,17 +36,21 @@ subroutine tuvx_init(vertical_layer_dimension, & type(radiator_map_t), pointer :: radiators type(error_t) :: error - errcode = 0 - errmsg = '' - grids => grid_map_t( error ) if (has_error_occurred( error, errmsg, errcode )) return height_grid => create_height_grid( vertical_layer_dimension, & vertical_interface_dimension, errmsg, errcode ) - if (has_error_occurred( error, errmsg, errcode )) return + if (errcode /= 0) then + deallocate( grids ) + return + endif + call grids%add( height_grid, error ) - if (has_error_occurred( error, errmsg, errcode )) return + if (has_error_occurred( error, errmsg, errcode )) then + deallocate( grids ) + return + end if profiles => profile_map_t( error ) if (has_error_occurred( error, errmsg, errcode )) then @@ -116,22 +120,19 @@ subroutine tuvx_run( temperature, dry_air_density, & integer, intent(out) :: errcode ! local variables - type(error_t) :: error - real(kind_phys), dimension(size(geopotential_height_wrt_surface_at_midpoint, dim = 2)) :: height_midpoints + real(kind_phys), dimension(size(geopotential_height_wrt_surface_at_midpoint, dim = 2)) :: height_midpoints real(kind_phys), dimension(size(geopotential_height_wrt_surface_at_interface, dim = 2)) :: height_interfaces integer :: i_col - errcode = 0 - errmsg = '' - do i_col = 1, size(temperature, dim=1) - call calculate_heights( geopotential_height_wrt_surface_at_midpoint(i_col,:), & - geopotential_height_wrt_surface_at_interface(i_col,:), & - surface_geopotential(i_col), reciprocal_of_gravitational_acceleration, & - height_midpoints, height_interfaces ) - call set_height_grid_values( height_grid, height_midpoints, & - height_interfaces, errmsg, errcode ) - if (has_error_occurred( error, errmsg, errcode )) return + call calculate_heights( geopotential_height_wrt_surface_at_midpoint(i_col,:), & + geopotential_height_wrt_surface_at_interface(i_col,:), & + surface_geopotential(i_col), & + reciprocal_of_gravitational_acceleration, & + height_midpoints, height_interfaces ) + call set_height_grid_values( height_grid, height_midpoints, height_interfaces, & + errmsg, errcode ) + if (errcode /= 0) return end do ! stand-in until actual photolysis rate constants are calculated @@ -144,8 +145,8 @@ subroutine tuvx_final(errmsg, errcode) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode - errcode = 0 errmsg = '' + errcode = 0 deallocate( height_grid ) end subroutine tuvx_final diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 index fff1dd9..dfb2a5f 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 @@ -66,9 +66,6 @@ function create_height_grid( vertical_layer_dimension, & ! local variable type(error_t) :: error - errcode = 0 - errmsg = '' - height_grid => null() if ( vertical_layer_dimension < 1 ) then errmsg = "[MUSICA Error] Invalid vertical_layer_dimension." @@ -107,9 +104,6 @@ subroutine set_height_grid_values( height_grid, host_midpoints, & real(kind_phys) :: interfaces(size(host_interfaces)+1) integer :: n_host_midpoints, n_host_interfaces - errcode = 0 - errmsg = '' - if ( size(midpoints) /= height_grid%number_of_sections( error ) ) then errmsg = "[MUSICA Error] Invalid size of TUV-x mid-point heights." errcode = 1 diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index 6f08f4a..3f204c3 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -63,7 +63,7 @@ subroutine test_musica_ccpp_api() constituents(1,2,:) = (/ 0.41_kind_phys, 0.42_kind_phys, 0.43_kind_phys, 0.44_kind_phys /) constituents(2,1,:) = (/ 0.21_kind_phys, 0.22_kind_phys, 0.23_kind_phys, 0.24_kind_phys /) constituents(2,2,:) = (/ 0.31_kind_phys, 0.32_kind_phys, 0.33_kind_phys, 0.34_kind_phys /) - + call musica_ccpp_register(solver_type, num_grid_cells, constituent_props, errmsg, errcode) ASSERT(allocated(constituent_props)) ASSERT(size(constituent_props) == NUM_SPECIES)