module procedures_changes_factory use, intrinsic :: iso_fortran_env, only: DP => REAL64 use data_input_prefixes, only: changes_prefix use json_module, only: json_file use classes_number_to_string, only: Concrete_Number_to_String use procedures_checks, only: check_data_found use classes_periodic_box, only: Abstract_Periodic_Box use types_environment_wrapper, only: Environment_Wrapper use procedures_environment_inquirers, only: property_total_volume_can_change => & total_volume_can_change use types_component_wrapper, only: Component_Wrapper use procedures_mixture_properties, only: set_have_positions, set_have_orientations, set_can_exchange use module_move_tuning, only: Concrete_Move_Tuning_Parameters use procedures_changed_boxes_size_factory, only: changed_boxes_size_create => create, & changed_boxes_size_destroy => destroy use procedures_exchanged_boxes_size_factory, only: exchanged_boxes_size_create => create, & exchanged_boxes_size_destroy => destroy use types_move_tuner_parameters, only: Concrete_Move_Tuner_Parameters use procedures_move_tuner_factory, only: move_tuner_create_boxes_size => create_boxes_size, & move_tuner_destroy => destroy use procedures_random_coordinates_factory, only: random_coordinates_create => create, & random_coordinates_destroy => destroy use procedures_coordinates_copier_factory, only: coordinates_copier_create_position => & create_position, coordinates_copier_create_orientation => create_orientation, & coordinates_copier_destroy => destroy use types_changes_component_wrapper, only: Changes_Component_Wrapper use procedures_changes_component_factory, only: changes_component_create => create, & changes_component_destroy => destroy use types_changes_wrapper, only: Changes_Wrapper implicit none private public :: create, destroy interface create module procedure :: create_all module procedure :: create_components end interface create interface destroy module procedure :: destroy_components module procedure :: destroy_all end interface destroy contains subroutine create_all(changes, environment, components, num_tuning_steps, generating_data) type(Changes_Wrapper), intent(out) :: changes type(Environment_Wrapper), intent(in) :: environment type(Component_Wrapper), intent(in) :: components(:, :) integer, intent(in) :: num_tuning_steps type(json_file), intent(inout) :: generating_data type(Concrete_Move_Tuning_Parameters) :: box_size_tuning_parameters, & components_tuning_parameters type(Concrete_Move_Tuner_Parameters) :: box_size_tuner_parameters, & components_tuner_parameters logical, dimension(size(components, 1), size(components, 2)) :: have_positions, & have_orientations, can_exchange logical :: total_volume_can_change logical :: some_boxes_size_can_change, some_components_have_coordinates total_volume_can_change = property_total_volume_can_change(environment%beta_pressure) some_boxes_size_can_change = total_volume_can_change .or. & size(environment%periodic_boxes) > 1 call set_tuning_parameters(box_size_tuning_parameters, num_tuning_steps, & some_boxes_size_can_change, generating_data, changes_prefix//"Boxes.") call changed_boxes_size_create(changes%changed_boxes_size, environment%periodic_boxes, & box_size_tuning_parameters, total_volume_can_change, generating_data, changes_prefix//& "Boxes.") call exchanged_boxes_size_create(changes%exchanged_boxes_size, environment%periodic_boxes, & box_size_tuning_parameters, generating_data, changes_prefix//"Boxes.") call set_tuner_parameters(box_size_tuner_parameters, num_tuning_steps, & some_boxes_size_can_change, generating_data, changes_prefix//"Boxes.") call move_tuner_create_boxes_size(changes%boxes_size_change_tuner, changes%& changed_boxes_size, box_size_tuner_parameters, num_tuning_steps) call move_tuner_create_boxes_size(changes%boxes_size_exchange_tuner, changes%& exchanged_boxes_size, box_size_tuner_parameters, num_tuning_steps) call set_have_positions(have_positions, components) call set_have_orientations(have_orientations, components) some_components_have_coordinates = any(have_positions) .or. any(have_orientations) call set_tuning_parameters(components_tuning_parameters, num_tuning_steps, & some_components_have_coordinates, generating_data, changes_prefix//"Components.") call set_tuner_parameters(components_tuner_parameters, num_tuning_steps, & some_components_have_coordinates, generating_data, changes_prefix//"Components.") call create(changes%components, environment%periodic_boxes, components, & components_tuning_parameters, components_tuner_parameters, num_tuning_steps, & generating_data, changes_prefix//"Components.") call set_can_exchange(can_exchange, components) call random_coordinates_create(changes%random_positions, environment%accessible_domains, & have_positions, can_exchange .or. size(environment%periodic_boxes) > 1) call random_coordinates_create(changes%random_orientation, have_orientations, can_exchange) call coordinates_copier_create_position(changes%position_copiers, changes%random_positions,& have_positions, can_exchange) call coordinates_copier_create_orientation(changes%orientation_copier, changes%& random_orientation, have_orientations, can_exchange) end subroutine create_all subroutine create_components(components, periodic_boxes, mixture_components, & components_tuning_parameters, components_tuner_parameters, num_tuning_steps, & generating_data, prefix) type(Changes_Component_Wrapper), allocatable, intent(out) :: components(:, :) class(Abstract_Periodic_Box), intent(in) :: periodic_boxes(:) type(Component_Wrapper), intent(in) :: mixture_components(:, :) type(Concrete_Move_Tuning_Parameters) :: components_tuning_parameters type(Concrete_Move_Tuner_Parameters) :: components_tuner_parameters integer, intent(in) :: num_tuning_steps type(json_file), intent(inout) :: generating_data character(len=*), intent(in) :: prefix integer :: i_box, i_component type(Concrete_Number_to_String) :: string allocate(components(size(mixture_components, 1), size(mixture_components, 2))) do i_box = 1, size(components, 2) do i_component = 1, size(components, 1) call changes_component_create(components(i_component, i_box), & periodic_boxes(i_box), mixture_components(i_component, i_box), & components_tuning_parameters, components_tuner_parameters, num_tuning_steps, & generating_data, prefix//"Component "//string%get(i_component)//".") end do end do end subroutine create_components subroutine set_tuning_parameters(parameters, num_tuning_steps, needed, generating_data, prefix) type(Concrete_Move_Tuning_Parameters), intent(out) :: parameters integer, intent(in) :: num_tuning_steps logical, intent(in) :: needed type(json_file), intent(inout) :: generating_data character(len=*), intent(in) :: prefix character(len=:), allocatable :: data_field logical :: data_found if (needed .and. num_tuning_steps > 0) then data_field = prefix//"increase factor" call generating_data%get(data_field, parameters%increase_factor, data_found) call check_data_found(data_field, data_found) data_field = prefix//"maximum increase factor" call generating_data%get(data_field, parameters%increase_factor_max, data_found) call check_data_found(data_field, data_found) else parameters%increase_factor = 1._DP parameters%increase_factor_max = parameters%increase_factor end if end subroutine set_tuning_parameters subroutine set_tuner_parameters(parameters, num_tuning_steps, needed, generating_data, prefix) type(Concrete_Move_Tuner_Parameters), intent(out) :: parameters integer, intent(in) :: num_tuning_steps logical, intent(in) :: needed type(json_file), intent(inout) :: generating_data character(len=*), intent(in) :: prefix character(len=:), allocatable :: data_field logical :: data_found if (needed .and. num_tuning_steps > 0) then data_field = prefix//"accumulation period" call generating_data%get(data_field, parameters%accumulation_period, data_found) call check_data_found(data_field, data_found) data_field = prefix//"wanted success ratio" call generating_data%get(data_field, parameters%wanted_success_ratio, data_found) call check_data_found(data_field, data_found) data_field = prefix//"tolerance" call generating_data%get(data_field, parameters%tolerance, data_found) call check_data_found(data_field, data_found) else parameters%accumulation_period = 0 parameters%wanted_success_ratio = 0._DP parameters%tolerance = 0._DP end if end subroutine set_tuner_parameters subroutine destroy_all(changes) type(Changes_Wrapper), intent(inout) :: changes call coordinates_copier_destroy(changes%orientation_copier) call coordinates_copier_destroy(changes%position_copiers) call random_coordinates_destroy(changes%random_orientation) call random_coordinates_destroy(changes%random_positions) call destroy_components(changes%components) call move_tuner_destroy(changes%boxes_size_exchange_tuner) call move_tuner_destroy(changes%boxes_size_change_tuner) call exchanged_boxes_size_destroy(changes%exchanged_boxes_size) call changed_boxes_size_destroy(changes%changed_boxes_size) end subroutine destroy_all subroutine destroy_components(components) type(Changes_Component_Wrapper), allocatable, intent(inout) :: components(:, :) integer :: i_box integer :: i_component if (allocated(components)) then do i_box = size(components, 2), 1, -1 do i_component = size(components, 1), 1, -1 call changes_component_destroy(components(i_component, i_box)) end do end do deallocate(components) end if end subroutine destroy_components end module procedures_changes_factory