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 logical function propor( N, A, B, TOL, AOVERB ) 9C ********************************************************************** 10C Checks if two vectors are proportional within a tolerance. 11C Written by J.M.Soler. August 1996. 12C ********************************************************************** 13 14 use precision 15 use sys 16 17 implicit none 18 19 integer i, imax, n 20 real(dp) a(n), aoverb, b(n), bmax, tol 21 22 bmax = 0.0d0 23 imax = 0 24 do i = 1,n 25 if ( abs(b(i)) .gt. bmax ) then 26 imax = i 27 bmax = abs(b(i)) 28 endif 29 enddo 30 if (imax .eq. 0) call die("propor: ERROR: IMAX = 0") 31 32 propor = .true. 33 if (bmax .eq. 0.0d0) then 34 aoverb = 0.0d0 35 do i = 1,n 36 if ( abs(a(i)) .gt. tol ) then 37 propor = .false. 38 return 39 endif 40 enddo 41 else 42 aoverb = a(imax) / b(imax) 43 do i = 1,n 44 if ( abs(a(i)-b(i)*aoverb) .gt. tol ) then 45 propor = .false. 46 return 47 endif 48 enddo 49 endif 50 end 51 52 53 54