Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief interface to use cp2k as library
10 : !> \note
11 : !> useful additions for the future would be:
12 : !> - string(path) based set/get of simple values (to change the new
13 : !> input during the run and extract more data (energy types for example).
14 : !> - set/get of a subset of atoms
15 : !> \par History
16 : !> 07.2004 created [fawzi]
17 : !> 11.2004 parallel version [fawzi]
18 : !> \author fawzi & Johanna
19 : ! **************************************************************************************************
20 : MODULE f77_interface
21 : USE base_hooks, ONLY: cp_abort_hook,&
22 : cp_warn_hook,&
23 : timeset_hook,&
24 : timestop_hook
25 : USE bibliography, ONLY: add_all_references
26 : USE cell_methods, ONLY: init_cell
27 : USE cell_types, ONLY: cell_type
28 : USE cp2k_info, ONLY: get_runtime_info
29 : USE cp_dbcsr_api, ONLY: dbcsr_finalize_lib,&
30 : dbcsr_init_lib
31 : USE cp_dlaf_utils_api, ONLY: cp_dlaf_finalize,&
32 : cp_dlaf_free_all_grids
33 : USE cp_error_handling, ONLY: cp_error_handling_setup
34 : USE cp_files, ONLY: init_preconnection_list,&
35 : open_file
36 : USE cp_log_handling, ONLY: &
37 : cp_add_default_logger, cp_default_logger_stack_size, cp_failure_level, &
38 : cp_get_default_logger, cp_logger_create, cp_logger_release, cp_logger_retain, &
39 : cp_logger_type, cp_rm_default_logger, cp_to_string
40 : USE cp_output_handling, ONLY: cp_iterate
41 : USE cp_result_methods, ONLY: get_results,&
42 : test_for_result
43 : USE cp_result_types, ONLY: cp_result_type
44 : USE cp_subsys_types, ONLY: cp_subsys_get,&
45 : cp_subsys_set,&
46 : cp_subsys_type,&
47 : unpack_subsys_particles
48 : USE dbm_api, ONLY: dbm_library_finalize,&
49 : dbm_library_init
50 : USE eip_environment, ONLY: eip_init
51 : USE eip_environment_types, ONLY: eip_env_create,&
52 : eip_environment_type
53 : USE embed_main, ONLY: embed_create_force_env
54 : USE embed_types, ONLY: embed_env_type
55 : USE environment, ONLY: cp2k_finalize,&
56 : cp2k_init,&
57 : cp2k_read,&
58 : cp2k_setup
59 : USE fist_main, ONLY: fist_create_force_env
60 : USE force_env_methods, ONLY: force_env_calc_energy_force,&
61 : force_env_create
62 : USE force_env_types, ONLY: &
63 : force_env_get, force_env_get_frc, force_env_get_natom, force_env_get_nparticle, &
64 : force_env_get_pos, force_env_get_vel, force_env_release, force_env_retain, force_env_set, &
65 : force_env_type, multiple_fe_list
66 : USE fp_types, ONLY: fp_env_create,&
67 : fp_env_read,&
68 : fp_env_write,&
69 : fp_type
70 : USE global_types, ONLY: global_environment_type,&
71 : globenv_create,&
72 : globenv_release
73 : USE grid_api, ONLY: grid_library_finalize,&
74 : grid_library_init
75 : USE input_constants, ONLY: &
76 : do_eip, do_embed, do_fist, do_ipi, do_mixed, do_nnp, do_qmmm, do_qmmmx, do_qs, do_sirius
77 : USE input_cp2k_check, ONLY: check_cp2k_input
78 : USE input_cp2k_force_eval, ONLY: create_force_eval_section
79 : USE input_cp2k_read, ONLY: empty_initial_variables,&
80 : read_input
81 : USE input_enumeration_types, ONLY: enum_i2c,&
82 : enumeration_type
83 : USE input_keyword_types, ONLY: keyword_get,&
84 : keyword_type
85 : USE input_section_types, ONLY: &
86 : section_get_keyword, section_release, section_type, section_vals_duplicate, &
87 : section_vals_get, section_vals_get_subs_vals, section_vals_release, &
88 : section_vals_remove_values, section_vals_retain, section_vals_type, section_vals_val_get, &
89 : section_vals_write
90 : USE ipi_environment, ONLY: ipi_init
91 : USE ipi_environment_types, ONLY: ipi_environment_type
92 : USE kinds, ONLY: default_path_length,&
93 : default_string_length,&
94 : dp
95 : USE machine, ONLY: default_output_unit,&
96 : m_chdir,&
97 : m_getcwd,&
98 : m_memory
99 : USE message_passing, ONLY: mp_comm_type,&
100 : mp_comm_world,&
101 : mp_para_env_release,&
102 : mp_para_env_type,&
103 : mp_world_finalize,&
104 : mp_world_init
105 : USE metadynamics_types, ONLY: meta_env_type
106 : USE metadynamics_utils, ONLY: metadyn_read
107 : USE mixed_environment_types, ONLY: mixed_environment_type
108 : USE mixed_main, ONLY: mixed_create_force_env
109 : USE mp_perf_env, ONLY: add_mp_perf_env,&
110 : get_mp_perf_env,&
111 : mp_perf_env_release,&
112 : mp_perf_env_retain,&
113 : mp_perf_env_type,&
114 : rm_mp_perf_env
115 : USE nnp_environment, ONLY: nnp_init
116 : USE nnp_environment_types, ONLY: nnp_type
117 : USE offload_api, ONLY: offload_get_device_count,&
118 : offload_init,&
119 : offload_set_chosen_device
120 : USE periodic_table, ONLY: init_periodic_table
121 : USE pw_fpga, ONLY: pw_fpga_finalize,&
122 : pw_fpga_init
123 : USE pw_gpu, ONLY: pw_gpu_finalize,&
124 : pw_gpu_init
125 : USE pwdft_environment, ONLY: pwdft_init
126 : USE pwdft_environment_types, ONLY: pwdft_env_create,&
127 : pwdft_environment_type
128 : USE qmmm_create, ONLY: qmmm_env_create
129 : USE qmmm_types, ONLY: qmmm_env_type
130 : USE qmmmx_create, ONLY: qmmmx_env_create
131 : USE qmmmx_types, ONLY: qmmmx_env_type
132 : USE qs_environment, ONLY: qs_init
133 : USE qs_environment_types, ONLY: get_qs_env,&
134 : qs_env_create,&
135 : qs_environment_type
136 : USE reference_manager, ONLY: remove_all_references
137 : USE sirius_interface, ONLY: cp_sirius_finalize,&
138 : cp_sirius_init,&
139 : cp_sirius_is_initialized
140 : USE string_table, ONLY: string_table_allocate,&
141 : string_table_deallocate
142 : USE timings, ONLY: add_timer_env,&
143 : get_timer_env,&
144 : rm_timer_env,&
145 : timer_env_release,&
146 : timer_env_retain,&
147 : timings_register_hooks
148 : USE timings_types, ONLY: timer_env_type
149 : USE virial_types, ONLY: virial_type
150 : #include "./base/base_uses.f90"
151 :
152 : IMPLICIT NONE
153 : PRIVATE
154 :
155 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
156 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'f77_interface'
157 :
158 : ! **************************************************************************************************
159 : TYPE f_env_p_type
160 : TYPE(f_env_type), POINTER :: f_env => NULL()
161 : END TYPE f_env_p_type
162 :
163 : ! **************************************************************************************************
164 : TYPE f_env_type
165 : INTEGER :: id_nr = 0
166 : TYPE(force_env_type), POINTER :: force_env => NULL()
167 : TYPE(cp_logger_type), POINTER :: logger => NULL()
168 : TYPE(timer_env_type), POINTER :: timer_env => NULL()
169 : TYPE(mp_perf_env_type), POINTER :: mp_perf_env => NULL()
170 : CHARACTER(len=default_path_length) :: my_path = "", old_path = ""
171 : END TYPE f_env_type
172 :
173 : TYPE(f_env_p_type), DIMENSION(:), POINTER, SAVE :: f_envs
174 : TYPE(mp_para_env_type), POINTER, SAVE :: default_para_env
175 : LOGICAL, SAVE :: module_initialized = .FALSE.
176 : INTEGER, SAVE :: last_f_env_id = 0, n_f_envs = 0
177 :
178 : PUBLIC :: default_para_env
179 : PUBLIC :: init_cp2k, finalize_cp2k
180 : PUBLIC :: create_force_env, destroy_force_env, set_pos, get_pos, &
181 : get_force, calc_energy_force, get_energy, get_stress_tensor, &
182 : calc_energy, calc_force, check_input, get_natom, get_nparticle, &
183 : f_env_add_defaults, f_env_rm_defaults, f_env_type, &
184 : f_env_get_from_id, &
185 : set_vel, set_cell, get_cell, get_qmmm_cell, get_result_r1
186 : CONTAINS
187 :
188 : ! **************************************************************************************************
189 : !> \brief returns the position of the force env corresponding to the given id
190 : !> \param env_id the id of the requested environment
191 : !> \return ...
192 : !> \author fawzi
193 : !> \note
194 : !> private utility function
195 : ! **************************************************************************************************
196 101288 : FUNCTION get_pos_of_env(env_id) RESULT(res)
197 : INTEGER, INTENT(in) :: env_id
198 : INTEGER :: res
199 :
200 : INTEGER :: env_pos, isub
201 :
202 101288 : env_pos = -1
203 245770 : DO isub = 1, n_f_envs
204 245770 : IF (f_envs(isub)%f_env%id_nr == env_id) THEN
205 101288 : env_pos = isub
206 : END IF
207 : END DO
208 101288 : res = env_pos
209 101288 : END FUNCTION get_pos_of_env
210 :
211 : ! **************************************************************************************************
212 : !> \brief initializes cp2k, needs to be called once before using any of the
213 : !> other functions when using cp2k as library
214 : !> \param init_mpi if the mpi environment should be initialized
215 : !> \param ierr returns a number different from 0 if there was an error
216 : !> \param mpi_comm an existing mpi communicator (if not given mp_comm_world
217 : !> will be used)
218 : !> \author fawzi
219 : ! **************************************************************************************************
220 9284 : SUBROUTINE init_cp2k(init_mpi, ierr, mpi_comm)
221 : LOGICAL, INTENT(in) :: init_mpi
222 : INTEGER, INTENT(out) :: ierr
223 : TYPE(mp_comm_type), INTENT(in), OPTIONAL :: mpi_comm
224 :
225 : INTEGER :: offload_device_count, unit_nr
226 : INTEGER, POINTER :: active_device_id
227 : INTEGER, TARGET :: offload_chosen_device
228 : TYPE(cp_logger_type), POINTER :: logger
229 :
230 9284 : IF (.NOT. module_initialized) THEN
231 : ! install error handler hooks
232 9284 : CALL cp_error_handling_setup()
233 :
234 : ! install timming handler hooks
235 9284 : CALL timings_register_hooks()
236 :
237 : ! Initialise preconnection list
238 9284 : CALL init_preconnection_list()
239 :
240 : ! get runtime information
241 9284 : CALL get_runtime_info()
242 :
243 : ! Intialize CUDA/HIP before MPI
244 : ! Needed for HIP on ALPS & LUMI
245 9284 : CALL offload_init()
246 :
247 : ! re-create the para_env and log with correct (reordered) ranks
248 9284 : ALLOCATE (default_para_env)
249 9284 : IF (init_mpi) THEN
250 : ! get the default system wide communicator
251 9284 : CALL mp_world_init(default_para_env)
252 : ELSE
253 0 : IF (PRESENT(mpi_comm)) THEN
254 0 : default_para_env = mpi_comm
255 : ELSE
256 0 : default_para_env = mp_comm_world
257 : END IF
258 : END IF
259 :
260 9284 : CALL string_table_allocate()
261 9284 : CALL add_mp_perf_env()
262 9284 : CALL add_timer_env()
263 :
264 9284 : IF (default_para_env%is_source()) THEN
265 4642 : unit_nr = default_output_unit
266 : ELSE
267 4642 : unit_nr = -1
268 : END IF
269 9284 : NULLIFY (logger)
270 :
271 : CALL cp_logger_create(logger, para_env=default_para_env, &
272 : default_global_unit_nr=unit_nr, &
273 9284 : close_global_unit_on_dealloc=.FALSE.)
274 9284 : CALL cp_add_default_logger(logger)
275 9284 : CALL cp_logger_release(logger)
276 :
277 9284 : ALLOCATE (f_envs(0))
278 9284 : module_initialized = .TRUE.
279 9284 : ierr = 0
280 :
281 : ! Initialize mathematical constants
282 9284 : CALL init_periodic_table()
283 :
284 : ! Init the bibliography
285 9284 : CALL add_all_references()
286 :
287 9284 : NULLIFY (active_device_id)
288 9284 : offload_device_count = offload_get_device_count()
289 :
290 : ! Select active offload device when available.
291 9284 : IF (offload_device_count > 0) THEN
292 0 : offload_chosen_device = MOD(default_para_env%mepos, offload_device_count)
293 0 : CALL offload_set_chosen_device(offload_chosen_device)
294 0 : active_device_id => offload_chosen_device
295 : END IF
296 :
297 : ! Initialize the DBCSR configuration
298 : ! Attach the time handler hooks to DBCSR
299 : CALL dbcsr_init_lib(default_para_env%get_handle(), timeset_hook, timestop_hook, &
300 : cp_abort_hook, cp_warn_hook, io_unit=unit_nr, &
301 9284 : accdrv_active_device_id=active_device_id)
302 9284 : CALL pw_fpga_init()
303 9284 : CALL pw_gpu_init()
304 9284 : CALL grid_library_init()
305 9284 : CALL dbm_library_init()
306 : ELSE
307 0 : ierr = cp_failure_level
308 : END IF
309 :
310 : !sample peak memory
311 9284 : CALL m_memory()
312 :
313 9284 : END SUBROUTINE init_cp2k
314 :
315 : ! **************************************************************************************************
316 : !> \brief cleanup after you have finished using this interface
317 : !> \param finalize_mpi if the mpi environment should be finalized
318 : !> \param ierr returns a number different from 0 if there was an error
319 : !> \author fawzi
320 : ! **************************************************************************************************
321 9284 : SUBROUTINE finalize_cp2k(finalize_mpi, ierr)
322 : LOGICAL, INTENT(in) :: finalize_mpi
323 : INTEGER, INTENT(out) :: ierr
324 :
325 : INTEGER :: ienv
326 :
327 : !sample peak memory
328 :
329 9284 : CALL m_memory()
330 :
331 9284 : IF (.NOT. module_initialized) THEN
332 0 : ierr = cp_failure_level
333 : ELSE
334 9286 : DO ienv = n_f_envs, 1, -1
335 2 : CALL destroy_force_env(f_envs(ienv)%f_env%id_nr, ierr=ierr)
336 9286 : CPASSERT(ierr == 0)
337 : END DO
338 9284 : DEALLOCATE (f_envs)
339 :
340 : ! Finalize libraries (Offload)
341 9284 : CALL dbm_library_finalize()
342 9284 : CALL grid_library_finalize()
343 9284 : CALL pw_gpu_finalize()
344 9284 : CALL pw_fpga_finalize()
345 9284 : IF (cp_sirius_is_initialized()) CALL cp_sirius_finalize()
346 : ! Finalize the DBCSR library
347 9284 : CALL dbcsr_finalize_lib()
348 :
349 : ! Finalize DLA-Future and pika runtime; if already finalized does nothing
350 9284 : CALL cp_dlaf_free_all_grids()
351 9284 : CALL cp_dlaf_finalize()
352 :
353 9284 : CALL mp_para_env_release(default_para_env)
354 9284 : CALL cp_rm_default_logger()
355 :
356 : ! Deallocate the bibliography
357 9284 : CALL remove_all_references()
358 9284 : CALL rm_timer_env()
359 9284 : CALL rm_mp_perf_env()
360 9284 : CALL string_table_deallocate(0)
361 9284 : IF (finalize_mpi) THEN
362 9284 : CALL mp_world_finalize()
363 : END IF
364 :
365 9284 : ierr = 0
366 : END IF
367 9284 : END SUBROUTINE finalize_cp2k
368 :
369 : ! **************************************************************************************************
370 : !> \brief deallocates a f_env
371 : !> \param f_env the f_env to deallocate
372 : !> \author fawzi
373 : ! **************************************************************************************************
374 9359 : RECURSIVE SUBROUTINE f_env_dealloc(f_env)
375 : TYPE(f_env_type), POINTER :: f_env
376 :
377 : INTEGER :: ierr
378 :
379 9359 : CPASSERT(ASSOCIATED(f_env))
380 9359 : CALL force_env_release(f_env%force_env)
381 9359 : CALL cp_logger_release(f_env%logger)
382 9359 : CALL timer_env_release(f_env%timer_env)
383 9359 : CALL mp_perf_env_release(f_env%mp_perf_env)
384 9359 : IF (f_env%old_path /= f_env%my_path) THEN
385 0 : CALL m_chdir(f_env%old_path, ierr)
386 0 : CPASSERT(ierr == 0)
387 : END IF
388 9359 : END SUBROUTINE f_env_dealloc
389 :
390 : ! **************************************************************************************************
391 : !> \brief createates a f_env
392 : !> \param f_env the f_env to createate
393 : !> \param force_env the force_environment to be stored
394 : !> \param timer_env the timer env to be stored
395 : !> \param mp_perf_env the mp performance environment to be stored
396 : !> \param id_nr ...
397 : !> \param logger ...
398 : !> \param old_dir ...
399 : !> \author fawzi
400 : ! **************************************************************************************************
401 9359 : SUBROUTINE f_env_create(f_env, force_env, timer_env, mp_perf_env, id_nr, logger, old_dir)
402 : TYPE(f_env_type), POINTER :: f_env
403 : TYPE(force_env_type), POINTER :: force_env
404 : TYPE(timer_env_type), POINTER :: timer_env
405 : TYPE(mp_perf_env_type), POINTER :: mp_perf_env
406 : INTEGER, INTENT(in) :: id_nr
407 : TYPE(cp_logger_type), POINTER :: logger
408 : CHARACTER(len=*), INTENT(in) :: old_dir
409 :
410 0 : ALLOCATE (f_env)
411 9359 : f_env%force_env => force_env
412 9359 : CALL force_env_retain(f_env%force_env)
413 9359 : f_env%logger => logger
414 9359 : CALL cp_logger_retain(logger)
415 9359 : f_env%timer_env => timer_env
416 9359 : CALL timer_env_retain(f_env%timer_env)
417 9359 : f_env%mp_perf_env => mp_perf_env
418 9359 : CALL mp_perf_env_retain(f_env%mp_perf_env)
419 9359 : f_env%id_nr = id_nr
420 9359 : CALL m_getcwd(f_env%my_path)
421 9359 : f_env%old_path = old_dir
422 9359 : END SUBROUTINE f_env_create
423 :
424 : ! **************************************************************************************************
425 : !> \brief ...
426 : !> \param f_env_id ...
427 : !> \param f_env ...
428 : ! **************************************************************************************************
429 283 : SUBROUTINE f_env_get_from_id(f_env_id, f_env)
430 : INTEGER, INTENT(in) :: f_env_id
431 : TYPE(f_env_type), POINTER :: f_env
432 :
433 : INTEGER :: f_env_pos
434 :
435 283 : NULLIFY (f_env)
436 283 : f_env_pos = get_pos_of_env(f_env_id)
437 283 : IF (f_env_pos < 1) THEN
438 0 : CPABORT("invalid env_id "//cp_to_string(f_env_id))
439 : ELSE
440 283 : f_env => f_envs(f_env_pos)%f_env
441 : END IF
442 :
443 283 : END SUBROUTINE f_env_get_from_id
444 :
445 : ! **************************************************************************************************
446 : !> \brief adds the default environments of the f_env to the stack of the
447 : !> defaults, and returns a new error and sets failure to true if
448 : !> something went wrong
449 : !> \param f_env_id the f_env from where to take the defaults
450 : !> \param f_env will contain the f_env corresponding to f_env_id
451 : !> \param handle ...
452 : !> \author fawzi
453 : !> \note
454 : !> The following routines need to be synchronized wrt. adding/removing
455 : !> of the default environments (logging, performance,error):
456 : !> environment:cp2k_init, environment:cp2k_finalize,
457 : !> f77_interface:f_env_add_defaults, f77_interface:f_env_rm_defaults,
458 : !> f77_interface:create_force_env, f77_interface:destroy_force_env
459 : ! **************************************************************************************************
460 91646 : SUBROUTINE f_env_add_defaults(f_env_id, f_env, handle)
461 : INTEGER, INTENT(in) :: f_env_id
462 : TYPE(f_env_type), POINTER :: f_env
463 : INTEGER, INTENT(out), OPTIONAL :: handle
464 :
465 : INTEGER :: f_env_pos, ierr
466 : TYPE(cp_logger_type), POINTER :: logger
467 :
468 91646 : NULLIFY (f_env)
469 91646 : f_env_pos = get_pos_of_env(f_env_id)
470 91646 : IF (f_env_pos < 1) THEN
471 0 : CPABORT("invalid env_id "//cp_to_string(f_env_id))
472 : ELSE
473 91646 : f_env => f_envs(f_env_pos)%f_env
474 91646 : logger => f_env%logger
475 91646 : CPASSERT(ASSOCIATED(logger))
476 91646 : CALL m_getcwd(f_env%old_path)
477 91646 : IF (f_env%old_path /= f_env%my_path) THEN
478 0 : CALL m_chdir(TRIM(f_env%my_path), ierr)
479 0 : CPASSERT(ierr == 0)
480 : END IF
481 91646 : CALL add_mp_perf_env(f_env%mp_perf_env)
482 91646 : CALL add_timer_env(f_env%timer_env)
483 91646 : CALL cp_add_default_logger(logger)
484 91646 : IF (PRESENT(handle)) handle = cp_default_logger_stack_size()
485 : END IF
486 91646 : END SUBROUTINE f_env_add_defaults
487 :
488 : ! **************************************************************************************************
489 : !> \brief removes the default environments of the f_env to the stack of the
490 : !> defaults, and sets ierr accordingly to the failuers stored in error
491 : !> It also releases the error
492 : !> \param f_env the f_env from where to take the defaults
493 : !> \param ierr variable that will be set to a number different from 0 if
494 : !> error contains an error (otherwise it will be set to 0)
495 : !> \param handle ...
496 : !> \author fawzi
497 : !> \note
498 : !> The following routines need to be synchronized wrt. adding/removing
499 : !> of the default environments (logging, performance,error):
500 : !> environment:cp2k_init, environment:cp2k_finalize,
501 : !> f77_interface:f_env_add_defaults, f77_interface:f_env_rm_defaults,
502 : !> f77_interface:create_force_env, f77_interface:destroy_force_env
503 : ! **************************************************************************************************
504 91646 : SUBROUTINE f_env_rm_defaults(f_env, ierr, handle)
505 : TYPE(f_env_type), POINTER :: f_env
506 : INTEGER, INTENT(out), OPTIONAL :: ierr
507 : INTEGER, INTENT(in), OPTIONAL :: handle
508 :
509 : INTEGER :: ierr2
510 : TYPE(cp_logger_type), POINTER :: d_logger, logger
511 : TYPE(mp_perf_env_type), POINTER :: d_mp_perf_env
512 : TYPE(timer_env_type), POINTER :: d_timer_env
513 :
514 91646 : IF (ASSOCIATED(f_env)) THEN
515 91646 : IF (PRESENT(handle)) THEN
516 14248 : CPASSERT(handle == cp_default_logger_stack_size())
517 : END IF
518 :
519 91646 : logger => f_env%logger
520 91646 : d_logger => cp_get_default_logger()
521 91646 : d_timer_env => get_timer_env()
522 91646 : d_mp_perf_env => get_mp_perf_env()
523 91646 : CPASSERT(ASSOCIATED(logger))
524 91646 : CPASSERT(ASSOCIATED(d_logger))
525 91646 : CPASSERT(ASSOCIATED(d_timer_env))
526 91646 : CPASSERT(ASSOCIATED(d_mp_perf_env))
527 91646 : CPASSERT(ASSOCIATED(logger, d_logger))
528 : ! CPASSERT(ASSOCIATED(d_timer_env, f_env%timer_env))
529 91646 : CPASSERT(ASSOCIATED(d_mp_perf_env, f_env%mp_perf_env))
530 91646 : IF (f_env%old_path /= f_env%my_path) THEN
531 0 : CALL m_chdir(TRIM(f_env%old_path), ierr2)
532 0 : CPASSERT(ierr2 == 0)
533 : END IF
534 91646 : IF (PRESENT(ierr)) THEN
535 91122 : ierr = 0
536 : END IF
537 91646 : CALL cp_rm_default_logger()
538 91646 : CALL rm_timer_env()
539 91646 : CALL rm_mp_perf_env()
540 : ELSE
541 0 : IF (PRESENT(ierr)) THEN
542 0 : ierr = 0
543 : END IF
544 : END IF
545 91646 : END SUBROUTINE f_env_rm_defaults
546 :
547 : ! **************************************************************************************************
548 : !> \brief creates a new force environment using the given input, and writing
549 : !> the output to the given output unit
550 : !> \param new_env_id will contain the id of the newly created environment
551 : !> \param input_declaration ...
552 : !> \param input_path where to read the input (if the input is given it can
553 : !> a virtual path)
554 : !> \param output_path filename (or name of the unit) for the output
555 : !> \param mpi_comm the mpi communicator to be used for this environment
556 : !> it will not be freed when you get rid of the force_env
557 : !> \param output_unit if given it should be the unit for the output
558 : !> and no file is open (should be valid on the processor with rank 0)
559 : !> \param owns_out_unit if the output unit should be closed upon destroing
560 : !> of the force_env (defaults to true if not default_output_unit)
561 : !> \param input the parsed input, if given and valid it is used
562 : !> instead of parsing from file
563 : !> \param ierr will return a number different from 0 if there was an error
564 : !> \param work_dir ...
565 : !> \param initial_variables key-value list of initial preprocessor variables
566 : !> \author fawzi
567 : !> \note
568 : !> The following routines need to be synchronized wrt. adding/removing
569 : !> of the default environments (logging, performance,error):
570 : !> environment:cp2k_init, environment:cp2k_finalize,
571 : !> f77_interface:f_env_add_defaults, f77_interface:f_env_rm_defaults,
572 : !> f77_interface:create_force_env, f77_interface:destroy_force_env
573 : ! **************************************************************************************************
574 9359 : RECURSIVE SUBROUTINE create_force_env(new_env_id, input_declaration, input_path, &
575 : output_path, mpi_comm, output_unit, owns_out_unit, &
576 86 : input, ierr, work_dir, initial_variables)
577 : INTEGER, INTENT(out) :: new_env_id
578 : TYPE(section_type), POINTER :: input_declaration
579 : CHARACTER(len=*), INTENT(in) :: input_path
580 : CHARACTER(len=*), INTENT(in), OPTIONAL :: output_path
581 :
582 : CLASS(mp_comm_type), INTENT(IN), OPTIONAL :: mpi_comm
583 : INTEGER, INTENT(in), OPTIONAL :: output_unit
584 : LOGICAL, INTENT(in), OPTIONAL :: owns_out_unit
585 : TYPE(section_vals_type), OPTIONAL, POINTER :: input
586 : INTEGER, INTENT(out), OPTIONAL :: ierr
587 : CHARACTER(len=*), INTENT(in), OPTIONAL :: work_dir
588 : CHARACTER(len=*), DIMENSION(:, :), OPTIONAL :: initial_variables
589 :
590 : CHARACTER(len=*), PARAMETER :: routineN = 'create_force_env'
591 :
592 : CHARACTER(len=default_path_length) :: old_dir, wdir
593 : INTEGER :: handle, i, ierr2, iforce_eval, isubforce_eval, k, method_name_id, my_group, &
594 : nforce_eval, ngroups, nsubforce_size, unit_nr
595 9359 : INTEGER, DIMENSION(:), POINTER :: group_distribution, i_force_eval, &
596 9359 : lgroup_distribution
597 : LOGICAL :: check, do_qmmm_force_mixing, multiple_subsys, my_owns_out_unit, &
598 : use_motion_section, use_multiple_para_env
599 : TYPE(cp_logger_type), POINTER :: logger, my_logger
600 : TYPE(mp_para_env_type), POINTER :: my_para_env, para_env
601 : TYPE(eip_environment_type), POINTER :: eip_env
602 : TYPE(embed_env_type), POINTER :: embed_env
603 : TYPE(enumeration_type), POINTER :: enum
604 9359 : TYPE(f_env_p_type), DIMENSION(:), POINTER :: f_envs_old
605 : TYPE(force_env_type), POINTER :: force_env, my_force_env
606 : TYPE(fp_type), POINTER :: fp_env
607 : TYPE(global_environment_type), POINTER :: globenv
608 : TYPE(ipi_environment_type), POINTER :: ipi_env
609 : TYPE(keyword_type), POINTER :: keyword
610 : TYPE(meta_env_type), POINTER :: meta_env
611 : TYPE(mixed_environment_type), POINTER :: mixed_env
612 : TYPE(mp_perf_env_type), POINTER :: mp_perf_env
613 : TYPE(nnp_type), POINTER :: nnp_env
614 : TYPE(pwdft_environment_type), POINTER :: pwdft_env
615 : TYPE(qmmm_env_type), POINTER :: qmmm_env
616 : TYPE(qmmmx_env_type), POINTER :: qmmmx_env
617 : TYPE(qs_environment_type), POINTER :: qs_env
618 : TYPE(section_type), POINTER :: section
619 : TYPE(section_vals_type), POINTER :: fe_section, force_env_section, force_env_sections, &
620 : fp_section, input_file, qmmm_section, qmmmx_section, root_section, subsys_section, &
621 : wrk_section
622 : TYPE(timer_env_type), POINTER :: timer_env
623 :
624 0 : CPASSERT(ASSOCIATED(input_declaration))
625 9359 : NULLIFY (para_env, force_env, timer_env, mp_perf_env, globenv, meta_env, &
626 9359 : fp_env, eip_env, pwdft_env, mixed_env, qs_env, qmmm_env, embed_env)
627 9359 : new_env_id = -1
628 9359 : IF (PRESENT(mpi_comm)) THEN
629 9357 : ALLOCATE (para_env)
630 9357 : para_env = mpi_comm
631 : ELSE
632 2 : para_env => default_para_env
633 2 : CALL para_env%retain()
634 : END IF
635 :
636 9359 : CALL timeset(routineN, handle)
637 :
638 9359 : CALL m_getcwd(old_dir)
639 9359 : wdir = old_dir
640 9359 : IF (PRESENT(work_dir)) THEN
641 0 : IF (work_dir /= " ") THEN
642 0 : CALL m_chdir(work_dir, ierr2)
643 0 : IF (ierr2 /= 0) THEN
644 0 : IF (PRESENT(ierr)) ierr = ierr2
645 0 : RETURN
646 : END IF
647 0 : wdir = work_dir
648 : END IF
649 : END IF
650 :
651 9359 : IF (PRESENT(output_unit)) THEN
652 9093 : unit_nr = output_unit
653 : ELSE
654 266 : IF (para_env%is_source()) THEN
655 207 : IF (output_path == "__STD_OUT__") THEN
656 1 : unit_nr = default_output_unit
657 : ELSE
658 : CALL open_file(file_name=output_path, &
659 : file_status="UNKNOWN", &
660 : file_action="WRITE", &
661 : file_position="APPEND", &
662 206 : unit_number=unit_nr)
663 : END IF
664 : ELSE
665 59 : unit_nr = -1
666 : END IF
667 : END IF
668 :
669 9359 : my_owns_out_unit = unit_nr /= default_output_unit
670 9359 : IF (PRESENT(owns_out_unit)) my_owns_out_unit = owns_out_unit
671 9359 : CALL globenv_create(globenv)
672 : CALL cp2k_init(para_env, output_unit=unit_nr, globenv=globenv, input_file_name=input_path, &
673 9359 : wdir=wdir)
674 9359 : logger => cp_get_default_logger()
675 : ! warning this is dangerous, I did not check that all the subfunctions
676 : ! support it, the program might crash upon error
677 :
678 9359 : NULLIFY (input_file)
679 9359 : IF (PRESENT(input)) input_file => input
680 9359 : IF (.NOT. ASSOCIATED(input_file)) THEN
681 467 : IF (PRESENT(initial_variables)) THEN
682 86 : input_file => read_input(input_declaration, input_path, initial_variables, para_env=para_env)
683 : ELSE
684 381 : input_file => read_input(input_declaration, input_path, empty_initial_variables, para_env=para_env)
685 : END IF
686 : ELSE
687 8892 : CALL section_vals_retain(input_file)
688 : END IF
689 :
690 9359 : CALL check_cp2k_input(input_declaration, input_file, para_env=para_env, output_unit=unit_nr)
691 :
692 9359 : root_section => input_file
693 9359 : CALL section_vals_retain(root_section)
694 :
695 9359 : IF (n_f_envs + 1 > SIZE(f_envs)) THEN
696 8815 : f_envs_old => f_envs
697 114595 : ALLOCATE (f_envs(n_f_envs + 10))
698 8815 : DO i = 1, n_f_envs
699 8815 : f_envs(i)%f_env => f_envs_old(i)%f_env
700 : END DO
701 96965 : DO i = n_f_envs + 1, SIZE(f_envs)
702 96965 : NULLIFY (f_envs(i)%f_env)
703 : END DO
704 8815 : DEALLOCATE (f_envs_old)
705 : END IF
706 :
707 9359 : CALL cp2k_read(root_section, para_env, globenv)
708 :
709 9359 : CALL cp2k_setup(root_section, para_env, globenv)
710 : ! Group Distribution
711 28077 : ALLOCATE (group_distribution(0:para_env%num_pe - 1))
712 27870 : group_distribution = 0
713 9359 : lgroup_distribution => group_distribution
714 : ! Setup all possible force_env
715 9359 : force_env_sections => section_vals_get_subs_vals(root_section, "FORCE_EVAL")
716 : CALL section_vals_val_get(root_section, "MULTIPLE_FORCE_EVALS%MULTIPLE_SUBSYS", &
717 9359 : l_val=multiple_subsys)
718 9359 : CALL multiple_fe_list(force_env_sections, root_section, i_force_eval, nforce_eval)
719 : ! Enforce the deletion of the subsys (unless not explicitly required)
720 9359 : IF (.NOT. multiple_subsys) THEN
721 9557 : DO iforce_eval = 2, nforce_eval
722 : wrk_section => section_vals_get_subs_vals(force_env_sections, "SUBSYS", &
723 246 : i_rep_section=i_force_eval(iforce_eval))
724 9557 : CALL section_vals_remove_values(wrk_section)
725 : END DO
726 : END IF
727 9359 : nsubforce_size = nforce_eval - 1
728 9359 : use_multiple_para_env = .FALSE.
729 9359 : use_motion_section = .TRUE.
730 19116 : DO iforce_eval = 1, nforce_eval
731 9757 : NULLIFY (force_env_section, my_force_env, subsys_section)
732 : ! Reference subsys from the first ordered force_eval
733 9757 : IF (.NOT. multiple_subsys) THEN
734 : subsys_section => section_vals_get_subs_vals(force_env_sections, "SUBSYS", &
735 9557 : i_rep_section=i_force_eval(1))
736 : END IF
737 : ! Handling para_env in case of multiple force_eval
738 9757 : IF (use_multiple_para_env) THEN
739 : ! Check that the order of the force_eval is the correct one
740 : CALL section_vals_val_get(force_env_sections, "METHOD", i_val=method_name_id, &
741 388 : i_rep_section=i_force_eval(1))
742 388 : IF ((method_name_id /= do_mixed) .AND. (method_name_id /= do_embed)) &
743 : CALL cp_abort(__LOCATION__, &
744 : "In case of multiple force_eval the MAIN force_eval (the first in the list of FORCE_EVAL_ORDER or "// &
745 : "the one omitted from that order list) must be a MIXED_ENV type calculation. Please check your "// &
746 0 : "input file and possibly correct the MULTIPLE_FORCE_EVAL%FORCE_EVAL_ORDER. ")
747 :
748 388 : IF (method_name_id == do_mixed) THEN
749 292 : check = ASSOCIATED(force_env%mixed_env%sub_para_env)
750 292 : CPASSERT(check)
751 292 : ngroups = force_env%mixed_env%ngroups
752 292 : my_group = lgroup_distribution(para_env%mepos)
753 292 : isubforce_eval = iforce_eval - 1
754 : ! If task not allocated on this procs skip setup..
755 292 : IF (MODULO(isubforce_eval - 1, ngroups) /= my_group) CYCLE
756 208 : my_para_env => force_env%mixed_env%sub_para_env(my_group + 1)%para_env
757 208 : my_logger => force_env%mixed_env%sub_logger(my_group + 1)%p
758 208 : CALL cp_rm_default_logger()
759 208 : CALL cp_add_default_logger(my_logger)
760 : END IF
761 304 : IF (method_name_id == do_embed) THEN
762 96 : check = ASSOCIATED(force_env%embed_env%sub_para_env)
763 96 : CPASSERT(check)
764 96 : ngroups = force_env%embed_env%ngroups
765 96 : my_group = lgroup_distribution(para_env%mepos)
766 96 : isubforce_eval = iforce_eval - 1
767 : ! If task not allocated on this procs skip setup..
768 96 : IF (MODULO(isubforce_eval - 1, ngroups) /= my_group) CYCLE
769 96 : my_para_env => force_env%embed_env%sub_para_env(my_group + 1)%para_env
770 96 : my_logger => force_env%embed_env%sub_logger(my_group + 1)%p
771 96 : CALL cp_rm_default_logger()
772 96 : CALL cp_add_default_logger(my_logger)
773 : END IF
774 : ELSE
775 9369 : my_para_env => para_env
776 : END IF
777 :
778 : ! Initialize force_env_section
779 : ! No need to allocate one more force_env_section if only 1 force_eval
780 : ! is provided.. this is in order to save memory..
781 9673 : IF (nforce_eval > 1) THEN
782 : CALL section_vals_duplicate(force_env_sections, force_env_section, &
783 476 : i_force_eval(iforce_eval), i_force_eval(iforce_eval))
784 476 : IF (iforce_eval /= 1) use_motion_section = .FALSE.
785 : ELSE
786 9197 : force_env_section => force_env_sections
787 9197 : use_motion_section = .TRUE.
788 : END IF
789 9673 : CALL section_vals_val_get(force_env_section, "METHOD", i_val=method_name_id)
790 :
791 9673 : IF (method_name_id == do_qmmm) THEN
792 334 : qmmmx_section => section_vals_get_subs_vals(force_env_section, "QMMM%FORCE_MIXING")
793 334 : CALL section_vals_get(qmmmx_section, explicit=do_qmmm_force_mixing)
794 334 : IF (do_qmmm_force_mixing) &
795 8 : method_name_id = do_qmmmx ! QMMM Force-Mixing has its own (hidden) method_id
796 : END IF
797 :
798 2249 : SELECT CASE (method_name_id)
799 : CASE (do_fist)
800 : CALL fist_create_force_env(my_force_env, root_section, my_para_env, globenv, &
801 : force_env_section=force_env_section, subsys_section=subsys_section, &
802 2249 : use_motion_section=use_motion_section)
803 :
804 : CASE (do_qs)
805 6900 : ALLOCATE (qs_env)
806 6900 : CALL qs_env_create(qs_env, globenv)
807 : CALL qs_init(qs_env, my_para_env, root_section, globenv=globenv, force_env_section=force_env_section, &
808 6900 : subsys_section=subsys_section, use_motion_section=use_motion_section)
809 : CALL force_env_create(my_force_env, root_section, qs_env=qs_env, para_env=my_para_env, globenv=globenv, &
810 6900 : force_env_section=force_env_section)
811 :
812 : CASE (do_qmmm)
813 326 : qmmm_section => section_vals_get_subs_vals(force_env_section, "QMMM")
814 326 : ALLOCATE (qmmm_env)
815 : CALL qmmm_env_create(qmmm_env, root_section, my_para_env, globenv, &
816 326 : force_env_section, qmmm_section, subsys_section, use_motion_section)
817 : CALL force_env_create(my_force_env, root_section, qmmm_env=qmmm_env, para_env=my_para_env, &
818 326 : globenv=globenv, force_env_section=force_env_section)
819 :
820 : CASE (do_qmmmx)
821 8 : ALLOCATE (qmmmx_env)
822 : CALL qmmmx_env_create(qmmmx_env, root_section, my_para_env, globenv, &
823 8 : force_env_section, subsys_section, use_motion_section)
824 : CALL force_env_create(my_force_env, root_section, qmmmx_env=qmmmx_env, para_env=my_para_env, &
825 8 : globenv=globenv, force_env_section=force_env_section)
826 :
827 : CASE (do_eip)
828 2 : ALLOCATE (eip_env)
829 2 : CALL eip_env_create(eip_env)
830 : CALL eip_init(eip_env, root_section, my_para_env, force_env_section=force_env_section, &
831 2 : subsys_section=subsys_section)
832 : CALL force_env_create(my_force_env, root_section, eip_env=eip_env, para_env=my_para_env, &
833 2 : globenv=globenv, force_env_section=force_env_section)
834 :
835 : CASE (do_sirius)
836 20 : IF (unit_nr > 0) WRITE (UNIT=unit_nr, FMT="(T2,A)", ADVANCE="NO") "SIRIUS| "
837 20 : CALL cp_sirius_init()
838 580 : ALLOCATE (pwdft_env)
839 20 : CALL pwdft_env_create(pwdft_env)
840 : CALL pwdft_init(pwdft_env, root_section, my_para_env, force_env_section=force_env_section, &
841 20 : subsys_section=subsys_section, use_motion_section=use_motion_section)
842 : CALL force_env_create(my_force_env, root_section, pwdft_env=pwdft_env, para_env=my_para_env, &
843 20 : globenv=globenv, force_env_section=force_env_section)
844 :
845 : CASE (do_mixed)
846 130 : ALLOCATE (mixed_env)
847 : CALL mixed_create_force_env(mixed_env, root_section, my_para_env, &
848 : force_env_section=force_env_section, n_subforce_eval=nsubforce_size, &
849 130 : use_motion_section=use_motion_section)
850 : CALL force_env_create(my_force_env, root_section, mixed_env=mixed_env, para_env=my_para_env, &
851 130 : globenv=globenv, force_env_section=force_env_section)
852 : !TODO: the sub_force_envs should really be created via recursion
853 130 : use_multiple_para_env = .TRUE.
854 130 : CALL cp_add_default_logger(logger) ! just to get the logger swapping started
855 130 : lgroup_distribution => my_force_env%mixed_env%group_distribution
856 :
857 : CASE (do_embed)
858 24 : ALLOCATE (embed_env)
859 : CALL embed_create_force_env(embed_env, root_section, my_para_env, &
860 : force_env_section=force_env_section, n_subforce_eval=nsubforce_size, &
861 24 : use_motion_section=use_motion_section)
862 : CALL force_env_create(my_force_env, root_section, embed_env=embed_env, para_env=my_para_env, &
863 24 : globenv=globenv, force_env_section=force_env_section)
864 : !TODO: the sub_force_envs should really be created via recursion
865 24 : use_multiple_para_env = .TRUE.
866 24 : CALL cp_add_default_logger(logger) ! just to get the logger swapping started
867 24 : lgroup_distribution => my_force_env%embed_env%group_distribution
868 :
869 : CASE (do_nnp)
870 14 : ALLOCATE (nnp_env)
871 : CALL nnp_init(nnp_env, root_section, my_para_env, force_env_section=force_env_section, &
872 14 : subsys_section=subsys_section, use_motion_section=use_motion_section)
873 : CALL force_env_create(my_force_env, root_section, nnp_env=nnp_env, para_env=my_para_env, &
874 14 : globenv=globenv, force_env_section=force_env_section)
875 :
876 : CASE (do_ipi)
877 0 : ALLOCATE (ipi_env)
878 : CALL ipi_init(ipi_env, root_section, my_para_env, force_env_section=force_env_section, &
879 0 : subsys_section=subsys_section)
880 : CALL force_env_create(my_force_env, root_section, ipi_env=ipi_env, para_env=my_para_env, &
881 0 : globenv=globenv, force_env_section=force_env_section)
882 :
883 : CASE DEFAULT
884 0 : CALL create_force_eval_section(section)
885 0 : keyword => section_get_keyword(section, "METHOD")
886 0 : CALL keyword_get(keyword, enum=enum)
887 : CALL cp_abort(__LOCATION__, &
888 : "Invalid METHOD <"//TRIM(enum_i2c(enum, method_name_id))// &
889 0 : "> was specified, ")
890 16953 : CALL section_release(section)
891 : END SELECT
892 :
893 9673 : NULLIFY (meta_env, fp_env)
894 9673 : IF (use_motion_section) THEN
895 : ! Metadynamics Setup
896 9359 : fe_section => section_vals_get_subs_vals(root_section, "MOTION%FREE_ENERGY")
897 9359 : CALL metadyn_read(meta_env, my_force_env, root_section, my_para_env, fe_section)
898 9359 : CALL force_env_set(my_force_env, meta_env=meta_env)
899 : ! Flexible Partition Setup
900 9359 : fp_section => section_vals_get_subs_vals(root_section, "MOTION%FLEXIBLE_PARTITIONING")
901 9359 : ALLOCATE (fp_env)
902 9359 : CALL fp_env_create(fp_env)
903 9359 : CALL fp_env_read(fp_env, fp_section)
904 9359 : CALL fp_env_write(fp_env, fp_section)
905 9359 : CALL force_env_set(my_force_env, fp_env=fp_env)
906 : END IF
907 : ! Handle multiple force_eval
908 9673 : IF (nforce_eval > 1 .AND. iforce_eval == 1) THEN
909 884 : ALLOCATE (my_force_env%sub_force_env(nsubforce_size))
910 : ! Nullify subforce_env
911 560 : DO k = 1, nsubforce_size
912 560 : NULLIFY (my_force_env%sub_force_env(k)%force_env)
913 : END DO
914 : END IF
915 : ! Reference the right force_env
916 9359 : IF (iforce_eval == 1) THEN
917 9359 : force_env => my_force_env
918 : ELSE
919 314 : force_env%sub_force_env(iforce_eval - 1)%force_env => my_force_env
920 : END IF
921 : ! Multiple para env for sub_force_eval
922 9673 : IF (.NOT. use_multiple_para_env) THEN
923 27438 : lgroup_distribution = iforce_eval
924 : END IF
925 : ! Release force_env_section
926 28705 : IF (nforce_eval > 1) CALL section_vals_release(force_env_section)
927 : END DO
928 9359 : IF (use_multiple_para_env) &
929 154 : CALL cp_rm_default_logger()
930 9359 : DEALLOCATE (group_distribution)
931 9359 : DEALLOCATE (i_force_eval)
932 9359 : timer_env => get_timer_env()
933 9359 : mp_perf_env => get_mp_perf_env()
934 9359 : CALL para_env%max(last_f_env_id)
935 9359 : last_f_env_id = last_f_env_id + 1
936 9359 : new_env_id = last_f_env_id
937 9359 : n_f_envs = n_f_envs + 1
938 : CALL f_env_create(f_envs(n_f_envs)%f_env, logger=logger, &
939 : timer_env=timer_env, mp_perf_env=mp_perf_env, force_env=force_env, &
940 9359 : id_nr=last_f_env_id, old_dir=old_dir)
941 9359 : CALL force_env_release(force_env)
942 9359 : CALL globenv_release(globenv)
943 9359 : CALL section_vals_release(root_section)
944 9359 : CALL mp_para_env_release(para_env)
945 9359 : CALL f_env_rm_defaults(f_envs(n_f_envs)%f_env, ierr=ierr)
946 9359 : CALL timestop(handle)
947 :
948 37522 : END SUBROUTINE create_force_env
949 :
950 : ! **************************************************************************************************
951 : !> \brief deallocates the force_env with the given id
952 : !> \param env_id the id of the force_env to remove
953 : !> \param ierr will contain a number different from 0 if
954 : !> \param q_finalize ...
955 : !> \author fawzi
956 : !> \note
957 : !> The following routines need to be synchronized wrt. adding/removing
958 : !> of the default environments (logging, performance,error):
959 : !> environment:cp2k_init, environment:cp2k_finalize,
960 : !> f77_interface:f_env_add_defaults, f77_interface:f_env_rm_defaults,
961 : !> f77_interface:create_force_env, f77_interface:destroy_force_env
962 : ! **************************************************************************************************
963 9359 : RECURSIVE SUBROUTINE destroy_force_env(env_id, ierr, q_finalize)
964 : INTEGER, INTENT(in) :: env_id
965 : INTEGER, INTENT(out) :: ierr
966 : LOGICAL, INTENT(IN), OPTIONAL :: q_finalize
967 :
968 : INTEGER :: env_pos, i
969 : TYPE(f_env_type), POINTER :: f_env
970 : TYPE(global_environment_type), POINTER :: globenv
971 : TYPE(mp_para_env_type), POINTER :: para_env
972 : TYPE(section_vals_type), POINTER :: root_section
973 :
974 9359 : NULLIFY (f_env)
975 9359 : CALL f_env_add_defaults(env_id, f_env)
976 9359 : env_pos = get_pos_of_env(env_id)
977 9359 : n_f_envs = n_f_envs - 1
978 9364 : DO i = env_pos, n_f_envs
979 9364 : f_envs(i)%f_env => f_envs(i + 1)%f_env
980 : END DO
981 9359 : NULLIFY (f_envs(n_f_envs + 1)%f_env)
982 :
983 : CALL force_env_get(f_env%force_env, globenv=globenv, &
984 9359 : root_section=root_section, para_env=para_env)
985 :
986 9359 : CPASSERT(ASSOCIATED(globenv))
987 9359 : NULLIFY (f_env%force_env%globenv)
988 9359 : CALL f_env_dealloc(f_env)
989 9359 : IF (PRESENT(q_finalize)) THEN
990 210 : CALL cp2k_finalize(root_section, para_env, globenv, f_env%old_path, q_finalize)
991 : ELSE
992 9149 : CALL cp2k_finalize(root_section, para_env, globenv, f_env%old_path)
993 : END IF
994 9359 : CALL section_vals_release(root_section)
995 9359 : CALL globenv_release(globenv)
996 9359 : DEALLOCATE (f_env)
997 9359 : ierr = 0
998 9359 : END SUBROUTINE destroy_force_env
999 :
1000 : ! **************************************************************************************************
1001 : !> \brief returns the number of atoms in the given force env
1002 : !> \param env_id id of the force_env
1003 : !> \param n_atom ...
1004 : !> \param ierr will return a number different from 0 if there was an error
1005 : !> \date 22.11.2010 (MK)
1006 : !> \author fawzi
1007 : ! **************************************************************************************************
1008 40 : SUBROUTINE get_natom(env_id, n_atom, ierr)
1009 :
1010 : INTEGER, INTENT(IN) :: env_id
1011 : INTEGER, INTENT(OUT) :: n_atom, ierr
1012 :
1013 : TYPE(f_env_type), POINTER :: f_env
1014 :
1015 20 : n_atom = 0
1016 20 : NULLIFY (f_env)
1017 20 : CALL f_env_add_defaults(env_id, f_env)
1018 20 : n_atom = force_env_get_natom(f_env%force_env)
1019 20 : CALL f_env_rm_defaults(f_env, ierr)
1020 :
1021 20 : END SUBROUTINE get_natom
1022 :
1023 : ! **************************************************************************************************
1024 : !> \brief returns the number of particles in the given force env
1025 : !> \param env_id id of the force_env
1026 : !> \param n_particle ...
1027 : !> \param ierr will return a number different from 0 if there was an error
1028 : !> \author Matthias Krack
1029 : !>
1030 : ! **************************************************************************************************
1031 288 : SUBROUTINE get_nparticle(env_id, n_particle, ierr)
1032 :
1033 : INTEGER, INTENT(IN) :: env_id
1034 : INTEGER, INTENT(OUT) :: n_particle, ierr
1035 :
1036 : TYPE(f_env_type), POINTER :: f_env
1037 :
1038 144 : n_particle = 0
1039 144 : NULLIFY (f_env)
1040 144 : CALL f_env_add_defaults(env_id, f_env)
1041 144 : n_particle = force_env_get_nparticle(f_env%force_env)
1042 144 : CALL f_env_rm_defaults(f_env, ierr)
1043 :
1044 144 : END SUBROUTINE get_nparticle
1045 :
1046 : ! **************************************************************************************************
1047 : !> \brief gets a cell
1048 : !> \param env_id id of the force_env
1049 : !> \param cell the array with the cell matrix
1050 : !> \param per periodicity
1051 : !> \param ierr will return a number different from 0 if there was an error
1052 : !> \author Joost VandeVondele
1053 : ! **************************************************************************************************
1054 0 : SUBROUTINE get_cell(env_id, cell, per, ierr)
1055 :
1056 : INTEGER, INTENT(IN) :: env_id
1057 : REAL(KIND=DP), DIMENSION(3, 3) :: cell
1058 : INTEGER, DIMENSION(3), OPTIONAL :: per
1059 : INTEGER, INTENT(OUT) :: ierr
1060 :
1061 : TYPE(cell_type), POINTER :: cell_full
1062 : TYPE(f_env_type), POINTER :: f_env
1063 :
1064 0 : NULLIFY (f_env)
1065 0 : CALL f_env_add_defaults(env_id, f_env)
1066 0 : NULLIFY (cell_full)
1067 0 : CALL force_env_get(f_env%force_env, cell=cell_full)
1068 0 : CPASSERT(ASSOCIATED(cell_full))
1069 0 : cell = cell_full%hmat
1070 0 : IF (PRESENT(per)) per(:) = cell_full%perd(:)
1071 0 : CALL f_env_rm_defaults(f_env, ierr)
1072 :
1073 0 : END SUBROUTINE get_cell
1074 :
1075 : ! **************************************************************************************************
1076 : !> \brief gets the qmmm cell
1077 : !> \param env_id id of the force_env
1078 : !> \param cell the array with the cell matrix
1079 : !> \param ierr will return a number different from 0 if there was an error
1080 : !> \author Holly Judge
1081 : ! **************************************************************************************************
1082 0 : SUBROUTINE get_qmmm_cell(env_id, cell, ierr)
1083 :
1084 : INTEGER, INTENT(IN) :: env_id
1085 : REAL(KIND=DP), DIMENSION(3, 3) :: cell
1086 : INTEGER, INTENT(OUT) :: ierr
1087 :
1088 : TYPE(cell_type), POINTER :: cell_qmmm
1089 : TYPE(f_env_type), POINTER :: f_env
1090 : TYPE(qmmm_env_type), POINTER :: qmmm_env
1091 :
1092 0 : NULLIFY (f_env)
1093 0 : CALL f_env_add_defaults(env_id, f_env)
1094 0 : NULLIFY (cell_qmmm)
1095 0 : CALL force_env_get(f_env%force_env, qmmm_env=qmmm_env)
1096 0 : CALL get_qs_env(qmmm_env%qs_env, cell=cell_qmmm)
1097 0 : CPASSERT(ASSOCIATED(cell_qmmm))
1098 0 : cell = cell_qmmm%hmat
1099 0 : CALL f_env_rm_defaults(f_env, ierr)
1100 :
1101 0 : END SUBROUTINE get_qmmm_cell
1102 :
1103 : ! **************************************************************************************************
1104 : !> \brief gets a result from CP2K that is a real 1D array
1105 : !> \param env_id id of the force_env
1106 : !> \param description the tag of the result
1107 : !> \param N ...
1108 : !> \param RESULT ...
1109 : !> \param res_exist ...
1110 : !> \param ierr will return a number different from 0 if there was an error
1111 : !> \author Joost VandeVondele
1112 : ! **************************************************************************************************
1113 0 : SUBROUTINE get_result_r1(env_id, description, N, RESULT, res_exist, ierr)
1114 : INTEGER :: env_id
1115 : CHARACTER(LEN=default_string_length) :: description
1116 : INTEGER :: N
1117 : REAL(KIND=dp), DIMENSION(1:N) :: RESULT
1118 : LOGICAL, OPTIONAL :: res_exist
1119 : INTEGER :: ierr
1120 :
1121 : INTEGER :: nres
1122 : LOGICAL :: exist_res
1123 : TYPE(cp_result_type), POINTER :: results
1124 : TYPE(cp_subsys_type), POINTER :: subsys
1125 : TYPE(f_env_type), POINTER :: f_env
1126 :
1127 0 : NULLIFY (f_env, subsys, results)
1128 0 : CALL f_env_add_defaults(env_id, f_env)
1129 :
1130 0 : CALL force_env_get(f_env%force_env, subsys=subsys)
1131 0 : CALL cp_subsys_get(subsys, results=results)
1132 : ! first test for the result
1133 0 : IF (PRESENT(res_exist)) THEN
1134 0 : res_exist = test_for_result(results, description=description)
1135 : exist_res = res_exist
1136 : ELSE
1137 : exist_res = .TRUE.
1138 : END IF
1139 : ! if existing (or assuming the existence) read the results
1140 0 : IF (exist_res) THEN
1141 0 : CALL get_results(results, description=description, n_rep=nres)
1142 0 : CALL get_results(results, description=description, values=RESULT, nval=nres)
1143 : END IF
1144 :
1145 0 : CALL f_env_rm_defaults(f_env, ierr)
1146 :
1147 0 : END SUBROUTINE get_result_r1
1148 :
1149 : ! **************************************************************************************************
1150 : !> \brief gets the forces of the particles
1151 : !> \param env_id id of the force_env
1152 : !> \param frc the array where to write the forces
1153 : !> \param n_el number of positions (3*nparticle) just to check
1154 : !> \param ierr will return a number different from 0 if there was an error
1155 : !> \date 22.11.2010 (MK)
1156 : !> \author fawzi
1157 : ! **************************************************************************************************
1158 18476 : SUBROUTINE get_force(env_id, frc, n_el, ierr)
1159 :
1160 : INTEGER, INTENT(IN) :: env_id, n_el
1161 : REAL(KIND=dp), DIMENSION(1:n_el) :: frc
1162 : INTEGER, INTENT(OUT) :: ierr
1163 :
1164 : TYPE(f_env_type), POINTER :: f_env
1165 :
1166 9238 : NULLIFY (f_env)
1167 9238 : CALL f_env_add_defaults(env_id, f_env)
1168 9238 : CALL force_env_get_frc(f_env%force_env, frc, n_el)
1169 9238 : CALL f_env_rm_defaults(f_env, ierr)
1170 :
1171 9238 : END SUBROUTINE get_force
1172 :
1173 : ! **************************************************************************************************
1174 : !> \brief gets the stress tensor
1175 : !> \param env_id id of the force_env
1176 : !> \param stress_tensor the array where to write the stress tensor
1177 : !> \param ierr will return a number different from 0 if there was an error
1178 : !> \author Ole Schuett
1179 : ! **************************************************************************************************
1180 0 : SUBROUTINE get_stress_tensor(env_id, stress_tensor, ierr)
1181 :
1182 : INTEGER, INTENT(IN) :: env_id
1183 : REAL(KIND=dp), DIMENSION(3, 3), INTENT(OUT) :: stress_tensor
1184 : INTEGER, INTENT(OUT) :: ierr
1185 :
1186 : TYPE(cell_type), POINTER :: cell
1187 : TYPE(cp_subsys_type), POINTER :: subsys
1188 : TYPE(f_env_type), POINTER :: f_env
1189 : TYPE(virial_type), POINTER :: virial
1190 :
1191 0 : NULLIFY (f_env, subsys, virial, cell)
1192 0 : stress_tensor(:, :) = 0.0_dp
1193 :
1194 0 : CALL f_env_add_defaults(env_id, f_env)
1195 0 : CALL force_env_get(f_env%force_env, subsys=subsys, cell=cell)
1196 0 : CALL cp_subsys_get(subsys, virial=virial)
1197 0 : IF (virial%pv_availability) THEN
1198 0 : stress_tensor(:, :) = virial%pv_virial(:, :)/cell%deth
1199 : END IF
1200 0 : CALL f_env_rm_defaults(f_env, ierr)
1201 :
1202 0 : END SUBROUTINE get_stress_tensor
1203 :
1204 : ! **************************************************************************************************
1205 : !> \brief gets the positions of the particles
1206 : !> \param env_id id of the force_env
1207 : !> \param pos the array where to write the positions
1208 : !> \param n_el number of positions (3*nparticle) just to check
1209 : !> \param ierr will return a number different from 0 if there was an error
1210 : !> \date 22.11.2010 (MK)
1211 : !> \author fawzi
1212 : ! **************************************************************************************************
1213 680 : SUBROUTINE get_pos(env_id, pos, n_el, ierr)
1214 :
1215 : INTEGER, INTENT(IN) :: env_id, n_el
1216 : REAL(KIND=DP), DIMENSION(1:n_el) :: pos
1217 : INTEGER, INTENT(OUT) :: ierr
1218 :
1219 : TYPE(f_env_type), POINTER :: f_env
1220 :
1221 340 : NULLIFY (f_env)
1222 340 : CALL f_env_add_defaults(env_id, f_env)
1223 340 : CALL force_env_get_pos(f_env%force_env, pos, n_el)
1224 340 : CALL f_env_rm_defaults(f_env, ierr)
1225 :
1226 340 : END SUBROUTINE get_pos
1227 :
1228 : ! **************************************************************************************************
1229 : !> \brief gets the velocities of the particles
1230 : !> \param env_id id of the force_env
1231 : !> \param vel the array where to write the velocities
1232 : !> \param n_el number of velocities (3*nparticle) just to check
1233 : !> \param ierr will return a number different from 0 if there was an error
1234 : !> \author fawzi
1235 : !> date 22.11.2010 (MK)
1236 : ! **************************************************************************************************
1237 0 : SUBROUTINE get_vel(env_id, vel, n_el, ierr)
1238 :
1239 : INTEGER, INTENT(IN) :: env_id, n_el
1240 : REAL(KIND=DP), DIMENSION(1:n_el) :: vel
1241 : INTEGER, INTENT(OUT) :: ierr
1242 :
1243 : TYPE(f_env_type), POINTER :: f_env
1244 :
1245 0 : NULLIFY (f_env)
1246 0 : CALL f_env_add_defaults(env_id, f_env)
1247 0 : CALL force_env_get_vel(f_env%force_env, vel, n_el)
1248 0 : CALL f_env_rm_defaults(f_env, ierr)
1249 :
1250 0 : END SUBROUTINE get_vel
1251 :
1252 : ! **************************************************************************************************
1253 : !> \brief sets a new cell
1254 : !> \param env_id id of the force_env
1255 : !> \param new_cell the array with the cell matrix
1256 : !> \param ierr will return a number different from 0 if there was an error
1257 : !> \author Joost VandeVondele
1258 : ! **************************************************************************************************
1259 8304 : SUBROUTINE set_cell(env_id, new_cell, ierr)
1260 :
1261 : INTEGER, INTENT(IN) :: env_id
1262 : REAL(KIND=DP), DIMENSION(3, 3) :: new_cell
1263 : INTEGER, INTENT(OUT) :: ierr
1264 :
1265 : TYPE(cell_type), POINTER :: cell
1266 : TYPE(cp_subsys_type), POINTER :: subsys
1267 : TYPE(f_env_type), POINTER :: f_env
1268 :
1269 4152 : NULLIFY (f_env, cell, subsys)
1270 4152 : CALL f_env_add_defaults(env_id, f_env)
1271 4152 : NULLIFY (cell)
1272 4152 : CALL force_env_get(f_env%force_env, cell=cell)
1273 4152 : CPASSERT(ASSOCIATED(cell))
1274 53976 : cell%hmat = new_cell
1275 4152 : CALL init_cell(cell)
1276 4152 : CALL force_env_get(f_env%force_env, subsys=subsys)
1277 4152 : CALL cp_subsys_set(subsys, cell=cell)
1278 4152 : CALL f_env_rm_defaults(f_env, ierr)
1279 :
1280 4152 : END SUBROUTINE set_cell
1281 :
1282 : ! **************************************************************************************************
1283 : !> \brief sets the positions of the particles
1284 : !> \param env_id id of the force_env
1285 : !> \param new_pos the array with the new positions
1286 : !> \param n_el number of positions (3*nparticle) just to check
1287 : !> \param ierr will return a number different from 0 if there was an error
1288 : !> \date 22.11.2010 updated (MK)
1289 : !> \author fawzi
1290 : ! **************************************************************************************************
1291 26614 : SUBROUTINE set_pos(env_id, new_pos, n_el, ierr)
1292 :
1293 : INTEGER, INTENT(IN) :: env_id, n_el
1294 : REAL(KIND=dp), DIMENSION(1:n_el) :: new_pos
1295 : INTEGER, INTENT(OUT) :: ierr
1296 :
1297 : TYPE(cp_subsys_type), POINTER :: subsys
1298 : TYPE(f_env_type), POINTER :: f_env
1299 :
1300 13307 : NULLIFY (f_env)
1301 13307 : CALL f_env_add_defaults(env_id, f_env)
1302 13307 : NULLIFY (subsys)
1303 13307 : CALL force_env_get(f_env%force_env, subsys=subsys)
1304 13307 : CALL unpack_subsys_particles(subsys=subsys, r=new_pos)
1305 13307 : CALL f_env_rm_defaults(f_env, ierr)
1306 :
1307 13307 : END SUBROUTINE set_pos
1308 :
1309 : ! **************************************************************************************************
1310 : !> \brief sets the velocities of the particles
1311 : !> \param env_id id of the force_env
1312 : !> \param new_vel the array with the new velocities
1313 : !> \param n_el number of velocities (3*nparticle) just to check
1314 : !> \param ierr will return a number different from 0 if there was an error
1315 : !> \date 22.11.2010 updated (MK)
1316 : !> \author fawzi
1317 : ! **************************************************************************************************
1318 288 : SUBROUTINE set_vel(env_id, new_vel, n_el, ierr)
1319 :
1320 : INTEGER, INTENT(IN) :: env_id, n_el
1321 : REAL(kind=dp), DIMENSION(1:n_el) :: new_vel
1322 : INTEGER, INTENT(OUT) :: ierr
1323 :
1324 : TYPE(cp_subsys_type), POINTER :: subsys
1325 : TYPE(f_env_type), POINTER :: f_env
1326 :
1327 144 : NULLIFY (f_env)
1328 144 : CALL f_env_add_defaults(env_id, f_env)
1329 144 : NULLIFY (subsys)
1330 144 : CALL force_env_get(f_env%force_env, subsys=subsys)
1331 144 : CALL unpack_subsys_particles(subsys=subsys, v=new_vel)
1332 144 : CALL f_env_rm_defaults(f_env, ierr)
1333 :
1334 144 : END SUBROUTINE set_vel
1335 :
1336 : ! **************************************************************************************************
1337 : !> \brief updates the energy and the forces of given force_env
1338 : !> \param env_id id of the force_env that you want to update
1339 : !> \param calc_force if the forces should be updated, if false the forces
1340 : !> might be wrong.
1341 : !> \param ierr will return a number different from 0 if there was an error
1342 : !> \author fawzi
1343 : ! **************************************************************************************************
1344 26474 : RECURSIVE SUBROUTINE calc_energy_force(env_id, calc_force, ierr)
1345 :
1346 : INTEGER, INTENT(in) :: env_id
1347 : LOGICAL, INTENT(in) :: calc_force
1348 : INTEGER, INTENT(out) :: ierr
1349 :
1350 : TYPE(cp_logger_type), POINTER :: logger
1351 : TYPE(f_env_type), POINTER :: f_env
1352 :
1353 13237 : NULLIFY (f_env)
1354 13237 : CALL f_env_add_defaults(env_id, f_env)
1355 13237 : logger => cp_get_default_logger()
1356 13237 : CALL cp_iterate(logger%iter_info) ! add one to the iteration count
1357 13237 : CALL force_env_calc_energy_force(f_env%force_env, calc_force=calc_force)
1358 13237 : CALL f_env_rm_defaults(f_env, ierr)
1359 :
1360 13237 : END SUBROUTINE calc_energy_force
1361 :
1362 : ! **************************************************************************************************
1363 : !> \brief returns the energy of the last configuration calculated
1364 : !> \param env_id id of the force_env that you want to update
1365 : !> \param e_pot the potential energy of the system
1366 : !> \param ierr will return a number different from 0 if there was an error
1367 : !> \author fawzi
1368 : ! **************************************************************************************************
1369 39891 : SUBROUTINE get_energy(env_id, e_pot, ierr)
1370 :
1371 : INTEGER, INTENT(in) :: env_id
1372 : REAL(kind=dp), INTENT(out) :: e_pot
1373 : INTEGER, INTENT(out) :: ierr
1374 :
1375 : TYPE(f_env_type), POINTER :: f_env
1376 :
1377 13297 : NULLIFY (f_env)
1378 13297 : CALL f_env_add_defaults(env_id, f_env)
1379 13297 : CALL force_env_get(f_env%force_env, potential_energy=e_pot)
1380 13297 : CALL f_env_rm_defaults(f_env, ierr)
1381 :
1382 13297 : END SUBROUTINE get_energy
1383 :
1384 : ! **************************************************************************************************
1385 : !> \brief returns the energy of the configuration given by the positions
1386 : !> passed as argument
1387 : !> \param env_id id of the force_env that you want to update
1388 : !> \param pos array with the positions
1389 : !> \param n_el number of elements in pos (3*natom)
1390 : !> \param e_pot the potential energy of the system
1391 : !> \param ierr will return a number different from 0 if there was an error
1392 : !> \author fawzi
1393 : !> \note
1394 : !> utility call
1395 : ! **************************************************************************************************
1396 4057 : RECURSIVE SUBROUTINE calc_energy(env_id, pos, n_el, e_pot, ierr)
1397 :
1398 : INTEGER, INTENT(IN) :: env_id, n_el
1399 : REAL(KIND=dp), DIMENSION(1:n_el), INTENT(IN) :: pos
1400 : REAL(KIND=dp), INTENT(OUT) :: e_pot
1401 : INTEGER, INTENT(OUT) :: ierr
1402 :
1403 : REAL(KIND=dp), DIMENSION(1) :: dummy_f
1404 :
1405 4057 : CALL calc_force(env_id, pos, n_el, e_pot, dummy_f, 0, ierr)
1406 :
1407 4057 : END SUBROUTINE calc_energy
1408 :
1409 : ! **************************************************************************************************
1410 : !> \brief returns the energy of the configuration given by the positions
1411 : !> passed as argument
1412 : !> \param env_id id of the force_env that you want to update
1413 : !> \param pos array with the positions
1414 : !> \param n_el_pos number of elements in pos (3*natom)
1415 : !> \param e_pot the potential energy of the system
1416 : !> \param force array that will contain the forces
1417 : !> \param n_el_force number of elements in force (3*natom). If 0 the
1418 : !> forces are not calculated
1419 : !> \param ierr will return a number different from 0 if there was an error
1420 : !> \author fawzi
1421 : !> \note
1422 : !> utility call, but actually it could be a better and more efficient
1423 : !> interface to connect to other codes if cp2k would be deeply
1424 : !> refactored
1425 : ! **************************************************************************************************
1426 13235 : RECURSIVE SUBROUTINE calc_force(env_id, pos, n_el_pos, e_pot, force, n_el_force, ierr)
1427 :
1428 : INTEGER, INTENT(in) :: env_id, n_el_pos
1429 : REAL(kind=dp), DIMENSION(1:n_el_pos), INTENT(in) :: pos
1430 : REAL(kind=dp), INTENT(out) :: e_pot
1431 : INTEGER, INTENT(in) :: n_el_force
1432 : REAL(kind=dp), DIMENSION(1:n_el_force), &
1433 : INTENT(inout) :: force
1434 : INTEGER, INTENT(out) :: ierr
1435 :
1436 : LOGICAL :: calc_f
1437 :
1438 13235 : calc_f = (n_el_force /= 0)
1439 13235 : CALL set_pos(env_id, pos, n_el_pos, ierr)
1440 13235 : IF (ierr == 0) CALL calc_energy_force(env_id, calc_f, ierr)
1441 13235 : IF (ierr == 0) CALL get_energy(env_id, e_pot, ierr)
1442 13235 : IF (calc_f .AND. (ierr == 0)) CALL get_force(env_id, force, n_el_force, ierr)
1443 :
1444 13235 : END SUBROUTINE calc_force
1445 :
1446 : ! **************************************************************************************************
1447 : !> \brief performs a check of the input
1448 : !> \param input_declaration ...
1449 : !> \param input_file_path the path of the input file to check
1450 : !> \param output_file_path path of the output file (to which it is appended)
1451 : !> if it is "__STD_OUT__" the default_output_unit is used
1452 : !> \param echo_input if the parsed input should be written out with all the
1453 : !> defaults made explicit
1454 : !> \param mpi_comm the mpi communicator (if not given it uses the default
1455 : !> one)
1456 : !> \param initial_variables key-value list of initial preprocessor variables
1457 : !> \param ierr error control, if different from 0 there was an error
1458 : !> \author fawzi
1459 : ! **************************************************************************************************
1460 0 : SUBROUTINE check_input(input_declaration, input_file_path, output_file_path, &
1461 0 : echo_input, mpi_comm, initial_variables, ierr)
1462 : TYPE(section_type), POINTER :: input_declaration
1463 : CHARACTER(len=*), INTENT(in) :: input_file_path, output_file_path
1464 : LOGICAL, INTENT(in), OPTIONAL :: echo_input
1465 : TYPE(mp_comm_type), INTENT(in), OPTIONAL :: mpi_comm
1466 : CHARACTER(len=default_path_length), &
1467 : DIMENSION(:, :), INTENT(IN) :: initial_variables
1468 : INTEGER, INTENT(out) :: ierr
1469 :
1470 : INTEGER :: unit_nr
1471 : LOGICAL :: my_echo_input
1472 : TYPE(cp_logger_type), POINTER :: logger
1473 : TYPE(mp_para_env_type), POINTER :: para_env
1474 : TYPE(section_vals_type), POINTER :: input_file
1475 :
1476 0 : my_echo_input = .FALSE.
1477 0 : IF (PRESENT(echo_input)) my_echo_input = echo_input
1478 :
1479 0 : IF (PRESENT(mpi_comm)) THEN
1480 0 : ALLOCATE (para_env)
1481 0 : para_env = mpi_comm
1482 : ELSE
1483 0 : para_env => default_para_env
1484 0 : CALL para_env%retain()
1485 : END IF
1486 0 : IF (para_env%is_source()) THEN
1487 0 : IF (output_file_path == "__STD_OUT__") THEN
1488 0 : unit_nr = default_output_unit
1489 : ELSE
1490 : CALL open_file(file_name=output_file_path, file_status="UNKNOWN", &
1491 : file_action="WRITE", file_position="APPEND", &
1492 0 : unit_number=unit_nr)
1493 : END IF
1494 : ELSE
1495 0 : unit_nr = -1
1496 : END IF
1497 :
1498 0 : NULLIFY (logger)
1499 : CALL cp_logger_create(logger, para_env=para_env, &
1500 : default_global_unit_nr=unit_nr, &
1501 0 : close_global_unit_on_dealloc=.FALSE.)
1502 0 : CALL cp_add_default_logger(logger)
1503 0 : CALL cp_logger_release(logger)
1504 :
1505 : input_file => read_input(input_declaration, input_file_path, initial_variables=initial_variables, &
1506 0 : para_env=para_env)
1507 0 : CALL check_cp2k_input(input_declaration, input_file, para_env=para_env, output_unit=unit_nr)
1508 0 : IF (my_echo_input .AND. (unit_nr > 0)) THEN
1509 : CALL section_vals_write(input_file, &
1510 : unit_nr=unit_nr, &
1511 : hide_root=.TRUE., &
1512 0 : hide_defaults=.FALSE.)
1513 : END IF
1514 0 : CALL section_vals_release(input_file)
1515 :
1516 0 : CALL cp_logger_release(logger)
1517 0 : CALL mp_para_env_release(para_env)
1518 0 : ierr = 0
1519 0 : CALL cp_rm_default_logger()
1520 :
1521 0 : END SUBROUTINE check_input
1522 :
1523 0 : END MODULE f77_interface
|
