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