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