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 107948 : 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 107948 : env_pos = -1
208 262798 : DO isub = 1, n_f_envs
209 262798 : IF (f_envs(isub)%f_env%id_nr == env_id) THEN
210 107948 : env_pos = isub
211 : END IF
212 : END DO
213 107948 : res = env_pos
214 107948 : 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 10262 : 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 10262 : IF (.NOT. module_initialized) THEN
237 : ! install error handler hooks
238 10262 : CALL cp_error_handling_setup()
239 :
240 : ! install timming handler hooks
241 10262 : CALL timings_register_hooks()
242 :
243 : ! Initialise preconnection list
244 10262 : CALL init_preconnection_list()
245 :
246 : ! get runtime information
247 10262 : CALL get_runtime_info()
248 :
249 : ! Intialize CUDA/HIP before MPI
250 : ! Needed for HIP on ALPS & LUMI
251 10262 : CALL offload_init()
252 :
253 : ! re-create the para_env and log with correct (reordered) ranks
254 10262 : ALLOCATE (default_para_env)
255 10262 : IF (init_mpi) THEN
256 : ! get the default system wide communicator
257 10262 : 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 10262 : CALL string_table_allocate()
267 10262 : CALL add_mp_perf_env()
268 10262 : CALL add_timer_env()
269 :
270 10262 : IF (default_para_env%is_source()) THEN
271 5131 : unit_nr = default_output_unit
272 : ELSE
273 5131 : unit_nr = -1
274 : END IF
275 10262 : NULLIFY (logger)
276 :
277 : CALL cp_logger_create(logger, para_env=default_para_env, &
278 : default_global_unit_nr=unit_nr, &
279 10262 : close_global_unit_on_dealloc=.FALSE.)
280 10262 : CALL cp_add_default_logger(logger)
281 10262 : CALL cp_logger_release(logger)
282 :
283 10262 : ALLOCATE (f_envs(0))
284 10262 : module_initialized = .TRUE.
285 10262 : ierr = 0
286 :
287 : ! Initialize mathematical constants
288 10262 : CALL init_periodic_table()
289 :
290 : ! Init the bibliography
291 10262 : CALL add_all_references()
292 :
293 10262 : NULLIFY (active_device_id)
294 10262 : offload_device_count = offload_get_device_count()
295 :
296 : ! Select active offload device when available.
297 10262 : 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 10262 : accdrv_active_device_id=active_device_id)
308 : #if defined(__parallel)
309 10262 : CALL gauxc_init(default_para_env%get_handle(), gauxc_status)
310 : #else
311 : CALL gauxc_init(status=gauxc_status)
312 : #endif
313 10262 : CALL gauxc_check_status(gauxc_status)
314 10262 : CALL pw_fpga_init()
315 10262 : CALL pw_gpu_init()
316 10262 : CALL grid_library_init()
317 10262 : CALL dbm_library_init()
318 : ELSE
319 0 : ierr = cp_failure_level
320 : END IF
321 :
322 : !sample peak memory
323 10262 : CALL m_memory()
324 :
325 10262 : 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 10262 : 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 10262 : CALL m_memory()
343 :
344 10262 : IF (.NOT. module_initialized) THEN
345 0 : ierr = cp_failure_level
346 : ELSE
347 10264 : DO ienv = n_f_envs, 1, -1
348 2 : CALL destroy_force_env(f_envs(ienv)%f_env%id_nr, ierr=ierr)
349 10264 : CPASSERT(ierr == 0)
350 : END DO
351 10262 : DEALLOCATE (f_envs)
352 :
353 : ! Finalize libraries (Offload)
354 10262 : CALL dbm_library_finalize()
355 10262 : CALL grid_library_finalize()
356 10262 : CALL pw_gpu_finalize()
357 10262 : CALL pw_fpga_finalize()
358 10262 : IF (cp_sirius_is_initialized()) CALL cp_sirius_finalize()
359 10262 : CALL gauxc_finalize(gauxc_status)
360 10262 : CALL gauxc_check_status(gauxc_status)
361 : ! Finalize the DBCSR library
362 10262 : CALL dbcsr_finalize_lib()
363 :
364 : ! Finalize DLA-Future and pika runtime; if already finalized does nothing
365 10262 : CALL cp_dlaf_free_all_grids()
366 10262 : CALL cp_dlaf_finalize()
367 :
368 10262 : CALL mp_para_env_release(default_para_env)
369 10262 : CALL cp_rm_default_logger()
370 :
371 : ! Deallocate the bibliography
372 10262 : CALL remove_all_references()
373 10262 : CALL rm_timer_env()
374 10262 : CALL rm_mp_perf_env()
375 10262 : CALL string_table_deallocate(0)
376 10262 : CALL cp_openpmd_output_finalize()
377 10262 : IF (finalize_mpi) THEN
378 10262 : CALL mp_world_finalize()
379 : END IF
380 :
381 10262 : ierr = 0
382 : END IF
383 10262 : 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 10339 : RECURSIVE SUBROUTINE f_env_dealloc(f_env)
391 : TYPE(f_env_type), POINTER :: f_env
392 :
393 : INTEGER :: ierr
394 :
395 10339 : CPASSERT(ASSOCIATED(f_env))
396 10339 : CALL force_env_release(f_env%force_env)
397 10339 : CALL cp_logger_release(f_env%logger)
398 10339 : CALL timer_env_release(f_env%timer_env)
399 10339 : CALL mp_perf_env_release(f_env%mp_perf_env)
400 10339 : 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 10339 : 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 10339 : 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 10339 : f_env%force_env => force_env
428 10339 : CALL force_env_retain(f_env%force_env)
429 10339 : f_env%logger => logger
430 10339 : CALL cp_logger_retain(logger)
431 10339 : f_env%timer_env => timer_env
432 10339 : CALL timer_env_retain(f_env%timer_env)
433 10339 : f_env%mp_perf_env => mp_perf_env
434 10339 : CALL mp_perf_env_retain(f_env%mp_perf_env)
435 10339 : f_env%id_nr = id_nr
436 10339 : CALL m_getcwd(f_env%my_path)
437 10339 : f_env%old_path = old_dir
438 10339 : 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 97326 : 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 97326 : NULLIFY (f_env)
485 97326 : f_env_pos = get_pos_of_env(f_env_id)
486 97326 : IF (f_env_pos < 1) THEN
487 0 : CPABORT("invalid env_id "//cp_to_string(f_env_id))
488 : ELSE
489 97326 : f_env => f_envs(f_env_pos)%f_env
490 97326 : logger => f_env%logger
491 97326 : CPASSERT(ASSOCIATED(logger))
492 97326 : CALL m_getcwd(f_env%old_path)
493 97326 : 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 97326 : CALL add_mp_perf_env(f_env%mp_perf_env)
498 97326 : CALL add_timer_env(f_env%timer_env)
499 97326 : CALL cp_add_default_logger(logger)
500 97326 : IF (PRESENT(handle)) handle = cp_default_logger_stack_size()
501 : END IF
502 97326 : 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 97326 : 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 97326 : IF (ASSOCIATED(f_env)) THEN
531 97326 : IF (PRESENT(handle)) THEN
532 16234 : CPASSERT(handle == cp_default_logger_stack_size())
533 : END IF
534 :
535 97326 : logger => f_env%logger
536 97326 : d_logger => cp_get_default_logger()
537 97326 : d_timer_env => get_timer_env()
538 97326 : d_mp_perf_env => get_mp_perf_env()
539 97326 : CPASSERT(ASSOCIATED(logger))
540 97326 : CPASSERT(ASSOCIATED(d_logger))
541 97326 : CPASSERT(ASSOCIATED(d_timer_env))
542 97326 : CPASSERT(ASSOCIATED(d_mp_perf_env))
543 97326 : CPASSERT(ASSOCIATED(logger, d_logger))
544 : ! CPASSERT(ASSOCIATED(d_timer_env, f_env%timer_env))
545 97326 : CPASSERT(ASSOCIATED(d_mp_perf_env, f_env%mp_perf_env))
546 97326 : 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 97326 : IF (PRESENT(ierr)) THEN
551 96800 : ierr = 0
552 : END IF
553 97326 : CALL cp_rm_default_logger()
554 97326 : CALL rm_timer_env()
555 97326 : CALL rm_mp_perf_env()
556 : ELSE
557 0 : IF (PRESENT(ierr)) THEN
558 0 : ierr = 0
559 : END IF
560 : END IF
561 97326 : 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 10339 : 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 10339 : INTEGER, DIMENSION(:), POINTER :: group_distribution, i_force_eval, &
612 10339 : 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 10339 : 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 10339 : NULLIFY (para_env, force_env, timer_env, mp_perf_env, globenv, meta_env, &
642 10339 : fp_env, eip_env, pwdft_env, mixed_env, qs_env, qmmm_env, embed_env)
643 10339 : new_env_id = -1
644 10339 : IF (PRESENT(mpi_comm)) THEN
645 10337 : ALLOCATE (para_env)
646 10337 : para_env = mpi_comm
647 : ELSE
648 2 : para_env => default_para_env
649 2 : CALL para_env%retain()
650 : END IF
651 :
652 10339 : CALL timeset(routineN, handle)
653 :
654 10339 : CALL m_getcwd(old_dir)
655 10339 : wdir = old_dir
656 10339 : 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 10339 : IF (PRESENT(output_unit)) THEN
668 10069 : 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 10339 : my_owns_out_unit = unit_nr /= default_output_unit
686 10339 : IF (PRESENT(owns_out_unit)) my_owns_out_unit = owns_out_unit
687 10339 : CALL globenv_create(globenv)
688 : CALL cp2k_init(para_env, output_unit=unit_nr, globenv=globenv, input_file_name=input_path, &
689 10339 : wdir=wdir)
690 10339 : 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 10339 : NULLIFY (input_file)
695 10339 : IF (PRESENT(input)) input_file => input
696 10339 : 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 9868 : CALL section_vals_retain(input_file)
704 : END IF
705 :
706 10339 : CALL check_cp2k_input(input_declaration, input_file, para_env=para_env, output_unit=unit_nr)
707 :
708 10339 : root_section => input_file
709 10339 : CALL section_vals_retain(root_section)
710 :
711 10339 : IF (n_f_envs + 1 > SIZE(f_envs)) THEN
712 9791 : f_envs_old => f_envs
713 127283 : ALLOCATE (f_envs(n_f_envs + 10))
714 9791 : DO i = 1, n_f_envs
715 9791 : f_envs(i)%f_env => f_envs_old(i)%f_env
716 : END DO
717 107701 : DO i = n_f_envs + 1, SIZE(f_envs)
718 107701 : NULLIFY (f_envs(i)%f_env)
719 : END DO
720 9791 : DEALLOCATE (f_envs_old)
721 : END IF
722 :
723 10339 : CALL cp2k_read(root_section, para_env, globenv)
724 :
725 10339 : CALL cp2k_setup(root_section, para_env, globenv)
726 : ! Group Distribution
727 31017 : ALLOCATE (group_distribution(0:para_env%num_pe - 1))
728 30806 : group_distribution = 0
729 10339 : lgroup_distribution => group_distribution
730 : ! Setup all possible force_env
731 10339 : 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 10339 : l_val=multiple_subsys)
734 10339 : 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 10339 : IF (.NOT. multiple_subsys) THEN
737 10549 : 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 10549 : CALL section_vals_remove_values(wrk_section)
741 : END DO
742 : END IF
743 10339 : nsubforce_size = nforce_eval - 1
744 10339 : use_multiple_para_env = .FALSE.
745 10339 : use_motion_section = .TRUE.
746 21088 : DO iforce_eval = 1, nforce_eval
747 10749 : NULLIFY (force_env_section, my_force_env, subsys_section)
748 : ! Reference subsys from the first ordered force_eval
749 10749 : IF (.NOT. multiple_subsys) THEN
750 : subsys_section => section_vals_get_subs_vals(force_env_sections, "SUBSYS", &
751 10549 : i_rep_section=i_force_eval(1))
752 : END IF
753 : ! Handling para_env in case of multiple force_eval
754 10749 : 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)) &
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 :
764 400 : IF (method_name_id == do_mixed) THEN
765 304 : check = ASSOCIATED(force_env%mixed_env%sub_para_env)
766 304 : CPASSERT(check)
767 304 : ngroups = force_env%mixed_env%ngroups
768 304 : my_group = lgroup_distribution(para_env%mepos)
769 304 : isubforce_eval = iforce_eval - 1
770 : ! If task not allocated on this procs skip setup..
771 304 : IF (MODULO(isubforce_eval - 1, ngroups) /= my_group) CYCLE
772 218 : my_para_env => force_env%mixed_env%sub_para_env(my_group + 1)%para_env
773 218 : my_logger => force_env%mixed_env%sub_logger(my_group + 1)%p
774 218 : CALL cp_rm_default_logger()
775 218 : CALL cp_add_default_logger(my_logger)
776 : END IF
777 314 : IF (method_name_id == do_embed) THEN
778 96 : check = ASSOCIATED(force_env%embed_env%sub_para_env)
779 96 : CPASSERT(check)
780 96 : ngroups = force_env%embed_env%ngroups
781 96 : my_group = lgroup_distribution(para_env%mepos)
782 96 : isubforce_eval = iforce_eval - 1
783 : ! If task not allocated on this procs skip setup..
784 96 : IF (MODULO(isubforce_eval - 1, ngroups) /= my_group) CYCLE
785 96 : my_para_env => force_env%embed_env%sub_para_env(my_group + 1)%para_env
786 96 : my_logger => force_env%embed_env%sub_logger(my_group + 1)%p
787 96 : CALL cp_rm_default_logger()
788 96 : CALL cp_add_default_logger(my_logger)
789 : END IF
790 : ELSE
791 10349 : my_para_env => para_env
792 : END IF
793 :
794 : ! Initialize force_env_section
795 : ! No need to allocate one more force_env_section if only 1 force_eval
796 : ! is provided.. this is in order to save memory..
797 10663 : IF (nforce_eval > 1) THEN
798 : CALL section_vals_duplicate(force_env_sections, force_env_section, &
799 492 : i_force_eval(iforce_eval), i_force_eval(iforce_eval))
800 492 : IF (iforce_eval /= 1) use_motion_section = .FALSE.
801 : ELSE
802 10171 : force_env_section => force_env_sections
803 10171 : use_motion_section = .TRUE.
804 : END IF
805 10663 : CALL section_vals_val_get(force_env_section, "METHOD", i_val=method_name_id)
806 :
807 10663 : IF (method_name_id == do_qmmm) THEN
808 334 : qmmmx_section => section_vals_get_subs_vals(force_env_section, "QMMM%FORCE_MIXING")
809 334 : CALL section_vals_get(qmmmx_section, explicit=do_qmmm_force_mixing)
810 334 : IF (do_qmmm_force_mixing) &
811 8 : method_name_id = do_qmmmx ! QMMM Force-Mixing has its own (hidden) method_id
812 : END IF
813 :
814 2241 : SELECT CASE (method_name_id)
815 : CASE (do_fist)
816 : CALL fist_create_force_env(my_force_env, root_section, my_para_env, globenv, &
817 : force_env_section=force_env_section, subsys_section=subsys_section, &
818 2241 : use_motion_section=use_motion_section)
819 :
820 : CASE (do_qs)
821 7886 : ALLOCATE (qs_env)
822 7886 : CALL qs_env_create(qs_env, globenv)
823 : CALL qs_init(qs_env, my_para_env, root_section, globenv=globenv, force_env_section=force_env_section, &
824 7886 : subsys_section=subsys_section, use_motion_section=use_motion_section)
825 : CALL force_env_create(my_force_env, root_section, qs_env=qs_env, para_env=my_para_env, globenv=globenv, &
826 7886 : force_env_section=force_env_section)
827 :
828 : CASE (do_qmmm)
829 326 : qmmm_section => section_vals_get_subs_vals(force_env_section, "QMMM")
830 326 : ALLOCATE (qmmm_env)
831 : CALL qmmm_env_create(qmmm_env, root_section, my_para_env, globenv, &
832 326 : force_env_section, qmmm_section, subsys_section, use_motion_section)
833 : CALL force_env_create(my_force_env, root_section, qmmm_env=qmmm_env, para_env=my_para_env, &
834 326 : globenv=globenv, force_env_section=force_env_section)
835 :
836 : CASE (do_qmmmx)
837 8 : ALLOCATE (qmmmx_env)
838 : CALL qmmmx_env_create(qmmmx_env, root_section, my_para_env, globenv, &
839 8 : force_env_section, subsys_section, use_motion_section)
840 : CALL force_env_create(my_force_env, root_section, qmmmx_env=qmmmx_env, para_env=my_para_env, &
841 8 : globenv=globenv, force_env_section=force_env_section)
842 :
843 : CASE (do_eip)
844 8 : ALLOCATE (eip_env)
845 8 : CALL eip_env_create(eip_env)
846 : CALL eip_init(eip_env, root_section, my_para_env, force_env_section=force_env_section, &
847 8 : subsys_section=subsys_section)
848 : CALL force_env_create(my_force_env, root_section, eip_env=eip_env, para_env=my_para_env, &
849 8 : globenv=globenv, force_env_section=force_env_section)
850 :
851 : CASE (do_sirius)
852 20 : IF (.NOT. cp_sirius_is_initialized()) THEN
853 20 : IF (unit_nr > 0) WRITE (UNIT=unit_nr, FMT="(T2,A)", ADVANCE="NO") "SIRIUS| "
854 20 : CALL cp_sirius_init()
855 : END IF
856 580 : ALLOCATE (pwdft_env)
857 20 : CALL pwdft_env_create(pwdft_env)
858 : CALL pwdft_init(pwdft_env, root_section, my_para_env, force_env_section=force_env_section, &
859 20 : subsys_section=subsys_section, use_motion_section=use_motion_section)
860 : CALL force_env_create(my_force_env, root_section, pwdft_env=pwdft_env, para_env=my_para_env, &
861 20 : globenv=globenv, force_env_section=force_env_section)
862 :
863 : CASE (do_mixed)
864 136 : ALLOCATE (mixed_env)
865 : CALL mixed_create_force_env(mixed_env, root_section, my_para_env, &
866 : force_env_section=force_env_section, n_subforce_eval=nsubforce_size, &
867 136 : use_motion_section=use_motion_section)
868 : CALL force_env_create(my_force_env, root_section, mixed_env=mixed_env, para_env=my_para_env, &
869 136 : globenv=globenv, force_env_section=force_env_section)
870 : !TODO: the sub_force_envs should really be created via recursion
871 136 : use_multiple_para_env = .TRUE.
872 136 : CALL cp_add_default_logger(logger) ! just to get the logger swapping started
873 136 : lgroup_distribution => my_force_env%mixed_env%group_distribution
874 :
875 : CASE (do_embed)
876 24 : ALLOCATE (embed_env)
877 : CALL embed_create_force_env(embed_env, root_section, my_para_env, &
878 : force_env_section=force_env_section, n_subforce_eval=nsubforce_size, &
879 24 : use_motion_section=use_motion_section)
880 : CALL force_env_create(my_force_env, root_section, embed_env=embed_env, para_env=my_para_env, &
881 24 : globenv=globenv, force_env_section=force_env_section)
882 : !TODO: the sub_force_envs should really be created via recursion
883 24 : use_multiple_para_env = .TRUE.
884 24 : CALL cp_add_default_logger(logger) ! just to get the logger swapping started
885 24 : lgroup_distribution => my_force_env%embed_env%group_distribution
886 :
887 : CASE (do_nnp)
888 14 : ALLOCATE (nnp_env)
889 : CALL nnp_init(nnp_env, root_section, my_para_env, force_env_section=force_env_section, &
890 14 : subsys_section=subsys_section, use_motion_section=use_motion_section)
891 : CALL force_env_create(my_force_env, root_section, nnp_env=nnp_env, para_env=my_para_env, &
892 14 : globenv=globenv, force_env_section=force_env_section)
893 :
894 : CASE (do_ipi)
895 0 : ALLOCATE (ipi_env)
896 : CALL ipi_init(ipi_env, root_section, my_para_env, force_env_section=force_env_section, &
897 0 : subsys_section=subsys_section)
898 : CALL force_env_create(my_force_env, root_section, ipi_env=ipi_env, para_env=my_para_env, &
899 0 : globenv=globenv, force_env_section=force_env_section)
900 :
901 : CASE DEFAULT
902 0 : CALL create_force_eval_section(section)
903 0 : keyword => section_get_keyword(section, "METHOD")
904 0 : CALL keyword_get(keyword, enum=enum)
905 : CALL cp_abort(__LOCATION__, &
906 : "Invalid METHOD <"//TRIM(enum_i2c(enum, method_name_id))// &
907 0 : "> was specified, ")
908 18935 : CALL section_release(section)
909 : END SELECT
910 :
911 10663 : NULLIFY (meta_env, fp_env)
912 10663 : IF (use_motion_section) THEN
913 : ! Metadynamics Setup
914 10339 : fe_section => section_vals_get_subs_vals(root_section, "MOTION%FREE_ENERGY")
915 10339 : CALL metadyn_read(meta_env, my_force_env, root_section, my_para_env, fe_section)
916 10339 : CALL force_env_set(my_force_env, meta_env=meta_env)
917 : ! Flexible Partition Setup
918 10339 : fp_section => section_vals_get_subs_vals(root_section, "MOTION%FLEXIBLE_PARTITIONING")
919 10339 : ALLOCATE (fp_env)
920 10339 : CALL fp_env_create(fp_env)
921 10339 : CALL fp_env_read(fp_env, fp_section)
922 10339 : CALL fp_env_write(fp_env, fp_section)
923 10339 : CALL force_env_set(my_force_env, fp_env=fp_env)
924 : END IF
925 : ! Handle multiple force_eval
926 10663 : IF (nforce_eval > 1 .AND. iforce_eval == 1) THEN
927 914 : ALLOCATE (my_force_env%sub_force_env(nsubforce_size))
928 : ! Nullify subforce_env
929 578 : DO k = 1, nsubforce_size
930 578 : NULLIFY (my_force_env%sub_force_env(k)%force_env)
931 : END DO
932 : END IF
933 : ! Reference the right force_env
934 10339 : IF (iforce_eval == 1) THEN
935 10339 : force_env => my_force_env
936 : ELSE
937 324 : force_env%sub_force_env(iforce_eval - 1)%force_env => my_force_env
938 : END IF
939 : ! Multiple para env for sub_force_eval
940 10663 : IF (.NOT. use_multiple_para_env) THEN
941 30356 : lgroup_distribution = iforce_eval
942 : END IF
943 : ! Release force_env_section
944 31665 : IF (nforce_eval > 1) CALL section_vals_release(force_env_section)
945 : END DO
946 10339 : IF (use_multiple_para_env) &
947 160 : CALL cp_rm_default_logger()
948 10339 : DEALLOCATE (group_distribution)
949 10339 : DEALLOCATE (i_force_eval)
950 10339 : timer_env => get_timer_env()
951 10339 : mp_perf_env => get_mp_perf_env()
952 10339 : CALL para_env%max(last_f_env_id)
953 10339 : last_f_env_id = last_f_env_id + 1
954 10339 : new_env_id = last_f_env_id
955 10339 : n_f_envs = n_f_envs + 1
956 : CALL f_env_create(f_envs(n_f_envs)%f_env, logger=logger, &
957 : timer_env=timer_env, mp_perf_env=mp_perf_env, force_env=force_env, &
958 10339 : id_nr=last_f_env_id, old_dir=old_dir)
959 10339 : CALL force_env_release(force_env)
960 10339 : CALL globenv_release(globenv)
961 10339 : CALL section_vals_release(root_section)
962 10339 : CALL mp_para_env_release(para_env)
963 10339 : CALL f_env_rm_defaults(f_envs(n_f_envs)%f_env, ierr=ierr)
964 10339 : CALL timestop(handle)
965 :
966 41442 : END SUBROUTINE create_force_env
967 :
968 : ! **************************************************************************************************
969 : !> \brief deallocates the force_env with the given id
970 : !> \param env_id the id of the force_env to remove
971 : !> \param ierr will contain a number different from 0 if
972 : !> \param q_finalize ...
973 : !> \author fawzi
974 : !> \note
975 : !> The following routines need to be synchronized wrt. adding/removing
976 : !> of the default environments (logging, performance,error):
977 : !> environment:cp2k_init, environment:cp2k_finalize,
978 : !> f77_interface:f_env_add_defaults, f77_interface:f_env_rm_defaults,
979 : !> f77_interface:create_force_env, f77_interface:destroy_force_env
980 : ! **************************************************************************************************
981 10339 : RECURSIVE SUBROUTINE destroy_force_env(env_id, ierr, q_finalize)
982 : INTEGER, INTENT(in) :: env_id
983 : INTEGER, INTENT(out) :: ierr
984 : LOGICAL, INTENT(IN), OPTIONAL :: q_finalize
985 :
986 : INTEGER :: env_pos, i
987 : TYPE(f_env_type), POINTER :: f_env
988 : TYPE(global_environment_type), POINTER :: globenv
989 : TYPE(mp_para_env_type), POINTER :: para_env
990 : TYPE(section_vals_type), POINTER :: root_section
991 :
992 10339 : NULLIFY (f_env)
993 10339 : CALL f_env_add_defaults(env_id, f_env)
994 10339 : env_pos = get_pos_of_env(env_id)
995 10339 : n_f_envs = n_f_envs - 1
996 10344 : DO i = env_pos, n_f_envs
997 10344 : f_envs(i)%f_env => f_envs(i + 1)%f_env
998 : END DO
999 10339 : NULLIFY (f_envs(n_f_envs + 1)%f_env)
1000 :
1001 : CALL force_env_get(f_env%force_env, globenv=globenv, &
1002 10339 : root_section=root_section, para_env=para_env)
1003 :
1004 10339 : CPASSERT(ASSOCIATED(globenv))
1005 10339 : NULLIFY (f_env%force_env%globenv)
1006 10339 : CALL f_env_dealloc(f_env)
1007 10339 : IF (PRESENT(q_finalize)) THEN
1008 210 : CALL cp2k_finalize(root_section, para_env, globenv, f_env%old_path, q_finalize)
1009 : ELSE
1010 10129 : CALL cp2k_finalize(root_section, para_env, globenv, f_env%old_path)
1011 : END IF
1012 10339 : CALL section_vals_release(root_section)
1013 10339 : CALL globenv_release(globenv)
1014 10339 : DEALLOCATE (f_env)
1015 10339 : ierr = 0
1016 10339 : END SUBROUTINE destroy_force_env
1017 :
1018 : ! **************************************************************************************************
1019 : !> \brief returns the number of atoms in the given force env
1020 : !> \param env_id id of the force_env
1021 : !> \param n_atom ...
1022 : !> \param ierr will return a number different from 0 if there was an error
1023 : !> \date 22.11.2010 (MK)
1024 : !> \author fawzi
1025 : ! **************************************************************************************************
1026 40 : SUBROUTINE get_natom(env_id, n_atom, ierr)
1027 :
1028 : INTEGER, INTENT(IN) :: env_id
1029 : INTEGER, INTENT(OUT) :: n_atom, ierr
1030 :
1031 : TYPE(f_env_type), POINTER :: f_env
1032 :
1033 20 : n_atom = 0
1034 20 : NULLIFY (f_env)
1035 20 : CALL f_env_add_defaults(env_id, f_env)
1036 20 : n_atom = force_env_get_natom(f_env%force_env)
1037 20 : CALL f_env_rm_defaults(f_env, ierr)
1038 :
1039 20 : END SUBROUTINE get_natom
1040 :
1041 : ! **************************************************************************************************
1042 : !> \brief returns the number of particles in the given force env
1043 : !> \param env_id id of the force_env
1044 : !> \param n_particle ...
1045 : !> \param ierr will return a number different from 0 if there was an error
1046 : !> \author Matthias Krack
1047 : !>
1048 : ! **************************************************************************************************
1049 296 : SUBROUTINE get_nparticle(env_id, n_particle, ierr)
1050 :
1051 : INTEGER, INTENT(IN) :: env_id
1052 : INTEGER, INTENT(OUT) :: n_particle, ierr
1053 :
1054 : TYPE(f_env_type), POINTER :: f_env
1055 :
1056 148 : n_particle = 0
1057 148 : NULLIFY (f_env)
1058 148 : CALL f_env_add_defaults(env_id, f_env)
1059 148 : n_particle = force_env_get_nparticle(f_env%force_env)
1060 148 : CALL f_env_rm_defaults(f_env, ierr)
1061 :
1062 148 : END SUBROUTINE get_nparticle
1063 :
1064 : ! **************************************************************************************************
1065 : !> \brief gets a cell
1066 : !> \param env_id id of the force_env
1067 : !> \param cell the array with the cell matrix
1068 : !> \param per periodicity
1069 : !> \param ierr will return a number different from 0 if there was an error
1070 : !> \author Joost VandeVondele
1071 : ! **************************************************************************************************
1072 0 : SUBROUTINE get_cell(env_id, cell, per, ierr)
1073 :
1074 : INTEGER, INTENT(IN) :: env_id
1075 : REAL(KIND=DP), DIMENSION(3, 3) :: cell
1076 : INTEGER, DIMENSION(3), OPTIONAL :: per
1077 : INTEGER, INTENT(OUT) :: ierr
1078 :
1079 : TYPE(cell_type), POINTER :: cell_full
1080 : TYPE(f_env_type), POINTER :: f_env
1081 :
1082 0 : NULLIFY (f_env)
1083 0 : CALL f_env_add_defaults(env_id, f_env)
1084 0 : NULLIFY (cell_full)
1085 0 : CALL force_env_get(f_env%force_env, cell=cell_full)
1086 0 : CPASSERT(ASSOCIATED(cell_full))
1087 0 : cell = cell_full%hmat
1088 0 : IF (PRESENT(per)) per(:) = cell_full%perd(:)
1089 0 : CALL f_env_rm_defaults(f_env, ierr)
1090 :
1091 0 : END SUBROUTINE get_cell
1092 :
1093 : ! **************************************************************************************************
1094 : !> \brief gets the qmmm cell
1095 : !> \param env_id id of the force_env
1096 : !> \param cell the array with the cell matrix
1097 : !> \param ierr will return a number different from 0 if there was an error
1098 : !> \author Holly Judge
1099 : ! **************************************************************************************************
1100 0 : SUBROUTINE get_qmmm_cell(env_id, cell, ierr)
1101 :
1102 : INTEGER, INTENT(IN) :: env_id
1103 : REAL(KIND=DP), DIMENSION(3, 3) :: cell
1104 : INTEGER, INTENT(OUT) :: ierr
1105 :
1106 : TYPE(cell_type), POINTER :: cell_qmmm
1107 : TYPE(f_env_type), POINTER :: f_env
1108 : TYPE(qmmm_env_type), POINTER :: qmmm_env
1109 :
1110 0 : NULLIFY (f_env)
1111 0 : CALL f_env_add_defaults(env_id, f_env)
1112 0 : NULLIFY (cell_qmmm)
1113 0 : CALL force_env_get(f_env%force_env, qmmm_env=qmmm_env)
1114 0 : CALL get_qs_env(qmmm_env%qs_env, cell=cell_qmmm)
1115 0 : CPASSERT(ASSOCIATED(cell_qmmm))
1116 0 : cell = cell_qmmm%hmat
1117 0 : CALL f_env_rm_defaults(f_env, ierr)
1118 :
1119 0 : END SUBROUTINE get_qmmm_cell
1120 :
1121 : ! **************************************************************************************************
1122 : !> \brief gets a result from CP2K that is a real 1D array
1123 : !> \param env_id id of the force_env
1124 : !> \param description the tag of the result
1125 : !> \param N ...
1126 : !> \param RESULT ...
1127 : !> \param res_exist ...
1128 : !> \param ierr will return a number different from 0 if there was an error
1129 : !> \author Joost VandeVondele
1130 : ! **************************************************************************************************
1131 0 : SUBROUTINE get_result_r1(env_id, description, N, RESULT, res_exist, ierr)
1132 : INTEGER :: env_id
1133 : CHARACTER(LEN=default_string_length) :: description
1134 : INTEGER :: N
1135 : REAL(KIND=dp), DIMENSION(1:N) :: RESULT
1136 : LOGICAL, OPTIONAL :: res_exist
1137 : INTEGER :: ierr
1138 :
1139 : INTEGER :: nres
1140 : LOGICAL :: exist_res
1141 : TYPE(cp_result_type), POINTER :: results
1142 : TYPE(cp_subsys_type), POINTER :: subsys
1143 : TYPE(f_env_type), POINTER :: f_env
1144 :
1145 0 : NULLIFY (f_env, subsys, results)
1146 0 : CALL f_env_add_defaults(env_id, f_env)
1147 :
1148 0 : CALL force_env_get(f_env%force_env, subsys=subsys)
1149 0 : CALL cp_subsys_get(subsys, results=results)
1150 : ! first test for the result
1151 0 : IF (PRESENT(res_exist)) THEN
1152 0 : res_exist = test_for_result(results, description=description)
1153 : exist_res = res_exist
1154 : ELSE
1155 : exist_res = .TRUE.
1156 : END IF
1157 : ! if existing (or assuming the existence) read the results
1158 0 : IF (exist_res) THEN
1159 0 : CALL get_results(results, description=description, n_rep=nres)
1160 0 : CALL get_results(results, description=description, values=RESULT, nval=nres)
1161 : END IF
1162 :
1163 0 : CALL f_env_rm_defaults(f_env, ierr)
1164 :
1165 0 : END SUBROUTINE get_result_r1
1166 :
1167 : ! **************************************************************************************************
1168 : !> \brief gets the forces of the particles
1169 : !> \param env_id id of the force_env
1170 : !> \param frc the array where to write the forces
1171 : !> \param n_el number of positions (3*nparticle) just to check
1172 : !> \param ierr will return a number different from 0 if there was an error
1173 : !> \date 22.11.2010 (MK)
1174 : !> \author fawzi
1175 : ! **************************************************************************************************
1176 19352 : SUBROUTINE get_force(env_id, frc, n_el, ierr)
1177 :
1178 : INTEGER, INTENT(IN) :: env_id, n_el
1179 : REAL(KIND=dp), DIMENSION(1:n_el) :: frc
1180 : INTEGER, INTENT(OUT) :: ierr
1181 :
1182 : TYPE(f_env_type), POINTER :: f_env
1183 :
1184 9676 : NULLIFY (f_env)
1185 9676 : CALL f_env_add_defaults(env_id, f_env)
1186 9676 : CALL force_env_get_frc(f_env%force_env, frc, n_el)
1187 9676 : CALL f_env_rm_defaults(f_env, ierr)
1188 :
1189 9676 : END SUBROUTINE get_force
1190 :
1191 : ! **************************************************************************************************
1192 : !> \brief gets the stress tensor
1193 : !> \param env_id id of the force_env
1194 : !> \param stress_tensor the array where to write the stress tensor
1195 : !> \param ierr will return a number different from 0 if there was an error
1196 : !> \author Ole Schuett
1197 : ! **************************************************************************************************
1198 0 : SUBROUTINE get_stress_tensor(env_id, stress_tensor, ierr)
1199 :
1200 : INTEGER, INTENT(IN) :: env_id
1201 : REAL(KIND=dp), DIMENSION(3, 3), INTENT(OUT) :: stress_tensor
1202 : INTEGER, INTENT(OUT) :: ierr
1203 :
1204 : TYPE(cell_type), POINTER :: cell
1205 : TYPE(cp_subsys_type), POINTER :: subsys
1206 : TYPE(f_env_type), POINTER :: f_env
1207 : TYPE(virial_type), POINTER :: virial
1208 :
1209 0 : NULLIFY (f_env, subsys, virial, cell)
1210 0 : stress_tensor(:, :) = 0.0_dp
1211 :
1212 0 : CALL f_env_add_defaults(env_id, f_env)
1213 0 : CALL force_env_get(f_env%force_env, subsys=subsys, cell=cell)
1214 0 : CALL cp_subsys_get(subsys, virial=virial)
1215 0 : IF (virial%pv_availability) THEN
1216 0 : stress_tensor(:, :) = virial%pv_virial(:, :)/cell%deth
1217 : END IF
1218 0 : CALL f_env_rm_defaults(f_env, ierr)
1219 :
1220 0 : END SUBROUTINE get_stress_tensor
1221 :
1222 : ! **************************************************************************************************
1223 : !> \brief gets the positions of the particles
1224 : !> \param env_id id of the force_env
1225 : !> \param pos the array where to write the positions
1226 : !> \param n_el number of positions (3*nparticle) just to check
1227 : !> \param ierr will return a number different from 0 if there was an error
1228 : !> \date 22.11.2010 (MK)
1229 : !> \author fawzi
1230 : ! **************************************************************************************************
1231 692 : SUBROUTINE get_pos(env_id, pos, n_el, ierr)
1232 :
1233 : INTEGER, INTENT(IN) :: env_id, n_el
1234 : REAL(KIND=DP), DIMENSION(1:n_el) :: pos
1235 : INTEGER, INTENT(OUT) :: ierr
1236 :
1237 : TYPE(f_env_type), POINTER :: f_env
1238 :
1239 346 : NULLIFY (f_env)
1240 346 : CALL f_env_add_defaults(env_id, f_env)
1241 346 : CALL force_env_get_pos(f_env%force_env, pos, n_el)
1242 346 : CALL f_env_rm_defaults(f_env, ierr)
1243 :
1244 346 : END SUBROUTINE get_pos
1245 :
1246 : ! **************************************************************************************************
1247 : !> \brief gets the velocities of the particles
1248 : !> \param env_id id of the force_env
1249 : !> \param vel the array where to write the velocities
1250 : !> \param n_el number of velocities (3*nparticle) just to check
1251 : !> \param ierr will return a number different from 0 if there was an error
1252 : !> \author fawzi
1253 : !> date 22.11.2010 (MK)
1254 : ! **************************************************************************************************
1255 0 : SUBROUTINE get_vel(env_id, vel, n_el, ierr)
1256 :
1257 : INTEGER, INTENT(IN) :: env_id, n_el
1258 : REAL(KIND=DP), DIMENSION(1:n_el) :: vel
1259 : INTEGER, INTENT(OUT) :: ierr
1260 :
1261 : TYPE(f_env_type), POINTER :: f_env
1262 :
1263 0 : NULLIFY (f_env)
1264 0 : CALL f_env_add_defaults(env_id, f_env)
1265 0 : CALL force_env_get_vel(f_env%force_env, vel, n_el)
1266 0 : CALL f_env_rm_defaults(f_env, ierr)
1267 :
1268 0 : END SUBROUTINE get_vel
1269 :
1270 : ! **************************************************************************************************
1271 : !> \brief sets a new cell
1272 : !> \param env_id id of the force_env
1273 : !> \param new_cell the array with the cell matrix
1274 : !> \param ierr will return a number different from 0 if there was an error
1275 : !> \author Joost VandeVondele
1276 : ! **************************************************************************************************
1277 8304 : SUBROUTINE set_cell(env_id, new_cell, ierr)
1278 :
1279 : INTEGER, INTENT(IN) :: env_id
1280 : REAL(KIND=DP), DIMENSION(3, 3) :: new_cell
1281 : INTEGER, INTENT(OUT) :: ierr
1282 :
1283 : TYPE(cell_type), POINTER :: cell
1284 : TYPE(cp_subsys_type), POINTER :: subsys
1285 : TYPE(f_env_type), POINTER :: f_env
1286 :
1287 4152 : NULLIFY (f_env, cell, subsys)
1288 4152 : CALL f_env_add_defaults(env_id, f_env)
1289 4152 : NULLIFY (cell)
1290 4152 : CALL force_env_get(f_env%force_env, cell=cell)
1291 4152 : CPASSERT(ASSOCIATED(cell))
1292 53976 : cell%hmat = new_cell
1293 4152 : CALL init_cell(cell)
1294 4152 : CALL force_env_get(f_env%force_env, subsys=subsys)
1295 4152 : CALL cp_subsys_set(subsys, cell=cell)
1296 4152 : CALL f_env_rm_defaults(f_env, ierr)
1297 :
1298 4152 : END SUBROUTINE set_cell
1299 :
1300 : ! **************************************************************************************************
1301 : !> \brief sets the positions of the particles
1302 : !> \param env_id id of the force_env
1303 : !> \param new_pos the array with the new positions
1304 : !> \param n_el number of positions (3*nparticle) just to check
1305 : !> \param ierr will return a number different from 0 if there was an error
1306 : !> \date 22.11.2010 updated (MK)
1307 : !> \author fawzi
1308 : ! **************************************************************************************************
1309 27506 : SUBROUTINE set_pos(env_id, new_pos, n_el, ierr)
1310 :
1311 : INTEGER, INTENT(IN) :: env_id, n_el
1312 : REAL(KIND=dp), DIMENSION(1:n_el) :: new_pos
1313 : INTEGER, INTENT(OUT) :: ierr
1314 :
1315 : TYPE(cp_subsys_type), POINTER :: subsys
1316 : TYPE(f_env_type), POINTER :: f_env
1317 :
1318 13753 : NULLIFY (f_env)
1319 13753 : CALL f_env_add_defaults(env_id, f_env)
1320 13753 : NULLIFY (subsys)
1321 13753 : CALL force_env_get(f_env%force_env, subsys=subsys)
1322 13753 : CALL unpack_subsys_particles(subsys=subsys, r=new_pos)
1323 13753 : CALL f_env_rm_defaults(f_env, ierr)
1324 :
1325 13753 : END SUBROUTINE set_pos
1326 :
1327 : ! **************************************************************************************************
1328 : !> \brief sets the velocities of the particles
1329 : !> \param env_id id of the force_env
1330 : !> \param new_vel the array with the new velocities
1331 : !> \param n_el number of velocities (3*nparticle) just to check
1332 : !> \param ierr will return a number different from 0 if there was an error
1333 : !> \date 22.11.2010 updated (MK)
1334 : !> \author fawzi
1335 : ! **************************************************************************************************
1336 296 : SUBROUTINE set_vel(env_id, new_vel, n_el, ierr)
1337 :
1338 : INTEGER, INTENT(IN) :: env_id, n_el
1339 : REAL(kind=dp), DIMENSION(1:n_el) :: new_vel
1340 : INTEGER, INTENT(OUT) :: ierr
1341 :
1342 : TYPE(cp_subsys_type), POINTER :: subsys
1343 : TYPE(f_env_type), POINTER :: f_env
1344 :
1345 148 : NULLIFY (f_env)
1346 148 : CALL f_env_add_defaults(env_id, f_env)
1347 148 : NULLIFY (subsys)
1348 148 : CALL force_env_get(f_env%force_env, subsys=subsys)
1349 148 : CALL unpack_subsys_particles(subsys=subsys, v=new_vel)
1350 148 : CALL f_env_rm_defaults(f_env, ierr)
1351 :
1352 148 : END SUBROUTINE set_vel
1353 :
1354 : ! **************************************************************************************************
1355 : !> \brief updates the energy and the forces of given force_env
1356 : !> \param env_id id of the force_env that you want to update
1357 : !> \param calc_force if the forces should be updated, if false the forces
1358 : !> might be wrong.
1359 : !> \param ierr will return a number different from 0 if there was an error
1360 : !> \author fawzi
1361 : ! **************************************************************************************************
1362 27366 : RECURSIVE SUBROUTINE calc_energy_force(env_id, calc_force, ierr)
1363 :
1364 : INTEGER, INTENT(in) :: env_id
1365 : LOGICAL, INTENT(in) :: calc_force
1366 : INTEGER, INTENT(out) :: ierr
1367 :
1368 : TYPE(cp_logger_type), POINTER :: logger
1369 : TYPE(f_env_type), POINTER :: f_env
1370 :
1371 13683 : NULLIFY (f_env)
1372 13683 : CALL f_env_add_defaults(env_id, f_env)
1373 13683 : logger => cp_get_default_logger()
1374 13683 : CALL cp_iterate(logger%iter_info) ! add one to the iteration count
1375 13683 : CALL force_env_calc_energy_force(f_env%force_env, calc_force=calc_force)
1376 13683 : CALL f_env_rm_defaults(f_env, ierr)
1377 :
1378 13683 : END SUBROUTINE calc_energy_force
1379 :
1380 : ! **************************************************************************************************
1381 : !> \brief returns the energy of the last configuration calculated
1382 : !> \param env_id id of the force_env that you want to update
1383 : !> \param e_pot the potential energy of the system
1384 : !> \param ierr will return a number different from 0 if there was an error
1385 : !> \author fawzi
1386 : ! **************************************************************************************************
1387 41229 : SUBROUTINE get_energy(env_id, e_pot, ierr)
1388 :
1389 : INTEGER, INTENT(in) :: env_id
1390 : REAL(kind=dp), INTENT(out) :: e_pot
1391 : INTEGER, INTENT(out) :: ierr
1392 :
1393 : TYPE(f_env_type), POINTER :: f_env
1394 :
1395 13743 : NULLIFY (f_env)
1396 13743 : CALL f_env_add_defaults(env_id, f_env)
1397 13743 : CALL force_env_get(f_env%force_env, potential_energy=e_pot)
1398 13743 : CALL f_env_rm_defaults(f_env, ierr)
1399 :
1400 13743 : END SUBROUTINE get_energy
1401 :
1402 : ! **************************************************************************************************
1403 : !> \brief returns the energy of the configuration given by the positions
1404 : !> passed as argument
1405 : !> \param env_id id of the force_env that you want to update
1406 : !> \param pos array with the positions
1407 : !> \param n_el number of elements in pos (3*natom)
1408 : !> \param e_pot the potential energy of the system
1409 : !> \param ierr will return a number different from 0 if there was an error
1410 : !> \author fawzi
1411 : !> \note
1412 : !> utility call
1413 : ! **************************************************************************************************
1414 4065 : RECURSIVE SUBROUTINE calc_energy(env_id, pos, n_el, e_pot, ierr)
1415 :
1416 : INTEGER, INTENT(IN) :: env_id, n_el
1417 : REAL(KIND=dp), DIMENSION(1:n_el), INTENT(IN) :: pos
1418 : REAL(KIND=dp), INTENT(OUT) :: e_pot
1419 : INTEGER, INTENT(OUT) :: ierr
1420 :
1421 : REAL(KIND=dp), DIMENSION(1) :: dummy_f
1422 :
1423 4065 : CALL calc_force(env_id, pos, n_el, e_pot, dummy_f, 0, ierr)
1424 :
1425 4065 : END SUBROUTINE calc_energy
1426 :
1427 : ! **************************************************************************************************
1428 : !> \brief returns the energy of the configuration given by the positions
1429 : !> passed as argument
1430 : !> \param env_id id of the force_env that you want to update
1431 : !> \param pos array with the positions
1432 : !> \param n_el_pos number of elements in pos (3*natom)
1433 : !> \param e_pot the potential energy of the system
1434 : !> \param force array that will contain the forces
1435 : !> \param n_el_force number of elements in force (3*natom). If 0 the
1436 : !> forces are not calculated
1437 : !> \param ierr will return a number different from 0 if there was an error
1438 : !> \author fawzi
1439 : !> \note
1440 : !> utility call, but actually it could be a better and more efficient
1441 : !> interface to connect to other codes if cp2k would be deeply
1442 : !> refactored
1443 : ! **************************************************************************************************
1444 13681 : RECURSIVE SUBROUTINE calc_force(env_id, pos, n_el_pos, e_pot, force, n_el_force, ierr)
1445 :
1446 : INTEGER, INTENT(in) :: env_id, n_el_pos
1447 : REAL(kind=dp), DIMENSION(1:n_el_pos), INTENT(in) :: pos
1448 : REAL(kind=dp), INTENT(out) :: e_pot
1449 : INTEGER, INTENT(in) :: n_el_force
1450 : REAL(kind=dp), DIMENSION(1:n_el_force), &
1451 : INTENT(inout) :: force
1452 : INTEGER, INTENT(out) :: ierr
1453 :
1454 : LOGICAL :: calc_f
1455 :
1456 13681 : calc_f = (n_el_force /= 0)
1457 13681 : CALL set_pos(env_id, pos, n_el_pos, ierr)
1458 13681 : IF (ierr == 0) CALL calc_energy_force(env_id, calc_f, ierr)
1459 13681 : IF (ierr == 0) CALL get_energy(env_id, e_pot, ierr)
1460 13681 : IF (calc_f .AND. (ierr == 0)) CALL get_force(env_id, force, n_el_force, ierr)
1461 :
1462 13681 : END SUBROUTINE calc_force
1463 :
1464 : ! **************************************************************************************************
1465 : !> \brief performs a check of the input
1466 : !> \param input_declaration ...
1467 : !> \param input_file_path the path of the input file to check
1468 : !> \param output_file_path path of the output file (to which it is appended)
1469 : !> if it is "__STD_OUT__" the default_output_unit is used
1470 : !> \param echo_input if the parsed input should be written out with all the
1471 : !> defaults made explicit
1472 : !> \param mpi_comm the mpi communicator (if not given it uses the default
1473 : !> one)
1474 : !> \param initial_variables key-value list of initial preprocessor variables
1475 : !> \param ierr error control, if different from 0 there was an error
1476 : !> \author fawzi
1477 : ! **************************************************************************************************
1478 0 : SUBROUTINE check_input(input_declaration, input_file_path, output_file_path, &
1479 0 : echo_input, mpi_comm, initial_variables, ierr)
1480 : TYPE(section_type), POINTER :: input_declaration
1481 : CHARACTER(len=*), INTENT(in) :: input_file_path, output_file_path
1482 : LOGICAL, INTENT(in), OPTIONAL :: echo_input
1483 : TYPE(mp_comm_type), INTENT(in), OPTIONAL :: mpi_comm
1484 : CHARACTER(len=default_path_length), &
1485 : DIMENSION(:, :), INTENT(IN) :: initial_variables
1486 : INTEGER, INTENT(out) :: ierr
1487 :
1488 : INTEGER :: unit_nr
1489 : LOGICAL :: my_echo_input
1490 : TYPE(cp_logger_type), POINTER :: logger
1491 : TYPE(mp_para_env_type), POINTER :: para_env
1492 : TYPE(section_vals_type), POINTER :: input_file
1493 :
1494 0 : my_echo_input = .FALSE.
1495 0 : IF (PRESENT(echo_input)) my_echo_input = echo_input
1496 :
1497 0 : IF (PRESENT(mpi_comm)) THEN
1498 0 : ALLOCATE (para_env)
1499 0 : para_env = mpi_comm
1500 : ELSE
1501 0 : para_env => default_para_env
1502 0 : CALL para_env%retain()
1503 : END IF
1504 0 : IF (para_env%is_source()) THEN
1505 0 : IF (output_file_path == "__STD_OUT__") THEN
1506 0 : unit_nr = default_output_unit
1507 : ELSE
1508 : CALL open_file(file_name=output_file_path, file_status="UNKNOWN", &
1509 : file_action="WRITE", file_position="APPEND", &
1510 0 : unit_number=unit_nr)
1511 : END IF
1512 : ELSE
1513 0 : unit_nr = -1
1514 : END IF
1515 :
1516 0 : NULLIFY (logger)
1517 : CALL cp_logger_create(logger, para_env=para_env, &
1518 : default_global_unit_nr=unit_nr, &
1519 0 : close_global_unit_on_dealloc=.FALSE.)
1520 0 : CALL cp_add_default_logger(logger)
1521 0 : CALL cp_logger_release(logger)
1522 :
1523 : input_file => read_input(input_declaration, input_file_path, initial_variables=initial_variables, &
1524 0 : para_env=para_env)
1525 0 : CALL check_cp2k_input(input_declaration, input_file, para_env=para_env, output_unit=unit_nr)
1526 0 : IF (my_echo_input .AND. (unit_nr > 0)) THEN
1527 : CALL section_vals_write(input_file, &
1528 : unit_nr=unit_nr, &
1529 : hide_root=.TRUE., &
1530 0 : hide_defaults=.FALSE.)
1531 : END IF
1532 0 : CALL section_vals_release(input_file)
1533 :
1534 0 : CALL cp_logger_release(logger)
1535 0 : CALL mp_para_env_release(para_env)
1536 0 : ierr = 0
1537 0 : CALL cp_rm_default_logger()
1538 :
1539 0 : END SUBROUTINE check_input
1540 :
1541 0 : END MODULE f77_interface
|
