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