Merge branch '94-tuvx-height-grid' into 95-update-tuvx-temp

schemes/musica/micm/musica_ccpp_micm.F90

@@ -132,7 +132,10 @@ subroutine micm_final(errmsg, errcode)
  errmsg = ''
  errcode = 0
 
- deallocate( micm )
+ if (associated( micm )) then
+ deallocate( micm )
+ micm => null()
+ end if
 
  end subroutine micm_final
 

schemes/musica/tuvx/musica_ccpp_tuvx.F90

@@ -49,19 +49,25 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
  call grids%add( height_grid, error )
  if (has_error_occurred( error, errmsg, errcode )) then
  deallocate( grids )
+ deallocate( height_grid )
+ height_grid => null()
  return
  end if
 
  profiles => profile_map_t( error )
  if (has_error_occurred( error, errmsg, errcode )) then
  deallocate( grids )
+ deallocate( height_grid )
+ height_grid => null()
  return
  end if
 
  radiators => radiator_map_t( error )
  if (has_error_occurred( error, errmsg, errcode )) then
  deallocate( grids )
  deallocate( profiles )
+ deallocate( height_grid )
+ height_grid => null()
  return
  end if
 
@@ -71,13 +77,16 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
  deallocate( grids )
  deallocate( profiles )
  deallocate( radiators )
+ deallocate( height_grid )
+ height_grid => null()
  return
  end if
 
- deallocate( height_grid )
  deallocate( grids )
  deallocate( profiles )
  deallocate( radiators )
+ deallocate( height_grid )
+ height_grid => null()
 
  grids => tuvx%get_grids( error )
  if (has_error_occurred( error, errmsg, errcode )) then
@@ -123,13 +132,16 @@ subroutine tuvx_run(temperature, dry_air_density, &
  ! local variables
  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
+ real(kind_phys) :: reciprocal_of_gravitational_acceleration ! s2 m-1
+ integer :: i_col
+
+ reciprocal_of_gravitational_acceleration = 1.0_kind_phys / standard_gravitational_acceleration
 
  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), &
- standard_gravitational_acceleration,  &
+ reciprocal_of_gravitational_acceleration, &
  height_midpoints, height_interfaces )
  call set_height_grid_values( height_grid, height_midpoints, height_interfaces, &
  errmsg, errcode )
@@ -148,8 +160,16 @@ subroutine tuvx_final(errmsg, errcode)
 
  errmsg = ''
  errcode = 0
- deallocate( height_grid )
- deallocate( tuvx )
+
+ if (associated( height_grid )) then
+ deallocate( height_grid )
+ height_grid => null()
+ end if
+
+ if (associated( tuvx )) then
+ deallocate( tuvx )
+ tuvx => null()
+ end if
 
  end subroutine tuvx_final
 

schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90

@@ -146,22 +146,21 @@ end subroutine set_height_grid_values
  subroutine calculate_heights(geopotential_height_wrt_surface_at_midpoint, &
  geopotential_height_wrt_surface_at_interface, &
  surface_geopotential, &
- standard_gravitational_acceleration,  &
+ reciprocal_of_gravitational_acceleration, &
  height_midpoints, height_interfaces)
  use ccpp_kinds, only: kind_phys
 
  real(kind_phys), intent(in) :: geopotential_height_wrt_surface_at_midpoint(:) ! m
  real(kind_phys), intent(in) :: geopotential_height_wrt_surface_at_interface(:) ! m
  real(kind_phys), intent(in) :: surface_geopotential ! m2 s-2
- real(kind_phys), intent(in) :: standard_gravitational_acceleration  ! m s-2
+ real(kind_phys), intent(in) :: reciprocal_of_gravitational_acceleration ! s2 m-1
  real(kind_phys), intent(out) :: height_midpoints(:) ! km
  real(kind_phys), intent(out) :: height_interfaces(:) ! km
 
  ! local variable
  real(kind_phys) :: surface_height ! m
 
- surface_height = &
- surface_geopotential * ( 1.0_kind_phys / standard_gravitational_acceleration )
+ surface_height = surface_geopotential * reciprocal_of_gravitational_acceleration
  height_midpoints(:) = &
  0.001_kind_phys * ( geopotential_height_wrt_surface_at_midpoint(:) + surface_height )
  height_interfaces(:) = &

test/cmake/TestUtils.cmake

@@ -3,6 +3,9 @@
 
 if(CCPP_ENABLE_MEMCHECK)
  find_program(MEMORYCHECK_COMMAND "valgrind")
+
+ # Set the Valgrind suppressions file for tests
+ set(MEMCHECK_SUPPRESS "--suppressions=${CMAKE_SOURCE_DIR}/valgrind.supp")
 endif()
 
 ################################################################################
@@ -11,10 +14,10 @@ endif()
 function(add_memory_check_test test_name test_binary test_args working_dir)
  if(CCPP_ENABLE_MEMCHECK)
  add_test(NAME memcheck_${test_name}
- COMMAND mpirun -v -np 1 ${MEMORYCHECK_COMMAND} --leak-check=full --error-exitcode=1 --trace-children=yes
+ COMMAND mpirun -v -np 1 ${MEMORYCHECK_COMMAND} --leak-check=full --error-exitcode=1 --trace-children=yes --gen-suppressions=all ${MEMCHECK_SUPPRESS}
  ${test_binary} ${test_args}
  WORKING_DIRECTORY ${working_dir})
  endif()
 endfunction(add_memory_check_test)
 
-################################################################################
+################################################################################

test/musica/tuvx/test_tuvx_height_grid.F90

@@ -78,18 +78,18 @@ subroutine test_calculate_height_grid_values()
  real(kind_phys), dimension(NUM_LAYERS) :: geopotential_height_wrt_surface_at_midpoint ! m
  real(kind_phys), dimension(NUM_LAYERS+1) :: geopotential_height_wrt_surface_at_interface ! m
  real(kind_phys) :: surface_geopotential ! m2 s-2
- real(kind_phys) :: standard_gravitational_acceleration ! m s-2
+ real(kind_phys) :: reciprocal_of_gravitational_acceleration ! s2 m-1
  real(kind_phys), dimension(NUM_LAYERS) :: height_midpoints ! km
  real(kind_phys), dimension(NUM_LAYERS+1) :: height_interfaces ! km
 
  geopotential_height_wrt_surface_at_midpoint(:) = (/ 2000.0_kind_phys, 500.0_kind_phys /)
  geopotential_height_wrt_surface_at_interface(:) = (/ 3000.0_kind_phys, 1000.0_kind_phys, 0.0_kind_phys /)
  surface_geopotential = 100.0_kind_phys
- standard_gravitational_acceleration = 0.1_kind_phys
+ reciprocal_of_gravitational_acceleration = 10.0_kind_phys
 
  call calculate_heights(geopotential_height_wrt_surface_at_midpoint, &
  geopotential_height_wrt_surface_at_interface, &
- surface_geopotential, standard_gravitational_acceleration, &
+ surface_geopotential, reciprocal_of_gravitational_acceleration, &
  height_midpoints, height_interfaces)
 
  ASSERT_NEAR(height_midpoints(1), 3.0, 1e-5)

test/valgrind.supp

@@ -0,0 +1,27 @@
+##############################################################
+#
+# MUSICA TUV-x suppressions
+#
+# TODO(jiwon) We are experiencing memory leak issues in certain 
+# functions of TUV-x. It appears that these leaks occur only 
+# occasionally during initialization. We believe it’s acceptable 
+# to add a Valgrind suppression for now, and we will investigate 
+# further if it becomes a significant concern.
+#
+##############################################################
+{
+ Suppress_MUSICA_TUV-x_Leak
+ Memcheck:Leak
+ obj:/usr/libexec/valgrind/vgpreload_memcheck-amd64-linux.so
+ fun:__musica_config_MOD_get_string
+ fun:__tuvx_radiator_aerosol_MOD_constructor
+ fun:__tuvx_radiator_factory_MOD_radiator_builder
+ fun:__tuvx_radiator_warehouse_MOD_constructor
+ fun:__tuvx_radiative_transfer_MOD_constructor
+ fun:__tuvx_core_MOD_constructor
+ fun:InternalCreateTuvx
+ fun:musica::TUVX::Create
+ fun:CreateTuvx
+ fun:__musica_tuvx_MOD_constructor
+ fun:__musica_ccpp_tuvx_MOD_tuvx_init
+}