Add other close gaps hook (#518)

* add other_close_gaps hook (#487)

Co-authored-by: Simon Guichandut <[email protected]>

Author: rjfarmer

docs/source/changelog.rst

@@ -92,6 +92,12 @@ This was found to be important for smooth convective boundary
 evolution with convective premixing.
 
 
+Hooks
+~~~~~
+
+A new other_close_gaps hook has been added. Provided by Simon Guichandut
+
+
 Changes in r22.11.1
 ===================
 

star/defaults/controls.defaults

@@ -11341,6 +11341,7 @@
     use_other_eps_grav = .false.
     use_other_mesh_functions = .false.
     use_other_D_mix = .false.
+    use_other_close_gaps = .false.
 
       ! ::
 

star/make/makefile_base

@@ -118,6 +118,7 @@ SRCS = \
    other_rate_get.f90 \
    other_net_derivs.f90 \
    other_split_burn.f90 \
+   other_close_gaps.f90 \
    star_utils.f90 \
    ctrls_io.f90 \
    alloc.f90 \

star/other/other_close_gaps.f90

@@ -0,0 +1,53 @@
+! ***********************************************************************
+!
+!   Copyright (C) 2023  The MESA Team & Simon Guichandut
+!
+!   MESA is free software; you can use it and/or modify
+!   it under the combined terms and restrictions of the MESA MANIFESTO
+!   and the GNU General Library Public License as published
+!   by the Free Software Foundation; either version 2 of the License,
+!   or (at your option) any later version.
+!
+!   You should have received a copy of the MESA MANIFESTO along with
+!   this software; if not, it is available at the mesa website:
+!   http://mesa.sourceforge.net/
+!
+!   MESA is distributed in the hope that it will be useful,
+!   but WITHOUT ANY WARRANTY; without even the implied warranty of
+!   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+!   See the GNU Library General Public License for more details.
+!
+!   You should have received a copy of the GNU Library General Public License
+!   along with this software; if not, write to the Free Software
+!   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+!
+! ***********************************************************************
+ 
+      module other_close_gaps
+
+      ! consult star/other/README for general usage instructions
+      ! control name: use_other_close_gaps = .true.
+      ! procedure pointer: s% other_close_gaps => my_routine
+      ! This also requires the control remove_mixing_glitches = .true. 
+
+      use star_def
+
+      implicit none
+      
+      contains
+      
+      
+      subroutine null_other_close_gaps(id, mix_type, min_gap, ierr)
+         integer, intent(in) :: id
+         integer, intent(in) :: mix_type
+         real(dp), intent(in) :: min_gap
+         integer, intent(out) :: ierr
+         ierr = 0
+      end subroutine null_other_close_gaps
+
+
+      end module other_close_gaps
+      
+      
+      
+      

star/private/ctrls_io.f90

@@ -520,7 +520,7 @@ module ctrls_io
     use_other_diffusion_coefficients, use_other_pgstar_plots, use_other_eval_fp_ft, use_other_eval_i_rot, use_other_torque, &
     use_other_torque_implicit, use_other_wind, use_other_accreting_state, use_other_after_struct_burn_mix, use_other_mesh_delta_coeff_factor, &
     use_other_before_struct_burn_mix, use_other_astero_freq_corr, use_other_timestep_limit, use_other_set_pgstar_controls, &
-    use_other_screening, use_other_rate_get, use_other_net_derivs, use_other_split_burn, &
+    use_other_screening, use_other_rate_get, use_other_net_derivs, use_other_split_burn, use_other_close_gaps, &
     x_ctrl, x_integer_ctrl, x_logical_ctrl, x_character_ctrl, &
 
     ! extra files
@@ -2397,6 +2397,7 @@ subroutine store_controls(s, ierr)
  s% use_other_rate_get = use_other_rate_get
  s% use_other_net_derivs = use_other_net_derivs
  s% use_other_split_burn = use_other_split_burn
+ s% use_other_close_gaps = use_other_close_gaps
 
  s% x_ctrl = x_ctrl
  s% x_integer_ctrl = x_integer_ctrl
@@ -4059,6 +4060,7 @@ subroutine set_controls_for_writing(s, ierr)
  use_other_rate_get = s% use_other_rate_get
  use_other_net_derivs = s% use_other_net_derivs
  use_other_split_burn = s% use_other_split_burn
+ use_other_close_gaps = s% use_other_close_gaps
 
  x_ctrl = s% x_ctrl
  x_integer_ctrl = s% x_integer_ctrl

star/private/mix_info.f90

@@ -1077,21 +1077,33 @@ end subroutine remove_mixing_singletons
       subroutine close_convection_gaps(s, ierr)
          type (star_info), pointer :: s
          integer, intent(out) :: ierr
-         call close_gaps(s, convective_mixing, s% min_convective_gap, ierr)
+         if (s% use_other_close_gaps) then
+            call s% other_close_gaps(s% id, convective_mixing, s% min_convective_gap, ierr)
+         else
+            call close_gaps(s, convective_mixing, s% min_convective_gap, ierr)
+         end if
       end subroutine close_convection_gaps
 
 
       subroutine close_thermohaline_gaps(s, ierr)
          type (star_info), pointer :: s
          integer, intent(out) :: ierr
-         call close_gaps(s, thermohaline_mixing, s% min_thermohaline_gap, ierr)
+         if (s% use_other_close_gaps) then
+            call s% other_close_gaps(s% id, thermohaline_mixing, s% min_thermohaline_gap, ierr)
+         else
+            call close_gaps(s, thermohaline_mixing, s% min_thermohaline_gap, ierr)
+         end if
       end subroutine close_thermohaline_gaps
 
 
       subroutine close_semiconvection_gaps(s, ierr)
          type (star_info), pointer :: s
          integer, intent(out) :: ierr
-         call close_gaps(s, semiconvective_mixing, s% min_semiconvection_gap, ierr)
+         if (s% use_other_close_gaps) then
+            call s% other_close_gaps(s% id, semiconvective_mixing, s% min_semiconvection_gap, ierr)
+         else
+            call close_gaps(s, semiconvective_mixing, s% min_semiconvection_gap, ierr)
+         end if
       end subroutine close_semiconvection_gaps
 
 

star/test_suite/other_physics_hooks/src/run_star_extras.f90

@@ -77,6 +77,9 @@ subroutine extras_controls(id, ierr)
          s% use_other_rate_get = .true.
          s% other_rate_get => my_rate_get
 
+         s% use_other_close_gaps = .true.
+         s% other_close_gaps => my_close_gaps
+
          s% extras_startup => extras_startup
          s% extras_check_model => extras_check_model
          s% extras_finish_step => extras_finish_step
@@ -394,5 +397,27 @@ subroutine my_rate_get(ir, temp, tf, raw_rate, ierr)
       end subroutine my_rate_get
 
 
+      subroutine my_close_gaps(id, mix_type, min_gap, ierr)
+         integer, intent(in) :: id
+         integer, intent(in) :: mix_type
+         real(dp), intent(in) :: min_gap
+         integer, intent(out) :: ierr
+         integer :: k
+         type (star_info), pointer :: s
+         ierr = 0
+         call star_ptr(id, s, ierr)
+         if (ierr /= 0) return
+
+         do k=1, 10
+            if (.false. .and. s% mixing_type(k) == mix_type) then 
+               write(*,*) k, s% D_mix(k), s% mixing_type(k)
+            end if
+         end do
+
+
+      end subroutine my_close_gaps
+
+
+
       end module run_star_extras
 

star_data/private/star_controls.inc

@@ -1360,6 +1360,7 @@
          logical :: use_other_rate_get
          logical :: use_other_net_derivs
          logical :: use_other_split_burn
+         logical :: use_other_close_gaps
 
          real(dp) :: x_ctrl(num_x_ctrls)
          integer :: x_integer_ctrl(num_x_ctrls)

star_data/public/star_data_def.inc

@@ -835,6 +835,15 @@
          end subroutine other_diffusion_interface
 
 
+         subroutine other_close_gaps_interface(id, mix_type, min_gap, ierr)
+            use const_def, only: dp
+            integer, intent(in) :: id
+            integer, intent(in) :: mix_type
+            real(dp), intent(in) :: min_gap
+            integer, intent(out) :: ierr
+         end subroutine other_close_gaps_interface
+
+
          subroutine other_kap_get_interface( &
                id, k, handle, species, chem_id, net_iso, xa, &
                log10_rho, log10_T, &

star_data/public/star_data_procedures.inc

@@ -128,6 +128,9 @@
          procedure (other_surface_PT_interface), pointer, nopass :: &
             other_surface_PT => null()
 
+         procedure (other_close_gaps_interface), pointer, nopass :: &
+            other_close_gaps => null()
+
          procedure (other_kap_get_interface), pointer, nopass :: &
             other_kap_get => null()
          procedure (other_kap_get_op_mono_interface), pointer, nopass :: &