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