Add helper function for deallocating objects associated with TUV-x

schemes/musica/tuvx/musica_ccpp_tuvx.F90

@@ -24,13 +24,13 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
                        wavelength_grid_interfaces, errmsg, errcode)
     use musica_tuvx, only: grid_map_t, profile_map_t, radiator_map_t
     use musica_util, only: error_t
-    use musica_ccpp_tuvx_height_grid, only: create_height_grid, &
-                                            height_grid_label, height_grid_unit
-    use musica_ccpp_tuvx_wavelength_grid, only: create_wavelength_grid, &
-                                                wavelength_grid_label, &
-                                                wavelength_grid_unit
-    use musica_ccpp_tuvx_temperature, only: create_temperature_profile, &
-                                            temperature_label, temperature_unit
+    use musica_ccpp_tuvx_util, only: tuvx_deallocate
+    use musica_ccpp_tuvx_height_grid, &
+      only: create_height_grid, height_grid_label, height_grid_unit
+    use musica_ccpp_tuvx_wavelength_grid, &
+      only: create_wavelength_grid, wavelength_grid_label, wavelength_grid_unit
+    use musica_ccpp_tuvx_temperature, &
+      only: create_temperature_profile, temperature_label, temperature_unit
 
     integer,            intent(in)  :: vertical_layer_dimension      ! (count)
     integer,            intent(in)  :: vertical_interface_dimension  ! (count)
@@ -56,102 +56,62 @@ 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()
+      call tuvx_deallocate( grids, null(), null(), null(), height_grid, null(), null() )
       return
     end if
 
     wavelength_grid => create_wavelength_grid( wavelength_grid_interfaces, &
                                                errmsg, errcode )
     if (errcode /= 0) then
-      deallocate( grids )
-      deallocate( height_grid )
-      height_grid => null()
+      call tuvx_deallocate( grids, null(), null(), null(), height_grid, null(), null() )
       return
     endif
 
     call grids%add( wavelength_grid, error )
     if (has_error_occurred( error, errmsg, errcode )) then
-      deallocate( grids )
-      deallocate( height_grid )
-      height_grid => null()
-      deallocate( wavelength_grid )
-      wavelength_grid => null()
+      call tuvx_deallocate( grids, null(), null(), null(), height_grid, wavelength_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()
-      deallocate( wavelength_grid )
-      wavelength_grid => null()
+      call tuvx_deallocate( grids, null(), null(), null(), height_grid, wavelength_grid, &
+                            null() )
       return
     end if
 
     temperature_profile => create_temperature_profile( height_grid, errmsg, errcode )
     if (errcode /= 0) then
-      deallocate( grids )
-      deallocate( height_grid )
-      height_grid => null()
-      deallocate( wavelength_grid )
-      wavelength_grid => null()
-      deallocate( profiles )
+      call tuvx_deallocate( grids, profiles, null(), null(), height_grid, wavelength_grid, &
+                            null() )
       return
     endif
 
     call profiles%add( temperature_profile, error )
     if (has_error_occurred( error, errmsg, errcode )) then
-      deallocate( grids )
-      deallocate( height_grid )
-      height_grid => null()
-      deallocate( wavelength_grid )
-      wavelength_grid => null()
-      deallocate( profiles )
-      deallocate( temperature_profile )
-      temperature_profile => null()
+      call tuvx_deallocate( grids, profiles, null(), null(), height_grid, wavelength_grid, &
+                            temperature_profile )
       return
     end if
 
     radiators => radiator_map_t( error )
     if (has_error_occurred( error, errmsg, errcode )) then
-      deallocate( grids )
-      deallocate( height_grid )
-      height_grid => null()
-      deallocate( wavelength_grid )
-      wavelength_grid => null()
-      deallocate( profiles )
-      deallocate( temperature_profile )
-      temperature_profile => null()
+      call tuvx_deallocate( grids, profiles, null(), null(), height_grid, wavelength_grid, &
+                            temperature_profile )
       return
     end if
 
     tuvx => tuvx_t( filename_of_tuvx_configuration, grids, profiles, &
                     radiators, error )
     if (has_error_occurred( error, errmsg, errcode )) then
-      deallocate( grids )
-      deallocate( height_grid )
-      height_grid => null()
-      deallocate( wavelength_grid )
-      wavelength_grid => null()
-      deallocate( profiles )
-      deallocate( temperature_profile )
-      temperature_profile => null()
-      deallocate( radiators )
+      call tuvx_deallocate( grids, profiles, radiators, null(), height_grid, wavelength_grid, &
+                            temperature_profile )
       return
     end if
 
-    deallocate( grids )
-    deallocate( height_grid )
-    height_grid => null()
-    deallocate( wavelength_grid )
-    wavelength_grid => null()
-    deallocate( profiles )
-    deallocate( temperature_profile )
-    temperature_profile => null()
-    deallocate( radiators )
+    call tuvx_deallocate( grids, profiles, radiators, null(), height_grid, wavelength_grid, &
+                          temperature_profile )
 
     grids => tuvx%get_grids( error )
     if (has_error_occurred( error, errmsg, errcode )) then
@@ -162,49 +122,32 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
 
     height_grid => grids%get( height_grid_label, height_grid_unit, error )
     if (has_error_occurred( error, errmsg, errcode )) then
-      deallocate( tuvx )
-      tuvx => null()
-      deallocate( grids )
+      call tuvx_deallocate( grids, null(), null(), tuvx, null(), null(), null() )
       return
     end if
 
     wavelength_grid => grids%get( wavelength_grid_label, wavelength_grid_unit, &
                                   error )
     if (has_error_occurred( error, errmsg, errcode )) then
-      deallocate( tuvx )
-      tuvx => null()
-      deallocate( grids )
-      deallocate( height_grid )
-      height_grid => null()
+      call tuvx_deallocate( grids, null(), null(), tuvx, height_grid, null(), null() )
       return
     end if
 
-    deallocate( grids )
-
     profiles => tuvx%get_profiles( error )
     if (has_error_occurred( error, errmsg, errcode )) then
-      deallocate( tuvx )
-      tuvx => null()
-      deallocate( height_grid )
-      height_grid => null()
-      deallocate( wavelength_grid )
-      wavelength_grid => null()
+      call tuvx_deallocate( grids, null(), null(), tuvx, height_grid, wavelength_grid, &
+                            null() )
       return
     end if
 
     temperature_profile => profiles%get( temperature_label, temperature_unit, error )
     if (has_error_occurred( error, errmsg, errcode )) then
-      deallocate( tuvx )
-      tuvx => null()
-      deallocate( height_grid )
-      height_grid => null()
-      deallocate( wavelength_grid )
-      wavelength_grid => null()
-      deallocate( profiles )
+      call tuvx_deallocate( grids, profiles, null(), tuvx, height_grid, wavelength_grid, &
+                            null() )
       return
     end if
 
-    deallocate( profiles )
+    call tuvx_deallocate( grids, profiles, null(), null(), null(), null(), null() )
 
   end subroutine tuvx_init
 

schemes/musica/tuvx/musica_ccpp_tuvx_util.F90

@@ -0,0 +1,49 @@
+module musica_ccpp_tuvx_util
+  implicit none
+
+  private
+  public :: tuvx_deallocate
+
+contains
+
+  !> This is a helper subroutine created to deallocate objects associated with TUV-x
+  subroutine tuvx_deallocate(grids, profiles, radiators, tuvx, height_grid, &
+                             wavelength_grid, temperature_profile)
+    use musica_tuvx, only: tuvx_t, grid_map_t, profile_map_t, radiator_map_t, &
+                           grid_t, profile_t
+
+    type(grid_map_t),     pointer :: grids
+    type(profile_map_t),  pointer :: profiles
+    type(radiator_map_t), pointer :: radiators
+    type(tuvx_t),         pointer :: tuvx
+    type(grid_t),         pointer :: height_grid
+    type(grid_t),         pointer :: wavelength_grid
+    type(profile_t),      pointer :: temperature_profile
+
+    if (associated( grids )) deallocate( grids )
+    if (associated( profiles )) deallocate( profiles )
+    if (associated( radiators )) deallocate( radiators )
+
+    if (associated( tuvx )) then
+      deallocate( tuvx )
+      tuvx => null()
+    end if
+
+    if (associated( height_grid )) then
+      deallocate( height_grid )
+      height_grid => null()
+    end if
+
+    if (associated( wavelength_grid )) then
+      deallocate( wavelength_grid )
+      wavelength_grid => null()
+    end if
+
+    if (associated( temperature_profile )) then
+      deallocate( temperature_profile )
+      temperature_profile => null()
+    end if
+
+  end subroutine tuvx_deallocate
+
+end module musica_ccpp_tuvx_util

schemes/musica/tuvx/musica_ccpp_tuvx_wavelength_grid.F90

@@ -16,9 +16,9 @@ module musica_ccpp_tuvx_wavelength_grid
   ! The wavelength grid is defined by the host model. Any wavelength-
   ! resolved quantities passed to TUV-x must be on this grid.
 
-  !> Label for height grid in TUV-x
+  !> Label for wavelength grid in TUV-x
   character(len=*), parameter, public :: wavelength_grid_label = "wavelength"
-  !> Units for height grid in TUV-x
+  !> Unit for wavelength grid in TUV-x
   character(len=*), parameter, public :: wavelength_grid_unit = "nm"
 
 contains
@@ -29,7 +29,6 @@ function create_wavelength_grid( wavelength_grid_interfaces, errmsg, errcode ) &
 
     use ccpp_kinds,       only: kind_phys
     use musica_ccpp_util, only: has_error_occurred
-    use musica_config,    only: config_t
     use musica_tuvx_grid, only: grid_t
     use musica_util,      only: error_t
 
@@ -41,7 +40,7 @@ function create_wavelength_grid( wavelength_grid_interfaces, errmsg, errcode ) &
     ! local variables
     real(kind_phys) :: interfaces( size( wavelength_grid_interfaces ) )    ! [nm]
     reaL(kind_phys) :: midpoints( size( wavelength_grid_interfaces ) - 1 ) ! [nm]
-    type(error_t) :: error
+    type(error_t)   :: error
 
     interfaces(:) = wavelength_grid_interfaces(:) * 1.0e9
     midpoints(:) = &

test/musica/tuvx/test_tuvx_surface_albedo.F90

@@ -32,6 +32,9 @@ subroutine test_update_surface_albedo()
     integer                  :: i
 
     wavelength_grid => create_wavelength_grid(wavelength_grid_interfaces, errmsg, errcode)
+    ASSERT(errcode == 0)
+    ASSERT(associated(wavelength_grid))
+
     profile => create_surface_albedo_profile( wavelength_grid, errmsg, errcode )
     ASSERT(errcode == 0)
     ASSERT(associated(profile))