(git:374b731)
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-2024 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)) &
860 cpabort("swarm_message_add_str: key already exists: "//trim(key))
861
862 ALLOCATE (new_entry)
863 new_entry%key = key
864
865 ALLOCATE (new_entry%value_str)
866
867 new_entry%value_str = value
868
869 !WRITE (*,*) "swarm_message_add_str: key=",key, " value=",new_entry%value_str
870
871 IF (.NOT. ASSOCIATED(msg%root)) THEN
872 msg%root => new_entry
873 ELSE
874 new_entry%next => msg%root
875 msg%root => new_entry
876 END IF
877
878 END SUBROUTINE swarm_message_add_str
879
880! **************************************************************************************************
881!> \brief Returns an entry from a swarm-message.
882!> \param msg ...
883!> \param key ...
884!> \param value ...
885!> \author Ole Schuett
886! **************************************************************************************************
887 SUBROUTINE swarm_message_get_str (msg, key, value)
888 TYPE(swarm_message_type), INTENT(IN) :: msg
889 CHARACTER(LEN=*), INTENT(IN) :: key
890
891 CHARACTER(LEN=default_string_length) :: value
892
893 TYPE(message_entry_type), POINTER :: curr_entry
894 !WRITE (*,*) "swarm_message_get_str: key=",key
895
896
897 curr_entry => msg%root
898 DO WHILE (ASSOCIATED(curr_entry))
899 IF (trim(curr_entry%key) == trim(key)) THEN
900 IF (.NOT. ASSOCIATED(curr_entry%value_str)) &
901 cpabort("swarm_message_get_str: value not associated key: "//trim(key))
902 value = curr_entry%value_str
903 !WRITE (*,*) "swarm_message_get_str: value=",value
904 RETURN
905 END IF
906 curr_entry => curr_entry%next
907 END DO
908 cpabort("swarm_message_get: key not found: "//trim(key))
909 END SUBROUTINE swarm_message_get_str
910
911
912! **************************************************************************************************
913!> \brief Addes an entry from a swarm-message.
914!> \param msg ...
915!> \param key ...
916!> \param value ...
917!> \author Ole Schuett
918! **************************************************************************************************
919 SUBROUTINE swarm_message_add_i4 (msg, key, value)
920 TYPE(swarm_message_type), INTENT(INOUT) :: msg
921 CHARACTER(LEN=*), INTENT(IN) :: key
922 INTEGER(KIND=int_4), INTENT(IN) :: value
923
924 TYPE(message_entry_type), POINTER :: new_entry
925
926 IF (swarm_message_haskey(msg, key)) &
927 cpabort("swarm_message_add_i4: key already exists: "//trim(key))
928
929 ALLOCATE (new_entry)
930 new_entry%key = key
931
932 ALLOCATE (new_entry%value_i4)
933
934 new_entry%value_i4 = value
935
936 !WRITE (*,*) "swarm_message_add_i4: key=",key, " value=",new_entry%value_i4
937
938 IF (.NOT. ASSOCIATED(msg%root)) THEN
939 msg%root => new_entry
940 ELSE
941 new_entry%next => msg%root
942 msg%root => new_entry
943 END IF
944
945 END SUBROUTINE swarm_message_add_i4
946
947! **************************************************************************************************
948!> \brief Returns an entry from a swarm-message.
949!> \param msg ...
950!> \param key ...
951!> \param value ...
952!> \author Ole Schuett
953! **************************************************************************************************
954 SUBROUTINE swarm_message_get_i4 (msg, key, value)
955 TYPE(swarm_message_type), INTENT(IN) :: msg
956 CHARACTER(LEN=*), INTENT(IN) :: key
957
958 INTEGER(KIND=int_4), INTENT(OUT) :: value
959
960 TYPE(message_entry_type), POINTER :: curr_entry
961 !WRITE (*,*) "swarm_message_get_i4: key=",key
962
963
964 curr_entry => msg%root
965 DO WHILE (ASSOCIATED(curr_entry))
966 IF (trim(curr_entry%key) == trim(key)) THEN
967 IF (.NOT. ASSOCIATED(curr_entry%value_i4)) &
968 cpabort("swarm_message_get_i4: value not associated key: "//trim(key))
969 value = curr_entry%value_i4
970 !WRITE (*,*) "swarm_message_get_i4: value=",value
971 RETURN
972 END IF
973 curr_entry => curr_entry%next
974 END DO
975 cpabort("swarm_message_get: key not found: "//trim(key))
976 END SUBROUTINE swarm_message_get_i4
977
978
979! **************************************************************************************************
980!> \brief Addes an entry from a swarm-message.
981!> \param msg ...
982!> \param key ...
983!> \param value ...
984!> \author Ole Schuett
985! **************************************************************************************************
986 SUBROUTINE swarm_message_add_i8 (msg, key, value)
987 TYPE(swarm_message_type), INTENT(INOUT) :: msg
988 CHARACTER(LEN=*), INTENT(IN) :: key
989 INTEGER(KIND=int_8), INTENT(IN) :: value
990
991 TYPE(message_entry_type), POINTER :: new_entry
992
993 IF (swarm_message_haskey(msg, key)) &
994 cpabort("swarm_message_add_i8: key already exists: "//trim(key))
995
996 ALLOCATE (new_entry)
997 new_entry%key = key
998
999 ALLOCATE (new_entry%value_i8)
1000
1001 new_entry%value_i8 = value
1002
1003 !WRITE (*,*) "swarm_message_add_i8: key=",key, " value=",new_entry%value_i8
1004
1005 IF (.NOT. ASSOCIATED(msg%root)) THEN
1006 msg%root => new_entry
1007 ELSE
1008 new_entry%next => msg%root
1009 msg%root => new_entry
1010 END IF
1011
1012 END SUBROUTINE swarm_message_add_i8
1013
1014! **************************************************************************************************
1015!> \brief Returns an entry from a swarm-message.
1016!> \param msg ...
1017!> \param key ...
1018!> \param value ...
1019!> \author Ole Schuett
1020! **************************************************************************************************
1021 SUBROUTINE swarm_message_get_i8 (msg, key, value)
1022 TYPE(swarm_message_type), INTENT(IN) :: msg
1023 CHARACTER(LEN=*), INTENT(IN) :: key
1024
1025 INTEGER(KIND=int_8), INTENT(OUT) :: value
1026
1027 TYPE(message_entry_type), POINTER :: curr_entry
1028 !WRITE (*,*) "swarm_message_get_i8: key=",key
1029
1030
1031 curr_entry => msg%root
1032 DO WHILE (ASSOCIATED(curr_entry))
1033 IF (trim(curr_entry%key) == trim(key)) THEN
1034 IF (.NOT. ASSOCIATED(curr_entry%value_i8)) &
1035 cpabort("swarm_message_get_i8: value not associated key: "//trim(key))
1036 value = curr_entry%value_i8
1037 !WRITE (*,*) "swarm_message_get_i8: value=",value
1038 RETURN
1039 END IF
1040 curr_entry => curr_entry%next
1041 END DO
1042 cpabort("swarm_message_get: key not found: "//trim(key))
1043 END SUBROUTINE swarm_message_get_i8
1044
1045
1046! **************************************************************************************************
1047!> \brief Addes an entry from a swarm-message.
1048!> \param msg ...
1049!> \param key ...
1050!> \param value ...
1051!> \author Ole Schuett
1052! **************************************************************************************************
1053 SUBROUTINE swarm_message_add_r4 (msg, key, value)
1054 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1055 CHARACTER(LEN=*), INTENT(IN) :: key
1056 REAL(KIND=real_4), INTENT(IN) :: value
1057
1058 TYPE(message_entry_type), POINTER :: new_entry
1059
1060 IF (swarm_message_haskey(msg, key)) &
1061 cpabort("swarm_message_add_r4: key already exists: "//trim(key))
1062
1063 ALLOCATE (new_entry)
1064 new_entry%key = key
1065
1066 ALLOCATE (new_entry%value_r4)
1067
1068 new_entry%value_r4 = value
1069
1070 !WRITE (*,*) "swarm_message_add_r4: key=",key, " value=",new_entry%value_r4
1071
1072 IF (.NOT. ASSOCIATED(msg%root)) THEN
1073 msg%root => new_entry
1074 ELSE
1075 new_entry%next => msg%root
1076 msg%root => new_entry
1077 END IF
1078
1079 END SUBROUTINE swarm_message_add_r4
1080
1081! **************************************************************************************************
1082!> \brief Returns an entry from a swarm-message.
1083!> \param msg ...
1084!> \param key ...
1085!> \param value ...
1086!> \author Ole Schuett
1087! **************************************************************************************************
1088 SUBROUTINE swarm_message_get_r4 (msg, key, value)
1089 TYPE(swarm_message_type), INTENT(IN) :: msg
1090 CHARACTER(LEN=*), INTENT(IN) :: key
1091
1092 REAL(KIND=real_4), INTENT(OUT) :: value
1093
1094 TYPE(message_entry_type), POINTER :: curr_entry
1095 !WRITE (*,*) "swarm_message_get_r4: key=",key
1096
1097
1098 curr_entry => msg%root
1099 DO WHILE (ASSOCIATED(curr_entry))
1100 IF (trim(curr_entry%key) == trim(key)) THEN
1101 IF (.NOT. ASSOCIATED(curr_entry%value_r4)) &
1102 cpabort("swarm_message_get_r4: value not associated key: "//trim(key))
1103 value = curr_entry%value_r4
1104 !WRITE (*,*) "swarm_message_get_r4: value=",value
1105 RETURN
1106 END IF
1107 curr_entry => curr_entry%next
1108 END DO
1109 cpabort("swarm_message_get: key not found: "//trim(key))
1110 END SUBROUTINE swarm_message_get_r4
1111
1112
1113! **************************************************************************************************
1114!> \brief Addes an entry from a swarm-message.
1115!> \param msg ...
1116!> \param key ...
1117!> \param value ...
1118!> \author Ole Schuett
1119! **************************************************************************************************
1120 SUBROUTINE swarm_message_add_r8 (msg, key, value)
1121 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1122 CHARACTER(LEN=*), INTENT(IN) :: key
1123 REAL(KIND=real_8), INTENT(IN) :: value
1124
1125 TYPE(message_entry_type), POINTER :: new_entry
1126
1127 IF (swarm_message_haskey(msg, key)) &
1128 cpabort("swarm_message_add_r8: key already exists: "//trim(key))
1129
1130 ALLOCATE (new_entry)
1131 new_entry%key = key
1132
1133 ALLOCATE (new_entry%value_r8)
1134
1135 new_entry%value_r8 = value
1136
1137 !WRITE (*,*) "swarm_message_add_r8: key=",key, " value=",new_entry%value_r8
1138
1139 IF (.NOT. ASSOCIATED(msg%root)) THEN
1140 msg%root => new_entry
1141 ELSE
1142 new_entry%next => msg%root
1143 msg%root => new_entry
1144 END IF
1145
1146 END SUBROUTINE swarm_message_add_r8
1147
1148! **************************************************************************************************
1149!> \brief Returns an entry from a swarm-message.
1150!> \param msg ...
1151!> \param key ...
1152!> \param value ...
1153!> \author Ole Schuett
1154! **************************************************************************************************
1155 SUBROUTINE swarm_message_get_r8 (msg, key, value)
1156 TYPE(swarm_message_type), INTENT(IN) :: msg
1157 CHARACTER(LEN=*), INTENT(IN) :: key
1158
1159 REAL(KIND=real_8), INTENT(OUT) :: value
1160
1161 TYPE(message_entry_type), POINTER :: curr_entry
1162 !WRITE (*,*) "swarm_message_get_r8: key=",key
1163
1164
1165 curr_entry => msg%root
1166 DO WHILE (ASSOCIATED(curr_entry))
1167 IF (trim(curr_entry%key) == trim(key)) THEN
1168 IF (.NOT. ASSOCIATED(curr_entry%value_r8)) &
1169 cpabort("swarm_message_get_r8: value not associated key: "//trim(key))
1170 value = curr_entry%value_r8
1171 !WRITE (*,*) "swarm_message_get_r8: value=",value
1172 RETURN
1173 END IF
1174 curr_entry => curr_entry%next
1175 END DO
1176 cpabort("swarm_message_get: key not found: "//trim(key))
1177 END SUBROUTINE swarm_message_get_r8
1178
1179
1180! **************************************************************************************************
1181!> \brief Addes an entry from a swarm-message.
1182!> \param msg ...
1183!> \param key ...
1184!> \param value ...
1185!> \author Ole Schuett
1186! **************************************************************************************************
1187 SUBROUTINE swarm_message_add_1d_i4 (msg, key, value)
1188 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1189 CHARACTER(LEN=*), INTENT(IN) :: key
1190 INTEGER(KIND=int_4), DIMENSION(:), INTENT(IN) :: value
1191
1192 TYPE(message_entry_type), POINTER :: new_entry
1193
1194 IF (swarm_message_haskey(msg, key)) &
1195 cpabort("swarm_message_add_1d_i4: key already exists: "//trim(key))
1196
1197 ALLOCATE (new_entry)
1198 new_entry%key = key
1199
1200 ALLOCATE (new_entry%value_1d_i4 (SIZE(value)))
1201
1202 new_entry%value_1d_i4 = value
1203
1204 !WRITE (*,*) "swarm_message_add_1d_i4: key=",key, " value=",new_entry%value_1d_i4
1205
1206 IF (.NOT. ASSOCIATED(msg%root)) THEN
1207 msg%root => new_entry
1208 ELSE
1209 new_entry%next => msg%root
1210 msg%root => new_entry
1211 END IF
1212
1213 END SUBROUTINE swarm_message_add_1d_i4
1214
1215! **************************************************************************************************
1216!> \brief Returns an entry from a swarm-message.
1217!> \param msg ...
1218!> \param key ...
1219!> \param value ...
1220!> \author Ole Schuett
1221! **************************************************************************************************
1222 SUBROUTINE swarm_message_get_1d_i4 (msg, key, value)
1223 TYPE(swarm_message_type), INTENT(IN) :: msg
1224 CHARACTER(LEN=*), INTENT(IN) :: key
1225
1226 INTEGER(KIND=int_4), DIMENSION(:), POINTER :: value
1227
1228 TYPE(message_entry_type), POINTER :: curr_entry
1229 !WRITE (*,*) "swarm_message_get_1d_i4: key=",key
1230
1231 IF (ASSOCIATED(value)) cpabort("swarm_message_get_1d_i4: value already associated")
1232
1233 curr_entry => msg%root
1234 DO WHILE (ASSOCIATED(curr_entry))
1235 IF (trim(curr_entry%key) == trim(key)) THEN
1236 IF (.NOT. ASSOCIATED(curr_entry%value_1d_i4)) &
1237 cpabort("swarm_message_get_1d_i4: value not associated key: "//trim(key))
1238 ALLOCATE (value(SIZE(curr_entry%value_1d_i4)))
1239 value = curr_entry%value_1d_i4
1240 !WRITE (*,*) "swarm_message_get_1d_i4: value=",value
1241 RETURN
1242 END IF
1243 curr_entry => curr_entry%next
1244 END DO
1245 cpabort("swarm_message_get: key not found: "//trim(key))
1246 END SUBROUTINE swarm_message_get_1d_i4
1247
1248
1249! **************************************************************************************************
1250!> \brief Addes an entry from a swarm-message.
1251!> \param msg ...
1252!> \param key ...
1253!> \param value ...
1254!> \author Ole Schuett
1255! **************************************************************************************************
1256 SUBROUTINE swarm_message_add_1d_i8 (msg, key, value)
1257 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1258 CHARACTER(LEN=*), INTENT(IN) :: key
1259 INTEGER(KIND=int_8), DIMENSION(:), INTENT(IN) :: value
1260
1261 TYPE(message_entry_type), POINTER :: new_entry
1262
1263 IF (swarm_message_haskey(msg, key)) &
1264 cpabort("swarm_message_add_1d_i8: key already exists: "//trim(key))
1265
1266 ALLOCATE (new_entry)
1267 new_entry%key = key
1268
1269 ALLOCATE (new_entry%value_1d_i8 (SIZE(value)))
1270
1271 new_entry%value_1d_i8 = value
1272
1273 !WRITE (*,*) "swarm_message_add_1d_i8: key=",key, " value=",new_entry%value_1d_i8
1274
1275 IF (.NOT. ASSOCIATED(msg%root)) THEN
1276 msg%root => new_entry
1277 ELSE
1278 new_entry%next => msg%root
1279 msg%root => new_entry
1280 END IF
1281
1282 END SUBROUTINE swarm_message_add_1d_i8
1283
1284! **************************************************************************************************
1285!> \brief Returns an entry from a swarm-message.
1286!> \param msg ...
1287!> \param key ...
1288!> \param value ...
1289!> \author Ole Schuett
1290! **************************************************************************************************
1291 SUBROUTINE swarm_message_get_1d_i8 (msg, key, value)
1292 TYPE(swarm_message_type), INTENT(IN) :: msg
1293 CHARACTER(LEN=*), INTENT(IN) :: key
1294
1295 INTEGER(KIND=int_8), DIMENSION(:), POINTER :: value
1296
1297 TYPE(message_entry_type), POINTER :: curr_entry
1298 !WRITE (*,*) "swarm_message_get_1d_i8: key=",key
1299
1300 IF (ASSOCIATED(value)) cpabort("swarm_message_get_1d_i8: value already associated")
1301
1302 curr_entry => msg%root
1303 DO WHILE (ASSOCIATED(curr_entry))
1304 IF (trim(curr_entry%key) == trim(key)) THEN
1305 IF (.NOT. ASSOCIATED(curr_entry%value_1d_i8)) &
1306 cpabort("swarm_message_get_1d_i8: value not associated key: "//trim(key))
1307 ALLOCATE (value(SIZE(curr_entry%value_1d_i8)))
1308 value = curr_entry%value_1d_i8
1309 !WRITE (*,*) "swarm_message_get_1d_i8: value=",value
1310 RETURN
1311 END IF
1312 curr_entry => curr_entry%next
1313 END DO
1314 cpabort("swarm_message_get: key not found: "//trim(key))
1315 END SUBROUTINE swarm_message_get_1d_i8
1316
1317
1318! **************************************************************************************************
1319!> \brief Addes an entry from a swarm-message.
1320!> \param msg ...
1321!> \param key ...
1322!> \param value ...
1323!> \author Ole Schuett
1324! **************************************************************************************************
1325 SUBROUTINE swarm_message_add_1d_r4 (msg, key, value)
1326 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1327 CHARACTER(LEN=*), INTENT(IN) :: key
1328 REAL(KIND=real_4), DIMENSION(:), INTENT(IN) :: value
1329
1330 TYPE(message_entry_type), POINTER :: new_entry
1331
1332 IF (swarm_message_haskey(msg, key)) &
1333 cpabort("swarm_message_add_1d_r4: key already exists: "//trim(key))
1334
1335 ALLOCATE (new_entry)
1336 new_entry%key = key
1337
1338 ALLOCATE (new_entry%value_1d_r4 (SIZE(value)))
1339
1340 new_entry%value_1d_r4 = value
1341
1342 !WRITE (*,*) "swarm_message_add_1d_r4: key=",key, " value=",new_entry%value_1d_r4
1343
1344 IF (.NOT. ASSOCIATED(msg%root)) THEN
1345 msg%root => new_entry
1346 ELSE
1347 new_entry%next => msg%root
1348 msg%root => new_entry
1349 END IF
1350
1351 END SUBROUTINE swarm_message_add_1d_r4
1352
1353! **************************************************************************************************
1354!> \brief Returns an entry from a swarm-message.
1355!> \param msg ...
1356!> \param key ...
1357!> \param value ...
1358!> \author Ole Schuett
1359! **************************************************************************************************
1360 SUBROUTINE swarm_message_get_1d_r4 (msg, key, value)
1361 TYPE(swarm_message_type), INTENT(IN) :: msg
1362 CHARACTER(LEN=*), INTENT(IN) :: key
1363
1364 REAL(KIND=real_4), DIMENSION(:), POINTER :: value
1365
1366 TYPE(message_entry_type), POINTER :: curr_entry
1367 !WRITE (*,*) "swarm_message_get_1d_r4: key=",key
1368
1369 IF (ASSOCIATED(value)) cpabort("swarm_message_get_1d_r4: value already associated")
1370
1371 curr_entry => msg%root
1372 DO WHILE (ASSOCIATED(curr_entry))
1373 IF (trim(curr_entry%key) == trim(key)) THEN
1374 IF (.NOT. ASSOCIATED(curr_entry%value_1d_r4)) &
1375 cpabort("swarm_message_get_1d_r4: value not associated key: "//trim(key))
1376 ALLOCATE (value(SIZE(curr_entry%value_1d_r4)))
1377 value = curr_entry%value_1d_r4
1378 !WRITE (*,*) "swarm_message_get_1d_r4: value=",value
1379 RETURN
1380 END IF
1381 curr_entry => curr_entry%next
1382 END DO
1383 cpabort("swarm_message_get: key not found: "//trim(key))
1384 END SUBROUTINE swarm_message_get_1d_r4
1385
1386
1387! **************************************************************************************************
1388!> \brief Addes an entry from a swarm-message.
1389!> \param msg ...
1390!> \param key ...
1391!> \param value ...
1392!> \author Ole Schuett
1393! **************************************************************************************************
1394 SUBROUTINE swarm_message_add_1d_r8 (msg, key, value)
1395 TYPE(swarm_message_type), INTENT(INOUT) :: msg
1396 CHARACTER(LEN=*), INTENT(IN) :: key
1397 REAL(KIND=real_8), DIMENSION(:), INTENT(IN) :: value
1398
1399 TYPE(message_entry_type), POINTER :: new_entry
1400
1401 IF (swarm_message_haskey(msg, key)) &
1402 cpabort("swarm_message_add_1d_r8: key already exists: "//trim(key))
1403
1404 ALLOCATE (new_entry)
1405 new_entry%key = key
1406
1407 ALLOCATE (new_entry%value_1d_r8 (SIZE(value)))
1408
1409 new_entry%value_1d_r8 = value
1410
1411 !WRITE (*,*) "swarm_message_add_1d_r8: key=",key, " value=",new_entry%value_1d_r8
1412
1413 IF (.NOT. ASSOCIATED(msg%root)) THEN
1414 msg%root => new_entry
1415 ELSE
1416 new_entry%next => msg%root
1417 msg%root => new_entry
1418 END IF
1419
1420 END SUBROUTINE swarm_message_add_1d_r8
1421
1422! **************************************************************************************************
1423!> \brief Returns an entry from a swarm-message.
1424!> \param msg ...
1425!> \param key ...
1426!> \param value ...
1427!> \author Ole Schuett
1428! **************************************************************************************************
1429 SUBROUTINE swarm_message_get_1d_r8 (msg, key, value)
1430 TYPE(swarm_message_type), INTENT(IN) :: msg
1431 CHARACTER(LEN=*), INTENT(IN) :: key
1432
1433 REAL(KIND=real_8), DIMENSION(:), POINTER :: value
1434
1435 TYPE(message_entry_type), POINTER :: curr_entry
1436 !WRITE (*,*) "swarm_message_get_1d_r8: key=",key
1437
1438 IF (ASSOCIATED(value)) cpabort("swarm_message_get_1d_r8: value already associated")
1439
1440 curr_entry => msg%root
1441 DO WHILE (ASSOCIATED(curr_entry))
1442 IF (trim(curr_entry%key) == trim(key)) THEN
1443 IF (.NOT. ASSOCIATED(curr_entry%value_1d_r8)) &
1444 cpabort("swarm_message_get_1d_r8: value not associated key: "//trim(key))
1445 ALLOCATE (value(SIZE(curr_entry%value_1d_r8)))
1446 value = curr_entry%value_1d_r8
1447 !WRITE (*,*) "swarm_message_get_1d_r8: value=",value
1448 RETURN
1449 END IF
1450 curr_entry => curr_entry%next
1451 END DO
1452 cpabort("swarm_message_get: key not found: "//trim(key))
1453 END SUBROUTINE swarm_message_get_1d_r8
1454
1455
1456END MODULE swarm_message
1457
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:189
swarm_message::swarm_message_type
Definition swarm_message.F:29