(git:98357aa)
Loading...
Searching...
No Matches
swarm_message.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Swarm-message, a convenient data-container for with build-in serialization.
10!> \author Ole Schuett
11! **************************************************************************************************
12MODULE swarm_message
13
14 USE cp_parser_methods, ONLY: parser_get_next_line
15 USE cp_parser_types, ONLY: cp_parser_type
16 USE kinds, ONLY: default_string_length, &
17 int_4, &
18 int_8, &
19 real_4, &
20 real_8
21 USE message_passing, ONLY: mp_comm_type
22#include "../base/base_uses.f90"
23
24 IMPLICIT NONE
25 PRIVATE
26
27 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'swarm_message'
28
29 TYPE swarm_message_type
30 PRIVATE
31 TYPE(message_entry_type), POINTER :: root => null()
32 END TYPE swarm_message_type
33
34 INTEGER, PARAMETER :: key_length = 20
35
36 TYPE message_entry_type
37 CHARACTER(LEN=key_length) :: key = ""
38 TYPE(message_entry_type), POINTER :: next => null()
39 CHARACTER(LEN=default_string_length), POINTER :: value_str => null()
40 INTEGER(KIND=int_4), POINTER :: value_i4 => null()
41 INTEGER(KIND=int_8), POINTER :: value_i8 => null()
42 REAL(kind=real_4), POINTER :: value_r4 => null()
43 REAL(kind=real_8), POINTER :: value_r8 => null()
44 INTEGER(KIND=int_4), DIMENSION(:), POINTER :: value_1d_i4 => null()
45 INTEGER(KIND=int_8), DIMENSION(:), POINTER :: value_1d_i8 => null()
46 REAL(kind=real_4), DIMENSION(:), POINTER :: value_1d_r4 => null()
47 REAL(kind=real_8), DIMENSION(:), POINTER :: value_1d_r8 => null()
48 END TYPE message_entry_type
49
50! **************************************************************************************************
51!> \brief Adds an entry from a swarm-message.
52!> \author Ole Schuett
53! **************************************************************************************************
54 INTERFACE swarm_message_add
55 MODULE PROCEDURE swarm_message_add_str
56 MODULE PROCEDURE swarm_message_add_i4, swarm_message_add_i8
57 MODULE PROCEDURE swarm_message_add_r4, swarm_message_add_r8
58 MODULE PROCEDURE swarm_message_add_1d_i4, swarm_message_add_1d_i8
59 MODULE PROCEDURE swarm_message_add_1d_r4, swarm_message_add_1d_r8
60 END INTERFACE swarm_message_add
61
62! **************************************************************************************************
63!> \brief Returns an entry from a swarm-message.
64!> \author Ole Schuett
65! **************************************************************************************************
66 INTERFACE swarm_message_get
67 MODULE PROCEDURE swarm_message_get_str
68 MODULE PROCEDURE swarm_message_get_i4, swarm_message_get_i8
69 MODULE PROCEDURE swarm_message_get_r4, swarm_message_get_r8
70 MODULE PROCEDURE swarm_message_get_1d_i4, swarm_message_get_1d_i8
71 MODULE PROCEDURE swarm_message_get_1d_r4, swarm_message_get_1d_r8
72 END INTERFACE swarm_message_get
73
74 PUBLIC :: swarm_message_type, swarm_message_add, swarm_message_get
75 PUBLIC :: swarm_message_mpi_send, swarm_message_mpi_recv, swarm_message_mpi_bcast
76 PUBLIC :: swarm_message_file_write, swarm_message_file_read
77 PUBLIC :: swarm_message_haskey, swarm_message_equal
78 PUBLIC :: swarm_message_free
79
80CONTAINS
81
82! **************************************************************************************************
83!> \brief Returns the number of entries contained in a swarm-message.
84!> \param msg ...
85!> \return ...
86!> \author Ole Schuett
87! **************************************************************************************************
88 FUNCTION swarm_message_length(msg) RESULT(l)
89 TYPE(swarm_message_type), INTENT(IN) :: msg
90 INTEGER :: l
91
92 TYPE(message_entry_type), POINTER :: curr_entry
93
94 l = 0
95 curr_entry => msg%root
96 DO WHILE (ASSOCIATED(curr_entry))
97 l = l + 1
98 curr_entry => curr_entry%next
99 END DO
100 END FUNCTION swarm_message_length
101
102! **************************************************************************************************
103!> \brief Checks if a swarm-message contains an entry with the given key.
104!> \param msg ...
105!> \param key ...
106!> \return ...
107!> \author Ole Schuett
108! **************************************************************************************************
109 FUNCTION swarm_message_haskey(msg, key) RESULT(res)
110 TYPE(swarm_message_type), INTENT(IN) :: msg
111 CHARACTER(LEN=*), INTENT(IN) :: key
112 LOGICAL :: res
113
114 TYPE(message_entry_type), POINTER :: curr_entry
115
116 res = .false.
117 curr_entry => msg%root
118 DO WHILE (ASSOCIATED(curr_entry))
119 IF (trim(curr_entry%key) == trim(key)) THEN
120 res = .true.
121 EXIT
122 END IF
123 curr_entry => curr_entry%next
124 END DO
125 END FUNCTION swarm_message_haskey
126
127! **************************************************************************************************
128!> \brief Deallocates all entries contained in a swarm-message.
129!> \param msg ...
130!> \author Ole Schuett
131! **************************************************************************************************
132 SUBROUTINE swarm_message_free(msg)
133 TYPE(swarm_message_type), INTENT(INOUT) :: msg
134
135 TYPE(message_entry_type), POINTER :: entry, old_entry
136
137 entry => msg%root
138 DO WHILE (ASSOCIATED(entry))
139 IF (ASSOCIATED(entry%value_str)) DEALLOCATE (entry%value_str)
140 IF (ASSOCIATED(entry%value_i4)) DEALLOCATE (entry%value_i4)
141 IF (ASSOCIATED(entry%value_i8)) DEALLOCATE (entry%value_i8)
142 IF (ASSOCIATED(entry%value_r4)) DEALLOCATE (entry%value_r4)
143 IF (ASSOCIATED(entry%value_r8)) DEALLOCATE (entry%value_r8)
144 IF (ASSOCIATED(entry%value_1d_i4)) DEALLOCATE (entry%value_1d_i4)
145 IF (ASSOCIATED(entry%value_1d_i8)) DEALLOCATE (entry%value_1d_i8)
146 IF (ASSOCIATED(entry%value_1d_r4)) DEALLOCATE (entry%value_1d_r4)
147 IF (ASSOCIATED(entry%value_1d_r8)) DEALLOCATE (entry%value_1d_r8)
148 old_entry => entry
149 entry => entry%next
150 DEALLOCATE (old_entry)
151 END DO
152
153 NULLIFY (msg%root)
154
155 cpassert(swarm_message_length(msg) == 0)
156 END SUBROUTINE swarm_message_free
157
158! **************************************************************************************************
159!> \brief Checks if two swarm-messages are equal
160!> \param msg1 ...
161!> \param msg2 ...
162!> \return ...
163!> \author Ole Schuett
164! **************************************************************************************************
165 FUNCTION swarm_message_equal(msg1, msg2) RESULT(res)
166 TYPE(swarm_message_type), INTENT(IN) :: msg1, msg2
167 LOGICAL :: res
168
169 res = swarm_message_equal_oneway(msg1, msg2) .AND. &
170 swarm_message_equal_oneway(msg2, msg1)
171
172 END FUNCTION swarm_message_equal
173
174! **************************************************************************************************
175!> \brief Sends a swarm message via MPI.
176!> \param msg ...
177!> \param group ...
178!> \param dest ...
179!> \param tag ...
180!> \author Ole Schuett
181! **************************************************************************************************
182 SUBROUTINE swarm_message_mpi_send(msg, group, dest, tag)
183 TYPE(swarm_message_type), INTENT(IN) :: msg
184 CLASS(mp_comm_type), INTENT(IN) :: group
185 INTEGER, INTENT(IN) :: dest, tag
186
187 TYPE(message_entry_type), POINTER :: curr_entry
188
189 CALL group%send(swarm_message_length(msg), dest, tag)
190 curr_entry => msg%root
191 DO WHILE (ASSOCIATED(curr_entry))
192 CALL swarm_message_entry_mpi_send(curr_entry, group, dest, tag)
193 curr_entry => curr_entry%next
194 END DO
195 END SUBROUTINE swarm_message_mpi_send
196
197! **************************************************************************************************
198!> \brief Receives a swarm message via MPI.
199!> \param msg ...
200!> \param group ...
201!> \param src ...
202!> \param tag ...
203!> \author Ole Schuett
204! **************************************************************************************************
205 SUBROUTINE swarm_message_mpi_recv(msg, group, src, tag)
206 TYPE(swarm_message_type), INTENT(INOUT) :: msg
207 CLASS(mp_comm_type), INTENT(IN) :: group
208 INTEGER, INTENT(INOUT) :: src, tag
209
210 INTEGER :: i, length
211 TYPE(message_entry_type), POINTER :: new_entry
212
213 IF (ASSOCIATED(msg%root)) cpabort("message not empty")
214 CALL group%recv(length, src, tag)
215 DO i = 1, length
216 ALLOCATE (new_entry)
217 CALL swarm_message_entry_mpi_recv(new_entry, group, src, tag)
218 new_entry%next => msg%root
219 msg%root => new_entry
220 END DO
221
222 END SUBROUTINE swarm_message_mpi_recv
223
224! **************************************************************************************************
225!> \brief Broadcasts a swarm message via MPI.
226!> \param msg ...
227!> \param src ...
228!> \param group ...
229!> \author Ole Schuett
230! **************************************************************************************************
231 SUBROUTINE swarm_message_mpi_bcast(msg, src, group)
232 TYPE(swarm_message_type), INTENT(INOUT) :: msg
233 INTEGER, INTENT(IN) :: src
234 CLASS(mp_comm_type), INTENT(IN) :: group
235
236 INTEGER :: i, length
237 TYPE(message_entry_type), POINTER :: curr_entry
238
239 associate(mepos => group%mepos)
240
241 IF (mepos /= src .AND. ASSOCIATED(msg%root)) cpabort("message not empty")
242 length = swarm_message_length(msg)
243 CALL group%bcast(length, src)
244
245 IF (mepos == src) curr_entry => msg%root
246
247 DO i = 1, length
248 IF (mepos /= src) ALLOCATE (curr_entry)
249
250 CALL swarm_message_entry_mpi_bcast(curr_entry, src, group, mepos)
251
252 IF (mepos == src) THEN
253 curr_entry => curr_entry%next
254 ELSE
255 curr_entry%next => msg%root
256 msg%root => curr_entry
257 END IF
258 END DO
259 END associate
260
261 END SUBROUTINE swarm_message_mpi_bcast
262
263! **************************************************************************************************
264!> \brief Write a swarm-message to a given file / unit.
265!> \param msg ...
266!> \param unit ...
267!> \author Ole Schuett
268! **************************************************************************************************
269 SUBROUTINE swarm_message_file_write(msg, unit)
270 TYPE(swarm_message_type), INTENT(IN) :: msg
271 INTEGER, INTENT(IN) :: unit
272
273 INTEGER :: handle
274 TYPE(message_entry_type), POINTER :: curr_entry
275
276 IF (unit <= 0) RETURN
277
278 CALL timeset("swarm_message_file_write", handle)
279 WRITE (unit, "(A)") "BEGIN SWARM_MESSAGE"
280 WRITE (unit, "(A,I10)") "msg_length: ", swarm_message_length(msg)
281
282 curr_entry => msg%root
283 DO WHILE (ASSOCIATED(curr_entry))
284 CALL swarm_message_entry_file_write(curr_entry, unit)
285 curr_entry => curr_entry%next
286 END DO
287
288 WRITE (unit, "(A)") "END SWARM_MESSAGE"
289 WRITE (unit, "()")
290 CALL timestop(handle)
291 END SUBROUTINE swarm_message_file_write
292
293! **************************************************************************************************
294!> \brief Reads a swarm-message from a given file / unit.
295!> \param msg ...
296!> \param parser ...
297!> \param at_end ...
298!> \author Ole Schuett
299! **************************************************************************************************
300 SUBROUTINE swarm_message_file_read(msg, parser, at_end)
301 TYPE(swarm_message_type), INTENT(OUT) :: msg
302 TYPE(cp_parser_type), INTENT(INOUT) :: parser
303 LOGICAL, INTENT(INOUT) :: at_end
304
305 INTEGER :: handle
306
307 CALL timeset("swarm_message_file_read", handle)
308 CALL swarm_message_file_read_low(msg, parser, at_end)
309 CALL timestop(handle)
310 END SUBROUTINE swarm_message_file_read
311
312! **************************************************************************************************
313!> \brief Helper routine, does the actual work of swarm_message_file_read().
314!> \param msg ...
315!> \param parser ...
316!> \param at_end ...
317!> \author Ole Schuett
318! **************************************************************************************************
319 SUBROUTINE swarm_message_file_read_low(msg, parser, at_end)
320 TYPE(swarm_message_type), INTENT(OUT) :: msg
321 TYPE(cp_parser_type), INTENT(INOUT) :: parser
322 LOGICAL, INTENT(INOUT) :: at_end
323
324 CHARACTER(LEN=20) :: label
325 INTEGER :: i, length
326 TYPE(message_entry_type), POINTER :: new_entry
327
328 CALL parser_get_next_line(parser, 1, at_end)
329 at_end = at_end .OR. len_trim(parser%input_line(1:10)) == 0
330 IF (at_end) RETURN
331 cpassert(trim(parser%input_line(1:20)) == "BEGIN SWARM_MESSAGE")
332
333 CALL parser_get_next_line(parser, 1, at_end)
334 at_end = at_end .OR. len_trim(parser%input_line(1:10)) == 0
335 IF (at_end) RETURN
336 READ (parser%input_line(1:40), *) label, length
337 cpassert(trim(label) == "msg_length:")
338
339 DO i = 1, length
340 ALLOCATE (new_entry)
341 CALL swarm_message_entry_file_read(new_entry, parser, at_end)
342 new_entry%next => msg%root
343 msg%root => new_entry
344 END DO
345
346 CALL parser_get_next_line(parser, 1, at_end)
347 at_end = at_end .OR. len_trim(parser%input_line(1:10)) == 0
348 IF (at_end) RETURN
349 cpassert(trim(parser%input_line(1:20)) == "END SWARM_MESSAGE")
350
351 END SUBROUTINE swarm_message_file_read_low
352
353! **************************************************************************************************
354!> \brief Helper routine for swarm_message_equal
355!> \param msg1 ...
356!> \param msg2 ...
357!> \return ...
358!> \author Ole Schuett
359! **************************************************************************************************
360 FUNCTION swarm_message_equal_oneway(msg1, msg2) RESULT(res)
361 TYPE(swarm_message_type), INTENT(IN) :: msg1, msg2
362 LOGICAL :: res
363
364 LOGICAL :: found
365 TYPE(message_entry_type), POINTER :: entry1, entry2
366
367 res = .false.
368
369 !loop over entries of msg1
370 entry1 => msg1%root
371 DO WHILE (ASSOCIATED(entry1))
372
373 ! finding matching entry in msg2
374 entry2 => msg2%root
375 found = .false.
376 DO WHILE (ASSOCIATED(entry2))
377 IF (trim(entry2%key) == trim(entry1%key)) THEN
378 found = .true.
379 EXIT
380 END IF
381 entry2 => entry2%next
382 END DO
383 IF (.NOT. found) RETURN
384
385 !compare the two entries
386 IF (ASSOCIATED(entry1%value_str)) THEN
387 IF (.NOT. ASSOCIATED(entry2%value_str)) RETURN
388 IF (trim(entry1%value_str) /= trim(entry2%value_str)) RETURN
389
390 ELSE IF (ASSOCIATED(entry1%value_i4)) THEN
391 IF (.NOT. ASSOCIATED(entry2%value_i4)) RETURN
392 IF (entry1%value_i4 /= entry2%value_i4) RETURN
393
394 ELSE IF (ASSOCIATED(entry1%value_i8)) THEN
395 IF (.NOT. ASSOCIATED(entry2%value_i8)) RETURN
396 IF (entry1%value_i8 /= entry2%value_i8) RETURN
397
398 ELSE IF (ASSOCIATED(entry1%value_r4)) THEN
399 IF (.NOT. ASSOCIATED(entry2%value_r4)) RETURN
400 IF (abs(entry1%value_r4 - entry2%value_r4) > 1e-5) RETURN
401
402 ELSE IF (ASSOCIATED(entry1%value_r8)) THEN
403 IF (.NOT. ASSOCIATED(entry2%value_r8)) RETURN
404 IF (abs(entry1%value_r8 - entry2%value_r8) > 1e-10) RETURN
405
406 ELSE IF (ASSOCIATED(entry1%value_1d_i4)) THEN
407 IF (.NOT. ASSOCIATED(entry2%value_1d_i4)) RETURN
408 IF (any(entry1%value_1d_i4 /= entry2%value_1d_i4)) RETURN
409
410 ELSE IF (ASSOCIATED(entry1%value_1d_i8)) THEN
411 IF (.NOT. ASSOCIATED(entry2%value_1d_i8)) RETURN
412 IF (any(entry1%value_1d_i8 /= entry2%value_1d_i8)) RETURN
413
414 ELSE IF (ASSOCIATED(entry1%value_1d_r4)) THEN
415 IF (.NOT. ASSOCIATED(entry2%value_1d_r4)) RETURN
416 IF (any(abs(entry1%value_1d_r4 - entry2%value_1d_r4) > 1e-5)) RETURN
417
418 ELSE IF (ASSOCIATED(entry1%value_1d_r8)) THEN
419 IF (.NOT. ASSOCIATED(entry2%value_1d_r8)) RETURN
420 IF (any(abs(entry1%value_1d_r8 - entry2%value_1d_r8) > 1e-10)) RETURN
421 ELSE
422 cpabort("no value ASSOCIATED")
423 END IF
424
425 entry1 => entry1%next
426 END DO
427
428 ! if we reach this point no differences were found
429 res = .true.
430 END FUNCTION swarm_message_equal_oneway
431
432! **************************************************************************************************
433!> \brief Helper routine for swarm_message_mpi_send.
434!> \param ENTRY ...
435!> \param group ...
436!> \param dest ...
437!> \param tag ...
438!> \author Ole Schuett
439! **************************************************************************************************
440 SUBROUTINE swarm_message_entry_mpi_send(ENTRY, group, dest, tag)
441 TYPE(message_entry_type), INTENT(IN) :: entry
442 CLASS(mp_comm_type), INTENT(IN) :: group
443 INTEGER, INTENT(IN) :: dest, tag
444
445 INTEGER, DIMENSION(default_string_length) :: value_str_arr
446 INTEGER, DIMENSION(key_length) :: key_arr
447
448 key_arr = str2iarr(entry%key)
449 CALL group%send(key_arr, dest, tag)
450
451 IF (ASSOCIATED(entry%value_i4)) THEN
452 CALL group%send(1, dest, tag)
453 CALL group%send(entry%value_i4, dest, tag)
454
455 ELSE IF (ASSOCIATED(entry%value_i8)) THEN
456 CALL group%send(2, dest, tag)
457 CALL group%send(entry%value_i8, dest, tag)
458
459 ELSE IF (ASSOCIATED(entry%value_r4)) THEN
460 CALL group%send(3, dest, tag)
461 CALL group%send(entry%value_r4, dest, tag)
462
463 ELSE IF (ASSOCIATED(entry%value_r8)) THEN
464 CALL group%send(4, dest, tag)
465 CALL group%send(entry%value_r8, dest, tag)
466
467 ELSE IF (ASSOCIATED(entry%value_1d_i4)) THEN
468 CALL group%send(5, dest, tag)
469 CALL group%send(SIZE(entry%value_1d_i4), dest, tag)
470 CALL group%send(entry%value_1d_i4, dest, tag)
471
472 ELSE IF (ASSOCIATED(entry%value_1d_i8)) THEN
473 CALL group%send(6, dest, tag)
474 CALL group%send(SIZE(entry%value_1d_i8), dest, tag)
475 CALL group%send(entry%value_1d_i8, dest, tag)
476
477 ELSE IF (ASSOCIATED(entry%value_1d_r4)) THEN
478 CALL group%send(7, dest, tag)
479 CALL group%send(SIZE(entry%value_1d_r4), dest, tag)
480 CALL group%send(entry%value_1d_r4, dest, tag)
481
482 ELSE IF (ASSOCIATED(entry%value_1d_r8)) THEN
483 CALL group%send(8, dest, tag)
484 CALL group%send(SIZE(entry%value_1d_r8), dest, tag)
485 CALL group%send(entry%value_1d_r8, dest, tag)
486
487 ELSE IF (ASSOCIATED(entry%value_str)) THEN
488 CALL group%send(9, dest, tag)
489 value_str_arr = str2iarr(entry%value_str)
490 CALL group%send(value_str_arr, dest, tag)
491 ELSE
492 cpabort("no value ASSOCIATED")
493 END IF
494 END SUBROUTINE swarm_message_entry_mpi_send
495
496! **************************************************************************************************
497!> \brief Helper routine for swarm_message_mpi_recv.
498!> \param ENTRY ...
499!> \param group ...
500!> \param src ...
501!> \param tag ...
502!> \author Ole Schuett
503! **************************************************************************************************
504 SUBROUTINE swarm_message_entry_mpi_recv(ENTRY, group, src, tag)
505 TYPE(message_entry_type), INTENT(INOUT) :: entry
506 CLASS(mp_comm_type), INTENT(IN) :: group
507 INTEGER, INTENT(INOUT) :: src, tag
508
509 INTEGER :: datatype, s
510 INTEGER, DIMENSION(default_string_length) :: value_str_arr
511 INTEGER, DIMENSION(key_length) :: key_arr
512
513 CALL group%recv(key_arr, src, tag)
514 entry%key = iarr2str(key_arr)
515
516 CALL group%recv(datatype, src, tag)
517
518 SELECT CASE (datatype)
519 CASE (1)
520 ALLOCATE (entry%value_i4)
521 CALL group%recv(entry%value_i4, src, tag)
522 CASE (2)
523 ALLOCATE (entry%value_i8)
524 CALL group%recv(entry%value_i8, src, tag)
525 CASE (3)
526 ALLOCATE (entry%value_r4)
527 CALL group%recv(entry%value_r4, src, tag)
528 CASE (4)
529 ALLOCATE (entry%value_r8)
530 CALL group%recv(entry%value_r8, src, tag)
531 CASE (5)
532 CALL group%recv(s, src, tag)
533 ALLOCATE (entry%value_1d_i4(s))
534 CALL group%recv(entry%value_1d_i4, src, tag)
535 CASE (6)
536 CALL group%recv(s, src, tag)
537 ALLOCATE (entry%value_1d_i8(s))
538 CALL group%recv(entry%value_1d_i8, src, tag)
539 CASE (7)
540 CALL group%recv(s, src, tag)
541 ALLOCATE (entry%value_1d_r4(s))
542 CALL group%recv(entry%value_1d_r4, src, tag)
543 CASE (8)
544 CALL group%recv(s, src, tag)
545 ALLOCATE (entry%value_1d_r8(s))
546 CALL group%recv(entry%value_1d_r8, src, tag)
547 CASE (9)
548 ALLOCATE (entry%value_str)
549 CALL group%recv(value_str_arr, src, tag)
550 entry%value_str = iarr2str(value_str_arr)
551 CASE DEFAULT
552 cpabort("unknown datatype")
553 END SELECT
554 END SUBROUTINE swarm_message_entry_mpi_recv
555
556! **************************************************************************************************
557!> \brief Helper routine for swarm_message_mpi_bcast.
558!> \param ENTRY ...
559!> \param src ...
560!> \param group ...
561!> \param mepos ...
562!> \author Ole Schuett
563! **************************************************************************************************
564 SUBROUTINE swarm_message_entry_mpi_bcast(ENTRY, src, group, mepos)
565 TYPE(message_entry_type), INTENT(INOUT) :: entry
566 INTEGER, INTENT(IN) :: src, mepos
567 CLASS(mp_comm_type), INTENT(IN) :: group
568
569 INTEGER :: datasize, datatype
570 INTEGER, DIMENSION(default_string_length) :: value_str_arr
571 INTEGER, DIMENSION(key_length) :: key_arr
572
573 IF (src == mepos) key_arr = str2iarr(entry%key)
574 CALL group%bcast(key_arr, src)
575 IF (src /= mepos) entry%key = iarr2str(key_arr)
576
577 IF (src == mepos) THEN
578 datasize = 1
579 IF (ASSOCIATED(entry%value_i4)) THEN
580 datatype = 1
581 ELSE IF (ASSOCIATED(entry%value_i8)) THEN
582 datatype = 2
583 ELSE IF (ASSOCIATED(entry%value_r4)) THEN
584 datatype = 3
585 ELSE IF (ASSOCIATED(entry%value_r8)) THEN
586 datatype = 4
587 ELSE IF (ASSOCIATED(entry%value_1d_i4)) THEN
588 datatype = 5
589 datasize = SIZE(entry%value_1d_i4)
590 ELSE IF (ASSOCIATED(entry%value_1d_i8)) THEN
591 datatype = 6
592 datasize = SIZE(entry%value_1d_i8)
593 ELSE IF (ASSOCIATED(entry%value_1d_r4)) THEN
594 datatype = 7
595 datasize = SIZE(entry%value_1d_r4)
596 ELSE IF (ASSOCIATED(entry%value_1d_r8)) THEN
597 datatype = 8
598 datasize = SIZE(entry%value_1d_r8)
599 ELSE IF (ASSOCIATED(entry%value_str)) THEN
600 datatype = 9
601 ELSE
602 cpabort("no value ASSOCIATED")
603 END IF
604 END IF
605 CALL group%bcast(datatype, src)
606 CALL group%bcast(datasize, src)
607
608 SELECT CASE (datatype)
609 CASE (1)
610 IF (src /= mepos) ALLOCATE (entry%value_i4)
611 CALL group%bcast(entry%value_i4, src)
612 CASE (2)
613 IF (src /= mepos) ALLOCATE (entry%value_i8)
614 CALL group%bcast(entry%value_i8, src)
615 CASE (3)
616 IF (src /= mepos) ALLOCATE (entry%value_r4)
617 CALL group%bcast(entry%value_r4, src)
618 CASE (4)
619 IF (src /= mepos) ALLOCATE (entry%value_r8)
620 CALL group%bcast(entry%value_r8, src)
621 CASE (5)
622 IF (src /= mepos) ALLOCATE (entry%value_1d_i4(datasize))
623 CALL group%bcast(entry%value_1d_i4, src)
624 CASE (6)
625 IF (src /= mepos) ALLOCATE (entry%value_1d_i8(datasize))
626 CALL group%bcast(entry%value_1d_i8, src)
627 CASE (7)
628 IF (src /= mepos) ALLOCATE (entry%value_1d_r4(datasize))
629 CALL group%bcast(entry%value_1d_r4, src)
630 CASE (8)
631 IF (src /= mepos) ALLOCATE (entry%value_1d_r8(datasize))
632 CALL group%bcast(entry%value_1d_r8, src)
633 CASE (9)
634 IF (src == mepos) value_str_arr = str2iarr(entry%value_str)
635 CALL group%bcast(value_str_arr, src)
636 IF (src /= mepos) THEN
637 ALLOCATE (entry%value_str)
638 entry%value_str = iarr2str(value_str_arr)
639 END IF
640 CASE DEFAULT
641 cpabort("unknown datatype")
642 END SELECT
643
644 END SUBROUTINE swarm_message_entry_mpi_bcast
645
646! **************************************************************************************************
647!> \brief Helper routine for swarm_message_file_write.
648!> \param ENTRY ...
649!> \param unit ...
650!> \author Ole Schuett
651! **************************************************************************************************
652 SUBROUTINE swarm_message_entry_file_write(ENTRY, unit)
653 TYPE(message_entry_type), INTENT(IN) :: entry
654 INTEGER, INTENT(IN) :: unit
655
656 INTEGER :: i
657
658 WRITE (unit, "(A,A)") "key: ", entry%key
659 IF (ASSOCIATED(entry%value_i4)) THEN
660 WRITE (unit, "(A)") "datatype: i4"
661 WRITE (unit, "(A,I10)") "value: ", entry%value_i4
662
663 ELSE IF (ASSOCIATED(entry%value_i8)) THEN
664 WRITE (unit, "(A)") "datatype: i8"
665 WRITE (unit, "(A,I20)") "value: ", entry%value_i8
666
667 ELSE IF (ASSOCIATED(entry%value_r4)) THEN
668 WRITE (unit, "(A)") "datatype: r4"
669 WRITE (unit, "(A,E30.20)") "value: ", entry%value_r4
670
671 ELSE IF (ASSOCIATED(entry%value_r8)) THEN
672 WRITE (unit, "(A)") "datatype: r8"
673 WRITE (unit, "(A,E30.20)") "value: ", entry%value_r8
674
675 ELSE IF (ASSOCIATED(entry%value_str)) THEN
676 WRITE (unit, "(A)") "datatype: str"
677 WRITE (unit, "(A,A)") "value: ", entry%value_str
678
679 ELSE IF (ASSOCIATED(entry%value_1d_i4)) THEN
680 WRITE (unit, "(A)") "datatype: 1d_i4"
681 WRITE (unit, "(A,I10)") "size: ", SIZE(entry%value_1d_i4)
682 DO i = 1, SIZE(entry%value_1d_i4)
683 WRITE (unit, *) entry%value_1d_i4(i)
684 END DO
685
686 ELSE IF (ASSOCIATED(entry%value_1d_i8)) THEN
687 WRITE (unit, "(A)") "datatype: 1d_i8"
688 WRITE (unit, "(A,I20)") "size: ", SIZE(entry%value_1d_i8)
689 DO i = 1, SIZE(entry%value_1d_i8)
690 WRITE (unit, *) entry%value_1d_i8(i)
691 END DO
692
693 ELSE IF (ASSOCIATED(entry%value_1d_r4)) THEN
694 WRITE (unit, "(A)") "datatype: 1d_r4"
695 WRITE (unit, "(A,I8)") "size: ", SIZE(entry%value_1d_r4)
696 DO i = 1, SIZE(entry%value_1d_r4)
697 WRITE (unit, "(1X,E30.20)") entry%value_1d_r4(i)
698 END DO
699
700 ELSE IF (ASSOCIATED(entry%value_1d_r8)) THEN
701 WRITE (unit, "(A)") "datatype: 1d_r8"
702 WRITE (unit, "(A,I8)") "size: ", SIZE(entry%value_1d_r8)
703 DO i = 1, SIZE(entry%value_1d_r8)
704 WRITE (unit, "(1X,E30.20)") entry%value_1d_r8(i)
705 END DO
706
707 ELSE
708 cpabort("no value ASSOCIATED")
709 END IF
710 END SUBROUTINE swarm_message_entry_file_write
711
712! **************************************************************************************************
713!> \brief Helper routine for swarm_message_file_read.
714!> \param ENTRY ...
715!> \param parser ...
716!> \param at_end ...
717!> \author Ole Schuett
718! **************************************************************************************************
719 SUBROUTINE swarm_message_entry_file_read(ENTRY, parser, at_end)
720 TYPE(message_entry_type), INTENT(INOUT) :: entry
721 TYPE(cp_parser_type), INTENT(INOUT) :: parser
722 LOGICAL, INTENT(INOUT) :: at_end
723
724 CHARACTER(LEN=15) :: datatype, label
725 INTEGER :: arr_size, i
726 LOGICAL :: is_scalar
727
728 CALL parser_get_next_line(parser, 1, at_end)
729 at_end = at_end .OR. len_trim(parser%input_line(1:10)) == 0
730 IF (at_end) RETURN
731 READ (parser%input_line(1:key_length + 10), *) label, entry%key
732 cpassert(trim(label) == "key:")
733
734 CALL parser_get_next_line(parser, 1, at_end)
735 at_end = at_end .OR. len_trim(parser%input_line(1:10)) == 0
736 IF (at_end) RETURN
737 READ (parser%input_line(1:30), *) label, datatype
738 cpassert(trim(label) == "datatype:")
739
740 CALL parser_get_next_line(parser, 1, at_end)
741 at_end = at_end .OR. len_trim(parser%input_line(1:10)) == 0
742 IF (at_end) RETURN
743
744 is_scalar = .true.
745 SELECT CASE (trim(datatype))
746 CASE ("i4")
747 ALLOCATE (entry%value_i4)
748 READ (parser%input_line(1:40), *) label, entry%value_i4
749 CASE ("i8")
750 ALLOCATE (entry%value_i8)
751 READ (parser%input_line(1:40), *) label, entry%value_i8
752 CASE ("r4")
753 ALLOCATE (entry%value_r4)
754 READ (parser%input_line(1:40), *) label, entry%value_r4
755 CASE ("r8")
756 ALLOCATE (entry%value_r8)
757 READ (parser%input_line(1:40), *) label, entry%value_r8
758 CASE ("str")
759 ALLOCATE (entry%value_str)
760 READ (parser%input_line(1:40), *) label, entry%value_str
761 CASE DEFAULT
762 is_scalar = .false.
763 END SELECT
764
765 IF (is_scalar) THEN
766 cpassert(trim(label) == "value:")
767 RETURN
768 END IF
769
770 ! musst be an array-datatype
771 READ (parser%input_line(1:30), *) label, arr_size
772 cpassert(trim(label) == "size:")
773
774 SELECT CASE (trim(datatype))
775 CASE ("1d_i4")
776 ALLOCATE (entry%value_1d_i4(arr_size))
777 CASE ("1d_i8")
778 ALLOCATE (entry%value_1d_i8(arr_size))
779 CASE ("1d_r4")
780 ALLOCATE (entry%value_1d_r4(arr_size))
781 CASE ("1d_r8")
782 ALLOCATE (entry%value_1d_r8(arr_size))
783 CASE DEFAULT
784 cpabort("unknown datatype")
785 END SELECT
786
787 DO i = 1, arr_size
788 CALL parser_get_next_line(parser, 1, at_end)
789 at_end = at_end .OR. len_trim(parser%input_line(1:10)) == 0
790 IF (at_end) RETURN
791
792 !Numbers were written with at most 31 characters.
793 SELECT CASE (trim(datatype))
794 CASE ("1d_i4")
795 READ (parser%input_line(1:31), *) entry%value_1d_i4(i)
796 CASE ("1d_i8")
797 READ (parser%input_line(1:31), *) entry%value_1d_i8(i)
798 CASE ("1d_r4")
799 READ (parser%input_line(1:31), *) entry%value_1d_r4(i)
800 CASE ("1d_r8")
801 READ (parser%input_line(1:31), *) entry%value_1d_r8(i)
802 CASE DEFAULT
803 cpabort("swarm_message_entry_file_read: unknown datatype")
804 END SELECT
805 END DO
806
807 END SUBROUTINE swarm_message_entry_file_read
808
809! **************************************************************************************************
810!> \brief Helper routine, converts a string into an integer-array
811!> \param str ...
812!> \return ...
813!> \author Ole Schuett
814! **************************************************************************************************
815 PURE FUNCTION str2iarr(str) RESULT(arr)
816 CHARACTER(LEN=*), INTENT(IN) :: str
817 INTEGER, DIMENSION(LEN(str)) :: arr
818
819 INTEGER :: i
820
821 DO i = 1, len(str)
822 arr(i) = ichar(str(i:i))
823 END DO
824 END FUNCTION str2iarr
825
826! **************************************************************************************************
827!> \brief Helper routine, converts an integer-array into a string
828!> \param arr ...
829!> \return ...
830!> \author Ole Schuett
831! **************************************************************************************************
832 PURE FUNCTION iarr2str(arr) RESULT(str)
833 INTEGER, DIMENSION(:), INTENT(IN) :: arr
834 CHARACTER(LEN=SIZE(arr)) :: str
835
836 INTEGER :: i
837
838 DO i = 1, SIZE(arr)
839 str(i:i) = char(arr(i))
840 END DO
841 END FUNCTION iarr2str
842
843
844
845! **************************************************************************************************
846!> \brief Addes an entry from a swarm-message.
847!> \param msg ...
848!> \param key ...
849!> \param value ...
850!> \author Ole Schuett
851! **************************************************************************************************
852 SUBROUTINE swarm_message_add_str (msg, key, value)
853 TYPE(swarm_message_type), INTENT(INOUT) :: msg
854 CHARACTER(LEN=*), INTENT(IN) :: key
855 CHARACTER(LEN=*), INTENT(IN) :: value
856
857 TYPE(message_entry_type), POINTER :: new_entry
858
859 IF (swarm_message_haskey(msg, key)) THEN
860 cpabort("swarm_message_add_str: key already exists: "//trim(key))
861 END IF
862
863 ALLOCATE (new_entry)
864 new_entry%key = key
865
866 ALLOCATE (new_entry%value_str)
867
868 new_entry%value_str = value
869
870 !WRITE (*,*) "swarm_message_add_str: key=",key, " value=",new_entry%value_str
871
872 IF (.NOT. ASSOCIATED(msg%root)) THEN
873 msg%root => new_entry
874 ELSE
875 new_entry%next => msg%root
876 msg%root => new_entry
877 END IF
878
879 END SUBROUTINE swarm_message_add_str
880
881! **************************************************************************************************
882!> \brief Returns an entry from a swarm-message.
883!> \param msg ...
884!> \param key ...
885!> \param value ...
886!> \author Ole Schuett
887! **************************************************************************************************
888 SUBROUTINE swarm_message_get_str (msg, key, value)
889 TYPE(swarm_message_type), INTENT(IN) :: msg
890 CHARACTER(LEN=*), INTENT(IN) :: key
891
892 CHARACTER(LEN=default_string_length) :: value
893
894 TYPE(message_entry_type), POINTER :: curr_entry
895 !WRITE (*,*) "swarm_message_get_str: key=",key
896
897
898 curr_entry => msg%root
899 DO WHILE (ASSOCIATED(curr_entry))
900 IF (trim(curr_entry%key) == trim(key)) THEN
901 IF (.NOT. ASSOCIATED(curr_entry%value_str)) THEN
902 cpabort("swarm_message_get_str: value not associated key: "//trim(key))
903 END IF
904 value = curr_entry%value_str
905 !WRITE (*,*) "swarm_message_get_str: value=",value
906 RETURN
907 END IF
908 curr_entry => curr_entry%next
909 END DO
910 cpabort("swarm_message_get: key not found: "//trim(key))
911 END SUBROUTINE swarm_message_get_str
912
913
914! **************************************************************************************************
915!> \brief Addes an entry from a swarm-message.
916!> \param msg ...
917!> \param key ...
918!> \param value ...
919!> \author Ole Schuett
920! **************************************************************************************************
921 SUBROUTINE swarm_message_add_i4 (msg, key, value)
922 TYPE(swarm_message_type), INTENT(INOUT) :: msg
923 CHARACTER(LEN=*), INTENT(IN) :: key
924 INTEGER(KIND=int_4), INTENT(IN) :: value
925
926 TYPE(message_entry_type), POINTER :: new_entry
927
928 IF (swarm_message_haskey(msg, key)) THEN
929 cpabort("swarm_message_add_i4: key already exists: "//trim(key))
930 END IF
931
932 ALLOCATE (new_entry)
933 new_entry%key = key
934
935 ALLOCATE (new_entry%value_i4)
936
937 new_entry%value_i4 = value
938
939 !WRITE (*,*) "swarm_message_add_i4: key=",key, " value=",new_entry%value_i4
940
941 IF (.NOT. ASSOCIATED(msg%root)) THEN
942 msg%root => new_entry
943 ELSE
944 new_entry%next => msg%root
945 msg%root => new_entry
946 END IF
947
948 END SUBROUTINE swarm_message_add_i4
949
950! **************************************************************************************************
951!> \brief Returns an entry from a swarm-message.
952!> \param msg ...
953!> \param key ...
954!> \param value ...
955!> \author Ole Schuett
956! **************************************************************************************************
957 SUBROUTINE swarm_message_get_i4 (msg, key, value)
958 TYPE(swarm_message_type), INTENT(IN) :: msg
959 CHARACTER(LEN=*), INTENT(IN) :: key
960
961 INTEGER(KIND=int_4), INTENT(OUT) :: value
962
963 TYPE(message_entry_type), POINTER :: curr_entry
964 !WRITE (*,*) "swarm_message_get_i4: key=",key
965
966
967 curr_entry => msg%root
968 DO WHILE (ASSOCIATED(curr_entry))
969 IF (trim(curr_entry%key) == trim(key)) THEN
970 IF (.NOT. ASSOCIATED(curr_entry%value_i4)) THEN
971 cpabort("swarm_message_get_i4: value not associated key: "//trim(key))
972 END IF
973 value = curr_entry%value_i4
974 !WRITE (*,*) "swarm_message_get_i4: value=",value
975 RETURN
976 END IF
977 curr_entry => curr_entry%next
978 END DO
979 cpabort("swarm_message_get: key not found: "//trim(key))
980 END SUBROUTINE swarm_message_get_i4
981
982
983! **************************************************************************************************
984!> \brief Addes an entry from a swarm-message.
985!> \param msg ...
986!> \param key ...
987!> \param value ...
988!> \author Ole Schuett
989! **************************************************************************************************
990 SUBROUTINE swarm_message_add_i8 (msg, key, value)
991 TYPE(swarm_message_type), INTENT(INOUT) :: msg
992 CHARACTER(LEN=*), INTENT(IN) :: key
993 INTEGER(KIND=int_8), INTENT(IN) :: value
994
995 TYPE(message_entry_type), POINTER :: new_entry
996
997 IF (swarm_message_haskey(msg, key)) THEN
998 cpabort("swarm_message_add_i8: key already exists: "//trim(key))
999 END IF
1000
1001 ALLOCATE (new_entry)
1002 new_entry%key = key
1003
1004 ALLOCATE (new_entry%value_i8)
1005
1006 new_entry%value_i8 = value
1007
1008 !WRITE (*,*) "swarm_message_add_i8: key=",key, " value=",new_entry%value_i8
1009
1010 IF (.NOT. ASSOCIATED(msg%root)) THEN
1011 msg%root => new_entry
1012 ELSE
1013 new_entry%next => msg%root
1014 msg%root => new_entry
1015 END IF
1016
1017 END SUBROUTINE swarm_message_add_i8
1018
1019! **************************************************************************************************
1020!> \brief Returns an entry from a swarm-message.
1021!> \param msg ...
1022!> \param key ...
1023!> \param value ...
1024!> \author Ole Schuett
1025! **************************************************************************************************
1026 SUBROUTINE swarm_message_get_i8 (msg, key, value)
1027 TYPE(swarm_message_type), INTENT(IN) :: msg
1028 CHARACTER(LEN=*), INTENT(IN) :: key
1029
1030 INTEGER(KIND=int_8), INTENT(OUT) :: value
1031
1032 TYPE(message_entry_type), POINTER :: curr_entry
1033 !WRITE (*,*) "swarm_message_get_i8: key=",key
1034
1035
1036 curr_entry => msg%root
1037 DO WHILE (ASSOCIATED(curr_entry))
1038 IF (trim(curr_entry%key) == trim(key)) THEN
1039 IF (.NOT. ASSOCIATED(curr_entry%value_i8)) THEN
1040 cpabort("swarm_message_get_i8: value not associated key: "//trim(key))
1041 END IF
1042 value = curr_entry%value_i8
1043 !WRITE (*,*) "swarm_message_get_i8: value=",value
1044 RETURN
1045 END IF
1046 curr_entry => curr_entry%next
1047 END DO
1048 cpabort("swarm_message_get: key not found: "//trim(key))
1049 END SUBROUTINE swarm_message_get_i8
1050
1051
1052! **************************************************************************************************
1053!> \brief Addes an entry from a swarm-message.
1054!> \param msg ...
1055!> \param key ...
1056!> \param value ...
1057!> \author Ole Schuett
1058! **************************************************************************************************
1059 SUBROUTINE swarm_message_add_r4 (msg, key, value)
1060 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1061 CHARACTER(LEN=*), INTENT(IN) :: key
1062 REAL(KIND=real_4), INTENT(IN) :: value
1063
1064 TYPE(message_entry_type), POINTER :: new_entry
1065
1066 IF (swarm_message_haskey(msg, key)) THEN
1067 cpabort("swarm_message_add_r4: key already exists: "//trim(key))
1068 END IF
1069
1070 ALLOCATE (new_entry)
1071 new_entry%key = key
1072
1073 ALLOCATE (new_entry%value_r4)
1074
1075 new_entry%value_r4 = value
1076
1077 !WRITE (*,*) "swarm_message_add_r4: key=",key, " value=",new_entry%value_r4
1078
1079 IF (.NOT. ASSOCIATED(msg%root)) THEN
1080 msg%root => new_entry
1081 ELSE
1082 new_entry%next => msg%root
1083 msg%root => new_entry
1084 END IF
1085
1086 END SUBROUTINE swarm_message_add_r4
1087
1088! **************************************************************************************************
1089!> \brief Returns an entry from a swarm-message.
1090!> \param msg ...
1091!> \param key ...
1092!> \param value ...
1093!> \author Ole Schuett
1094! **************************************************************************************************
1095 SUBROUTINE swarm_message_get_r4 (msg, key, value)
1096 TYPE(swarm_message_type), INTENT(IN) :: msg
1097 CHARACTER(LEN=*), INTENT(IN) :: key
1098
1099 REAL(KIND=real_4), INTENT(OUT) :: value
1100
1101 TYPE(message_entry_type), POINTER :: curr_entry
1102 !WRITE (*,*) "swarm_message_get_r4: key=",key
1103
1104
1105 curr_entry => msg%root
1106 DO WHILE (ASSOCIATED(curr_entry))
1107 IF (trim(curr_entry%key) == trim(key)) THEN
1108 IF (.NOT. ASSOCIATED(curr_entry%value_r4)) THEN
1109 cpabort("swarm_message_get_r4: value not associated key: "//trim(key))
1110 END IF
1111 value = curr_entry%value_r4
1112 !WRITE (*,*) "swarm_message_get_r4: value=",value
1113 RETURN
1114 END IF
1115 curr_entry => curr_entry%next
1116 END DO
1117 cpabort("swarm_message_get: key not found: "//trim(key))
1118 END SUBROUTINE swarm_message_get_r4
1119
1120
1121! **************************************************************************************************
1122!> \brief Addes an entry from a swarm-message.
1123!> \param msg ...
1124!> \param key ...
1125!> \param value ...
1126!> \author Ole Schuett
1127! **************************************************************************************************
1128 SUBROUTINE swarm_message_add_r8 (msg, key, value)
1129 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1130 CHARACTER(LEN=*), INTENT(IN) :: key
1131 REAL(KIND=real_8), INTENT(IN) :: value
1132
1133 TYPE(message_entry_type), POINTER :: new_entry
1134
1135 IF (swarm_message_haskey(msg, key)) THEN
1136 cpabort("swarm_message_add_r8: key already exists: "//trim(key))
1137 END IF
1138
1139 ALLOCATE (new_entry)
1140 new_entry%key = key
1141
1142 ALLOCATE (new_entry%value_r8)
1143
1144 new_entry%value_r8 = value
1145
1146 !WRITE (*,*) "swarm_message_add_r8: key=",key, " value=",new_entry%value_r8
1147
1148 IF (.NOT. ASSOCIATED(msg%root)) THEN
1149 msg%root => new_entry
1150 ELSE
1151 new_entry%next => msg%root
1152 msg%root => new_entry
1153 END IF
1154
1155 END SUBROUTINE swarm_message_add_r8
1156
1157! **************************************************************************************************
1158!> \brief Returns an entry from a swarm-message.
1159!> \param msg ...
1160!> \param key ...
1161!> \param value ...
1162!> \author Ole Schuett
1163! **************************************************************************************************
1164 SUBROUTINE swarm_message_get_r8 (msg, key, value)
1165 TYPE(swarm_message_type), INTENT(IN) :: msg
1166 CHARACTER(LEN=*), INTENT(IN) :: key
1167
1168 REAL(KIND=real_8), INTENT(OUT) :: value
1169
1170 TYPE(message_entry_type), POINTER :: curr_entry
1171 !WRITE (*,*) "swarm_message_get_r8: key=",key
1172
1173
1174 curr_entry => msg%root
1175 DO WHILE (ASSOCIATED(curr_entry))
1176 IF (trim(curr_entry%key) == trim(key)) THEN
1177 IF (.NOT. ASSOCIATED(curr_entry%value_r8)) THEN
1178 cpabort("swarm_message_get_r8: value not associated key: "//trim(key))
1179 END IF
1180 value = curr_entry%value_r8
1181 !WRITE (*,*) "swarm_message_get_r8: value=",value
1182 RETURN
1183 END IF
1184 curr_entry => curr_entry%next
1185 END DO
1186 cpabort("swarm_message_get: key not found: "//trim(key))
1187 END SUBROUTINE swarm_message_get_r8
1188
1189
1190! **************************************************************************************************
1191!> \brief Addes an entry from a swarm-message.
1192!> \param msg ...
1193!> \param key ...
1194!> \param value ...
1195!> \author Ole Schuett
1196! **************************************************************************************************
1197 SUBROUTINE swarm_message_add_1d_i4 (msg, key, value)
1198 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1199 CHARACTER(LEN=*), INTENT(IN) :: key
1200 INTEGER(KIND=int_4), DIMENSION(:), INTENT(IN) :: value
1201
1202 TYPE(message_entry_type), POINTER :: new_entry
1203
1204 IF (swarm_message_haskey(msg, key)) THEN
1205 cpabort("swarm_message_add_1d_i4: key already exists: "//trim(key))
1206 END IF
1207
1208 ALLOCATE (new_entry)
1209 new_entry%key = key
1210
1211 ALLOCATE (new_entry%value_1d_i4 (SIZE(value)))
1212
1213 new_entry%value_1d_i4 = value
1214
1215 !WRITE (*,*) "swarm_message_add_1d_i4: key=",key, " value=",new_entry%value_1d_i4
1216
1217 IF (.NOT. ASSOCIATED(msg%root)) THEN
1218 msg%root => new_entry
1219 ELSE
1220 new_entry%next => msg%root
1221 msg%root => new_entry
1222 END IF
1223
1224 END SUBROUTINE swarm_message_add_1d_i4
1225
1226! **************************************************************************************************
1227!> \brief Returns an entry from a swarm-message.
1228!> \param msg ...
1229!> \param key ...
1230!> \param value ...
1231!> \author Ole Schuett
1232! **************************************************************************************************
1233 SUBROUTINE swarm_message_get_1d_i4 (msg, key, value)
1234 TYPE(swarm_message_type), INTENT(IN) :: msg
1235 CHARACTER(LEN=*), INTENT(IN) :: key
1236
1237 INTEGER(KIND=int_4), DIMENSION(:), POINTER :: value
1238
1239 TYPE(message_entry_type), POINTER :: curr_entry
1240 !WRITE (*,*) "swarm_message_get_1d_i4: key=",key
1241
1242 IF (ASSOCIATED(value)) cpabort("swarm_message_get_1d_i4: value already associated")
1243
1244 curr_entry => msg%root
1245 DO WHILE (ASSOCIATED(curr_entry))
1246 IF (trim(curr_entry%key) == trim(key)) THEN
1247 IF (.NOT. ASSOCIATED(curr_entry%value_1d_i4)) THEN
1248 cpabort("swarm_message_get_1d_i4: value not associated key: "//trim(key))
1249 END IF
1250 ALLOCATE (value(SIZE(curr_entry%value_1d_i4)))
1251 value = curr_entry%value_1d_i4
1252 !WRITE (*,*) "swarm_message_get_1d_i4: value=",value
1253 RETURN
1254 END IF
1255 curr_entry => curr_entry%next
1256 END DO
1257 cpabort("swarm_message_get: key not found: "//trim(key))
1258 END SUBROUTINE swarm_message_get_1d_i4
1259
1260
1261! **************************************************************************************************
1262!> \brief Addes an entry from a swarm-message.
1263!> \param msg ...
1264!> \param key ...
1265!> \param value ...
1266!> \author Ole Schuett
1267! **************************************************************************************************
1268 SUBROUTINE swarm_message_add_1d_i8 (msg, key, value)
1269 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1270 CHARACTER(LEN=*), INTENT(IN) :: key
1271 INTEGER(KIND=int_8), DIMENSION(:), INTENT(IN) :: value
1272
1273 TYPE(message_entry_type), POINTER :: new_entry
1274
1275 IF (swarm_message_haskey(msg, key)) THEN
1276 cpabort("swarm_message_add_1d_i8: key already exists: "//trim(key))
1277 END IF
1278
1279 ALLOCATE (new_entry)
1280 new_entry%key = key
1281
1282 ALLOCATE (new_entry%value_1d_i8 (SIZE(value)))
1283
1284 new_entry%value_1d_i8 = value
1285
1286 !WRITE (*,*) "swarm_message_add_1d_i8: key=",key, " value=",new_entry%value_1d_i8
1287
1288 IF (.NOT. ASSOCIATED(msg%root)) THEN
1289 msg%root => new_entry
1290 ELSE
1291 new_entry%next => msg%root
1292 msg%root => new_entry
1293 END IF
1294
1295 END SUBROUTINE swarm_message_add_1d_i8
1296
1297! **************************************************************************************************
1298!> \brief Returns an entry from a swarm-message.
1299!> \param msg ...
1300!> \param key ...
1301!> \param value ...
1302!> \author Ole Schuett
1303! **************************************************************************************************
1304 SUBROUTINE swarm_message_get_1d_i8 (msg, key, value)
1305 TYPE(swarm_message_type), INTENT(IN) :: msg
1306 CHARACTER(LEN=*), INTENT(IN) :: key
1307
1308 INTEGER(KIND=int_8), DIMENSION(:), POINTER :: value
1309
1310 TYPE(message_entry_type), POINTER :: curr_entry
1311 !WRITE (*,*) "swarm_message_get_1d_i8: key=",key
1312
1313 IF (ASSOCIATED(value)) cpabort("swarm_message_get_1d_i8: value already associated")
1314
1315 curr_entry => msg%root
1316 DO WHILE (ASSOCIATED(curr_entry))
1317 IF (trim(curr_entry%key) == trim(key)) THEN
1318 IF (.NOT. ASSOCIATED(curr_entry%value_1d_i8)) THEN
1319 cpabort("swarm_message_get_1d_i8: value not associated key: "//trim(key))
1320 END IF
1321 ALLOCATE (value(SIZE(curr_entry%value_1d_i8)))
1322 value = curr_entry%value_1d_i8
1323 !WRITE (*,*) "swarm_message_get_1d_i8: value=",value
1324 RETURN
1325 END IF
1326 curr_entry => curr_entry%next
1327 END DO
1328 cpabort("swarm_message_get: key not found: "//trim(key))
1329 END SUBROUTINE swarm_message_get_1d_i8
1330
1331
1332! **************************************************************************************************
1333!> \brief Addes an entry from a swarm-message.
1334!> \param msg ...
1335!> \param key ...
1336!> \param value ...
1337!> \author Ole Schuett
1338! **************************************************************************************************
1339 SUBROUTINE swarm_message_add_1d_r4 (msg, key, value)
1340 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1341 CHARACTER(LEN=*), INTENT(IN) :: key
1342 REAL(KIND=real_4), DIMENSION(:), INTENT(IN) :: value
1343
1344 TYPE(message_entry_type), POINTER :: new_entry
1345
1346 IF (swarm_message_haskey(msg, key)) THEN
1347 cpabort("swarm_message_add_1d_r4: key already exists: "//trim(key))
1348 END IF
1349
1350 ALLOCATE (new_entry)
1351 new_entry%key = key
1352
1353 ALLOCATE (new_entry%value_1d_r4 (SIZE(value)))
1354
1355 new_entry%value_1d_r4 = value
1356
1357 !WRITE (*,*) "swarm_message_add_1d_r4: key=",key, " value=",new_entry%value_1d_r4
1358
1359 IF (.NOT. ASSOCIATED(msg%root)) THEN
1360 msg%root => new_entry
1361 ELSE
1362 new_entry%next => msg%root
1363 msg%root => new_entry
1364 END IF
1365
1366 END SUBROUTINE swarm_message_add_1d_r4
1367
1368! **************************************************************************************************
1369!> \brief Returns an entry from a swarm-message.
1370!> \param msg ...
1371!> \param key ...
1372!> \param value ...
1373!> \author Ole Schuett
1374! **************************************************************************************************
1375 SUBROUTINE swarm_message_get_1d_r4 (msg, key, value)
1376 TYPE(swarm_message_type), INTENT(IN) :: msg
1377 CHARACTER(LEN=*), INTENT(IN) :: key
1378
1379 REAL(KIND=real_4), DIMENSION(:), POINTER :: value
1380
1381 TYPE(message_entry_type), POINTER :: curr_entry
1382 !WRITE (*,*) "swarm_message_get_1d_r4: key=",key
1383
1384 IF (ASSOCIATED(value)) cpabort("swarm_message_get_1d_r4: value already associated")
1385
1386 curr_entry => msg%root
1387 DO WHILE (ASSOCIATED(curr_entry))
1388 IF (trim(curr_entry%key) == trim(key)) THEN
1389 IF (.NOT. ASSOCIATED(curr_entry%value_1d_r4)) THEN
1390 cpabort("swarm_message_get_1d_r4: value not associated key: "//trim(key))
1391 END IF
1392 ALLOCATE (value(SIZE(curr_entry%value_1d_r4)))
1393 value = curr_entry%value_1d_r4
1394 !WRITE (*,*) "swarm_message_get_1d_r4: value=",value
1395 RETURN
1396 END IF
1397 curr_entry => curr_entry%next
1398 END DO
1399 cpabort("swarm_message_get: key not found: "//trim(key))
1400 END SUBROUTINE swarm_message_get_1d_r4
1401
1402
1403! **************************************************************************************************
1404!> \brief Addes an entry from a swarm-message.
1405!> \param msg ...
1406!> \param key ...
1407!> \param value ...
1408!> \author Ole Schuett
1409! **************************************************************************************************
1410 SUBROUTINE swarm_message_add_1d_r8 (msg, key, value)
1411 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1412 CHARACTER(LEN=*), INTENT(IN) :: key
1413 REAL(KIND=real_8), DIMENSION(:), INTENT(IN) :: value
1414
1415 TYPE(message_entry_type), POINTER :: new_entry
1416
1417 IF (swarm_message_haskey(msg, key)) THEN
1418 cpabort("swarm_message_add_1d_r8: key already exists: "//trim(key))
1419 END IF
1420
1421 ALLOCATE (new_entry)
1422 new_entry%key = key
1423
1424 ALLOCATE (new_entry%value_1d_r8 (SIZE(value)))
1425
1426 new_entry%value_1d_r8 = value
1427
1428 !WRITE (*,*) "swarm_message_add_1d_r8: key=",key, " value=",new_entry%value_1d_r8
1429
1430 IF (.NOT. ASSOCIATED(msg%root)) THEN
1431 msg%root => new_entry
1432 ELSE
1433 new_entry%next => msg%root
1434 msg%root => new_entry
1435 END IF
1436
1437 END SUBROUTINE swarm_message_add_1d_r8
1438
1439! **************************************************************************************************
1440!> \brief Returns an entry from a swarm-message.
1441!> \param msg ...
1442!> \param key ...
1443!> \param value ...
1444!> \author Ole Schuett
1445! **************************************************************************************************
1446 SUBROUTINE swarm_message_get_1d_r8 (msg, key, value)
1447 TYPE(swarm_message_type), INTENT(IN) :: msg
1448 CHARACTER(LEN=*), INTENT(IN) :: key
1449
1450 REAL(KIND=real_8), DIMENSION(:), POINTER :: value
1451
1452 TYPE(message_entry_type), POINTER :: curr_entry
1453 !WRITE (*,*) "swarm_message_get_1d_r8: key=",key
1454
1455 IF (ASSOCIATED(value)) cpabort("swarm_message_get_1d_r8: value already associated")
1456
1457 curr_entry => msg%root
1458 DO WHILE (ASSOCIATED(curr_entry))
1459 IF (trim(curr_entry%key) == trim(key)) THEN
1460 IF (.NOT. ASSOCIATED(curr_entry%value_1d_r8)) THEN
1461 cpabort("swarm_message_get_1d_r8: value not associated key: "//trim(key))
1462 END IF
1463 ALLOCATE (value(SIZE(curr_entry%value_1d_r8)))
1464 value = curr_entry%value_1d_r8
1465 !WRITE (*,*) "swarm_message_get_1d_r8: value=",value
1466 RETURN
1467 END IF
1468 curr_entry => curr_entry%next
1469 END DO
1470 cpabort("swarm_message_get: key not found: "//trim(key))
1471 END SUBROUTINE swarm_message_get_1d_r8
1472
1473
1474END MODULE swarm_message
1475
swarm_message::swarm_message_add
Adds an entry from a swarm-message.
Definition swarm_message.F:54
swarm_message::swarm_message_get
Returns an entry from a swarm-message.
Definition swarm_message.F:66
cp_parser_methods
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_methods.F:20
cp_parser_methods::parser_get_next_line
subroutine, public parser_get_next_line(parser, nline, at_end)
Read the next input line and broadcast the input information. Skip (nline-1) lines and skip also all ...
Definition cp_parser_methods.F:421
cp_parser_types
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_types.F:21
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::int_8
integer, parameter, public int_8
Definition kinds.F:54
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
kinds::real_4
integer, parameter, public real_4
Definition kinds.F:40
kinds::real_8
integer, parameter, public real_8
Definition kinds.F:41
kinds::int_4
integer, parameter, public int_4
Definition kinds.F:51
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
swarm_message
Swarm-message, a convenient data-container for with build-in serialization.
Definition swarm_message.F:12
swarm_message::swarm_message_mpi_send
subroutine, public swarm_message_mpi_send(msg, group, dest, tag)
Sends a swarm message via MPI.
Definition swarm_message.F:183
swarm_message::swarm_message_mpi_bcast
subroutine, public swarm_message_mpi_bcast(msg, src, group)
Broadcasts a swarm message via MPI.
Definition swarm_message.F:232
swarm_message::swarm_message_mpi_recv
subroutine, public swarm_message_mpi_recv(msg, group, src, tag)
Receives a swarm message via MPI.
Definition swarm_message.F:206
swarm_message::swarm_message_file_write
subroutine, public swarm_message_file_write(msg, unit)
Write a swarm-message to a given file / unit.
Definition swarm_message.F:270
swarm_message::swarm_message_equal
logical function, public swarm_message_equal(msg1, msg2)
Checks if two swarm-messages are equal.
Definition swarm_message.F:166
swarm_message::swarm_message_haskey
logical function, public swarm_message_haskey(msg, key)
Checks if a swarm-message contains an entry with the given key.
Definition swarm_message.F:110
swarm_message::swarm_message_free
subroutine, public swarm_message_free(msg)
Deallocates all entries contained in a swarm-message.
Definition swarm_message.F:133
swarm_message::key_length
integer, parameter key_length
Definition swarm_message.F:34
swarm_message::swarm_message_file_read
subroutine, public swarm_message_file_read(msg, parser, at_end)
Reads a swarm-message from a given file / unit.
Definition swarm_message.F:301
cp_parser_types::cp_parser_type
represent a parser
Definition cp_parser_types.F:77
message_passing::mp_comm_type
Definition message_passing.F:161
swarm_message::swarm_message_type
Definition swarm_message.F:29