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 101303 : 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 101303 : env_pos = -1
203 245800 : DO isub = 1, n_f_envs
204 245800 : IF (f_envs(isub)%f_env%id_nr == env_id) THEN
205 101303 : env_pos = isub
206 : END IF
207 : END DO
208 101303 : res = env_pos
209 101303 : 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 9286 : 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 9286 : IF (.NOT. module_initialized) THEN
231 : ! install error handler hooks
232 9286 : CALL cp_error_handling_setup()
233 :
234 : ! install timming handler hooks
235 9286 : CALL timings_register_hooks()
236 :
237 : ! Initialise preconnection list
238 9286 : CALL init_preconnection_list()
239 :
240 : ! get runtime information
241 9286 : CALL get_runtime_info()
242 :
243 : ! Intialize CUDA/HIP before MPI
244 : ! Needed for HIP on ALPS & LUMI
245 9286 : CALL offload_init()
246 :
247 : ! re-create the para_env and log with correct (reordered) ranks
248 9286 : ALLOCATE (default_para_env)
249 9286 : IF (init_mpi) THEN
250 : ! get the default system wide communicator
251 9286 : 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 9286 : CALL string_table_allocate()
261 9286 : CALL add_mp_perf_env()
262 9286 : CALL add_timer_env()
263 :
264 9286 : IF (default_para_env%is_source()) THEN
265 4643 : unit_nr = default_output_unit
266 : ELSE
267 4643 : unit_nr = -1
268 : END IF
269 9286 : NULLIFY (logger)
270 :
271 : CALL cp_logger_create(logger, para_env=default_para_env, &
272 : default_global_unit_nr=unit_nr, &
273 9286 : close_global_unit_on_dealloc=.FALSE.)
274 9286 : CALL cp_add_default_logger(logger)
275 9286 : CALL cp_logger_release(logger)
276 :
277 9286 : ALLOCATE (f_envs(0))
278 9286 : module_initialized = .TRUE.
279 9286 : ierr = 0
280 :
281 : ! Initialize mathematical constants
282 9286 : CALL init_periodic_table()
283 :
284 : ! Init the bibliography
285 9286 : CALL add_all_references()
286 :
287 9286 : NULLIFY (active_device_id)
288 9286 : offload_device_count = offload_get_device_count()
289 :
290 : ! Select active offload device when available.
291 9286 : 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 9286 : accdrv_active_device_id=active_device_id)
302 9286 : CALL pw_fpga_init()
303 9286 : CALL pw_gpu_init()
304 9286 : CALL grid_library_init()
305 9286 : CALL dbm_library_init()
306 : ELSE
307 0 : ierr = cp_failure_level
308 : END IF
309 :
310 : !sample peak memory
311 9286 : CALL m_memory()
312 :
313 9286 : 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 9286 : 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 9286 : CALL m_memory()
330 :
331 9286 : IF (.NOT. module_initialized) THEN
332 0 : ierr = cp_failure_level
333 : ELSE
334 9288 : DO ienv = n_f_envs, 1, -1
335 2 : CALL destroy_force_env(f_envs(ienv)%f_env%id_nr, ierr=ierr)
336 9288 : CPASSERT(ierr == 0)
337 : END DO
338 9286 : DEALLOCATE (f_envs)
339 :
340 : ! Finalize libraries (Offload)
341 9286 : CALL dbm_library_finalize()
342 9286 : CALL grid_library_finalize()
343 9286 : CALL pw_gpu_finalize()
344 9286 : CALL pw_fpga_finalize()
345 9286 : IF (cp_sirius_is_initialized()) CALL cp_sirius_finalize()
346 : ! Finalize the DBCSR library
347 9286 : CALL dbcsr_finalize_lib()
348 :
349 : ! Finalize DLA-Future and pika runtime; if already finalized does nothing
350 9286 : CALL cp_dlaf_free_all_grids()
351 9286 : CALL cp_dlaf_finalize()
352 :
353 9286 : CALL mp_para_env_release(default_para_env)
354 9286 : CALL cp_rm_default_logger()
355 :
356 : ! Deallocate the bibliography
357 9286 : CALL remove_all_references()
358 9286 : CALL rm_timer_env()
359 9286 : CALL rm_mp_perf_env()
360 9286 : CALL string_table_deallocate(0)
361 9286 : IF (finalize_mpi) THEN
362 9286 : CALL mp_world_finalize()
363 : END IF
364 :
365 9286 : ierr = 0
366 : END IF
367 9286 : 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 9361 : RECURSIVE SUBROUTINE f_env_dealloc(f_env)
375 : TYPE(f_env_type), POINTER :: f_env
376 :
377 : INTEGER :: ierr
378 :
379 9361 : CPASSERT(ASSOCIATED(f_env))
380 9361 : CALL force_env_release(f_env%force_env)
381 9361 : CALL cp_logger_release(f_env%logger)
382 9361 : CALL timer_env_release(f_env%timer_env)
383 9361 : CALL mp_perf_env_release(f_env%mp_perf_env)
384 9361 : 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 9361 : 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 9361 : 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 9361 : f_env%force_env => force_env
412 9361 : CALL force_env_retain(f_env%force_env)
413 9361 : f_env%logger => logger
414 9361 : CALL cp_logger_retain(logger)
415 9361 : f_env%timer_env => timer_env
416 9361 : CALL timer_env_retain(f_env%timer_env)
417 9361 : f_env%mp_perf_env => mp_perf_env
418 9361 : CALL mp_perf_env_retain(f_env%mp_perf_env)
419 9361 : f_env%id_nr = id_nr
420 9361 : CALL m_getcwd(f_env%my_path)
421 9361 : f_env%old_path = old_dir
422 9361 : 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 91659 : 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 91659 : NULLIFY (f_env)
469 91659 : f_env_pos = get_pos_of_env(f_env_id)
470 91659 : IF (f_env_pos < 1) THEN
471 0 : CPABORT("invalid env_id "//cp_to_string(f_env_id))
472 : ELSE
473 91659 : f_env => f_envs(f_env_pos)%f_env
474 91659 : logger => f_env%logger
475 91659 : CPASSERT(ASSOCIATED(logger))
476 91659 : CALL m_getcwd(f_env%old_path)
477 91659 : 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 91659 : CALL add_mp_perf_env(f_env%mp_perf_env)
482 91659 : CALL add_timer_env(f_env%timer_env)
483 91659 : CALL cp_add_default_logger(logger)
484 91659 : IF (PRESENT(handle)) handle = cp_default_logger_stack_size()
485 : END IF
486 91659 : 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 91659 : 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 91659 : IF (ASSOCIATED(f_env)) THEN
515 91659 : IF (PRESENT(handle)) THEN
516 14250 : CPASSERT(handle == cp_default_logger_stack_size())
517 : END IF
518 :
519 91659 : logger => f_env%logger
520 91659 : d_logger => cp_get_default_logger()
521 91659 : d_timer_env => get_timer_env()
522 91659 : d_mp_perf_env => get_mp_perf_env()
523 91659 : CPASSERT(ASSOCIATED(logger))
524 91659 : CPASSERT(ASSOCIATED(d_logger))
525 91659 : CPASSERT(ASSOCIATED(d_timer_env))
526 91659 : CPASSERT(ASSOCIATED(d_mp_perf_env))
527 91659 : CPASSERT(ASSOCIATED(logger, d_logger))
528 : ! CPASSERT(ASSOCIATED(d_timer_env, f_env%timer_env))
529 91659 : CPASSERT(ASSOCIATED(d_mp_perf_env, f_env%mp_perf_env))
530 91659 : 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 91659 : IF (PRESENT(ierr)) THEN
535 91135 : ierr = 0
536 : END IF
537 91659 : CALL cp_rm_default_logger()
538 91659 : CALL rm_timer_env()
539 91659 : CALL rm_mp_perf_env()
540 : ELSE
541 0 : IF (PRESENT(ierr)) THEN
542 0 : ierr = 0
543 : END IF
544 : END IF
545 91659 : 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 9361 : 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 9361 : INTEGER, DIMENSION(:), POINTER :: group_distribution, i_force_eval, &
596 9361 : 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 9361 : 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 9361 : NULLIFY (para_env, force_env, timer_env, mp_perf_env, globenv, meta_env, &
626 9361 : fp_env, eip_env, pwdft_env, mixed_env, qs_env, qmmm_env, embed_env)
627 9361 : new_env_id = -1
628 9361 : IF (PRESENT(mpi_comm)) THEN
629 9359 : ALLOCATE (para_env)
630 9359 : para_env = mpi_comm
631 : ELSE
632 2 : para_env => default_para_env
633 2 : CALL para_env%retain()
634 : END IF
635 :
636 9361 : CALL timeset(routineN, handle)
637 :
638 9361 : CALL m_getcwd(old_dir)
639 9361 : wdir = old_dir
640 9361 : 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 9361 : IF (PRESENT(output_unit)) THEN
652 9095 : 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 9361 : my_owns_out_unit = unit_nr /= default_output_unit
670 9361 : IF (PRESENT(owns_out_unit)) my_owns_out_unit = owns_out_unit
671 9361 : CALL globenv_create(globenv)
672 : CALL cp2k_init(para_env, output_unit=unit_nr, globenv=globenv, input_file_name=input_path, &
673 9361 : wdir=wdir)
674 9361 : 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 9361 : NULLIFY (input_file)
679 9361 : IF (PRESENT(input)) input_file => input
680 9361 : 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 8894 : CALL section_vals_retain(input_file)
688 : END IF
689 :
690 9361 : CALL check_cp2k_input(input_declaration, input_file, para_env=para_env, output_unit=unit_nr)
691 :
692 9361 : root_section => input_file
693 9361 : CALL section_vals_retain(root_section)
694 :
695 9361 : IF (n_f_envs + 1 > SIZE(f_envs)) THEN
696 8817 : f_envs_old => f_envs
697 114621 : ALLOCATE (f_envs(n_f_envs + 10))
698 8817 : DO i = 1, n_f_envs
699 8817 : f_envs(i)%f_env => f_envs_old(i)%f_env
700 : END DO
701 96987 : DO i = n_f_envs + 1, SIZE(f_envs)
702 96987 : NULLIFY (f_envs(i)%f_env)
703 : END DO
704 8817 : DEALLOCATE (f_envs_old)
705 : END IF
706 :
707 9361 : CALL cp2k_read(root_section, para_env, globenv)
708 :
709 9361 : CALL cp2k_setup(root_section, para_env, globenv)
710 : ! Group Distribution
711 28083 : ALLOCATE (group_distribution(0:para_env%num_pe - 1))
712 27876 : group_distribution = 0
713 9361 : lgroup_distribution => group_distribution
714 : ! Setup all possible force_env
715 9361 : 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 9361 : l_val=multiple_subsys)
718 9361 : 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 9361 : IF (.NOT. multiple_subsys) THEN
721 9559 : 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 9559 : CALL section_vals_remove_values(wrk_section)
725 : END DO
726 : END IF
727 9361 : nsubforce_size = nforce_eval - 1
728 9361 : use_multiple_para_env = .FALSE.
729 9361 : use_motion_section = .TRUE.
730 19120 : DO iforce_eval = 1, nforce_eval
731 9759 : NULLIFY (force_env_section, my_force_env, subsys_section)
732 : ! Reference subsys from the first ordered force_eval
733 9759 : IF (.NOT. multiple_subsys) THEN
734 : subsys_section => section_vals_get_subs_vals(force_env_sections, "SUBSYS", &
735 9559 : i_rep_section=i_force_eval(1))
736 : END IF
737 : ! Handling para_env in case of multiple force_eval
738 9759 : 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 9371 : 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 9675 : 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 9199 : force_env_section => force_env_sections
787 9199 : use_motion_section = .TRUE.
788 : END IF
789 9675 : CALL section_vals_val_get(force_env_section, "METHOD", i_val=method_name_id)
790 :
791 9675 : 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 6902 : ALLOCATE (qs_env)
806 6902 : 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 6902 : 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 6902 : 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 (.NOT. cp_sirius_is_initialized()) THEN
837 20 : IF (unit_nr > 0) WRITE (UNIT=unit_nr, FMT="(T2,A)", ADVANCE="NO") "SIRIUS| "
838 20 : CALL cp_sirius_init()
839 : END IF
840 580 : ALLOCATE (pwdft_env)
841 20 : CALL pwdft_env_create(pwdft_env)
842 : CALL pwdft_init(pwdft_env, root_section, my_para_env, force_env_section=force_env_section, &
843 20 : subsys_section=subsys_section, use_motion_section=use_motion_section)
844 : CALL force_env_create(my_force_env, root_section, pwdft_env=pwdft_env, para_env=my_para_env, &
845 20 : globenv=globenv, force_env_section=force_env_section)
846 :
847 : CASE (do_mixed)
848 130 : ALLOCATE (mixed_env)
849 : CALL mixed_create_force_env(mixed_env, root_section, my_para_env, &
850 : force_env_section=force_env_section, n_subforce_eval=nsubforce_size, &
851 130 : use_motion_section=use_motion_section)
852 : CALL force_env_create(my_force_env, root_section, mixed_env=mixed_env, para_env=my_para_env, &
853 130 : globenv=globenv, force_env_section=force_env_section)
854 : !TODO: the sub_force_envs should really be created via recursion
855 130 : use_multiple_para_env = .TRUE.
856 130 : CALL cp_add_default_logger(logger) ! just to get the logger swapping started
857 130 : lgroup_distribution => my_force_env%mixed_env%group_distribution
858 :
859 : CASE (do_embed)
860 24 : ALLOCATE (embed_env)
861 : CALL embed_create_force_env(embed_env, root_section, my_para_env, &
862 : force_env_section=force_env_section, n_subforce_eval=nsubforce_size, &
863 24 : use_motion_section=use_motion_section)
864 : CALL force_env_create(my_force_env, root_section, embed_env=embed_env, para_env=my_para_env, &
865 24 : globenv=globenv, force_env_section=force_env_section)
866 : !TODO: the sub_force_envs should really be created via recursion
867 24 : use_multiple_para_env = .TRUE.
868 24 : CALL cp_add_default_logger(logger) ! just to get the logger swapping started
869 24 : lgroup_distribution => my_force_env%embed_env%group_distribution
870 :
871 : CASE (do_nnp)
872 14 : ALLOCATE (nnp_env)
873 : CALL nnp_init(nnp_env, root_section, my_para_env, force_env_section=force_env_section, &
874 14 : subsys_section=subsys_section, use_motion_section=use_motion_section)
875 : CALL force_env_create(my_force_env, root_section, nnp_env=nnp_env, para_env=my_para_env, &
876 14 : globenv=globenv, force_env_section=force_env_section)
877 :
878 : CASE (do_ipi)
879 0 : ALLOCATE (ipi_env)
880 : CALL ipi_init(ipi_env, root_section, my_para_env, force_env_section=force_env_section, &
881 0 : subsys_section=subsys_section)
882 : CALL force_env_create(my_force_env, root_section, ipi_env=ipi_env, para_env=my_para_env, &
883 0 : globenv=globenv, force_env_section=force_env_section)
884 :
885 : CASE DEFAULT
886 0 : CALL create_force_eval_section(section)
887 0 : keyword => section_get_keyword(section, "METHOD")
888 0 : CALL keyword_get(keyword, enum=enum)
889 : CALL cp_abort(__LOCATION__, &
890 : "Invalid METHOD <"//TRIM(enum_i2c(enum, method_name_id))// &
891 0 : "> was specified, ")
892 16957 : CALL section_release(section)
893 : END SELECT
894 :
895 9675 : NULLIFY (meta_env, fp_env)
896 9675 : IF (use_motion_section) THEN
897 : ! Metadynamics Setup
898 9361 : fe_section => section_vals_get_subs_vals(root_section, "MOTION%FREE_ENERGY")
899 9361 : CALL metadyn_read(meta_env, my_force_env, root_section, my_para_env, fe_section)
900 9361 : CALL force_env_set(my_force_env, meta_env=meta_env)
901 : ! Flexible Partition Setup
902 9361 : fp_section => section_vals_get_subs_vals(root_section, "MOTION%FLEXIBLE_PARTITIONING")
903 9361 : ALLOCATE (fp_env)
904 9361 : CALL fp_env_create(fp_env)
905 9361 : CALL fp_env_read(fp_env, fp_section)
906 9361 : CALL fp_env_write(fp_env, fp_section)
907 9361 : CALL force_env_set(my_force_env, fp_env=fp_env)
908 : END IF
909 : ! Handle multiple force_eval
910 9675 : IF (nforce_eval > 1 .AND. iforce_eval == 1) THEN
911 884 : ALLOCATE (my_force_env%sub_force_env(nsubforce_size))
912 : ! Nullify subforce_env
913 560 : DO k = 1, nsubforce_size
914 560 : NULLIFY (my_force_env%sub_force_env(k)%force_env)
915 : END DO
916 : END IF
917 : ! Reference the right force_env
918 9361 : IF (iforce_eval == 1) THEN
919 9361 : force_env => my_force_env
920 : ELSE
921 314 : force_env%sub_force_env(iforce_eval - 1)%force_env => my_force_env
922 : END IF
923 : ! Multiple para env for sub_force_eval
924 9675 : IF (.NOT. use_multiple_para_env) THEN
925 27444 : lgroup_distribution = iforce_eval
926 : END IF
927 : ! Release force_env_section
928 28711 : IF (nforce_eval > 1) CALL section_vals_release(force_env_section)
929 : END DO
930 9361 : IF (use_multiple_para_env) &
931 154 : CALL cp_rm_default_logger()
932 9361 : DEALLOCATE (group_distribution)
933 9361 : DEALLOCATE (i_force_eval)
934 9361 : timer_env => get_timer_env()
935 9361 : mp_perf_env => get_mp_perf_env()
936 9361 : CALL para_env%max(last_f_env_id)
937 9361 : last_f_env_id = last_f_env_id + 1
938 9361 : new_env_id = last_f_env_id
939 9361 : n_f_envs = n_f_envs + 1
940 : CALL f_env_create(f_envs(n_f_envs)%f_env, logger=logger, &
941 : timer_env=timer_env, mp_perf_env=mp_perf_env, force_env=force_env, &
942 9361 : id_nr=last_f_env_id, old_dir=old_dir)
943 9361 : CALL force_env_release(force_env)
944 9361 : CALL globenv_release(globenv)
945 9361 : CALL section_vals_release(root_section)
946 9361 : CALL mp_para_env_release(para_env)
947 9361 : CALL f_env_rm_defaults(f_envs(n_f_envs)%f_env, ierr=ierr)
948 9361 : CALL timestop(handle)
949 :
950 37530 : END SUBROUTINE create_force_env
951 :
952 : ! **************************************************************************************************
953 : !> \brief deallocates the force_env with the given id
954 : !> \param env_id the id of the force_env to remove
955 : !> \param ierr will contain a number different from 0 if
956 : !> \param q_finalize ...
957 : !> \author fawzi
958 : !> \note
959 : !> The following routines need to be synchronized wrt. adding/removing
960 : !> of the default environments (logging, performance,error):
961 : !> environment:cp2k_init, environment:cp2k_finalize,
962 : !> f77_interface:f_env_add_defaults, f77_interface:f_env_rm_defaults,
963 : !> f77_interface:create_force_env, f77_interface:destroy_force_env
964 : ! **************************************************************************************************
965 9361 : RECURSIVE SUBROUTINE destroy_force_env(env_id, ierr, q_finalize)
966 : INTEGER, INTENT(in) :: env_id
967 : INTEGER, INTENT(out) :: ierr
968 : LOGICAL, INTENT(IN), OPTIONAL :: q_finalize
969 :
970 : INTEGER :: env_pos, i
971 : TYPE(f_env_type), POINTER :: f_env
972 : TYPE(global_environment_type), POINTER :: globenv
973 : TYPE(mp_para_env_type), POINTER :: para_env
974 : TYPE(section_vals_type), POINTER :: root_section
975 :
976 9361 : NULLIFY (f_env)
977 9361 : CALL f_env_add_defaults(env_id, f_env)
978 9361 : env_pos = get_pos_of_env(env_id)
979 9361 : n_f_envs = n_f_envs - 1
980 9366 : DO i = env_pos, n_f_envs
981 9366 : f_envs(i)%f_env => f_envs(i + 1)%f_env
982 : END DO
983 9361 : NULLIFY (f_envs(n_f_envs + 1)%f_env)
984 :
985 : CALL force_env_get(f_env%force_env, globenv=globenv, &
986 9361 : root_section=root_section, para_env=para_env)
987 :
988 9361 : CPASSERT(ASSOCIATED(globenv))
989 9361 : NULLIFY (f_env%force_env%globenv)
990 9361 : CALL f_env_dealloc(f_env)
991 9361 : IF (PRESENT(q_finalize)) THEN
992 210 : CALL cp2k_finalize(root_section, para_env, globenv, f_env%old_path, q_finalize)
993 : ELSE
994 9151 : CALL cp2k_finalize(root_section, para_env, globenv, f_env%old_path)
995 : END IF
996 9361 : CALL section_vals_release(root_section)
997 9361 : CALL globenv_release(globenv)
998 9361 : DEALLOCATE (f_env)
999 9361 : ierr = 0
1000 9361 : END SUBROUTINE destroy_force_env
1001 :
1002 : ! **************************************************************************************************
1003 : !> \brief returns the number of atoms in the given force env
1004 : !> \param env_id id of the force_env
1005 : !> \param n_atom ...
1006 : !> \param ierr will return a number different from 0 if there was an error
1007 : !> \date 22.11.2010 (MK)
1008 : !> \author fawzi
1009 : ! **************************************************************************************************
1010 40 : SUBROUTINE get_natom(env_id, n_atom, ierr)
1011 :
1012 : INTEGER, INTENT(IN) :: env_id
1013 : INTEGER, INTENT(OUT) :: n_atom, ierr
1014 :
1015 : TYPE(f_env_type), POINTER :: f_env
1016 :
1017 20 : n_atom = 0
1018 20 : NULLIFY (f_env)
1019 20 : CALL f_env_add_defaults(env_id, f_env)
1020 20 : n_atom = force_env_get_natom(f_env%force_env)
1021 20 : CALL f_env_rm_defaults(f_env, ierr)
1022 :
1023 20 : END SUBROUTINE get_natom
1024 :
1025 : ! **************************************************************************************************
1026 : !> \brief returns the number of particles in the given force env
1027 : !> \param env_id id of the force_env
1028 : !> \param n_particle ...
1029 : !> \param ierr will return a number different from 0 if there was an error
1030 : !> \author Matthias Krack
1031 : !>
1032 : ! **************************************************************************************************
1033 288 : SUBROUTINE get_nparticle(env_id, n_particle, ierr)
1034 :
1035 : INTEGER, INTENT(IN) :: env_id
1036 : INTEGER, INTENT(OUT) :: n_particle, ierr
1037 :
1038 : TYPE(f_env_type), POINTER :: f_env
1039 :
1040 144 : n_particle = 0
1041 144 : NULLIFY (f_env)
1042 144 : CALL f_env_add_defaults(env_id, f_env)
1043 144 : n_particle = force_env_get_nparticle(f_env%force_env)
1044 144 : CALL f_env_rm_defaults(f_env, ierr)
1045 :
1046 144 : END SUBROUTINE get_nparticle
1047 :
1048 : ! **************************************************************************************************
1049 : !> \brief gets a cell
1050 : !> \param env_id id of the force_env
1051 : !> \param cell the array with the cell matrix
1052 : !> \param per periodicity
1053 : !> \param ierr will return a number different from 0 if there was an error
1054 : !> \author Joost VandeVondele
1055 : ! **************************************************************************************************
1056 0 : SUBROUTINE get_cell(env_id, cell, per, ierr)
1057 :
1058 : INTEGER, INTENT(IN) :: env_id
1059 : REAL(KIND=DP), DIMENSION(3, 3) :: cell
1060 : INTEGER, DIMENSION(3), OPTIONAL :: per
1061 : INTEGER, INTENT(OUT) :: ierr
1062 :
1063 : TYPE(cell_type), POINTER :: cell_full
1064 : TYPE(f_env_type), POINTER :: f_env
1065 :
1066 0 : NULLIFY (f_env)
1067 0 : CALL f_env_add_defaults(env_id, f_env)
1068 0 : NULLIFY (cell_full)
1069 0 : CALL force_env_get(f_env%force_env, cell=cell_full)
1070 0 : CPASSERT(ASSOCIATED(cell_full))
1071 0 : cell = cell_full%hmat
1072 0 : IF (PRESENT(per)) per(:) = cell_full%perd(:)
1073 0 : CALL f_env_rm_defaults(f_env, ierr)
1074 :
1075 0 : END SUBROUTINE get_cell
1076 :
1077 : ! **************************************************************************************************
1078 : !> \brief gets the qmmm cell
1079 : !> \param env_id id of the force_env
1080 : !> \param cell the array with the cell matrix
1081 : !> \param ierr will return a number different from 0 if there was an error
1082 : !> \author Holly Judge
1083 : ! **************************************************************************************************
1084 0 : SUBROUTINE get_qmmm_cell(env_id, cell, ierr)
1085 :
1086 : INTEGER, INTENT(IN) :: env_id
1087 : REAL(KIND=DP), DIMENSION(3, 3) :: cell
1088 : INTEGER, INTENT(OUT) :: ierr
1089 :
1090 : TYPE(cell_type), POINTER :: cell_qmmm
1091 : TYPE(f_env_type), POINTER :: f_env
1092 : TYPE(qmmm_env_type), POINTER :: qmmm_env
1093 :
1094 0 : NULLIFY (f_env)
1095 0 : CALL f_env_add_defaults(env_id, f_env)
1096 0 : NULLIFY (cell_qmmm)
1097 0 : CALL force_env_get(f_env%force_env, qmmm_env=qmmm_env)
1098 0 : CALL get_qs_env(qmmm_env%qs_env, cell=cell_qmmm)
1099 0 : CPASSERT(ASSOCIATED(cell_qmmm))
1100 0 : cell = cell_qmmm%hmat
1101 0 : CALL f_env_rm_defaults(f_env, ierr)
1102 :
1103 0 : END SUBROUTINE get_qmmm_cell
1104 :
1105 : ! **************************************************************************************************
1106 : !> \brief gets a result from CP2K that is a real 1D array
1107 : !> \param env_id id of the force_env
1108 : !> \param description the tag of the result
1109 : !> \param N ...
1110 : !> \param RESULT ...
1111 : !> \param res_exist ...
1112 : !> \param ierr will return a number different from 0 if there was an error
1113 : !> \author Joost VandeVondele
1114 : ! **************************************************************************************************
1115 0 : SUBROUTINE get_result_r1(env_id, description, N, RESULT, res_exist, ierr)
1116 : INTEGER :: env_id
1117 : CHARACTER(LEN=default_string_length) :: description
1118 : INTEGER :: N
1119 : REAL(KIND=dp), DIMENSION(1:N) :: RESULT
1120 : LOGICAL, OPTIONAL :: res_exist
1121 : INTEGER :: ierr
1122 :
1123 : INTEGER :: nres
1124 : LOGICAL :: exist_res
1125 : TYPE(cp_result_type), POINTER :: results
1126 : TYPE(cp_subsys_type), POINTER :: subsys
1127 : TYPE(f_env_type), POINTER :: f_env
1128 :
1129 0 : NULLIFY (f_env, subsys, results)
1130 0 : CALL f_env_add_defaults(env_id, f_env)
1131 :
1132 0 : CALL force_env_get(f_env%force_env, subsys=subsys)
1133 0 : CALL cp_subsys_get(subsys, results=results)
1134 : ! first test for the result
1135 0 : IF (PRESENT(res_exist)) THEN
1136 0 : res_exist = test_for_result(results, description=description)
1137 : exist_res = res_exist
1138 : ELSE
1139 : exist_res = .TRUE.
1140 : END IF
1141 : ! if existing (or assuming the existence) read the results
1142 0 : IF (exist_res) THEN
1143 0 : CALL get_results(results, description=description, n_rep=nres)
1144 0 : CALL get_results(results, description=description, values=RESULT, nval=nres)
1145 : END IF
1146 :
1147 0 : CALL f_env_rm_defaults(f_env, ierr)
1148 :
1149 0 : END SUBROUTINE get_result_r1
1150 :
1151 : ! **************************************************************************************************
1152 : !> \brief gets the forces of the particles
1153 : !> \param env_id id of the force_env
1154 : !> \param frc the array where to write the forces
1155 : !> \param n_el number of positions (3*nparticle) just to check
1156 : !> \param ierr will return a number different from 0 if there was an error
1157 : !> \date 22.11.2010 (MK)
1158 : !> \author fawzi
1159 : ! **************************************************************************************************
1160 18476 : SUBROUTINE get_force(env_id, frc, n_el, ierr)
1161 :
1162 : INTEGER, INTENT(IN) :: env_id, n_el
1163 : REAL(KIND=dp), DIMENSION(1:n_el) :: frc
1164 : INTEGER, INTENT(OUT) :: ierr
1165 :
1166 : TYPE(f_env_type), POINTER :: f_env
1167 :
1168 9238 : NULLIFY (f_env)
1169 9238 : CALL f_env_add_defaults(env_id, f_env)
1170 9238 : CALL force_env_get_frc(f_env%force_env, frc, n_el)
1171 9238 : CALL f_env_rm_defaults(f_env, ierr)
1172 :
1173 9238 : END SUBROUTINE get_force
1174 :
1175 : ! **************************************************************************************************
1176 : !> \brief gets the stress tensor
1177 : !> \param env_id id of the force_env
1178 : !> \param stress_tensor the array where to write the stress tensor
1179 : !> \param ierr will return a number different from 0 if there was an error
1180 : !> \author Ole Schuett
1181 : ! **************************************************************************************************
1182 0 : SUBROUTINE get_stress_tensor(env_id, stress_tensor, ierr)
1183 :
1184 : INTEGER, INTENT(IN) :: env_id
1185 : REAL(KIND=dp), DIMENSION(3, 3), INTENT(OUT) :: stress_tensor
1186 : INTEGER, INTENT(OUT) :: ierr
1187 :
1188 : TYPE(cell_type), POINTER :: cell
1189 : TYPE(cp_subsys_type), POINTER :: subsys
1190 : TYPE(f_env_type), POINTER :: f_env
1191 : TYPE(virial_type), POINTER :: virial
1192 :
1193 0 : NULLIFY (f_env, subsys, virial, cell)
1194 0 : stress_tensor(:, :) = 0.0_dp
1195 :
1196 0 : CALL f_env_add_defaults(env_id, f_env)
1197 0 : CALL force_env_get(f_env%force_env, subsys=subsys, cell=cell)
1198 0 : CALL cp_subsys_get(subsys, virial=virial)
1199 0 : IF (virial%pv_availability) THEN
1200 0 : stress_tensor(:, :) = virial%pv_virial(:, :)/cell%deth
1201 : END IF
1202 0 : CALL f_env_rm_defaults(f_env, ierr)
1203 :
1204 0 : END SUBROUTINE get_stress_tensor
1205 :
1206 : ! **************************************************************************************************
1207 : !> \brief gets the positions of the particles
1208 : !> \param env_id id of the force_env
1209 : !> \param pos the array where to write the positions
1210 : !> \param n_el number of positions (3*nparticle) just to check
1211 : !> \param ierr will return a number different from 0 if there was an error
1212 : !> \date 22.11.2010 (MK)
1213 : !> \author fawzi
1214 : ! **************************************************************************************************
1215 680 : SUBROUTINE get_pos(env_id, pos, n_el, ierr)
1216 :
1217 : INTEGER, INTENT(IN) :: env_id, n_el
1218 : REAL(KIND=DP), DIMENSION(1:n_el) :: pos
1219 : INTEGER, INTENT(OUT) :: ierr
1220 :
1221 : TYPE(f_env_type), POINTER :: f_env
1222 :
1223 340 : NULLIFY (f_env)
1224 340 : CALL f_env_add_defaults(env_id, f_env)
1225 340 : CALL force_env_get_pos(f_env%force_env, pos, n_el)
1226 340 : CALL f_env_rm_defaults(f_env, ierr)
1227 :
1228 340 : END SUBROUTINE get_pos
1229 :
1230 : ! **************************************************************************************************
1231 : !> \brief gets the velocities of the particles
1232 : !> \param env_id id of the force_env
1233 : !> \param vel the array where to write the velocities
1234 : !> \param n_el number of velocities (3*nparticle) just to check
1235 : !> \param ierr will return a number different from 0 if there was an error
1236 : !> \author fawzi
1237 : !> date 22.11.2010 (MK)
1238 : ! **************************************************************************************************
1239 0 : SUBROUTINE get_vel(env_id, vel, n_el, ierr)
1240 :
1241 : INTEGER, INTENT(IN) :: env_id, n_el
1242 : REAL(KIND=DP), DIMENSION(1:n_el) :: vel
1243 : INTEGER, INTENT(OUT) :: ierr
1244 :
1245 : TYPE(f_env_type), POINTER :: f_env
1246 :
1247 0 : NULLIFY (f_env)
1248 0 : CALL f_env_add_defaults(env_id, f_env)
1249 0 : CALL force_env_get_vel(f_env%force_env, vel, n_el)
1250 0 : CALL f_env_rm_defaults(f_env, ierr)
1251 :
1252 0 : END SUBROUTINE get_vel
1253 :
1254 : ! **************************************************************************************************
1255 : !> \brief sets a new cell
1256 : !> \param env_id id of the force_env
1257 : !> \param new_cell the array with the cell matrix
1258 : !> \param ierr will return a number different from 0 if there was an error
1259 : !> \author Joost VandeVondele
1260 : ! **************************************************************************************************
1261 8304 : SUBROUTINE set_cell(env_id, new_cell, ierr)
1262 :
1263 : INTEGER, INTENT(IN) :: env_id
1264 : REAL(KIND=DP), DIMENSION(3, 3) :: new_cell
1265 : INTEGER, INTENT(OUT) :: ierr
1266 :
1267 : TYPE(cell_type), POINTER :: cell
1268 : TYPE(cp_subsys_type), POINTER :: subsys
1269 : TYPE(f_env_type), POINTER :: f_env
1270 :
1271 4152 : NULLIFY (f_env, cell, subsys)
1272 4152 : CALL f_env_add_defaults(env_id, f_env)
1273 4152 : NULLIFY (cell)
1274 4152 : CALL force_env_get(f_env%force_env, cell=cell)
1275 4152 : CPASSERT(ASSOCIATED(cell))
1276 53976 : cell%hmat = new_cell
1277 4152 : CALL init_cell(cell)
1278 4152 : CALL force_env_get(f_env%force_env, subsys=subsys)
1279 4152 : CALL cp_subsys_set(subsys, cell=cell)
1280 4152 : CALL f_env_rm_defaults(f_env, ierr)
1281 :
1282 4152 : END SUBROUTINE set_cell
1283 :
1284 : ! **************************************************************************************************
1285 : !> \brief sets the positions of the particles
1286 : !> \param env_id id of the force_env
1287 : !> \param new_pos the array with the new positions
1288 : !> \param n_el number of positions (3*nparticle) just to check
1289 : !> \param ierr will return a number different from 0 if there was an error
1290 : !> \date 22.11.2010 updated (MK)
1291 : !> \author fawzi
1292 : ! **************************************************************************************************
1293 26620 : SUBROUTINE set_pos(env_id, new_pos, n_el, ierr)
1294 :
1295 : INTEGER, INTENT(IN) :: env_id, n_el
1296 : REAL(KIND=dp), DIMENSION(1:n_el) :: new_pos
1297 : INTEGER, INTENT(OUT) :: ierr
1298 :
1299 : TYPE(cp_subsys_type), POINTER :: subsys
1300 : TYPE(f_env_type), POINTER :: f_env
1301 :
1302 13310 : NULLIFY (f_env)
1303 13310 : CALL f_env_add_defaults(env_id, f_env)
1304 13310 : NULLIFY (subsys)
1305 13310 : CALL force_env_get(f_env%force_env, subsys=subsys)
1306 13310 : CALL unpack_subsys_particles(subsys=subsys, r=new_pos)
1307 13310 : CALL f_env_rm_defaults(f_env, ierr)
1308 :
1309 13310 : END SUBROUTINE set_pos
1310 :
1311 : ! **************************************************************************************************
1312 : !> \brief sets the velocities of the particles
1313 : !> \param env_id id of the force_env
1314 : !> \param new_vel the array with the new velocities
1315 : !> \param n_el number of velocities (3*nparticle) just to check
1316 : !> \param ierr will return a number different from 0 if there was an error
1317 : !> \date 22.11.2010 updated (MK)
1318 : !> \author fawzi
1319 : ! **************************************************************************************************
1320 288 : SUBROUTINE set_vel(env_id, new_vel, n_el, ierr)
1321 :
1322 : INTEGER, INTENT(IN) :: env_id, n_el
1323 : REAL(kind=dp), DIMENSION(1:n_el) :: new_vel
1324 : INTEGER, INTENT(OUT) :: ierr
1325 :
1326 : TYPE(cp_subsys_type), POINTER :: subsys
1327 : TYPE(f_env_type), POINTER :: f_env
1328 :
1329 144 : NULLIFY (f_env)
1330 144 : CALL f_env_add_defaults(env_id, f_env)
1331 144 : NULLIFY (subsys)
1332 144 : CALL force_env_get(f_env%force_env, subsys=subsys)
1333 144 : CALL unpack_subsys_particles(subsys=subsys, v=new_vel)
1334 144 : CALL f_env_rm_defaults(f_env, ierr)
1335 :
1336 144 : END SUBROUTINE set_vel
1337 :
1338 : ! **************************************************************************************************
1339 : !> \brief updates the energy and the forces of given force_env
1340 : !> \param env_id id of the force_env that you want to update
1341 : !> \param calc_force if the forces should be updated, if false the forces
1342 : !> might be wrong.
1343 : !> \param ierr will return a number different from 0 if there was an error
1344 : !> \author fawzi
1345 : ! **************************************************************************************************
1346 26480 : RECURSIVE SUBROUTINE calc_energy_force(env_id, calc_force, ierr)
1347 :
1348 : INTEGER, INTENT(in) :: env_id
1349 : LOGICAL, INTENT(in) :: calc_force
1350 : INTEGER, INTENT(out) :: ierr
1351 :
1352 : TYPE(cp_logger_type), POINTER :: logger
1353 : TYPE(f_env_type), POINTER :: f_env
1354 :
1355 13240 : NULLIFY (f_env)
1356 13240 : CALL f_env_add_defaults(env_id, f_env)
1357 13240 : logger => cp_get_default_logger()
1358 13240 : CALL cp_iterate(logger%iter_info) ! add one to the iteration count
1359 13240 : CALL force_env_calc_energy_force(f_env%force_env, calc_force=calc_force)
1360 13240 : CALL f_env_rm_defaults(f_env, ierr)
1361 :
1362 13240 : END SUBROUTINE calc_energy_force
1363 :
1364 : ! **************************************************************************************************
1365 : !> \brief returns the energy of the last configuration calculated
1366 : !> \param env_id id of the force_env that you want to update
1367 : !> \param e_pot the potential energy of the system
1368 : !> \param ierr will return a number different from 0 if there was an error
1369 : !> \author fawzi
1370 : ! **************************************************************************************************
1371 39900 : SUBROUTINE get_energy(env_id, e_pot, ierr)
1372 :
1373 : INTEGER, INTENT(in) :: env_id
1374 : REAL(kind=dp), INTENT(out) :: e_pot
1375 : INTEGER, INTENT(out) :: ierr
1376 :
1377 : TYPE(f_env_type), POINTER :: f_env
1378 :
1379 13300 : NULLIFY (f_env)
1380 13300 : CALL f_env_add_defaults(env_id, f_env)
1381 13300 : CALL force_env_get(f_env%force_env, potential_energy=e_pot)
1382 13300 : CALL f_env_rm_defaults(f_env, ierr)
1383 :
1384 13300 : END SUBROUTINE get_energy
1385 :
1386 : ! **************************************************************************************************
1387 : !> \brief returns the energy of the configuration given by the positions
1388 : !> passed as argument
1389 : !> \param env_id id of the force_env that you want to update
1390 : !> \param pos array with the positions
1391 : !> \param n_el number of elements in pos (3*natom)
1392 : !> \param e_pot the potential energy of the system
1393 : !> \param ierr will return a number different from 0 if there was an error
1394 : !> \author fawzi
1395 : !> \note
1396 : !> utility call
1397 : ! **************************************************************************************************
1398 4060 : RECURSIVE SUBROUTINE calc_energy(env_id, pos, n_el, e_pot, ierr)
1399 :
1400 : INTEGER, INTENT(IN) :: env_id, n_el
1401 : REAL(KIND=dp), DIMENSION(1:n_el), INTENT(IN) :: pos
1402 : REAL(KIND=dp), INTENT(OUT) :: e_pot
1403 : INTEGER, INTENT(OUT) :: ierr
1404 :
1405 : REAL(KIND=dp), DIMENSION(1) :: dummy_f
1406 :
1407 4060 : CALL calc_force(env_id, pos, n_el, e_pot, dummy_f, 0, ierr)
1408 :
1409 4060 : END SUBROUTINE calc_energy
1410 :
1411 : ! **************************************************************************************************
1412 : !> \brief returns the energy of the configuration given by the positions
1413 : !> passed as argument
1414 : !> \param env_id id of the force_env that you want to update
1415 : !> \param pos array with the positions
1416 : !> \param n_el_pos number of elements in pos (3*natom)
1417 : !> \param e_pot the potential energy of the system
1418 : !> \param force array that will contain the forces
1419 : !> \param n_el_force number of elements in force (3*natom). If 0 the
1420 : !> forces are not calculated
1421 : !> \param ierr will return a number different from 0 if there was an error
1422 : !> \author fawzi
1423 : !> \note
1424 : !> utility call, but actually it could be a better and more efficient
1425 : !> interface to connect to other codes if cp2k would be deeply
1426 : !> refactored
1427 : ! **************************************************************************************************
1428 13238 : RECURSIVE SUBROUTINE calc_force(env_id, pos, n_el_pos, e_pot, force, n_el_force, ierr)
1429 :
1430 : INTEGER, INTENT(in) :: env_id, n_el_pos
1431 : REAL(kind=dp), DIMENSION(1:n_el_pos), INTENT(in) :: pos
1432 : REAL(kind=dp), INTENT(out) :: e_pot
1433 : INTEGER, INTENT(in) :: n_el_force
1434 : REAL(kind=dp), DIMENSION(1:n_el_force), &
1435 : INTENT(inout) :: force
1436 : INTEGER, INTENT(out) :: ierr
1437 :
1438 : LOGICAL :: calc_f
1439 :
1440 13238 : calc_f = (n_el_force /= 0)
1441 13238 : CALL set_pos(env_id, pos, n_el_pos, ierr)
1442 13238 : IF (ierr == 0) CALL calc_energy_force(env_id, calc_f, ierr)
1443 13238 : IF (ierr == 0) CALL get_energy(env_id, e_pot, ierr)
1444 13238 : IF (calc_f .AND. (ierr == 0)) CALL get_force(env_id, force, n_el_force, ierr)
1445 :
1446 13238 : END SUBROUTINE calc_force
1447 :
1448 : ! **************************************************************************************************
1449 : !> \brief performs a check of the input
1450 : !> \param input_declaration ...
1451 : !> \param input_file_path the path of the input file to check
1452 : !> \param output_file_path path of the output file (to which it is appended)
1453 : !> if it is "__STD_OUT__" the default_output_unit is used
1454 : !> \param echo_input if the parsed input should be written out with all the
1455 : !> defaults made explicit
1456 : !> \param mpi_comm the mpi communicator (if not given it uses the default
1457 : !> one)
1458 : !> \param initial_variables key-value list of initial preprocessor variables
1459 : !> \param ierr error control, if different from 0 there was an error
1460 : !> \author fawzi
1461 : ! **************************************************************************************************
1462 0 : SUBROUTINE check_input(input_declaration, input_file_path, output_file_path, &
1463 0 : echo_input, mpi_comm, initial_variables, ierr)
1464 : TYPE(section_type), POINTER :: input_declaration
1465 : CHARACTER(len=*), INTENT(in) :: input_file_path, output_file_path
1466 : LOGICAL, INTENT(in), OPTIONAL :: echo_input
1467 : TYPE(mp_comm_type), INTENT(in), OPTIONAL :: mpi_comm
1468 : CHARACTER(len=default_path_length), &
1469 : DIMENSION(:, :), INTENT(IN) :: initial_variables
1470 : INTEGER, INTENT(out) :: ierr
1471 :
1472 : INTEGER :: unit_nr
1473 : LOGICAL :: my_echo_input
1474 : TYPE(cp_logger_type), POINTER :: logger
1475 : TYPE(mp_para_env_type), POINTER :: para_env
1476 : TYPE(section_vals_type), POINTER :: input_file
1477 :
1478 0 : my_echo_input = .FALSE.
1479 0 : IF (PRESENT(echo_input)) my_echo_input = echo_input
1480 :
1481 0 : IF (PRESENT(mpi_comm)) THEN
1482 0 : ALLOCATE (para_env)
1483 0 : para_env = mpi_comm
1484 : ELSE
1485 0 : para_env => default_para_env
1486 0 : CALL para_env%retain()
1487 : END IF
1488 0 : IF (para_env%is_source()) THEN
1489 0 : IF (output_file_path == "__STD_OUT__") THEN
1490 0 : unit_nr = default_output_unit
1491 : ELSE
1492 : CALL open_file(file_name=output_file_path, file_status="UNKNOWN", &
1493 : file_action="WRITE", file_position="APPEND", &
1494 0 : unit_number=unit_nr)
1495 : END IF
1496 : ELSE
1497 0 : unit_nr = -1
1498 : END IF
1499 :
1500 0 : NULLIFY (logger)
1501 : CALL cp_logger_create(logger, para_env=para_env, &
1502 : default_global_unit_nr=unit_nr, &
1503 0 : close_global_unit_on_dealloc=.FALSE.)
1504 0 : CALL cp_add_default_logger(logger)
1505 0 : CALL cp_logger_release(logger)
1506 :
1507 : input_file => read_input(input_declaration, input_file_path, initial_variables=initial_variables, &
1508 0 : para_env=para_env)
1509 0 : CALL check_cp2k_input(input_declaration, input_file, para_env=para_env, output_unit=unit_nr)
1510 0 : IF (my_echo_input .AND. (unit_nr > 0)) THEN
1511 : CALL section_vals_write(input_file, &
1512 : unit_nr=unit_nr, &
1513 : hide_root=.TRUE., &
1514 0 : hide_defaults=.FALSE.)
1515 : END IF
1516 0 : CALL section_vals_release(input_file)
1517 :
1518 0 : CALL cp_logger_release(logger)
1519 0 : CALL mp_para_env_release(para_env)
1520 0 : ierr = 0
1521 0 : CALL cp_rm_default_logger()
1522 :
1523 0 : END SUBROUTINE check_input
1524 :
1525 0 : END MODULE f77_interface
|
