69 real(real64) :: target_time
72 integer,
parameter,
public :: &
73 NUMBER_BARRIERS = 1, &
81 type(iteration_counter_t),
public :: iteration
82 class(algorithm_t),
pointer,
public :: algo => null()
84 integer,
allocatable,
public :: supported_interactions(:)
85 type(interaction_list_t),
public :: interactions
87 type(mpi_grp_t),
public :: grp
89 type(barrier_t) :: barrier(NUMBER_BARRIERS)
90 real(real64),
public :: kinetic_energy
91 real(real64),
public :: potential_energy
92 real(real64),
public :: internal_energy
94 real(real64),
public :: total_energy
124 procedure(system_init_interaction),
deferred :: init_interaction
125 procedure(system_initialize),
deferred :: initialize
126 procedure(system_do_algorithmic_operation),
deferred :: do_algorithmic_operation
127 procedure(system_is_tolerance_reached),
deferred :: is_tolerance_reached
128 procedure(system_restart_write_data),
deferred :: restart_write_data
129 procedure(system_restart_read_data),
deferred :: restart_read_data
130 procedure(system_update_kinetic_energy),
deferred :: update_kinetic_energy
144 class(system_t),
target,
intent(inout) :: this
145 class(interaction_t),
intent(inout) :: interaction
152 class(system_t),
intent(inout) :: this
168 class(
system_t),
intent(inout) :: this
170 character(len=:),
allocatable,
intent(out) :: updated_quantities(:)
176 use,
intrinsic :: iso_fortran_env
179 real(real64),
intent(in) :: tol
188 class(
system_t),
intent(inout) :: this
246 logical :: all_updated, at_barrier, operation_done
250 character(len=:),
allocatable :: updated_quantities(:)
256 do while (.not. at_barrier)
258 operation = this%algo%get_current_operation()
261 system_iteration=this%iteration, algo_iteration=this%algo%iteration)
264 operation_done = this%do_algorithmic_operation(operation, updated_quantities)
265 if (
allocated(updated_quantities))
then
267 do i = 1,
size(updated_quantities)
268 quantity => this%quantities%get(updated_quantities(i))
269 call quantity%iteration%set(this%algo%iteration + 1)
271 quantity%iteration,
"set"))
276 if (.not. operation_done)
then
277 operation_done = this%algo%do_operation(operation)
279 call this%algo%next()
283 if (.not. operation_done)
then
285 select case (operation%id)
288 call this%algo%next()
292 this%iteration = this%iteration + 1
296 call this%update_total_energy()
299 call this%output_write()
302 call this%algo%update_elapsed_time()
307 call this%iteration_info()
309 call this%algo%next()
312 if (.not. this%algo%finished())
then
313 if (.not. this%arrived_at_any_barrier())
then
315 call this%algo%rewind()
320 if (this%algo%continues_after_finished())
then
321 call this%algo%rewind()
329 this%algo%iteration = this%algo%iteration + 1
331 this%algo%iteration,
"tick"))
334 all_updated = this%update_couplings()
338 if (all_updated)
then
339 call this%algo%next()
341 this%algo%iteration = this%algo%iteration - 1
343 this%algo%iteration,
"reverse"))
351 call this%update_interactions()
352 call this%algo%next()
355 message(1) =
"Unsupported algorithmic operation."
356 write(
message(2),
'(A,A,A)') trim(operation%id),
": ", trim(operation%label)
369 class(
system_t),
intent(inout) :: this
370 integer,
intent(in) :: accumulated_iterations
377 character(len=MAX_INFO_LEN) :: extended_label
382 this%algo%iteration = this%algo%iteration - accumulated_iterations
386 call iter%start(this%interactions)
387 do while (iter%has_next())
388 interaction => iter%get_next()
389 interaction%iteration = interaction%iteration - accumulated_iterations
391 extended_label = trim(interaction%label)//
"-"//trim(interaction%partner%namespace%get())
393 interaction%iteration,
"reset"))
397 call qiter%start(this%interactions)
398 do while(qiter%has_next())
399 quantity => qiter%get_next()
400 quantity%iteration = quantity%iteration - accumulated_iterations
402 quantity%iteration,
"reset"))
423 class(
system_t),
intent(inout) :: this
429 integer :: i, ip, iq, interaction_type
439 assert(
allocated(this%supported_interactions))
440 assert(
allocated(this%supported_interactions_as_partner))
446 call iter%start(available_partners)
447 do while (iter%has_next())
448 partner => iter%get_next()
449 call partner%add_partners_to_list(partners)
452 call iter%start(partners)
453 do while (iter%has_next())
454 partner => iter%get_next()
457 if (partner%namespace%get() == this%namespace%get()) cycle
468 call partners%empty()
472 options = interaction_factory%options(this%namespace, this%supported_interactions)
475 do i = 1,
size(this%supported_interactions)
476 interaction_type = this%supported_interactions(i)
481 assert(count(this%supported_interactions == interaction_type) == 1)
484 call iter%start(available_partners)
485 do while (iter%has_next())
486 partner => iter%get_next()
487 call partner%add_partners_to_list(partners, interaction_type)
491 select case (options(i)%mode)
497 call partners%empty()
501 call iter%start(partners)
502 do while (iter%has_next())
503 partner => iter%get_next()
505 do ip = 1,
size(options(i)%partners)
506 if (partner%namespace%is_contained_in(options(i)%partners(ip)))
then
511 if (.not. in_list)
then
512 call partners%delete(partner)
518 do ip = 1,
size(options(i)%partners)
519 call iter%start(partners)
520 do while (iter%has_next())
521 partner => iter%get_next()
522 if (partner%namespace%is_contained_in(options(i)%partners(ip)))
then
523 call partners%delete(partner)
531 call iter%start(partners)
532 do while (iter%has_next())
533 partner => iter%get_next()
535 interaction => interaction_factory%create(interaction_type, partner)
539 interaction%intra_interaction = partner%namespace%get() == this%namespace%get()
542 interaction%timing = options(i)%timing
544 select type (partner => interaction%partner)
546 if (this%algo%iteration%global_step() /= partner%algo%iteration%global_step() .and. &
547 .not. all(partner%quantities%always_available(interaction%couplings_from_partner)))
then
548 write(
message(1),
'(2a)')
"InteractionTiming was set to exact timing, but systems ", &
549 trim(this%namespace%get())
550 write(
message(2),
'(3a)')
"and ", trim(partner%namespace%get()),
" have incompatible steps."
557 call this%init_interaction(interaction)
558 call interaction%partner%init_interaction_as_partner(interaction)
561 if (
allocated(interaction%system_quantities))
then
562 do iq = 1,
size(interaction%system_quantities)
563 if (.not.
associated(this%quantities%get(interaction%system_quantities(iq))))
then
564 write(
message(1),
'(5a)')
"Interaction '", trim(interaction%label),
"' requires quantity '", &
565 trim(interaction%system_quantities(iq)),
"'"
566 write(
message(2),
'(3a)')
"from system '", trim(this%namespace%get()),
"' but it is not available."
571 if (
allocated(interaction%couplings_from_partner))
then
572 do iq = 1,
size(interaction%couplings_from_partner)
573 if (.not.
associated(partner%quantities%get(interaction%couplings_from_partner(iq))))
then
574 write(
message(1),
'(5a)')
"Interaction '", trim(interaction%label),
"' requires coupling '", &
575 trim(interaction%couplings_from_partner(iq)),
"'"
576 write(
message(2),
'(3a)')
"from partner '", trim(partner%namespace%get()),
"' but it is not available."
583 call this%interactions%add(interaction)
587 call partners%empty()
600 class(
system_t),
intent(inout) :: this
608 call iter%start(this%interactions)
609 do while (iter%has_next())
610 interaction => iter%get_next()
612 select type (partner => interaction%partner)
616 if (partner%algo%iteration + 1 >= this%algo%iteration)
then
617 call interaction%update_partner_couplings(this%algo%iteration)
622 call interaction%update_partner_couplings(this%algo%iteration)
625 all_updated = all_updated .and. interaction%partner_couplings_up_to_date
637 class(
system_t),
intent(inout) :: this
639 integer :: iq, n_quantities
648 call this%update_interactions_start()
651 call iter%start(this%interactions)
652 do while (iter%has_next())
653 interaction => iter%get_next()
656 if (
allocated(interaction%system_quantities))
then
657 n_quantities =
size(interaction%system_quantities)
661 do iq = 1, n_quantities
663 quantity => this%quantities%get(interaction%system_quantities(iq))
665 if (.not. quantity%iteration == this%algo%iteration)
then
670 if (quantity%iteration > this%algo%iteration)
then
671 message(1) =
"The quantity "//trim(quantity%label)//
" is in advance compared to the requested iteration."
672 message(2) =
"The interaction is "//trim(interaction%label)//
"."
677 if (quantity%updated_on_demand)
then
678 call this%update_on_demand_quantity(quantity, this%algo%iteration)
683 if (.not. quantity%iteration == this%algo%iteration .and. .not. quantity%always_available)
then
684 write(
message(1),
'(5a)')
"Interaction ", trim(interaction%label),
" is incompatible with the selected algorithm."
685 write(
message(2),
'(3a)')
"The interaction requires the ", trim(quantity%label), &
686 " at an iteration it is not available."
694 call interaction%update(this%algo%iteration)
699 call this%update_interactions_finish()
706 class(
system_t),
intent(inout) :: this
718 class(
system_t),
intent(inout) :: this
730 class(
system_t),
intent(inout) :: this
732 logical :: restart_write
743 if (restart_write)
then
746 call this%iteration%restart_write(
'restart_iteration_system', this%namespace)
747 call this%algo%iteration%restart_write(
'restart_iteration_algorithm', this%namespace)
748 call iter%start(this%interactions)
749 do while (iter%has_next())
750 interaction => iter%get_next()
751 call interaction%restart_write(this%namespace)
753 call qiter%start(this%quantities)
754 do while (qiter%has_next())
755 quantity => qiter%get_next()
756 call quantity%iteration%restart_write(
'restart_iteration_quantity_'//trim(quantity%label), &
760 call this%restart_write_data()
761 message(1) =
"Wrote restart data for system "//trim(this%namespace%get())
771 class(
system_t),
intent(inout) :: this
782 system_restart_read = this%iteration%restart_read(
'restart_iteration_system', this%namespace)
784 this%algo%iteration%restart_read(
'restart_iteration_algorithm', this%namespace)
785 call iter%start(this%interactions)
786 do while (iter%has_next())
787 interaction => iter%get_next()
790 interaction%iteration = interaction%iteration - 1
792 call qiter%start(this%quantities)
793 do while (qiter%has_next())
794 quantity => qiter%get_next()
796 quantity%iteration%restart_read(
'restart_iteration_quantity_'//trim(quantity%label), &
798 if (quantity%updated_on_demand)
then
800 quantity%iteration = quantity%iteration - 1
807 message(1) =
"Successfully read restart data for system "//trim(this%namespace%get())
816 class(
system_t),
intent(inout) :: this
828 class(
system_t),
intent(inout) :: this
840 class(
system_t),
intent(inout) :: this
852 class(
system_t),
intent(inout) :: this
861 this%algo => factory%create(this)
863 call this%init_iteration_counters()
865 do ii = 1, number_barriers
866 this%barrier(ii)%active = .false.
867 this%barrier(ii)%target_time =
m_zero
878 finished = this%algo%finished()
890 class(
system_t),
intent(inout) :: this
900 call this%algo%init_iteration_counters()
903 call iter%start(this%interactions)
904 do while (iter%has_next())
905 interaction => iter%get_next()
906 interaction%iteration = this%algo%iteration - 1
910 call qiter%start(this%quantities)
911 do while (qiter%has_next())
912 quantity => qiter%get_next()
913 if (quantity%updated_on_demand)
then
916 quantity%iteration = this%algo%iteration - 1
918 quantity%iteration = this%algo%iteration
927 class(
system_t),
intent(inout) :: this
929 logical :: all_updated
931 character(len=:),
allocatable :: updated_quantities(:)
936 system_iteration = this%iteration, algo_iteration = this%algo%iteration)
939 all_updated = this%update_couplings()
940 if (.not. all_updated)
then
941 message(1) =
"Unable to update interactions when initializing the algorithm."
944 call this%update_interactions()
947 if (this%algo%start_operation%id /=
skip)
then
948 if (.not. this%do_algorithmic_operation(this%algo%start_operation, updated_quantities))
then
949 message(1) =
"Unsupported algorithmic operation."
950 write(
message(2),
'(A,A,A)') trim(this%algo%start_operation%id),
": ", trim(this%algo%start_operation%label)
953 if (
allocated(updated_quantities))
then
954 message(1) =
"Update of quantities not allowed in algorithmic operation."
955 write(
message(2),
'(A,A,A)') trim(this%algo%start_operation%id),
": ", trim(this%algo%start_operation%label)
961 call this%update_total_energy()
964 call this%output_start()
967 call this%algo%write_output_header()
970 call this%algo%rewind()
979 class(
system_t),
intent(inout) :: this
982 character(len=:),
allocatable :: updated_quantities(:)
987 system_iteration = this%iteration, algo_iteration = this%algo%iteration)
990 call this%output_finish()
993 if (this%algo%final_operation%id /=
skip)
then
994 if (.not. this%do_algorithmic_operation(this%algo%final_operation, updated_quantities))
then
995 message(1) =
"Unsupported algorithmic operation."
996 write(
message(2),
'(A,A,A)') trim(this%algo%final_operation%id),
": ", trim(this%algo%final_operation%label)
999 if (
allocated(updated_quantities))
then
1000 message(1) =
"Update of quantities not allowed in algorithmic operation."
1001 write(
message(2),
'(A,A,A)') trim(this%algo%final_operation%id),
": ", trim(this%algo%final_operation%label)
1013 class(
system_t),
intent(in) :: this
1015 real(real64) :: energy
1016 character(len=40) :: fmt
1021 if (abs(energy) >= 1e5)
then
1022 fmt =
'(i7,1x,f14.6,1X,es13.6,1X,i9,1X,'
1024 fmt =
'(i7,1x,f14.6,1X,f13.6,1X,i9,1X,'
1026 if (this%algo%elapsed_time < 1e-3)
then
1027 fmt = trim(fmt)//
'es13.3)'
1029 fmt = trim(fmt)//
'f13.3)'
1032 write(
message(1), fmt) this%iteration%counter(), &
1034 0, this%algo%elapsed_time
1042 class(
system_t),
intent(in) :: this
1054 class(
system_t),
intent(inout) :: this
1062 if (
associated(this%algo))
then
1063 deallocate(this%algo)
1066 call iter%start(this%interactions)
1067 do while (iter%has_next())
1068 interaction => iter%get_next()
1069 if (
associated(interaction))
then
1070 deallocate(interaction)
1085 select type (partner)
1087 call this%add_ptr(partner)
1107 select type (partner)
1110 call iterator%start(this)
1111 do while (iterator%has_next() .and. .not. contains)
1112 system => iterator%get_next()
1113 contains =
associated(system, partner)
1130 select type (ptr => this%get_next_ptr())
1145 class(
system_t),
intent(inout) :: this
1160 class(
system_t),
intent(inout) :: this
1161 real(real64),
intent(in) :: target_time
1162 integer,
intent(in) :: barrier_index
1166 this%barrier(barrier_index)%active = .
true.
1167 this%barrier(barrier_index)%target_time = target_time
1174 class(
system_t),
intent(inout) :: this
1175 integer,
intent(in) :: barrier_index
1179 this%barrier(barrier_index)%active = .false.
1180 this%barrier(barrier_index)%target_time =
m_zero
1187 class(
system_t),
intent(inout) :: this
1188 integer,
intent(in) :: barrier_index
1195 if (this%barrier(barrier_index)%active)
then
1196 iteration = this%iteration + 1
1197 if (iteration%value() > this%barrier(barrier_index)%target_time)
then
1207 class(
system_t),
intent(inout) :: this
1214 do ii = 1, number_barriers
1216 .or. this%arrived_at_barrier(ii)
1229 class(
system_t),
intent(inout) :: this
1236 this%potential_energy =
m_zero
1238 call iter%start(this%interactions)
1239 do while (iter%has_next())
1240 interaction => iter%get_next()
1241 if(.not. interaction%intra_interaction)
then
1242 call interaction%calculate_energy()
1243 this%potential_energy = this%potential_energy + interaction%energy
1256 class(
system_t),
intent(inout) :: this
1263 this%internal_energy =
m_zero
1264 call iter%start(this%interactions)
1265 do while (iter%has_next())
1266 interaction => iter%get_next()
1267 if(interaction%intra_interaction)
then
1268 call interaction%calculate_energy()
1269 this%internal_energy = this%internal_energy + interaction%energy
1281 class(
system_t),
intent(inout) :: this
1285 call this%update_kinetic_energy()
1286 this%total_energy = this%kinetic_energy
1289 call this%update_potential_energy()
1290 this%total_energy = this%total_energy + this%potential_energy
1293 call this%update_internal_energy()
1294 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
For some algorithms it might be necessary to store the status of a system at a given algorithmic step...
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(real64), 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 defines the abstract class for the interaction factory.
integer, parameter, public no_partners
integer, parameter, public all_except
integer, parameter, public only_partners
integer, parameter, public all_partners
This module implements fully polymorphic linked lists, and some specializations thereof.
subroutine, public messages_update_mpi_grp(namespace, mpigrp)
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_experimental(name, namespace)
subroutine, public messages_info(no_lines, iunit, debug_only, stress, all_nodes, 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...
This module implements the abstract system type.
subroutine, public system_algorithm_start(this)
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)
Initialize the iteration counters of the system and its interactions, algorithms and quantities.
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, 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, public system_algorithm_finish(this)
subroutine system_start_barrier(this, target_time, barrier_index)
recursive subroutine, public system_create_interactions(this, interaction_factory, available_partners)
create the interactions of the system
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)
Attempt to update all interactions of the system.
class(system_t) function, pointer system_iterator_get_next(this)
logical function system_update_couplings(this)
Update the couplings (quantities) of the interaction partners.
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, public system_new_algorithm(this, factory)
subroutine system_output_finish(this)
subroutine system_list_add_node(this, partner)
add system to list
subroutine, public system_reset_iteration_counters(this, accumulated_iterations)
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
abstract class for interaction factories
type for storing options to be used when creating a given interaction
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
Systems (system_t) can expose quantities that can be used to calculate interactions with other system...
These classes extends the list and list iterator to create a system list.
Abstract class for systems.