1! dftd3 program for computing the dispersion energy and forces from cart
2! and atomic numbers as described in
3!
4! S. Grimme, J. Antony, S. Ehrlich and H. Krieg
5! J. Chem. Phys, 132 (2010), 154104
6!
7! S. Grimme, S. Ehrlich and L. Goerigk, J. Comput. Chem, 32 (2011), 1456
8! (for BJ-damping)
9!
10! Copyright (C) 2009 - 2011 Stefan Grimme, University of Muenster, Germany
11!
12! Repackaging of the original code without any change in the functionality:
13!
14! Copyright (C) 2016, Bálint Aradi
15!
16! This program is free software; you can redistribute it and/or modify
17! it under the terms of the GNU General Public License as published by
18! the Free Software Foundation; either version 1, or (at your option)
19! any later version.
20!
21! This program is distributed in the hope that it will be useful,
22! but WITHOUT ANY WARRANTY; without even the implied warranty of
23! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24! GNU General Public License for more details.
25!
26! For the GNU General Public License, see <http://www.gnu.org/licenses/>
27!
28
29module dftd3_common
30  implicit none
31
32  ! Working precision (double precision)
33  integer, parameter :: wp = kind(1.0d0)
34
35  ! Large integers
36  integer, parameter :: int64 = selected_int_kind(12)
37
38  ! global ad hoc parameters
39  real(wp), parameter :: k1 = 16.0
40  real(wp), parameter :: k2 = 4./3.
41
42  ! reasonable choices are between 3 and 5
43  ! this gives smoth curves with maxima around the integer values
44  ! k3=3 give for CN=0 a slightly smaller value than computed
45  ! for the free atom. This also yields to larger CN for atoms
46  ! in larger molecules but with the same chem. environment
47  ! which is physically not right
48  ! values >5 might lead to bumps in the potential
49  real(wp), parameter :: k3 = -4.
50
51
52  real(wp), parameter :: autoang = 0.52917726d0
53  real(wp), parameter :: autokcal = 627.509541d0
54  real(wp), parameter :: autoev = 27.21138505
55  ! J/mol nm^6 - > au
56  real(wp), parameter :: c6conv = 1.d-3/2625.4999d0/((autoang / 10.0d0)**6)
57
58
59contains
60
61  subroutine limit(iat,jat,iadr,jadr)
62    integer, intent(inout) :: iat,jat
63    integer, intent(out) :: iadr,jadr
64    integer :: i
65    iadr=1
66    jadr=1
67    i=100
68    do while (iat .gt. 100)
69      iat=iat-100
70      iadr=iadr+1
71    end do
72
73    i=100
74    do while (jat .gt.100)
75      jat=jat-100
76      jadr=jadr+1
77    end do
78
79  end subroutine limit
80
81end module dftd3_common
82