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