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 module contains the worker routine handling the communication and
10 : !> the calculation / creation of the configurations
11 : !> - WORKER these are all TMC cores, instead of master core
12 : !> and maybe some idle cores
13 : !> - divided in groups, in every group exists group master
14 : !> - there can be two kind of groups, one for exact energy calculation
15 : !> and one calculating configurational change using an approximate
16 : !> potential
17 : !> - Algorithm:
18 : !> - group master receive messages and decide what to do,
19 : !> - (if nessesary) broadcast of working task
20 : !> to all other group members (needed for parallel CP2K)
21 : !> - process task, calculations of energy or configurational change
22 : !> - result, exist on group master, sent to master core
23 : !> Communication structure (master->worker, worker->master):
24 : !> - message structure is defined in TMC message module
25 : !> \par History
26 : !> 11.2012 created [Mandes Schoenherr]
27 : !> \author Mandes
28 : ! **************************************************************************************************
29 :
30 : MODULE tmc_worker
31 : USE cell_methods, ONLY: init_cell
32 : USE cell_types, ONLY: cell_copy,&
33 : cell_type
34 : USE cp_external_control, ONLY: set_external_comm
35 : USE cp_log_handling, ONLY: cp_to_string
36 : USE cp_result_methods, ONLY: cp_results_erase,&
37 : put_results
38 : USE cp_result_types, ONLY: cp_result_type
39 : USE cp_subsys_types, ONLY: cp_subsys_get,&
40 : cp_subsys_type
41 : USE f77_interface, ONLY: f_env_get_from_id,&
42 : f_env_type,&
43 : get_natom,&
44 : get_pos,&
45 : get_result_r1
46 : USE force_env_types, ONLY: force_env_get,&
47 : force_env_get_natom
48 : USE kinds, ONLY: default_string_length,&
49 : dp
50 : USE message_passing, ONLY: mp_comm_type,&
51 : mp_para_env_type
52 : USE molecule_list_types, ONLY: molecule_list_type
53 : USE particle_list_types, ONLY: particle_list_type
54 : USE tmc_analysis, ONLY: analysis_init,&
55 : analysis_restart_print,&
56 : analysis_restart_read,&
57 : analyze_file_configurations,&
58 : do_tmc_analysis,&
59 : finalize_tmc_analysis
60 : USE tmc_analysis_types, ONLY: tmc_ana_list_type
61 : USE tmc_calculations, ONLY: calc_potential_energy
62 : USE tmc_messages, ONLY: bcast_group,&
63 : check_if_group_master,&
64 : communicate_atom_types,&
65 : master_comm_id,&
66 : recv_msg,&
67 : send_msg,&
68 : stop_whole_group,&
69 : tmc_message
70 : USE tmc_move_handle, ONLY: clear_move_probs,&
71 : prob_update,&
72 : select_random_move_type
73 : USE tmc_move_types, ONLY: mv_type_MD,&
74 : mv_type_NMC_moves
75 : USE tmc_moves, ONLY: change_pos
76 : USE tmc_stati, ONLY: &
77 : TMC_CANCELING_MESSAGE, TMC_CANCELING_RECEIPT, TMC_STATUS_CALCULATING, TMC_STATUS_FAILED, &
78 : TMC_STATUS_STOP_RECEIPT, TMC_STATUS_WAIT_FOR_NEW_TASK, TMC_STATUS_WORKER_INIT, &
79 : TMC_STAT_ANALYSIS_REQUEST, TMC_STAT_ANALYSIS_RESULT, TMC_STAT_APPROX_ENERGY_REQUEST, &
80 : TMC_STAT_APPROX_ENERGY_RESULT, TMC_STAT_ENERGY_REQUEST, TMC_STAT_ENERGY_RESULT, &
81 : TMC_STAT_INIT_ANALYSIS, TMC_STAT_MD_REQUEST, TMC_STAT_MD_RESULT, TMC_STAT_NMC_REQUEST, &
82 : TMC_STAT_NMC_RESULT, TMC_STAT_SCF_STEP_ENER_RECEIVE, TMC_STAT_START_CONF_REQUEST, &
83 : TMC_STAT_START_CONF_RESULT, task_type_MC, task_type_ideal_gas
84 : USE tmc_tree_acceptance, ONLY: acceptance_check
85 : USE tmc_tree_build, ONLY: allocate_new_sub_tree_node,&
86 : deallocate_sub_tree_node
87 : USE tmc_tree_types, ONLY: tree_type
88 : USE tmc_types, ONLY: allocate_tmc_atom_type,&
89 : tmc_atom_type,&
90 : tmc_env_type,&
91 : tmc_param_type
92 : #include "../base/base_uses.f90"
93 :
94 : IMPLICIT NONE
95 :
96 : PRIVATE
97 :
98 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'tmc_worker'
99 :
100 : PUBLIC :: do_tmc_worker
101 : PUBLIC :: get_initial_conf, get_atom_kinds_and_cell
102 :
103 : INTEGER, PARAMETER :: DEBUG = 0
104 :
105 : CONTAINS
106 :
107 : ! **************************************************************************************************
108 : !> \brief worker get tasks form master and fulfill them
109 : !> \param tmc_env structure for storing all the tmc parameters
110 : !> \param ana_list ...
111 : !> \author Mandes 11.2012
112 : ! **************************************************************************************************
113 28 : SUBROUTINE do_tmc_worker(tmc_env, ana_list)
114 : TYPE(tmc_env_type), POINTER :: tmc_env
115 : TYPE(tmc_ana_list_type), DIMENSION(:), OPTIONAL, &
116 : POINTER :: ana_list
117 :
118 : CHARACTER(LEN=*), PARAMETER :: routineN = 'do_tmc_worker'
119 :
120 : CHARACTER(LEN=default_string_length) :: c_tmp
121 : INTEGER :: calc_stat, handle, i1, i2, ierr, itmp, &
122 : num_dim, work_stat
123 14 : INTEGER, DIMENSION(:), POINTER :: ana_restart_conf
124 : LOGICAL :: flag, master
125 : TYPE(mp_para_env_type), POINTER :: para_env_m_w
126 : TYPE(tree_type), POINTER :: conf
127 :
128 14 : master = .FALSE.
129 14 : i1 = -1
130 14 : i2 = -1
131 14 : NULLIFY (conf, para_env_m_w, ana_restart_conf)
132 :
133 0 : CPASSERT(ASSOCIATED(tmc_env))
134 :
135 : ! start the timing
136 14 : CALL timeset(routineN, handle)
137 :
138 : ! initialize
139 14 : IF (tmc_env%tmc_comp_set%group_nr > 0) THEN
140 14 : CPASSERT(ASSOCIATED(tmc_env%tmc_comp_set%para_env_sub_group))
141 14 : IF (tmc_env%w_env%env_id_ener > 0) THEN
142 14 : itmp = tmc_env%w_env%env_id_ener
143 : ELSE
144 0 : itmp = tmc_env%w_env%env_id_approx
145 : END IF
146 :
147 : CALL get_atom_kinds_and_cell(env_id=itmp, &
148 14 : atoms=tmc_env%params%atoms, cell=tmc_env%params%cell)
149 14 : para_env_m_w => tmc_env%tmc_comp_set%para_env_m_w
150 14 : master = check_if_group_master(tmc_env%tmc_comp_set%para_env_sub_group)
151 : ELSE
152 : ! analysis group
153 0 : CPASSERT(ASSOCIATED(tmc_env%tmc_comp_set%para_env_m_ana))
154 0 : para_env_m_w => tmc_env%tmc_comp_set%para_env_m_ana
155 : master = .TRUE.
156 : END IF
157 :
158 : !-- GROUP MASTER only --------------
159 : ! get messages from master and handle them
160 14 : IF (master) THEN
161 : ! NOT the analysis group
162 14 : IF (tmc_env%tmc_comp_set%group_nr > 0) THEN
163 14 : IF (tmc_env%w_env%env_id_ener > 0) THEN
164 14 : itmp = tmc_env%w_env%env_id_ener
165 : ELSE
166 0 : itmp = tmc_env%w_env%env_id_approx
167 : END IF
168 : ! set the communicator in the external control for receiving exit tags
169 : ! and sending additional information (e.g. the intermediate scf energies)
170 14 : IF (tmc_env%params%use_scf_energy_info) THEN
171 : CALL set_intermediate_info_comm(env_id=itmp, &
172 0 : comm=tmc_env%tmc_comp_set%para_env_m_w)
173 : END IF
174 14 : IF (tmc_env%params%SPECULATIVE_CANCELING) THEN
175 : CALL set_external_comm(comm=tmc_env%tmc_comp_set%para_env_m_w, &
176 : in_external_master_id=MASTER_COMM_ID, &
177 14 : in_exit_tag=TMC_CANCELING_MESSAGE)
178 : END IF
179 : END IF
180 : !-- WORKING LOOP --!
181 : master_work_time: DO
182 1304177 : work_stat = TMC_STATUS_WAIT_FOR_NEW_TASK
183 : ! -- receive message from master
184 : ! check for new task (wait for it)
185 1304177 : itmp = MASTER_COMM_ID
186 : CALL tmc_message(msg_type=work_stat, send_recv=recv_msg, &
187 : dest=itmp, &
188 : para_env=para_env_m_w, &
189 : result_count=ana_restart_conf, &
190 1304177 : tmc_params=tmc_env%params, elem=conf)
191 :
192 : IF (DEBUG >= 1 .AND. work_stat /= TMC_STATUS_WAIT_FOR_NEW_TASK) THEN
193 : WRITE (tmc_env%w_env%io_unit, *) "worker: group master of group ", &
194 : tmc_env%tmc_comp_set%group_nr, "got task ", work_stat
195 : END IF
196 1304177 : calc_stat = TMC_STATUS_CALCULATING
197 14 : SELECT CASE (work_stat)
198 : CASE (TMC_STATUS_WAIT_FOR_NEW_TASK)
199 : CASE (TMC_STATUS_WORKER_INIT)
200 14 : CALL init_cell(cell=tmc_env%params%cell)
201 14 : itmp = bcast_group
202 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, &
203 : dest=itmp, &
204 : para_env=tmc_env%tmc_comp_set%para_env_sub_group, &
205 14 : tmc_params=tmc_env%params)
206 : CASE (TMC_CANCELING_MESSAGE)
207 1 : work_stat = TMC_CANCELING_RECEIPT
208 1 : itmp = MASTER_COMM_ID
209 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, &
210 : dest=itmp, &
211 : para_env=para_env_m_w, &
212 1 : tmc_params=tmc_env%params)
213 : CASE (TMC_STATUS_FAILED)
214 : IF (DEBUG >= 1) THEN
215 : WRITE (tmc_env%w_env%io_unit, *) "master worker of group", &
216 : tmc_env%tmc_comp_set%group_nr, " exit work time."
217 : END IF
218 14 : EXIT master_work_time
219 : !-- group master read the CP2K input file, and write data to master
220 : CASE (TMC_STAT_START_CONF_REQUEST)
221 14 : IF (tmc_env%w_env%env_id_ener > 0) THEN
222 14 : itmp = tmc_env%w_env%env_id_ener
223 : ELSE
224 0 : itmp = tmc_env%w_env%env_id_approx
225 : END IF
226 : CALL get_initial_conf(tmc_params=tmc_env%params, init_conf=conf, &
227 14 : env_id=itmp)
228 : ! send start configuration back to master
229 14 : work_stat = TMC_STAT_START_CONF_RESULT
230 14 : itmp = MASTER_COMM_ID
231 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, &
232 : dest=itmp, &
233 : para_env=para_env_m_w, &
234 : tmc_params=tmc_env%params, elem=conf, &
235 14 : wait_for_message=.TRUE.)
236 :
237 14 : IF (ASSOCIATED(tmc_env%tmc_comp_set%para_env_m_first_w)) THEN
238 : CALL communicate_atom_types(atoms=tmc_env%params%atoms, &
239 : source=1, &
240 14 : para_env=tmc_env%tmc_comp_set%para_env_m_first_w)
241 : END IF
242 : !-- calculate the approximate energy
243 : CASE (TMC_STAT_APPROX_ENERGY_REQUEST)
244 14 : CPASSERT(tmc_env%w_env%env_id_approx > 0)
245 14 : itmp = bcast_group
246 : !-- DISTRIBUTING WORK (group master) to all other group members
247 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, &
248 : dest=itmp, &
249 : para_env=tmc_env%tmc_comp_set%para_env_sub_group, &
250 14 : tmc_params=tmc_env%params, elem=conf)
251 : CALL calc_potential_energy(conf=conf, &
252 : env_id=tmc_env%w_env%env_id_approx, &
253 : exact_approx_pot=.FALSE., &
254 14 : tmc_env=tmc_env)
255 14 : work_stat = TMC_STAT_APPROX_ENERGY_RESULT
256 14 : itmp = MASTER_COMM_ID
257 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, &
258 : dest=itmp, &
259 : para_env=para_env_m_w, &
260 14 : tmc_params=tmc_env%params, elem=conf)
261 : ! -- Nested Monte Carlo routines
262 : CASE (TMC_STAT_MD_REQUEST, TMC_STAT_NMC_REQUEST)
263 57 : CALL clear_move_probs(tmc_env%params%nmc_move_types)
264 57 : itmp = bcast_group
265 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, &
266 : dest=itmp, &
267 : para_env=tmc_env%tmc_comp_set%para_env_sub_group, &
268 57 : tmc_params=tmc_env%params, elem=conf)
269 : !-- collective calculation for MD/NMC steps
270 57 : IF (work_stat == TMC_STAT_NMC_REQUEST) THEN
271 : !-- calculate MD steps, in case of 2 different potentials do nested Monte Carlo
272 : CALL nested_markov_chain_MC(conf=conf, &
273 : env_id=tmc_env%w_env%env_id_approx, &
274 57 : tmc_env=tmc_env, calc_status=calc_stat)
275 0 : ELSE IF (work_stat == TMC_STAT_MD_REQUEST) THEN
276 : !TODO Hybrid MC routine
277 0 : CPABORT("there is no Hybrid MC implemented yet.")
278 :
279 : ELSE
280 0 : CPABORT("unknown task type for workers.")
281 : END IF
282 : !-- in case of cancelation send receipt
283 57 : itmp = MASTER_COMM_ID
284 : CALL tmc_message(msg_type=calc_stat, send_recv=recv_msg, &
285 : dest=itmp, &
286 : para_env=para_env_m_w, &
287 : tmc_params=tmc_env%params, &
288 57 : success=flag)
289 57 : SELECT CASE (calc_stat)
290 : CASE (TMC_STATUS_CALCULATING)
291 0 : SELECT CASE (work_stat)
292 : CASE (TMC_STAT_MD_REQUEST)
293 0 : work_stat = TMC_STAT_MD_RESULT
294 : CASE (TMC_STAT_NMC_REQUEST)
295 57 : work_stat = TMC_STAT_NMC_RESULT
296 : CASE DEFAULT
297 : CALL cp_abort(__LOCATION__, &
298 : "unknown work status after possible NMC subgroup "// &
299 57 : "cancelation, work_stat="//cp_to_string(work_stat))
300 : END SELECT
301 : CASE (TMC_CANCELING_MESSAGE)
302 0 : work_stat = TMC_CANCELING_RECEIPT
303 : CASE DEFAULT
304 : CALL cp_abort(__LOCATION__, &
305 : "unknown calc status before sending NMC result "// &
306 57 : cp_to_string(calc_stat))
307 : END SELECT
308 : ! send message back to master
309 57 : itmp = MASTER_COMM_ID
310 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, &
311 : dest=itmp, &
312 : para_env=para_env_m_w, &
313 57 : tmc_params=tmc_env%params, elem=conf)
314 : CASE (TMC_STAT_ENERGY_REQUEST)
315 4324 : CPASSERT(tmc_env%w_env%env_id_ener > 0)
316 : !-- DISTRIBUTING WORK (group master) to all other group members
317 4324 : itmp = bcast_group
318 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, &
319 : dest=itmp, &
320 : para_env=tmc_env%tmc_comp_set%para_env_sub_group, &
321 4324 : tmc_params=tmc_env%params, elem=conf)
322 :
323 : CALL calc_potential_energy(conf=conf, &
324 : env_id=tmc_env%w_env%env_id_ener, &
325 : exact_approx_pot=.TRUE., &
326 4324 : tmc_env=tmc_env)
327 : !-- in case of cancelation send receipt
328 4324 : flag = .FALSE.
329 4324 : itmp = MASTER_COMM_ID
330 : CALL tmc_message(msg_type=calc_stat, send_recv=recv_msg, &
331 : dest=itmp, &
332 : para_env=para_env_m_w, &
333 4324 : tmc_params=tmc_env%params, success=flag)
334 4324 : SELECT CASE (calc_stat)
335 : CASE (TMC_STATUS_CALCULATING)
336 4324 : SELECT CASE (work_stat)
337 : CASE (TMC_STAT_ENERGY_REQUEST)
338 4324 : work_stat = TMC_STAT_ENERGY_RESULT
339 : !-- if nessesary get the exact dipoles (for e.g. quantum potential)
340 4324 : IF (tmc_env%params%print_dipole) THEN
341 0 : c_tmp = "[DIPOLE]"
342 : CALL get_result_r1(env_id=tmc_env%w_env%env_id_ener, &
343 : description=c_tmp, N=3, RESULT=conf%dipole, &
344 0 : res_exist=flag, ierr=ierr)
345 0 : IF (.NOT. flag) tmc_env%params%print_dipole = .FALSE.
346 : ! TODO maybe let run with the changed option, but inform user properly
347 0 : IF (.NOT. flag) THEN
348 : CALL cp_abort(__LOCATION__, &
349 : "TMC: The requested dipoles are not porvided by the "// &
350 0 : "force environment.")
351 : END IF
352 : END IF
353 : CASE DEFAULT
354 : CALL cp_abort(__LOCATION__, &
355 : "energy worker should handle unknown stat "// &
356 4324 : cp_to_string(work_stat))
357 : END SELECT
358 : CASE (TMC_CANCELING_MESSAGE)
359 0 : work_stat = TMC_CANCELING_RECEIPT
360 : CASE DEFAULT
361 : CALL cp_abort(__LOCATION__, &
362 : "worker while energy calc is in unknown state "// &
363 4324 : cp_to_string(work_stat))
364 : END SELECT
365 :
366 : !-- send information back to master
367 : IF (DEBUG >= 1) THEN
368 : WRITE (tmc_env%w_env%io_unit, *) "worker group ", &
369 : tmc_env%tmc_comp_set%group_nr, &
370 : "calculations done, send result energy", conf%potential
371 : END IF
372 4324 : itmp = MASTER_COMM_ID
373 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, &
374 : dest=itmp, &
375 : para_env=para_env_m_w, &
376 4324 : tmc_params=tmc_env%params, elem=conf)
377 : CASE (TMC_STAT_INIT_ANALYSIS)
378 0 : CPASSERT(ASSOCIATED(ana_restart_conf))
379 0 : CPASSERT(SIZE(ana_restart_conf) == tmc_env%params%nr_temp)
380 0 : CPASSERT(PRESENT(ana_list))
381 0 : CPASSERT(ASSOCIATED(ana_list))
382 0 : itmp = MASTER_COMM_ID
383 : CALL communicate_atom_types(atoms=tmc_env%params%atoms, &
384 0 : source=itmp, para_env=tmc_env%tmc_comp_set%para_env_m_ana)
385 :
386 0 : num_dim = SIZE(conf%pos)
387 0 : DO itmp = 1, tmc_env%params%nr_temp
388 : ! do not forget to nullify the pointer at the end, deallcoated at tmc_env%params
389 0 : ana_list(itmp)%temp%temperature = tmc_env%params%Temp(itmp)
390 0 : ana_list(itmp)%temp%atoms => tmc_env%params%atoms
391 0 : ana_list(itmp)%temp%cell => tmc_env%params%cell
392 : ! ana_list(itmp)%temp%io_unit = tmc_env%w_env%io_unit
393 :
394 0 : CALL analysis_init(ana_env=ana_list(itmp)%temp, nr_dim=num_dim)
395 0 : ana_list(itmp)%temp%print_test_output = tmc_env%params%print_test_output
396 0 : IF (.NOT. ASSOCIATED(conf)) THEN
397 : CALL allocate_new_sub_tree_node(tmc_params=tmc_env%params, &
398 0 : next_el=conf, nr_dim=num_dim)
399 : END IF
400 : CALL analysis_restart_read(ana_env=ana_list(itmp)%temp, &
401 0 : elem=conf)
402 : !check if we have the read the file
403 0 : flag = .FALSE.
404 0 : IF ((.NOT. ASSOCIATED(ana_list(itmp)%temp%last_elem)) .AND. &
405 : ana_restart_conf(itmp) > 0) THEN
406 0 : flag = .TRUE.
407 0 : i1 = 0
408 0 : i2 = ana_restart_conf(itmp)
409 : CALL cp_warn(__LOCATION__, &
410 : "analysis old trajectory up to "// &
411 : "elem "//cp_to_string(ana_restart_conf(itmp))// &
412 0 : ". Read trajectory file.")
413 0 : ELSE IF (ASSOCIATED(ana_list(itmp)%temp%last_elem)) THEN
414 0 : IF (.NOT. (ana_list(itmp)%temp%last_elem%nr == ana_restart_conf(itmp))) THEN
415 0 : flag = .TRUE.
416 0 : i1 = ana_list(itmp)%temp%last_elem%nr
417 0 : i2 = ana_restart_conf(itmp)
418 : CALL cp_warn(__LOCATION__, &
419 : "analysis restart with the incorrect configuration "// &
420 : "TMC "//cp_to_string(ana_restart_conf(itmp))// &
421 : " ana "//cp_to_string(ana_list(itmp)%temp%last_elem%nr)// &
422 0 : ". REread trajectory file.")
423 : END IF
424 : END IF
425 0 : IF (flag) THEN
426 : CALL analyze_file_configurations(start_id=i1, &
427 : end_id=i2, &
428 : ana_env=ana_list(itmp)%temp, &
429 0 : tmc_params=tmc_env%params)
430 : END IF
431 : END DO
432 : CASE (TMC_STAT_ANALYSIS_REQUEST)
433 0 : CPASSERT(PRESENT(ana_list))
434 0 : CPASSERT(ASSOCIATED(ana_list(conf%sub_tree_nr)%temp))
435 : CALL do_tmc_analysis(elem=conf, &
436 0 : ana_env=ana_list(conf%sub_tree_nr)%temp)
437 0 : work_stat = TMC_STAT_ANALYSIS_RESULT
438 0 : itmp = MASTER_COMM_ID
439 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, &
440 : dest=itmp, &
441 : para_env=para_env_m_w, &
442 0 : tmc_params=tmc_env%params, elem=conf)
443 : CASE DEFAULT
444 : CALL cp_abort(__LOCATION__, &
445 : "worker received unknown message task type "// &
446 1304177 : cp_to_string(work_stat))
447 : END SELECT
448 :
449 : IF (DEBUG >= 1 .AND. work_stat /= TMC_STATUS_WAIT_FOR_NEW_TASK) THEN
450 : WRITE (tmc_env%w_env%io_unit, *) "worker: group ", &
451 : tmc_env%tmc_comp_set%group_nr, &
452 : "send back status:", work_stat
453 : END IF
454 1304163 : IF (ASSOCIATED(conf)) THEN
455 4409 : CALL deallocate_sub_tree_node(tree_elem=conf)
456 : END IF
457 : END DO master_work_time
458 : !-- every other group paricipants----------------------------------------
459 : ELSE
460 : worker_work_time: DO
461 0 : work_stat = TMC_STATUS_WAIT_FOR_NEW_TASK
462 : flag = .FALSE.
463 0 : itmp = bcast_group
464 : CALL tmc_message(msg_type=work_stat, send_recv=recv_msg, &
465 : dest=itmp, &
466 : para_env=tmc_env%tmc_comp_set%para_env_sub_group, &
467 0 : tmc_params=tmc_env%params, elem=conf)
468 : calc_stat = TMC_STATUS_CALCULATING
469 0 : SELECT CASE (work_stat)
470 : CASE (TMC_STATUS_WORKER_INIT)
471 0 : CALL init_cell(cell=tmc_env%params%cell)
472 : CASE (TMC_CANCELING_MESSAGE)
473 : ! error message
474 : CASE (TMC_STATUS_FAILED)
475 0 : EXIT worker_work_time
476 : ! all group members have to calculate the (MD potential) energy together
477 : CASE (TMC_STAT_START_CONF_RESULT)
478 0 : CPASSERT(tmc_env%w_env%env_id_approx > 0)
479 : !-- collective calculation of the potential energy of MD potential
480 0 : SELECT CASE (tmc_env%params%task_type)
481 : CASE (task_type_MC, task_type_ideal_gas)
482 0 : IF (tmc_env%params%NMC_inp_file /= "") THEN
483 0 : conf%box_scale(:) = 1.0_dp
484 : CALL calc_potential_energy(conf=conf, &
485 : env_id=tmc_env%w_env%env_id_approx, &
486 : exact_approx_pot=.FALSE., &
487 0 : tmc_env=tmc_env)
488 : END IF
489 : CASE DEFAULT
490 : CALL cp_abort(__LOCATION__, &
491 : "unknown task_type for participants in "// &
492 0 : "START_CONF_RESULT request ")
493 : END SELECT
494 : !-- HMC - calculating MD steps
495 : CASE (TMC_STAT_NMC_REQUEST, TMC_STAT_MD_REQUEST)
496 : !-- collective calculation for MD/NMC steps
497 0 : IF (work_stat == TMC_STAT_NMC_REQUEST) THEN
498 : !-- calculate MD steps, in case of 2 different potentials do nested Monte Carlo
499 : CALL nested_markov_chain_MC(conf=conf, &
500 : env_id=tmc_env%w_env%env_id_approx, &
501 0 : tmc_env=tmc_env, calc_status=calc_stat)
502 0 : ELSE IF (work_stat == TMC_STAT_MD_REQUEST) THEN
503 : !TODO Hybrid MC routine
504 0 : CPABORT("there is no Hybrid MC implemented yet.")
505 :
506 : ELSE
507 0 : CPABORT("unknown task type for workers.")
508 : END IF
509 : !-- energy calculations
510 : CASE (TMC_STAT_APPROX_ENERGY_REQUEST)
511 : !--- do calculate energy
512 0 : CPASSERT(tmc_env%w_env%env_id_approx > 0)
513 : CALL calc_potential_energy(conf=conf, &
514 : env_id=tmc_env%w_env%env_id_approx, &
515 : exact_approx_pot=.FALSE., &
516 0 : tmc_env=tmc_env)
517 : CASE (TMC_STAT_ENERGY_REQUEST)
518 : !--- do calculate energy
519 0 : CPASSERT(tmc_env%w_env%env_id_ener > 0)
520 : CALL calc_potential_energy(conf=conf, &
521 : env_id=tmc_env%w_env%env_id_ener, &
522 : exact_approx_pot=.TRUE., &
523 0 : tmc_env=tmc_env)
524 : CASE DEFAULT
525 : CALL cp_abort(__LOCATION__, &
526 : "group participant got unknown working type "// &
527 0 : cp_to_string(work_stat))
528 : END SELECT
529 0 : IF (ASSOCIATED(conf)) THEN
530 0 : CALL deallocate_sub_tree_node(tree_elem=conf)
531 : END IF
532 : END DO worker_work_time
533 : END IF
534 : ! --------------------------------------------------------------------
535 : ! finalizing analysis, writing files etc.
536 14 : IF (ASSOCIATED(tmc_env%tmc_comp_set%para_env_m_ana)) THEN
537 0 : DO itmp = 1, tmc_env%params%nr_temp
538 0 : CALL analysis_restart_print(ana_env=ana_list(itmp)%temp)
539 0 : IF (ASSOCIATED(conf)) THEN
540 0 : CALL deallocate_sub_tree_node(tree_elem=ana_list(itmp)%temp%last_elem)
541 : END IF
542 0 : CALL finalize_tmc_analysis(ana_list(itmp)%temp)
543 : END DO
544 : END IF
545 : !-- stopping and finalizing
546 : ! sending back receipt for stopping
547 14 : IF (master) THEN
548 : ! NOT the analysis group
549 14 : IF (tmc_env%tmc_comp_set%group_nr > 0) THEN
550 : ! remove the communicator in the external control for receiving exit tags
551 : ! and sending additional information (e.g. the intermediate scf energies)
552 14 : IF (tmc_env%params%use_scf_energy_info) THEN
553 0 : IF (tmc_env%w_env%env_id_ener > 0) THEN
554 0 : itmp = tmc_env%w_env%env_id_ener
555 : ELSE
556 0 : itmp = tmc_env%w_env%env_id_approx
557 : END IF
558 0 : CALL remove_intermediate_info_comm(env_id=itmp)
559 : END IF
560 : END IF
561 14 : IF (ASSOCIATED(tmc_env%tmc_comp_set%para_env_sub_group)) THEN
562 : CALL stop_whole_group(para_env=tmc_env%tmc_comp_set%para_env_sub_group, &
563 14 : tmc_params=tmc_env%params)
564 : END IF
565 :
566 14 : work_stat = TMC_STATUS_STOP_RECEIPT
567 14 : itmp = MASTER_COMM_ID
568 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, dest=itmp, &
569 : para_env=para_env_m_w, &
570 14 : tmc_params=tmc_env%params)
571 0 : ELSE IF (ASSOCIATED(tmc_env%tmc_comp_set%para_env_sub_group)) THEN
572 0 : work_stat = TMC_STATUS_STOP_RECEIPT
573 0 : itmp = MASTER_COMM_ID
574 : CALL tmc_message(msg_type=work_stat, send_recv=send_msg, dest=itmp, &
575 : para_env=tmc_env%tmc_comp_set%para_env_sub_group, &
576 0 : tmc_params=tmc_env%params)
577 : END IF
578 :
579 : IF (DEBUG >= 5) THEN
580 : WRITE (tmc_env%w_env%io_unit, *) "worker ", &
581 : tmc_env%tmc_comp_set%para_env_sub_group%mepos, "of group ", &
582 : tmc_env%tmc_comp_set%group_nr, "stops working!"
583 : END IF
584 :
585 14 : IF (PRESENT(ana_list)) THEN
586 0 : DO itmp = 1, tmc_env%params%nr_temp
587 0 : ana_list(itmp)%temp%atoms => NULL()
588 0 : ana_list(itmp)%temp%cell => NULL()
589 : END DO
590 : END IF
591 14 : IF (ASSOCIATED(conf)) THEN
592 0 : CALL deallocate_sub_tree_node(tree_elem=conf)
593 : END IF
594 14 : IF (ASSOCIATED(ana_restart_conf)) DEALLOCATE (ana_restart_conf)
595 :
596 : ! end the timing
597 14 : CALL timestop(handle)
598 14 : END SUBROUTINE do_tmc_worker
599 :
600 : ! **************************************************************************************************
601 : !> \brief Nested Monte Carlo (NMC), do several Markov Chain Monte Carlo steps
602 : !> usually using the approximate potential, could be also Hybrid MC.
603 : !> The amount of steps are predefined by the user, but should be huge
604 : !> enough to reach the equilibrium state for this potential
605 : !> \param conf ...
606 : !> \param env_id ...
607 : !> \param tmc_env ...
608 : !> \param calc_status ...
609 : !> \param
610 : !> \author Mandes 11.2012
611 : ! **************************************************************************************************
612 114 : SUBROUTINE nested_markov_chain_MC(conf, env_id, tmc_env, calc_status)
613 : TYPE(tree_type), POINTER :: conf
614 : INTEGER, INTENT(IN) :: env_id
615 : TYPE(tmc_env_type), POINTER :: tmc_env
616 : INTEGER, INTENT(OUT) :: calc_status
617 :
618 : CHARACTER(LEN=*), PARAMETER :: routineN = 'nested_markov_chain_MC'
619 :
620 : INTEGER :: comm_dest, handle, substeps
621 : LOGICAL :: accept, change_rejected, flag
622 : REAL(KIND=dp) :: rnd_nr
623 : TYPE(tree_type), POINTER :: last_acc_conf
624 :
625 57 : NULLIFY (last_acc_conf)
626 :
627 57 : CPASSERT(ASSOCIATED(tmc_env))
628 57 : CPASSERT(ASSOCIATED(tmc_env%params))
629 57 : CPASSERT(ASSOCIATED(tmc_env%tmc_comp_set))
630 57 : CPASSERT(ALLOCATED(tmc_env%rng_stream))
631 57 : CPASSERT(ASSOCIATED(conf))
632 57 : CPASSERT(conf%temp_created > 0)
633 57 : CPASSERT(conf%temp_created <= tmc_env%params%nr_temp)
634 57 : CPASSERT(env_id > 0)
635 : MARK_USED(env_id)
636 :
637 : ! start the timing
638 57 : CALL timeset(routineN, handle)
639 :
640 : CALL allocate_new_sub_tree_node(tmc_params=tmc_env%params, &
641 57 : next_el=last_acc_conf, nr_dim=SIZE(conf%pos))
642 :
643 98610 : last_acc_conf%pos = conf%pos
644 456 : last_acc_conf%box_scale = conf%box_scale
645 :
646 : ! energy of the last accepted configuration
647 : CALL calc_potential_energy(conf=last_acc_conf, &
648 : env_id=tmc_env%w_env%env_id_approx, exact_approx_pot=.FALSE., &
649 57 : tmc_env=tmc_env)
650 :
651 194 : NMC_steps: DO substeps = 1, INT(tmc_env%params%move_types%mv_size(mv_type_NMC_moves, 1))
652 : ! check for canceling message
653 137 : IF (ASSOCIATED(tmc_env%tmc_comp_set%para_env_m_w)) THEN
654 137 : flag = .FALSE.
655 137 : comm_dest = MASTER_COMM_ID
656 : ! check for new canceling message
657 : CALL tmc_message(msg_type=calc_status, send_recv=recv_msg, &
658 : dest=comm_dest, &
659 : para_env=tmc_env%tmc_comp_set%para_env_m_w, &
660 137 : tmc_params=tmc_env%params, success=flag)
661 : END IF
662 137 : comm_dest = bcast_group
663 : CALL tmc_message(msg_type=calc_status, send_recv=send_msg, &
664 : dest=comm_dest, &
665 : para_env=tmc_env%tmc_comp_set%para_env_sub_group, &
666 137 : tmc_params=tmc_env%params)
667 137 : SELECT CASE (calc_status)
668 : CASE (TMC_STATUS_CALCULATING)
669 : ! keep on working
670 : CASE (TMC_CANCELING_MESSAGE)
671 : ! nothing to do, because calculation CANCELING, exit with cancel status
672 0 : EXIT NMC_steps
673 : CASE DEFAULT
674 : CALL cp_abort(__LOCATION__, &
675 : "unknown status "//cp_to_string(calc_status)// &
676 137 : "in the NMC routine, expect only caneling status. ")
677 : END SELECT
678 :
679 : ! set move type
680 : CALL tmc_env%rng_stream%set( &
681 : bg=conf%rng_seed(:, :, 1), cg=conf%rng_seed(:, :, 2), &
682 137 : ig=conf%rng_seed(:, :, 3))
683 : conf%move_type = select_random_move_type( &
684 : move_types=tmc_env%params%nmc_move_types, &
685 137 : rnd=tmc_env%rng_stream%next())
686 : CALL tmc_env%rng_stream%get( &
687 : bg=conf%rng_seed(:, :, 1), cg=conf%rng_seed(:, :, 2), &
688 137 : ig=conf%rng_seed(:, :, 3))
689 :
690 : ! do move
691 : CALL change_pos(tmc_params=tmc_env%params, &
692 : move_types=tmc_env%params%nmc_move_types, &
693 : rng_stream=tmc_env%rng_stream, &
694 : elem=conf, mv_conf=1, new_subbox=.FALSE., &
695 137 : move_rejected=change_rejected)
696 : ! for Hybrid MC the change_pos is only velocity change,
697 : ! the actual MD step hast to be done in this module for communication reason
698 137 : IF (conf%move_type == mv_type_MD) THEN
699 : !TODO implement the MD part
700 : !CALL calc_MD_step(...)
701 : !CALL calc_calc_e_kin(...)
702 : CALL cp_abort(__LOCATION__, &
703 : "Hybrid MC is not implemented yet, "// &
704 0 : "(no MD section in TMC yet). ")
705 : END IF
706 :
707 : ! update the subbox acceptance probabilities
708 : CALL prob_update(move_types=tmc_env%params%nmc_move_types, elem=conf, &
709 : acc=.NOT. change_rejected, subbox=.TRUE., &
710 137 : prob_opt=tmc_env%params%esimate_acc_prob)
711 :
712 : ! calculate potential energy if necessary
713 137 : IF (.NOT. change_rejected) THEN
714 : CALL calc_potential_energy(conf=conf, &
715 : env_id=tmc_env%w_env%env_id_approx, exact_approx_pot=.FALSE., &
716 126 : tmc_env=tmc_env)
717 : ELSE
718 11 : conf%e_pot_approx = HUGE(conf%e_pot_approx)
719 : END IF
720 :
721 : !check NMC step
722 : CALL tmc_env%rng_stream%set( &
723 : bg=conf%rng_seed(:, :, 1), cg=conf%rng_seed(:, :, 2), &
724 137 : ig=conf%rng_seed(:, :, 3))
725 137 : rnd_nr = tmc_env%rng_stream%next()
726 : CALL tmc_env%rng_stream%get( &
727 : bg=conf%rng_seed(:, :, 1), cg=conf%rng_seed(:, :, 2), &
728 137 : ig=conf%rng_seed(:, :, 3))
729 :
730 137 : IF (.NOT. change_rejected) THEN
731 : CALL acceptance_check(tree_element=conf, parent_element=last_acc_conf, &
732 : tmc_params=tmc_env%params, &
733 : temperature=tmc_env%params%Temp(conf%temp_created), &
734 : diff_pot_check=.FALSE., &
735 126 : accept=accept, approx_ener=.TRUE., rnd_nr=rnd_nr)
736 : ELSE
737 11 : accept = .FALSE.
738 : END IF
739 : ! update the NMC accpetance per move
740 : CALL prob_update(move_types=tmc_env%params%nmc_move_types, elem=conf, &
741 137 : acc=accept, prob_opt=tmc_env%params%esimate_acc_prob)
742 :
743 : ! update last accepted configuration or actual configuration
744 194 : IF (accept .AND. (.NOT. change_rejected)) THEN
745 103800 : last_acc_conf%pos = conf%pos
746 103800 : last_acc_conf%vel = conf%vel
747 60 : last_acc_conf%e_pot_approx = conf%e_pot_approx
748 60 : last_acc_conf%ekin = conf%ekin
749 60 : last_acc_conf%ekin_before_md = conf%ekin_before_md
750 480 : last_acc_conf%box_scale = conf%box_scale
751 : ELSE
752 133210 : conf%pos = last_acc_conf%pos
753 133210 : conf%vel = last_acc_conf%vel
754 616 : conf%box_scale = last_acc_conf%box_scale
755 : END IF
756 : END DO NMC_steps
757 :
758 : ! result values of Nested Monte Carlo (NMC) steps
759 : ! regard that the calculated potential energy is the one of the approximated potential
760 98610 : conf%pos = last_acc_conf%pos
761 98610 : conf%vel = last_acc_conf%vel
762 57 : conf%e_pot_approx = last_acc_conf%e_pot_approx
763 57 : conf%potential = 0.0_dp
764 57 : conf%ekin = last_acc_conf%ekin
765 57 : conf%ekin_before_md = last_acc_conf%ekin_before_md
766 :
767 57 : CALL deallocate_sub_tree_node(tree_elem=last_acc_conf)
768 :
769 : ! end the timing
770 57 : CALL timestop(handle)
771 57 : END SUBROUTINE nested_markov_chain_MC
772 :
773 : ! **************************************************************************************************
774 : !> \brief get the initial confuguration (pos,...)
775 : !> \param tmc_params ...
776 : !> \param init_conf the structure the data should be stored
777 : !> force_env
778 : !> \param env_id ...
779 : !> \author Mandes 11.2012
780 : ! **************************************************************************************************
781 60 : SUBROUTINE get_initial_conf(tmc_params, init_conf, env_id)
782 : TYPE(tmc_param_type), POINTER :: tmc_params
783 : TYPE(tree_type), POINTER :: init_conf
784 : INTEGER :: env_id
785 :
786 : CHARACTER(LEN=*), PARAMETER :: routineN = 'get_initial_conf'
787 :
788 : INTEGER :: handle, ierr, mol, ndim, nr_atoms
789 : TYPE(cp_subsys_type), POINTER :: subsys
790 : TYPE(f_env_type), POINTER :: f_env
791 : TYPE(molecule_list_type), POINTER :: molecule_new
792 :
793 20 : CPASSERT(.NOT. ASSOCIATED(init_conf))
794 :
795 : ! start the timing
796 20 : CALL timeset(routineN, handle)
797 :
798 : ! get positions
799 20 : CALL get_natom(env_id=env_id, n_atom=nr_atoms, ierr=ierr)
800 20 : CPASSERT(ierr == 0)
801 20 : ndim = 3*nr_atoms
802 : CALL allocate_new_sub_tree_node(tmc_params=tmc_params, &
803 20 : next_el=init_conf, nr_dim=ndim)
804 : CALL get_pos(env_id=env_id, pos=init_conf%pos, n_el=SIZE(init_conf%pos), &
805 20 : ierr=ierr)
806 :
807 : ! get the molecule info
808 20 : CALL f_env_get_from_id(env_id, f_env)
809 20 : CALL force_env_get(f_env%force_env, subsys=subsys)
810 :
811 20 : CALL cp_subsys_get(subsys=subsys, molecules=molecule_new)
812 688 : loop_mol: DO mol = 1, SIZE(molecule_new%els(:))
813 : init_conf%mol(molecule_new%els(mol)%first_atom: &
814 2694 : molecule_new%els(mol)%last_atom) = mol
815 : END DO loop_mol
816 :
817 : ! end the timing
818 20 : CALL timestop(handle)
819 :
820 20 : END SUBROUTINE get_initial_conf
821 :
822 : ! **************************************************************************************************
823 : !> \brief get the pointer to the atoms, for easy handling
824 : !> \param env_id ...
825 : !> \param atoms pointer to atomic_kind
826 : !> \param cell ...
827 : !> \author Mandes 01.2013
828 : ! **************************************************************************************************
829 20 : SUBROUTINE get_atom_kinds_and_cell(env_id, atoms, cell)
830 : INTEGER :: env_id
831 : TYPE(tmc_atom_type), DIMENSION(:), POINTER :: atoms
832 : TYPE(cell_type), POINTER :: cell
833 :
834 : INTEGER :: iparticle, nr_atoms, nunits_tot
835 : TYPE(cell_type), POINTER :: cell_tmp
836 : TYPE(cp_subsys_type), POINTER :: subsys
837 : TYPE(f_env_type), POINTER :: f_env
838 : TYPE(particle_list_type), POINTER :: particles
839 :
840 20 : NULLIFY (f_env, subsys, particles)
841 : nr_atoms = 0
842 :
843 20 : CPASSERT(env_id > 0)
844 20 : CPASSERT(.NOT. ASSOCIATED(atoms))
845 20 : CPASSERT(.NOT. ASSOCIATED(cell))
846 :
847 20 : CALL f_env_get_from_id(env_id, f_env)
848 20 : nr_atoms = force_env_get_natom(f_env%force_env)
849 20 : CALL force_env_get(f_env%force_env, subsys=subsys, cell=cell_tmp)
850 1380 : ALLOCATE (cell)
851 20 : CALL cell_copy(cell_in=cell_tmp, cell_out=cell)
852 :
853 : !get atom kinds
854 20 : CALL allocate_tmc_atom_type(atoms, nr_atoms)
855 20 : CALL cp_subsys_get(subsys, particles=particles)
856 20 : nunits_tot = SIZE(particles%els(:))
857 20 : IF (nunits_tot > 0) THEN
858 2026 : DO iparticle = 1, nunits_tot
859 2006 : atoms(iparticle)%name = particles%els(iparticle)%atomic_kind%name
860 2026 : atoms(iparticle)%mass = particles%els(iparticle)%atomic_kind%mass
861 : END DO
862 20 : CPASSERT(iparticle - 1 == nr_atoms)
863 : END IF
864 20 : END SUBROUTINE get_atom_kinds_and_cell
865 :
866 : ! **************************************************************************************************
867 : !> \brief set the communicator in the SCF environment
868 : !> to receive the intermediate energies on the (global) master side
869 : !> \param comm the master-worker communicator
870 : !> \param env_id the ID of the related force environment
871 : !> \author Mandes 10.2013
872 : ! **************************************************************************************************
873 0 : SUBROUTINE set_intermediate_info_comm(comm, env_id)
874 : CLASS(mp_comm_type), INTENT(IN) :: comm
875 : INTEGER :: env_id
876 :
877 : CHARACTER(LEN=default_string_length) :: description
878 : REAL(KIND=dp), DIMENSION(3) :: values
879 : TYPE(cp_result_type), POINTER :: results
880 : TYPE(cp_subsys_type), POINTER :: subsys
881 : TYPE(f_env_type), POINTER :: f_env
882 :
883 0 : NULLIFY (results, subsys)
884 0 : CPASSERT(env_id > 0)
885 :
886 0 : CALL f_env_get_from_id(env_id, f_env)
887 :
888 0 : CPASSERT(ASSOCIATED(f_env))
889 0 : CPASSERT(ASSOCIATED(f_env%force_env))
890 0 : IF (.NOT. ASSOCIATED(f_env%force_env%qs_env)) THEN
891 : CALL cp_abort(__LOCATION__, &
892 : "the intermediate SCF energy request can not be set "// &
893 0 : "employing this force environment! ")
894 : END IF
895 :
896 : ! set the information
897 0 : values(1) = REAL(comm%get_handle(), KIND=dp)
898 0 : values(2) = REAL(MASTER_COMM_ID, KIND=dp)
899 0 : values(3) = REAL(TMC_STAT_SCF_STEP_ENER_RECEIVE, KIND=dp)
900 0 : description = "[EXT_SCF_ENER_COMM]"
901 :
902 : ! set the communicator information in the qs_env result container
903 0 : CALL force_env_get(f_env%force_env, subsys=subsys)
904 0 : CALL cp_subsys_get(subsys, results=results)
905 0 : CALL put_results(results, description=description, values=values)
906 0 : END SUBROUTINE set_intermediate_info_comm
907 :
908 : ! **************************************************************************************************
909 : !> \brief set the communicator in the SCF environment
910 : !> to receive the intermediate energies on the (global) master side
911 : !> \param env_id the ID of the related force environment
912 : !> \author Mandes 10.2013
913 : ! **************************************************************************************************
914 0 : SUBROUTINE remove_intermediate_info_comm(env_id)
915 : INTEGER :: env_id
916 :
917 : CHARACTER(LEN=default_string_length) :: description
918 : TYPE(cp_result_type), POINTER :: results
919 : TYPE(cp_subsys_type), POINTER :: subsys
920 : TYPE(f_env_type), POINTER :: f_env
921 :
922 0 : NULLIFY (subsys, results)
923 0 : CPASSERT(env_id > 0)
924 :
925 0 : CALL f_env_get_from_id(env_id, f_env)
926 :
927 0 : CPASSERT(ASSOCIATED(f_env))
928 0 : CPASSERT(ASSOCIATED(f_env%force_env))
929 0 : IF (.NOT. ASSOCIATED(f_env%force_env%qs_env)) THEN
930 : CALL cp_abort(__LOCATION__, &
931 : "the SCF intermediate energy communicator can not be "// &
932 0 : "removed! ")
933 : END IF
934 :
935 0 : description = "[EXT_SCF_ENER_COMM]"
936 :
937 : ! set the communicator information in the qs_env result container
938 0 : CALL force_env_get(f_env%force_env, subsys=subsys)
939 0 : CALL cp_subsys_get(subsys, results=results)
940 0 : CALL cp_results_erase(results, description=description)
941 0 : END SUBROUTINE remove_intermediate_info_comm
942 :
943 : END MODULE tmc_worker
|
