70 integer,
parameter,
public :: &
71 NUMBER_BARRIERS = 1, &
79 type(iteration_counter_t),
public :: iteration
80 class(algorithm_t),
pointer,
public :: algo => null()
82 type(integer_list_t),
public :: supported_interactions
83 type(interaction_list_t),
public :: interactions
85 type(mpi_grp_t),
public :: grp
87 type(barrier_t) :: barrier(NUMBER_BARRIERS)
88 float,
public :: kinetic_energy
89 float,
public :: potential_energy
90 float,
public :: internal_energy
91 float,
public :: total_energy
121 procedure(system_init_interaction),
deferred :: init_interaction
122 procedure(system_initial_conditions),
deferred :: initial_conditions
123 procedure(system_do_algorithmic_operation),
deferred :: do_algorithmic_operation
124 procedure(system_is_tolerance_reached),
deferred :: is_tolerance_reached
125 procedure(system_restart_write_data),
deferred :: restart_write_data
126 procedure(system_restart_read_data),
deferred :: restart_read_data
127 procedure(system_update_kinetic_energy),
deferred :: update_kinetic_energy
137 class(system_t),
target,
intent(inout) :: this
138 class(interaction_t),
intent(inout) :: interaction
145 class(system_t),
intent(inout) :: this
158 class(system_t),
intent(inout) :: this
159 class(algorithmic_operation_t),
intent(in) :: operation
160 integer,
allocatable,
intent(out) :: updated_quantities(:)
166 use,
intrinsic :: iso_fortran_env
169 float,
intent(in) :: tol
230 class(
system_t),
intent(inout) :: this
233 logical :: all_updated, at_barrier, operation_done
236 integer,
allocatable :: updated_quantities(:)
242 do while (.not. at_barrier)
244 operation = this%algo%get_current_operation()
247 system_iteration=this%iteration, algo_iteration=this%algo%iteration)
250 operation_done = this%do_algorithmic_operation(operation, updated_quantities)
251 if (
allocated(updated_quantities))
then
253 do iuq = 1,
size(updated_quantities)
254 iq = updated_quantities(iuq)
255 call this%quantities(iq)%iteration%set(this%algo%iteration + 1)
257 this%quantities(iq)%iteration,
"set"))
262 if (.not. operation_done)
then
263 operation_done = this%algo%do_operation(operation)
265 call this%algo%next()
269 if (.not. operation_done)
then
271 select case (operation%id)
274 call this%algo%next()
278 this%iteration = this%iteration + 1
282 call this%update_total_energy()
285 call this%output_write()
288 call this%algo%update_elapsed_time()
293 call this%iteration_info()
295 call this%algo%next()
298 if (.not. this%arrived_at_any_barrier() .and. .not. this%algorithm_finished())
then
301 call this%algo%rewind()
308 this%algo%iteration = this%algo%iteration + 1
310 this%algo%iteration,
"tick"))
313 all_updated = this%update_couplings()
317 if (all_updated)
then
318 call this%algo%next()
320 this%algo%iteration = this%algo%iteration - 1
322 this%algo%iteration,
"reverse"))
330 call this%update_interactions()
331 call this%algo%next()
334 message(1) =
"Unsupported algorithmic operation."
335 write(
message(2),
'(A,A,A)') trim(operation%id),
": ", trim(operation%label)
348 class(
system_t),
intent(inout) :: this
349 integer,
intent(in) :: accumulated_iterations
355 character(len=MAX_INFO_LEN) :: extended_label
360 this%algo%iteration = this%algo%iteration - accumulated_iterations
364 call iter%start(this%interactions)
365 do while (iter%has_next())
366 interaction => iter%get_next()
367 interaction%iteration = interaction%iteration - accumulated_iterations
369 extended_label = trim(interaction%label)//
"-"//trim(interaction%partner%namespace%get())
371 interaction%iteration,
"reset"))
376 if (this%quantities(iq)%required)
then
377 this%quantities(iq)%iteration = this%quantities(iq)%iteration - accumulated_iterations
379 this%quantities(iq)%iteration,
"reset"))
394 class(
system_t),
intent(inout) :: this
420 call iter%start(this%interactions)
421 do while (iter%has_next())
422 interaction => iter%get_next()
423 select type (interaction)
427 call this%init_interaction(interaction)
428 call interaction%partner%init_interaction_as_partner(interaction)
429 interaction%timing = timing
433 select type (partner => interaction%partner)
435 if (this%algo%iteration%global_step() /= partner%algo%iteration%global_step() .and. &
436 .not. all(partner%quantities(interaction%couplings_from_partner)%always_available))
then
437 write(
message(1),
'(2a)')
"InteractionTiming was set to exact timing, but systems ", &
438 trim(this%namespace%get())
439 write(
message(2),
'(3a)')
"and ", trim(partner%namespace%get()),
" have incompatible steps."
452 class(
system_t),
intent(inout) :: this
460 call iter%start(this%interactions)
461 do while (iter%has_next())
462 interaction => iter%get_next()
464 select type (partner => interaction%partner)
468 if (partner%algo%iteration + 1 >= this%algo%iteration)
then
469 call interaction%update_partner_couplings(this%algo%iteration)
474 call interaction%update_partner_couplings(this%algo%iteration)
477 all_updated = all_updated .and. interaction%partner_couplings_up_to_date
485 class(
system_t),
intent(inout) :: this
487 integer :: iq, q_id, n_quantities
495 call this%update_interactions_start()
498 call iter%start(this%interactions)
499 do while (iter%has_next())
500 interaction => iter%get_next()
503 if (
allocated(interaction%system_quantities))
then
504 n_quantities =
size(interaction%system_quantities)
508 do iq = 1, n_quantities
510 q_id = interaction%system_quantities(iq)
512 if (.not. this%quantities(q_id)%iteration == this%algo%iteration)
then
515 if (.not. this%quantities(q_id)%updated_on_demand)
then
518 if (.not. this%quantities(q_id)%iteration == this%algo%iteration .and. &
519 .not. this%quantities(q_id)%always_available)
then
520 write(
message(1),
'(5a)')
"Interaction ", trim(interaction%label),
" is incompatible with the selected algorithm."
522 " at a iteration it is not available."
534 if (this%quantities(q_id)%iteration > this%algo%iteration)
then
535 message(1) =
"The quantity iteration is in advance compared to the requested iteration."
539 call this%update_quantity(q_id)
541 this%quantities(q_id)%iteration,
"set"))
546 call interaction%update(this%algo%iteration)
551 call this%update_interactions_finish()
558 class(
system_t),
intent(inout) :: this
570 class(
system_t),
intent(inout) :: this
582 class(
system_t),
intent(inout) :: this
584 logical :: restart_write
593 if (restart_write)
then
596 call this%iteration%restart_write(
'restart_iteration_system', this%namespace)
597 call this%algo%iteration%restart_write(
'restart_iteration_propagator', this%namespace)
598 call iter%start(this%interactions)
599 do while (iter%has_next())
600 interaction => iter%get_next()
601 call interaction%restart_write(this%namespace)
604 if (this%quantities(ii)%required)
then
605 call this%quantities(ii)%iteration%restart_write(
'restart_iteration_quantity_'//trim(
quantity_label(ii)), &
610 call this%restart_write_data()
611 message(1) =
"Wrote restart data for system "//trim(this%namespace%get())
621 class(
system_t),
intent(inout) :: this
631 system_restart_read = this%iteration%restart_read(
'restart_iteration_system', this%namespace)
633 this%algo%iteration%restart_read(
'restart_iteration_propagator', this%namespace)
634 call iter%start(this%interactions)
635 do while (iter%has_next())
636 interaction => iter%get_next()
639 interaction%iteration = interaction%iteration - 1
642 if (this%quantities(ii)%required)
then
644 this%quantities(ii)%iteration%restart_read(
'restart_iteration_quantity_'//trim(
quantity_label(ii)), &
647 if (this%quantities(ii)%updated_on_demand)
then
649 this%quantities(ii)%iteration = this%quantities(ii)%iteration - 1
656 message(1) =
"Successfully read restart data for system "//trim(this%namespace%get())
677 class(
system_t),
intent(inout) :: this
689 class(
system_t),
intent(inout) :: this
701 class(
system_t),
intent(inout) :: this
710 this%algo => factory%create(this)
712 call this%init_iteration_counters()
714 do ii = 1, number_barriers
715 this%barrier(ii)%active = .false.
716 this%barrier(ii)%target_time =
m_zero
727 finished = this%algo%finished()
733 class(
system_t),
intent(inout) :: this
741 call this%algo%init_iteration_counters()
744 call iter%start(this%interactions)
745 do while (iter%has_next())
746 interaction => iter%get_next()
747 interaction%iteration = this%algo%iteration - 1
751 where (this%quantities%required)
752 this%quantities%iteration = this%algo%iteration
754 where (this%quantities%updated_on_demand)
755 this%quantities%iteration = this%algo%iteration - 1
763 class(
system_t),
intent(inout) :: this
765 logical :: all_updated
767 integer,
allocatable :: updated_quantities(:)
772 system_iteration = this%iteration, algo_iteration = this%algo%iteration)
775 all_updated = this%update_couplings()
776 if (.not. all_updated)
then
777 message(1) =
"Unable to update interactions when initializing the propagation."
780 call this%update_interactions()
783 if (this%algo%start_operation%id /=
skip)
then
784 if (.not. this%do_algorithmic_operation(this%algo%start_operation, updated_quantities))
then
785 message(1) =
"Unsupported algorithmic operation."
786 write(
message(2),
'(A,A,A)') trim(this%algo%start_operation%id),
": ", trim(this%algo%start_operation%label)
788 else if (
allocated(updated_quantities))
then
789 message(1) =
"Update of quantities not allowed in algorithmic operation."
790 write(
message(2),
'(A,A,A)') trim(this%algo%start_operation%id),
": ", trim(this%algo%start_operation%label)
796 call this%update_total_energy()
799 call this%output_start()
803 write(
message(1),
'(a6,1x,a14,1x,a13,1x,a10,1x,a15)')
'Iter',
'Time',
'Energy',
'SC Steps',
'Elapsed Time'
808 call this%algo%rewind()
817 class(
system_t),
intent(inout) :: this
820 integer,
allocatable :: updated_quantities(:)
825 system_iteration = this%iteration, algo_iteration = this%algo%iteration)
828 call this%output_finish()
831 if (this%algo%final_operation%id /=
skip)
then
832 if (.not. this%do_algorithmic_operation(this%algo%final_operation, updated_quantities))
then
833 message(1) =
"Unsupported algorithmic operation."
834 write(
message(2),
'(A,A,A)') trim(this%algo%final_operation%id),
": ", trim(this%algo%final_operation%label)
836 else if (
allocated(updated_quantities))
then
837 message(1) =
"Update of quantities not allowed in algorithmic operation."
838 write(
message(2),
'(A,A,A)') trim(this%algo%final_operation%id),
": ", trim(this%algo%final_operation%label)
853 character(len=40) :: fmt
858 if (abs(energy) >= 1e5)
then
859 fmt =
'(i7,1x,f14.6,1X,es13.6,1X,i9,1X,'
861 fmt =
'(i7,1x,f14.6,1X,f13.6,1X,i9,1X,'
863 if (this%algo%elapsed_time < 1e-3)
then
864 fmt = trim(fmt)//
'es13.3)'
866 fmt = trim(fmt)//
'f13.3)'
869 write(
message(1), fmt) this%iteration%counter(), &
871 0, this%algo%elapsed_time
891 class(
system_t),
intent(inout) :: this
899 if (
associated(this%algo))
then
900 deallocate(this%algo)
903 call iter%start(this%interactions)
904 do while (iter%has_next())
905 interaction => iter%get_next()
906 if (
associated(interaction))
then
907 deallocate(interaction)
921 select type (partner)
923 call this%add_ptr(partner)
943 select type (partner)
946 call iterator%start(this)
947 do while (iterator%has_next() .and. .not. contains)
948 system => iterator%get_next()
949 contains =
associated(system, partner)
966 select type (ptr => this%get_next_ptr())
981 class(
system_t),
intent(inout) :: this
996 class(
system_t),
intent(inout) :: this
997 float,
intent(in) :: target_time
998 integer,
intent(in) :: barrier_index
1002 this%barrier(barrier_index)%active = .
true.
1003 this%barrier(barrier_index)%target_time = target_time
1010 class(
system_t),
intent(inout) :: this
1011 integer,
intent(in) :: barrier_index
1015 this%barrier(barrier_index)%active = .false.
1016 this%barrier(barrier_index)%target_time =
m_zero
1023 class(
system_t),
intent(inout) :: this
1024 integer,
intent(in) :: barrier_index
1031 if (this%barrier(barrier_index)%active)
then
1032 iteration = this%iteration + 1
1033 if (iteration%value() > this%barrier(barrier_index)%target_time)
then
1043 class(
system_t),
intent(inout) :: this
1050 do ii = 1, number_barriers
1052 .or. this%arrived_at_barrier(ii)
1065 class(
system_t),
intent(inout) :: this
1072 this%potential_energy =
m_zero
1074 call iter%start(this%interactions)
1075 do while (iter%has_next())
1076 interaction => iter%get_next()
1077 if(.not. interaction%intra_interaction)
then
1078 call interaction%calculate_energy()
1079 this%potential_energy = this%potential_energy + interaction%energy
1092 class(
system_t),
intent(inout) :: this
1099 this%internal_energy =
m_zero
1100 call iter%start(this%interactions)
1101 do while (iter%has_next())
1102 interaction => iter%get_next()
1103 if(interaction%intra_interaction)
then
1104 call interaction%calculate_energy()
1105 this%internal_energy = this%internal_energy + interaction%energy
1117 class(
system_t),
intent(inout) :: this
1121 call this%update_kinetic_energy()
1122 this%total_energy = this%kinetic_energy
1125 call this%update_potential_energy()
1126 this%total_energy = this%total_energy + this%potential_energy
1129 call this%update_internal_energy()
1130 this%total_energy = this%total_energy + this%internal_energy
Execute one operation that is part of a larger algorithm. Returns true if the operation was successfu...
initialize a given interaction of the system
set initial conditions for a system
check whether a system has reached a given tolerance
This module defines the abstract interfact for algorithm factories.
This module implements the basic elements defining algorithms.
character(len=algo_label_len), parameter, public update_interactions
character(len=algo_label_len), parameter, public rewind_algorithm
character(len=algo_label_len), parameter, public update_couplings
character(len=algo_label_len), parameter, public iteration_done
character(len=algo_label_len), parameter, public skip
Operations that can be used by any algorithm and, therefore, should be implemented by all systems.
real(8), parameter, public m_zero
This module defines the abstract interaction_t class, and some auxiliary classes for interactions.
integer, parameter, public timing_exact
This module defines classes and functions for interaction partners.
This module implements fully polymorphic linked lists, and some specializations thereof.
subroutine, public messages_print_with_emphasis(msg, iunit, namespace)
character(len=512), private msg
subroutine, public messages_update_mpi_grp(namespace, mpigrp)
subroutine, public messages_info(no_lines, iunit, verbose_limit, stress, all_nodes, namespace)
character(len=256), dimension(max_lines), public message
to be output by fatal, warning
subroutine, public messages_fatal(no_lines, only_root_writes, namespace)
subroutine, public messages_input_error(namespace, var, details, row, column)
subroutine, public messages_experimental(name, namespace)
subroutine mpi_grp_copy(mpi_grp_out, mpi_grp_in)
This module implements the multisystem debug functionality.
subroutine, public multisystem_debug_write_marker(system_namespace, event)
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_write_event_out(handle, extra, update, system_iteration, algo_iteration, interaction_iteration, partner_iteration, requested_iteration)
This module defines the quantity_t class and the IDs for quantities, which can be exposed by a system...
character(len=17), dimension(max_quantities), parameter, public quantity_label
integer, parameter, public max_quantities
This module implements the abstract system type.
subroutine, public system_update_total_energy(this)
Calculate the total energy of the system. The total energy is defined as the sum of the kinetic,...
subroutine system_iteration_info(this)
subroutine, public system_init_iteration_counters(this)
integer, parameter, public barrier_restart
subroutine system_update_internal_energy(this)
Calculate the internal energy of the system. The internal energy is defined as the sum of all energie...
logical function system_arrived_at_any_barrier(this)
recursive logical function system_list_contains(this, partner)
subroutine system_init_all_interactions(this)
initialize all interactions of this system
subroutine, public system_restart_write(this)
subroutine, public system_update_potential_energy(this)
Calculate the potential energy of the system. The potential energy is defined as the sum of all energ...
subroutine, public system_init_parallelization(this, grp)
Basic functionality: copy the MPI group. This function needs to be implemented by extended types that...
subroutine system_output_start(this)
subroutine system_update_interactions_start(this)
subroutine system_start_barrier(this, target_time, barrier_index)
subroutine, public system_propagation_finish(this)
subroutine, public system_end(this)
subroutine system_output_write(this)
subroutine system_update_interactions_finish(this)
subroutine, public system_execute_algorithm(this)
perform one or more algorithmic operations
subroutine system_update_interactions(this)
class(system_t) function, pointer system_iterator_get_next(this)
logical function system_update_couplings(this)
logical function system_process_is_slave(this)
logical function system_arrived_at_barrier(this, barrier_index)
recursive logical function system_algorithm_finished(this)
logical function, public system_restart_read(this)
subroutine system_output_finish(this)
subroutine system_list_add_node(this, partner)
subroutine, public system_propagation_start(this)
subroutine, public system_reset_iteration_counters(this, accumulated_iterations)
subroutine, public system_init_algorithm(this, factory)
subroutine system_end_barrier(this, barrier_index)
brief This module defines the class unit_t which is used by the unit_systems_oct_m module.
This module defines the unit system, used for input and output.
type(unit_system_t), public units_out
Abstract class for the algorithm factories.
Descriptor of one algorithmic operation.
The ghost ineraction is a dummy interaction, which needs to be setup between otherwise non-interactin...
These class extend the list and list iterator to make an interaction list.
abstract interaction class
abstract class for general interaction partners
iterator for the list of partners
This class implements the iteration counter used by the multisystem algorithms. As any iteration coun...
This class implements an iterator for the polymorphic linked list.
This is defined even when running serial.
events marking a function call
handle to keep track of in- out- events
events marking an iteration update
These classes extends the list and list iterator to create a system list.
Abstract class for systems.