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