| 1 |
subroutine doMultipolePair(atom1, atom2, d, rij, r2, rcut, sw, & |
| 2 |
vpair, pot, eFrame, f, t) |
| 3 |
|
| 4 |
!*************************************************************** |
| 5 |
! doMultipolePair evaluates the potential, forces, and torques |
| 6 |
! between point multipoles. It is based on the ewald2 real |
| 7 |
! space routine in the MDMULP code written by W. Smith and |
| 8 |
! available from the CCP5 website. |
| 9 |
! |
| 10 |
! We're using the damped real space portion of the Ewald sum |
| 11 |
! as the entire interaction. Details on this portion of the |
| 12 |
! sum can be found in: |
| 13 |
! |
| 14 |
! "Point Multipoles in the Ewald Summation (Revisited)," by |
| 15 |
! W. Smith, CCP5 Newsletter, 46, pp. 18-30 (1998). |
| 16 |
! |
| 17 |
!************************************************************** |
| 18 |
|
| 19 |
integer, intent(in) :: atom1, atom2 |
| 20 |
real(kind=dp), intent(in) :: rij, r2, sw, rcut |
| 21 |
real(kind=dp), intent(in), dimension(3) :: d |
| 22 |
real(kind=dp), intent(inout) :: vpair |
| 23 |
|
| 24 |
real( kind = dp ) :: pot |
| 25 |
real( kind = dp ), dimension(9,nLocal) :: eFrame |
| 26 |
real( kind = dp ), dimension(3,nLocal) :: f |
| 27 |
real( kind = dp ), dimension(3,nLocal) :: t |
| 28 |
logical :: i_is_Charge, i_is_Dipole, i_is_SplitDipole, i_is_Quadrupole |
| 29 |
logical :: j_is_Charge, j_is_Dipole, j_is_SplitDipole, j_is_Quadrupole |
| 30 |
integer :: me1, me2, id1, id2 |
| 31 |
real (kind=dp) :: q_i, q_j, mu_i, mu_j, d_i, d_j |
| 32 |
real (kind=dp) :: qxx_i, qyy_i, qzz_i |
| 33 |
real (kind=dp) :: qxx_j, qyy_j, qzz_j |
| 34 |
|
| 35 |
real (kind=dp) :: epot, qii, alsq2, alsq2n, exp2a, ralpha |
| 36 |
real (kind=dp), dimension(3) :: ftm, ttm_i, ttm_j |
| 37 |
real (kind=dp), dimension(3) :: qir, qjr, qidj, qjdi, qiqjr, qjqir |
| 38 |
real (kind=dp), dimension(3) :: dixdj, qixqj, dixr, djxr, rxqir, rxqjr |
| 39 |
real (kind=dp), dimension(3) :: dixqjr, djxqir, rxqidj, rxqjdi, rxqijr |
| 40 |
real (kind=dp), dimension(3) :: rxqjir, qjrxqir |
| 41 |
real (kind=dp), dimension(6) :: bn |
| 42 |
real (kind=dp), dimension(10) :: sc |
| 43 |
real (kind=dp), dimension(9) :: gl |
| 44 |
|
| 45 |
real(kind=dp) :: a1, a2, a3, a4, a5, p |
| 46 |
|
| 47 |
DATA A1,A2,A3/0.254829592,-0.284496736,1.421413741/ |
| 48 |
DATA A4,A5,P/-1.453152027,1.061405429,0.3275911/ |
| 49 |
|
| 50 |
if (.not.summationMethodChecked) then |
| 51 |
call checkSummationMethod() |
| 52 |
endif |
| 53 |
|
| 54 |
#ifdef IS_MPI |
| 55 |
me1 = atid_Row(atom1) |
| 56 |
me2 = atid_Col(atom2) |
| 57 |
#else |
| 58 |
me1 = atid(atom1) |
| 59 |
me2 = atid(atom2) |
| 60 |
#endif |
| 61 |
|
| 62 |
! logicals |
| 63 |
i_is_Charge = ElectrostaticMap(me1)%is_Charge |
| 64 |
i_is_Dipole = ElectrostaticMap(me1)%is_Dipole |
| 65 |
i_is_Quadrupole = ElectrostaticMap(me1)%is_Quadrupole |
| 66 |
|
| 67 |
j_is_Charge = ElectrostaticMap(me2)%is_Charge |
| 68 |
j_is_Dipole = ElectrostaticMap(me2)%is_Dipole |
| 69 |
j_is_Quadrupole = ElectrostaticMap(me2)%is_Quadrupole |
| 70 |
|
| 71 |
if (i_is_Charge) then |
| 72 |
q_i = ElectrostaticMap(me1)%charge |
| 73 |
else |
| 74 |
q_i = 0.0_dp |
| 75 |
endif |
| 76 |
|
| 77 |
if (j_is_Charge) then |
| 78 |
q_j = ElectrostaticMap(me2)%charge |
| 79 |
else |
| 80 |
q_j = 0.0_dp |
| 81 |
endif |
| 82 |
|
| 83 |
if (i_is_Dipole) then |
| 84 |
mu_i = ElectrostaticMap(me1)%dipole_moment |
| 85 |
#ifdef IS_MPI |
| 86 |
d_i(1) = eFrame_Row(3,atom1) |
| 87 |
d_i(2) = eFrame_Row(6,atom1) |
| 88 |
d_i(3) = eFrame_Row(9,atom1) |
| 89 |
#else |
| 90 |
d_i(1) = eFrame(3,atom1) |
| 91 |
d_i(2) = eFrame(6,atom1) |
| 92 |
d_i(3) = eFrame(9,atom1) |
| 93 |
#endif |
| 94 |
d_i = d_i * mu_i |
| 95 |
else |
| 96 |
d_i = 0.0_dp |
| 97 |
endif |
| 98 |
|
| 99 |
if (j_is_Dipole) then |
| 100 |
mu_j = ElectrostaticMap(me2)%dipole_moment |
| 101 |
#ifdef IS_MPI |
| 102 |
d_j(1) = eFrame_Col(3,atom2) |
| 103 |
d_j(2) = eFrame_Col(6,atom2) |
| 104 |
d_j(3) = eFrame_Col(9,atom2) |
| 105 |
#else |
| 106 |
d_j(1) = eFrame(3,atom2) |
| 107 |
d_j(2) = eFrame(6,atom2) |
| 108 |
d_j(3) = eFrame(9,atom2) |
| 109 |
#endif |
| 110 |
d_j = d_j * mu_j |
| 111 |
else |
| 112 |
d_j = 0.0_dp |
| 113 |
endif |
| 114 |
|
| 115 |
if (i_is_Quadrupole) then |
| 116 |
qxx_i = ElectrostaticMap(me1)%quadrupole_moments(1) |
| 117 |
qyy_i = ElectrostaticMap(me1)%quadrupole_moments(2) |
| 118 |
qzz_i = ElectrostaticMap(me1)%quadrupole_moments(3) |
| 119 |
#ifdef IS_MPI |
| 120 |
qpole_i(1) = qxx_i * eFrame_Row(1,atom1) |
| 121 |
qpole_i(2) = qxx_i * eFrame_Row(4,atom1) |
| 122 |
qpole_i(3) = qxx_i * eFrame_Row(7,atom1) |
| 123 |
qpole_i(4) = qyy_i * eFrame_Row(2,atom1) |
| 124 |
qpole_i(5) = qyy_i * eFrame_Row(5,atom1) |
| 125 |
qpole_i(6) = qyy_i * eFrame_Row(8,atom1) |
| 126 |
qpole_i(7) = qzz_i * eFrame_Row(3,atom1) |
| 127 |
qpole_i(8) = qzz_i * eFrame_Row(6,atom1) |
| 128 |
qpole_i(9) = qzz_i * eFrame_Row(9,atom1) |
| 129 |
#else |
| 130 |
qpole_i(1) = qxx_i * eFrame(1,atom1) |
| 131 |
qpole_i(2) = qxx_i * eFrame(4,atom1) |
| 132 |
qpole_i(3) = qxx_i * eFrame(7,atom1) |
| 133 |
qpole_i(4) = qyy_i * eFrame(2,atom1) |
| 134 |
qpole_i(5) = qyy_i * eFrame(5,atom1) |
| 135 |
qpole_i(6) = qyy_i * eFrame(8,atom1) |
| 136 |
qpole_i(7) = qzz_i * eFrame(3,atom1) |
| 137 |
qpole_i(8) = qzz_i * eFrame(6,atom1) |
| 138 |
qpole_i(9) = qzz_i * eFrame(9,atom1) |
| 139 |
#endif |
| 140 |
else |
| 141 |
qpole_i = 0.0_dp |
| 142 |
endif |
| 143 |
|
| 144 |
if (j_is_Quadrupole) then |
| 145 |
qxx_j = ElectrostaticMap(me2)%quadrupole_moments(1) |
| 146 |
qyy_j = ElectrostaticMap(me2)%quadrupole_moments(2) |
| 147 |
qzz_j = ElectrostaticMap(me2)%quadrupole_moments(3) |
| 148 |
#ifdef IS_MPI |
| 149 |
qpole_j(1) = qxx_j * eFrame_Col(1,atom2) |
| 150 |
qpole_j(2) = qxx_j * eFrame_Col(4,atom2) |
| 151 |
qpole_j(3) = qxx_j * eFrame_Col(7,atom2) |
| 152 |
qpole_j(4) = qyy_j * eFrame_Col(2,atom2) |
| 153 |
qpole_j(5) = qyy_j * eFrame_Col(5,atom2) |
| 154 |
qpole_j(6) = qyy_j * eFrame_Col(8,atom2) |
| 155 |
qpole_j(7) = qzz_j * eFrame_Col(3,atom2) |
| 156 |
qpole_j(8) = qzz_j * eFrame_Col(6,atom2) |
| 157 |
qpole_j(9) = qzz_j * eFrame_Col(9,atom2) |
| 158 |
#else |
| 159 |
qpole_j(1) = qxx_j * eFrame(1,atom2) |
| 160 |
qpole_j(2) = qxx_j * eFrame(4,atom2) |
| 161 |
qpole_j(3) = qxx_j * eFrame(7,atom2) |
| 162 |
qpole_j(4) = qyy_j * eFrame(2,atom2) |
| 163 |
qpole_j(5) = qyy_j * eFrame(5,atom2) |
| 164 |
qpole_j(6) = qyy_j * eFrame(8,atom2) |
| 165 |
qpole_j(7) = qzz_j * eFrame(3,atom2) |
| 166 |
qpole_j(8) = qzz_j * eFrame(6,atom2) |
| 167 |
qpole_j(9) = qzz_j * eFrame(9,atom2) |
| 168 |
#endif |
| 169 |
else |
| 170 |
qpole_j = 0.0_dp |
| 171 |
endif |
| 172 |
|
| 173 |
! |
| 174 |
! INITIALISE TEMPORARY FORCE AND TORQUE ACCUMULATORS |
| 175 |
! |
| 176 |
|
| 177 |
ftm = 0.0 |
| 178 |
ttm_i = 0.0 |
| 179 |
ttm_j = 0.0 |
| 180 |
|
| 181 |
ri = 1.0_dp / rij |
| 182 |
ri2 = ri * ri |
| 183 |
|
| 184 |
! |
| 185 |
! CALCULATE BN FUNCTIONS |
| 186 |
! |
| 187 |
if (screeningMethod .eq. DAMPED) then |
| 188 |
! assemble the damping variables |
| 189 |
call lookupUniformSpline1d(erfcSpline, rij, erfcVal, derfcVal) |
| 190 |
else |
| 191 |
dampingAlpha = 0.0_dp |
| 192 |
erfcVal = 1.0_dp |
| 193 |
endif |
| 194 |
|
| 195 |
rrtpi = 1.0 / sqrt(pi) |
| 196 |
alsq2 = 2.0 * dampingAlpha**2 |
| 197 |
ralpi = 0.0 |
| 198 |
if(dampingAlpha .gt. 0.0) ralpi = rrtpi / dampingAlpha |
| 199 |
|
| 200 |
alphar = dampingAlpha * rij |
| 201 |
t = 1.0 / (1.0 + p*alphar) |
| 202 |
exp2a = exp(-alphar**2) |
| 203 |
bn(1) = ((((a5*t+a4)*t+a3)*t+a2)*t+a1) * t * exp2a * ri |
| 204 |
alsq2n = ralpi |
| 205 |
|
| 206 |
do n = 1, 5 |
| 207 |
bfac = real(n+n-1, kind=dp) |
| 208 |
alsq2n = alsq2*alsq2n |
| 209 |
bn(n+1) = ri2 * (bfac*bn(n) + alsq2n*exp2a) |
| 210 |
enddo |
| 211 |
|
| 212 |
ralpha = dampingAlpha * rij |
| 213 |
bn(0) = erfcVal * ri |
| 214 |
alsq2 = 2.0d0 * dampingAlpha**2 |
| 215 |
alsq2n = 0.0d0 |
| 216 |
if (dampingAlpha .gt. 0.0_dp) alsq2n = 1.0_dp / (sqrtpi*dampingAlpha) |
| 217 |
exp2a = exp(-ralpha**2) |
| 218 |
do m = 1, 5 |
| 219 |
bfac = real(m+m-1, kind=dp) |
| 220 |
alsq2n = alsq2 * alsq2n |
| 221 |
bn(m) = (bfac*bn(m-1)+alsq2n*exp2a) / r2 |
| 222 |
end do |
| 223 |
|
| 224 |
! |
| 225 |
! CONSTRUCT AUXILIARY VECTORS |
| 226 |
! |
| 227 |
|
| 228 |
dixdj(1) = d_i(2)*d_j(3) - d_i(3)*d_j(2) |
| 229 |
dixdj(2) = d_i(3)*d_j(1) - d_i(1)*d_j(3) |
| 230 |
dixdj(3) = d_i(1)*d_j(2) - d_i(2)*d_j(1) |
| 231 |
|
| 232 |
dixr(1) = d_i(2)*d(3) - d_i(3)*d(2) |
| 233 |
dixr(2) = d_i(3)*d(1) - d_i(1)*d(3) |
| 234 |
dixr(3) = d_i(1)*d(2) - d_i(2)*d(1) |
| 235 |
|
| 236 |
djxr(1) = d_j(2)*d(3) - d_j(3)*d(2) |
| 237 |
djxr(2) = d_j(3)*d(1) - d_j(1)*d(3) |
| 238 |
djxr(3) = d_j(1)*d(2) - d_j(2)*d(1) |
| 239 |
|
| 240 |
qir(1) = qpole_i(1)*d(1) + qpole_i(4)*d(2) + qpole_i(7)*d(3) |
| 241 |
qir(2) = qpole_i(2)*d(1) + qpole_i(5)*d(2) + qpole_i(8)*d(3) |
| 242 |
qir(3) = qpole_i(3)*d(1) + qpole_i(6)*d(2) + qpole_i(9)*d(3) |
| 243 |
|
| 244 |
qjr(1) = qpole_j(1)*d(1) + qpole_j(4)*d(2) + qpole_j(7)*d(3) |
| 245 |
qjr(2) = qpole_j(2)*d(1) + qpole_j(5)*d(2) + qpole_j(8)*d(3) |
| 246 |
qjr(3) = qpole_j(3)*d(1) + qpole_j(6)*d(2) + qpole_j(9)*d(3) |
| 247 |
|
| 248 |
qiqjr(1) = qpole_i(1)*qjr(1) + qpole_i(4)*qjr(2) + qpole_i(7)*qjr(3) |
| 249 |
qiqjr(2) = qpole_i(2)*qjr(1) + qpole_i(5)*qjr(2) + qpole_i(8)*qjr(3) |
| 250 |
qiqjr(3) = qpole_i(3)*qjr(1) + qpole_i(6)*qjr(2) + qpole_i(9)*qjr(3) |
| 251 |
|
| 252 |
|
| 253 |
qjqir(1) = qpole_j(1)*QIR(1) + qpole_j(4)*QIR(2) + qpole_j(7)*QIR(3) |
| 254 |
qjqir(2) = qpole_j(2)*QIR(1) + qpole_j(5)*QIR(2) + qpole_j(8)*QIR(3) |
| 255 |
qjqir(3) = qpole_j(3)*QIR(1) + qpole_j(6)*QIR(2) + qpole_j(9)*QIR(3) |
| 256 |
|
| 257 |
qixqj(1) = qpole_i(2)*qpole_j(3) + qpole_i(5)*qpole_j(6) + & |
| 258 |
qpole_i(8)*qpole_j(9) - qpole_i(3)*qpole_j(2) - & |
| 259 |
qpole_i(6)*qpole_j(5) - qpole_i(9)*qpole_j(8) |
| 260 |
|
| 261 |
qixqj(2) = qpole_i(3)*qpole_j(1) + qpole_i(6)*qpole_j(4) + & |
| 262 |
qpole_i(9)*qpole_j(7) - qpole_i(1)*qpole_j(3) - & |
| 263 |
qpole_i(4)*qpole_j(6) - qpole_i(7)*qpole_j(9) |
| 264 |
|
| 265 |
qixqj(3) = qpole_i(1)*qpole_j(2) + qpole_i(4)*qpole_j(5) + & |
| 266 |
qpole_i(7)*qpole_j(8) - qpole_i(2)*qpole_j(1) - & |
| 267 |
qpole_i(5)*qpole_j(4) - qpole_i(8)*qpole_j(7) |
| 268 |
|
| 269 |
rxqir(1) = d(2)*qir(3) - d(3)*qir(2) |
| 270 |
rxqir(2) = d(3)*qir(1) - d(1)*qir(3) |
| 271 |
rxqir(3) = d(1)*qir(2) - d(2)*qir(1) |
| 272 |
|
| 273 |
rxqjr(1) = d(2)*qjr(3) - d(3)*qjr(2) |
| 274 |
rxqjr(2) = d(3)*qjr(1) - d(1)*qjr(3) |
| 275 |
rxqjr(3) = d(1)*qjr(2) - d(2)*qjr(1) |
| 276 |
|
| 277 |
rxqijr(1) = d(2)*qiqjr(3) - d(3)*qiqjr(2) |
| 278 |
rxqijr(2) = d(3)*qiqjr(1) - d(1)*qiqjr(3) |
| 279 |
rxqijr(3) = d(1)*qiqjr(2) - d(2)*qiqjr(1) |
| 280 |
|
| 281 |
rxqjir(1) = d(2)*qjqir(3) - d(3)*qjqir(2) |
| 282 |
rxqjir(2) = d(3)*qjqir(1) - d(1)*qjqir(3) |
| 283 |
rxqjir(3) = d(1)*qjqir(2) - d(2)*qjqir(1) |
| 284 |
|
| 285 |
qjrxqir(1) = qjr(2)*qir(3) - qjr(3)*qir(2) |
| 286 |
qjrxqir(2) = qjr(3)*qir(1) - qjr(1)*qir(3) |
| 287 |
qjrxqir(3) = qjr(1)*qir(2) - qjr(2)*qir(1) |
| 288 |
|
| 289 |
qidj(1) = qpole_i(1)*d_j(1) + qpole_i(4)*d_j(2) + qpole_i(7)*d_j(3) |
| 290 |
qidj(2) = qpole_i(2)*d_j(1) + qpole_i(5)*d_j(2) + qpole_i(8)*d_j(3) |
| 291 |
qidj(3) = qpole_i(3)*d_j(1) + qpole_i(6)*d_j(2) + qpole_i(9)*d_j(3) |
| 292 |
|
| 293 |
qjdi(1) = qpole_j(1)*d_i(1) + qpole_j(4)*d_i(2) + qpole_j(7)*d_i(3) |
| 294 |
qjdi(2) = qpole_j(2)*d_i(1) + qpole_j(5)*d_i(2) + qpole_j(8)*d_i(3) |
| 295 |
qjdi(3) = qpole_j(3)*d_i(1) + qpole_j(6)*d_i(2) + qpole_j(9)*d_i(3) |
| 296 |
|
| 297 |
dixqjr(1) = d_i(2)*qjr(3) - d_i(3)*qjr(2) |
| 298 |
dixqjr(2) = d_i(3)*qjr(1) - d_i(1)*qjr(3) |
| 299 |
dixqjr(3) = d_i(1)*qjr(2) - d_i(2)*qjr(1) |
| 300 |
|
| 301 |
djxqir(1) = d_j(2)*qir(3) - d_j(3)*qir(2) |
| 302 |
djxqir(2) = d_j(3)*qir(1) - d_j(1)*qir(3) |
| 303 |
djxqir(3) = d_j(1)*qir(2) - d_j(2)*qir(1) |
| 304 |
|
| 305 |
rxqidj(1) = d(2)*qidj(3) - d(3)*qidj(2) |
| 306 |
rxqidj(2) = d(3)*qidj(1) - d(1)*qidj(3) |
| 307 |
rxqidj(3) = d(1)*qidj(2) - d(2)*qidj(1) |
| 308 |
|
| 309 |
rxqjdi(1) = d(2)*qjdi(3) - d(3)*qjdi(2) |
| 310 |
rxqjdi(2) = d(3)*qjdi(1) - d(1)*qjdi(3) |
| 311 |
rxqjdi(3) = d(1)*qjdi(2) - d(2)*qjdi(1) |
| 312 |
|
| 313 |
! |
| 314 |
! CALCULATE SCALAR PRODUCTS |
| 315 |
! |
| 316 |
|
| 317 |
qii = qpole_i(1) + qpole_i(5) + qpole_i(9) |
| 318 |
|
| 319 |
sc(1) = qpole_j(1) + qpole_j(5) + qpole_j(9) |
| 320 |
sc(2) = d_i(1)*d_j(1) + d_i(2)*d_j(2) + d_i(3)*d_j(3) |
| 321 |
sc(3) = d_i(1)*d(1) + d_i(2)*d(2) + d_i(3)*d(3) |
| 322 |
sc(4) = d_j(1)*d(1) + d_j(2)*d(2) + d_j(3)*d(3) |
| 323 |
sc(5) = qir(1)*d(1) + qir(2)*d(2) + qir(3)*d(3) |
| 324 |
sc(6) = qjr(1)*d(1) + qjr(2)*d(2) + qjr(3)*d(3) |
| 325 |
sc(7) = qir(1)*d_j(1) + qir(2)*d_j(2) + qir(3)*d_j(3) |
| 326 |
sc(8) = qjr(1)*d_i(1) + qjr(2)*d_i(2) + qjr(3)*d_i(3) |
| 327 |
sc(9) = qir(1)*qjr(1) + qir(2)*qjr(2) + qir(3)*qjr(3) |
| 328 |
sc(10) = qpole_i(1)*qpole_j(1) + qpole_i(2)*qpole_j(2) + & |
| 329 |
qpole_i(3)*qpole_j(3) + qpole_i(4)*qpole_j(4) + & |
| 330 |
qpole_i(5)*qpole_j(5) + qpole_i(6)*qpole_j(6) + & |
| 331 |
qpole_i(7)*qpole_j(7) + qpole_i(8)*qpole_j(8) + & |
| 332 |
qpole_i(9)*qpole_j(9) |
| 333 |
|
| 334 |
! |
| 335 |
! CALCULATE GL FUNCTIONS FOR POTENTIAL |
| 336 |
! |
| 337 |
|
| 338 |
gl(1) = q_i*q_j |
| 339 |
gl(2) = q_j*sc(3) - q_i*sc(4) |
| 340 |
gl(3) = q_i*sc(6) + q_j*sc(5) - sc(3)*sc(4) |
| 341 |
gl(4) = sc(3)*sc(6) - sc(4)*sc(5) |
| 342 |
gl(5) = sc(5)*sc(6) |
| 343 |
gl(7) = sc(2) - q_j*qii - q_i*sc(1) |
| 344 |
gl(8) = sc(4)*qii - sc(1)*sc(3) + 2.0*(sc(7) - sc(8)) |
| 345 |
gl(9) = 2.0*sc(10) + sc(1)*qii |
| 346 |
gl(6) = -(sc(1)*sc(5) + sc(6)*qii + 4.0*sc(9)) |
| 347 |
|
| 348 |
! |
| 349 |
! CALCULATE POTENTIAL AND VIRIAL |
| 350 |
! |
| 351 |
|
| 352 |
epot = bn(1)*gl(1) + bn(2)*(gl(2) + gl(7)) + bn(3)*(gl(3) & |
| 353 |
+ gl(8) + gl(9)) + bn(4)*(gl(4) + gl(6)) + bn(5)*gl(5) |
| 354 |
|
| 355 |
vpair = vpair + epot |
| 356 |
|
| 357 |
#ifdef IS_MPI |
| 358 |
pot_row(ELECTROSTATIC_POT,atom1) = pot_row(ELECTROSTATIC_POT,atom1) + & |
| 359 |
0.5_dp*epot*sw |
| 360 |
pot_col(ELECTROSTATIC_POT,atom2) = pot_col(ELECTROSTATIC_POT,atom2) + & |
| 361 |
0.5_dp*epot*sw |
| 362 |
#else |
| 363 |
pot = pot + epot*sw |
| 364 |
#endif |
| 365 |
|
| 366 |
! |
| 367 |
! CALCULATE FORCE AND TORQUE COEFFICIENTS |
| 368 |
! |
| 369 |
|
| 370 |
gl(1) = bn(2)*gl(1) + bn(3)*(gl(2) + gl(7)) + bn(4)*(gl(3) & |
| 371 |
+ gl(8) + gl(9)) + bn(5)*(gl(4) + gl(6)) + bn(6)*gl(5) |
| 372 |
gl(2) = -q_j*bn(2) + (sc(4) + sc(1))*bn(3) - sc(6)*bn(4) |
| 373 |
gl(3) = q_i*bn(2) + (sc(3) - qii)*bn(3) + sc(5)*bn(4) |
| 374 |
gl(4) = 2.0*bn(3) |
| 375 |
gl(5) = 2.0*( - q_j*bn(3) + (sc(1) + sc(4))*bn(4) - sc(6)* bn(5)) |
| 376 |
gl(6) = 2.0*( - q_i*bn(3) + (qii - sc(3))*bn(4) - sc(5)*bn(5)) |
| 377 |
gl(7) = 4.0*bn(4) |
| 378 |
|
| 379 |
! |
| 380 |
! CALCULATE FORCES BETWEEN MULTIPOLES I AND J |
| 381 |
! |
| 382 |
|
| 383 |
ftm(1) = gl(1)*d(1) + gl(2)*d_i(1) + gl(3)*d_j(1) + & |
| 384 |
gl(4)*(qjdi(1) - qidj(1)) + gl(5)*qir(1) + & |
| 385 |
gl(6)*qjr(1) + gl(7)*(qiqjr(1) + qjqir(1)) |
| 386 |
ftm(2) = gl(1)*d(2) + gl(2)*d_i(2) + gl(3)*d_j(2) + & |
| 387 |
gl(4)*(qjdi(2) - qidj(2)) + gl(5)*qir(2) + & |
| 388 |
gl(6)*qjr(2) + gl(7)*(qiqjr(2) + qjqir(2)) |
| 389 |
ftm(3) = gl(1)*d(3) + gl(2)*d_i(3) + gl(3)*d_j(3) + & |
| 390 |
gl(4)*(qjdi(3) - qidj(3)) + gl(5)*qir(3) + & |
| 391 |
gl(6)*qjr(3) + gl(7)*(qiqjr(3) + qjqir(3)) |
| 392 |
|
| 393 |
! |
| 394 |
! CALCULATE TORQUES BETWEEN MULTIPOLES I AND J |
| 395 |
! |
| 396 |
|
| 397 |
ttm_i(1) = - bn(2)*dixdj(1) + gl(2)*dixr(1) + gl(4)* & |
| 398 |
(dixqjr(1) + djxqir(1) + rxqidj(1) - 2.0*qixqj(1)) - & |
| 399 |
gl(5)*rxqir(1) - gl(7)*(rxqijr(1) + qjrxqir(1)) |
| 400 |
ttm_i(2) = - bn(2)*dixdj(2) + gl(2)*dixr(2) + gl(4)* & |
| 401 |
(dixqjr(2) + djxqir(2) + rxqidj(2) - 2.0*qixqj(2)) - & |
| 402 |
gl(5)*rxqir(2) - gl(7)*(rxqijr(2) + qjrxqir(2)) |
| 403 |
ttm_i(3) = - bn(2)*dixdj(3) + gl(2)*dixr(3) + gl(4)* & |
| 404 |
(dixqjr(3) + djxqir(3) + rxqidj(3) - 2.0*qixqj(3)) - & |
| 405 |
gl(5)*rxqir(3) - gl(7)*(rxqijr(3) + qjrxqir(3)) |
| 406 |
ttm_j(1) = bn(2)*dixdj(1) + gl(3)*djxr(1) - gl(4)* & |
| 407 |
(dixqjr(1) + djxqir(1) + rxqjdi(1) - 2.0*qixqj(1)) - & |
| 408 |
gl(6)*rxqjr(1) - gl(7)*(rxqjir(1) - qjrxqir(1)) |
| 409 |
ttm_j(2) = bn(2)*dixdj(2) + gl(3)*djxr(2) - gl(4)* & |
| 410 |
(dixqjr(2) + djxqir(2) + rxqjdi(2) - 2.0*qixqj(2)) - & |
| 411 |
gl(6)*rxqjr(2) - gl(7)*(rxqjir(2) - qjrxqir(2)) |
| 412 |
ttm_j(3) = bn(2)*dixdj(3) + gl(3)*djxr(3) - gl(4)* & |
| 413 |
(dixqjr(3) + djxqir(3) + rxqjdi(3) - 2.0*qixqj(3)) - & |
| 414 |
gl(6)*rxqjr(3) - gl(7)*(rxqjir(3) - qjrxqir(3)) |
| 415 |
|
| 416 |
ftm = ftm*sw |
| 417 |
ttm_i = ttm_i*sw |
| 418 |
ttm_j = ttm_j*sw |
| 419 |
|
| 420 |
#ifdef IS_MPI |
| 421 |
f_Row(1,atom1) = f_Row(1,atom1) + ftm(1) |
| 422 |
f_Row(2,atom1) = f_Row(2,atom1) + ftm(2) |
| 423 |
f_Row(3,atom1) = f_Row(3,atom1) + ftm(3) |
| 424 |
|
| 425 |
f_Col(1,atom2) = f_Col(1,atom2) - ftm(1) |
| 426 |
f_Col(2,atom2) = f_Col(2,atom2) - ftm(2) |
| 427 |
f_Col(3,atom2) = f_Col(3,atom2) - ftm(3) |
| 428 |
|
| 429 |
t_Row(1,atom1) = t_Row(1,atom1) + ttm_i(1) |
| 430 |
t_Row(2,atom1) = t_Row(2,atom1) + ttm_i(2) |
| 431 |
t_Row(3,atom1) = t_Row(3,atom1) + ttm_i(3) |
| 432 |
|
| 433 |
t_Col(1,atom2) = t_Col(1,atom2) + ttm_j(1) |
| 434 |
t_Col(2,atom2) = t_Col(2,atom2) + ttm_j(2) |
| 435 |
t_Col(3,atom2) = t_Col(3,atom2) + ttm_j(3) |
| 436 |
#else |
| 437 |
f(1,atom1) = f(1,atom1) + ftm(1) |
| 438 |
f(2,atom1) = f(2,atom1) + ftm(2) |
| 439 |
f(3,atom1) = f(3,atom1) + ftm(3) |
| 440 |
|
| 441 |
f(1,atom2) = f(1,atom2) - ftm(1) |
| 442 |
f(2,atom2) = f(2,atom2) - ftm(2) |
| 443 |
f(3,atom2) = f(3,atom2) - ftm(3) |
| 444 |
|
| 445 |
t(1,atom1) = t(1,atom1) + ttm_i(1) |
| 446 |
t(2,atom1) = t(2,atom1) + ttm_i(2) |
| 447 |
t(3,atom1) = t(3,atom1) + ttm_i(3) |
| 448 |
|
| 449 |
t(1,atom2) = t(1,atom2) + ttm_j(1) |
| 450 |
t(2,atom2) = t(2,atom2) + ttm_j(2) |
| 451 |
t(3,atom2) = t(3,atom2) + ttm_j(3) |
| 452 |
#endif |
| 453 |
|
| 454 |
#ifdef IS_MPI |
| 455 |
id1 = AtomRowToGlobal(atom1) |
| 456 |
id2 = AtomColToGlobal(atom2) |
| 457 |
#else |
| 458 |
id1 = atom1 |
| 459 |
id2 = atom2 |
| 460 |
#endif |
| 461 |
|
| 462 |
if (molMembershipList(id1) .ne. molMembershipList(id2)) then |
| 463 |
|
| 464 |
f1(1) = f1(1) + ftm(1) |
| 465 |
f1(2) = f1(2) + ftm(2) |
| 466 |
f1(3) = f1(3) + ftm(3) |
| 467 |
|
| 468 |
endif |
| 469 |
|
| 470 |
return |
| 471 |
|
| 472 |
end subroutine domultipolepair |
