Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief 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 14 : FUNCTION check_if_group_master(para_env) RESULT(master)
85 : TYPE(mp_para_env_type), POINTER :: para_env
86 : LOGICAL :: master
87 :
88 14 : CPASSERT(ASSOCIATED(para_env))
89 :
90 14 : master = .FALSE.
91 14 : IF (para_env%mepos == MASTER_COMM_ID) THEN
92 14 : master = .TRUE.
93 : END IF
94 14 : 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 1582111 : SUBROUTINE tmc_message(msg_type, send_recv, dest, para_env, tmc_params, &
115 1582111 : 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 1582111 : CPASSERT(ASSOCIATED(para_env))
133 1582111 : CPASSERT(ASSOCIATED(tmc_params))
134 :
135 7910555 : ALLOCATE (m_send)
136 :
137 : ! init
138 : ! define send_recv flag for broadcast
139 1582111 : IF (dest == bcast_group) THEN
140 : ! master should always send
141 4560 : 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 1577551 : act_send_recv = send_recv
149 : END IF
150 0 : message_tag = 0
151 :
152 : ! =============================
153 : ! sending message
154 : ! =============================
155 : ! creating message to send
156 1577551 : 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 13617 : 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 195 : CALL create_status_message(m_send)
172 : CASE (TMC_STATUS_WORKER_INIT)
173 28 : CALL create_worker_init_message(tmc_params, m_send)
174 : CASE (TMC_STAT_START_CONF_RESULT, TMC_STAT_INIT_ANALYSIS)
175 14 : 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 8676 : CALL create_energy_request_message(elem, m_send, tmc_params)
178 : CASE (TMC_STAT_APPROX_ENERGY_RESULT)
179 14 : CALL create_approx_energy_result_message(elem, m_send, tmc_params)
180 : CASE (TMC_STAT_ENERGY_RESULT)
181 4324 : 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 114 : CALL create_NMC_request_massage(msg_type, elem, m_send, tmc_params)
185 : CASE (TMC_STAT_MD_RESULT, TMC_STAT_NMC_RESULT)
186 57 : CALL create_NMC_result_massage(msg_type, elem, m_send, tmc_params)
187 : CASE (TMC_STAT_ANALYSIS_REQUEST)
188 0 : CPASSERT(PRESENT(list_elem))
189 0 : CALL create_analysis_request_message(list_elem, m_send, tmc_params)
190 : CASE DEFAULT
191 13422 : CPABORT("try to send unknown message type "//cp_to_string(msg_type))
192 : END SELECT
193 : !set message info
194 13422 : message_tag = msg_type
195 67110 : m_send%info(:) = 0
196 13422 : m_send%info(1) = msg_type
197 13422 : IF (ALLOCATED(m_send%task_int)) m_send%info(2) = SIZE(m_send%task_int)
198 13422 : IF (ALLOCATED(m_send%task_real)) m_send%info(3) = SIZE(m_send%task_real)
199 13422 : IF (ALLOCATED(m_send%task_char)) m_send%info(4) = SIZE(m_send%task_char)
200 : END IF
201 :
202 : ! sending message
203 13422 : IF ((act_send_recv .EQV. send_msg) .AND. (dest /= bcast_group)) THEN
204 8862 : CALL para_env%send(m_send%info, dest, message_tag)
205 8862 : IF (m_send%info(2) > 0) THEN
206 4480 : CALL para_env%send(m_send%task_int, dest, message_tag)
207 : END IF
208 8862 : IF (m_send%info(3) > 0) THEN
209 8818 : CALL para_env%send(m_send%task_real, dest, message_tag)
210 : END IF
211 8862 : IF (m_send%info(4) > 0) THEN
212 0 : 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 8862 : IF (m_send%info(2) > 0) DEALLOCATE (m_send%task_int)
222 8862 : IF (m_send%info(3) > 0) DEALLOCATE (m_send%task_real)
223 8862 : IF (m_send%info(4) > 0) DEALLOCATE (m_send%task_char)
224 8862 : IF (PRESENT(success)) success = .TRUE.
225 : END IF
226 :
227 : ! =============================
228 : ! broadcast
229 : ! =============================
230 1582111 : IF (dest == bcast_group) THEN
231 4560 : IF (para_env%num_pe > 1) THEN
232 0 : CALL para_env%bcast(m_send%info, MASTER_COMM_ID)
233 0 : IF (m_send%info(2) > 0) THEN
234 0 : IF (.NOT. act_send_recv) ALLOCATE (m_send%task_int(m_send%info(2)))
235 0 : CALL para_env%bcast(m_send%task_int, MASTER_COMM_ID)
236 : END IF
237 0 : IF (m_send%info(3) > 0) THEN
238 0 : IF (.NOT. act_send_recv) ALLOCATE (m_send%task_real(m_send%info(3)))
239 0 : CALL para_env%bcast(m_send%task_real, MASTER_COMM_ID)
240 : END IF
241 0 : IF (m_send%info(4) > 0) THEN
242 0 : IF (.NOT. act_send_recv) ALLOCATE (m_send%task_char(m_send%info(3)))
243 0 : 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 4560 : IF (act_send_recv) THEN
249 4560 : IF (m_send%info(2) > 0) DEALLOCATE (m_send%task_int)
250 4560 : IF (m_send%info(3) > 0) DEALLOCATE (m_send%task_real)
251 4560 : IF (m_send%info(4) > 0) DEALLOCATE (m_send%task_char)
252 : END IF
253 : END IF
254 :
255 : ! =============================
256 : ! receiving message
257 : ! =============================
258 1582111 : IF ((act_send_recv .EQV. recv_msg) .AND. dest /= bcast_group) THEN
259 1568689 : flag = .FALSE.
260 1568689 : tmp_tag = TMC_STATUS_WAIT_FOR_NEW_TASK
261 1568689 : IF (PRESENT(wait_for_message)) THEN
262 14 : dest = mp_any_source
263 14 : CALL para_env%probe(dest, tmp_tag)
264 : flag = .TRUE.
265 : ELSE
266 4692711 : participant_loop: DO i = 0, para_env%num_pe - 1
267 4692711 : IF (i /= para_env%mepos) THEN
268 1568647 : dest = i
269 1568647 : CALL para_env%probe(dest, tmp_tag)
270 1568647 : 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 1568675 : IF (flag .EQV. .FALSE.) THEN
278 1559827 : IF (PRESENT(success)) success = .FALSE.
279 1559827 : DEALLOCATE (m_send)
280 1559827 : RETURN
281 : END IF
282 :
283 8862 : IF (tmp_tag == TMC_STAT_SCF_STEP_ENER_RECEIVE) THEN
284 : ! CP2K send back SCF step energies without info message
285 0 : message_tag = TMC_STAT_SCF_STEP_ENER_RECEIVE
286 0 : m_send%info(1) = TMC_STAT_SCF_STEP_ENER_RECEIVE
287 0 : m_send%info(2) = 0 ! no integer values
288 0 : m_send%info(3) = 1 ! one double values (SCF total energy)
289 0 : m_send%info(4) = 0 ! no character values
290 : ELSE
291 8862 : message_tag = mp_any_tag
292 : ! first get message type and sizes
293 8862 : 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 8862 : IF (m_send%info(2) > 0) THEN
302 13440 : ALLOCATE (m_send%task_int(m_send%info(2)))
303 4480 : CALL para_env%recv(m_send%task_int, dest, message_tag)
304 : END IF
305 : !-- receive message double (floatingpoint) part
306 8862 : IF (m_send%info(3) > 0) THEN
307 26454 : ALLOCATE (m_send%task_real(m_send%info(3)))
308 8818 : CALL para_env%recv(m_send%task_real, dest, message_tag)
309 : END IF
310 : !-- receive message character part
311 8862 : IF (m_send%info(4) > 0) THEN
312 0 : ALLOCATE (m_send%task_char(m_send%info(4)))
313 0 : 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 8862 : 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 8862 : IF (PRESENT(elem_array)) THEN
323 4410 : IF (elem_array(dest)%canceled .AND. m_send%info(1) /= TMC_CANCELING_RECEIPT) THEN
324 0 : msg_type = m_send%info(1)
325 0 : IF (m_send%info(2) > 0) DEALLOCATE (m_send%task_int)
326 0 : IF (m_send%info(3) > 0) DEALLOCATE (m_send%task_real)
327 0 : IF (m_send%info(4) > 0) DEALLOCATE (m_send%task_char)
328 : ! to check for further messages
329 0 : IF (PRESENT(success)) success = .TRUE.
330 0 : DEALLOCATE (m_send)
331 0 : RETURN
332 : END IF
333 : END IF
334 :
335 8862 : msg_type = m_send%info(1)
336 14 : 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 14 : CALL read_worker_init_message(tmc_params, m_send)
343 : CASE (TMC_STAT_START_CONF_RESULT, TMC_STAT_INIT_ANALYSIS)
344 14 : IF (PRESENT(elem_array)) THEN
345 : CALL read_start_conf_message(msg_type, elem_array(dest)%elem, &
346 0 : result_count, m_send, tmc_params)
347 : ELSE
348 : CALL read_start_conf_message(msg_type, elem, result_count, m_send, &
349 14 : tmc_params)
350 : END IF
351 : CASE (TMC_STAT_APPROX_ENERGY_RESULT)
352 14 : 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 4338 : CALL read_energy_request_message(elem, m_send, tmc_params)
355 : CASE (TMC_STAT_ENERGY_RESULT)
356 4324 : IF (PRESENT(elem_array)) THEN
357 4324 : 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 57 : CALL read_NMC_request_massage(msg_type, elem, m_send, tmc_params)
362 : CASE (TMC_STAT_NMC_RESULT, TMC_STAT_MD_RESULT)
363 57 : IF (PRESENT(elem_array)) THEN
364 57 : 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 0 : CALL read_scf_step_ener(elem_array(dest)%elem, m_send)
370 : CASE (TMC_STAT_ANALYSIS_REQUEST)
371 0 : 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 8862 : "from source "//cp_to_string(dest))
376 : END SELECT
377 8862 : IF (m_send%info(2) > 0) DEALLOCATE (m_send%task_int)
378 8862 : IF (m_send%info(3) > 0) DEALLOCATE (m_send%task_real)
379 8862 : IF (m_send%info(4) > 0) DEALLOCATE (m_send%task_char)
380 8862 : IF (PRESENT(success)) success = .TRUE.
381 : END IF
382 :
383 : ! ATTENTION there is also an short exit (RETURN) after probing for new messages
384 22284 : 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 195 : SUBROUTINE create_status_message(m_send)
394 : TYPE(message_send), POINTER :: m_send
395 :
396 195 : CPASSERT(ASSOCIATED(m_send))
397 :
398 : ! nothing to do, send just the message tag
399 :
400 195 : CPASSERT(.NOT. ALLOCATED(m_send%task_int))
401 195 : CPASSERT(.NOT. ALLOCATED(m_send%task_real))
402 : MARK_USED(m_send)
403 :
404 195 : 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 28 : 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 28 : CPASSERT(ASSOCIATED(tmc_params))
503 28 : CPASSERT(ASSOCIATED(m_send))
504 28 : CPASSERT(.NOT. ALLOCATED(m_send%task_int))
505 28 : CPASSERT(.NOT. ALLOCATED(m_send%task_real))
506 28 : CPASSERT(.NOT. ALLOCATED(m_send%task_char))
507 28 : CPASSERT(ASSOCIATED(tmc_params%cell))
508 :
509 28 : counter = 1
510 28 : msg_size_int = 1 + SIZE(tmc_params%cell%perd) + 1 + 1 + 1 + 1
511 28 : ALLOCATE (m_send%task_int(msg_size_int))
512 28 : m_send%task_int(counter) = SIZE(tmc_params%cell%perd) ! periodicity of the cell
513 28 : counter = counter + 1 + m_send%task_int(counter)
514 224 : m_send%task_int(2:counter - 1) = tmc_params%cell%perd(:)
515 28 : m_send%task_int(counter) = 1
516 28 : m_send%task_int(counter + 1) = tmc_params%cell%symmetry_id
517 28 : m_send%task_int(counter + 2) = 0
518 28 : IF (tmc_params%cell%orthorhombic) m_send%task_int(counter + 2) = 1
519 28 : counter = counter + 3
520 28 : m_send%task_int(counter) = message_end_flag
521 28 : CPASSERT(counter == SIZE(m_send%task_int))
522 :
523 : !float array with cell vectors
524 28 : msg_size_real = 1 + SIZE(tmc_params%cell%hmat) + 1
525 28 : ALLOCATE (m_send%task_real(msg_size_real))
526 28 : counter = 1
527 28 : 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 280 : [SIZE(tmc_params%cell%hmat)])
531 28 : counter = counter + 1 + INT(m_send%task_real(counter))
532 28 : m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
533 28 : CPASSERT(SIZE(m_send%task_real) == msg_size_real)
534 28 : CPASSERT(INT(m_send%task_real(msg_size_real)) == message_end_flag)
535 28 : 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 14 : 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 14 : CPASSERT(ASSOCIATED(tmc_params))
551 14 : CPASSERT(ASSOCIATED(m_send))
552 14 : CPASSERT(m_send%info(3) >= 4)
553 :
554 14 : IF (.NOT. ASSOCIATED(tmc_params%cell)) ALLOCATE (tmc_params%cell)
555 14 : counter = 1
556 : !int array
557 14 : flag = INT(m_send%task_int(1)) == SIZE(tmc_params%cell%perd)
558 14 : CPASSERT(flag)
559 14 : counter = 1 + m_send%task_int(1) + 1
560 112 : tmc_params%cell%perd = m_send%task_int(2:counter - 1)
561 14 : tmc_params%cell%symmetry_id = m_send%task_int(counter + 1)
562 14 : tmc_params%cell%orthorhombic = .FALSE.
563 14 : IF (m_send%task_int(counter + 2) == 1) tmc_params%cell%orthorhombic = .TRUE.
564 14 : counter = counter + 3
565 14 : CPASSERT(counter == m_send%info(2))
566 14 : CPASSERT(m_send%task_int(counter) == message_end_flag)
567 :
568 : !float array with cell vectors
569 14 : counter = 1
570 14 : flag = INT(m_send%task_real(counter)) == SIZE(tmc_params%cell%hmat)
571 14 : CPASSERT(flag)
572 : tmc_params%cell%hmat = &
573 : RESHAPE(m_send%task_real(counter + 1:counter + &
574 182 : SIZE(tmc_params%cell%hmat)), [3, 3])
575 14 : counter = counter + 1 + INT(m_send%task_real(counter))
576 :
577 14 : CPASSERT(counter == m_send%info(3))
578 14 : CPASSERT(INT(m_send%task_real(m_send%info(3))) == message_end_flag)
579 :
580 14 : 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 14 : 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 14 : CPASSERT(ASSOCIATED(m_send))
603 14 : CPASSERT(ASSOCIATED(elem))
604 14 : CPASSERT(ASSOCIATED(tmc_params))
605 14 : CPASSERT(ASSOCIATED(tmc_params%atoms))
606 14 : CPASSERT(.NOT. ALLOCATED(m_send%task_int))
607 14 : CPASSERT(.NOT. ALLOCATED(m_send%task_real))
608 14 : CPASSERT(.NOT. ALLOCATED(m_send%task_char))
609 :
610 14 : counter = 1
611 14 : msg_size_int = 1 + SIZE(tmc_params%cell%perd) + 1 + 1 + 1 + 1 + SIZE(elem%mol) + 1
612 14 : IF (msg_type == TMC_STAT_INIT_ANALYSIS) THEN
613 0 : CPASSERT(PRESENT(result_count))
614 0 : CPASSERT(ASSOCIATED(result_count))
615 0 : msg_size_int = msg_size_int + 1 + SIZE(result_count(1:))
616 : END IF
617 42 : ALLOCATE (m_send%task_int(msg_size_int))
618 14 : m_send%task_int(counter) = SIZE(tmc_params%cell%perd) ! periodicity of the cell
619 14 : counter = counter + 1 + m_send%task_int(counter)
620 112 : m_send%task_int(2:counter - 1) = tmc_params%cell%perd(:)
621 14 : m_send%task_int(counter) = 1
622 14 : m_send%task_int(counter + 1) = tmc_params%cell%symmetry_id
623 14 : m_send%task_int(counter + 2) = 0
624 14 : IF (tmc_params%cell%orthorhombic) m_send%task_int(counter + 2) = 1
625 14 : counter = counter + 3
626 14 : m_send%task_int(counter) = SIZE(elem%mol)
627 3788 : m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:)
628 14 : counter = counter + 1 + m_send%task_int(counter)
629 14 : IF (msg_type == TMC_STAT_INIT_ANALYSIS) THEN
630 0 : m_send%task_int(counter) = SIZE(result_count(1:))
631 : m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = &
632 0 : result_count(1:)
633 0 : counter = counter + 1 + m_send%task_int(counter)
634 : END IF
635 14 : m_send%task_int(counter) = message_end_flag
636 14 : CPASSERT(counter == SIZE(m_send%task_int))
637 :
638 14 : 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 14 : + 1 + SIZE(tmc_params%atoms) + 1
642 42 : ALLOCATE (m_send%task_real(msg_size_real))
643 14 : m_send%task_real(1) = REAL(SIZE(elem%pos), KIND=dp) ! positions
644 14 : counter = 2 + INT(m_send%task_real(1))
645 11308 : m_send%task_real(2:counter - 1) = elem%pos
646 14 : 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 140 : [SIZE(tmc_params%cell%hmat)])
650 14 : counter = counter + 1 + INT(m_send%task_real(counter))
651 14 : m_send%task_real(counter) = SIZE(tmc_params%atoms) ! atom mass
652 1894 : DO i = 1, SIZE(tmc_params%atoms)
653 1894 : m_send%task_real(counter + i) = tmc_params%atoms(i)%mass
654 : END DO
655 14 : counter = counter + 1 + INT(m_send%task_real(counter))
656 14 : m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
657 14 : CPASSERT(SIZE(m_send%task_real) == msg_size_real)
658 14 : CPASSERT(INT(m_send%task_real(msg_size_real)) == message_end_flag)
659 :
660 14 : 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 14 : 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 14 : CPASSERT(ASSOCIATED(tmc_params))
684 14 : CPASSERT(.NOT. ASSOCIATED(tmc_params%atoms))
685 14 : CPASSERT(ASSOCIATED(m_send))
686 14 : CPASSERT(.NOT. ASSOCIATED(elem))
687 14 : CPASSERT(m_send%info(3) >= 4)
688 :
689 896 : 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 14 : nr_dim=NINT(m_send%task_real(1)))
692 14 : counter = 1
693 : !int array
694 14 : flag = INT(m_send%task_int(1)) == SIZE(tmc_params%cell%perd)
695 14 : CPASSERT(flag)
696 14 : counter = 1 + m_send%task_int(1) + 1
697 98 : tmc_params%cell%perd = m_send%task_int(2:counter - 1)
698 14 : tmc_params%cell%symmetry_id = m_send%task_int(counter + 1)
699 14 : tmc_params%cell%orthorhombic = .FALSE.
700 14 : IF (m_send%task_int(counter + 2) == 1) tmc_params%cell%orthorhombic = .TRUE.
701 14 : counter = counter + 3
702 3774 : elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
703 14 : counter = counter + 1 + m_send%task_int(counter)
704 14 : IF (msg_type == TMC_STAT_INIT_ANALYSIS) THEN
705 0 : CPASSERT(PRESENT(result_count))
706 0 : CPASSERT(.NOT. ASSOCIATED(result_count))
707 0 : ALLOCATE (result_count(m_send%task_int(counter)))
708 0 : result_count(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
709 0 : counter = counter + 1 + m_send%task_int(counter)
710 : END IF
711 14 : CPASSERT(counter == m_send%info(2))
712 14 : CPASSERT(m_send%task_int(counter) == message_end_flag)
713 :
714 14 : counter = 0
715 : !float array with pos, cell vectors, atom_mass
716 14 : counter = 2 + INT(m_send%task_real(1))
717 11294 : elem%pos = m_send%task_real(2:counter - 1)
718 14 : flag = INT(m_send%task_real(counter)) == SIZE(tmc_params%cell%hmat)
719 14 : CPASSERT(flag)
720 : tmc_params%cell%hmat = &
721 : RESHAPE(m_send%task_real(counter + 1:counter + &
722 182 : SIZE(tmc_params%cell%hmat)), [3, 3])
723 14 : counter = counter + 1 + INT(m_send%task_real(counter))
724 :
725 : CALL allocate_tmc_atom_type(atoms=tmc_params%atoms, &
726 14 : nr_atoms=INT(m_send%task_real(counter)))
727 1894 : DO i = 1, SIZE(tmc_params%atoms)
728 1894 : tmc_params%atoms(i)%mass = m_send%task_real(counter + i)
729 : END DO
730 14 : counter = counter + 1 + INT(m_send%task_real(counter))
731 :
732 14 : CPASSERT(counter == m_send%info(3))
733 14 : CPASSERT(INT(m_send%task_real(m_send%info(3))) == message_end_flag)
734 :
735 14 : 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 8676 : 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 8676 : CPASSERT(ASSOCIATED(m_send))
756 8676 : CPASSERT(.NOT. ALLOCATED(m_send%task_int))
757 8676 : CPASSERT(.NOT. ALLOCATED(m_send%task_real))
758 8676 : CPASSERT(ASSOCIATED(elem))
759 8676 : CPASSERT(ASSOCIATED(tmc_params))
760 :
761 8676 : counter = 0
762 : !first integer array
763 8676 : msg_size_int = 1 + 1 + 1 + 1 + 1 ! 1+SIZE(elem%sub_tree_nr) +1+SIZE(elem%nr)
764 8676 : ALLOCATE (m_send%task_int(msg_size_int))
765 8676 : counter = 1
766 8676 : m_send%task_int(counter) = 1 !SIZE(elem%sub_tree_nr)
767 17352 : m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%sub_tree_nr
768 8676 : counter = counter + 1 + m_send%task_int(counter)
769 8676 : m_send%task_int(counter) = 1 !SIZE(elem%nr)
770 17352 : m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%nr
771 8676 : counter = counter + 1 + m_send%task_int(counter)
772 8676 : m_send%task_int(counter) = message_end_flag
773 8676 : CPASSERT(SIZE(m_send%task_int) == msg_size_int)
774 8676 : CPASSERT(m_send%task_int(msg_size_int) == message_end_flag)
775 :
776 : !then float array with pos
777 8676 : msg_size_real = 1 + SIZE(elem%pos) + 1
778 8676 : IF (tmc_params%pressure >= 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:))
779 26028 : ALLOCATE (m_send%task_real(msg_size_real))
780 8676 : m_send%task_real(1) = SIZE(elem%pos)
781 8676 : counter = 2 + INT(m_send%task_real(1))
782 1419876 : m_send%task_real(2:counter - 1) = elem%pos
783 8676 : IF (tmc_params%pressure >= 0.0_dp) THEN
784 1352 : m_send%task_real(counter) = SIZE(elem%box_scale)
785 10816 : m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = elem%box_scale(:)
786 1352 : counter = counter + 1 + INT(m_send%task_real(counter))
787 : END IF
788 8676 : m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
789 :
790 8676 : CPASSERT(SIZE(m_send%task_real) == msg_size_real)
791 8676 : CPASSERT(INT(m_send%task_real(msg_size_real)) == message_end_flag)
792 8676 : 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 4338 : 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 4338 : CPASSERT(ASSOCIATED(m_send))
809 4338 : CPASSERT(m_send%info(3) > 0)
810 4338 : CPASSERT(ASSOCIATED(tmc_params))
811 4338 : CPASSERT(.NOT. ASSOCIATED(elem))
812 :
813 : ! initialize the new sub tree element
814 4338 : IF (.NOT. ASSOCIATED(elem)) THEN
815 : CALL allocate_new_sub_tree_node(next_el=elem, nr_dim=NINT(m_send%task_real(1)), &
816 4338 : tmc_params=tmc_params)
817 : END IF
818 : ! read the integer values
819 4338 : CPASSERT(m_send%info(2) > 0)
820 4338 : counter = 1
821 4338 : elem%sub_tree_nr = m_send%task_int(counter + 1)
822 4338 : counter = counter + 1 + m_send%task_int(counter)
823 4338 : elem%nr = m_send%task_int(counter + 1)
824 4338 : counter = counter + 1 + m_send%task_int(counter)
825 4338 : CPASSERT(m_send%task_int(counter) == message_end_flag)
826 :
827 : !float array with pos
828 4338 : counter = 0
829 4338 : counter = 1 + NINT(m_send%task_real(1))
830 705600 : elem%pos = m_send%task_real(2:counter)
831 4338 : counter = counter + 1
832 4338 : IF (tmc_params%pressure >= 0.0_dp) THEN
833 4732 : elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter)))
834 676 : counter = counter + 1 + INT(m_send%task_real(counter))
835 : END IF
836 :
837 4338 : CPASSERT(counter == m_send%info(3))
838 4338 : CPASSERT(INT(m_send%task_real(m_send%info(3))) == message_end_flag)
839 4338 : 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 4324 : 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 4324 : CPASSERT(ASSOCIATED(m_send))
856 4324 : CPASSERT(.NOT. ALLOCATED(m_send%task_int))
857 4324 : CPASSERT(.NOT. ALLOCATED(m_send%task_real))
858 4324 : CPASSERT(ASSOCIATED(elem))
859 4324 : CPASSERT(ASSOCIATED(tmc_params))
860 :
861 4324 : counter = 0
862 : !first integer array
863 4324 : 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 4324 : msg_size_real = 1 + 1 + 1
880 4324 : IF (tmc_params%print_forces) msg_size_real = msg_size_real + 1 + SIZE(elem%frc)
881 4324 : IF (tmc_params%print_dipole) msg_size_real = msg_size_real + 1 + SIZE(elem%dipole)
882 :
883 12972 : ALLOCATE (m_send%task_real(msg_size_real))
884 4324 : m_send%task_real(1) = 1
885 4324 : m_send%task_real(2) = elem%potential
886 4324 : counter = 3
887 4324 : IF (tmc_params%print_forces) THEN
888 598 : m_send%task_real(counter) = SIZE(elem%frc)
889 75946 : m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%frc
890 598 : counter = counter + NINT(m_send%task_real(counter)) + 1
891 : END IF
892 4324 : IF (tmc_params%print_dipole) THEN
893 0 : m_send%task_real(counter) = SIZE(elem%dipole)
894 0 : m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%dipole
895 0 : counter = counter + NINT(m_send%task_real(counter)) + 1
896 : END IF
897 :
898 4324 : m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
899 :
900 4324 : CPASSERT(SIZE(m_send%task_real) == msg_size_real)
901 4324 : CPASSERT(INT(m_send%task_real(msg_size_real)) == message_end_flag)
902 4324 : 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 4324 : 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 4324 : CPASSERT(ASSOCIATED(elem))
919 4324 : CPASSERT(ASSOCIATED(m_send))
920 4324 : CPASSERT(m_send%info(3) > 0)
921 4324 : 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 4324 : CPASSERT(m_send%info(2) == 0)
936 : END IF
937 :
938 : !then float array with energy of exact potential
939 4324 : elem%potential = m_send%task_real(2)
940 4324 : counter = 3
941 4324 : IF (tmc_params%print_forces) THEN
942 75946 : elem%frc(:) = m_send%task_real((counter + 1):(counter + NINT(m_send%task_real(counter))))
943 598 : counter = counter + 1 + NINT(m_send%task_real(counter))
944 : END IF
945 4324 : IF (tmc_params%print_dipole) THEN
946 0 : elem%dipole(:) = m_send%task_real((counter + 1):(counter + NINT(m_send%task_real(counter))))
947 0 : counter = counter + 1 + NINT(m_send%task_real(counter))
948 : END IF
949 :
950 4324 : CPASSERT(counter == m_send%info(3))
951 4324 : CPASSERT(INT(m_send%task_real(m_send%info(3))) == message_end_flag)
952 4324 : 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 14 : 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 14 : CPASSERT(ASSOCIATED(m_send))
970 14 : CPASSERT(.NOT. ALLOCATED(m_send%task_int))
971 14 : CPASSERT(.NOT. ALLOCATED(m_send%task_real))
972 14 : CPASSERT(ASSOCIATED(elem))
973 14 : CPASSERT(ASSOCIATED(tmc_params))
974 :
975 14 : counter = 0
976 :
977 : !then float array with energy of exact potential
978 14 : msg_size_real = 1 + 1 + 1
979 14 : IF (tmc_params%pressure >= 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:))
980 :
981 42 : ALLOCATE (m_send%task_real(msg_size_real))
982 14 : m_send%task_real(1) = 1
983 14 : m_send%task_real(2) = elem%e_pot_approx
984 14 : counter = 3
985 : ! the box size for NpT
986 14 : IF (tmc_params%pressure >= 0.0_dp) THEN
987 12 : m_send%task_real(counter) = SIZE(elem%box_scale)
988 96 : m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = elem%box_scale(:)
989 12 : counter = counter + 1 + INT(m_send%task_real(counter))
990 : END IF
991 14 : m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
992 :
993 14 : CPASSERT(SIZE(m_send%task_real) == msg_size_real)
994 14 : CPASSERT(INT(m_send%task_real(msg_size_real)) == message_end_flag)
995 14 : 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 14 : 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 14 : CPASSERT(ASSOCIATED(elem))
1012 14 : CPASSERT(ASSOCIATED(m_send))
1013 14 : CPASSERT(m_send%info(2) == 0 .AND. m_send%info(3) > 0)
1014 14 : CPASSERT(ASSOCIATED(tmc_params))
1015 :
1016 : !then float array with energy of exact potential
1017 14 : elem%e_pot_approx = m_send%task_real(2)
1018 14 : counter = 3
1019 14 : IF (tmc_params%pressure >= 0.0_dp) THEN
1020 96 : elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter)))
1021 12 : counter = counter + 1 + INT(m_send%task_real(counter))
1022 : END IF
1023 :
1024 14 : CPASSERT(counter == m_send%info(3))
1025 14 : CPASSERT(INT(m_send%task_real(m_send%info(3))) == message_end_flag)
1026 14 : 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 114 : 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 114 : CPASSERT(ASSOCIATED(m_send))
1049 114 : CPASSERT(ASSOCIATED(elem))
1050 114 : CPASSERT(.NOT. ALLOCATED(m_send%task_int))
1051 114 : CPASSERT(.NOT. ALLOCATED(m_send%task_real))
1052 114 : CPASSERT(ASSOCIATED(tmc_params))
1053 :
1054 114 : counter = 0
1055 : !first integer array with element status,mol_info, move type, sub tree, element nr, temp index
1056 114 : msg_size_int = 1 + SIZE(elem%elem_stat) + 1 + SIZE(elem%mol) + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1
1057 :
1058 342 : ALLOCATE (m_send%task_int(msg_size_int))
1059 : ! element status
1060 114 : m_send%task_int(1) = SIZE(elem%elem_stat)
1061 114 : counter = 2 + m_send%task_int(1)
1062 197106 : m_send%task_int(2:counter - 1) = elem%elem_stat
1063 114 : m_send%task_int(counter) = SIZE(elem%mol)
1064 65778 : m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:)
1065 114 : counter = counter + 1 + m_send%task_int(counter)
1066 : ! element move type
1067 114 : m_send%task_int(counter) = 1
1068 114 : m_send%task_int(counter + 1) = elem%move_type
1069 114 : counter = counter + 2
1070 114 : m_send%task_int(counter) = 1
1071 114 : m_send%task_int(counter + 1) = elem%nr
1072 114 : counter = counter + 2
1073 114 : m_send%task_int(counter) = 1
1074 114 : m_send%task_int(counter + 1) = elem%sub_tree_nr
1075 114 : counter = counter + 2
1076 114 : m_send%task_int(counter) = 1
1077 114 : m_send%task_int(counter + 1) = elem%temp_created
1078 114 : m_send%task_int(counter + 2) = message_end_flag !message end
1079 :
1080 114 : counter = 0
1081 : !then float array with pos, (vel), random number seed, subbox_center
1082 114 : msg_size_real = 1 + SIZE(elem%pos) + 1 + SIZE(elem%rng_seed) + 1 + SIZE(elem%subbox_center(:)) + 1
1083 114 : IF (msg_type == TMC_STAT_MD_REQUEST .OR. msg_type == TMC_STAT_MD_BROADCAST) THEN
1084 0 : msg_size_real = msg_size_real + 1 + SIZE(elem%vel)
1085 : END IF ! the velocities
1086 114 : IF (tmc_params%pressure >= 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:)) ! box size for NpT
1087 :
1088 342 : ALLOCATE (m_send%task_real(msg_size_real))
1089 114 : m_send%task_real(1) = SIZE(elem%pos)
1090 114 : counter = 2 + INT(m_send%task_real(1))
1091 197106 : m_send%task_real(2:counter - 1) = elem%pos
1092 114 : IF (msg_type == TMC_STAT_MD_REQUEST .OR. msg_type == TMC_STAT_MD_BROADCAST) THEN
1093 0 : m_send%task_real(counter) = SIZE(elem%vel)
1094 0 : m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%vel
1095 0 : counter = counter + 1 + NINT(m_send%task_real(counter))
1096 : END IF
1097 : ! rng seed
1098 114 : m_send%task_real(counter) = SIZE(elem%rng_seed)
1099 2166 : m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)) = RESHAPE(elem%rng_seed(:, :, :), [SIZE(elem%rng_seed)])
1100 114 : counter = counter + NINT(m_send%task_real(counter)) + 1
1101 : ! sub box center
1102 114 : m_send%task_real(counter) = SIZE(elem%subbox_center(:))
1103 798 : m_send%task_real(counter + 1:counter + SIZE(elem%subbox_center)) = elem%subbox_center(:)
1104 114 : counter = counter + 1 + NINT(m_send%task_real(counter))
1105 : ! the box size for NpT
1106 114 : IF (tmc_params%pressure >= 0.0_dp) THEN
1107 68 : m_send%task_real(counter) = SIZE(elem%box_scale)
1108 476 : m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = elem%box_scale(:)
1109 68 : counter = counter + 1 + INT(m_send%task_real(counter))
1110 : END IF
1111 114 : m_send%task_real(counter) = message_end_flag !message end
1112 :
1113 114 : CPASSERT(SIZE(m_send%task_int) == msg_size_int)
1114 114 : CPASSERT(SIZE(m_send%task_real) == msg_size_real)
1115 114 : CPASSERT(m_send%task_int(msg_size_int) == message_end_flag)
1116 114 : CPASSERT(INT(m_send%task_real(msg_size_real)) == message_end_flag)
1117 114 : 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 57 : 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 57 : CPASSERT(.NOT. ASSOCIATED(elem))
1137 57 : CPASSERT(ASSOCIATED(m_send))
1138 57 : CPASSERT(m_send%info(2) > 5 .AND. m_send%info(3) > 8)
1139 57 : CPASSERT(ASSOCIATED(tmc_params))
1140 :
1141 57 : counter = 0
1142 : !first integer array with number of dimensions and random seed size
1143 57 : rnd_seed_size = m_send%task_int(1 + m_send%task_int(1) + 1)
1144 :
1145 57 : IF (.NOT. ASSOCIATED(elem)) THEN
1146 : CALL allocate_new_sub_tree_node(next_el=elem, nr_dim=NINT(m_send%task_real(1)), &
1147 57 : tmc_params=tmc_params)
1148 : END IF
1149 : ! element status
1150 57 : counter = 2 + m_send%task_int(1)
1151 98553 : elem%elem_stat = m_send%task_int(2:counter - 1)
1152 32889 : elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
1153 57 : counter = counter + 1 + m_send%task_int(counter)
1154 : ! element move type
1155 57 : elem%move_type = m_send%task_int(counter + 1)
1156 57 : counter = counter + 2
1157 57 : elem%nr = m_send%task_int(counter + 1)
1158 57 : counter = counter + 2
1159 57 : elem%sub_tree_nr = m_send%task_int(counter + 1)
1160 57 : counter = counter + 2
1161 57 : elem%temp_created = m_send%task_int(counter + 1)
1162 57 : counter = counter + 2
1163 57 : CPASSERT(counter == m_send%info(2))
1164 :
1165 57 : counter = 0
1166 : !then float array with pos, (vel), subbox_center and temp
1167 57 : num_dim = NINT(m_send%task_real(1))
1168 57 : counter = 2 + INT(m_send%task_real(1))
1169 98553 : elem%pos = m_send%task_real(2:counter - 1)
1170 57 : IF (msg_type == TMC_STAT_MD_REQUEST .OR. msg_type == TMC_STAT_MD_BROADCAST) THEN
1171 0 : elem%vel = m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter)))
1172 0 : counter = counter + NINT(m_send%task_real(counter)) + 1
1173 : END IF
1174 : ! rng seed
1175 1596 : elem%rng_seed(:, :, :) = RESHAPE(m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)), [3, 2, 3])
1176 57 : counter = counter + NINT(m_send%task_real(counter)) + 1
1177 : ! sub box center
1178 399 : elem%subbox_center(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter)))
1179 57 : counter = counter + 1 + NINT(m_send%task_real(counter))
1180 :
1181 57 : IF (tmc_params%pressure >= 0.0_dp) THEN
1182 238 : elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter)))
1183 34 : counter = counter + 1 + INT(m_send%task_real(counter))
1184 : ELSE
1185 92 : elem%box_scale(:) = 1.0_dp
1186 : END IF
1187 :
1188 57 : CPASSERT(counter == m_send%info(3))
1189 57 : CPASSERT(m_send%task_int(m_send%info(2)) == message_end_flag)
1190 57 : CPASSERT(INT(m_send%task_real(m_send%info(3))) == message_end_flag)
1191 57 : 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 57 : 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 57 : CPASSERT(ASSOCIATED(m_send))
1213 57 : CPASSERT(.NOT. ALLOCATED(m_send%task_int))
1214 57 : CPASSERT(.NOT. ALLOCATED(m_send%task_real))
1215 57 : CPASSERT(ASSOCIATED(elem))
1216 57 : 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 285 : + 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 99 : 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 70 : + 1 + SIZE(tmc_params%nmc_move_types%subbox_acc_count)
1226 : END IF
1227 :
1228 171 : ALLOCATE (m_send%task_int(msg_size_int))
1229 57 : 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 57 : m_send%task_int(counter) = SIZE(elem%mol)
1241 32889 : m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:)
1242 57 : counter = counter + 1 + m_send%task_int(counter)
1243 : ! the counters for each move type
1244 171 : 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 899 : [SIZE(tmc_params%nmc_move_types%mv_count)])
1248 57 : counter = counter + 1 + m_send%task_int(counter)
1249 : ! the counter for the accepted moves
1250 171 : 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 899 : [SIZE(tmc_params%nmc_move_types%acc_count)])
1254 57 : counter = counter + 1 + m_send%task_int(counter)
1255 : ! amount of rejected subbox moves
1256 99 : IF (.NOT. ANY(tmc_params%sub_box_size <= 0.1_dp)) THEN
1257 42 : 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 196 : [SIZE(tmc_params%nmc_move_types%subbox_count)])
1261 14 : counter = counter + 1 + m_send%task_int(counter)
1262 42 : 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 196 : [SIZE(tmc_params%nmc_move_types%subbox_acc_count)])
1266 14 : counter = counter + 1 + m_send%task_int(counter)
1267 : END IF
1268 57 : m_send%task_int(counter) = message_end_flag ! message end
1269 :
1270 57 : 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 57 : + 1 ! check bit
1278 :
1279 57 : IF (msg_type == TMC_STAT_MD_REQUEST .OR. msg_type == TMC_STAT_MD_RESULT .OR. &
1280 : msg_type == TMC_STAT_MD_BROADCAST) THEN
1281 0 : 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 171 : ALLOCATE (m_send%task_real(msg_size_real))
1285 : ! pos
1286 57 : counter = 1
1287 57 : m_send%task_real(counter) = SIZE(elem%pos)
1288 98553 : m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%pos
1289 57 : counter = counter + 1 + NINT(m_send%task_real(counter))
1290 : ! rng seed
1291 57 : m_send%task_real(counter) = SIZE(elem%rng_seed)
1292 : m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)) = &
1293 1083 : RESHAPE(elem%rng_seed(:, :, :), [SIZE(elem%rng_seed)])
1294 57 : counter = counter + 1 + NINT(m_send%task_real(counter))
1295 : ! potential
1296 57 : m_send%task_real(counter) = 1
1297 57 : m_send%task_real(counter + 1) = elem%potential
1298 57 : counter = counter + 2
1299 : ! approximate potential energy
1300 57 : m_send%task_real(counter) = 1
1301 57 : m_send%task_real(counter + 1) = elem%e_pot_approx
1302 57 : counter = counter + 2
1303 : ! for MD also: vel, e_kin_befor_md, ekin
1304 57 : IF (msg_type == TMC_STAT_MD_REQUEST .OR. msg_type == TMC_STAT_MD_RESULT .OR. &
1305 : msg_type == TMC_STAT_MD_BROADCAST) THEN
1306 0 : m_send%task_real(counter) = SIZE(elem%vel)
1307 0 : m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%vel
1308 0 : counter = counter + 1 + INT(m_send%task_real(counter))
1309 0 : m_send%task_real(counter) = 1
1310 0 : m_send%task_real(counter + 1) = elem%ekin_before_md
1311 0 : counter = counter + 2
1312 0 : m_send%task_real(counter) = 1
1313 0 : m_send%task_real(counter + 1) = elem%ekin
1314 0 : counter = counter + 2
1315 : END IF
1316 57 : m_send%task_real(counter) = message_end_flag ! message end
1317 :
1318 57 : CPASSERT(SIZE(m_send%task_int) == msg_size_int)
1319 57 : CPASSERT(SIZE(m_send%task_real) == msg_size_real)
1320 57 : CPASSERT(m_send%task_int(msg_size_int) == message_end_flag)
1321 57 : CPASSERT(INT(m_send%task_real(msg_size_real)) == message_end_flag)
1322 57 : 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 57 : 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 57 : subbox_acc_counter, subbox_counter
1341 :
1342 57 : NULLIFY (mv_counter, subbox_counter, acc_counter, subbox_acc_counter)
1343 :
1344 0 : CPASSERT(ASSOCIATED(elem))
1345 57 : CPASSERT(ASSOCIATED(m_send))
1346 57 : CPASSERT(m_send%info(2) > 0 .AND. m_send%info(3) > 0)
1347 57 : CPASSERT(ASSOCIATED(tmc_params))
1348 :
1349 : !first integer array with element status, random number seed, and move type
1350 57 : 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 32889 : elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter))
1359 57 : 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 228 : 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 903 : SIZE(tmc_params%nmc_move_types%mv_count(1, :))])
1366 57 : 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 228 : 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 903 : SIZE(tmc_params%nmc_move_types%acc_count(1, :))])
1373 57 : counter = counter + 1 + m_send%task_int(counter)
1374 : ! amount of rejected subbox moves
1375 99 : 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 56 : 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 196 : SIZE(tmc_params%nmc_move_types%subbox_count(1, :))])
1381 14 : counter = counter + 1 + m_send%task_int(counter)
1382 : ALLOCATE (subbox_acc_counter(SIZE(tmc_params%nmc_move_types%subbox_acc_count(:, 1)), &
1383 56 : 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 196 : SIZE(tmc_params%nmc_move_types%subbox_acc_count(1, :))])
1387 14 : counter = counter + 1 + m_send%task_int(counter)
1388 : END IF
1389 57 : 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 57 : counter = 1
1394 : ! pos
1395 98553 : elem%pos = m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter)))
1396 57 : counter = counter + 1 + NINT(m_send%task_real(counter))
1397 : ! rng seed
1398 1596 : elem%rng_seed(:, :, :) = RESHAPE(m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)), [3, 2, 3])
1399 57 : counter = counter + 1 + NINT(m_send%task_real(counter))
1400 : ! potential
1401 57 : elem%potential = m_send%task_real(counter + 1)
1402 57 : counter = counter + 2
1403 : ! approximate potential energy
1404 57 : elem%e_pot_approx = m_send%task_real(counter + 1)
1405 57 : counter = counter + 2
1406 : ! for MD also: vel, e_kin_befor_md, ekin
1407 57 : IF (msg_type == TMC_STAT_MD_REQUEST .OR. msg_type == TMC_STAT_MD_RESULT .OR. &
1408 : msg_type == TMC_STAT_MD_BROADCAST) THEN
1409 0 : elem%vel = m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter)))
1410 0 : counter = counter + 1 + INT(m_send%task_real(counter))
1411 0 : IF (.NOT. (tmc_params%task_type == task_type_gaussian_adaptation)) THEN
1412 0 : elem%ekin_before_md = m_send%task_real(counter + 1)
1413 : END IF
1414 0 : counter = counter + 2
1415 0 : elem%ekin = m_send%task_real(counter + 1)
1416 0 : 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 57 : mv_counter=mv_counter, acc_counter=acc_counter)
1421 99 : 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 14 : subbox_counter=subbox_counter, subbox_acc_counter=subbox_acc_counter)
1424 : END IF
1425 :
1426 57 : DEALLOCATE (mv_counter, acc_counter)
1427 99 : IF (.NOT. ANY(tmc_params%sub_box_size <= 0.1_dp)) THEN
1428 14 : DEALLOCATE (subbox_counter, subbox_acc_counter)
1429 : END IF
1430 57 : CPASSERT(counter == m_send%info(3))
1431 57 : CPASSERT(m_send%task_int(m_send%info(2)) == message_end_flag)
1432 57 : CPASSERT(INT(m_send%task_real(m_send%info(3))) == message_end_flag)
1433 57 : 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 0 : 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 0 : CPASSERT(ASSOCIATED(m_send))
1456 0 : CPASSERT(.NOT. ALLOCATED(m_send%task_int))
1457 0 : CPASSERT(.NOT. ALLOCATED(m_send%task_real))
1458 0 : CPASSERT(ASSOCIATED(list_elem))
1459 0 : CPASSERT(ASSOCIATED(tmc_params))
1460 :
1461 0 : counter = 0
1462 : !first integer array
1463 0 : msg_size_int = 1 + 1 + 1 + 1 + 1 ! 1+SIZE(list_elem%elem%sub_tree_nr) +1+SIZE(list_elem%elem%nr)
1464 0 : ALLOCATE (m_send%task_int(msg_size_int))
1465 0 : counter = 1
1466 0 : m_send%task_int(counter) = 1 ! temperature index
1467 0 : m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = list_elem%temp_ind
1468 0 : counter = counter + 1 + m_send%task_int(counter)
1469 0 : m_send%task_int(counter) = 1 ! Markov chain number
1470 0 : m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = list_elem%nr
1471 0 : counter = counter + 1 + m_send%task_int(counter)
1472 0 : m_send%task_int(counter) = message_end_flag
1473 0 : CPASSERT(SIZE(m_send%task_int) == msg_size_int)
1474 0 : CPASSERT(m_send%task_int(msg_size_int) == message_end_flag)
1475 :
1476 : !then float array with pos
1477 0 : msg_size_real = 1 + SIZE(list_elem%elem%pos) + 1
1478 0 : IF (tmc_params%pressure >= 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(list_elem%elem%box_scale(:))
1479 0 : ALLOCATE (m_send%task_real(msg_size_real))
1480 0 : m_send%task_real(1) = SIZE(list_elem%elem%pos)
1481 0 : counter = 2 + INT(m_send%task_real(1))
1482 0 : m_send%task_real(2:counter - 1) = list_elem%elem%pos
1483 0 : IF (tmc_params%pressure >= 0.0_dp) THEN
1484 0 : m_send%task_real(counter) = SIZE(list_elem%elem%box_scale)
1485 0 : m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = list_elem%elem%box_scale(:)
1486 0 : counter = counter + 1 + INT(m_send%task_real(counter))
1487 : END IF
1488 0 : m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end
1489 :
1490 0 : CPASSERT(SIZE(m_send%task_real) == msg_size_real)
1491 0 : CPASSERT(INT(m_send%task_real(msg_size_real)) == message_end_flag)
1492 0 : 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 0 : 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 0 : CPASSERT(ASSOCIATED(m_send))
1509 0 : CPASSERT(m_send%info(3) > 0)
1510 0 : CPASSERT(ASSOCIATED(tmc_params))
1511 0 : CPASSERT(.NOT. ASSOCIATED(elem))
1512 :
1513 : ! initialize the new sub tree element
1514 0 : IF (.NOT. ASSOCIATED(elem)) THEN
1515 : CALL allocate_new_sub_tree_node(next_el=elem, nr_dim=NINT(m_send%task_real(1)), &
1516 0 : tmc_params=tmc_params)
1517 : END IF
1518 : ! read the integer values
1519 0 : CPASSERT(m_send%info(2) > 0)
1520 0 : counter = 1
1521 0 : elem%sub_tree_nr = m_send%task_int(counter + 1)
1522 0 : counter = counter + 1 + m_send%task_int(counter)
1523 0 : elem%nr = m_send%task_int(counter + 1)
1524 0 : counter = counter + 1 + m_send%task_int(counter)
1525 0 : CPASSERT(m_send%task_int(counter) == message_end_flag)
1526 :
1527 : !float array with pos
1528 0 : counter = 0
1529 0 : counter = 1 + NINT(m_send%task_real(1))
1530 0 : elem%pos = m_send%task_real(2:counter)
1531 0 : counter = counter + 1
1532 0 : IF (tmc_params%pressure >= 0.0_dp) THEN
1533 0 : elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter)))
1534 0 : counter = counter + 1 + INT(m_send%task_real(counter))
1535 : END IF
1536 :
1537 0 : CPASSERT(counter == m_send%info(3))
1538 0 : CPASSERT(INT(m_send%task_real(m_send%info(3))) == message_end_flag)
1539 0 : 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 0 : SUBROUTINE read_scf_step_ener(elem, m_send)
1551 : TYPE(tree_type), POINTER :: elem
1552 : TYPE(message_send), POINTER :: m_send
1553 :
1554 0 : CPASSERT(ASSOCIATED(elem))
1555 0 : CPASSERT(ASSOCIATED(m_send))
1556 :
1557 0 : elem%scf_energies(MOD(elem%scf_energies_count, 4) + 1) = m_send%task_real(1)
1558 0 : elem%scf_energies_count = elem%scf_energies_count + 1
1559 :
1560 0 : 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 28 : 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 28 : CPASSERT(ASSOCIATED(para_env))
1581 28 : CPASSERT(source >= 0)
1582 28 : CPASSERT(source < para_env%num_pe)
1583 :
1584 84 : ALLOCATE (msg(SIZE(atoms)))
1585 28 : IF (para_env%mepos == source) THEN
1586 1894 : DO i = 1, SIZE(atoms)
1587 1894 : msg(i) = atoms(i)%name
1588 : END DO
1589 14 : CALL para_env%bcast(msg, source)
1590 : ELSE
1591 14 : CALL para_env%bcast(msg, source)
1592 1894 : DO i = 1, SIZE(atoms)
1593 1894 : atoms(i)%name = msg(i)
1594 : END DO
1595 : END IF
1596 28 : DEALLOCATE (msg)
1597 28 : 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 42 : 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 42 : LOGICAL, ALLOCATABLE, DIMENSION(:) :: rank_stoped
1617 :
1618 : ! INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status_single
1619 :
1620 42 : CPASSERT(ASSOCIATED(para_env))
1621 42 : CPASSERT(ASSOCIATED(tmc_params))
1622 :
1623 126 : ALLOCATE (rank_stoped(0:para_env%num_pe - 1))
1624 42 : rank_stoped(:) = .FALSE.
1625 42 : rank_stoped(para_env%mepos) = .TRUE.
1626 :
1627 : ! global master
1628 42 : IF (PRESENT(worker_info)) THEN
1629 28 : CPASSERT(ASSOCIATED(worker_info))
1630 : ! canceling running jobs and stop workers
1631 42 : worker_group_loop: DO dest_rank = 1, para_env%num_pe - 1
1632 : ! busy workers have to be canceled
1633 42 : IF (worker_info(dest_rank)%busy) THEN
1634 1 : stat = TMC_CANCELING_MESSAGE
1635 1 : act_rank = dest_rank
1636 : CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=act_rank, &
1637 1 : para_env=para_env, tmc_params=tmc_params)
1638 : ELSE
1639 : ! send stop message
1640 13 : stat = TMC_STATUS_FAILED
1641 13 : act_rank = dest_rank
1642 : CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=act_rank, &
1643 13 : 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 14 : stat = TMC_STATUS_FAILED
1649 : CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=bcast_group, &
1650 14 : para_env=para_env, tmc_params=tmc_params)
1651 : END IF
1652 :
1653 : ! receive stop message receipt
1654 42 : IF (para_env%mepos == MASTER_COMM_ID) THEN
1655 : wait_for_receipts: DO
1656 : ! check incomming messages
1657 155 : stat = TMC_STATUS_WAIT_FOR_NEW_TASK
1658 155 : dest_rank = 999
1659 155 : 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 141 : elem_array=worker_info(:), success=flag)
1664 : ELSE
1665 : CALL tmc_message(msg_type=stat, send_recv=recv_msg, dest=dest_rank, &
1666 14 : para_env=para_env, tmc_params=tmc_params)
1667 : END IF
1668 1 : SELECT CASE (stat)
1669 : CASE (TMC_STATUS_WAIT_FOR_NEW_TASK)
1670 : ! no message received
1671 : CASE (TMC_CANCELING_RECEIPT)
1672 1 : IF (PRESENT(worker_info)) THEN
1673 1 : worker_info(dest_rank)%busy = .FALSE.
1674 1 : stat = TMC_STATUS_FAILED
1675 : ! send stop message
1676 : CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=dest_rank, &
1677 1 : para_env=para_env, tmc_params=tmc_params)
1678 : ELSE
1679 0 : CPABORT("group master should not receive cancel receipt")
1680 : END IF
1681 : CASE (TMC_STATUS_STOP_RECEIPT)
1682 14 : 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 155 : " while stopping workers")
1690 : END SELECT
1691 324 : IF (ALL(rank_stoped)) EXIT wait_for_receipts
1692 : END DO wait_for_receipts
1693 : ELSE
1694 0 : CPABORT("only (group) master should stop other participants")
1695 : END IF
1696 42 : END SUBROUTINE stop_whole_group
1697 :
1698 0 : END MODULE tmc_messages
|
