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