mimic_center_qm Subroutine

subroutine mimic_center_qm(r_diff, subsystem, quantum_fragment)

    !> resulting translation vector
    real(dp), dimension(3), intent(out) :: r_diff
    !> classical subsystem
    class(subsystem_type), dimension(:), intent(in) :: subsystem
    !> quantum fragment
    class(quantum_fragment_type), intent(in) :: quantum_fragment

    real(dp) :: max_x, max_y, max_z
    real(dp) :: min_x, min_y, min_z
    real(dp), dimension(3,3) :: quantum_box
    integer :: n_client, n_atom, n_qatom

    call timer_start("mimic_center_qm")

    max_x = -huge(0.0_dp)
    max_y = -huge(0.0_dp)
    max_z = -huge(0.0_dp)

    min_x = huge(0.0_dp)
    min_y = huge(0.0_dp)
    min_z = huge(0.0_dp)

    quantum_box = quantum_fragment%cell%lattice

    do n_qatom = 1, quantum_fragment%num_nuclei
        max_x = max(max_x, quantum_fragment%nuclei(n_qatom)%coordinate(1))
        max_y = max(max_y, quantum_fragment%nuclei(n_qatom)%coordinate(2))
        max_z = max(max_z, quantum_fragment%nuclei(n_qatom)%coordinate(3))
        min_x = min(min_x, quantum_fragment%nuclei(n_qatom)%coordinate(1))
        min_y = min(min_y, quantum_fragment%nuclei(n_qatom)%coordinate(2))
        min_z = min(min_z, quantum_fragment%nuclei(n_qatom)%coordinate(3))
    end do

    r_diff(1) = (quantum_box(1,1) - max_x - min_x) * 0.5_dp
    r_diff(2) = (quantum_box(2,2) - max_y - min_y) * 0.5_dp
    r_diff(3) = (quantum_box(3,3) - max_z - min_z) * 0.5_dp

    !$OMP PARALLEL DO PRIVATE(n_qatom)
    do n_qatom = 1, quantum_fragment%num_nuclei
        quantum_fragment%nuclei(n_qatom)%coordinate = &
            quantum_fragment%nuclei(n_qatom)%coordinate + r_diff
    end do
    !$OMP END PARALLEL DO

    do n_client = 1, size(subsystem)
        !$OMP PARALLEL DO PRIVATE(n_atom)
        do n_atom = 1, size(subsystem(n_client)%atoms)
            if (.not. subsystem(n_client)%atoms(n_atom)%overlapped) then
                subsystem(n_client)%atoms(n_atom)%coordinate = &
                    subsystem(n_client)%atoms(n_atom)%coordinate + r_diff
            endif
        end do
        !$OMP END PARALLEL DO
    end do

    call timer_stop

end subroutine mimic_center_qm