diff --git a/schemes/musica/micm/musica_ccpp_micm.F90 b/schemes/musica/micm/musica_ccpp_micm.F90 index d2c6044d..c2e40d95 100644 --- a/schemes/musica/micm/musica_ccpp_micm.F90 +++ b/schemes/musica/micm/musica_ccpp_micm.F90 @@ -38,6 +38,10 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & logical :: is_advected integer :: i, species_index + if (associated( micm )) then + deallocate( micm ) + micm => null() + end if micm => micm_t(trim(filename_of_micm_configuration), solver_type, & number_of_grid_cells, error) if (has_error_occurred(error, errmsg, errcode)) return diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 1fb99c24..36d79663 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -14,14 +14,11 @@ module musica_ccpp !> \section arg_table_musica_ccpp_register Argument Table !! \htmlinclude musica_ccpp_register.html - subroutine musica_ccpp_register(horizontal_loop_extent, & - vertical_layer_dimension, constituent_props, errmsg, & + subroutine musica_ccpp_register(constituent_props, errmsg, & errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_namelist, only: micm_solver_type - integer, intent(in) :: horizontal_loop_extent - integer, intent(in) :: vertical_layer_dimension type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -29,7 +26,11 @@ subroutine musica_ccpp_register(horizontal_loop_extent, & type(ccpp_constituent_properties_t), allocatable :: constituent_props_subset(:) integer :: number_of_grid_cells - number_of_grid_cells = horizontal_loop_extent * vertical_layer_dimension + ! Temporary fix until the number of grid cells is only needed to create a MICM state + ! instead of when the solver is created. + ! The number of grid cells is not know at this point, so we set it to 1 and recreate + ! the solver when the number of grid cells is known at the init stage. + number_of_grid_cells = 1 call micm_register(micm_solver_type, number_of_grid_cells, constituent_props_subset, & errmsg, errcode) if (errcode /= 0) return @@ -44,13 +45,16 @@ end subroutine musica_ccpp_register !> \section arg_table_musica_ccpp_init Argument Table !! \htmlinclude musica_ccpp_init.html - subroutine musica_ccpp_init(vertical_layer_dimension, vertical_interface_dimension, & + subroutine musica_ccpp_init(horizontal_loop_extent, vertical_layer_dimension, & + vertical_interface_dimension, & photolysis_wavelength_grid_interfaces, & constituent_props, errmsg, errcode) - use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t, ccpp_constituent_prop_ptr_t use ccpp_kinds, only : kind_phys use musica_ccpp_micm, only: micm + use musica_ccpp_namelist, only: micm_solver_type use musica_ccpp_util, only: has_error_occurred + integer, intent(in) :: horizontal_loop_extent ! (count) integer, intent(in) :: vertical_layer_dimension ! (count) integer, intent(in) :: vertical_interface_dimension ! (count) real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! m @@ -58,6 +62,14 @@ subroutine musica_ccpp_init(vertical_layer_dimension, vertical_interface_dimensi character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode + integer :: number_of_grid_cells + type(ccpp_constituent_properties_t), allocatable :: micm_species_props(:) + + ! Temporary fix until the number of grid cells is only needed to create a MICM state + ! instead of when the solver is created. + ! Re-create the MICM solver with the correct number of grid cells + number_of_grid_cells = horizontal_loop_extent * vertical_layer_dimension + call micm_register(micm_solver_type, number_of_grid_cells, micm_species_props, errmsg, errcode) call micm_init(errmsg, errcode) if (errcode /= 0) return call tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index 807ac20d..3d9ef96c 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -6,18 +6,6 @@ [ccpp-arg-table] name = musica_ccpp_register type = scheme -[ horizontal_loop_extent ] - standard_name = horizontal_loop_extent - units = count - type = integer - dimensions = () - intent = in -[ vertical_layer_dimension ] - standard_name = vertical_layer_dimension - units = count - type = integer - dimensions = () - intent = in [ constituent_props ] standard_name = dynamic_constituents_for_musica_ccpp units = none @@ -41,6 +29,12 @@ [ccpp-arg-table] name = musica_ccpp_init type = scheme +[ horizontal_loop_extent ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in [ vertical_layer_dimension ] standard_name = vertical_layer_dimension units = none diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index 99b95892..ef567e95 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -222,7 +222,7 @@ subroutine test_chapman() filename_of_tuvx_configuration = 'musica_configurations/chapman/tuvx/config.json' filename_of_tuvx_micm_mapping_configuration = 'musica_configurations/chapman/tuvx_micm_mapping.json' - call musica_ccpp_register(NUM_COLUMNS, NUM_LAYERS, constituent_props, errmsg, errcode) + call musica_ccpp_register(constituent_props, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -264,7 +264,7 @@ subroutine test_chapman() call constituent_props_ptr(i)%set(const_prop, errcode, errmsg) end do - call musica_ccpp_init(NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & + call musica_ccpp_init(NUM_COLUMNS, NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & constituent_props_ptr, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg) @@ -457,7 +457,7 @@ subroutine test_terminator() filename_of_tuvx_configuration = 'musica_configurations/terminator/tuvx/config.json' filename_of_tuvx_micm_mapping_configuration = 'musica_configurations/terminator/tuvx_micm_mapping.json' - call musica_ccpp_register(NUM_COLUMNS, NUM_LAYERS, constituent_props, errmsg, errcode) + call musica_ccpp_register(constituent_props, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -496,7 +496,7 @@ subroutine test_terminator() call constituent_props_ptr(i)%set(const_prop, errcode, errmsg) end do - call musica_ccpp_init(NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & + call musica_ccpp_init(NUM_COLUMNS, NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & constituent_props_ptr, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg)