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