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