24 semi_empirical_mpole_p_type,&
25 semi_empirical_mpole_type
28 #include "./base/base_uses.f90"
35 LOGICAL,
PARAMETER,
PRIVATE :: debug_this_module = .false.
36 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'semi_empirical_mpole_methods'
56 TYPE(semi_empirical_mpole_p_type),
DIMENSION(:), &
58 TYPE(semi_empirical_type),
POINTER :: se_parameter
59 INTEGER,
INTENT(IN) :: method
61 CHARACTER(LEN=3),
DIMENSION(9),
PARAMETER :: &
62 label_print_orb = (/
" s",
" px",
" py",
" pz",
"dx2",
"dzx",
"dz2",
"dzy",
"dxy"/)
63 INTEGER,
DIMENSION(9),
PARAMETER :: loc_index = (/1, 2, 2, 2, 3, 3, 3, 3, 3/)
65 INTEGER :: a, b, i, ind1, ind2, j, k, k1, k2, mu, &
67 REAL(kind=
dp) :: dlm, tmp, wp, ws, zb, zp, zs, zt
68 REAL(kind=
dp),
DIMENSION(3, 3, 45) :: m2
69 REAL(kind=
dp),
DIMENSION(3, 45) :: m1
70 REAL(kind=
dp),
DIMENSION(45) :: m0
71 REAL(kind=
dp),
DIMENSION(6, 0:2) :: amn
72 TYPE(semi_empirical_mpole_type),
POINTER :: mpole
74 cpassert(.NOT.
ASSOCIATED(mpoles))
76 natorb = se_parameter%natorb
78 ndim = natorb*(natorb + 1)/2
86 CALL amn_l(se_parameter, amn)
95 mpole => mpoles(ind2)%mpole
100 mpole%c = huge(0.0_dp)
101 mpole%d = huge(0.0_dp)
102 mpole%qs = huge(0.0_dp)
103 mpole%qc = huge(0.0_dp)
106 IF (
alm(ind1, 0, 0) /= 0.0_dp)
THEN
107 dlm = 1.0_dp/sqrt(real((2*0 + 1), kind=
dp))
108 tmp = -dlm*amn(
indexb(a, b), 0)
109 mpole%c = tmp*
alm(ind1, 0, 0)
110 mpole%task(1) = .true.
114 IF (any(
alm(ind1, 1, -1:1) /= 0.0_dp))
THEN
115 dlm = 1.0_dp/sqrt(real((2*1 + 1), kind=
dp))
116 tmp = -dlm*amn(
indexb(a, b), 1)
117 mpole%d(1) = tmp*
alm(ind1, 1, 1)
118 mpole%d(2) = tmp*
alm(ind1, 1, -1)
119 mpole%d(3) = tmp*
alm(ind1, 1, 0)
120 mpole%task(2) = .true.
124 IF (any(
alm(ind1, 2, -2:2) /= 0.0_dp))
THEN
125 dlm = 1.0_dp/sqrt(real((2*2 + 1), kind=
dp))
126 tmp = -dlm*amn(
indexb(a, b), 2)
129 mpole%qs(1) = tmp*
alm(ind1, 2, 0)
130 mpole%qs(2) = tmp*
alm(ind1, 2, 1)
131 mpole%qs(3) = tmp*
alm(ind1, 2, -1)
132 mpole%qs(4) = tmp*
alm(ind1, 2, 2)
133 mpole%qs(5) = tmp*
alm(ind1, 2, -2)
137 mpole%task(3) = .true.
140 IF (debug_this_module)
THEN
141 WRITE (*,
'(A,2I6,A)')
"Orbitals ", i, j, &
142 " ("//label_print_orb(i)//
","//label_print_orb(j)//
")"
143 IF (mpole%task(1))
WRITE (*,
'(9F12.6)') mpole%c
144 IF (mpole%task(2))
WRITE (*,
'(9F12.6)') mpole%d
145 IF (mpole%task(3))
WRITE (*,
'(9F12.6)') mpole%qc
153 cpassert(natorb <= 4)
159 DO mu = 1, se_parameter%natorb
160 m0(
indexb(mu, mu)) = 1.0_dp
163 zs = se_parameter%sto_exponents(0)
164 zp = se_parameter%sto_exponents(1)
167 ws = real((2*nr + 2)*(2*nr + 1),
dp)/(24.0_dp*zs**2)
169 m2(k, k,
indexb(1, 1)) = ws
174 zb = 0.5_dp*(zs + zp)
176 m1(k,
indexb(1, 1 + k)) = (zt/zb)**(2*nr + 1)*real(2*nr + 1,
dp)/(2.0*zb*sqrt(3.0_dp))
179 wp = real((2*nr + 2)*(2*nr + 1),
dp)/(40.0_dp*zp**2)
183 m2(k2, k2,
indexb(1 + k1, 1 + k1)) = 3.0_dp*wp
185 m2(k2, k2,
indexb(1 + k1, 1 + k1)) = wp
189 m2(1, 2,
indexb(1 + 1, 1 + 2)) = wp
190 m2(2, 1,
indexb(1 + 1, 1 + 2)) = wp
191 m2(2, 3,
indexb(1 + 2, 1 + 3)) = wp
192 m2(3, 2,
indexb(1 + 2, 1 + 3)) = wp
193 m2(3, 1,
indexb(1 + 3, 1 + 1)) = wp
194 m2(1, 3,
indexb(1 + 3, 1 + 1)) = wp
201 mpole => mpoles(ind2)%mpole
205 mpole%cs = -m0(
indexb(i, j))
207 mpole%ds = -m1(1:3,
indexb(i, j))
209 mpole%qq = -3._dp*m2(1:3, 1:3,
indexb(i, j))
210 IF (debug_this_module)
THEN
211 WRITE (*,
'(A,2I6,A)')
"Orbitals ", i, j, &
212 " ("//label_print_orb(i)//
","//label_print_orb(j)//
")"
213 WRITE (*,
'(9F12.6)') mpole%cs
214 WRITE (*,
'(9F12.6)') mpole%ds
215 WRITE (*,
'(9F12.6)') mpole%qq
237 REAL(kind=
dp),
DIMENSION(3, 3),
INTENT(OUT) :: qcart
238 REAL(kind=
dp),
DIMENSION(5),
INTENT(IN) :: qsph
248 qcart(1, 1) = (qsph(4) - qsph(1)/sqrt(3.0_dp))*sqrt(3.0_dp)/2.0_dp
249 qcart(2, 1) = qsph(5)*sqrt(3.0_dp)/2.0_dp
250 qcart(3, 1) = qsph(2)*sqrt(3.0_dp)/2.0_dp
251 qcart(2, 2) = -(qsph(4) + qsph(1)/sqrt(3.0_dp))*sqrt(3.0_dp)/2.0_dp
252 qcart(3, 2) = qsph(3)*sqrt(3.0_dp)/2.0_dp
253 qcart(3, 3) = qsph(1)
255 qcart(1, 2) = qcart(2, 1)
256 qcart(1, 3) = qcart(3, 1)
257 qcart(2, 3) = qcart(3, 2)
269 TYPE(nddo_mpole_type),
POINTER :: nddo_mpole
270 INTEGER,
INTENT(IN) :: natom
272 CHARACTER(len=*),
PARAMETER :: routinen =
'nddo_mpole_setup'
276 CALL timeset(routinen, handle)
278 IF (
ASSOCIATED(nddo_mpole))
THEN
283 ALLOCATE (nddo_mpole%charge(natom))
284 ALLOCATE (nddo_mpole%dipole(3, natom))
285 ALLOCATE (nddo_mpole%quadrupole(3, 3, natom))
287 ALLOCATE (nddo_mpole%efield0(natom))
288 ALLOCATE (nddo_mpole%efield1(3, natom))
289 ALLOCATE (nddo_mpole%efield2(9, natom))
291 CALL timestop(handle)
Defines the basic variable types.
integer, parameter, public dp
Arrays of parameters used in the semi-empirical calculations \References Everywhere in this module TC...
integer, dimension(9), public se_map_alm
integer, dimension(9, 9), public indexb
real(kind=dp), dimension(45, 0:2, -2:2), public alm
integer, dimension(9, 9), public indexa
Setup and Methods for semi-empirical multipole types.
subroutine, public semi_empirical_mpole_p_setup(mpoles, se_parameter, method)
Setup semi-empirical mpole type This function setup for each semi-empirical type a structure containi...
subroutine, public quadrupole_sph_to_cart(qcart, qsph)
Transforms the quadrupole components from sphericals to cartesians.
subroutine, public nddo_mpole_setup(nddo_mpole, natom)
Setup NDDO multipole type.
Definition of the semi empirical multipole integral expansions types.
subroutine, public nddo_mpole_release(nddo_mpole)
Deallocate NDDO multipole type.
subroutine, public semi_empirical_mpole_p_create(mpole, ndim)
Allocate semi-empirical mpole type.
subroutine, public nddo_mpole_create(nddo_mpole)
Allocate NDDO multipole type.
Utilities to post-process semi-empirical parameters.
Definition of the semi empirical parameter types.