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