(git:e7e05ae)
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 ! **************************************************************************************************
19 MODULE 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 
76 CONTAINS
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 
1688 END MODULE tmc_messages
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