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 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, id_nr, f_env_id, &
98 : nrep, ndim, nparticle, &
99 : my_rep_group, force_dim
100 : REAL(kind=dp), DIMENSION(:, :), POINTER :: r, v, f
101 : LOGICAL :: sync_v, keep_wf_history
102 : CHARACTER(LEN=default_path_length) :: original_project_name
103 : TYPE(qs_wf_history_p_type), DIMENSION(:), POINTER :: wf_history
104 : TYPE(cp_result_p_type), DIMENSION(:), POINTER :: results
105 : INTEGER, DIMENSION(:), POINTER :: local_rep_indices
106 : INTEGER, DIMENSION(:), POINTER :: replica_owner, force_rank, &
107 : inter_rep_rank
108 : LOGICAL, DIMENSION(:), POINTER :: rep_is_local
109 : TYPE(mp_para_cart_type), POINTER :: cart
110 : TYPE(mp_para_env_type), POINTER :: para_env, para_env_f, &
111 : para_env_inter_rep
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
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 144 : 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 144 : CALL timeset(routineN, handle)
145 144 : IF (ASSOCIATED(rep_env)) THEN
146 144 : CPASSERT(rep_env%ref_count > 0)
147 144 : rep_env%ref_count = rep_env%ref_count - 1
148 144 : IF (rep_env%ref_count == 0) THEN
149 144 : CALL rep_env_destroy_low(rep_env%id_nr, ierr)
150 144 : IF (rep_env%f_env_id > 0) THEN
151 144 : CALL destroy_force_env(rep_env%f_env_id, ierr)
152 144 : CPASSERT(ierr == 0)
153 : END IF
154 144 : IF (ASSOCIATED(rep_env%r)) THEN
155 144 : DEALLOCATE (rep_env%r)
156 : END IF
157 144 : IF (ASSOCIATED(rep_env%v)) THEN
158 144 : DEALLOCATE (rep_env%v)
159 : END IF
160 144 : IF (ASSOCIATED(rep_env%f)) THEN
161 144 : DEALLOCATE (rep_env%f)
162 : END IF
163 144 : 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 144 : IF (ASSOCIATED(rep_env%results)) THEN
170 634 : DO i = 1, SIZE(rep_env%results)
171 634 : CALL cp_result_release(rep_env%results(i)%results)
172 : END DO
173 144 : DEALLOCATE (rep_env%results)
174 : END IF
175 144 : DEALLOCATE (rep_env%local_rep_indices)
176 144 : DEALLOCATE (rep_env%rep_is_local)
177 144 : IF (ASSOCIATED(rep_env%replica_owner)) THEN
178 144 : DEALLOCATE (rep_env%replica_owner)
179 : END IF
180 144 : DEALLOCATE (rep_env%inter_rep_rank, rep_env%force_rank)
181 144 : CALL mp_para_cart_release(rep_env%cart)
182 144 : CALL mp_para_env_release(rep_env%para_env)
183 144 : CALL mp_para_env_release(rep_env%para_env_f)
184 144 : CALL mp_para_env_release(rep_env%para_env_inter_rep)
185 144 : CALL rep_envs_rm_rep_env(rep_env)
186 144 : DEALLOCATE (rep_env)
187 : END IF
188 : END IF
189 144 : NULLIFY (rep_env)
190 144 : CALL timestop(handle)
191 144 : 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 144 : 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 144 : rep_env => rep_envs_get_rep_env(rep_env_id, ierr=stat)
209 144 : IF (.NOT. ASSOCIATED(rep_env)) &
210 0 : CPABORT("could not find rep_env with id_nr"//cp_to_string(rep_env_id))
211 144 : CALL f_env_add_defaults(f_env_id=rep_env%f_env_id, f_env=f_env)
212 144 : logger => cp_get_default_logger()
213 : CALL cp_rm_iter_level(iteration_info=logger%iter_info, &
214 144 : level_name="REPLICA_EVAL")
215 144 : CALL f_env_rm_defaults(f_env, ierr)
216 144 : CPASSERT(ierr == 0)
217 144 : END SUBROUTINE rep_env_destroy_low
218 :
219 : ! **************************************************************************************************
220 : !> \brief sends the data from each replica to all the other
221 : !> on replica j/=i data from replica i overwrites val(:,i)
222 : !> \param rep_env replica environment
223 : !> \param vals the values to synchronize (second index runs over replicas)
224 : !> \author fawzi
225 : !> \note
226 : !> could be optimized: bcast in inter_rep, all2all or shift vs sum
227 : ! **************************************************************************************************
228 4620 : SUBROUTINE rep_env_sync(rep_env, vals)
229 : TYPE(replica_env_type), POINTER :: rep_env
230 : REAL(kind=dp), DIMENSION(:, :), INTENT(inout) :: vals
231 :
232 : CHARACTER(len=*), PARAMETER :: routineN = 'rep_env_sync'
233 :
234 : INTEGER :: handle, irep
235 :
236 4620 : CALL timeset(routineN, handle)
237 4620 : CPASSERT(ASSOCIATED(rep_env))
238 4620 : CPASSERT(rep_env%ref_count > 0)
239 4620 : CPASSERT(SIZE(vals, 2) == rep_env%nrep)
240 16608 : DO irep = 1, rep_env%nrep
241 16608 : IF (.NOT. rep_env%rep_is_local(irep)) THEN
242 1840434 : vals(:, irep) = 0._dp
243 : END IF
244 : END DO
245 7642064 : CALL rep_env%para_env_inter_rep%sum(vals)
246 4620 : CALL timestop(handle)
247 4620 : END SUBROUTINE rep_env_sync
248 :
249 : ! **************************************************************************************************
250 : !> \brief sends the data from each replica to all the other
251 : !> in this case the result type is passed
252 : !> \param rep_env replica environment
253 : !> \param results is an array of result_types
254 : !> \author fschiff
255 : ! **************************************************************************************************
256 3900 : SUBROUTINE rep_env_sync_results(rep_env, results)
257 : TYPE(replica_env_type), POINTER :: rep_env
258 : TYPE(cp_result_p_type), DIMENSION(:), POINTER :: results
259 :
260 : CHARACTER(len=*), PARAMETER :: routineN = 'rep_env_sync_results'
261 :
262 : INTEGER :: handle, irep, nrep, source
263 :
264 3900 : CALL timeset(routineN, handle)
265 3900 : nrep = rep_env%nrep
266 3900 : CPASSERT(ASSOCIATED(rep_env))
267 3900 : CPASSERT(rep_env%ref_count > 0)
268 3900 : CPASSERT(SIZE(results) == rep_env%nrep)
269 13842 : DO irep = 1, nrep
270 9942 : source = rep_env%inter_rep_rank(rep_env%replica_owner(irep))
271 13842 : CALL cp_results_mp_bcast(results(irep)%results, source, rep_env%para_env_inter_rep)
272 : END DO
273 3900 : CALL timestop(handle)
274 3900 : END SUBROUTINE rep_env_sync_results
275 :
276 : ! **************************************************************************************************
277 : !> \brief returns the replica environment with the given id_nr
278 : !> \param id_nr the id_nr of the requested rep_envs
279 : !> \param ierr ...
280 : !> \return ...
281 : !> \author fawzi
282 : ! **************************************************************************************************
283 4332 : FUNCTION rep_envs_get_rep_env(id_nr, ierr) RESULT(res)
284 : INTEGER, INTENT(in) :: id_nr
285 : INTEGER, INTENT(OUT) :: ierr
286 : TYPE(replica_env_type), POINTER :: res
287 :
288 : INTEGER :: i
289 :
290 4332 : NULLIFY (res)
291 4332 : ierr = -1
292 4332 : IF (module_initialized) THEN
293 4188 : IF (ASSOCIATED(rep_envs)) THEN
294 4188 : DO i = 1, SIZE(rep_envs)
295 4188 : IF (rep_envs(i)%rep_env%id_nr == id_nr) THEN
296 4188 : res => rep_envs(i)%rep_env
297 4188 : ierr = 0
298 4188 : EXIT
299 : END IF
300 : END DO
301 : END IF
302 : END IF
303 4332 : END FUNCTION rep_envs_get_rep_env
304 :
305 : ! **************************************************************************************************
306 : !> \brief adds the given rep_env to the list of controlled rep_envs.
307 : !> \param rep_env the rep_env to add
308 : !> \author fawzi
309 : ! **************************************************************************************************
310 144 : SUBROUTINE rep_envs_add_rep_env(rep_env)
311 : TYPE(replica_env_type), POINTER :: rep_env
312 :
313 : INTEGER :: i, stat
314 144 : TYPE(replica_env_p_type), DIMENSION(:), POINTER :: new_rep_envs
315 : TYPE(replica_env_type), POINTER :: rep_env2
316 :
317 144 : IF (ASSOCIATED(rep_env)) THEN
318 144 : rep_env2 => rep_envs_get_rep_env(rep_env%id_nr, ierr=stat)
319 144 : IF (.NOT. ASSOCIATED(rep_env2)) THEN
320 144 : IF (module_initialized) THEN
321 0 : IF (.NOT. ASSOCIATED(rep_envs)) THEN
322 0 : ALLOCATE (rep_envs(1))
323 : ELSE
324 0 : ALLOCATE (new_rep_envs(SIZE(rep_envs) + 1))
325 0 : DO i = 1, SIZE(rep_envs)
326 0 : new_rep_envs(i)%rep_env => rep_envs(i)%rep_env
327 : END DO
328 0 : DEALLOCATE (rep_envs)
329 0 : rep_envs => new_rep_envs
330 : END IF
331 : ELSE
332 144 : ALLOCATE (rep_envs(1))
333 : END IF
334 144 : rep_envs(SIZE(rep_envs))%rep_env => rep_env
335 144 : module_initialized = .TRUE.
336 : END IF
337 : END IF
338 144 : END SUBROUTINE rep_envs_add_rep_env
339 :
340 : ! **************************************************************************************************
341 : !> \brief removes the given rep_env to the list of controlled rep_envs.
342 : !> \param rep_env the rep_env to remove
343 : !> \author fawzi
344 : ! **************************************************************************************************
345 144 : SUBROUTINE rep_envs_rm_rep_env(rep_env)
346 : TYPE(replica_env_type), POINTER :: rep_env
347 :
348 : INTEGER :: i, ii
349 144 : TYPE(replica_env_p_type), DIMENSION(:), POINTER :: new_rep_envs
350 :
351 144 : IF (ASSOCIATED(rep_env)) THEN
352 144 : CPASSERT(module_initialized)
353 288 : ALLOCATE (new_rep_envs(SIZE(rep_envs) - 1))
354 144 : ii = 0
355 288 : DO i = 1, SIZE(rep_envs)
356 288 : IF (rep_envs(i)%rep_env%id_nr /= rep_env%id_nr) THEN
357 0 : ii = ii + 1
358 0 : new_rep_envs(ii)%rep_env => rep_envs(i)%rep_env
359 : END IF
360 : END DO
361 144 : CPASSERT(ii == SIZE(new_rep_envs))
362 144 : DEALLOCATE (rep_envs)
363 144 : rep_envs => new_rep_envs
364 144 : IF (SIZE(rep_envs) == 0) THEN
365 144 : DEALLOCATE (rep_envs)
366 : END IF
367 : END IF
368 144 : END SUBROUTINE rep_envs_rm_rep_env
369 :
370 0 : END MODULE replica_types
|
