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