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