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 for the force calculations
10 : !> \par History
11 : !> cjm, FEB-20-2001: pass variable box_ref
12 : !> cjm, SEPT-12-2002: major reorganization
13 : !> fawzi, APR-12-2003: introduced force_env
14 : !> cjm, FEB-27-2006: no more box_change
15 : !> MK, Nov. 2010: new interfaces added and others were updated
16 : !> \author CJM & JGH
17 : ! **************************************************************************************************
18 : MODULE force_env_types
19 : USE cell_types, ONLY: cell_type
20 : USE cp_log_handling, ONLY: cp_add_default_logger,&
21 : cp_logger_type,&
22 : cp_rm_default_logger
23 : USE cp_subsys_types, ONLY: cp_subsys_get,&
24 : cp_subsys_type,&
25 : pack_subsys_particles
26 : USE eip_environment_types, ONLY: eip_env_get,&
27 : eip_env_release,&
28 : eip_environment_type
29 : USE embed_types, ONLY: embed_env_release,&
30 : embed_env_type,&
31 : get_embed_env
32 : USE fist_energy_types, ONLY: fist_energy_type
33 : USE fist_environment_types, ONLY: fist_env_get,&
34 : fist_env_release,&
35 : fist_environment_type
36 : USE fp_types, ONLY: fp_env_release,&
37 : fp_type
38 : USE global_types, ONLY: global_environment_type,&
39 : globenv_release
40 : USE input_section_types, ONLY: section_vals_get,&
41 : section_vals_release,&
42 : section_vals_retain,&
43 : section_vals_type,&
44 : section_vals_val_get
45 : USE ipi_environment_types, ONLY: ipi_env_get,&
46 : ipi_env_release,&
47 : ipi_environment_type
48 : USE ipi_server, ONLY: shutdown_server
49 : USE kinds, ONLY: dp
50 : USE message_passing, ONLY: mp_para_env_release,&
51 : mp_para_env_type
52 : USE metadynamics_types, ONLY: meta_env_release,&
53 : meta_env_type
54 : USE mixed_energy_types, ONLY: mixed_energy_type
55 : USE mixed_environment_types, ONLY: get_mixed_env,&
56 : mixed_env_release,&
57 : mixed_environment_type
58 : USE nnp_environment_types, ONLY: nnp_env_get,&
59 : nnp_env_release,&
60 : nnp_type
61 : USE pwdft_environment_types, ONLY: pwdft_energy_type,&
62 : pwdft_env_get,&
63 : pwdft_env_release,&
64 : pwdft_environment_type
65 : USE qmmm_types, ONLY: qmmm_env_get,&
66 : qmmm_env_release,&
67 : qmmm_env_type
68 : USE qmmmx_types, ONLY: qmmmx_env_get,&
69 : qmmmx_env_release,&
70 : qmmmx_env_type
71 : USE qs_energy_types, ONLY: qs_energy_type
72 : USE qs_environment_types, ONLY: get_qs_env,&
73 : qs_env_release,&
74 : qs_environment_type
75 : #include "./base/base_uses.f90"
76 :
77 : IMPLICIT NONE
78 :
79 : PRIVATE
80 :
81 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'force_env_types'
82 :
83 : INTEGER, PARAMETER, PUBLIC :: use_fist_force = 501, &
84 : use_qs_force = 502, &
85 : use_qmmm = 503, &
86 : use_qmmmx = 504, &
87 : use_eip_force = 505, &
88 : use_mixed_force = 506, &
89 : use_embed = 507, &
90 : use_pwdft_force = 508, &
91 : use_nnp_force = 509, &
92 : use_ipi = 510
93 :
94 : CHARACTER(LEN=10), DIMENSION(501:510), PARAMETER, PUBLIC :: &
95 : use_prog_name = [ &
96 : "FIST ", &
97 : "QS ", &
98 : "QMMM ", &
99 : "QMMMX ", &
100 : "EIP ", &
101 : "MIXED ", &
102 : "EMBED ", &
103 : "SIRIUS", &
104 : "NNP ", &
105 : "IPI "]
106 :
107 : PUBLIC :: force_env_type, &
108 : force_env_p_type
109 :
110 : PUBLIC :: force_env_retain, &
111 : force_env_release, &
112 : force_env_get, &
113 : force_env_get_natom, &
114 : force_env_get_nparticle, &
115 : force_env_get_frc, &
116 : force_env_get_pos, &
117 : force_env_get_vel, &
118 : force_env_set, &
119 : multiple_fe_list
120 :
121 : ! **************************************************************************************************
122 : !> \brief wrapper to abstract the force evaluation of the various methods
123 : !> \param ref_count reference count (see doc/ReferenceCounting.html)
124 : !> \param in_use which method is in use
125 : !> \param fist_env the fist environment (allocated only if fist is in use)
126 : !> \param qs_env qs_env (activated only if quickstep is in use)
127 : !> \param globenv the globenv to have the input that generated this force_env
128 : !> \param para_env the parallel environment that contains all the parallel
129 : !> environment of the fragments
130 : !> \param meta_env the metadynamics environment, allocated if there is
131 : !> metadynamics
132 : !> \param fp_env the flexible partitioning environment
133 : !> read-only attributes (get them *only* through force_env_get):
134 : !> \param subsys the fragments that build up the actual system.
135 : !> \param cell the cell of the actual system
136 : !> \note
137 : !> as always direct manipulation of these attributes can have very
138 : !> bad effects. In this case it can be quite bad and the variables
139 : !> might not be up to date. You are warned, use only the get method...
140 : !> \par History
141 : !> 04.2003 created [fawzi]
142 : !> 07.2003 tried to adapt to multiple mpi groups
143 : !> \author fawzi
144 : ! **************************************************************************************************
145 : TYPE force_env_type
146 : INTEGER :: ref_count = 0, in_use = 0, method_name_id = 0
147 : REAL(KIND=dp) :: additional_potential = 0.0_dp
148 : TYPE(fist_environment_type), POINTER :: fist_env => NULL()
149 : TYPE(meta_env_type), POINTER :: meta_env => NULL()
150 : TYPE(fp_type), POINTER :: fp_env => NULL()
151 : TYPE(qs_environment_type), POINTER :: qs_env => NULL()
152 : TYPE(eip_environment_type), POINTER :: eip_env => NULL()
153 : TYPE(pwdft_environment_type), POINTER :: pwdft_env => NULL()
154 : TYPE(global_environment_type), POINTER :: globenv => NULL()
155 : TYPE(mp_para_env_type), POINTER :: para_env => NULL()
156 : TYPE(force_env_p_type), DIMENSION(:), POINTER :: sub_force_env => NULL()
157 : TYPE(qmmm_env_type), POINTER :: qmmm_env => NULL()
158 : TYPE(qmmmx_env_type), POINTER :: qmmmx_env => NULL()
159 : TYPE(mixed_environment_type), POINTER :: mixed_env => NULL()
160 : TYPE(nnp_type), POINTER :: nnp_env => NULL()
161 : TYPE(embed_env_type), POINTER :: embed_env => NULL()
162 : TYPE(ipi_environment_type), POINTER :: ipi_env => NULL()
163 : TYPE(section_vals_type), POINTER :: force_env_section => NULL()
164 : TYPE(section_vals_type), POINTER :: root_section => NULL()
165 : END TYPE force_env_type
166 :
167 : ! **************************************************************************************************
168 : !> \brief allows for the creation of an array of force_env
169 : !> \param force_env a force environment (see above)
170 : !> \note
171 : !> added by MJM for MC swap moves
172 : !> \author MJM
173 : ! **************************************************************************************************
174 : TYPE force_env_p_type
175 : TYPE(force_env_type), POINTER :: force_env => NULL()
176 : END TYPE force_env_p_type
177 :
178 : CONTAINS
179 :
180 : ! **************************************************************************************************
181 : !> \brief retains the given force env
182 : !> \param force_env the force environment to retain
183 : !> \par History
184 : !> 04.2003 created [fawzi]
185 : !> \author fawzi
186 : !> \note
187 : !> see doc/ReferenceCounting.html
188 : ! **************************************************************************************************
189 14334 : SUBROUTINE force_env_retain(force_env)
190 : TYPE(force_env_type), POINTER :: force_env
191 :
192 14334 : CPASSERT(ASSOCIATED(force_env))
193 14334 : CPASSERT(force_env%ref_count > 0)
194 14334 : force_env%ref_count = force_env%ref_count + 1
195 14334 : END SUBROUTINE force_env_retain
196 :
197 : ! **************************************************************************************************
198 : !> \brief releases the given force env
199 : !> \param force_env the force environment to release
200 : !> \par History
201 : !> 04.2003 created [fawzi]
202 : !> \author fawzi
203 : !> \note
204 : !> see doc/ReferenceCounting.html
205 : ! **************************************************************************************************
206 25845 : RECURSIVE SUBROUTINE force_env_release(force_env)
207 : TYPE(force_env_type), POINTER :: force_env
208 :
209 : INTEGER :: i, my_group
210 : TYPE(cp_logger_type), POINTER :: my_logger
211 :
212 25845 : IF (ASSOCIATED(force_env)) THEN
213 25845 : CPASSERT(force_env%ref_count > 0)
214 25845 : force_env%ref_count = force_env%ref_count - 1
215 25845 : IF (force_env%ref_count == 0) THEN
216 : ! Deallocate SUB_FORCE_ENV
217 11511 : IF (ASSOCIATED(force_env%sub_force_env)) THEN
218 584 : DO i = 1, SIZE(force_env%sub_force_env)
219 414 : IF (.NOT. ASSOCIATED(force_env%sub_force_env(i)%force_env)) CYCLE
220 : ! Use the proper logger to deallocate..
221 328 : IF (force_env%in_use == use_mixed_force) THEN
222 222 : my_group = force_env%mixed_env%group_distribution(force_env%para_env%mepos)
223 222 : my_logger => force_env%mixed_env%sub_logger(my_group + 1)%p
224 222 : CALL cp_add_default_logger(my_logger)
225 : END IF
226 : ! The same for embedding
227 328 : IF (force_env%in_use == use_embed) THEN
228 96 : my_group = force_env%embed_env%group_distribution(force_env%para_env%mepos)
229 96 : my_logger => force_env%embed_env%sub_logger(my_group + 1)%p
230 96 : CALL cp_add_default_logger(my_logger)
231 : END IF
232 328 : CALL force_env_release(force_env%sub_force_env(i)%force_env)
233 328 : IF (force_env%in_use == use_mixed_force) THEN
234 222 : CALL cp_rm_default_logger()
235 : END IF
236 498 : IF (force_env%in_use == use_embed) THEN
237 96 : CALL cp_rm_default_logger()
238 : END IF
239 : END DO
240 170 : DEALLOCATE (force_env%sub_force_env)
241 : END IF
242 :
243 13814 : SELECT CASE (force_env%in_use)
244 : CASE (use_fist_force)
245 2303 : CALL fist_env_release(force_env%fist_env)
246 2303 : DEALLOCATE (force_env%fist_env)
247 : CASE (use_qs_force)
248 8666 : CALL qs_env_release(force_env%qs_env)
249 8666 : DEALLOCATE (force_env%qs_env)
250 : CASE (use_eip_force)
251 8 : CALL eip_env_release(force_env%eip_env)
252 8 : DEALLOCATE (force_env%eip_env)
253 : CASE (use_pwdft_force)
254 20 : CALL pwdft_env_release(force_env%pwdft_env)
255 20 : DEALLOCATE (force_env%pwdft_env)
256 : CASE (use_mixed_force)
257 138 : CALL mixed_env_release(force_env%mixed_env)
258 138 : DEALLOCATE (force_env%mixed_env)
259 : CASE (use_nnp_force)
260 16 : CALL nnp_env_release(force_env%nnp_env)
261 16 : DEALLOCATE (force_env%nnp_env)
262 : CASE (use_embed)
263 24 : CALL embed_env_release(force_env%embed_env)
264 24 : DEALLOCATE (force_env%embed_env)
265 : CASE (use_ipi)
266 0 : CALL shutdown_server(force_env%ipi_env)
267 0 : CALL ipi_env_release(force_env%ipi_env)
268 11511 : DEALLOCATE (force_env%ipi_env)
269 : END SELECT
270 11511 : CALL globenv_release(force_env%globenv)
271 11511 : CALL mp_para_env_release(force_env%para_env)
272 : ! Not deallocated
273 11511 : CPASSERT(.NOT. ASSOCIATED(force_env%fist_env))
274 11511 : CPASSERT(.NOT. ASSOCIATED(force_env%qs_env))
275 11511 : CPASSERT(.NOT. ASSOCIATED(force_env%eip_env))
276 11511 : CPASSERT(.NOT. ASSOCIATED(force_env%pwdft_env))
277 11511 : CPASSERT(.NOT. ASSOCIATED(force_env%mixed_env))
278 11511 : CPASSERT(.NOT. ASSOCIATED(force_env%nnp_env))
279 11511 : CPASSERT(.NOT. ASSOCIATED(force_env%embed_env))
280 11511 : CPASSERT(.NOT. ASSOCIATED(force_env%ipi_env))
281 11511 : IF (ASSOCIATED(force_env%meta_env)) THEN
282 158 : CALL meta_env_release(force_env%meta_env)
283 158 : DEALLOCATE (force_env%meta_env)
284 : END IF
285 11511 : IF (ASSOCIATED(force_env%fp_env)) THEN
286 11183 : CALL fp_env_release(force_env%fp_env)
287 11183 : DEALLOCATE (force_env%fp_env)
288 : END IF
289 11511 : IF (ASSOCIATED(force_env%qmmm_env)) THEN
290 328 : CALL qmmm_env_release(force_env%qmmm_env)
291 328 : DEALLOCATE (force_env%qmmm_env)
292 : END IF
293 11511 : IF (ASSOCIATED(force_env%qmmmx_env)) THEN
294 8 : CALL qmmmx_env_release(force_env%qmmmx_env)
295 8 : DEALLOCATE (force_env%qmmmx_env)
296 : END IF
297 11511 : CALL section_vals_release(force_env%force_env_section)
298 11511 : CALL section_vals_release(force_env%root_section)
299 11511 : DEALLOCATE (force_env)
300 : END IF
301 : END IF
302 25845 : NULLIFY (force_env)
303 25845 : END SUBROUTINE force_env_release
304 :
305 : ! **************************************************************************************************
306 : !> \brief returns various attributes about the force environment
307 : !> \param force_env the force environment you what informations about
308 : !> \param in_use ...
309 : !> \param fist_env ...
310 : !> \param qs_env ...
311 : !> \param meta_env ...
312 : !> \param fp_env ...
313 : !> \param subsys ...
314 : !> \param para_env ...
315 : !> \param potential_energy ...
316 : !> \param additional_potential ...
317 : !> \param kinetic_energy ...
318 : !> \param harmonic_shell ...
319 : !> \param kinetic_shell ...
320 : !> \param cell ...
321 : !> \param sub_force_env ...
322 : !> \param qmmm_env ...
323 : !> \param qmmmx_env ...
324 : !> \param eip_env ...
325 : !> \param pwdft_env ...
326 : !> \param globenv ...
327 : !> \param input ...
328 : !> \param force_env_section ...
329 : !> \param method_name_id ...
330 : !> \param root_section ...
331 : !> \param mixed_env ...
332 : !> \param nnp_env ...
333 : !> \param embed_env ...
334 : !> \param ipi_env ...
335 : !> \par History
336 : !> 04.2003 created [fawzi]
337 : !> \author fawzi
338 : ! **************************************************************************************************
339 2152694 : RECURSIVE SUBROUTINE force_env_get(force_env, in_use, fist_env, qs_env, &
340 : meta_env, fp_env, subsys, para_env, potential_energy, additional_potential, &
341 : kinetic_energy, harmonic_shell, kinetic_shell, cell, sub_force_env, &
342 : qmmm_env, qmmmx_env, eip_env, pwdft_env, globenv, input, force_env_section, &
343 : method_name_id, root_section, mixed_env, nnp_env, embed_env, ipi_env)
344 : TYPE(force_env_type), INTENT(IN) :: force_env
345 : INTEGER, INTENT(out), OPTIONAL :: in_use
346 : TYPE(fist_environment_type), OPTIONAL, POINTER :: fist_env
347 : TYPE(qs_environment_type), OPTIONAL, POINTER :: qs_env
348 : TYPE(meta_env_type), OPTIONAL, POINTER :: meta_env
349 : TYPE(fp_type), OPTIONAL, POINTER :: fp_env
350 : TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
351 : TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env
352 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: potential_energy, additional_potential, &
353 : kinetic_energy, harmonic_shell, &
354 : kinetic_shell
355 : TYPE(cell_type), OPTIONAL, POINTER :: cell
356 : TYPE(force_env_p_type), DIMENSION(:), OPTIONAL, &
357 : POINTER :: sub_force_env
358 : TYPE(qmmm_env_type), OPTIONAL, POINTER :: qmmm_env
359 : TYPE(qmmmx_env_type), OPTIONAL, POINTER :: qmmmx_env
360 : TYPE(eip_environment_type), OPTIONAL, POINTER :: eip_env
361 : TYPE(pwdft_environment_type), OPTIONAL, POINTER :: pwdft_env
362 : TYPE(global_environment_type), OPTIONAL, POINTER :: globenv
363 : TYPE(section_vals_type), OPTIONAL, POINTER :: input, force_env_section
364 : INTEGER, INTENT(out), OPTIONAL :: method_name_id
365 : TYPE(section_vals_type), OPTIONAL, POINTER :: root_section
366 : TYPE(mixed_environment_type), OPTIONAL, POINTER :: mixed_env
367 : TYPE(nnp_type), OPTIONAL, POINTER :: nnp_env
368 : TYPE(embed_env_type), OPTIONAL, POINTER :: embed_env
369 : TYPE(ipi_environment_type), OPTIONAL, POINTER :: ipi_env
370 :
371 : REAL(KIND=dp) :: eip_kinetic_energy, eip_potential_energy
372 : TYPE(cp_subsys_type), POINTER :: subsys_tmp
373 : TYPE(fist_energy_type), POINTER :: thermo
374 : TYPE(mixed_energy_type), POINTER :: mixed_energy
375 : TYPE(pwdft_energy_type), POINTER :: pwdft_energy
376 : TYPE(qs_energy_type), POINTER :: qs_energy
377 :
378 2152694 : NULLIFY (subsys_tmp)
379 :
380 2152694 : CPASSERT(force_env%ref_count > 0)
381 :
382 2560397 : SELECT CASE (force_env%in_use)
383 : CASE (use_qs_force)
384 407703 : CPASSERT(ASSOCIATED(force_env%qs_env))
385 407703 : CPASSERT(.NOT. PRESENT(fist_env))
386 407703 : CPASSERT(.NOT. PRESENT(eip_env))
387 407703 : CPASSERT(.NOT. PRESENT(pwdft_env))
388 407703 : CPASSERT(.NOT. PRESENT(ipi_env))
389 : CALL get_qs_env(force_env%qs_env, &
390 : energy=qs_energy, &
391 : input=input, &
392 407703 : cp_subsys=subsys)
393 407703 : IF (PRESENT(potential_energy)) potential_energy = qs_energy%total
394 407703 : CPASSERT(.NOT. PRESENT(kinetic_energy))
395 : CASE (use_fist_force)
396 1655328 : CPASSERT(ASSOCIATED(force_env%fist_env))
397 1655328 : CPASSERT(.NOT. PRESENT(input))
398 : CALL fist_env_get(force_env%fist_env, &
399 : thermo=thermo, &
400 1655328 : subsys=subsys)
401 1655328 : IF (PRESENT(potential_energy)) potential_energy = thermo%pot
402 1655328 : IF (PRESENT(kinetic_energy)) kinetic_energy = thermo%kin
403 1655328 : IF (PRESENT(kinetic_shell)) kinetic_shell = thermo%kin_shell
404 1655328 : IF (PRESENT(harmonic_shell)) harmonic_shell = thermo%harm_shell
405 : CASE (use_eip_force)
406 2416 : CPASSERT(ASSOCIATED(force_env%eip_env))
407 2416 : CPASSERT(.NOT. PRESENT(qs_env))
408 2416 : CPASSERT(.NOT. PRESENT(fist_env))
409 2416 : CPASSERT(.NOT. PRESENT(ipi_env))
410 : CALL eip_env_get(force_env%eip_env, &
411 : eip_potential_energy=eip_potential_energy, &
412 : eip_kinetic_energy=eip_kinetic_energy, &
413 2416 : subsys=subsys)
414 2416 : IF (PRESENT(potential_energy)) THEN
415 176 : potential_energy = eip_potential_energy
416 : END IF
417 2416 : IF (PRESENT(kinetic_energy)) kinetic_energy = eip_kinetic_energy
418 0 : CPASSERT(.NOT. PRESENT(kinetic_energy))
419 : CASE (use_pwdft_force)
420 220 : CPASSERT(ASSOCIATED(force_env%pwdft_env))
421 220 : CPASSERT(.NOT. PRESENT(qs_env))
422 220 : CPASSERT(.NOT. PRESENT(fist_env))
423 220 : CPASSERT(.NOT. PRESENT(ipi_env))
424 220 : CALL pwdft_env_get(force_env%pwdft_env, energy=pwdft_energy)
425 220 : CALL pwdft_env_get(force_env%pwdft_env, cp_subsys=subsys)
426 220 : IF (PRESENT(potential_energy)) potential_energy = pwdft_energy%etotal
427 220 : CPASSERT(.NOT. PRESENT(kinetic_energy))
428 : CASE (use_qmmm)
429 : CALL qmmm_env_get(force_env%qmmm_env, &
430 : subsys=subsys, &
431 : potential_energy=potential_energy, &
432 65228 : kinetic_energy=kinetic_energy)
433 : CASE (use_qmmmx)
434 : CALL qmmmx_env_get(force_env%qmmmx_env, &
435 : subsys=subsys, &
436 : potential_energy=potential_energy, &
437 16849 : kinetic_energy=kinetic_energy)
438 : CASE (use_mixed_force)
439 15291 : CPASSERT(ASSOCIATED(force_env%mixed_env))
440 15291 : CPASSERT(.NOT. PRESENT(input))
441 : CALL get_mixed_env(force_env%mixed_env, &
442 : mixed_energy=mixed_energy, &
443 15291 : subsys=subsys)
444 15291 : IF (PRESENT(potential_energy)) potential_energy = mixed_energy%pot
445 15291 : IF (PRESENT(kinetic_energy)) kinetic_energy = mixed_energy%kin
446 : ! In embedding we only have potential energies (electronic energies)
447 : CASE (use_embed)
448 338 : CPASSERT(ASSOCIATED(force_env%embed_env))
449 338 : CPASSERT(.NOT. PRESENT(input))
450 : CALL get_embed_env(force_env%embed_env, &
451 : pot_energy=potential_energy, &
452 338 : subsys=subsys)
453 : CASE (use_nnp_force)
454 6170 : CPASSERT(ASSOCIATED(force_env%nnp_env))
455 6170 : CPASSERT(.NOT. PRESENT(ipi_env))
456 : CALL nnp_env_get(force_env%nnp_env, &
457 : nnp_potential_energy=potential_energy, &
458 6170 : subsys=subsys)
459 6170 : CPASSERT(.NOT. PRESENT(kinetic_energy))
460 : CASE (use_ipi)
461 : CALL ipi_env_get(force_env%ipi_env, &
462 : ipi_energy=potential_energy, &
463 0 : subsys=subsys)
464 : CASE DEFAULT
465 2161280 : CPABORT("unknown in_use flag value ")
466 : END SELECT
467 :
468 2152694 : IF (PRESENT(force_env_section)) force_env_section => force_env%force_env_section
469 2152694 : IF (PRESENT(in_use)) in_use = force_env%in_use
470 2152694 : IF (PRESENT(method_name_id)) method_name_id = force_env%method_name_id
471 2152694 : IF (PRESENT(fist_env)) THEN
472 14 : fist_env => force_env%fist_env
473 : END IF
474 2152694 : IF (PRESENT(qs_env)) THEN
475 26840 : qs_env => force_env%qs_env
476 : END IF
477 2152694 : IF (PRESENT(eip_env)) THEN
478 0 : eip_env => force_env%eip_env
479 : END IF
480 2152694 : IF (PRESENT(pwdft_env)) THEN
481 0 : pwdft_env => force_env%pwdft_env
482 : END IF
483 2152694 : IF (PRESENT(nnp_env)) THEN
484 0 : nnp_env => force_env%nnp_env
485 : END IF
486 2152694 : IF (PRESENT(ipi_env)) THEN
487 0 : ipi_env => force_env%ipi_env
488 : END IF
489 2152694 : IF (PRESENT(para_env)) para_env => force_env%para_env
490 : ! adjust the total energy for the metadynamics
491 2152694 : IF (ASSOCIATED(force_env%meta_env)) THEN
492 430954 : IF (PRESENT(potential_energy)) THEN
493 : potential_energy = potential_energy + &
494 : force_env%meta_env%epot_s + &
495 : force_env%meta_env%epot_walls + &
496 : force_env%meta_env%plumed_bias + &
497 27838 : force_env%meta_env%hills_env%energy
498 : END IF
499 430954 : IF (PRESENT(kinetic_energy)) THEN
500 0 : kinetic_energy = kinetic_energy + force_env%meta_env%ekin_s
501 : END IF
502 : END IF
503 : ! adjust the total energy for the flexible partitioning
504 2152694 : IF (ASSOCIATED(force_env%fp_env) .AND. PRESENT(potential_energy)) THEN
505 195240 : IF (force_env%fp_env%use_fp) THEN
506 244 : potential_energy = potential_energy + force_env%fp_env%energy
507 : END IF
508 : END IF
509 201766 : IF (PRESENT(potential_energy)) THEN
510 196790 : potential_energy = potential_energy + force_env%additional_potential
511 : END IF
512 2152694 : IF (PRESENT(additional_potential)) THEN
513 102578 : additional_potential = force_env%additional_potential
514 : END IF
515 2152694 : IF (PRESENT(cell)) THEN
516 500155 : CALL force_env_get(force_env, subsys=subsys_tmp)
517 500155 : CALL cp_subsys_get(subsys_tmp, cell=cell)
518 : END IF
519 2152694 : IF (PRESENT(fp_env)) fp_env => force_env%fp_env
520 2152694 : IF (PRESENT(meta_env)) meta_env => force_env%meta_env
521 2152694 : IF (PRESENT(sub_force_env)) sub_force_env => force_env%sub_force_env
522 2152694 : IF (PRESENT(qmmm_env)) qmmm_env => force_env%qmmm_env
523 2152694 : IF (PRESENT(qmmmx_env)) qmmmx_env => force_env%qmmmx_env
524 2152694 : IF (PRESENT(mixed_env)) mixed_env => force_env%mixed_env
525 2152694 : IF (PRESENT(embed_env)) embed_env => force_env%embed_env
526 2152694 : IF (PRESENT(ipi_env)) ipi_env => force_env%ipi_env
527 2152694 : IF (PRESENT(globenv)) globenv => force_env%globenv
528 2152694 : IF (PRESENT(root_section)) root_section => force_env%root_section
529 :
530 2152694 : END SUBROUTINE force_env_get
531 :
532 : ! **************************************************************************************************
533 : !> \brief returns the number of atoms
534 : !> \param force_env the force_env you what information about
535 : !> \return the number of atoms
536 : !> \date 22.11.2010 updated (MK)
537 : !> \author fawzi
538 : ! **************************************************************************************************
539 233572 : FUNCTION force_env_get_natom(force_env) RESULT(n_atom)
540 :
541 : TYPE(force_env_type), INTENT(IN) :: force_env
542 : INTEGER :: n_atom
543 :
544 : TYPE(cp_subsys_type), POINTER :: subsys
545 :
546 : n_atom = 0
547 116786 : NULLIFY (subsys)
548 116786 : CALL force_env_get(force_env, subsys=subsys)
549 116786 : CALL cp_subsys_get(subsys, natom=n_atom)
550 :
551 116786 : END FUNCTION force_env_get_natom
552 :
553 : ! **************************************************************************************************
554 : !> \brief returns the number of particles in a force environment
555 : !> \param force_env the force_env you what information about
556 : !> \return the number of particles
557 : !> \date 22.11.2010 (MK)
558 : !> \author Matthias Krack
559 : ! **************************************************************************************************
560 45082 : FUNCTION force_env_get_nparticle(force_env) RESULT(n_particle)
561 :
562 : TYPE(force_env_type), INTENT(IN) :: force_env
563 : INTEGER :: n_particle
564 :
565 : TYPE(cp_subsys_type), POINTER :: subsys
566 :
567 : n_particle = 0
568 22541 : NULLIFY (subsys)
569 22541 : CALL force_env_get(force_env, subsys=subsys)
570 22541 : CALL cp_subsys_get(subsys, nparticle=n_particle)
571 :
572 22541 : END FUNCTION force_env_get_nparticle
573 :
574 : ! **************************************************************************************************
575 : !> \brief returns the particle forces in a dimension(*) array
576 : !> \param force_env the force_env you want to get the forces
577 : !> \param frc the array of the forces
578 : !> \param n ...
579 : !> \date 22.11.2010 Creation
580 : !> \author Matthias Krack
581 : ! **************************************************************************************************
582 9724 : SUBROUTINE force_env_get_frc(force_env, frc, n)
583 :
584 : TYPE(force_env_type), INTENT(IN) :: force_env
585 : REAL(KIND=dp), DIMENSION(*), INTENT(OUT) :: frc
586 : INTEGER, INTENT(IN) :: n
587 :
588 : CHARACTER(LEN=*), PARAMETER :: routineN = 'force_env_get_frc'
589 :
590 : INTEGER :: handle
591 : TYPE(cp_subsys_type), POINTER :: subsys
592 :
593 9724 : CALL timeset(routineN, handle)
594 9724 : CPASSERT(force_env%ref_count > 0)
595 9724 : CALL force_env_get(force_env, subsys=subsys)
596 9724 : CALL pack_subsys_particles(subsys=subsys, f=frc(1:n))
597 9724 : CALL timestop(handle)
598 :
599 9724 : END SUBROUTINE force_env_get_frc
600 :
601 : ! **************************************************************************************************
602 : !> \brief returns the particle positions in a dimension(*) array
603 : !> \param force_env the force_env you want to get the positions
604 : !> \param pos the array of the positions
605 : !> \param n ...
606 : !> \date 22.11.2010 updated (MK)
607 : !> \author fawzi
608 : ! **************************************************************************************************
609 352 : SUBROUTINE force_env_get_pos(force_env, pos, n)
610 :
611 : TYPE(force_env_type), INTENT(IN) :: force_env
612 : REAL(kind=dp), DIMENSION(*), INTENT(OUT) :: pos
613 : INTEGER, INTENT(IN) :: n
614 :
615 : CHARACTER(LEN=*), PARAMETER :: routineN = 'force_env_get_pos'
616 :
617 : INTEGER :: handle
618 : TYPE(cp_subsys_type), POINTER :: subsys
619 :
620 352 : CALL timeset(routineN, handle)
621 352 : CPASSERT(force_env%ref_count > 0)
622 352 : CALL force_env_get(force_env, subsys=subsys)
623 352 : CALL pack_subsys_particles(subsys=subsys, r=pos(1:n))
624 352 : CALL timestop(handle)
625 :
626 352 : END SUBROUTINE force_env_get_pos
627 :
628 : ! **************************************************************************************************
629 : !> \brief returns the particle velocities in a dimension(*) array
630 : !> \param force_env the force_env you want to get the velocities
631 : !> \param vel the array of the velocities
632 : !> \param n ...
633 : !> \date 22.11.2010 Creation (MK)
634 : !> \author Matthias Krack
635 : ! **************************************************************************************************
636 0 : SUBROUTINE force_env_get_vel(force_env, vel, n)
637 :
638 : TYPE(force_env_type), INTENT(IN) :: force_env
639 : REAL(KIND=dp), DIMENSION(*), INTENT(OUT) :: vel
640 : INTEGER, INTENT(IN) :: n
641 :
642 : CHARACTER(LEN=*), PARAMETER :: routineN = 'force_env_get_vel'
643 :
644 : INTEGER :: handle
645 : TYPE(cp_subsys_type), POINTER :: subsys
646 :
647 0 : CALL timeset(routineN, handle)
648 0 : CPASSERT(force_env%ref_count > 0)
649 0 : CALL force_env_get(force_env, subsys=subsys)
650 0 : CALL pack_subsys_particles(subsys=subsys, v=vel(1:n))
651 0 : CALL timestop(handle)
652 :
653 0 : END SUBROUTINE force_env_get_vel
654 :
655 : ! **************************************************************************************************
656 : !> \brief changes some attributes of the force_env
657 : !> \param force_env the force environment where the cell should be changed
658 : !> \param meta_env the new meta environment
659 : !> \param fp_env ...
660 : !> \param force_env_section ...
661 : !> \param method_name_id ...
662 : !> \param additional_potential ...
663 : !> \par History
664 : !> 09.2003 created [fawzi]
665 : !> \author Fawzi Mohamed
666 : ! **************************************************************************************************
667 228039 : SUBROUTINE force_env_set(force_env, meta_env, fp_env, force_env_section, &
668 : method_name_id, additional_potential)
669 :
670 : TYPE(force_env_type), INTENT(INOUT) :: force_env
671 : TYPE(meta_env_type), OPTIONAL, POINTER :: meta_env
672 : TYPE(fp_type), OPTIONAL, POINTER :: fp_env
673 : TYPE(section_vals_type), OPTIONAL, POINTER :: force_env_section
674 : INTEGER, OPTIONAL :: method_name_id
675 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: additional_potential
676 :
677 228039 : CPASSERT(force_env%ref_count > 0)
678 228039 : IF (PRESENT(meta_env)) THEN
679 11184 : IF (ASSOCIATED(force_env%meta_env)) THEN
680 0 : CALL meta_env_release(force_env%meta_env)
681 0 : DEALLOCATE (force_env%meta_env)
682 : END IF
683 11184 : force_env%meta_env => meta_env
684 : END IF
685 228039 : IF (PRESENT(fp_env)) THEN
686 11184 : IF (ASSOCIATED(force_env%fp_env)) CALL fp_env_release(force_env%fp_env)
687 11184 : force_env%fp_env => fp_env
688 : END IF
689 228039 : IF (PRESENT(force_env_section)) THEN
690 0 : IF (ASSOCIATED(force_env_section)) THEN
691 0 : CALL section_vals_retain(force_env_section)
692 0 : CALL section_vals_release(force_env%force_env_section)
693 0 : force_env%force_env_section => force_env_section
694 : END IF
695 : END IF
696 228039 : IF (PRESENT(additional_potential)) THEN
697 205671 : force_env%additional_potential = additional_potential
698 : END IF
699 228039 : IF (PRESENT(method_name_id)) THEN
700 0 : force_env%method_name_id = method_name_id
701 : END IF
702 :
703 228039 : END SUBROUTINE force_env_set
704 :
705 : ! **************************************************************************************************
706 : !> \brief returns the order of the multiple force_env
707 : !> \param force_env_sections ...
708 : !> \param root_section ...
709 : !> \param i_force_eval ...
710 : !> \param nforce_eval ...
711 : !> \author teo
712 : ! **************************************************************************************************
713 30897 : SUBROUTINE multiple_fe_list(force_env_sections, root_section, i_force_eval, nforce_eval)
714 :
715 : TYPE(section_vals_type), INTENT(IN) :: force_env_sections, root_section
716 : INTEGER, DIMENSION(:), POINTER :: i_force_eval
717 : INTEGER :: nforce_eval
718 :
719 : INTEGER :: iforce_eval, main_force_eval
720 30897 : INTEGER, DIMENSION(:), POINTER :: my_i_force_eval
721 :
722 : ! Let's treat the case of Multiple force_eval
723 :
724 30897 : CALL section_vals_get(force_env_sections, n_repetition=nforce_eval)
725 : CALL section_vals_val_get(root_section, "MULTIPLE_FORCE_EVALS%FORCE_EVAL_ORDER", &
726 30897 : i_vals=my_i_force_eval)
727 92431 : ALLOCATE (i_force_eval(nforce_eval))
728 30897 : IF (nforce_eval > 0) THEN
729 30637 : IF (nforce_eval == SIZE(my_i_force_eval)) THEN
730 121722 : i_force_eval = my_i_force_eval
731 : ELSE
732 : ! The difference in the amount of defined force_env MUST be one..
733 273 : CPASSERT(nforce_eval - SIZE(my_i_force_eval) == 1)
734 283 : DO iforce_eval = 1, nforce_eval
735 964 : IF (ANY(my_i_force_eval == iforce_eval)) CYCLE
736 : main_force_eval = iforce_eval
737 10 : EXIT
738 : END DO
739 273 : i_force_eval(1) = main_force_eval
740 1898 : i_force_eval(2:nforce_eval) = my_i_force_eval
741 : END IF
742 : END IF
743 :
744 30897 : END SUBROUTINE multiple_fe_list
745 :
746 0 : END MODULE force_env_types
|