Add Tao command to set number of OpenMP threads

tao/code/tao_command.f90

@@ -692,7 +692,7 @@ subroutine tao_command (command_line, err_flag, err_is_fatal)
       'universe', 'curve', 'graph', 'beam_init', 'wave', 'plot', 'bmad_com', 'element', 'opti_de_param', &
       'csr_param', 'floor_plan', 'lat_layout', 'geodesic_lm', 'default', 'key', 'particle_start', &
       'plot_page', 'ran_state', 'symbolic_number', 'beam', 'beam_start', 'dynamic_aperture', &
-      'global', 'region', 'calculate', 'space_charge_com', 'ptc_com', 'tune', 'z_tune'], .true., switch, err_flag) 
+      'global', 'region', 'calculate', 'space_charge_com', 'ptc_com', 'tune', 'z_tune', 'openmp'], .true., switch, err_flag)
     if (err_flag) return
     set_word = switch
   enddo
@@ -711,6 +711,7 @@ subroutine tao_command (command_line, err_flag, err_is_fatal)
   case ('calculate'); n_word = 1; n_eq = 0
   case ('tune'); n_word = 7; n_eq = 0
   case ('z_tune'); n_word = 6; n_eq = 0
+  case ('openmp'); n_word = 3; n_eq = 2
   case default
     call out_io (s_error$, r_name, 'SET WHAT? (MUST BE ON OF "branch", "data", "var", ...etc.')
     goto 9000
@@ -809,6 +810,8 @@ subroutine tao_command (command_line, err_flag, err_is_fatal)
     call tao_set_drawing_cmd (s%plot_page%lat_layout, cmd_word(1), cmd_word(3))
   case ('lattice')
     call tao_set_lattice_cmd (cmd_word(1), cmd_word(3))
+  case ('openmp')
+    call tao_set_openmp_cmd (cmd_word(1), cmd_word(3))
   case ('opti_de_param')
     call tao_set_opti_de_param_cmd (cmd_word(1), cmd_word(3))
   case ('plot ')

tao/code/tao_set_mod.f90

@@ -141,6 +141,54 @@ subroutine tao_set_z_tune_cmd (branch_str, q_str, delta_input)
 
 end subroutine tao_set_z_tune_cmd
 
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+!+
+! Subroutine tao_set_openmp_cmd (branch_str, q_str, delta_input)
+!
+! Routine to set OpenMP-related parameters.
+!
+! Input:
+!   setting_str    -- character(*): Parameter setting
+!   value_str      -- character(*): Value
+!-
+
+subroutine tao_set_openmp_cmd (setting_str, value_str)
+
+!$ use omp_lib, only: omp_get_max_threads, omp_set_num_threads
+
+implicit none
+
+integer ivalue
+
+logical err, openmp_available
+
+character(*) setting_str, value_str
+character(*), parameter :: r_name = 'tao_set_openmp_cmd'
+
+openmp_available = .false.
+!$ openmp_available = .true.
+
+  if (.not. openmp_available) then
+    call out_io (s_error$, r_name, 'OpenMP support is not available.')
+    return
+  endif
+
+  select case (setting_str)
+  case ('num_threads')
+    !$ call out_io (s_blank$, r_name, 'omp_get_max_threads() was: ' // int_str(omp_get_max_threads()))
+    !$ call tao_set_integer_value (ivalue, setting_str, value_str, err, 1)
+    if (err) return
+    !$ call omp_set_num_threads(ivalue)
+    !$ call out_io (s_blank$, r_name, 'omp_get_max_threads() is now: ' // int_str(omp_get_max_threads()))
+  case default
+    call out_io (s_error$, r_name, 'BAD NAME: ' // setting_str)
+    return
+  end select
+
+end subroutine tao_set_openmp_cmd
+
 !-----------------------------------------------------------------------------
 !-----------------------------------------------------------------------------
 !-----------------------------------------------------------------------------