Simplified function pointer code for custom and hook routines.

bmad-sim · Nov 4, 2023 · 87550ba · 87550ba
1 parent f1945df
commit 87550ba
Show file tree

Hide file tree

Showing 51 changed files with 78 additions and 446 deletions.
diff --git a/bmad/custom/apply_element_edge_kick_hook.f90 b/bmad/custom/apply_element_edge_kick_hook.f90
@@ -25,7 +25,7 @@
 
 subroutine apply_element_edge_kick_hook (orb, fringe_info, track_ele, param, finished, mat6, make_matrix, rf_time)
 
-use fringe_mod, dummy => apply_element_edge_kick_hook
+use fringe_mod
 
 implicit none
 

diff --git a/bmad/custom/check_aperture_limit_custom.f90 b/bmad/custom/check_aperture_limit_custom.f90
@@ -23,7 +23,7 @@
 
 subroutine check_aperture_limit_custom (orb, ele, particle_at, param, err_flag)
 
-use bmad_interface, dummy => check_aperture_limit_custom
+use bmad_interface
 
 implicit none
 

diff --git a/bmad/custom/distance_to_aperture_custom.f90 b/bmad/custom/distance_to_aperture_custom.f90
@@ -23,7 +23,7 @@
 
 function distance_to_aperture_custom (orbit, particle_at, ele, no_aperture_here) result (dist)
 
-use bmad, dummy => distance_to_aperture_custom
+use bmad
 
 implicit none
 

diff --git a/bmad/custom/ele_geometry_hook.f90 b/bmad/custom/ele_geometry_hook.f90
@@ -26,7 +26,7 @@
 
 subroutine ele_geometry_hook (floor0, ele, floor, finished, len_scale)
 
-use bmad_interface, dummy => ele_geometry_hook
+use bmad_interface
 
 implicit none
 

diff --git a/bmad/custom/ele_to_fibre_hook.f90 b/bmad/custom/ele_to_fibre_hook.f90
@@ -17,7 +17,7 @@
 
 subroutine ele_to_fibre_hook (ele, ptc_fibre, param, use_offsets, err_flag)
 
-use bmad, except_dummy => ele_to_fibre_hook
+use bmad
 use s_family, only: work, suntao, assignment(=) ! PTC
 
 implicit none

diff --git a/bmad/custom/em_field_custom.f90 b/bmad/custom/em_field_custom.f90
@@ -47,7 +47,7 @@
 recursive subroutine em_field_custom (ele, param, s_rel, orbit, local_ref_frame, field, calc_dfield, err_flag, &
  calc_potential, use_overlap, grid_allow_s_out_of_bounds, rf_time, used_eles)
 
-use em_field_mod, except_dummy => em_field_custom
+use em_field_mod
 
 implicit none
 

diff --git a/bmad/custom/init_custom.f90 b/bmad/custom/init_custom.f90
@@ -19,8 +19,7 @@
 
 subroutine init_custom (ele, err_flag)
 
-use bmad_struct
-use bmad_interface, except_dummy => init_custom
+use bmad_interface
 
 implicit none
 

diff --git a/bmad/custom/make_mat6_custom.f90 b/bmad/custom/make_mat6_custom.f90
@@ -21,8 +21,7 @@
 
 subroutine make_mat6_custom (ele, param, start_orb, end_orb, err_flag)
 
-use bmad_struct
-use bmad_interface, except_dummy => make_mat6_custom
+use bmad_interface
 
 implicit none
 

diff --git a/bmad/custom/radiation_integrals_custom.f90 b/bmad/custom/radiation_integrals_custom.f90
@@ -20,7 +20,7 @@
 
 subroutine radiation_integrals_custom (lat, ir, orb, rad_int1, err_flag)
 
-use bmad_interface, dummy => radiation_integrals_custom
+use bmad_interface
 
 implicit none
 

diff --git a/bmad/custom/time_runge_kutta_periodic_kick_hook.f90 b/bmad/custom/time_runge_kutta_periodic_kick_hook.f90
@@ -32,7 +32,7 @@
 
 subroutine time_runge_kutta_periodic_kick_hook (orbit, ele, param, stop_time, init_needed)
 
-use bmad, except_dummy => time_runge_kutta_periodic_kick_hook
+use bmad
 
 implicit none
 

diff --git a/bmad/custom/track1_bunch_hook.f90 b/bmad/custom/track1_bunch_hook.f90
@@ -24,7 +24,7 @@
 
 subroutine track1_bunch_hook (bunch, ele, err, centroid, direction, finished, bunch_track)
 
-use bmad, dummy => track1_bunch_hook
+use bmad
 
 implicit none
 

diff --git a/bmad/custom/track1_custom.f90 b/bmad/custom/track1_custom.f90
@@ -35,7 +35,7 @@
 
 subroutine track1_custom (orbit, ele, param, err_flag, finished, track)
 
-use bmad, except_dummy => track1_custom
+use bmad
 
 implicit none
 

diff --git a/bmad/custom/track1_postprocess.f90 b/bmad/custom/track1_postprocess.f90
@@ -23,7 +23,7 @@
 
 subroutine track1_postprocess (start_orb, ele, param, end_orb)
 
-use bmad, except_dummy => track1_postprocess
+use bmad
 
 implicit none
 

diff --git a/bmad/custom/track1_preprocess.f90 b/bmad/custom/track1_preprocess.f90
@@ -32,7 +32,7 @@
 
 subroutine track1_preprocess (start_orb, ele, param, err_flag, finished, radiation_included, track)
 
-use bmad, except_dummy => track1_preprocess
+use bmad
 
 implicit none
 

diff --git a/bmad/custom/track1_spin_custom.f90 b/bmad/custom/track1_spin_custom.f90
@@ -24,7 +24,7 @@
 
 subroutine track1_spin_custom (start, ele, param, end, err_flag, make_quaternion)
 
-use bmad_interface, except_dummy => track1_spin_custom
+use bmad_interface
 
 implicit none
 

diff --git a/bmad/custom/track1_wake_hook.f90 b/bmad/custom/track1_wake_hook.f90
@@ -16,7 +16,7 @@
 
 subroutine track1_wake_hook (bunch, ele, finished)
 
-use bmad_interface, dummy => track1_wake_hook
+use bmad_interface
 
 implicit none
 

diff --git a/bmad/custom/track_many_hook.f90 b/bmad/custom/track_many_hook.f90
@@ -24,7 +24,7 @@
 
 subroutine track_many_hook (finished, lat, orbit, ix_start, ix_end, direction, ix_branch, track_state)
 
-use bmad_interface, except_dummy => track_many_hook
+use bmad_interface
 
 implicit none
 

diff --git a/bmad/doc/misc-programming.tex b/bmad/doc/misc-programming.tex
@@ -28,8 +28,14 @@ \section{Custom and Hook Routines}
  procedure(track1_custom_def), pointer :: track1_custom_ptr => null()
 \end{example}
 
-To implement custom code for, say, \vn{track1_custom}, copy the file \vn{/bmad/custom/track1_custom.f90}
-to the area where the program is
+To implement custom code for, say, \vn{track1_custom}:
+\begin{itemize}
+%
+\item 
+copy the file \vn{/bmad/custom/track1_custom.f90} to the area where the program is to be compiled.
+%
+\item
+Code desired, 
 
 
 

diff --git a/bmad/modules/bmad_routine_interface.f90 b/bmad/modules/bmad_routine_interface.f90
@@ -3237,192 +3237,6 @@ subroutine zero_ele_offsets (ele)
 
 ! Custom and hook routines
 
-interface
-
-subroutine apply_element_edge_kick_hook (orb, fringe_info, track_ele, param, finished, mat6, make_matrix, rf_time)
- import
- implicit none
- type (coord_struct) orb
- type (fringe_field_info_struct) fringe_info
- type (ele_struct) track_ele
- type (lat_param_struct) param
- real(rp), optional :: mat6(6,6), rf_time
- logical, optional :: make_matrix
- logical finished
-end subroutine
-
-subroutine check_aperture_limit_custom (orb, ele, particle_at, param, err_flag)
- import
- implicit none
- type (coord_struct) :: orb
- type (ele_struct) :: ele
- type (lat_param_struct) :: param
- integer particle_at
- logical err_flag
-end subroutine
-
-function distance_to_aperture_custom (orbit, particle_at, ele, no_aperture_here) result (dist)
- import
- implicit none
- type (coord_struct) orbit
- type (ele_struct) ele
- real(rp) dist
- integer particle_at
- logical no_aperture_here
-end function
-
-subroutine ele_geometry_hook (floor0, ele, floor, finished, len_scale)
- import
- implicit none
- type (ele_struct) ele
- type (floor_position_struct) floor0, floor
- real(rp) len_scale
- logical finished
-end subroutine
-
-subroutine wall_hit_handler_custom (orb, ele, s)
- import
- implicit none
- type (coord_struct) :: orb
- type (ele_struct) :: ele
- real(rp) s
-end subroutine
-
-recursive subroutine em_field_custom (ele, param, s_rel, orbit, local_ref_frame, field, calc_dfield, err_flag, &
- calc_potential, use_overlap, grid_allow_s_out_of_bounds, rf_time, used_eles)
- import
- implicit none
- type (ele_struct), target :: ele
- type (lat_param_struct) param
- type (coord_struct), intent(in) :: orbit
- type (ele_pointer_struct), allocatable, optional :: used_eles(:)
- real(rp), intent(in) :: s_rel
- real(rp), optional :: rf_time
- logical local_ref_frame
- type (em_field_struct) :: field
- logical, optional :: err_flag, grid_allow_s_out_of_bounds
- logical, optional :: calc_dfield, calc_potential, use_overlap
-end subroutine
-
-subroutine ele_to_fibre_hook (ele, ptc_fibre, param, use_offsets, err_flag)
- import
- implicit none
- type (ele_struct) ele
- type (fibre) ptc_fibre
- type (lat_param_struct) param
- logical use_offsets, err_flag
-end subroutine
-
-subroutine radiation_integrals_custom (lat, ir, orb, rad_int1, err_flag)
- import
- implicit none
- type (lat_struct) lat
- type (coord_struct) orb(0:)
- type (rad_int1_struct) rad_int1
- integer ir
- logical err_flag
-end subroutine
-
-subroutine init_custom (ele, err_flag)
- import
- implicit none
- type (ele_struct), target :: ele
- logical err_flag
-end subroutine
-
-subroutine make_mat6_custom (ele, param, start_orb, end_orb, err_flag)
- import
- implicit none
- type (ele_struct), target :: ele
- type (coord_struct) :: start_orb, end_orb
- type (lat_param_struct) param
- logical err_flag, finished
-end subroutine
-
-subroutine time_runge_kutta_periodic_kick_hook (orbit, ele, param, stop_time, init_needed)
- import
- type (coord_struct) orbit
- type (ele_struct) ele
- type (lat_param_struct) param
- real(rp) stop_time
- integer :: init_needed
-end subroutine
-
-subroutine track1_bunch_hook (bunch, ele, err, centroid, direction, finished, bunch_track)
- import
- implicit none
- type (bunch_struct), target :: bunch
- type (ele_struct), target :: ele
- type (coord_struct), optional :: centroid(0:)
- type (bunch_track_struct), optional :: bunch_track
- integer, optional :: direction
- logical err, finished
-end subroutine
-
-subroutine track1_custom (start_orb, ele, param, err_flag, finished, track)
- import
- implicit none
- type (coord_struct) :: start_orb
- type (coord_struct) :: end_orb
- type (ele_struct) :: ele
- type (lat_param_struct) :: param
- type (track_struct), optional :: track
- logical err_flag, finished, radiation_included
-end subroutine
-
-subroutine track_many_hook (finished, lat, orbit, ix_start, ix_end, direction, ix_branch, track_state)
- import
- implicit none
- type (lat_struct), target :: lat
- type (coord_struct) orbit(0:)
- integer ix_start
- integer ix_end
- integer direction
- integer, optional :: ix_branch, track_state
- logical finished
-end subroutine
-
-subroutine track1_postprocess (start_orb, ele, param, end_orb)
- import
- implicit none
- type (coord_struct) :: start_orb
- type (coord_struct) :: end_orb
- type (ele_struct) :: ele
- type (lat_param_struct) :: param
-end subroutine
-
-subroutine track1_preprocess (start_orb, ele, param, err_flag, finished, radiation_included, track)
- import
- implicit none
- type (coord_struct) :: start_orb
- type (coord_struct) :: end_orb
- type (ele_struct), target :: ele
- type (lat_param_struct) :: param
- type (track_struct), optional :: track
- logical err_flag, finished, radiation_included
-end subroutine
-
-subroutine track1_spin_custom (start_orb, ele, param, end_orb, err_flag, make_quaternion)
- import
- implicit none
- type (coord_struct) :: start_orb
- type (coord_struct) :: end_orb
- type (ele_struct) :: ele
- type (lat_param_struct) :: param
- logical err_flag
- logical, optional :: make_quaternion
-end subroutine
-
-subroutine track1_wake_hook (bunch, ele, finished)
- import
- implicit none
- type (bunch_struct) bunch
- type (ele_struct) ele
- logical finished
-end subroutine
-
-end interface
-
 ! Hook and custom abstract definitions 
 
 abstract interface

diff --git a/bsim/dynamic_aperture/dynamic_aperture.f90 b/bsim/dynamic_aperture/dynamic_aperture.f90
@@ -27,6 +27,8 @@ program dynamic_aperture_program
 type (ele_struct), pointer :: ele
 type (branch_struct), pointer :: branch
 
+procedure(track_many_hook_def) :: track_many_hook
+
 real(rp) dpz(20)
 real(rp) :: ramping_start_time = 0
 integer nargs, ios, i, j, n_dpz, nt

diff --git a/bsim/dynamic_aperture/track_many_hook.f90 b/bsim/dynamic_aperture/track_many_hook.f90
@@ -26,7 +26,7 @@
 
 subroutine track_many_hook (finished, lat, orbit, ix_start, ix_end, direction, ix_branch, track_state)
 
-use da_program_mod, except_dummy => track_many_hook
+use da_program_mod
 
 implicit none
 

diff --git a/bsim/spin_stroboscope/spin_stroboscope.f90 b/bsim/spin_stroboscope/spin_stroboscope.f90
@@ -77,6 +77,8 @@ program spin_stroboscope
 type (fourier_mode_struct) fourier ! Fourier transform for the spin x-axis
 type (spin_results_struct), allocatable :: result(:)
 
+procedure(track1_custom_def) :: track1_custom
+
 real(rp) orbit_start(3), orbit_stop(3), delta(3), xfer_mat(3,3), closed_orb_invar_spin(3), dtune
 real(rp) time, unit_mat(3,3), norm_max, norm, tune2, r, axis(3), ave_invar_spin(3), dphase_long, dphase_transverse
 real(rp) f(3), p_lim, angle, angle0, angle1, angle2, dangle, j_amp(3), old_relaxed_invar_spin(3), old_scatter_min_invar_spin(3)