1! ---
2! Copyright (C) 1996-2016	The SIESTA group
3!  This file is distributed under the terms of the
4!  GNU General Public License: see COPYING in the top directory
5!  or http://www.gnu.org/copyleft/gpl.txt .
6! See Docs/Contributors.txt for a list of contributors.
7! ---
8      module m_proximity_check
9      private
10      public :: proximity_check
11      CONTAINS
12
13      subroutine proximity_check( rmax )
14      USE precision, only:dp
15      USE siesta_options
16      use units, only: Ang
17      use siesta_geom
18      use chemical, only: is_floating
19      use parallel,     only : IOnode
20      use neighbour,    only : jna=>jan, r2ij, mneighb,
21     &                         reset_neighbour_arrays
22      use m_ts_global_vars, only : onlyS
23      implicit none
24      real(dp), intent(in)  :: rmax
25      integer :: ii, jj, jamin, idxneighJ, nneigbI, isel, nna
26      real(dp):: rmin, r2min
27
28!     Check if any two atoms are unreasonably close
29      isel = 0   ! Get back all neighbors, regardless of whether ja>ia
30
31!     Initialize neighb
32      call mneighb( scell, rmax, na_s, xa, 0, isel, nna )
33      do ii = 1,na_s
34        ! Check whether the atom is a floating orbital
35        ! If that is the case, simply skip checking...
36        if ( is_floating(isa(ii)) ) cycle
37        r2min = huge(1._dp)
38        jamin = 0
39        call mneighb( scell, rmax, na_s, xa, ii, isel, nneigbI )
40        do jj = 1,nneigbI
41          idxneighJ = jna(jj)
42          if ( is_floating(isa(idxneighJ)) ) cycle
43          if ( r2ij(jj).lt.r2min .and. idxneighJ.ge.ii ) then
44!           Check that it is not the same atom
45            if ( idxneighJ.ne.ii .or. r2ij(jj).gt.1.d-12 ) then
46              r2min = r2ij(jj)
47              jamin = idxneighJ
48            endif
49          endif
50        enddo
51        rmin = sqrt( r2min )
52        if (IOnode) then
53          if (( rmin .lt. rijmin ) .and. (.not. onlyS))
54     &      write(6,'(a,2i6,a,f12.6,a)') 'siesta: WARNING: Atoms', ii,
55     &                    jamin, ' too close: rij =', rmin/Ang, ' Ang'
56        endif
57      enddo
58
59      call reset_neighbour_arrays( )
60
61      end subroutine proximity_check
62      end module m_proximity_check
63