mimic_min_image Subroutine

subroutine mimic_min_image(box, pivot, subsystems)

    !> vectors of the encompassing box
    real(dp), dimension(3,3), intent(in) :: box
    !> pivot point
    real(dp), dimension(3), intent(in) :: pivot
    !> classical fragments
    class(subsystem_type), dimension(:), intent(inout) :: subsystems

    real(dp), dimension(3) :: frag_center, orig_center
    real(dp), dimension(3) :: r_ij, stmp, s_ij
    real(dp), dimension(3,3) :: inv_box
    integer :: i, j, k
    type(cell_type) :: classical_box

    call timer_start("mimic_min_image")

    call classical_box%init(0, [1, 1, 1], [1, 1, 1], [0.0_dp, 0.0_dp, 0.0_dp], box)

    inv_box = classical_box%lattice_inverse

    do k = 1, size(subsystems)
        !$OMP PARALLEL DO PRIVATE(j, frag_center, orig_center, r_ij, stmp, &
        !$OMP& s_ij, i)
        do j = 1, subsystems(k)%num_fragments
                frag_center = subsystems(k)%fragments(j)%centroid()
                orig_center = frag_center
                r_ij = frag_center - pivot
                stmp = matmul(inv_box, r_ij)
                s_ij = stmp - anint(stmp)
                frag_center = matmul(s_ij, box) + pivot
                s_ij = frag_center - orig_center
                do i = 1, subsystems(k)%fragments(j)%num_atoms
                    if (.not. subsystems(k)%fragments(j)%atoms(i)%overlapped) then
                        subsystems(k)%fragments(j)%atoms(i)%coordinate = &
                            subsystems(k)%fragments(j)%atoms(i)%coordinate + s_ij
                    endif
                end do
        end do
        !$OMP END PARALLEL DO
    end do

    call timer_stop

end subroutine mimic_min_image