(git:374b731)
Loading...
Searching...
No Matches
tmc_messages.F
Go to the documentation of this file.
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 set up the different message for different tasks
10!> A TMC message consists of 3 parts (messages)
11!> 1: first a message with task type (STATUS) and SIZES of submessages
12!> 2: (if existing) a message with INTEGER values
13!> 3: (if existing) a message with REAL values
14!> submessages 2 and 3 include relevant data, e.g. positions, box sizes...
15!> \par History
16!> 11.2012 created [Mandes Schoenherr]
17!> \author Mandes
18! **************************************************************************************************
19MODULE tmc_messages
20 USE cp_log_handling, ONLY: cp_to_string
21 USE kinds, ONLY: default_string_length,&
22 dp
23 USE message_passing, ONLY: mp_any_source,&
24 mp_any_tag,&
25 mp_para_env_type
26 USE tmc_move_handle, ONLY: add_mv_prob
27 USE tmc_stati, ONLY: &
28 tmc_canceling_message, tmc_canceling_receipt, tmc_status_calculating, tmc_status_failed, &
29 tmc_status_stop_receipt, tmc_status_wait_for_new_task, tmc_status_worker_init, &
30 tmc_stat_analysis_request, tmc_stat_analysis_result, tmc_stat_approx_energy_request, &
31 tmc_stat_approx_energy_result, tmc_stat_energy_request, tmc_stat_energy_result, &
32 tmc_stat_init_analysis, tmc_stat_md_broadcast, tmc_stat_md_request, tmc_stat_md_result, &
33 tmc_stat_nmc_broadcast, tmc_stat_nmc_request, tmc_stat_nmc_result, &
34 tmc_stat_scf_step_ener_receive, tmc_stat_start_conf_request, tmc_stat_start_conf_result, &
35 task_type_gaussian_adaptation
36 USE tmc_tree_build, ONLY: allocate_new_sub_tree_node
37 USE tmc_tree_types, ONLY: elem_array_type,&
38 elem_list_type,&
39 tree_type
40 USE tmc_types, ONLY: allocate_tmc_atom_type,&
41 tmc_atom_type,&
42 tmc_param_type
43#include "../base/base_uses.f90"
44
45 IMPLICIT NONE
46
47 PRIVATE
48
49 LOGICAL, PARAMETER, PUBLIC :: send_msg = .true.
50 LOGICAL, PARAMETER, PUBLIC :: recv_msg = .false.
51
52 INTEGER, PARAMETER :: message_end_flag = 25
53
54 INTEGER, PARAMETER :: debug = 0
55
56 CHARACTER(len=*), PARAMETER, PRIVATE :: modulen = 'tmc_messages'
57
58 PUBLIC :: check_if_group_master
59 PUBLIC :: tmc_message
60 PUBLIC :: communicate_atom_types
61 PUBLIC :: stop_whole_group
62
63 INTEGER, PARAMETER, PUBLIC :: master_comm_id = 0 ! id for master and group master
64 INTEGER, PARAMETER, PUBLIC :: bcast_group = -1 ! destination flag for broadcasting to other group participants
65 INTEGER, PARAMETER :: tmc_send_info_size = 4 ! usually: 1. status, array sizes: 2. int, 3. real, 4. char
66
67 TYPE message_send
68 INTEGER, DIMENSION(TMC_SEND_INFO_SIZE) :: info = -1
69 REAL(kind=dp), DIMENSION(:), ALLOCATABLE :: task_real
70 INTEGER, DIMENSION(:), ALLOCATABLE :: task_int
71 CHARACTER, DIMENSION(:), ALLOCATABLE :: task_char
72 !should be deleted somewhen
73 INTEGER, DIMENSION(:), ALLOCATABLE :: elem_stat
74 END TYPE message_send
75
76CONTAINS
77
78! **************************************************************************************************
79!> \brief checks if the core is the group master
80!> \param para_env defines the mpi communicator
81!> \return return value, logical
82!> \author Mandes 01.2013
83! **************************************************************************************************
84 FUNCTION check_if_group_master(para_env) RESULT(master)
85 TYPE(mp_para_env_type), POINTER :: para_env
86 LOGICAL :: master
87
88 cpassert(ASSOCIATED(para_env))
89
90 master = .false.
91 IF (para_env%mepos .EQ. master_comm_id) &
92 master = .true.
93 END FUNCTION check_if_group_master
94
95! **************************************************************************************************
96!> \brief tmc message handling, packing messages with integer and real data
97!> type. Send first info message with task type and message sizes and
98!> then the int and real messages. The same for receiving
99!> \param msg_type defines the message types, see message tags definition
100!> \param send_recv 1= send, 0= receive
101!> \param dest defines the target or source of message
102!> (-1=braodcast, 0= master, 1... working group)
103!> \param para_env defines the mpi communicator
104!> \param tmc_params stuct with parameters (global settings)
105!> \param elem a subtree element from which info are readed or written in
106!> \param elem_array ...
107!> \param list_elem ...
108!> \param result_count ...
109!> \param wait_for_message ...
110!> \param success ...
111!> \author Mandes 12.2012
112! **************************************************************************************************
113 SUBROUTINE tmc_message(msg_type, send_recv, dest, para_env, tmc_params, &
114 elem, elem_array, list_elem, result_count, &
115 wait_for_message, success)
116 INTEGER :: msg_type
117 LOGICAL :: send_recv
118 INTEGER :: dest
119 TYPE(mp_para_env_type), POINTER :: para_env
120 TYPE(tmc_param_type), POINTER :: tmc_params
121 TYPE(tree_type), OPTIONAL, POINTER :: elem
122 TYPE(elem_array_type), DIMENSION(:), OPTIONAL :: elem_array
123 TYPE(elem_list_type), OPTIONAL, POINTER :: list_elem
124 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: result_count
125 LOGICAL, OPTIONAL :: wait_for_message, success
126
127 INTEGER :: i, message_tag, tmp_tag
128 LOGICAL :: act_send_recv, flag
129 TYPE(message_send), POINTER :: m_send
130
131 cpassert(ASSOCIATED(para_env))
132 cpassert(ASSOCIATED(tmc_params))
133
134 ALLOCATE (m_send)
135
136 ! init
137 ! define send_recv flag for broadcast
138 IF (dest .EQ. bcast_group) THEN
139 ! master should always send
140 IF (para_env%mepos .EQ. master_comm_id) THEN
141 act_send_recv = send_msg
142 ELSE
143 ! worker should always receive
144 act_send_recv = recv_msg
145 END IF
146 ELSE
147 act_send_recv = send_recv
148 END IF
149 message_tag = 0
150
151 ! =============================
152 ! sending message
153 ! =============================
154 ! creating message to send
155 IF (act_send_recv .EQV. send_msg) THEN
156 IF ((debug .GE. 7) .AND. (dest .NE. bcast_group) .AND. &
157 (dest .NE. master_comm_id)) THEN
158 IF (PRESENT(elem)) THEN
159 WRITE (*, *) "send element info to ", dest, " of type ", msg_type, "of subtree", elem%sub_tree_nr, &
160 "elem", elem%nr
161 ELSE
162 WRITE (*, *) "send element info to ", dest, " of type ", msg_type
163 END IF
164 END IF
165 SELECT CASE (msg_type)
166 CASE (tmc_stat_start_conf_request, tmc_status_failed, tmc_canceling_message, &
167 tmc_canceling_receipt, tmc_status_stop_receipt, &
168 tmc_status_wait_for_new_task, tmc_status_calculating, &
169 tmc_stat_analysis_result)
170 CALL create_status_message(m_send)
171 CASE (tmc_status_worker_init)
172 CALL create_worker_init_message(tmc_params, m_send)
173 CASE (tmc_stat_start_conf_result, tmc_stat_init_analysis)
174 CALL create_start_conf_message(msg_type, elem, result_count, tmc_params, m_send)
175 CASE (tmc_stat_energy_request, tmc_stat_approx_energy_request)
176 CALL create_energy_request_message(elem, m_send, tmc_params)
177 CASE (tmc_stat_approx_energy_result)
178 CALL create_approx_energy_result_message(elem, m_send, tmc_params)
179 CASE (tmc_stat_energy_result)
180 CALL create_energy_result_message(elem, m_send, tmc_params)
181 CASE (tmc_stat_nmc_request, tmc_stat_nmc_broadcast, &
182 tmc_stat_md_request, tmc_stat_md_broadcast)
183 CALL create_nmc_request_massage(msg_type, elem, m_send, tmc_params)
184 CASE (tmc_stat_md_result, tmc_stat_nmc_result)
185 CALL create_nmc_result_massage(msg_type, elem, m_send, tmc_params)
186 CASE (tmc_stat_analysis_request)
187 cpassert(PRESENT(list_elem))
188 CALL create_analysis_request_message(list_elem, m_send, tmc_params)
189 CASE DEFAULT
190 cpabort("try to send unknown message type "//cp_to_string(msg_type))
191 END SELECT
192 !set message info
193 message_tag = msg_type
194 m_send%info(:) = 0
195 m_send%info(1) = msg_type
196 IF (ALLOCATED(m_send%task_int)) m_send%info(2) = SIZE(m_send%task_int)
197 IF (ALLOCATED(m_send%task_real)) m_send%info(3) = SIZE(m_send%task_real)
198 IF (ALLOCATED(m_send%task_char)) m_send%info(4) = SIZE(m_send%task_char)
199 END IF
200
201 ! sending message
202 IF ((act_send_recv .EQV. send_msg) .AND. (dest .NE. bcast_group)) THEN
203 CALL para_env%send(m_send%info, dest, message_tag)
204 IF (m_send%info(2) .GT. 0) THEN
205 CALL para_env%send(m_send%task_int, dest, message_tag)
206 END IF
207 IF (m_send%info(3) .GT. 0) THEN
208 CALL para_env%send(m_send%task_real, dest, message_tag)
209 END IF
210 IF (m_send%info(4) .GT. 0) THEN
211 cpabort("")
212 !TODO send characters CALL para_env%send(m_send%task_char, dest, message_tag)
213 END IF
214 IF (debug .GE. 1) &
215 WRITE (*, *) "TMC|message: ID: ", para_env%mepos, &
216 " send element info to ", dest, " of stat ", m_send%info(1), &
217 " with size int/real/char", m_send%info(2:), " with comm ", &
218 para_env%get_handle(), " and tag ", message_tag
219 IF (m_send%info(2) .GT. 0) DEALLOCATE (m_send%task_int)
220 IF (m_send%info(3) .GT. 0) DEALLOCATE (m_send%task_real)
221 IF (m_send%info(4) .GT. 0) DEALLOCATE (m_send%task_char)
222 IF (PRESENT(success)) success = .true.
223 END IF
224
225 ! =============================
226 ! broadcast
227 ! =============================
228 IF (dest .EQ. bcast_group) THEN
229 IF (para_env%num_pe .GT. 1) THEN
230 CALL para_env%bcast(m_send%info, master_comm_id)
231 IF (m_send%info(2) .GT. 0) THEN
232 IF (.NOT. act_send_recv) ALLOCATE (m_send%task_int(m_send%info(2)))
233 CALL para_env%bcast(m_send%task_int, master_comm_id)
234 END IF
235 IF (m_send%info(3) .GT. 0) THEN
236 IF (.NOT. act_send_recv) ALLOCATE (m_send%task_real(m_send%info(3)))
237 CALL para_env%bcast(m_send%task_real, master_comm_id)
238 END IF
239 IF (m_send%info(4) .GT. 0) THEN
240 IF (.NOT. act_send_recv) ALLOCATE (m_send%task_char(m_send%info(3)))
241 cpabort("")
242 !TODO bcast char CALL para_env%bcast(m_send%task_char, MASTER_COMM_ID)
243 END IF
244 END IF
245 ! sender delete arrays
246 IF (act_send_recv) THEN
247 IF (m_send%info(2) .GT. 0) DEALLOCATE (m_send%task_int)
248 IF (m_send%info(3) .GT. 0) DEALLOCATE (m_send%task_real)
249 IF (m_send%info(4) .GT. 0) DEALLOCATE (m_send%task_char)
250 END IF
251 END IF
252
253 ! =============================
254 ! receiving message
255 ! =============================
256 IF ((act_send_recv .EQV. recv_msg) .AND. dest .NE. bcast_group) THEN
257 flag = .false.
258 tmp_tag = tmc_status_wait_for_new_task
259 IF (PRESENT(wait_for_message)) THEN
260 dest = mp_any_source
261 CALL para_env%probe(dest, tmp_tag)
262 flag = .true.
263 ELSE
264 participant_loop: DO i = 0, para_env%num_pe - 1
265 IF (i .NE. para_env%mepos) THEN
266 dest = i
267 CALL para_env%probe(dest, tmp_tag)
268 IF (dest .EQ. i) THEN
269 flag = .true.
270 EXIT participant_loop
271 END IF
272 END IF
273 END DO participant_loop
274 END IF
275 IF (flag .EQV. .false.) THEN
276 IF (PRESENT(success)) success = .false.
277 DEALLOCATE (m_send)
278 RETURN
279 END IF
280
281 IF (tmp_tag .EQ. tmc_stat_scf_step_ener_receive) THEN
282 ! CP2K send back SCF step energies without info message
283 message_tag = tmc_stat_scf_step_ener_receive
284 m_send%info(1) = tmc_stat_scf_step_ener_receive
285 m_send%info(2) = 0 ! no integer values
286 m_send%info(3) = 1 ! one double values (SCF total energy)
287 m_send%info(4) = 0 ! no character values
288 ELSE
289 message_tag = mp_any_tag
290 ! first get message type and sizes
291 CALL para_env%recv(m_send%info, dest, message_tag)
292 END IF
293 IF (debug .GE. 1) &
294 WRITE (*, *) "TMC|message: ID: ", para_env%mepos, &
295 " recv element info from ", dest, " of stat ", m_send%info(1), &
296 " with size int/real/char", m_send%info(2:)
297 !-- receive message integer part
298 IF (m_send%info(2) .GT. 0) THEN
299 ALLOCATE (m_send%task_int(m_send%info(2)))
300 CALL para_env%recv(m_send%task_int, dest, message_tag)
301 END IF
302 !-- receive message double (floatingpoint) part
303 IF (m_send%info(3) .GT. 0) THEN
304 ALLOCATE (m_send%task_real(m_send%info(3)))
305 CALL para_env%recv(m_send%task_real, dest, message_tag)
306 END IF
307 !-- receive message character part
308 IF (m_send%info(4) .GT. 0) THEN
309 ALLOCATE (m_send%task_char(m_send%info(4)))
310 cpabort("")
311 !TODO recv characters CALL para_env%recv(m_send%task_char, dest, message_tag)
312 END IF
313 END IF
314
315 ! handling received message
316 IF (act_send_recv .EQV. recv_msg) THEN
317 ! if the element is supposed to be canceled but received message is not canceling receipt do not handle element
318 ! (because element could be already deallocated, and hence a new element would be created -> not necessary)
319 IF (PRESENT(elem_array)) THEN
320 IF (elem_array(dest)%canceled .AND. m_send%info(1) .NE. tmc_canceling_receipt) THEN
321 msg_type = m_send%info(1)
322 IF (m_send%info(2) .GT. 0) DEALLOCATE (m_send%task_int)
323 IF (m_send%info(3) .GT. 0) DEALLOCATE (m_send%task_real)
324 IF (m_send%info(4) .GT. 0) DEALLOCATE (m_send%task_char)
325 ! to check for further messages
326 IF (PRESENT(success)) success = .true.
327 DEALLOCATE (m_send)
328 RETURN
329 END IF
330 END IF
331
332 msg_type = m_send%info(1)
333 SELECT CASE (m_send%info(1))
334 CASE (tmc_stat_start_conf_request, tmc_canceling_message, &
335 tmc_canceling_receipt, tmc_status_wait_for_new_task, &
336 tmc_status_calculating, tmc_stat_analysis_result)
337 ! nothing to do here
338 CASE (tmc_status_worker_init)
339 CALL read_worker_init_message(tmc_params, m_send)
340 CASE (tmc_stat_start_conf_result, tmc_stat_init_analysis)
341 IF (PRESENT(elem_array)) THEN
342 CALL read_start_conf_message(msg_type, elem_array(dest)%elem, &
343 result_count, m_send, tmc_params)
344 ELSE
345 CALL read_start_conf_message(msg_type, elem, result_count, m_send, &
346 tmc_params)
347 END IF
348 CASE (tmc_stat_approx_energy_result)
349 CALL read_approx_energy_result(elem_array(dest)%elem, m_send, tmc_params)
350 CASE (tmc_stat_energy_request, tmc_stat_approx_energy_request)
351 CALL read_energy_request_message(elem, m_send, tmc_params)
352 CASE (tmc_stat_energy_result)
353 IF (PRESENT(elem_array)) &
354 CALL read_energy_result_message(elem_array(dest)%elem, m_send, tmc_params)
355 CASE (tmc_stat_nmc_request, tmc_stat_nmc_broadcast, &
356 tmc_stat_md_request, tmc_stat_md_broadcast)
357 CALL read_nmc_request_massage(msg_type, elem, m_send, tmc_params)
358 CASE (tmc_stat_nmc_result, tmc_stat_md_result)
359 IF (PRESENT(elem_array)) &
360 CALL read_nmc_result_massage(msg_type, elem_array(dest)%elem, m_send, tmc_params)
361 CASE (tmc_status_failed, tmc_status_stop_receipt)
362 ! if task is failed, handle situation in outer routine
363 CASE (tmc_stat_scf_step_ener_receive)
364 CALL read_scf_step_ener(elem_array(dest)%elem, m_send)
365 CASE (tmc_stat_analysis_request)
366 CALL read_analysis_request_message(elem, m_send, tmc_params)
367 CASE DEFAULT
368 CALL cp_abort(__location__, &
369 "try to receive unknown message type "//cp_to_string(msg_type)// &
370 "from source "//cp_to_string(dest))
371 END SELECT
372 IF (m_send%info(2) .GT. 0) DEALLOCATE (m_send%task_int)
373 IF (m_send%info(3) .GT. 0) DEALLOCATE (m_send%task_real)
374 IF (m_send%info(4) .GT. 0) DEALLOCATE (m_send%task_char)
375 IF (PRESENT(success)) success = .true.
376 END IF
377
378 ! ATTENTION there is also an short exit (RETURN) after probing for new messages
379 DEALLOCATE (m_send)
380 END SUBROUTINE tmc_message
381
382! **************************************************************************************************
383!> \brief set the messege just with an status tag
384!> \param m_send the message structure
385!> \author Mandes 12.2012
386! **************************************************************************************************
387
388 SUBROUTINE create_status_message(m_send)
389 TYPE(message_send), POINTER :: m_send
390
391 cpassert(ASSOCIATED(m_send))
392
393 ! nothing to do, send just the message tag
394
395 cpassert(.NOT. ALLOCATED(m_send%task_int))
396 cpassert(.NOT. ALLOCATED(m_send%task_real))
397 mark_used(m_send)
398
399 END SUBROUTINE create_status_message
400
401 !============================================================================
402 ! message for requesting start configuration
403 !============================================================================
404!! **************************************************************************************************
405!!> \brief the message for sending the atom mass
406!!> (number of atoms is also tranfered)
407!!> atom names have to be done separately,
408!!> because character send only with bcast possible
409!!> \param tmc_parms th send the cell properties
410!!> \param m_send the message structure
411!!> \param error variable to control error logging, stopping,...
412!!> see module cp_error_handling
413!!> \author Mandes 02.2013
414!! **************************************************************************************************
415! SUBROUTINE create_atom_mass_message(m_send, atoms)
416! TYPE(tmc_atom_type), DIMENSION(:), POINTER :: atoms
417! TYPE(message_send), POINTER :: m_send
418!
419! CHARACTER(LEN=*), PARAMETER :: routineN = 'create_atom_mass_message', &
420! routineP = moduleN//':'//routineN
421!
422! INTEGER :: counter, i, &
423! msg_size_real
424! LOGICAL :: failure
425!
426! failure = .FALSE.
427!
428! CPPrecondition(ASSOCIATED(m_send),cp_failure_level,routineP,failure)
429! CPPrecondition(.NOT.ALLOCATED(m_send%task_int),cp_failure_level,routineP,failure)
430! CPPrecondition(.NOT.ALLOCATED(m_send%task_real),cp_failure_level,routineP,failure)
431! CPPrecondition(.NOT.ALLOCATED(m_send%task_char),cp_failure_level,routineP,failure)
432!
433! counter =1
434! msg_size_real = 1+SIZE(tmc_params%cell%hmat)+ 1+SIZE(atoms) +1
435! ALLOCATE(m_send%task_real(msg_size_real))
436!
437! m_send%task_real(1) = REAL(SIZE(atoms,KIND=dp))
438! DO i=1, SIZE(atoms)
439! m_send%task_real(counter+i) = atoms(i)%mass
440! END DO
441! counter = counter + 1+INT(m_send%task_real(counter))
442! m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
443! CPPostconditionNoFail(INT(m_send%task_real(msg_size_real)).EQ.message_end_flag,cp_failure_level,routineP)
444! END SUBROUTINE create_atom_mass_message
445!
446!! **************************************************************************************************
447!!> \brief the message for reading the atom mass
448!!> (number of atoms is also tranfered)
449!!> atom names have to be done separately,
450!!> because character send only with bcast possible
451!!> \param tmc_parms th send the cell properties
452!!> \param m_send the message structure
453!!> \param error variable to control error logging, stopping,...
454!!> see module cp_error_handling
455!!> \author Mandes 02.2013
456!! **************************************************************************************************
457! SUBROUTINE read_atom_mass_message(m_send, atoms)
458! TYPE(tmc_atom_type), DIMENSION(:), &
459! POINTER :: atoms
460! TYPE(message_send), POINTER :: m_send
461!
462! CHARACTER(LEN=*), PARAMETER :: routineN = 'read_atom_mass_message', &
463! routineP = moduleN//':'//routineN
464!
465! INTEGER :: counter, i, nr_atoms
466! LOGICAL :: failure
467!
468! failure = .FALSE.
469!
470! CPPrecondition(ASSOCIATED(m_send),cp_failure_level,routineP,failure)
471! CPPrecondition(.NOT.ALLOCATED(m_send%task_int),cp_failure_level,routineP,failure)
472! CPPrecondition(ALLOCATED(m_send%task_real),cp_failure_level,routineP,failure)
473! CPPrecondition(.NOT.ALLOCATED(m_send%task_char),cp_failure_level,routineP,failure)
474!
475! counter =1
476! nr_atoms = m_send%task_real(counter)
477! IF(.NOT.ASSOCIATED(atoms)) CALL allocate_tmc_atom_type(atoms, nr_atoms)
478! DO i=1, SIZE(atoms)
479! atoms(i)%mass = m_send%task_real(counter+i)
480! END DO
481! counter = counter + 1+INT(m_send%task_real(counter))
482! CPPostconditionNoFail(INT(m_send%task_real(counter)).EQ.message_end_flag,cp_failure_level,routineP)
483! END SUBROUTINE read_atom_mass_message
484
485! **************************************************************************************************
486!> \brief the message for the initial values (cell size) to the workers
487!> \param tmc_params to send the cell properties
488!> \param m_send the message structure
489!> \author Mandes 07.2013
490! **************************************************************************************************
491 SUBROUTINE create_worker_init_message(tmc_params, m_send)
492 TYPE(tmc_param_type), POINTER :: tmc_params
493 TYPE(message_send), POINTER :: m_send
494
495 INTEGER :: counter, msg_size_int, msg_size_real
496
497 cpassert(ASSOCIATED(tmc_params))
498 cpassert(ASSOCIATED(m_send))
499 cpassert(.NOT. ALLOCATED(m_send%task_int))
500 cpassert(.NOT. ALLOCATED(m_send%task_real))
501 cpassert(.NOT. ALLOCATED(m_send%task_char))
502 cpassert(ASSOCIATED(tmc_params%cell))
503
504 counter = 1
505 msg_size_int = 1 + SIZE(tmc_params%cell%perd) + 1 + 1 + 1 + 1
506 ALLOCATE (m_send%task_int(msg_size_int))
507 m_send%task_int(counter) = SIZE(tmc_params%cell%perd) ! periodicity of the cell
508 counter = counter + 1 + m_send%task_int(counter)
509 m_send%task_int(2:counter - 1) = tmc_params%cell%perd(:)
510 m_send%task_int(counter) = 1
511 m_send%task_int(counter + 1) = tmc_params%cell%symmetry_id
512 m_send%task_int(counter + 2) = 0
513 IF (tmc_params%cell%orthorhombic) m_send%task_int(counter + 2) = 1
514 counter = counter + 3
515 m_send%task_int(counter) = message_end_flag
516 cpassert(counter .EQ. SIZE(m_send%task_int))
517
518 !float array with cell vectors
519 msg_size_real = 1 + SIZE(tmc_params%cell%hmat) + 1
520 ALLOCATE (m_send%task_real(msg_size_real))
521 counter = 1
522 m_send%task_real(counter) = SIZE(tmc_params%cell%hmat) ! cell vectors for cell size
523 m_send%task_real(counter + 1:counter + SIZE(tmc_params%cell%hmat)) = &
524 reshape(tmc_params%cell%hmat(:, :), &
525 (/SIZE(tmc_params%cell%hmat)/))
526 counter = counter + 1 + int(m_send%task_real(counter))
527 m_send%task_real(counter) = real(message_end_flag, kind=dp) !message end
528 cpassert(SIZE(m_send%task_real) .EQ. msg_size_real)
529 cpassert(int(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
530 END SUBROUTINE create_worker_init_message
531
532! **************************************************************************************************
533!> \brief the message for the initial values (cell size) to the workers
534!> \param tmc_params to send the cell properties
535!> \param m_send the message structure
536!> \author Mandes 07.2013
537! **************************************************************************************************
538 SUBROUTINE read_worker_init_message(tmc_params, m_send)
539 TYPE(tmc_param_type), POINTER :: tmc_params
540 TYPE(message_send), POINTER :: m_send
541
542 INTEGER :: counter
543 LOGICAL :: flag
544
545 cpassert(ASSOCIATED(tmc_params))
546 cpassert(ASSOCIATED(m_send))
547 cpassert(m_send%info(3) .GE. 4)
548
549 IF (.NOT. ASSOCIATED(tmc_params%cell)) ALLOCATE (tmc_params%cell)
550 counter = 1
551 !int array
552 flag = int(m_send%task_int(1)) .EQ. SIZE(tmc_params%cell%perd)
553 cpassert(flag)
554 counter = 1 + m_send%task_int(1) + 1
555 tmc_params%cell%perd = m_send%task_int(2:counter - 1)
556 tmc_params%cell%symmetry_id = m_send%task_int(counter + 1)
557 tmc_params%cell%orthorhombic = .false.
558 IF (m_send%task_int(counter + 2) .EQ. 1) tmc_params%cell%orthorhombic = .true.
559 counter = counter + 3
560 cpassert(counter .EQ. m_send%info(2))
561 cpassert(m_send%task_int(counter) .EQ. message_end_flag)
562
563 !float array with cell vectors
564 counter = 1
565 flag = int(m_send%task_real(counter)) .EQ. SIZE(tmc_params%cell%hmat)
566 cpassert(flag)
567 tmc_params%cell%hmat = &
568 reshape(m_send%task_real(counter + 1:counter + &
569 SIZE(tmc_params%cell%hmat)), (/3, 3/))
570 counter = counter + 1 + int(m_send%task_real(counter))
571
572 cpassert(counter .EQ. m_send%info(3))
573 cpassert(int(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
574
575 END SUBROUTINE read_worker_init_message
576
577! **************************************************************************************************
578!> \brief the message for sending back the initial configuration
579!> \param msg_type the status tag
580!> \param elem the initial tree element with initial coordinates and energy
581!> (using the approximated potential)
582!> \param result_count ...
583!> \param tmc_params to send the cell properties
584!> \param m_send the message structure
585!> \author Mandes 12.2012
586! **************************************************************************************************
587 SUBROUTINE create_start_conf_message(msg_type, elem, result_count, &
588 tmc_params, m_send)
589 INTEGER :: msg_type
590 TYPE(tree_type), POINTER :: elem
591 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: result_count
592 TYPE(tmc_param_type), POINTER :: tmc_params
593 TYPE(message_send), POINTER :: m_send
594
595 INTEGER :: counter, i, msg_size_int, msg_size_real
596
597 cpassert(ASSOCIATED(m_send))
598 cpassert(ASSOCIATED(elem))
599 cpassert(ASSOCIATED(tmc_params))
600 cpassert(ASSOCIATED(tmc_params%atoms))
601 cpassert(.NOT. ALLOCATED(m_send%task_int))
602 cpassert(.NOT. ALLOCATED(m_send%task_real))
603 cpassert(.NOT. ALLOCATED(m_send%task_char))
604
605 counter = 1
606 msg_size_int = 1 + SIZE(tmc_params%cell%perd) + 1 + 1 + 1 + 1 + SIZE(elem%mol) + 1
607 IF (msg_type .EQ. tmc_stat_init_analysis) THEN
608 cpassert(PRESENT(result_count))
609 cpassert(ASSOCIATED(result_count))
610 msg_size_int = msg_size_int + 1 + SIZE(result_count(1:))
611 END IF
612 ALLOCATE (m_send%task_int(msg_size_int))
613 m_send%task_int(counter) = SIZE(tmc_params%cell%perd) ! periodicity of the cell
614 counter = counter + 1 + m_send%task_int(counter)
615 m_send%task_int(2:counter - 1) = tmc_params%cell%perd(:)
616 m_send%task_int(counter) = 1
617 m_send%task_int(counter + 1) = tmc_params%cell%symmetry_id
618 m_send%task_int(counter + 2) = 0
619 IF (tmc_params%cell%orthorhombic) m_send%task_int(counter + 2) = 1
620 counter = counter + 3
621 m_send%task_int(counter) = SIZE(elem%mol)
622 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:)
623 counter = counter + 1 + m_send%task_int(counter)
624 IF (msg_type .EQ. tmc_stat_init_analysis) THEN
625 m_send%task_int(counter) = SIZE(result_count(1:))
626 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = &
627 result_count(1:)
628 counter = counter + 1 + m_send%task_int(counter)
629 END IF
630 m_send%task_int(counter) = message_end_flag
631 cpassert(counter .EQ. SIZE(m_send%task_int))
632
633 counter = 0
634 !float array with pos, cell vectors, atom_mass
635 msg_size_real = 1 + SIZE(elem%pos) + 1 + SIZE(tmc_params%cell%hmat) &
636 + 1 + SIZE(tmc_params%atoms) + 1
637 ALLOCATE (m_send%task_real(msg_size_real))
638 m_send%task_real(1) = real(SIZE(elem%pos), kind=dp) ! positions
639 counter = 2 + int(m_send%task_real(1))
640 m_send%task_real(2:counter - 1) = elem%pos
641 m_send%task_real(counter) = SIZE(tmc_params%cell%hmat) ! cell vectors for cell size
642 m_send%task_real(counter + 1:counter + SIZE(tmc_params%cell%hmat)) = &
643 reshape(tmc_params%cell%hmat(:, :), &
644 (/SIZE(tmc_params%cell%hmat)/))
645 counter = counter + 1 + int(m_send%task_real(counter))
646 m_send%task_real(counter) = SIZE(tmc_params%atoms) ! atom mass
647 DO i = 1, SIZE(tmc_params%atoms)
648 m_send%task_real(counter + i) = tmc_params%atoms(i)%mass
649 END DO
650 counter = counter + 1 + int(m_send%task_real(counter))
651 m_send%task_real(counter) = real(message_end_flag, kind=dp) !message end
652 cpassert(SIZE(m_send%task_real) .EQ. msg_size_real)
653 cpassert(int(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
654
655 END SUBROUTINE create_start_conf_message
656
657! **************************************************************************************************
658!> \brief the message for sending back the initial configuration
659!> \param msg_type the status tag
660!> \param elem the initial tree element with initial coordinates and energy
661!> (using the approximated potential)
662!> \param result_count ...
663!> \param m_send the message structure
664!> \param tmc_params the param struct with necessary values for allocation
665!> \author Mandes 12.2012
666! **************************************************************************************************
667 SUBROUTINE read_start_conf_message(msg_type, elem, result_count, m_send, &
668 tmc_params)
669 INTEGER :: msg_type
670 TYPE(tree_type), POINTER :: elem
671 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: result_count
672 TYPE(message_send), POINTER :: m_send
673 TYPE(tmc_param_type), POINTER :: tmc_params
674
675 INTEGER :: counter, i
676 LOGICAL :: flag
677
678 cpassert(ASSOCIATED(tmc_params))
679 cpassert(.NOT. ASSOCIATED(tmc_params%atoms))
680 cpassert(ASSOCIATED(m_send))
681 cpassert(.NOT. ASSOCIATED(elem))
682 cpassert(m_send%info(3) .GE. 4)
683
684 IF (.NOT. ASSOCIATED(tmc_params%cell)) ALLOCATE (tmc_params%cell)
685 CALL allocate_new_sub_tree_node(tmc_params=tmc_params, next_el=elem, &
686 nr_dim=nint(m_send%task_real(1)))
687 counter = 1
688 !int array
689 flag = int(m_send%task_int(1)) .EQ. SIZE(tmc_params%cell%perd)
690 cpassert(flag)
691 counter = 1 + m_send%task_int(1) + 1
692 tmc_params%cell%perd = m_send%task_int(2:counter - 1)
693 tmc_params%cell%symmetry_id = m_send%task_int(counter + 1)
694 tmc_params%cell%orthorhombic = .false.
695 IF (m_send%task_int(counter + 2) .EQ. 1) tmc_params%cell%orthorhombic = .true.
696 counter = counter + 3
697 elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
698 counter = counter + 1 + m_send%task_int(counter)
699 IF (msg_type .EQ. tmc_stat_init_analysis) THEN
700 cpassert(PRESENT(result_count))
701 cpassert(.NOT. ASSOCIATED(result_count))
702 ALLOCATE (result_count(m_send%task_int(counter)))
703 result_count(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
704 counter = counter + 1 + m_send%task_int(counter)
705 END IF
706 cpassert(counter .EQ. m_send%info(2))
707 cpassert(m_send%task_int(counter) .EQ. message_end_flag)
708
709 counter = 0
710 !float array with pos, cell vectors, atom_mass
711 counter = 2 + int(m_send%task_real(1))
712 elem%pos = m_send%task_real(2:counter - 1)
713 flag = int(m_send%task_real(counter)) .EQ. SIZE(tmc_params%cell%hmat)
714 cpassert(flag)
715 tmc_params%cell%hmat = &
716 reshape(m_send%task_real(counter + 1:counter + &
717 SIZE(tmc_params%cell%hmat)), (/3, 3/))
718 counter = counter + 1 + int(m_send%task_real(counter))
719
720 CALL allocate_tmc_atom_type(atoms=tmc_params%atoms, &
721 nr_atoms=int(m_send%task_real(counter)))
722 DO i = 1, SIZE(tmc_params%atoms)
723 tmc_params%atoms(i)%mass = m_send%task_real(counter + i)
724 END DO
725 counter = counter + 1 + int(m_send%task_real(counter))
726
727 cpassert(counter .EQ. m_send%info(3))
728 cpassert(int(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
729
730 END SUBROUTINE read_start_conf_message
731
732 !============================================================================
733 ! Energy messages
734 !============================================================================
735! **************************************************************************************************
736!> \brief creating message for requesting exact energy of new configuration
737!> \param elem tree element with new coordinates
738!> \param m_send the message structure
739!> \param tmc_params stuct with parameters (global settings)
740!> \author Mandes 12.2012
741! **************************************************************************************************
742 SUBROUTINE create_energy_request_message(elem, m_send, &
743 tmc_params)
744 TYPE(tree_type), POINTER :: elem
745 TYPE(message_send), POINTER :: m_send
746 TYPE(tmc_param_type), POINTER :: tmc_params
747
748 INTEGER :: counter, msg_size_int, msg_size_real
749
750 cpassert(ASSOCIATED(m_send))
751 cpassert(.NOT. ALLOCATED(m_send%task_int))
752 cpassert(.NOT. ALLOCATED(m_send%task_real))
753 cpassert(ASSOCIATED(elem))
754 cpassert(ASSOCIATED(tmc_params))
755
756 counter = 0
757 !first integer array
758 msg_size_int = 1 + 1 + 1 + 1 + 1 ! 1+SIZE(elem%sub_tree_nr) +1+SIZE(elem%nr)
759 ALLOCATE (m_send%task_int(msg_size_int))
760 counter = 1
761 m_send%task_int(counter) = 1 !SIZE(elem%sub_tree_nr)
762 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%sub_tree_nr
763 counter = counter + 1 + m_send%task_int(counter)
764 m_send%task_int(counter) = 1 !SIZE(elem%nr)
765 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%nr
766 counter = counter + 1 + m_send%task_int(counter)
767 m_send%task_int(counter) = message_end_flag
768 cpassert(SIZE(m_send%task_int) .EQ. msg_size_int)
769 cpassert(m_send%task_int(msg_size_int) .EQ. message_end_flag)
770
771 !then float array with pos
772 msg_size_real = 1 + SIZE(elem%pos) + 1
773 IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:))
774 ALLOCATE (m_send%task_real(msg_size_real))
775 m_send%task_real(1) = SIZE(elem%pos)
776 counter = 2 + int(m_send%task_real(1))
777 m_send%task_real(2:counter - 1) = elem%pos
778 IF (tmc_params%pressure .GE. 0.0_dp) THEN
779 m_send%task_real(counter) = SIZE(elem%box_scale)
780 m_send%task_real(counter + 1:counter + int(m_send%task_real(counter))) = elem%box_scale(:)
781 counter = counter + 1 + int(m_send%task_real(counter))
782 END IF
783 m_send%task_real(counter) = real(message_end_flag, kind=dp) !message end
784
785 cpassert(SIZE(m_send%task_real) .EQ. msg_size_real)
786 cpassert(int(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
787 END SUBROUTINE create_energy_request_message
788
789! **************************************************************************************************
790!> \brief reading message for requesting exact energy of new configuration
791!> \param elem tree element with new coordinates
792!> \param m_send the message structure
793!> \param tmc_params stuct with parameters (global settings)
794!> \author Mandes 12.2012
795! **************************************************************************************************
796 SUBROUTINE read_energy_request_message(elem, m_send, tmc_params)
797 TYPE(tree_type), POINTER :: elem
798 TYPE(message_send), POINTER :: m_send
799 TYPE(tmc_param_type), POINTER :: tmc_params
800
801 INTEGER :: counter
802
803 cpassert(ASSOCIATED(m_send))
804 cpassert(m_send%info(3) .GT. 0)
805 cpassert(ASSOCIATED(tmc_params))
806 cpassert(.NOT. ASSOCIATED(elem))
807
808 ! initialize the new sub tree element
809 IF (.NOT. ASSOCIATED(elem)) THEN
810 CALL allocate_new_sub_tree_node(next_el=elem, nr_dim=nint(m_send%task_real(1)), &
811 tmc_params=tmc_params)
812 END IF
813 ! read the integer values
814 cpassert(m_send%info(2) .GT. 0)
815 counter = 1
816 elem%sub_tree_nr = m_send%task_int(counter + 1)
817 counter = counter + 1 + m_send%task_int(counter)
818 elem%nr = m_send%task_int(counter + 1)
819 counter = counter + 1 + m_send%task_int(counter)
820 cpassert(m_send%task_int(counter) .EQ. message_end_flag)
821
822 !float array with pos
823 counter = 0
824 counter = 1 + nint(m_send%task_real(1))
825 elem%pos = m_send%task_real(2:counter)
826 counter = counter + 1
827 IF (tmc_params%pressure .GE. 0.0_dp) THEN
828 elem%box_scale(:) = m_send%task_real(counter + 1:counter + int(m_send%task_real(counter)))
829 counter = counter + 1 + int(m_send%task_real(counter))
830 END IF
831
832 cpassert(counter .EQ. m_send%info(3))
833 cpassert(int(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
834 END SUBROUTINE read_energy_request_message
835
836! **************************************************************************************************
837!> \brief creating message for sending back the exact energy of new conf
838!> \param elem tree element with calculated energy
839!> \param m_send the message structure
840!> \param tmc_params stuct with parameters (global settings)
841!> \author Mandes 12.2012
842! **************************************************************************************************
843 SUBROUTINE create_energy_result_message(elem, m_send, tmc_params)
844 TYPE(tree_type), POINTER :: elem
845 TYPE(message_send), POINTER :: m_send
846 TYPE(tmc_param_type), POINTER :: tmc_params
847
848 INTEGER :: counter, msg_size_int, msg_size_real
849
850 cpassert(ASSOCIATED(m_send))
851 cpassert(.NOT. ALLOCATED(m_send%task_int))
852 cpassert(.NOT. ALLOCATED(m_send%task_real))
853 cpassert(ASSOCIATED(elem))
854 cpassert(ASSOCIATED(tmc_params))
855
856 counter = 0
857 !first integer array
858 msg_size_int = 0
859 ! for checking the tree element mapping, send back the tree numbers
860 IF (debug .GT. 0) THEN
861 msg_size_int = 1 + 1 + 1 + 1 + 1 ! 1+SIZE(elem%sub_tree_nr) +1+SIZE(elem%nr)
862 ALLOCATE (m_send%task_int(msg_size_int))
863 counter = 1
864 m_send%task_int(counter) = 1 !SIZE(elem%sub_tree_nr)
865 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%sub_tree_nr
866 counter = counter + 1 + m_send%task_int(counter)
867 m_send%task_int(counter) = 1 !SIZE(elem%nr)
868 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%nr
869 counter = counter + m_send%task_int(counter) + 1
870 m_send%task_int(counter) = message_end_flag !message end
871 END IF
872
873 !then float array with energy of exact potential
874 msg_size_real = 1 + 1 + 1
875 IF (tmc_params%print_forces) msg_size_real = msg_size_real + 1 + SIZE(elem%frc)
876 IF (tmc_params%print_dipole) msg_size_real = msg_size_real + 1 + SIZE(elem%dipole)
877
878 ALLOCATE (m_send%task_real(msg_size_real))
879 m_send%task_real(1) = 1
880 m_send%task_real(2) = elem%potential
881 counter = 3
882 IF (tmc_params%print_forces) THEN
883 m_send%task_real(counter) = SIZE(elem%frc)
884 m_send%task_real(counter + 1:counter + nint(m_send%task_real(counter))) = elem%frc
885 counter = counter + nint(m_send%task_real(counter)) + 1
886 END IF
887 IF (tmc_params%print_dipole) THEN
888 m_send%task_real(counter) = SIZE(elem%dipole)
889 m_send%task_real(counter + 1:counter + nint(m_send%task_real(counter))) = elem%dipole
890 counter = counter + nint(m_send%task_real(counter)) + 1
891 END IF
892
893 m_send%task_real(counter) = real(message_end_flag, kind=dp) !message end
894
895 cpassert(SIZE(m_send%task_real) .EQ. msg_size_real)
896 cpassert(int(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
897 END SUBROUTINE create_energy_result_message
898
899! **************************************************************************************************
900!> \brief reading message for sending back the exact energy of new conf
901!> \param elem tree element for storing new energy
902!> \param m_send the message structure
903!> \param tmc_params stuct with parameters (global settings)
904!> \author Mandes 12.2012
905! **************************************************************************************************
906 SUBROUTINE read_energy_result_message(elem, m_send, tmc_params)
907 TYPE(tree_type), POINTER :: elem
908 TYPE(message_send), POINTER :: m_send
909 TYPE(tmc_param_type), POINTER :: tmc_params
910
911 INTEGER :: counter
912
913 cpassert(ASSOCIATED(elem))
914 cpassert(ASSOCIATED(m_send))
915 cpassert(m_send%info(3) .GT. 0)
916 cpassert(ASSOCIATED(tmc_params))
917
918 ! read the integer values
919 ! for checking the tree element mapping, check the tree numbers
920 IF (debug .GT. 0) THEN
921 counter = 1
922 IF (elem%sub_tree_nr .NE. m_send%task_int(counter + 1) .OR. &
923 elem%nr .NE. m_send%task_int(counter + 3)) THEN
924 WRITE (*, *) "ERROR: read_energy_result: master got energy result of subtree elem ", &
925 m_send%task_int(counter + 1), m_send%task_int(counter + 3), &
926 " but expect result of subtree elem", elem%sub_tree_nr, elem%nr
927 cpabort("read_energy_result: got energy result from unexpected tree element.")
928 END IF
929 ELSE
930 cpassert(m_send%info(2) .EQ. 0)
931 END IF
932
933 !then float array with energy of exact potential
934 elem%potential = m_send%task_real(2)
935 counter = 3
936 IF (tmc_params%print_forces) THEN
937 elem%frc(:) = m_send%task_real((counter + 1):(counter + nint(m_send%task_real(counter))))
938 counter = counter + 1 + nint(m_send%task_real(counter))
939 END IF
940 IF (tmc_params%print_dipole) THEN
941 elem%dipole(:) = m_send%task_real((counter + 1):(counter + nint(m_send%task_real(counter))))
942 counter = counter + 1 + nint(m_send%task_real(counter))
943 END IF
944
945 cpassert(counter .EQ. m_send%info(3))
946 cpassert(int(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
947 END SUBROUTINE read_energy_result_message
948
949! **************************************************************************************************
950!> \brief create message for sending back the approximate energy of new conf
951!> \param elem tree element with calculated approx energy
952!> \param m_send the message structure
953!> \param tmc_params stuct with parameters (global settings)
954!> \author Mandes 12.2012
955! **************************************************************************************************
956 SUBROUTINE create_approx_energy_result_message(elem, m_send, &
957 tmc_params)
958 TYPE(tree_type), POINTER :: elem
959 TYPE(message_send), POINTER :: m_send
960 TYPE(tmc_param_type), POINTER :: tmc_params
961
962 INTEGER :: counter, msg_size_real
963
964 cpassert(ASSOCIATED(m_send))
965 cpassert(.NOT. ALLOCATED(m_send%task_int))
966 cpassert(.NOT. ALLOCATED(m_send%task_real))
967 cpassert(ASSOCIATED(elem))
968 cpassert(ASSOCIATED(tmc_params))
969
970 counter = 0
971
972 !then float array with energy of exact potential
973 msg_size_real = 1 + 1 + 1
974 IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:))
975
976 ALLOCATE (m_send%task_real(msg_size_real))
977 m_send%task_real(1) = 1
978 m_send%task_real(2) = elem%e_pot_approx
979 counter = 3
980 ! the box size for NpT
981 IF (tmc_params%pressure .GE. 0.0_dp) THEN
982 m_send%task_real(counter) = SIZE(elem%box_scale)
983 m_send%task_real(counter + 1:counter + int(m_send%task_real(counter))) = elem%box_scale(:)
984 counter = counter + 1 + int(m_send%task_real(counter))
985 END IF
986 m_send%task_real(counter) = real(message_end_flag, kind=dp) !message end
987
988 cpassert(SIZE(m_send%task_real) .EQ. msg_size_real)
989 cpassert(int(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
990 END SUBROUTINE create_approx_energy_result_message
991
992! **************************************************************************************************
993!> \brief reading message for sending back the exact energy of new conf
994!> \param elem tree element for storing new energy
995!> \param m_send the message structure
996!> \param tmc_params the param struct with necessary parameters
997!> \author Mandes 12.2012
998! **************************************************************************************************
999 SUBROUTINE read_approx_energy_result(elem, m_send, tmc_params)
1000 TYPE(tree_type), POINTER :: elem
1001 TYPE(message_send), POINTER :: m_send
1002 TYPE(tmc_param_type), POINTER :: tmc_params
1003
1004 INTEGER :: counter
1005
1006 cpassert(ASSOCIATED(elem))
1007 cpassert(ASSOCIATED(m_send))
1008 cpassert(m_send%info(2) .EQ. 0 .AND. m_send%info(3) .GT. 0)
1009 cpassert(ASSOCIATED(tmc_params))
1010
1011 !then float array with energy of exact potential
1012 elem%e_pot_approx = m_send%task_real(2)
1013 counter = 3
1014 IF (tmc_params%pressure .GE. 0.0_dp) THEN
1015 elem%box_scale(:) = m_send%task_real(counter + 1:counter + int(m_send%task_real(counter)))
1016 counter = counter + 1 + int(m_send%task_real(counter))
1017 END IF
1018
1019 cpassert(counter .EQ. m_send%info(3))
1020 cpassert(int(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
1021 END SUBROUTINE read_approx_energy_result
1022
1023 !============================================================================
1024 ! Nested Monte Carlo request messages
1025 !============================================================================
1026! **************************************************************************************************
1027!> \brief creating message for Nested Monte Carlo sampling of new configuration
1028!> \param msg_type the status tag
1029!> \param elem tree element with calculated energy
1030!> \param m_send the message structure
1031!> \param tmc_params stuct with parameters (global settings)
1032!> \author Mandes 12.2012
1033! **************************************************************************************************
1034 SUBROUTINE create_nmc_request_massage(msg_type, elem, m_send, &
1035 tmc_params)
1036 INTEGER :: msg_type
1037 TYPE(tree_type), POINTER :: elem
1038 TYPE(message_send), POINTER :: m_send
1039 TYPE(tmc_param_type), POINTER :: tmc_params
1040
1041 INTEGER :: counter, msg_size_int, msg_size_real
1042
1043 cpassert(ASSOCIATED(m_send))
1044 cpassert(ASSOCIATED(elem))
1045 cpassert(.NOT. ALLOCATED(m_send%task_int))
1046 cpassert(.NOT. ALLOCATED(m_send%task_real))
1047 cpassert(ASSOCIATED(tmc_params))
1048
1049 counter = 0
1050 !first integer array with element status,mol_info, move type, sub tree, element nr, temp index
1051 msg_size_int = 1 + SIZE(elem%elem_stat) + 1 + SIZE(elem%mol) + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1
1052
1053 ALLOCATE (m_send%task_int(msg_size_int))
1054 ! element status
1055 m_send%task_int(1) = SIZE(elem%elem_stat)
1056 counter = 2 + m_send%task_int(1)
1057 m_send%task_int(2:counter - 1) = elem%elem_stat
1058 m_send%task_int(counter) = SIZE(elem%mol)
1059 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:)
1060 counter = counter + 1 + m_send%task_int(counter)
1061 ! element move type
1062 m_send%task_int(counter) = 1
1063 m_send%task_int(counter + 1) = elem%move_type
1064 counter = counter + 2
1065 m_send%task_int(counter) = 1
1066 m_send%task_int(counter + 1) = elem%nr
1067 counter = counter + 2
1068 m_send%task_int(counter) = 1
1069 m_send%task_int(counter + 1) = elem%sub_tree_nr
1070 counter = counter + 2
1071 m_send%task_int(counter) = 1
1072 m_send%task_int(counter + 1) = elem%temp_created
1073 m_send%task_int(counter + 2) = message_end_flag !message end
1074
1075 counter = 0
1076 !then float array with pos, (vel), random number seed, subbox_center
1077 msg_size_real = 1 + SIZE(elem%pos) + 1 + SIZE(elem%rng_seed) + 1 + SIZE(elem%subbox_center(:)) + 1
1078 IF (msg_type .EQ. tmc_stat_md_request .OR. msg_type .EQ. tmc_stat_md_broadcast) &
1079 msg_size_real = msg_size_real + 1 + SIZE(elem%vel) ! the velocities
1080 IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:)) ! box size for NpT
1081
1082 ALLOCATE (m_send%task_real(msg_size_real))
1083 m_send%task_real(1) = SIZE(elem%pos)
1084 counter = 2 + int(m_send%task_real(1))
1085 m_send%task_real(2:counter - 1) = elem%pos
1086 IF (msg_type .EQ. tmc_stat_md_request .OR. msg_type .EQ. tmc_stat_md_broadcast) THEN
1087 m_send%task_real(counter) = SIZE(elem%vel)
1088 m_send%task_real(counter + 1:counter + nint(m_send%task_real(counter))) = elem%vel
1089 counter = counter + 1 + nint(m_send%task_real(counter))
1090 END IF
1091 ! rng seed
1092 m_send%task_real(counter) = SIZE(elem%rng_seed)
1093 m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)) = reshape(elem%rng_seed(:, :, :), (/SIZE(elem%rng_seed)/))
1094 counter = counter + nint(m_send%task_real(counter)) + 1
1095 ! sub box center
1096 m_send%task_real(counter) = SIZE(elem%subbox_center(:))
1097 m_send%task_real(counter + 1:counter + SIZE(elem%subbox_center)) = elem%subbox_center(:)
1098 counter = counter + 1 + nint(m_send%task_real(counter))
1099 ! the box size for NpT
1100 IF (tmc_params%pressure .GE. 0.0_dp) THEN
1101 m_send%task_real(counter) = SIZE(elem%box_scale)
1102 m_send%task_real(counter + 1:counter + int(m_send%task_real(counter))) = elem%box_scale(:)
1103 counter = counter + 1 + int(m_send%task_real(counter))
1104 END IF
1105 m_send%task_real(counter) = message_end_flag !message end
1106
1107 cpassert(SIZE(m_send%task_int) .EQ. msg_size_int)
1108 cpassert(SIZE(m_send%task_real) .EQ. msg_size_real)
1109 cpassert(m_send%task_int(msg_size_int) .EQ. message_end_flag)
1110 cpassert(int(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
1111 END SUBROUTINE create_nmc_request_massage
1112
1113! **************************************************************************************************
1114!> \brief reading message for Nested Monte Carlo sampling of new configuration
1115!> \param msg_type the status tag
1116!> \param elem tree element with new coordinates
1117!> \param m_send the message structure
1118!> \param tmc_params stuct with parameters (global settings)
1119!> \author Mandes 12.2012
1120! **************************************************************************************************
1121 SUBROUTINE read_nmc_request_massage(msg_type, elem, m_send, &
1122 tmc_params)
1123 INTEGER :: msg_type
1124 TYPE(tree_type), POINTER :: elem
1125 TYPE(message_send), POINTER :: m_send
1126 TYPE(tmc_param_type), POINTER :: tmc_params
1127
1128 INTEGER :: counter, num_dim, rnd_seed_size
1129
1130 cpassert(.NOT. ASSOCIATED(elem))
1131 cpassert(ASSOCIATED(m_send))
1132 cpassert(m_send%info(2) .GT. 5 .AND. m_send%info(3) .GT. 8)
1133 cpassert(ASSOCIATED(tmc_params))
1134
1135 counter = 0
1136 !first integer array with number of dimensions and random seed size
1137 rnd_seed_size = m_send%task_int(1 + m_send%task_int(1) + 1)
1138
1139 IF (.NOT. ASSOCIATED(elem)) THEN
1140 CALL allocate_new_sub_tree_node(next_el=elem, nr_dim=nint(m_send%task_real(1)), &
1141 tmc_params=tmc_params)
1142 END IF
1143 ! element status
1144 counter = 2 + m_send%task_int(1)
1145 elem%elem_stat = m_send%task_int(2:counter - 1)
1146 elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
1147 counter = counter + 1 + m_send%task_int(counter)
1148 ! element move type
1149 elem%move_type = m_send%task_int(counter + 1)
1150 counter = counter + 2
1151 elem%nr = m_send%task_int(counter + 1)
1152 counter = counter + 2
1153 elem%sub_tree_nr = m_send%task_int(counter + 1)
1154 counter = counter + 2
1155 elem%temp_created = m_send%task_int(counter + 1)
1156 counter = counter + 2
1157 cpassert(counter .EQ. m_send%info(2))
1158
1159 counter = 0
1160 !then float array with pos, (vel), subbox_center and temp
1161 num_dim = nint(m_send%task_real(1))
1162 counter = 2 + int(m_send%task_real(1))
1163 elem%pos = m_send%task_real(2:counter - 1)
1164 IF (msg_type .EQ. tmc_stat_md_request .OR. msg_type .EQ. tmc_stat_md_broadcast) THEN
1165 elem%vel = m_send%task_real(counter + 1:counter + nint(m_send%task_real(counter)))
1166 counter = counter + nint(m_send%task_real(counter)) + 1
1167 END IF
1168 ! rng seed
1169 elem%rng_seed(:, :, :) = reshape(m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)), (/3, 2, 3/))
1170 counter = counter + nint(m_send%task_real(counter)) + 1
1171 ! sub box center
1172 elem%subbox_center(:) = m_send%task_real(counter + 1:counter + int(m_send%task_real(counter)))
1173 counter = counter + 1 + nint(m_send%task_real(counter))
1174
1175 IF (tmc_params%pressure .GE. 0.0_dp) THEN
1176 elem%box_scale(:) = m_send%task_real(counter + 1:counter + int(m_send%task_real(counter)))
1177 counter = counter + 1 + int(m_send%task_real(counter))
1178 ELSE
1179 elem%box_scale(:) = 1.0_dp
1180 END IF
1181
1182 cpassert(counter .EQ. m_send%info(3))
1183 cpassert(m_send%task_int(m_send%info(2)) .EQ. message_end_flag)
1184 cpassert(int(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
1185 END SUBROUTINE read_nmc_request_massage
1186
1187 !============================================================================
1188 ! Nested Monte Carlo RESULT messages
1189 !============================================================================
1190! **************************************************************************************************
1191!> \brief creating message for Nested Monte Carlo sampling result
1192!> \param msg_type the status tag
1193!> \param elem tree element with calculated energy
1194!> \param m_send the message structure
1195!> \param tmc_params environment with move types and sizes
1196!> \author Mandes 12.2012
1197! **************************************************************************************************
1198 SUBROUTINE create_nmc_result_massage(msg_type, elem, m_send, tmc_params)
1199 INTEGER :: msg_type
1200 TYPE(tree_type), POINTER :: elem
1201 TYPE(message_send), POINTER :: m_send
1202 TYPE(tmc_param_type), POINTER :: tmc_params
1203
1204 INTEGER :: counter, msg_size_int, msg_size_real
1205
1206 cpassert(ASSOCIATED(m_send))
1207 cpassert(.NOT. ALLOCATED(m_send%task_int))
1208 cpassert(.NOT. ALLOCATED(m_send%task_real))
1209 cpassert(ASSOCIATED(elem))
1210 cpassert(ASSOCIATED(tmc_params))
1211
1212 !first integer array with status, nmc_acc_counts, subbox_acc_count and (subbox rejectance)
1213 msg_size_int = 1 + SIZE(elem%mol) &
1214 + 1 + SIZE(tmc_params%nmc_move_types%mv_count) &
1215 + 1 + SIZE(tmc_params%nmc_move_types%acc_count) + 1
1216 IF (debug .GT. 0) msg_size_int = msg_size_int + 1 + 1 + 1 + 1
1217 IF (.NOT. any(tmc_params%sub_box_size .LE. 0.1_dp)) &
1218 msg_size_int = msg_size_int + 1 + SIZE(tmc_params%nmc_move_types%subbox_count) &
1219 + 1 + SIZE(tmc_params%nmc_move_types%subbox_acc_count)
1220
1221 ALLOCATE (m_send%task_int(msg_size_int))
1222 counter = 1
1223 IF (debug .GT. 0) THEN
1224 ! send the element number back
1225 m_send%task_int(counter) = 1
1226 m_send%task_int(counter + 1) = elem%sub_tree_nr
1227 counter = counter + 1 + m_send%task_int(counter)
1228 m_send%task_int(counter) = 1
1229 m_send%task_int(counter + 1) = elem%nr
1230 counter = counter + 1 + m_send%task_int(counter)
1231 END IF
1232 ! the molecule information
1233 m_send%task_int(counter) = SIZE(elem%mol)
1234 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:)
1235 counter = counter + 1 + m_send%task_int(counter)
1236 ! the counters for each move type
1237 m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%mv_count)
1238 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = &
1239 reshape(tmc_params%nmc_move_types%mv_count(:, :), &
1240 (/SIZE(tmc_params%nmc_move_types%mv_count)/))
1241 counter = counter + 1 + m_send%task_int(counter)
1242 ! the counter for the accepted moves
1243 m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%acc_count)
1244 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = &
1245 reshape(tmc_params%nmc_move_types%acc_count(:, :), &
1246 (/SIZE(tmc_params%nmc_move_types%acc_count)/))
1247 counter = counter + 1 + m_send%task_int(counter)
1248 ! amount of rejected subbox moves
1249 IF (.NOT. any(tmc_params%sub_box_size .LE. 0.1_dp)) THEN
1250 m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%subbox_count)
1251 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = &
1252 reshape(tmc_params%nmc_move_types%subbox_count(:, :), &
1253 (/SIZE(tmc_params%nmc_move_types%subbox_count)/))
1254 counter = counter + 1 + m_send%task_int(counter)
1255 m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%subbox_acc_count)
1256 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = &
1257 reshape(tmc_params%nmc_move_types%subbox_acc_count(:, :), &
1258 (/SIZE(tmc_params%nmc_move_types%subbox_acc_count)/))
1259 counter = counter + 1 + m_send%task_int(counter)
1260 END IF
1261 m_send%task_int(counter) = message_end_flag ! message end
1262
1263 counter = 0
1264 !then float array with pos,(vel, e_kin_befor_md, ekin),(forces),rng_seed,
1265 ! potential,e_pot_approx,acc_prob,subbox_prob
1266 msg_size_real = 1 + SIZE(elem%pos) & ! pos
1267 + 1 + SIZE(elem%rng_seed) & ! rng_seed
1268 + 1 + 1 & ! potential
1269 + 1 + 1 & ! e_pot_approx
1270 + 1 ! check bit
1271
1272 IF (msg_type .EQ. tmc_stat_md_request .OR. msg_type .EQ. tmc_stat_md_result .OR. &
1273 msg_type .EQ. tmc_stat_md_broadcast) &
1274 msg_size_real = msg_size_real + 1 + SIZE(elem%vel) + 1 + 1 + 1 + 1 ! for MD also: vel, e_kin_befor_md, ekin
1275
1276 ALLOCATE (m_send%task_real(msg_size_real))
1277 ! pos
1278 counter = 1
1279 m_send%task_real(counter) = SIZE(elem%pos)
1280 m_send%task_real(counter + 1:counter + nint(m_send%task_real(counter))) = elem%pos
1281 counter = counter + 1 + nint(m_send%task_real(counter))
1282 ! rng seed
1283 m_send%task_real(counter) = SIZE(elem%rng_seed)
1284 m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)) = &
1285 reshape(elem%rng_seed(:, :, :), (/SIZE(elem%rng_seed)/))
1286 counter = counter + 1 + nint(m_send%task_real(counter))
1287 ! potential
1288 m_send%task_real(counter) = 1
1289 m_send%task_real(counter + 1) = elem%potential
1290 counter = counter + 2
1291 ! approximate potential energy
1292 m_send%task_real(counter) = 1
1293 m_send%task_real(counter + 1) = elem%e_pot_approx
1294 counter = counter + 2
1295 ! for MD also: vel, e_kin_befor_md, ekin
1296 IF (msg_type .EQ. tmc_stat_md_request .OR. msg_type .EQ. tmc_stat_md_result .OR. &
1297 msg_type .EQ. tmc_stat_md_broadcast) THEN
1298 m_send%task_real(counter) = SIZE(elem%vel)
1299 m_send%task_real(counter + 1:counter + nint(m_send%task_real(counter))) = elem%vel
1300 counter = counter + 1 + int(m_send%task_real(counter))
1301 m_send%task_real(counter) = 1
1302 m_send%task_real(counter + 1) = elem%ekin_before_md
1303 counter = counter + 2
1304 m_send%task_real(counter) = 1
1305 m_send%task_real(counter + 1) = elem%ekin
1306 counter = counter + 2
1307 END IF
1308 m_send%task_real(counter) = message_end_flag ! message end
1309
1310 cpassert(SIZE(m_send%task_int) .EQ. msg_size_int)
1311 cpassert(SIZE(m_send%task_real) .EQ. msg_size_real)
1312 cpassert(m_send%task_int(msg_size_int) .EQ. message_end_flag)
1313 cpassert(int(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
1314 END SUBROUTINE create_nmc_result_massage
1315
1316! **************************************************************************************************
1317!> \brief reading message for Nested Monte Carlo sampling result
1318!> \param msg_type the status tag
1319!> \param elem tree element with calculated energy
1320!> \param m_send the message structure
1321!> \param tmc_params environment with move types and sizes
1322!> \author Mandes 12.2012
1323! **************************************************************************************************
1324 SUBROUTINE read_nmc_result_massage(msg_type, elem, m_send, tmc_params)
1325 INTEGER :: msg_type
1326 TYPE(tree_type), POINTER :: elem
1327 TYPE(message_send), POINTER :: m_send
1328 TYPE(tmc_param_type), POINTER :: tmc_params
1329
1330 INTEGER :: counter
1331 INTEGER, DIMENSION(:, :), POINTER :: acc_counter, mv_counter, &
1332 subbox_acc_counter, subbox_counter
1333
1334 NULLIFY (mv_counter, subbox_counter, acc_counter, subbox_acc_counter)
1335
1336 cpassert(ASSOCIATED(elem))
1337 cpassert(ASSOCIATED(m_send))
1338 cpassert(m_send%info(2) .GT. 0 .AND. m_send%info(3) .GT. 0)
1339 cpassert(ASSOCIATED(tmc_params))
1340
1341 !first integer array with element status, random number seed, and move type
1342 counter = 1
1343 IF (debug .GT. 0) THEN
1344 IF ((m_send%task_int(counter + 1) .NE. elem%sub_tree_nr) .AND. (m_send%task_int(counter + 3) .NE. elem%nr)) THEN
1345 cpabort("read_NMC_result_massage: got result of wrong element")
1346 END IF
1347 counter = counter + 2 + 2
1348 END IF
1349 ! the molecule information
1350 elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
1351 counter = counter + 1 + m_send%task_int(counter)
1352 ! the counters for each move type
1353 ALLOCATE (mv_counter(0:SIZE(tmc_params%nmc_move_types%mv_count(:, 1)) - 1, &
1354 SIZE(tmc_params%nmc_move_types%mv_count(1, :))))
1355 mv_counter(:, :) = reshape(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), &
1356 (/SIZE(tmc_params%nmc_move_types%mv_count(:, 1)), &
1357 SIZE(tmc_params%nmc_move_types%mv_count(1, :))/))
1358 counter = counter + 1 + m_send%task_int(counter)
1359 ! the counter for the accepted moves
1360 ALLOCATE (acc_counter(0:SIZE(tmc_params%nmc_move_types%acc_count(:, 1)) - 1, &
1361 SIZE(tmc_params%nmc_move_types%acc_count(1, :))))
1362 acc_counter(:, :) = reshape(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), &
1363 (/SIZE(tmc_params%nmc_move_types%acc_count(:, 1)), &
1364 SIZE(tmc_params%nmc_move_types%acc_count(1, :))/))
1365 counter = counter + 1 + m_send%task_int(counter)
1366 ! amount of rejected subbox moves
1367 IF (.NOT. any(tmc_params%sub_box_size .LE. 0.1_dp)) THEN
1368 ALLOCATE (subbox_counter(SIZE(tmc_params%nmc_move_types%subbox_count(:, 1)), &
1369 SIZE(tmc_params%nmc_move_types%subbox_count(1, :))))
1370 subbox_counter(:, :) = reshape(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), &
1371 (/SIZE(tmc_params%nmc_move_types%subbox_count(:, 1)), &
1372 SIZE(tmc_params%nmc_move_types%subbox_count(1, :))/))
1373 counter = counter + 1 + m_send%task_int(counter)
1374 ALLOCATE (subbox_acc_counter(SIZE(tmc_params%nmc_move_types%subbox_acc_count(:, 1)), &
1375 SIZE(tmc_params%nmc_move_types%subbox_acc_count(1, :))))
1376 subbox_acc_counter(:, :) = reshape(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), &
1377 (/SIZE(tmc_params%nmc_move_types%subbox_acc_count(:, 1)), &
1378 SIZE(tmc_params%nmc_move_types%subbox_acc_count(1, :))/))
1379 counter = counter + 1 + m_send%task_int(counter)
1380 END IF
1381 cpassert(counter .EQ. m_send%info(2))
1382
1383 counter = 0
1384 !then float array with pos, (vel, e_kin_befor_md, ekin), (forces), rng_seed, potential, e_pot_approx
1385 counter = 1
1386 ! pos
1387 elem%pos = m_send%task_real(counter + 1:counter + nint(m_send%task_real(counter)))
1388 counter = counter + 1 + nint(m_send%task_real(counter))
1389 ! rng seed
1390 elem%rng_seed(:, :, :) = reshape(m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)), (/3, 2, 3/))
1391 counter = counter + 1 + nint(m_send%task_real(counter))
1392 ! potential
1393 elem%potential = m_send%task_real(counter + 1)
1394 counter = counter + 2
1395 ! approximate potential energy
1396 elem%e_pot_approx = m_send%task_real(counter + 1)
1397 counter = counter + 2
1398 ! for MD also: vel, e_kin_befor_md, ekin
1399 IF (msg_type .EQ. tmc_stat_md_request .OR. msg_type .EQ. tmc_stat_md_result .OR. &
1400 msg_type .EQ. tmc_stat_md_broadcast) THEN
1401 elem%vel = m_send%task_real(counter + 1:counter + nint(m_send%task_real(counter)))
1402 counter = counter + 1 + int(m_send%task_real(counter))
1403 IF (.NOT. (tmc_params%task_type .EQ. task_type_gaussian_adaptation)) &
1404 elem%ekin_before_md = m_send%task_real(counter + 1)
1405 counter = counter + 2
1406 elem%ekin = m_send%task_real(counter + 1)
1407 counter = counter + 2
1408 END IF
1409
1410 CALL add_mv_prob(move_types=tmc_params%nmc_move_types, prob_opt=tmc_params%esimate_acc_prob, &
1411 mv_counter=mv_counter, acc_counter=acc_counter)
1412 IF (.NOT. any(tmc_params%sub_box_size .LE. 0.1_dp)) THEN
1413 CALL add_mv_prob(move_types=tmc_params%nmc_move_types, prob_opt=tmc_params%esimate_acc_prob, &
1414 subbox_counter=subbox_counter, subbox_acc_counter=subbox_acc_counter)
1415 END IF
1416
1417 DEALLOCATE (mv_counter, acc_counter)
1418 IF (.NOT. any(tmc_params%sub_box_size .LE. 0.1_dp)) &
1419 DEALLOCATE (subbox_counter, subbox_acc_counter)
1420 cpassert(counter .EQ. m_send%info(3))
1421 cpassert(m_send%task_int(m_send%info(2)) .EQ. message_end_flag)
1422 cpassert(int(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
1423 END SUBROUTINE read_nmc_result_massage
1424
1425 !============================================================================
1426 ! Analysis element messages
1427 !============================================================================
1428! **************************************************************************************************
1429!> \brief creating message for requesting analysing a new configuration
1430!> we plot temperatur index into the sub tree number and
1431!> the Markov chain number into the element number
1432!> \param list_elem ...
1433!> \param m_send the message structure
1434!> \param tmc_params stuct with parameters (global settings)
1435!> \author Mandes 12.2012
1436! **************************************************************************************************
1437 SUBROUTINE create_analysis_request_message(list_elem, m_send, &
1438 tmc_params)
1439 TYPE(elem_list_type), POINTER :: list_elem
1440 TYPE(message_send), POINTER :: m_send
1441 TYPE(tmc_param_type), POINTER :: tmc_params
1442
1443 INTEGER :: counter, msg_size_int, msg_size_real
1444
1445 cpassert(ASSOCIATED(m_send))
1446 cpassert(.NOT. ALLOCATED(m_send%task_int))
1447 cpassert(.NOT. ALLOCATED(m_send%task_real))
1448 cpassert(ASSOCIATED(list_elem))
1449 cpassert(ASSOCIATED(tmc_params))
1450
1451 counter = 0
1452 !first integer array
1453 msg_size_int = 1 + 1 + 1 + 1 + 1 ! 1+SIZE(list_elem%elem%sub_tree_nr) +1+SIZE(list_elem%elem%nr)
1454 ALLOCATE (m_send%task_int(msg_size_int))
1455 counter = 1
1456 m_send%task_int(counter) = 1 ! temperature index
1457 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = list_elem%temp_ind
1458 counter = counter + 1 + m_send%task_int(counter)
1459 m_send%task_int(counter) = 1 ! Markov chain number
1460 m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = list_elem%nr
1461 counter = counter + 1 + m_send%task_int(counter)
1462 m_send%task_int(counter) = message_end_flag
1463 cpassert(SIZE(m_send%task_int) .EQ. msg_size_int)
1464 cpassert(m_send%task_int(msg_size_int) .EQ. message_end_flag)
1465
1466 !then float array with pos
1467 msg_size_real = 1 + SIZE(list_elem%elem%pos) + 1
1468 IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(list_elem%elem%box_scale(:))
1469 ALLOCATE (m_send%task_real(msg_size_real))
1470 m_send%task_real(1) = SIZE(list_elem%elem%pos)
1471 counter = 2 + int(m_send%task_real(1))
1472 m_send%task_real(2:counter - 1) = list_elem%elem%pos
1473 IF (tmc_params%pressure .GE. 0.0_dp) THEN
1474 m_send%task_real(counter) = SIZE(list_elem%elem%box_scale)
1475 m_send%task_real(counter + 1:counter + int(m_send%task_real(counter))) = list_elem%elem%box_scale(:)
1476 counter = counter + 1 + int(m_send%task_real(counter))
1477 END IF
1478 m_send%task_real(counter) = real(message_end_flag, kind=dp) !message end
1479
1480 cpassert(SIZE(m_send%task_real) .EQ. msg_size_real)
1481 cpassert(int(m_send%task_real(msg_size_real)) .EQ. message_end_flag)
1482 END SUBROUTINE create_analysis_request_message
1483
1484! **************************************************************************************************
1485!> \brief reading message for requesting exact energy of new configuration
1486!> \param elem tree element with new coordinates
1487!> \param m_send the message structure
1488!> \param tmc_params stuct with parameters (global settings)
1489!> \author Mandes 12.2012
1490! **************************************************************************************************
1491 SUBROUTINE read_analysis_request_message(elem, m_send, tmc_params)
1492 TYPE(tree_type), POINTER :: elem
1493 TYPE(message_send), POINTER :: m_send
1494 TYPE(tmc_param_type), POINTER :: tmc_params
1495
1496 INTEGER :: counter
1497
1498 cpassert(ASSOCIATED(m_send))
1499 cpassert(m_send%info(3) .GT. 0)
1500 cpassert(ASSOCIATED(tmc_params))
1501 cpassert(.NOT. ASSOCIATED(elem))
1502
1503 ! initialize the new sub tree element
1504 IF (.NOT. ASSOCIATED(elem)) THEN
1505 CALL allocate_new_sub_tree_node(next_el=elem, nr_dim=nint(m_send%task_real(1)), &
1506 tmc_params=tmc_params)
1507 END IF
1508 ! read the integer values
1509 cpassert(m_send%info(2) .GT. 0)
1510 counter = 1
1511 elem%sub_tree_nr = m_send%task_int(counter + 1)
1512 counter = counter + 1 + m_send%task_int(counter)
1513 elem%nr = m_send%task_int(counter + 1)
1514 counter = counter + 1 + m_send%task_int(counter)
1515 cpassert(m_send%task_int(counter) .EQ. message_end_flag)
1516
1517 !float array with pos
1518 counter = 0
1519 counter = 1 + nint(m_send%task_real(1))
1520 elem%pos = m_send%task_real(2:counter)
1521 counter = counter + 1
1522 IF (tmc_params%pressure .GE. 0.0_dp) THEN
1523 elem%box_scale(:) = m_send%task_real(counter + 1:counter + int(m_send%task_real(counter)))
1524 counter = counter + 1 + int(m_send%task_real(counter))
1525 END IF
1526
1527 cpassert(counter .EQ. m_send%info(3))
1528 cpassert(int(m_send%task_real(m_send%info(3))) .EQ. message_end_flag)
1529 END SUBROUTINE read_analysis_request_message
1530
1531 !============================================================================
1532 ! SCF step energies (receiving from CP2K)
1533 !============================================================================
1534! **************************************************************************************************
1535!> \brief routine cancel the other group participants
1536!> \param elem tree element with approximated energy
1537!> \param m_send the message structure
1538!> \author Mandes 12.2012
1539! **************************************************************************************************
1540 SUBROUTINE read_scf_step_ener(elem, m_send)
1541 TYPE(tree_type), POINTER :: elem
1542 TYPE(message_send), POINTER :: m_send
1543
1544 cpassert(ASSOCIATED(elem))
1545 cpassert(ASSOCIATED(m_send))
1546
1547 elem%scf_energies(mod(elem%scf_energies_count, 4) + 1) = m_send%task_real(1)
1548 elem%scf_energies_count = elem%scf_energies_count + 1
1549
1550 END SUBROUTINE read_scf_step_ener
1551
1552! **************************************************************************************************
1553!> \brief routines send atom names to the global master
1554!> (using broadcast in a specialized group consisting of the master
1555!> and the first energy worker master)
1556!> \param atoms ...
1557!> \param source ...
1558!> \param para_env the communicator environment
1559!> \author Mandes 12.2012
1560! **************************************************************************************************
1561 SUBROUTINE communicate_atom_types(atoms, source, para_env)
1562 TYPE(tmc_atom_type), DIMENSION(:), POINTER :: atoms
1563 INTEGER :: source
1564 TYPE(mp_para_env_type), POINTER :: para_env
1565
1566 CHARACTER(LEN=default_string_length), &
1567 ALLOCATABLE, DIMENSION(:) :: msg(:)
1568 INTEGER :: i
1569
1570 cpassert(ASSOCIATED(para_env))
1571 cpassert(source .GE. 0)
1572 cpassert(source .LT. para_env%num_pe)
1573
1574 ALLOCATE (msg(SIZE(atoms)))
1575 IF (para_env%mepos .EQ. source) THEN
1576 DO i = 1, SIZE(atoms)
1577 msg(i) = atoms(i)%name
1578 END DO
1579 CALL para_env%bcast(msg, source)
1580 ELSE
1581 CALL para_env%bcast(msg, source)
1582 DO i = 1, SIZE(atoms)
1583 atoms(i)%name = msg(i)
1584 END DO
1585 END IF
1586 DEALLOCATE (msg)
1587 END SUBROUTINE communicate_atom_types
1588
1589! **************************************************************************************************
1590!> \brief send stop command to all group participants
1591!> \param para_env ...
1592!> \param worker_info ...
1593!> \param tmc_params ...
1594!> \param
1595!> \param
1596!> \author Mandes 01.2013
1597! **************************************************************************************************
1598 SUBROUTINE stop_whole_group(para_env, worker_info, tmc_params)
1599 TYPE(mp_para_env_type), POINTER :: para_env
1600 TYPE(elem_array_type), DIMENSION(:), OPTIONAL, &
1601 POINTER :: worker_info
1602 TYPE(tmc_param_type), POINTER :: tmc_params
1603
1604 INTEGER :: act_rank, dest_rank, stat
1605 LOGICAL :: flag
1606 LOGICAL, ALLOCATABLE, DIMENSION(:) :: rank_stoped
1607
1608! INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status_single
1609
1610 cpassert(ASSOCIATED(para_env))
1611 cpassert(ASSOCIATED(tmc_params))
1612
1613 ALLOCATE (rank_stoped(0:para_env%num_pe - 1))
1614 rank_stoped(:) = .false.
1615 rank_stoped(para_env%mepos) = .true.
1616
1617 ! global master
1618 IF (PRESENT(worker_info)) THEN
1619 cpassert(ASSOCIATED(worker_info))
1620 ! canceling running jobs and stop workers
1621 worker_group_loop: DO dest_rank = 1, para_env%num_pe - 1
1622 ! busy workers have to be canceled
1623 IF (worker_info(dest_rank)%busy) THEN
1624 stat = tmc_canceling_message
1625 act_rank = dest_rank
1626 CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=act_rank, &
1627 para_env=para_env, tmc_params=tmc_params)
1628 ELSE
1629 ! send stop message
1630 stat = tmc_status_failed
1631 act_rank = dest_rank
1632 CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=act_rank, &
1633 para_env=para_env, tmc_params=tmc_params)
1634 END IF
1635 END DO worker_group_loop
1636 ELSE
1637 ! group master send stop message to all participants
1638 stat = tmc_status_failed
1639 CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=bcast_group, &
1640 para_env=para_env, tmc_params=tmc_params)
1641 END IF
1642
1643 ! receive stop message receipt
1644 IF (para_env%mepos .EQ. master_comm_id) THEN
1645 wait_for_receipts: DO
1646 ! check incomming messages
1647 stat = tmc_status_wait_for_new_task
1648 dest_rank = 999
1649 IF (PRESENT(worker_info)) THEN
1650 ! mast have to be able to receive results, if canceling was too late
1651 CALL tmc_message(msg_type=stat, send_recv=recv_msg, dest=dest_rank, &
1652 para_env=para_env, tmc_params=tmc_params, &
1653 elem_array=worker_info(:), success=flag)
1654 ELSE
1655 CALL tmc_message(msg_type=stat, send_recv=recv_msg, dest=dest_rank, &
1656 para_env=para_env, tmc_params=tmc_params)
1657 END IF
1658 SELECT CASE (stat)
1659 CASE (tmc_status_wait_for_new_task)
1660 ! no message received
1661 CASE (tmc_canceling_receipt)
1662 IF (PRESENT(worker_info)) THEN
1663 worker_info(dest_rank)%busy = .false.
1664 stat = tmc_status_failed
1665 ! send stop message
1666 CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=dest_rank, &
1667 para_env=para_env, tmc_params=tmc_params)
1668 ELSE
1669 cpabort("group master should not receive cancel receipt")
1670 END IF
1671 CASE (tmc_status_stop_receipt)
1672 rank_stoped(dest_rank) = .true.
1673 CASE (tmc_stat_energy_result, tmc_stat_nmc_result, tmc_stat_md_result, &
1674 tmc_stat_scf_step_ener_receive, tmc_stat_approx_energy_result, tmc_stat_analysis_result)
1675 ! nothing to do, canceling message already sent
1676 CASE DEFAULT
1677 CALL cp_abort(__location__, &
1678 "master received status "//cp_to_string(stat)// &
1679 " while stopping workers")
1680 END SELECT
1681 IF (all(rank_stoped)) EXIT wait_for_receipts
1682 END DO wait_for_receipts
1683 ELSE
1684 cpabort("only (group) master should stop other participants")
1685 END IF
1686 END SUBROUTINE stop_whole_group
1687
1688END MODULE tmc_messages
cp_log_handling::cp_to_string
Definition cp_log_handling.F:90
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
message_passing::mp_any_tag
integer, parameter, public mp_any_tag
Definition message_passing.F:144
message_passing::mp_any_source
integer, parameter, public mp_any_source
Definition message_passing.F:145
tmc_messages
set up the different message for different tasks A TMC message consists of 3 parts (messages) 1: firs...
Definition tmc_messages.F:19
tmc_messages::tmc_message
subroutine, public tmc_message(msg_type, send_recv, dest, para_env, tmc_params, elem, elem_array, list_elem, result_count, wait_for_message, success)
tmc message handling, packing messages with integer and real data type. Send first info message with ...
Definition tmc_messages.F:116
tmc_messages::communicate_atom_types
subroutine, public communicate_atom_types(atoms, source, para_env)
routines send atom names to the global master (using broadcast in a specialized group consisting of t...
Definition tmc_messages.F:1562
tmc_messages::bcast_group
integer, parameter, public bcast_group
Definition tmc_messages.F:64
tmc_messages::check_if_group_master
logical function, public check_if_group_master(para_env)
checks if the core is the group master
Definition tmc_messages.F:85
tmc_messages::master_comm_id
integer, parameter, public master_comm_id
Definition tmc_messages.F:63
tmc_messages::stop_whole_group
subroutine, public stop_whole_group(para_env, worker_info, tmc_params)
send stop command to all group participants
Definition tmc_messages.F:1599
tmc_messages::send_msg
logical, parameter, public send_msg
Definition tmc_messages.F:49
tmc_messages::recv_msg
logical, parameter, public recv_msg
Definition tmc_messages.F:50
tmc_move_handle
acceptance ratio handling of the different Monte Carlo Moves types For each move type and each temper...
Definition tmc_move_handle.F:27
tmc_move_handle::add_mv_prob
subroutine, public add_mv_prob(move_types, prob_opt, mv_counter, acc_counter, subbox_counter, subbox_acc_counter)
add the actual moves to the average probabilities
Definition tmc_move_handle.F:816
tmc_stati
tree nodes creation, searching, deallocation, references etc.
Definition tmc_stati.F:15
tmc_stati::tmc_stat_md_broadcast
integer, parameter, public tmc_stat_md_broadcast
Definition tmc_stati.F:83
tmc_stati::tmc_status_calculating
integer, parameter, public tmc_status_calculating
Definition tmc_stati.F:56
tmc_stati::tmc_status_failed
integer, parameter, public tmc_status_failed
Definition tmc_stati.F:57
tmc_stati::tmc_stat_analysis_request
integer, parameter, public tmc_stat_analysis_request
Definition tmc_stati.F:88
tmc_stati::task_type_gaussian_adaptation
integer, parameter, public task_type_gaussian_adaptation
Definition tmc_stati.F:47
tmc_stati::tmc_status_worker_init
integer, parameter, public tmc_status_worker_init
Definition tmc_stati.F:54
tmc_stati::tmc_stat_md_result
integer, parameter, public tmc_stat_md_result
Definition tmc_stati.F:82
tmc_stati::tmc_stat_md_request
integer, parameter, public tmc_stat_md_request
Definition tmc_stati.F:81
tmc_stati::tmc_stat_nmc_broadcast
integer, parameter, public tmc_stat_nmc_broadcast
Definition tmc_stati.F:79
tmc_stati::tmc_stat_approx_energy_result
integer, parameter, public tmc_stat_approx_energy_result
Definition tmc_stati.F:69
tmc_stati::tmc_stat_start_conf_result
integer, parameter, public tmc_stat_start_conf_result
Definition tmc_stati.F:72
tmc_stati::tmc_status_wait_for_new_task
integer, parameter, public tmc_status_wait_for_new_task
Definition tmc_stati.F:52
tmc_stati::tmc_stat_nmc_result
integer, parameter, public tmc_stat_nmc_result
Definition tmc_stati.F:78
tmc_stati::tmc_stat_analysis_result
integer, parameter, public tmc_stat_analysis_result
Definition tmc_stati.F:89
tmc_stati::tmc_stat_init_analysis
integer, parameter, public tmc_stat_init_analysis
Definition tmc_stati.F:87
tmc_stati::tmc_stat_energy_result
integer, parameter, public tmc_stat_energy_result
Definition tmc_stati.F:75
tmc_stati::tmc_stat_scf_step_ener_receive
integer, parameter, public tmc_stat_scf_step_ener_receive
Definition tmc_stati.F:85
tmc_stati::tmc_stat_approx_energy_request
integer, parameter, public tmc_stat_approx_energy_request
Definition tmc_stati.F:68
tmc_stati::tmc_stat_start_conf_request
integer, parameter, public tmc_stat_start_conf_request
Definition tmc_stati.F:71
tmc_stati::tmc_canceling_receipt
integer, parameter, public tmc_canceling_receipt
Definition tmc_stati.F:64
tmc_stati::tmc_stat_energy_request
integer, parameter, public tmc_stat_energy_request
Definition tmc_stati.F:74
tmc_stati::tmc_stat_nmc_request
integer, parameter, public tmc_stat_nmc_request
Definition tmc_stati.F:77
tmc_stati::tmc_status_stop_receipt
integer, parameter, public tmc_status_stop_receipt
Definition tmc_stati.F:58
tmc_stati::tmc_canceling_message
integer, parameter, public tmc_canceling_message
Definition tmc_stati.F:63
tmc_tree_build
tree nodes creation, deallocation, references etc.
Definition tmc_tree_build.F:35
tmc_tree_build::allocate_new_sub_tree_node
subroutine, public allocate_new_sub_tree_node(tmc_params, next_el, nr_dim)
allocates an elements of the subtree element structure
Definition tmc_tree_build.F:160
tmc_tree_types
module handles definition of the tree nodes for the global and the subtrees binary tree parent elemen...
Definition tmc_tree_types.F:32
tmc_types
module handles definition of the tree nodes for the global and the subtrees binary tree parent elemen...
Definition tmc_types.F:32
tmc_types::allocate_tmc_atom_type
subroutine, public allocate_tmc_atom_type(atoms, nr_atoms)
creates a structure for storing the atom informations
Definition tmc_types.F:394
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:763
tmc_tree_types::elem_array_type
Definition tmc_tree_types.F:131
tmc_tree_types::elem_list_type
Definition tmc_tree_types.F:123
tmc_tree_types::tree_type
Definition tmc_tree_types.F:75
tmc_types::tmc_atom_type
Definition tmc_types.F:124
tmc_types::tmc_param_type
Definition tmc_types.F:90