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