Octopus
multisystem_debug.F90
Go to the documentation of this file.
1!! Copyright (C) 2021 M. Lueders
2!!
3!! This Source Code Form is subject to the terms of the Mozilla Public
4!! License, v. 2.0. If a copy of the MPL was not distributed with this
5!! file, You can obtain one at https://mozilla.org/MPL/2.0/.
6!!
7
8#include "global.h"
9
18 use debug_oct_m
19 use global_oct_m
20 use io_oct_m
22 use mpi_oct_m
25
26 implicit none
27
28 private
29
30 public &
41
42 integer, parameter, public :: MAX_INFO_LEN = 256
43
44
45 !-------------------------------------------------------------------
46
49 type, abstract :: event_info_t
50 private
51 contains
52 procedure(event_info_get_info), deferred :: get_info
53 end type event_info_t
54
55 abstract interface
56
57 function event_info_get_info(this) result(result)
58 import event_info_t
59 import max_info_len
60 class(event_info_t), intent(in) :: this
61 character(len=MAX_INFO_LEN) :: result
62 end function event_info_get_info
63
64 end interface
65
66 !-------------------------------------------------------------------
67
70 type, extends(event_info_t) :: event_function_call_t
71 character(len=MAX_INFO_LEN) :: function_name
72 character(len=ALGO_LABEL_LEN) :: op_label
73 contains
74 procedure :: get_info => event_function_call_get_info
76
77 interface event_function_call_t
78 procedure :: event_function_call_constructor
79 end interface event_function_call_t
80
81 !-------------------------------------------------------------------
82
86 character(len=MAX_INFO_LEN) :: name
87 character(len=MAX_INFO_LEN) :: detail
88 class(iteration_counter_t), allocatable :: iteration
89 character(len=MAX_INFO_LEN) :: action
90 contains
91 procedure :: get_info => event_iteration_update_get_info
93
95 procedure :: event_iteration_update_constructor
96 end interface event_iteration_update_t
97
98 !-------------------------------------------------------------------
99
102 type, extends(event_info_t) :: event_marker_t
103 character(len=MAX_INFO_LEN) :: text
104 contains
105 procedure :: get_info => event_marker_get_info
106 end type event_marker_t
107
108 interface event_marker_t
109 procedure :: event_marker_constructor
110 end interface event_marker_t
111
112 !-------------------------------------------------------------------
113
116 type :: event_handle_t
117 integer, public :: enter_ID
118 end type event_handle_t
119
120 interface event_handle_t
121 procedure :: event_handle_constructor
122 end interface event_handle_t
123
124 !-------------------------------------------------------------------
125
126 type(mpi_grp_t) :: mpi_grp
127 integer iunit
128 integer event_ID
129
130contains
131
132
133 function event_handle_constructor(id) result(handle)
134 integer, intent(in) :: id
135 type(event_handle_t) :: handle
136
138
139 handle%enter_ID = id
140
143 !-------------------------------------------------------------------
144
145 function event_function_call_constructor(name, op) result(event)
146 character(*), intent(in) :: name
147 type(algorithmic_operation_t), intent(in), optional :: op
148 type(event_function_call_t) :: event
149
151
152 event%function_name = name
153
154 if (present(op)) then
155 event%op_label = op%label
156 else
157 event%op_label = "NULL"
158 end if
159
162
164 function event_function_call_get_info(this) result(info)
165 class(event_function_call_t), intent(in) :: this
166 character(len=MAX_INFO_LEN) :: info
169
170 info = "type: function_call | function: " // trim(this%function_name)
171 if (this%op_label /= "NULL") then
172 info = trim(info) // " | operation: " // trim(this%op_label)
173 end if
174
177
178 !-------------------------------------------------------------------
180 function event_iteration_update_constructor(name, detail, iteration, action) result(event)
181 character(*), intent(in) :: name
182 character(*), intent(in) :: detail
183 class(iteration_counter_t), intent(in) :: iteration
184 character(len=*), intent(in) :: action
185 type(event_iteration_update_t) :: event
186
188
189 event%iteration = iteration
190 event%name = name
191 event%detail = detail
192 event%action = action
193
197
198 function event_iteration_update_get_info(this) result(info)
199 class(event_iteration_update_t), intent(in) :: this
200 character(len=MAX_INFO_LEN) :: info
201
203
204 write(info, '("type: clock_update | clock_name: ",a," | clock_detail: ",a," | clock: ",E15.5," | action: ",a)') &
205 trim(this%name), trim(this%detail), this%iteration%value(), trim(this%action)
206
210 !-------------------------------------------------------------------
211
212 function event_marker_constructor(text) result(event)
213 character(*), intent(in) :: text
214 type(event_marker_t) :: event
215
217
218 event%text = text
222
223
224 function event_marker_get_info(this) result(info)
225 class(event_marker_t), intent(in) :: this
226 character(len=MAX_INFO_LEN) :: info
227
229
230 write(info, '("type: marker | text: ",a)') trim(this%text)
231
233 end function event_marker_get_info
234
235 !-------------------------------------------------------------------
236
237 subroutine multisystem_debug_init(filename, namespace, group)
238 character(*), intent(in) :: filename
239 type(namespace_t), intent(in) :: namespace
240 type(mpi_grp_t), intent(in) :: group
241
242 push_sub(multisystem_debug_init)
243
244 mpi_grp = group
245
246 event_id = 0
247 if (debug%propagation_graph .and. mpi_grp%rank == 0) then
248 iunit = io_open(filename, namespace, action="write", status="unknown")
249 end if
250
252 end subroutine multisystem_debug_init
253
254 subroutine multisystem_debug_end()
255
256 push_sub(multisystem_debug_end)
258 if (debug%propagation_graph .and. mpi_grp%rank == 0) then
259 call io_close(iunit)
260 end if
261
262 pop_sub(multisystem_debug_end)
263 end subroutine multisystem_debug_end
264
265
266 subroutine multisystem_debug_write_marker(system_namespace, event)
267
268 class(namespace_t), intent(in), optional :: system_namespace
269 class(event_info_t), intent(in) :: event
270
271 character(len = MAX_NAMESPACE_LEN) :: system_name
272
274
275 if (debug%propagation_graph .and. mpi_grp%rank == 0) then
276
277 if (present(system_namespace)) then
278 system_name = '.'//trim(system_namespace%get())
279 if (system_name == '.') system_name = ''
280 else
281 system_name = 'KEEP'
282 end if
283
284 write(iunit, '("MARKER: ",I10," | system: ",a,"| ",a)' , advance='yes') event_id, &
285 trim(system_name), trim(event%get_info())
286 event_id = event_id + 1
287
288 end if
289
292 end subroutine multisystem_debug_write_marker
293
294 function multisystem_debug_write_event_in(system_namespace, event, extra, system_iteration, algo_iteration, &
295 interaction_iteration, partner_iteration, requested_iteration) result(handle)
296 class(namespace_t), intent(in), optional :: system_namespace
297 class(event_info_t), intent(in) :: event
298 character(*), optional :: extra
299 class(iteration_counter_t), intent(in), optional :: system_iteration
300 class(iteration_counter_t), intent(in), optional :: algo_iteration
301 class(iteration_counter_t), intent(in), optional :: interaction_iteration
302 class(iteration_counter_t), intent(in), optional :: partner_iteration
303 class(iteration_counter_t), intent(in), optional :: requested_iteration
304 type(event_handle_t) :: handle
306 character(len = MAX_NAMESPACE_LEN) :: system_name
307
309
310 if (debug%propagation_graph .and. mpi_grp%rank == 0) then
311
312 if (present(system_namespace)) then
313 system_name = '.'//trim(system_namespace%get())
314 if (system_name == '.') system_name = ''
315 else
316 system_name = 'KEEP'
317 end if
318
319 handle = event_handle_t(event_id)
320
321 write(iunit, '("IN step: ",I10," | system: ",a,"| ",a)' , advance='no') event_id, trim(system_name), trim(event%get_info())
322
323 if (present(extra)) then
324 write(iunit, '(" | ",a)' , advance='no') trim(extra)
325 end if
326
327 if (present(system_iteration)) then
328 write(iunit, '(" | system_clock:", E15.5)' , advance='no') system_iteration%value()
329 end if
331 if (present(algo_iteration)) then
332 write(iunit, '(" | algo_clock:", E15.5)' , advance='no') algo_iteration%value()
333 end if
334
335 if (present(interaction_iteration)) then
336 write(iunit, '(" | interaction_clock:", E15.5)' , advance='no') interaction_iteration%value()
337 end if
338
339 if (present(partner_iteration)) then
340 write(iunit, '(" | partner_clock:", E15.5)' , advance='no') partner_iteration%value()
341 end if
342
343 if (present(requested_iteration)) then
344 write(iunit, '(" | requested_clock:", E15.5)' , advance='no') requested_iteration%value()
345 end if
346
347 write(iunit, '()' , advance='yes')
348
349 event_id = event_id + 1
350
351 end if
352
355
356 subroutine multisystem_debug_write_event_out(handle, extra, update, system_iteration, algo_iteration, &
357 interaction_iteration, partner_iteration, requested_iteration)
358 class(event_handle_t), intent(in) :: handle
359 character(*), optional :: extra
360 logical, optional :: update
361 class(iteration_counter_t), intent(in), optional :: system_iteration
362 class(iteration_counter_t), intent(in), optional :: algo_iteration
363 class(iteration_counter_t), intent(in), optional :: interaction_iteration
364 class(iteration_counter_t), intent(in), optional :: partner_iteration
365 class(iteration_counter_t), intent(in), optional :: requested_iteration
366
367 character(17) :: update_string
368
370
371 if (debug%propagation_graph .and. mpi_grp%rank == 0) then
372
373 if (present(update)) then
374 if (update) then
375 update_string = " | updated: true"
376 else
377 update_string = " | updated: false"
378 end if
379 else
380 update_string = ""
381 end if
382
383 write(iunit, '("OUT step: ",I10," | closes: ",I10)', advance='no') &
384 event_id, handle%enter_ID
385
386 if (present(update)) then
387 if (update) then
388 write(iunit, '(" | updated: true")', advance='no')
389 else
390 write(iunit, '(" | updated: false")', advance='no')
391 end if
392 end if
393
394 if (present(extra)) then
395 write(iunit, '(" | ",a)' , advance='no') trim(extra)
396 end if
397
398 if (present(system_iteration)) then
399 write(iunit, '(" | system_clock:", E15.5)' , advance='no') system_iteration%value()
400 end if
401
402 if (present(algo_iteration)) then
403 write(iunit, '(" | prop_clock:", E15.5)' , advance='no') algo_iteration%value()
404 end if
405
406 if (present(interaction_iteration)) then
407 write(iunit, '(" | interaction_clock:", E15.5)' , advance='no') interaction_iteration%value()
408 end if
409
410 if (present(partner_iteration)) then
411 write(iunit, '(" | partner_clock:", E15.5)' , advance='no') partner_iteration%value()
412 end if
413
414 if (present(requested_iteration)) then
415 write(iunit, '(" | requested_clock:", E15.5)' , advance='no') requested_iteration%value()
416 end if
417
418 write(iunit, '()' , advance='yes')
419
420 event_id = event_id + 1
421
422 end if
423
424
427
subroutine info()
Definition: em_resp.F90:1096
This module implements the basic elements defining algorithms.
Definition: algorithm.F90:141
type(debug_t), save, public debug
Definition: debug.F90:156
Definition: io.F90:114
subroutine, public io_close(iunit, grp)
Definition: io.F90:418
integer function, public io_open(file, namespace, action, status, form, position, die, recl, grp)
Definition: io.F90:352
This module implements the multisystem debug functionality.
type(event_marker_t) function event_marker_constructor(text)
type(event_function_call_t) function event_function_call_constructor(name, op)
character(len=max_info_len) function event_function_call_get_info(this)
subroutine, public multisystem_debug_write_marker(system_namespace, event)
character(len=max_info_len) function event_iteration_update_get_info(this)
type(event_iteration_update_t) function event_iteration_update_constructor(name, detail, iteration, action)
type(event_handle_t) function, public multisystem_debug_write_event_in(system_namespace, event, extra, system_iteration, algo_iteration, interaction_iteration, partner_iteration, requested_iteration)
subroutine, public multisystem_debug_init(filename, namespace, group)
type(event_handle_t) function event_handle_constructor(id)
subroutine, public multisystem_debug_write_event_out(handle, extra, update, system_iteration, algo_iteration, interaction_iteration, partner_iteration, requested_iteration)
character(len=max_info_len) function event_marker_get_info(this)
subroutine, public multisystem_debug_end()
Descriptor of one algorithmic operation.
Definition: algorithm.F90:163
This class implements the iteration counter used by the multisystem algorithms. As any iteration coun...
This is defined even when running serial.
Definition: mpi.F90:142
handle to keep track of in- out- events
abstract class to specify events in the algorithm execution