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 Update a QM/MM calculations with force mixing
10 : !> \par History
11 : !> 5.2004 created [fawzi]
12 : !> \author Fawzi Mohamed
13 : ! **************************************************************************************************
14 : MODULE qmmmx_update
15 : USE atomic_kind_list_types, ONLY: atomic_kind_list_type
16 : USE cp_subsys_types, ONLY: cp_subsys_get,&
17 : cp_subsys_type
18 : USE distribution_1d_types, ONLY: distribution_1d_type
19 : USE force_env_types, ONLY: force_env_get,&
20 : force_env_type
21 : USE input_restart_force_eval, ONLY: update_force_eval
22 : USE input_section_types, ONLY: section_vals_get,&
23 : section_vals_get_subs_vals,&
24 : section_vals_release,&
25 : section_vals_type
26 : USE qmmm_create, ONLY: qmmm_env_create
27 : USE qmmm_types, ONLY: qmmm_env_get
28 : USE qmmmx_types, ONLY: qmmmx_env_release,&
29 : qmmmx_env_type
30 : USE qmmmx_util, ONLY: setup_force_mixing_qmmm_sections,&
31 : update_force_mixing_labels
32 : #include "./base/base_uses.f90"
33 :
34 : IMPLICIT NONE
35 : PRIVATE
36 :
37 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
38 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qmmmx_update'
39 :
40 : PUBLIC :: qmmmx_update_force_env
41 :
42 : CONTAINS
43 :
44 : ! **************************************************************************************************
45 : !> \brief ...
46 : !> \param force_env ...
47 : !> \param root_section ...
48 : ! **************************************************************************************************
49 15272 : SUBROUTINE qmmmx_update_force_env(force_env, root_section)
50 : TYPE(force_env_type), POINTER :: force_env
51 : TYPE(section_vals_type), POINTER :: root_section
52 :
53 : LOGICAL :: force_mixing_active, labels_changed
54 : TYPE(atomic_kind_list_type), POINTER :: atomic_kinds, new_atomic_kinds
55 : TYPE(cp_subsys_type), POINTER :: subsys, subsys_new
56 : TYPE(distribution_1d_type), POINTER :: local_particles, new_local_particles
57 : TYPE(qmmmx_env_type) :: new_qmmmx_env
58 : TYPE(section_vals_type), POINTER :: qmmm_core_section, &
59 : qmmm_extended_Section, &
60 : qmmm_force_mixing, qmmm_section, &
61 : subsys_section
62 :
63 : ! check everything for not null, because sometimes (e.g. metadynamics in parallel) it happens
64 :
65 7614 : IF (.NOT. ASSOCIATED(force_env)) RETURN
66 7636 : IF (.NOT. ASSOCIATED(force_env%force_env_section)) RETURN
67 : ! these two should never happen, because the sections exist, but just in case...
68 7636 : qmmm_section => section_vals_get_subs_vals(force_env%force_env_section, "QMMM", can_return_null=.TRUE.)
69 7636 : IF (.NOT. ASSOCIATED(qmmm_section)) RETURN
70 7636 : qmmm_force_mixing => section_vals_get_subs_vals(qmmm_section, "FORCE_MIXING", can_return_null=.TRUE.)
71 7636 : IF (.NOT. ASSOCIATED(qmmm_force_mixing)) RETURN
72 7636 : CALL section_vals_get(qmmm_force_mixing, explicit=force_mixing_active)
73 7636 : IF (.NOT. force_mixing_active) RETURN
74 48 : IF (.NOT. ASSOCIATED(force_env%qmmmx_env)) CPABORT("force_env%qmmmx not associated")
75 :
76 48 : CALL force_env_get(force_env, subsys=subsys)
77 48 : CALL update_force_mixing_labels(subsys, qmmm_section, labels_changed=labels_changed)
78 48 : IF (.NOT. labels_changed) RETURN
79 22 : CPWARN("Adaptive force-mixing labels changed, rebuilding QM/MM calculations! ")
80 :
81 22 : CALL update_force_eval(force_env, root_section, .FALSE.)
82 :
83 : ! using CUR_INDICES and CUR_LABELS, create appropriate QM_KIND sections for two QM/MM calculations
84 22 : CALL setup_force_mixing_qmmm_sections(subsys, qmmm_section, qmmm_core_section, qmmm_extended_section)
85 :
86 22 : subsys_section => section_vals_get_subs_vals(force_env%force_env_section, "SUBSYS")
87 : ![ADAPT] no sure about use_motion_section
88 22 : ALLOCATE (new_qmmmx_env%core)
89 : CALL qmmm_env_create(new_qmmmx_env%core, &
90 : force_env%root_section, force_env%para_env, force_env%globenv, &
91 : force_env%force_env_section, qmmm_core_section, subsys_section, use_motion_section=.TRUE., &
92 22 : prev_subsys=subsys, ignore_outside_box=.TRUE.)
93 22 : ALLOCATE (new_qmmmx_env%ext)
94 : CALL qmmm_env_create(new_qmmmx_env%ext, &
95 : force_env%root_section, force_env%para_env, force_env%globenv, &
96 : force_env%force_env_section, qmmm_extended_section, subsys_section, use_motion_section=.TRUE., &
97 22 : prev_subsys=subsys, ignore_outside_box=.TRUE.)
98 :
99 : ! [NB] need to copy wiener process data, since it's not recreated when
100 : ! fist subsys is recreated by qmmm_env_create
101 22 : CALL qmmm_env_get(force_env%qmmmx_env%core, subsys=subsys)
102 22 : CALL cp_subsys_get(subsys, atomic_kinds=atomic_kinds, local_particles=local_particles)
103 22 : CALL qmmm_env_get(new_qmmmx_env%core, subsys=subsys_new)
104 22 : CALL cp_subsys_get(subsys_new, atomic_kinds=new_atomic_kinds, local_particles=new_local_particles)
105 22 : IF (ASSOCIATED(local_particles%local_particle_set)) THEN
106 0 : CALL copy_wiener_process(atomic_kinds, local_particles, new_atomic_kinds, new_local_particles)
107 : END IF
108 :
109 22 : CALL qmmm_env_get(force_env%qmmmx_env%ext, subsys=subsys)
110 22 : CALL cp_subsys_get(subsys, atomic_kinds=atomic_kinds, local_particles=local_particles)
111 22 : CALL qmmm_env_get(new_qmmmx_env%ext, subsys=subsys_new)
112 22 : CALL cp_subsys_get(subsys_new, atomic_kinds=new_atomic_kinds, local_particles=new_local_particles)
113 22 : IF (ASSOCIATED(local_particles%local_particle_set)) THEN
114 2 : CALL copy_wiener_process(atomic_kinds, local_particles, new_atomic_kinds, new_local_particles)
115 : END IF
116 :
117 22 : CALL section_vals_release(qmmm_core_section)
118 22 : CALL section_vals_release(qmmm_extended_section)
119 :
120 : ! release old qmmmx_env and point to new one
121 22 : CALL qmmmx_env_release(force_env%qmmmx_env)
122 22 : force_env%qmmmx_env = new_qmmmx_env
123 :
124 7636 : END SUBROUTINE qmmmx_update_force_env
125 :
126 : ! **************************************************************************************************
127 : !> \brief ...
128 : !> \param from_local_particle_kinds ...
129 : !> \param from_local_particles ...
130 : !> \param to_local_particle_kinds ...
131 : !> \param to_local_particles ...
132 : ! **************************************************************************************************
133 2 : SUBROUTINE copy_wiener_process(from_local_particle_kinds, from_local_particles, &
134 : to_local_particle_kinds, to_local_particles)
135 : TYPE(atomic_kind_list_type), POINTER :: from_local_particle_kinds
136 : TYPE(distribution_1d_type), POINTER :: from_local_particles
137 : TYPE(atomic_kind_list_type), POINTER :: to_local_particle_kinds
138 : TYPE(distribution_1d_type), POINTER :: to_local_particles
139 :
140 : CHARACTER(LEN=*), PARAMETER :: routineN = 'copy_wiener_process'
141 :
142 : INTEGER :: from_iparticle_kind, from_iparticle_local(1), from_nparticle_kind, &
143 : from_nparticle_local, handle, to_iparticle_global, to_iparticle_kind, to_iparticle_local, &
144 : to_nparticle_kind, to_nparticle_local, tot_from_nparticle_local, tot_to_nparticle_local
145 : LOGICAL :: found_it
146 :
147 2 : CALL timeset(routineN, handle)
148 2 : CPASSERT(ASSOCIATED(from_local_particles))
149 2 : CPASSERT(ASSOCIATED(to_local_particles))
150 :
151 2 : IF (.NOT. ASSOCIATED(from_local_particles%local_particle_set)) RETURN
152 2 : CPASSERT(.NOT. ASSOCIATED(to_local_particles%local_particle_set))
153 :
154 2 : from_nparticle_kind = from_local_particle_kinds%n_els
155 2 : to_nparticle_kind = to_local_particle_kinds%n_els
156 :
157 : ! make sure total number of particles hasn't changed, even if particle kinds have
158 2 : tot_from_nparticle_local = 0
159 42 : DO from_iparticle_kind = 1, from_nparticle_kind
160 42 : tot_from_nparticle_local = tot_from_nparticle_local + from_local_particles%n_el(from_iparticle_kind)
161 : END DO
162 : tot_to_nparticle_local = 0
163 42 : DO to_iparticle_kind = 1, to_nparticle_kind
164 42 : tot_to_nparticle_local = tot_to_nparticle_local + to_local_particles%n_el(to_iparticle_kind)
165 : END DO
166 2 : CPASSERT(tot_from_nparticle_local == tot_to_nparticle_local)
167 :
168 46 : ALLOCATE (to_local_particles%local_particle_set(to_nparticle_kind))
169 42 : DO to_iparticle_kind = 1, to_nparticle_kind
170 :
171 40 : to_nparticle_local = to_local_particles%n_el(to_iparticle_kind)
172 3769 : ALLOCATE (to_local_particles%local_particle_set(to_iparticle_kind)%rng(to_nparticle_local))
173 :
174 3707 : DO to_iparticle_local = 1, to_nparticle_local
175 3665 : to_iparticle_global = to_local_particles%list(to_iparticle_kind)%array(to_iparticle_local)
176 91625 : ALLOCATE (to_local_particles%local_particle_set(to_iparticle_kind)%rng(to_iparticle_local)%stream)
177 :
178 3665 : found_it = .FALSE.
179 : ! find the matching kind/index where this particle was before
180 64724 : DO from_iparticle_kind = 1, from_nparticle_kind
181 64724 : from_nparticle_local = from_local_particles%n_el(from_iparticle_kind)
182 5179234 : IF (MINVAL(ABS(from_local_particles%list(from_iparticle_kind)%array(1:from_nparticle_local) - &
183 0 : to_iparticle_global)) == 0) THEN
184 : from_iparticle_local = &
185 : MINLOC(ABS(from_local_particles%list(from_iparticle_kind)%array(1:from_nparticle_local) - &
186 3523902 : to_iparticle_global))
187 : to_local_particles%local_particle_set(to_iparticle_kind)%rng(to_iparticle_local)%stream = &
188 3665 : from_local_particles%local_particle_set(from_iparticle_kind)%rng(from_iparticle_local(1))%stream
189 : found_it = .TRUE.
190 : EXIT
191 : END IF
192 : END DO
193 40 : CPASSERT(found_it)
194 :
195 : END DO ! to_iparticle_local
196 :
197 : END DO ! to_iparticle_kind
198 2 : CALL timestop(handle)
199 :
200 2 : END SUBROUTINE copy_wiener_process
201 :
202 : END MODULE qmmmx_update
|
