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