1!
2! Copyright (C) 2001-2008 Quantum ESPRESSO group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8!-----------------------------------------------------------------------
9LOGICAL FUNCTION eqvect( x, y, f, accep )
10  !-----------------------------------------------------------------------
11  !! This function tests if the difference x-y-f is an integer.
12  !
13  USE kinds
14  !
15  IMPLICIT NONE
16  !
17  REAL(DP), INTENT(IN) :: x(3)
18  !! first 3d vector in crystal axis
19  REAL(DP), INTENT(IN) :: y(3)
20  !! second 3d vector in crystal axis
21  REAL(DP), INTENT(IN) :: f(3)
22  !! fractionary translation
23  REAL(DP), INTENT(IN) :: accep
24  !! threshold of acceptability
25  !
26  eqvect = ABS( x(1)-y(1)-f(1) - NINT(x(1)-y(1)-f(1)) ) < accep .AND. &
27           ABS( x(2)-y(2)-f(2) - NINT(x(2)-y(2)-f(2)) ) < accep .AND. &
28           ABS( x(3)-y(3)-f(3) - NINT(x(3)-y(3)-f(3)) ) < accep
29  !
30  RETURN
31  !
32END FUNCTION eqvect
33