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