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