Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : MODULE cp2k_runs
10 : USE atom, ONLY: atom_code
11 : USE bibliography, ONLY: Iannuzzi2026,&
12 : cite_reference,&
13 : cp2kqs2020
14 : USE bsse, ONLY: do_bsse_calculation
15 : USE cell_opt, ONLY: cp_cell_opt
16 : USE cp2k_debug, ONLY: cp2k_debug_energy_and_forces
17 : USE cp2k_info, ONLY: compile_date,&
18 : compile_revision,&
19 : cp2k_version,&
20 : cp2k_year
21 : USE cp_control_types, ONLY: dft_control_type
22 : USE cp_dbcsr_api, ONLY: dbcsr_finalize_lib,&
23 : dbcsr_init_lib,&
24 : dbcsr_print_config,&
25 : dbcsr_print_statistics
26 : USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_config
27 : USE cp_files, ONLY: close_file,&
28 : open_file
29 : USE cp_log_handling, ONLY: cp_get_default_logger,&
30 : cp_logger_type,&
31 : cp_logger_would_log,&
32 : cp_note_level
33 : USE cp_output_handling, ONLY: cp_add_iter_level,&
34 : cp_print_key_finished_output,&
35 : cp_print_key_unit_nr,&
36 : cp_rm_iter_level
37 : USE cp_parser_methods, ONLY: parser_search_string
38 : USE cp_parser_types, ONLY: cp_parser_type,&
39 : parser_create,&
40 : parser_release
41 : USE cp_units, ONLY: cp_unit_set_create,&
42 : cp_unit_set_release,&
43 : cp_unit_set_type,&
44 : export_units_as_xml
45 : USE dbm_api, ONLY: dbm_library_print_stats
46 : USE environment, ONLY: cp2k_finalize,&
47 : cp2k_init,&
48 : cp2k_read,&
49 : cp2k_setup
50 : USE f77_interface, ONLY: create_force_env,&
51 : destroy_force_env,&
52 : f77_default_para_env => default_para_env,&
53 : f_env_add_defaults,&
54 : f_env_rm_defaults,&
55 : f_env_type
56 : USE farming_methods, ONLY: do_deadlock,&
57 : do_nothing,&
58 : do_wait,&
59 : farming_parse_input,&
60 : get_next_job
61 : USE farming_types, ONLY: deallocate_farming_env,&
62 : farming_env_type,&
63 : init_farming_env,&
64 : job_finished,&
65 : job_running
66 : USE force_env_methods, ONLY: force_env_calc_energy_force
67 : USE force_env_types, ONLY: force_env_get,&
68 : force_env_type
69 : USE geo_opt, ONLY: cp_geo_opt
70 : USE global_types, ONLY: global_environment_type,&
71 : globenv_create,&
72 : globenv_release
73 : USE grid_api, ONLY: grid_library_print_stats,&
74 : grid_library_set_config
75 : USE input_constants, ONLY: &
76 : bsse_run, cell_opt_run, debug_run, do_atom, do_band, do_cp2k, do_embed, do_farming, &
77 : do_fist, do_ipi, do_mixed, do_nnp, do_opt_basis, do_optimize_input, do_qmmm, do_qs, &
78 : do_sirius, do_swarm, do_tamc, do_test, do_tree_mc, do_tree_mc_ana, driver_run, ehrenfest, &
79 : energy_force_run, energy_run, geo_opt_run, history_guess, linear_response_run, mimic_run, &
80 : mol_dyn_run, mon_car_run, mtlr_run, negf_run, none_run, pint_run, real_time_propagation, &
81 : rtp_method_bse, rtp_method_bse_linearized, tree_mc_run, vib_anal
82 : USE input_cp2k, ONLY: create_cp2k_root_section
83 : USE input_cp2k_check, ONLY: check_cp2k_input
84 : USE input_cp2k_global, ONLY: create_global_section
85 : USE input_cp2k_read, ONLY: read_input
86 : USE input_keyword_types, ONLY: keyword_release
87 : USE input_parsing, ONLY: section_vals_parse
88 : USE input_section_types, ONLY: &
89 : section_release, section_type, section_vals_create, section_vals_get, &
90 : section_vals_get_subs_vals, section_vals_release, section_vals_retain, section_vals_type, &
91 : section_vals_val_get, section_vals_write, write_section_xml
92 : USE ipi_driver, ONLY: run_driver
93 : USE kinds, ONLY: default_path_length,&
94 : default_string_length,&
95 : dp,&
96 : int_8
97 : USE library_tests, ONLY: lib_test
98 : USE machine, ONLY: default_output_unit,&
99 : m_chdir,&
100 : m_flush,&
101 : m_getcwd,&
102 : m_memory,&
103 : m_memory_max,&
104 : m_walltime
105 : USE mc_run, ONLY: do_mon_car
106 : USE md_run, ONLY: qs_mol_dyn
107 : USE message_passing, ONLY: mp_any_source,&
108 : mp_comm_type,&
109 : mp_para_env_release,&
110 : mp_para_env_type
111 : USE mimic_loop, ONLY: do_mimic_loop
112 : USE mscfg_methods, ONLY: do_mol_loop,&
113 : loop_over_molecules
114 : USE mtlr_u_j_methods, ONLY: do_mtlr_u_j
115 : USE neb_methods, ONLY: neb
116 : USE negf_methods, ONLY: do_negf
117 : USE offload_api, ONLY: offload_get_chosen_device,&
118 : offload_get_device_count,&
119 : offload_mempool_stats_print
120 : USE optimize_basis, ONLY: run_optimize_basis
121 : USE optimize_input, ONLY: run_optimize_input
122 : USE pint_methods, ONLY: do_pint_run
123 : USE qs_environment_types, ONLY: get_qs_env
124 : USE qs_linres_module, ONLY: linres_calculation
125 : USE reference_manager, ONLY: export_references_as_xml
126 : USE rt_bse, ONLY: run_propagation_bse
127 : USE rt_bse_linearized, ONLY: run_propagation_linearized_bse
128 : USE rt_propagation, ONLY: rt_prop_setup
129 : USE swarm, ONLY: run_swarm
130 : USE tamc_run, ONLY: qs_tamc
131 : USE tmc_setup, ONLY: do_analyze_files,&
132 : do_tmc
133 : USE vibrational_analysis, ONLY: vb_anal
134 : #include "../base/base_uses.f90"
135 :
136 : IMPLICIT NONE
137 :
138 : PRIVATE
139 :
140 : PUBLIC :: write_xml_file, run_input
141 :
142 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp2k_runs'
143 :
144 : CONTAINS
145 :
146 : ! **************************************************************************************************
147 : !> \brief performs an instance of a cp2k run
148 : !> \param input_declaration ...
149 : !> \param input_file_name name of the file to be opened for input
150 : !> \param output_unit unit to which output should be written
151 : !> \param mpi_comm ...
152 : !> \param initial_variables key-value list of initial preprocessor variables
153 : !> \author Joost VandeVondele
154 : !> \note
155 : !> para_env should be a valid communicator
156 : !> output_unit should be writeable by at least the lowest rank of the mpi group
157 : !>
158 : !> recursive because a given run_type might need to be able to perform
159 : !> another cp2k_run as part of its job (e.g. farming, classical equilibration, ...)
160 : !>
161 : !> the idea is that a cp2k instance should be able to run with just three
162 : !> arguments, i.e. a given input file, output unit, mpi communicator.
163 : !> giving these three to cp2k_run should produce a valid run.
164 : !> the only task of the PROGRAM cp2k is to create valid instances of the
165 : !> above arguments. Ideally, anything that is called afterwards should be
166 : !> able to run simultaneously / multithreaded / sequential / parallel / ...
167 : !> and able to fail safe
168 : ! **************************************************************************************************
169 11080 : RECURSIVE SUBROUTINE cp2k_run(input_declaration, input_file_name, output_unit, mpi_comm, initial_variables)
170 : TYPE(section_type), POINTER :: input_declaration
171 : CHARACTER(LEN=*), INTENT(IN) :: input_file_name
172 : INTEGER, INTENT(IN) :: output_unit
173 :
174 : CLASS(mp_comm_type) :: mpi_comm
175 : CHARACTER(len=default_path_length), &
176 : DIMENSION(:, :), INTENT(IN) :: initial_variables
177 :
178 : INTEGER :: f_env_handle, grid_backend, ierr, &
179 : iter_level, method_name_id, &
180 : new_env_id, prog_name_id, run_type_id
181 : #if defined(__DBCSR_ACC)
182 : INTEGER, TARGET :: offload_chosen_device
183 : #endif
184 : INTEGER, POINTER :: active_device_id
185 : INTEGER(KIND=int_8) :: m_memory_max_mpi
186 : LOGICAL :: echo_input, grid_apply_cutoff, &
187 : grid_validate, has_excited_states, has_properties, &
188 : I_was_ionode
189 : TYPE(cp_logger_type), POINTER :: logger, sublogger
190 : TYPE(mp_para_env_type), POINTER :: para_env
191 : TYPE(dft_control_type), POINTER :: dft_control
192 : TYPE(f_env_type), POINTER :: f_env
193 : TYPE(force_env_type), POINTER :: force_env
194 : TYPE(global_environment_type), POINTER :: globenv
195 : TYPE(section_vals_type), POINTER :: glob_section, input_file, root_section, &
196 : section
197 :
198 11080 : NULLIFY (para_env, f_env, dft_control, active_device_id)
199 11080 : ALLOCATE (para_env)
200 11080 : para_env = mpi_comm
201 :
202 : #if defined(__DBCSR_ACC)
203 : IF (offload_get_device_count() > 0) THEN
204 : offload_chosen_device = offload_get_chosen_device()
205 : active_device_id => offload_chosen_device
206 : END IF
207 : #endif
208 : CALL dbcsr_init_lib(mpi_comm%get_handle(), io_unit=output_unit, &
209 11080 : accdrv_active_device_id=active_device_id)
210 :
211 11080 : NULLIFY (globenv, force_env)
212 :
213 11080 : CALL cite_reference(cp2kqs2020)
214 11080 : CALL cite_reference(Iannuzzi2026)
215 :
216 : ! Parse the input
217 : input_file => read_input(input_declaration, input_file_name, &
218 : initial_variables=initial_variables, &
219 11080 : para_env=para_env)
220 :
221 11080 : CALL para_env%sync()
222 :
223 11080 : logger => cp_get_default_logger()
224 :
225 11080 : glob_section => section_vals_get_subs_vals(input_file, "GLOBAL")
226 11080 : CALL section_vals_val_get(glob_section, "ECHO_INPUT", l_val=echo_input)
227 11080 : IF (echo_input .AND. (output_unit > 0)) THEN
228 : CALL section_vals_write(input_file, &
229 : unit_nr=output_unit, &
230 : hide_root=.TRUE., &
231 16 : hide_defaults=.FALSE.)
232 : END IF
233 :
234 11080 : CALL check_cp2k_input(input_declaration, input_file, para_env=para_env, output_unit=output_unit)
235 11080 : root_section => input_file
236 : CALL section_vals_val_get(input_file, "GLOBAL%PROGRAM_NAME", &
237 11080 : i_val=prog_name_id)
238 : CALL section_vals_val_get(input_file, "GLOBAL%RUN_TYPE", &
239 11080 : i_val=run_type_id)
240 11080 : CALL section_vals_val_get(root_section, "FORCE_EVAL%METHOD", i_val=method_name_id)
241 :
242 11080 : IF (prog_name_id /= do_cp2k) THEN
243 : ! initial setup (cp2k does it in the creation of the force_env)
244 528 : CALL globenv_create(globenv)
245 528 : CALL section_vals_retain(input_file)
246 528 : CALL cp2k_init(para_env, output_unit, globenv, input_file_name=input_file_name)
247 528 : CALL cp2k_read(root_section, para_env, globenv)
248 528 : CALL cp2k_setup(root_section, para_env, globenv)
249 : END IF
250 :
251 11080 : CALL cp_dbcsr_config(root_section)
252 11080 : IF (output_unit > 0 .AND. &
253 : cp_logger_would_log(logger, cp_note_level)) THEN
254 5568 : CALL dbcsr_print_config(unit_nr=output_unit)
255 5568 : WRITE (UNIT=output_unit, FMT='()')
256 : END IF
257 :
258 : ! Configure the grid library.
259 11080 : CALL section_vals_val_get(root_section, "GLOBAL%GRID%BACKEND", i_val=grid_backend)
260 11080 : CALL section_vals_val_get(root_section, "GLOBAL%GRID%VALIDATE", l_val=grid_validate)
261 11080 : CALL section_vals_val_get(root_section, "GLOBAL%GRID%APPLY_CUTOFF", l_val=grid_apply_cutoff)
262 :
263 : CALL grid_library_set_config(backend=grid_backend, &
264 : validate=grid_validate, &
265 11080 : apply_cutoff=grid_apply_cutoff)
266 :
267 364 : SELECT CASE (prog_name_id)
268 : CASE (do_atom)
269 364 : globenv%run_type_id = none_run
270 364 : CALL atom_code(root_section)
271 : CASE (do_optimize_input)
272 6 : CALL run_optimize_input(input_declaration, root_section, para_env)
273 : CASE (do_swarm)
274 6 : CALL run_swarm(input_declaration, root_section, para_env, globenv, input_file_name)
275 : CASE (do_farming) ! TODO: refactor cp2k's startup code
276 24 : CALL dbcsr_finalize_lib()
277 24 : CALL farming_run(input_declaration, root_section, para_env, initial_variables)
278 : CALL dbcsr_init_lib(mpi_comm%get_handle(), io_unit=output_unit, &
279 24 : accdrv_active_device_id=active_device_id)
280 : CASE (do_opt_basis)
281 8 : CALL run_optimize_basis(input_declaration, root_section, para_env, globenv)
282 8 : globenv%run_type_id = none_run
283 : CASE (do_cp2k)
284 : CALL create_force_env(new_env_id, &
285 : input_declaration=input_declaration, &
286 : input_path=input_file_name, &
287 : output_path="__STD_OUT__", mpi_comm=para_env, &
288 : output_unit=output_unit, &
289 : owns_out_unit=.FALSE., &
290 10552 : input=input_file, ierr=ierr)
291 10552 : CPASSERT(ierr == 0)
292 10552 : CALL f_env_add_defaults(new_env_id, f_env, handle=f_env_handle)
293 10552 : force_env => f_env%force_env
294 10552 : CALL force_env_get(force_env, globenv=globenv)
295 : CASE (do_test)
296 80 : CALL lib_test(root_section, para_env, globenv)
297 : CASE (do_tree_mc) ! TMC entry point
298 28 : CALL do_tmc(input_declaration, root_section, para_env, globenv)
299 : CASE (do_tree_mc_ana)
300 12 : CALL do_analyze_files(input_declaration, root_section, para_env)
301 : CASE default
302 21632 : CPABORT("Unknown program")
303 : END SELECT
304 11080 : CALL section_vals_release(input_file)
305 :
306 11148 : SELECT CASE (globenv%run_type_id)
307 : CASE (pint_run)
308 68 : CALL do_pint_run(para_env, root_section, input_declaration, globenv)
309 : CASE (none_run, tree_mc_run)
310 : ! do nothing
311 : CASE (driver_run)
312 0 : CALL run_driver(force_env, globenv)
313 : CASE (energy_run, energy_force_run)
314 : IF (method_name_id /= do_qs .AND. &
315 : method_name_id /= do_sirius .AND. &
316 : method_name_id /= do_qmmm .AND. &
317 : method_name_id /= do_mixed .AND. &
318 : method_name_id /= do_nnp .AND. &
319 : method_name_id /= do_embed .AND. &
320 6256 : method_name_id /= do_fist .AND. &
321 : method_name_id /= do_ipi) THEN
322 0 : CPABORT("Energy/Force run not available for all methods ")
323 : END IF
324 :
325 6256 : sublogger => cp_get_default_logger()
326 : CALL cp_add_iter_level(sublogger%iter_info, "JUST_ENERGY", &
327 6256 : n_rlevel_new=iter_level)
328 :
329 : ! loop over molecules to generate a molecular guess
330 : ! this procedure is initiated here to avoid passing globenv deep down
331 : ! the subroutine stack
332 6256 : IF (do_mol_loop(force_env=force_env)) THEN
333 16 : CALL loop_over_molecules(globenv, force_env)
334 : END IF
335 :
336 : ! Only this driver knows that no later geometry step will be requested.
337 : ! Keep history for nested/repeated SCF consumers and for library/shell use.
338 6256 : IF (method_name_id == do_qs) THEN
339 5562 : CALL get_qs_env(force_env%qs_env, dft_control=dft_control)
340 5562 : section => section_vals_get_subs_vals(force_env%qs_env%input, "PROPERTIES")
341 5562 : CALL section_vals_get(section, explicit=has_properties)
342 5562 : section => section_vals_get_subs_vals(force_env%qs_env%input, "DFT%EXCITED_STATES")
343 5562 : CALL section_vals_get(section, explicit=has_excited_states)
344 : force_env%qs_env%skip_wf_history = .NOT. (has_properties .OR. has_excited_states .OR. &
345 : dft_control%qs_control%cdft .OR. &
346 : dft_control%qs_control%et_coupling_calc .OR. &
347 : dft_control%do_xas_calculation .OR. &
348 : dft_control%do_xas_tdp_calculation .OR. &
349 6342 : force_env%qs_env%scf_control%density_guess == history_guess)
350 : END IF
351 :
352 11224 : SELECT CASE (globenv%run_type_id)
353 : CASE (energy_run)
354 4968 : CALL force_env_calc_energy_force(force_env, calc_force=.FALSE.)
355 : CASE (energy_force_run)
356 1288 : CALL force_env_calc_energy_force(force_env, calc_force=.TRUE.)
357 : CASE default
358 6256 : CPABORT("Unknown run type")
359 : END SELECT
360 6256 : IF (method_name_id == do_qs) force_env%qs_env%skip_wf_history = .FALSE.
361 6256 : CALL cp_rm_iter_level(sublogger%iter_info, level_name="JUST_ENERGY", n_rlevel_att=iter_level)
362 : CASE (mol_dyn_run)
363 1648 : CALL qs_mol_dyn(force_env, globenv)
364 : CASE (geo_opt_run)
365 814 : CALL cp_geo_opt(force_env, globenv)
366 : CASE (cell_opt_run)
367 216 : CALL cp_cell_opt(force_env, globenv)
368 : CASE (mon_car_run)
369 20 : CALL do_mon_car(force_env, globenv, input_declaration, input_file_name)
370 : CASE (do_tamc)
371 2 : CALL qs_tamc(force_env, globenv)
372 : CASE (real_time_propagation)
373 210 : IF (method_name_id /= do_qs) THEN
374 0 : CPABORT("Real time propagation needs METHOD QS. ")
375 : END IF
376 210 : CALL get_qs_env(force_env%qs_env, dft_control=dft_control)
377 210 : dft_control%rtp_control%fixed_ions = .TRUE.
378 344 : SELECT CASE (dft_control%rtp_control%rtp_method)
379 : CASE (rtp_method_bse_linearized)
380 : ! Run the linearized TD-BSE method
381 58 : CALL run_propagation_linearized_bse(force_env)
382 : CASE (rtp_method_bse)
383 : ! Run the TD-BSE method
384 14 : CALL run_propagation_bse(force_env)
385 : CASE default
386 : ! Run the TDDFT method
387 210 : CALL rt_prop_setup(force_env)
388 : END SELECT
389 : CASE (ehrenfest)
390 76 : IF (method_name_id /= do_qs) THEN
391 0 : CPABORT("Ehrenfest dynamics needs METHOD QS ")
392 : END IF
393 76 : CALL get_qs_env(force_env%qs_env, dft_control=dft_control)
394 76 : dft_control%rtp_control%fixed_ions = .FALSE.
395 76 : CALL qs_mol_dyn(force_env, globenv)
396 : CASE (bsse_run)
397 12 : CALL do_bsse_calculation(force_env, globenv)
398 : CASE (linear_response_run)
399 188 : IF (method_name_id /= do_qs .AND. &
400 : method_name_id /= do_qmmm) THEN
401 0 : CPABORT("Property calculations by Linear Response only within the QS or QMMM program ")
402 : END IF
403 : ! The Ground State is needed, it can be read from Restart
404 188 : CALL force_env_calc_energy_force(force_env, calc_force=.FALSE., linres=.TRUE.)
405 188 : CALL linres_calculation(force_env)
406 : CASE (debug_run)
407 986 : SELECT CASE (method_name_id)
408 : CASE (do_qs, do_qmmm, do_fist)
409 926 : CALL cp2k_debug_energy_and_forces(force_env)
410 : CASE DEFAULT
411 926 : CPABORT("Debug run available only with QS, FIST, and QMMM program ")
412 : END SELECT
413 : CASE (vib_anal)
414 60 : CALL vb_anal(root_section, input_declaration, para_env, globenv)
415 : CASE (do_band)
416 34 : CALL neb(root_section, input_declaration, para_env, globenv)
417 : CASE (negf_run)
418 6 : CALL do_negf(force_env)
419 : CASE (mimic_run)
420 0 : CALL do_mimic_loop(force_env)
421 : CASE (mtlr_run)
422 16 : IF (method_name_id /= do_qs) THEN
423 0 : CPABORT("RUN_TYPE MTLR is available only for METHOD QS.")
424 : END IF
425 16 : CALL do_mtlr_u_j(force_env)
426 : CASE default
427 17336 : CPABORT("Unknown run type")
428 : END SELECT
429 :
430 : ! Sample peak memory
431 11080 : CALL m_memory()
432 :
433 11080 : CALL dbcsr_print_statistics()
434 11080 : CALL dbm_library_print_stats(mpi_comm=mpi_comm, output_unit=output_unit)
435 11080 : CALL grid_library_print_stats(mpi_comm=mpi_comm, output_unit=output_unit)
436 11080 : CALL offload_mempool_stats_print(mpi_comm=mpi_comm, output_unit=output_unit)
437 :
438 11080 : m_memory_max_mpi = m_memory_max
439 11080 : CALL mpi_comm%max(m_memory_max_mpi)
440 11080 : IF (output_unit > 0) THEN
441 5568 : WRITE (output_unit, *)
442 : WRITE (output_unit, '(T2,"MEMORY| Estimated peak process memory [MiB]",T73,I8)') &
443 5568 : (m_memory_max_mpi + (1024*1024) - 1)/(1024*1024)
444 : END IF
445 :
446 11080 : IF (prog_name_id == do_cp2k) THEN
447 10552 : f_env%force_env => force_env ! for mc
448 10552 : IF (ASSOCIATED(force_env%globenv)) THEN
449 10552 : IF (.NOT. ASSOCIATED(force_env%globenv, globenv)) THEN
450 0 : CALL globenv_release(force_env%globenv) !mc
451 : END IF
452 : END IF
453 10552 : force_env%globenv => globenv !mc
454 : CALL f_env_rm_defaults(f_env, ierr=ierr, &
455 10552 : handle=f_env_handle)
456 10552 : CPASSERT(ierr == 0)
457 10552 : CALL destroy_force_env(new_env_id, ierr=ierr)
458 10552 : CPASSERT(ierr == 0)
459 : ELSE
460 : I_was_ionode = para_env%is_source()
461 528 : CALL cp2k_finalize(root_section, para_env, globenv)
462 528 : CPASSERT(globenv%ref_count == 1)
463 528 : CALL section_vals_release(root_section)
464 528 : CALL globenv_release(globenv)
465 : END IF
466 :
467 11080 : CALL dbcsr_finalize_lib()
468 :
469 11080 : CALL mp_para_env_release(para_env)
470 :
471 11080 : END SUBROUTINE cp2k_run
472 :
473 : ! **************************************************************************************************
474 : !> \brief performs a farming run that performs several independent cp2k_runs
475 : !> \param input_declaration ...
476 : !> \param root_section ...
477 : !> \param para_env ...
478 : !> \param initial_variables ...
479 : !> \author Joost VandeVondele
480 : !> \note
481 : !> needs to be part of this module as the cp2k_run -> farming_run -> cp2k_run
482 : !> calling style creates a hard circular dependency
483 : ! **************************************************************************************************
484 24 : RECURSIVE SUBROUTINE farming_run(input_declaration, root_section, para_env, initial_variables)
485 : TYPE(section_type), POINTER :: input_declaration
486 : TYPE(section_vals_type), POINTER :: root_section
487 : TYPE(mp_para_env_type), POINTER :: para_env
488 : CHARACTER(len=default_path_length), DIMENSION(:, :), INTENT(IN) :: initial_variables
489 :
490 : CHARACTER(len=*), PARAMETER :: routineN = 'farming_run'
491 : INTEGER, PARAMETER :: minion_status_done = -3, &
492 : minion_status_wait = -4
493 :
494 : CHARACTER(len=7) :: label
495 : CHARACTER(LEN=default_path_length) :: output_file
496 : CHARACTER(LEN=default_string_length) :: str
497 : INTEGER :: dest, handle, i, i_job_to_restart, ierr, ijob, ijob_current, &
498 : ijob_end, ijob_start, iunit, n_jobs_to_run, new_output_unit, &
499 : new_rank, ngroups, num_minions, output_unit, primus_minion, &
500 : minion_rank, source, tag, todo
501 24 : INTEGER, DIMENSION(:), POINTER :: group_distribution, &
502 24 : captain_minion_partition, &
503 24 : minion_distribution, &
504 24 : minion_status
505 : LOGICAL :: found, captain, minion
506 : REAL(KIND=dp) :: t1, t2
507 24 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: waittime
508 : TYPE(cp_logger_type), POINTER :: logger
509 : TYPE(cp_parser_type), POINTER :: my_parser
510 : TYPE(cp_unit_set_type) :: default_units
511 : TYPE(farming_env_type), POINTER :: farming_env
512 : TYPE(section_type), POINTER :: g_section
513 : TYPE(section_vals_type), POINTER :: g_data
514 : TYPE(mp_comm_type) :: minion_group, new_group
515 :
516 : ! the primus of all minions, talks to the captain on topics concerning all minions
517 24 : CALL timeset(routineN, handle)
518 24 : NULLIFY (my_parser, g_section, g_data)
519 :
520 24 : logger => cp_get_default_logger()
521 : output_unit = cp_print_key_unit_nr(logger, root_section, "FARMING%PROGRAM_RUN_INFO", &
522 24 : extension=".log")
523 :
524 24 : IF (output_unit > 0) WRITE (output_unit, FMT="(T2,A)") "FARMING| Hi, welcome on this farm!"
525 :
526 24 : ALLOCATE (farming_env)
527 24 : CALL init_farming_env(farming_env)
528 : ! remember where we started
529 24 : CALL m_getcwd(farming_env%cwd)
530 24 : CALL farming_parse_input(farming_env, root_section, para_env)
531 :
532 : ! the full mpi group is first split in a minion group and a captain group, the latter being at most 1 process
533 24 : minion = .TRUE.
534 24 : captain = .FALSE.
535 24 : IF (farming_env%captain_minion) THEN
536 4 : IF (output_unit > 0) WRITE (output_unit, FMT="(T2,A)") "FARMING| Using a Captain-Minion setup"
537 :
538 4 : ALLOCATE (captain_minion_partition(0:1))
539 12 : captain_minion_partition = [1, para_env%num_pe - 1]
540 12 : ALLOCATE (group_distribution(0:para_env%num_pe - 1))
541 :
542 : CALL minion_group%from_split(para_env, ngroups, group_distribution, &
543 4 : n_subgroups=2, group_partition=captain_minion_partition)
544 4 : DEALLOCATE (captain_minion_partition)
545 4 : DEALLOCATE (group_distribution)
546 4 : num_minions = minion_group%num_pe
547 4 : minion_rank = minion_group%mepos
548 :
549 4 : IF (para_env%mepos == 0) THEN
550 2 : minion = .FALSE.
551 2 : captain = .TRUE.
552 : ! on the captain node, num_minions corresponds to the size of the captain group
553 2 : CPASSERT(num_minions == 1)
554 2 : num_minions = para_env%num_pe - 1
555 2 : minion_rank = -1
556 : END IF
557 4 : CPASSERT(num_minions == para_env%num_pe - 1)
558 : ELSE
559 : ! all processes are minions
560 20 : IF (output_unit > 0) WRITE (output_unit, FMT="(T2,A)") "FARMING| Using a Minion-only setup"
561 20 : CALL minion_group%from_dup(para_env)
562 20 : num_minions = minion_group%num_pe
563 20 : minion_rank = minion_group%mepos
564 : END IF
565 24 : IF (output_unit > 0) WRITE (output_unit, FMT="(T2,A,I0)") "FARMING| Number of Minions ", num_minions
566 :
567 : ! keep track of which para_env rank is which minion/captain
568 72 : ALLOCATE (minion_distribution(0:para_env%num_pe - 1))
569 72 : minion_distribution = 0
570 24 : minion_distribution(para_env%mepos) = minion_rank
571 120 : CALL para_env%sum(minion_distribution)
572 : ! we do have a primus inter pares
573 24 : primus_minion = 0
574 48 : DO i = 1, para_env%num_pe - 1
575 48 : IF (minion_distribution(i) == 0) primus_minion = i
576 : END DO
577 :
578 : ! split the current communicator for the minions
579 : ! in a new_group, new_size and new_rank according to the number of groups required according to the input
580 72 : ALLOCATE (group_distribution(0:num_minions - 1))
581 68 : group_distribution = -1
582 24 : IF (minion) THEN
583 22 : IF (farming_env%group_size_wish_set) THEN
584 4 : farming_env%group_size_wish = MIN(farming_env%group_size_wish, para_env%num_pe)
585 : CALL new_group%from_split(minion_group, ngroups, group_distribution, &
586 4 : subgroup_min_size=farming_env%group_size_wish, stride=farming_env%stride)
587 18 : ELSE IF (farming_env%ngroup_wish_set) THEN
588 18 : IF (ASSOCIATED(farming_env%group_partition)) THEN
589 : CALL new_group%from_split(minion_group, ngroups, group_distribution, &
590 : n_subgroups=farming_env%ngroup_wish, &
591 0 : group_partition=farming_env%group_partition, stride=farming_env%stride)
592 : ELSE
593 : CALL new_group%from_split(minion_group, ngroups, group_distribution, &
594 18 : n_subgroups=farming_env%ngroup_wish, stride=farming_env%stride)
595 : END IF
596 : ELSE
597 0 : CPABORT("must set either group_size_wish or ngroup_wish")
598 : END IF
599 22 : new_rank = new_group%mepos
600 : END IF
601 :
602 : ! transfer the info about the minion group distribution to the captain
603 24 : IF (farming_env%captain_minion) THEN
604 4 : IF (para_env%mepos == primus_minion) THEN
605 2 : tag = 1
606 4 : CALL para_env%send(group_distribution, 0, tag)
607 2 : tag = 2
608 2 : CALL para_env%send(ngroups, 0, tag)
609 : END IF
610 4 : IF (para_env%mepos == 0) THEN
611 2 : tag = 1
612 6 : CALL para_env%recv(group_distribution, primus_minion, tag)
613 2 : tag = 2
614 2 : CALL para_env%recv(ngroups, primus_minion, tag)
615 : END IF
616 : END IF
617 :
618 : ! write info on group distribution
619 24 : IF (output_unit > 0) THEN
620 12 : WRITE (output_unit, FMT="(T2,A,T71,I10)") "FARMING| Number of created MPI (Minion) groups:", ngroups
621 12 : WRITE (output_unit, FMT="(T2,A)", ADVANCE="NO") "FARMING| MPI (Minion) process to group correspondence:"
622 34 : DO i = 0, num_minions - 1
623 22 : IF (MODULO(i, 4) == 0) WRITE (output_unit, *)
624 : WRITE (output_unit, FMT='(A3,I6,A3,I6,A1)', ADVANCE="NO") &
625 34 : " (", i, " : ", group_distribution(i), ")"
626 : END DO
627 12 : WRITE (output_unit, *)
628 12 : CALL m_flush(output_unit)
629 : END IF
630 :
631 : ! protect about too many jobs being run in single go. Not more jobs are allowed than the number in the input file
632 : ! and determine the future restart point
633 24 : IF (farming_env%cycle) THEN
634 2 : n_jobs_to_run = farming_env%max_steps*ngroups
635 2 : i_job_to_restart = MODULO(farming_env%restart_n + n_jobs_to_run - 1, farming_env%njobs) + 1
636 : ELSE
637 22 : n_jobs_to_run = MIN(farming_env%njobs, farming_env%max_steps*ngroups)
638 22 : n_jobs_to_run = MIN(n_jobs_to_run, farming_env%njobs - farming_env%restart_n + 1)
639 22 : i_job_to_restart = n_jobs_to_run + farming_env%restart_n
640 : END IF
641 :
642 : ! and write the restart now, that's the point where the next job starts, even if this one is running
643 : iunit = cp_print_key_unit_nr(logger, root_section, "FARMING%RESTART", &
644 24 : extension=".restart")
645 24 : IF (iunit > 0) THEN
646 12 : WRITE (iunit, *) i_job_to_restart
647 : END IF
648 24 : CALL cp_print_key_finished_output(iunit, logger, root_section, "FARMING%RESTART")
649 :
650 : ! this is the job range to be executed.
651 24 : ijob_start = farming_env%restart_n
652 24 : ijob_end = ijob_start + n_jobs_to_run - 1
653 24 : IF (output_unit > 0 .AND. ijob_end - ijob_start < 0) THEN
654 0 : WRITE (output_unit, FMT="(T2,A)") "FARMING| --- WARNING --- NO JOBS NEED EXECUTION ? "
655 0 : WRITE (output_unit, FMT="(T2,A)") "FARMING| is the cycle keyword required ?"
656 0 : WRITE (output_unit, FMT="(T2,A)") "FARMING| or is a stray RESTART file present ?"
657 0 : WRITE (output_unit, FMT="(T2,A)") "FARMING| or is the group_size requested smaller than the number of CPUs?"
658 : END IF
659 :
660 : ! actual executions of the jobs in two different modes
661 24 : IF (farming_env%captain_minion) THEN
662 4 : IF (minion) THEN
663 : ! keep on doing work until captain has decided otherwise
664 2 : todo = do_wait
665 : DO
666 20 : IF (new_rank == 0) THEN
667 : ! the head minion tells the captain he's done or ready to start
668 : ! the message tells what has been done lately
669 20 : tag = 1
670 20 : dest = 0
671 20 : CALL para_env%send(todo, dest, tag)
672 :
673 : ! gets the new todo item
674 20 : tag = 2
675 20 : source = 0
676 20 : CALL para_env%recv(todo, source, tag)
677 :
678 : ! and informs his peer minions
679 20 : CALL new_group%bcast(todo, 0)
680 : ELSE
681 0 : CALL new_group%bcast(todo, 0)
682 : END IF
683 :
684 : ! if the todo is do_nothing we are flagged to quit. Otherwise it is the job number
685 0 : SELECT CASE (todo)
686 : CASE (do_wait, do_deadlock)
687 : ! go for a next round, but we first wait a bit
688 0 : t1 = m_walltime()
689 : DO
690 0 : t2 = m_walltime()
691 0 : IF (t2 - t1 > farming_env%wait_time) EXIT
692 : END DO
693 : CASE (do_nothing)
694 18 : EXIT
695 : CASE (1:)
696 20 : CALL execute_job(todo)
697 : END SELECT
698 : END DO
699 : ELSE ! captain
700 6 : ALLOCATE (minion_status(0:ngroups - 1))
701 4 : minion_status = minion_status_wait
702 2 : ijob_current = ijob_start - 1
703 :
704 20 : DO
705 24 : IF (ALL(minion_status == minion_status_done)) EXIT
706 :
707 : ! who's the next minion waiting for work
708 20 : tag = 1
709 20 : source = mp_any_source
710 20 : CALL para_env%recv(todo, source, tag) ! updates source
711 20 : IF (todo > 0) THEN
712 18 : farming_env%Job(todo)%status = job_finished
713 18 : IF (output_unit > 0) THEN
714 18 : WRITE (output_unit, FMT=*) "Job finished: ", todo
715 18 : CALL m_flush(output_unit)
716 : END IF
717 : END IF
718 :
719 : ! get the next job in line, this could be do_nothing, if we're finished
720 20 : CALL get_next_job(farming_env, ijob_start, ijob_end, ijob_current, todo)
721 20 : dest = source
722 20 : tag = 2
723 20 : CALL para_env%send(todo, dest, tag)
724 :
725 22 : IF (todo > 0) THEN
726 18 : farming_env%Job(todo)%status = job_running
727 18 : IF (output_unit > 0) THEN
728 18 : WRITE (output_unit, FMT=*) "Job: ", todo, " Dir: ", TRIM(farming_env%Job(todo)%cwd), &
729 36 : " assigned to group ", group_distribution(minion_distribution(dest))
730 18 : CALL m_flush(output_unit)
731 : END IF
732 : ELSE
733 2 : IF (todo == do_nothing) THEN
734 2 : minion_status(group_distribution(minion_distribution(dest))) = minion_status_done
735 2 : IF (output_unit > 0) THEN
736 2 : WRITE (output_unit, FMT=*) "group done: ", group_distribution(minion_distribution(dest))
737 2 : CALL m_flush(output_unit)
738 : END IF
739 : END IF
740 2 : IF (todo == do_deadlock) THEN
741 0 : IF (output_unit > 0) THEN
742 0 : WRITE (output_unit, FMT=*) ""
743 0 : WRITE (output_unit, FMT=*) "FARMING JOB DEADLOCKED ... CIRCULAR DEPENDENCIES"
744 0 : WRITE (output_unit, FMT=*) ""
745 0 : CALL m_flush(output_unit)
746 : END IF
747 0 : CPASSERT(todo /= do_deadlock)
748 : END IF
749 : END IF
750 :
751 : END DO
752 :
753 2 : DEALLOCATE (minion_status)
754 :
755 : END IF
756 : ELSE
757 : ! this is the non-captain-minion mode way of executing the jobs
758 : ! the i-th job in the input is always executed by the MODULO(i-1,ngroups)-th group
759 : ! (needed for cyclic runs, we don't want two groups working on the same job)
760 20 : IF (output_unit > 0) THEN
761 10 : IF (ijob_end - ijob_start >= 0) THEN
762 10 : WRITE (output_unit, FMT="(T2,A)") "FARMING| List of jobs : "
763 81 : DO ijob = ijob_start, ijob_end
764 71 : i = MODULO(ijob - 1, farming_env%njobs) + 1
765 71 : WRITE (output_unit, FMT=*) "Job: ", i, " Dir: ", TRIM(farming_env%Job(i)%cwd), " Input: ", &
766 152 : TRIM(farming_env%Job(i)%input), " MPI group:", MODULO(i - 1, ngroups)
767 : END DO
768 : END IF
769 10 : CALL m_flush(output_unit)
770 : END IF
771 :
772 162 : DO ijob = ijob_start, ijob_end
773 142 : i = MODULO(ijob - 1, farming_env%njobs) + 1
774 : ! this farms out the jobs
775 162 : IF (MODULO(i - 1, ngroups) == group_distribution(minion_rank)) THEN
776 104 : IF (output_unit > 0) THEN
777 54 : WRITE (output_unit, FMT="(T2,A,I5.5,A)", ADVANCE="NO") " Running Job ", i, &
778 108 : " in "//TRIM(farming_env%Job(i)%cwd)//"."
779 54 : CALL m_flush(output_unit)
780 : END IF
781 104 : CALL execute_job(i)
782 104 : IF (output_unit > 0) THEN
783 54 : WRITE (output_unit, FMT="(A)") " Done, output in "//TRIM(output_file)
784 54 : CALL m_flush(output_unit)
785 : END IF
786 : END IF
787 : END DO
788 : END IF
789 :
790 : ! keep information about how long each process has to wait
791 : ! i.e. the load imbalance
792 24 : t1 = m_walltime()
793 24 : CALL para_env%sync()
794 24 : t2 = m_walltime()
795 72 : ALLOCATE (waittime(0:para_env%num_pe - 1))
796 24 : waittime = 0.0_dp
797 24 : waittime(para_env%mepos) = t2 - t1
798 24 : CALL para_env%sum(waittime)
799 24 : IF (output_unit > 0) THEN
800 12 : WRITE (output_unit, '(T2,A)') "Process idle times [s] at the end of the run"
801 36 : DO i = 0, para_env%num_pe - 1
802 : WRITE (output_unit, FMT='(A2,I6,A3,F8.3,A1)', ADVANCE="NO") &
803 24 : " (", i, " : ", waittime(i), ")"
804 36 : IF (MOD(i + 1, 4) == 0) WRITE (output_unit, '(A)') ""
805 : END DO
806 12 : CALL m_flush(output_unit)
807 : END IF
808 24 : DEALLOCATE (waittime)
809 :
810 : ! give back the communicators of the split groups
811 24 : IF (minion) CALL new_group%free()
812 24 : CALL minion_group%free()
813 :
814 : ! and message passing deallocate structures
815 24 : DEALLOCATE (group_distribution)
816 24 : DEALLOCATE (minion_distribution)
817 :
818 : ! clean the farming env
819 24 : CALL deallocate_farming_env(farming_env)
820 :
821 : CALL cp_print_key_finished_output(output_unit, logger, root_section, &
822 24 : "FARMING%PROGRAM_RUN_INFO")
823 :
824 312 : CALL timestop(handle)
825 :
826 : CONTAINS
827 : ! **************************************************************************************************
828 : !> \brief ...
829 : !> \param i ...
830 : ! **************************************************************************************************
831 122 : RECURSIVE SUBROUTINE execute_job(i)
832 : INTEGER :: i
833 :
834 : ! change to the new working directory
835 :
836 122 : CALL m_chdir(TRIM(farming_env%Job(i)%cwd), ierr)
837 122 : IF (ierr /= 0) THEN
838 0 : CPABORT("Failed to change dir to: "//TRIM(farming_env%Job(i)%cwd))
839 : END IF
840 :
841 : ! generate a fresh call to cp2k_run
842 122 : IF (new_rank == 0) THEN
843 :
844 89 : IF (farming_env%Job(i)%output == "") THEN
845 : ! generate the output file
846 85 : WRITE (output_file, '(A12,I5.5)') "FARMING_OUT_", i
847 255 : ALLOCATE (my_parser)
848 85 : CALL parser_create(my_parser, file_name=TRIM(farming_env%Job(i)%input))
849 85 : label = "&GLOBAL"
850 85 : CALL parser_search_string(my_parser, label, ignore_case=.TRUE., found=found)
851 170 : IF (found) THEN
852 85 : CALL create_global_section(g_section)
853 85 : CALL section_vals_create(g_data, g_section)
854 : CALL cp_unit_set_create(default_units, "OUTPUT")
855 85 : CALL section_vals_parse(g_data, my_parser, default_units)
856 85 : CALL cp_unit_set_release(default_units)
857 : CALL section_vals_val_get(g_data, "PROJECT", &
858 85 : c_val=str)
859 85 : IF (str /= "") output_file = TRIM(str)//".out"
860 : CALL section_vals_val_get(g_data, "OUTPUT_FILE_NAME", &
861 85 : c_val=str)
862 85 : IF (str /= "") output_file = str
863 85 : CALL section_vals_release(g_data)
864 85 : CALL section_release(g_section)
865 : END IF
866 85 : CALL parser_release(my_parser)
867 85 : DEALLOCATE (my_parser)
868 : ELSE
869 4 : output_file = farming_env%Job(i)%output
870 : END IF
871 :
872 : CALL open_file(file_name=TRIM(output_file), &
873 : file_action="WRITE", &
874 : file_status="UNKNOWN", &
875 : file_position="APPEND", &
876 89 : unit_number=new_output_unit)
877 : ELSE
878 : ! this unit should be negative, otherwise all processors that get a default unit
879 : ! start writing output (to the same file, adding to confusion).
880 : ! error handling should be careful, asking for a local output unit if required
881 33 : new_output_unit = -1
882 : END IF
883 :
884 122 : CALL cp2k_run(input_declaration, TRIM(farming_env%Job(i)%input), new_output_unit, new_group, initial_variables)
885 :
886 122 : IF (new_rank == 0) CALL close_file(unit_number=new_output_unit)
887 :
888 : ! change to the original working directory
889 122 : CALL m_chdir(TRIM(farming_env%cwd), ierr)
890 122 : CPASSERT(ierr == 0)
891 :
892 122 : END SUBROUTINE execute_job
893 : END SUBROUTINE farming_run
894 :
895 : ! **************************************************************************************************
896 : !> \brief ...
897 : ! **************************************************************************************************
898 0 : SUBROUTINE write_xml_file()
899 :
900 : INTEGER :: i, unit_number
901 : TYPE(section_type), POINTER :: root_section
902 :
903 0 : NULLIFY (root_section)
904 0 : CALL create_cp2k_root_section(root_section)
905 0 : CALL keyword_release(root_section%keywords(0)%keyword)
906 : CALL open_file(unit_number=unit_number, &
907 : file_name="cp2k_input.xml", &
908 : file_action="WRITE", &
909 0 : file_status="REPLACE")
910 :
911 0 : WRITE (UNIT=unit_number, FMT="(A)") '<?xml version="1.0" encoding="utf-8"?>'
912 :
913 : !MK CP2K input structure
914 : WRITE (UNIT=unit_number, FMT="(A)") &
915 0 : "<CP2K_INPUT>", &
916 0 : " <CP2K_VERSION>"//TRIM(cp2k_version)//"</CP2K_VERSION>", &
917 0 : " <CP2K_YEAR>"//TRIM(cp2k_year)//"</CP2K_YEAR>", &
918 0 : " <COMPILE_DATE>"//TRIM(compile_date)//"</COMPILE_DATE>", &
919 0 : " <COMPILE_REVISION>"//TRIM(compile_revision)//"</COMPILE_REVISION>"
920 :
921 0 : CALL export_references_as_xml(unit_number)
922 0 : CALL export_units_as_xml(unit_number)
923 :
924 0 : DO i = 1, root_section%n_subsections
925 0 : CALL write_section_xml(root_section%subsections(i)%section, 1, unit_number)
926 : END DO
927 :
928 0 : WRITE (UNIT=unit_number, FMT="(A)") "</CP2K_INPUT>"
929 0 : CALL close_file(unit_number=unit_number)
930 0 : CALL section_release(root_section)
931 :
932 0 : END SUBROUTINE write_xml_file
933 :
934 : ! **************************************************************************************************
935 : !> \brief runs the given input
936 : !> \param input_declaration ...
937 : !> \param input_file_path the path of the input file
938 : !> \param output_file_path path of the output file (to which it is appended)
939 : !> if it is "__STD_OUT__" the default_output_unit is used
940 : !> \param initial_variables key-value list of initial preprocessor variables
941 : !> \param mpi_comm the mpi communicator to be used for this environment
942 : !> it will not be freed
943 : !> \author fawzi
944 : !> \note
945 : !> moved here because of circular dependencies
946 : ! **************************************************************************************************
947 10958 : SUBROUTINE run_input(input_declaration, input_file_path, output_file_path, initial_variables, mpi_comm)
948 : TYPE(section_type), POINTER :: input_declaration
949 : CHARACTER(len=*), INTENT(in) :: input_file_path, output_file_path
950 : CHARACTER(len=default_path_length), &
951 : DIMENSION(:, :), INTENT(IN) :: initial_variables
952 : TYPE(mp_comm_type), INTENT(in), OPTIONAL :: mpi_comm
953 :
954 : INTEGER :: unit_nr
955 : TYPE(mp_para_env_type), POINTER :: para_env
956 :
957 10958 : IF (PRESENT(mpi_comm)) THEN
958 0 : ALLOCATE (para_env)
959 0 : para_env = mpi_comm
960 : ELSE
961 10958 : para_env => f77_default_para_env
962 10958 : CALL para_env%retain()
963 : END IF
964 10958 : IF (para_env%is_source()) THEN
965 5479 : IF (output_file_path == "__STD_OUT__") THEN
966 5479 : unit_nr = default_output_unit
967 : ELSE
968 0 : INQUIRE (FILE=output_file_path, NUMBER=unit_nr)
969 : END IF
970 : ELSE
971 5479 : unit_nr = -1
972 : END IF
973 10958 : CALL cp2k_run(input_declaration, input_file_path, unit_nr, para_env, initial_variables)
974 10958 : CALL mp_para_env_release(para_env)
975 10958 : END SUBROUTINE run_input
976 :
977 : END MODULE cp2k_runs
|
