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 types used to handle many replica of the same system that differ only
10 : !> in atom positions, and velocity.
11 : !> This is useful for things like path integrals or nudged elastic band
12 : !> \note
13 : !> this is a stupid implementation that replicates all the information
14 : !> about the replicas, if you really want to do a *lot* of replicas on
15 : !> a lot of processors you should think about distributiong also that
16 : !> information
17 : !> \par History
18 : !> 09.2005 created [fawzi]
19 : !> \author fawzi
20 : ! **************************************************************************************************
21 : MODULE replica_types
22 : USE cp_log_handling, ONLY: cp_get_default_logger,&
23 : cp_logger_type,&
24 : cp_to_string
25 : USE cp_output_handling, ONLY: cp_rm_iter_level
26 : USE cp_result_methods, ONLY: cp_results_mp_bcast
27 : USE cp_result_types, ONLY: cp_result_p_type,&
28 : cp_result_release
29 : USE f77_interface, ONLY: destroy_force_env,&
30 : f_env_add_defaults,&
31 : f_env_rm_defaults,&
32 : f_env_type
33 : USE kinds, ONLY: default_path_length,&
34 : dp
35 : USE message_passing, ONLY: mp_para_cart_release,&
36 : mp_para_cart_type,&
37 : mp_para_env_release,&
38 : mp_para_env_type
39 : USE qs_wf_history_types, ONLY: qs_wf_history_p_type,&
40 : wfi_release
41 : #include "./base/base_uses.f90"
42 :
43 : IMPLICIT NONE
44 : PRIVATE
45 :
46 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
47 : LOGICAL, SAVE, PRIVATE :: module_initialized = .FALSE.
48 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'replica_types'
49 :
50 : PUBLIC :: replica_env_type
51 : PUBLIC :: rep_env_release
52 : PUBLIC :: rep_env_sync, rep_env_sync_results, rep_envs_add_rep_env
53 : PUBLIC :: rep_envs_get_rep_env
54 :
55 : ! **************************************************************************************************
56 : !> \brief keeps replicated information about the replicas
57 : !> \param ref_count reference count
58 : !> \param id_nr identity number (unique or each replica_env)
59 : !> \param nrep number of replicas
60 : !> \param nparticle number of particles (usually atoms) in each replica
61 : !> \param ndim = 3*nparticle
62 : !> \param f_env_id id of the force env that will do the calculations for the
63 : !> replicas owned by this processor
64 : !> \param r ,v,f: positions, velocities and forces of the replicas.
65 : !> the indexing is as follow (idir,iat,irep)
66 : !> \param replica_owner which replica group number owns the replica irep
67 : !> \param cart 2d distribution of the processors for the replicas,
68 : !> a column (or row if row_force was true in the rep_env_create call)
69 : !> work together on the same force_env (i.e. changing the
70 : !> row (column) you stay in the same replica), rows (columns) have
71 : !> different replicas
72 : !> \param force_dim which dimension of cart works on forces together
73 : !> used to be hardcoded to 1. Default is still 1, will
74 : !> be 2 if row_force is true in the rep_env_create call.
75 : !> \param para_env the global para env that contains all the replicas,
76 : !> this is just the cart as para_env
77 : !> \param para_env_f parallel environment of the underlying force
78 : !> environment
79 : !> \param inter_rep_rank mapping replica group number -> rank in para_env_inter_rep
80 : !> (this used to be col_rank)
81 : !> \param para_env_inter_rep parallel environment between replica
82 : !> \param force_rank mapping number of processor in force env -> rank in para_env_f
83 : !> (this used to be row_rank)
84 : !> \param local_rep_indices indices of the local replicas, starting at 1
85 : !> \param rep_is_local logical if specific replica is a local one.
86 : !> \param my_rep_group which replica group number this process belongs to
87 : !> (this used to be just cart%mepos(2) but with transposing the cart
88 : !> (row_force=.true.) became cart%mepos(1), and to generalize this it
89 : !> is now a separate variable, so one does not need to know
90 : !> which way the cart is mapped.)
91 : !> \param wf_history wavefunction history for the owned replicas
92 : !> \param keep_wf_history if the wavefunction history for the owned replicas
93 : !> should be kept
94 : !> \author fawzi
95 : ! **************************************************************************************************
96 : TYPE replica_env_type
97 : INTEGER :: ref_count = -1, id_nr = -1, f_env_id = -1, &
98 : nrep = -1, ndim = -1, nparticle = -1, &
99 : my_rep_group = -1, force_dim = -1
100 : REAL(kind=dp), DIMENSION(:, :), POINTER :: r => NULL(), v => NULL(), f => NULL()
101 : LOGICAL :: sync_v = .FALSE., keep_wf_history = .FALSE.
102 : CHARACTER(LEN=default_path_length) :: original_project_name = ""
103 : TYPE(qs_wf_history_p_type), DIMENSION(:), POINTER :: wf_history => NULL()
104 : TYPE(cp_result_p_type), DIMENSION(:), POINTER :: results => NULL()
105 : INTEGER, DIMENSION(:), POINTER :: local_rep_indices => NULL()
106 : INTEGER, DIMENSION(:), POINTER :: replica_owner => NULL(), force_rank => NULL(), &
107 : inter_rep_rank => NULL()
108 : LOGICAL, DIMENSION(:), POINTER :: rep_is_local => NULL()
109 : TYPE(mp_para_cart_type), POINTER :: cart => NULL()
110 : TYPE(mp_para_env_type), POINTER :: para_env => NULL(), para_env_f => NULL(), &
111 : para_env_inter_rep => NULL()
112 : END TYPE replica_env_type
113 :
114 : ! **************************************************************************************************
115 : !> \brief ****s* replica_types/replica_env_p_type *
116 : !>
117 : !> to build arrays of pointers to a replica_env_type
118 : !> \param rep_env the pointer to the replica_env
119 : !> \author fawzi
120 : ! **************************************************************************************************
121 : TYPE replica_env_p_type
122 : TYPE(replica_env_type), POINTER :: rep_env => NULL()
123 : END TYPE replica_env_p_type
124 :
125 : TYPE(replica_env_p_type), POINTER, DIMENSION(:), PRIVATE :: rep_envs
126 :
127 : CONTAINS
128 :
129 : ! **************************************************************************************************
130 : !> \brief releases the given replica environment
131 : !> \param rep_env the replica environment to release
132 : !> \author fawzi
133 : !> \note
134 : !> here and not in replica_types to allow the use of replica_env_type
135 : !> in a force_env (call to destroy_force_env gives circular dep)
136 : ! **************************************************************************************************
137 148 : SUBROUTINE rep_env_release(rep_env)
138 : TYPE(replica_env_type), POINTER :: rep_env
139 :
140 : CHARACTER(len=*), PARAMETER :: routineN = 'rep_env_release'
141 :
142 : INTEGER :: handle, i, ierr
143 :
144 148 : CALL timeset(routineN, handle)
145 148 : IF (ASSOCIATED(rep_env)) THEN
146 148 : CPASSERT(rep_env%ref_count > 0)
147 148 : rep_env%ref_count = rep_env%ref_count - 1
148 148 : IF (rep_env%ref_count == 0) THEN
149 148 : CALL rep_env_destroy_low(rep_env%id_nr, ierr)
150 148 : IF (rep_env%f_env_id > 0) THEN
151 148 : CALL destroy_force_env(rep_env%f_env_id, ierr)
152 148 : CPASSERT(ierr == 0)
153 : END IF
154 148 : IF (ASSOCIATED(rep_env%r)) THEN
155 148 : DEALLOCATE (rep_env%r)
156 : END IF
157 148 : IF (ASSOCIATED(rep_env%v)) THEN
158 148 : DEALLOCATE (rep_env%v)
159 : END IF
160 148 : IF (ASSOCIATED(rep_env%f)) THEN
161 148 : DEALLOCATE (rep_env%f)
162 : END IF
163 148 : IF (ASSOCIATED(rep_env%wf_history)) THEN
164 66 : DO i = 1, SIZE(rep_env%wf_history)
165 66 : CALL wfi_release(rep_env%wf_history(i)%wf_history)
166 : END DO
167 30 : DEALLOCATE (rep_env%wf_history)
168 : END IF
169 148 : IF (ASSOCIATED(rep_env%results)) THEN
170 650 : DO i = 1, SIZE(rep_env%results)
171 650 : CALL cp_result_release(rep_env%results(i)%results)
172 : END DO
173 148 : DEALLOCATE (rep_env%results)
174 : END IF
175 148 : DEALLOCATE (rep_env%local_rep_indices)
176 148 : DEALLOCATE (rep_env%rep_is_local)
177 148 : IF (ASSOCIATED(rep_env%replica_owner)) THEN
178 148 : DEALLOCATE (rep_env%replica_owner)
179 : END IF
180 148 : DEALLOCATE (rep_env%inter_rep_rank, rep_env%force_rank)
181 148 : CALL mp_para_cart_release(rep_env%cart)
182 148 : CALL mp_para_env_release(rep_env%para_env)
183 148 : CALL mp_para_env_release(rep_env%para_env_f)
184 148 : CALL mp_para_env_release(rep_env%para_env_inter_rep)
185 148 : CALL rep_envs_rm_rep_env(rep_env)
186 148 : DEALLOCATE (rep_env)
187 : END IF
188 : END IF
189 148 : NULLIFY (rep_env)
190 148 : CALL timestop(handle)
191 148 : END SUBROUTINE rep_env_release
192 :
193 : ! **************************************************************************************************
194 : !> \brief initializes the destruction of the replica_env
195 : !> \param rep_env_id id_nr of the replica environment that should be initialized
196 : !> \param ierr will be non zero if there is an initialization error
197 : !> \author fawzi
198 : ! **************************************************************************************************
199 296 : SUBROUTINE rep_env_destroy_low(rep_env_id, ierr)
200 : INTEGER, INTENT(in) :: rep_env_id
201 : INTEGER, INTENT(out) :: ierr
202 :
203 : INTEGER :: stat
204 : TYPE(cp_logger_type), POINTER :: logger
205 : TYPE(f_env_type), POINTER :: f_env
206 : TYPE(replica_env_type), POINTER :: rep_env
207 :
208 148 : rep_env => rep_envs_get_rep_env(rep_env_id, ierr=stat)
209 148 : IF (.NOT. ASSOCIATED(rep_env)) THEN
210 0 : CPABORT("could not find rep_env with id_nr"//cp_to_string(rep_env_id))
211 : END IF
212 148 : CALL f_env_add_defaults(f_env_id=rep_env%f_env_id, f_env=f_env)
213 148 : logger => cp_get_default_logger()
214 : CALL cp_rm_iter_level(iteration_info=logger%iter_info, &
215 148 : level_name="REPLICA_EVAL")
216 148 : CALL f_env_rm_defaults(f_env, ierr)
217 148 : CPASSERT(ierr == 0)
218 148 : END SUBROUTINE rep_env_destroy_low
219 :
220 : ! **************************************************************************************************
221 : !> \brief sends the data from each replica to all the other
222 : !> on replica j/=i data from replica i overwrites val(:,i)
223 : !> \param rep_env replica environment
224 : !> \param vals the values to synchronize (second index runs over replicas)
225 : !> \author fawzi
226 : !> \note
227 : !> could be optimized: bcast in inter_rep, all2all or shift vs sum
228 : ! **************************************************************************************************
229 4868 : SUBROUTINE rep_env_sync(rep_env, vals)
230 : TYPE(replica_env_type), POINTER :: rep_env
231 : REAL(kind=dp), DIMENSION(:, :), INTENT(inout) :: vals
232 :
233 : CHARACTER(len=*), PARAMETER :: routineN = 'rep_env_sync'
234 :
235 : INTEGER :: handle, irep
236 :
237 4868 : CALL timeset(routineN, handle)
238 4868 : CPASSERT(ASSOCIATED(rep_env))
239 4868 : CPASSERT(rep_env%ref_count > 0)
240 4868 : CPASSERT(SIZE(vals, 2) == rep_env%nrep)
241 17768 : DO irep = 1, rep_env%nrep
242 17768 : IF (.NOT. rep_env%rep_is_local(irep)) THEN
243 1845678 : vals(:, irep) = 0._dp
244 : END IF
245 : END DO
246 7663288 : CALL rep_env%para_env_inter_rep%sum(vals)
247 4868 : CALL timestop(handle)
248 4868 : END SUBROUTINE rep_env_sync
249 :
250 : ! **************************************************************************************************
251 : !> \brief sends the data from each replica to all the other
252 : !> in this case the result type is passed
253 : !> \param rep_env replica environment
254 : !> \param results is an array of result_types
255 : !> \author fschiff
256 : ! **************************************************************************************************
257 4136 : SUBROUTINE rep_env_sync_results(rep_env, results)
258 : TYPE(replica_env_type), POINTER :: rep_env
259 : TYPE(cp_result_p_type), DIMENSION(:), POINTER :: results
260 :
261 : CHARACTER(len=*), PARAMETER :: routineN = 'rep_env_sync_results'
262 :
263 : INTEGER :: handle, irep, nrep, source
264 :
265 4136 : CALL timeset(routineN, handle)
266 4136 : nrep = rep_env%nrep
267 4136 : CPASSERT(ASSOCIATED(rep_env))
268 4136 : CPASSERT(rep_env%ref_count > 0)
269 4136 : CPASSERT(SIZE(results) == rep_env%nrep)
270 14954 : DO irep = 1, nrep
271 10818 : source = rep_env%inter_rep_rank(rep_env%replica_owner(irep))
272 14954 : CALL cp_results_mp_bcast(results(irep)%results, source, rep_env%para_env_inter_rep)
273 : END DO
274 4136 : CALL timestop(handle)
275 4136 : END SUBROUTINE rep_env_sync_results
276 :
277 : ! **************************************************************************************************
278 : !> \brief returns the replica environment with the given id_nr
279 : !> \param id_nr the id_nr of the requested rep_envs
280 : !> \param ierr ...
281 : !> \return ...
282 : !> \author fawzi
283 : ! **************************************************************************************************
284 4580 : FUNCTION rep_envs_get_rep_env(id_nr, ierr) RESULT(res)
285 : INTEGER, INTENT(in) :: id_nr
286 : INTEGER, INTENT(OUT) :: ierr
287 : TYPE(replica_env_type), POINTER :: res
288 :
289 : INTEGER :: i
290 :
291 4580 : NULLIFY (res)
292 4580 : ierr = -1
293 4580 : IF (module_initialized) THEN
294 4432 : IF (ASSOCIATED(rep_envs)) THEN
295 4432 : DO i = 1, SIZE(rep_envs)
296 4432 : IF (rep_envs(i)%rep_env%id_nr == id_nr) THEN
297 4432 : res => rep_envs(i)%rep_env
298 4432 : ierr = 0
299 4432 : EXIT
300 : END IF
301 : END DO
302 : END IF
303 : END IF
304 4580 : END FUNCTION rep_envs_get_rep_env
305 :
306 : ! **************************************************************************************************
307 : !> \brief adds the given rep_env to the list of controlled rep_envs.
308 : !> \param rep_env the rep_env to add
309 : !> \author fawzi
310 : ! **************************************************************************************************
311 148 : SUBROUTINE rep_envs_add_rep_env(rep_env)
312 : TYPE(replica_env_type), POINTER :: rep_env
313 :
314 : INTEGER :: i, stat
315 148 : TYPE(replica_env_p_type), DIMENSION(:), POINTER :: new_rep_envs
316 : TYPE(replica_env_type), POINTER :: rep_env2
317 :
318 148 : IF (ASSOCIATED(rep_env)) THEN
319 148 : rep_env2 => rep_envs_get_rep_env(rep_env%id_nr, ierr=stat)
320 148 : IF (.NOT. ASSOCIATED(rep_env2)) THEN
321 148 : IF (module_initialized) THEN
322 0 : IF (.NOT. ASSOCIATED(rep_envs)) THEN
323 0 : ALLOCATE (rep_envs(1))
324 : ELSE
325 0 : ALLOCATE (new_rep_envs(SIZE(rep_envs) + 1))
326 0 : DO i = 1, SIZE(rep_envs)
327 0 : new_rep_envs(i)%rep_env => rep_envs(i)%rep_env
328 : END DO
329 0 : DEALLOCATE (rep_envs)
330 0 : rep_envs => new_rep_envs
331 : END IF
332 : ELSE
333 296 : ALLOCATE (rep_envs(1))
334 : END IF
335 148 : rep_envs(SIZE(rep_envs))%rep_env => rep_env
336 148 : module_initialized = .TRUE.
337 : END IF
338 : END IF
339 148 : END SUBROUTINE rep_envs_add_rep_env
340 :
341 : ! **************************************************************************************************
342 : !> \brief removes the given rep_env to the list of controlled rep_envs.
343 : !> \param rep_env the rep_env to remove
344 : !> \author fawzi
345 : ! **************************************************************************************************
346 148 : SUBROUTINE rep_envs_rm_rep_env(rep_env)
347 : TYPE(replica_env_type), POINTER :: rep_env
348 :
349 : INTEGER :: i, ii
350 148 : TYPE(replica_env_p_type), DIMENSION(:), POINTER :: new_rep_envs
351 :
352 148 : IF (ASSOCIATED(rep_env)) THEN
353 148 : CPASSERT(module_initialized)
354 296 : ALLOCATE (new_rep_envs(SIZE(rep_envs) - 1))
355 : ii = 0
356 296 : DO i = 1, SIZE(rep_envs)
357 296 : IF (rep_envs(i)%rep_env%id_nr /= rep_env%id_nr) THEN
358 0 : ii = ii + 1
359 0 : new_rep_envs(ii)%rep_env => rep_envs(i)%rep_env
360 : END IF
361 : END DO
362 148 : CPASSERT(ii == SIZE(new_rep_envs))
363 148 : DEALLOCATE (rep_envs)
364 148 : rep_envs => new_rep_envs
365 148 : IF (SIZE(rep_envs) == 0) THEN
366 148 : DEALLOCATE (rep_envs)
367 : END IF
368 : END IF
369 148 : END SUBROUTINE rep_envs_rm_rep_env
370 :
371 0 : END MODULE replica_types
|
