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