ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-2.0/src/UseTheForce/DarkSide/electrostatic.F90
Revision: 2416
Committed: Thu Nov 3 23:22:51 2005 UTC (18 years, 7 months ago) by chrisfen
File size: 58558 byte(s)
Log Message:
removed a poorly commented section

File Contents

# Content
1 !!
2 !! Copyright (c) 2005 The University of Notre Dame. All Rights Reserved.
3 !!
4 !! The University of Notre Dame grants you ("Licensee") a
5 !! non-exclusive, royalty free, license to use, modify and
6 !! redistribute this software in source and binary code form, provided
7 !! that the following conditions are met:
8 !!
9 !! 1. Acknowledgement of the program authors must be made in any
10 !! publication of scientific results based in part on use of the
11 !! program. An acceptable form of acknowledgement is citation of
12 !! the article in which the program was described (Matthew
13 !! A. Meineke, Charles F. Vardeman II, Teng Lin, Christopher
14 !! J. Fennell and J. Daniel Gezelter, "OOPSE: An Object-Oriented
15 !! Parallel Simulation Engine for Molecular Dynamics,"
16 !! J. Comput. Chem. 26, pp. 252-271 (2005))
17 !!
18 !! 2. Redistributions of source code must retain the above copyright
19 !! notice, this list of conditions and the following disclaimer.
20 !!
21 !! 3. Redistributions in binary form must reproduce the above copyright
22 !! notice, this list of conditions and the following disclaimer in the
23 !! documentation and/or other materials provided with the
24 !! distribution.
25 !!
26 !! This software is provided "AS IS," without a warranty of any
27 !! kind. All express or implied conditions, representations and
28 !! warranties, including any implied warranty of merchantability,
29 !! fitness for a particular purpose or non-infringement, are hereby
30 !! excluded. The University of Notre Dame and its licensors shall not
31 !! be liable for any damages suffered by licensee as a result of
32 !! using, modifying or distributing the software or its
33 !! derivatives. In no event will the University of Notre Dame or its
34 !! licensors be liable for any lost revenue, profit or data, or for
35 !! direct, indirect, special, consequential, incidental or punitive
36 !! damages, however caused and regardless of the theory of liability,
37 !! arising out of the use of or inability to use software, even if the
38 !! University of Notre Dame has been advised of the possibility of
39 !! such damages.
40 !!
41
42 module electrostatic_module
43
44 use force_globals
45 use definitions
46 use atype_module
47 use vector_class
48 use simulation
49 use status
50 #ifdef IS_MPI
51 use mpiSimulation
52 #endif
53 implicit none
54
55 PRIVATE
56
57
58 #define __FORTRAN90
59 #include "UseTheForce/DarkSide/fInteractionMap.h"
60 #include "UseTheForce/DarkSide/fElectrostaticSummationMethod.h"
61 #include "UseTheForce/DarkSide/fElectrostaticScreeningMethod.h"
62
63
64 !! these prefactors convert the multipole interactions into kcal / mol
65 !! all were computed assuming distances are measured in angstroms
66 !! Charge-Charge, assuming charges are measured in electrons
67 real(kind=dp), parameter :: pre11 = 332.0637778_dp
68 !! Charge-Dipole, assuming charges are measured in electrons, and
69 !! dipoles are measured in debyes
70 real(kind=dp), parameter :: pre12 = 69.13373_dp
71 !! Dipole-Dipole, assuming dipoles are measured in debyes
72 real(kind=dp), parameter :: pre22 = 14.39325_dp
73 !! Charge-Quadrupole, assuming charges are measured in electrons, and
74 !! quadrupoles are measured in 10^-26 esu cm^2
75 !! This unit is also known affectionately as an esu centi-barn.
76 real(kind=dp), parameter :: pre14 = 69.13373_dp
77
78 !! variables to handle different summation methods for long-range
79 !! electrostatics:
80 integer, save :: summationMethod = NONE
81 integer, save :: screeningMethod = UNDAMPED
82 logical, save :: summationMethodChecked = .false.
83 real(kind=DP), save :: defaultCutoff = 0.0_DP
84 real(kind=DP), save :: defaultCutoff2 = 0.0_DP
85 logical, save :: haveDefaultCutoff = .false.
86 real(kind=DP), save :: dampingAlpha = 0.0_DP
87 real(kind=DP), save :: alpha2 = 0.0_DP
88 logical, save :: haveDampingAlpha = .false.
89 real(kind=DP), save :: dielectric = 1.0_DP
90 logical, save :: haveDielectric = .false.
91 real(kind=DP), save :: constEXP = 0.0_DP
92 real(kind=dp), save :: rcuti = 0.0_DP
93 real(kind=dp), save :: rcuti2 = 0.0_DP
94 real(kind=dp), save :: rcuti3 = 0.0_DP
95 real(kind=dp), save :: rcuti4 = 0.0_DP
96 real(kind=dp), save :: alphaPi = 0.0_DP
97 real(kind=dp), save :: invRootPi = 0.0_DP
98 real(kind=dp), save :: rrf = 1.0_DP
99 real(kind=dp), save :: rt = 1.0_DP
100 real(kind=dp), save :: rrfsq = 1.0_DP
101 real(kind=dp), save :: preRF = 0.0_DP
102 real(kind=dp), save :: preRF2 = 0.0_DP
103 real(kind=dp), save :: f0 = 1.0_DP
104 real(kind=dp), save :: f1 = 1.0_DP
105 real(kind=dp), save :: f2 = 0.0_DP
106 real(kind=dp), save :: f0c = 1.0_DP
107 real(kind=dp), save :: f1c = 1.0_DP
108 real(kind=dp), save :: f2c = 0.0_DP
109
110 #ifdef __IFC
111 ! error function for ifc version > 7.
112 double precision, external :: derfc
113 #endif
114
115 public :: setElectrostaticSummationMethod
116 public :: setScreeningMethod
117 public :: setElectrostaticCutoffRadius
118 public :: setDampingAlpha
119 public :: setReactionFieldDielectric
120 public :: newElectrostaticType
121 public :: setCharge
122 public :: setDipoleMoment
123 public :: setSplitDipoleDistance
124 public :: setQuadrupoleMoments
125 public :: doElectrostaticPair
126 public :: getCharge
127 public :: getDipoleMoment
128 public :: destroyElectrostaticTypes
129 public :: self_self
130 public :: rf_self_excludes
131
132 type :: Electrostatic
133 integer :: c_ident
134 logical :: is_Charge = .false.
135 logical :: is_Dipole = .false.
136 logical :: is_SplitDipole = .false.
137 logical :: is_Quadrupole = .false.
138 logical :: is_Tap = .false.
139 real(kind=DP) :: charge = 0.0_DP
140 real(kind=DP) :: dipole_moment = 0.0_DP
141 real(kind=DP) :: split_dipole_distance = 0.0_DP
142 real(kind=DP), dimension(3) :: quadrupole_moments = 0.0_DP
143 end type Electrostatic
144
145 type(Electrostatic), dimension(:), allocatable :: ElectrostaticMap
146
147 contains
148
149 subroutine setElectrostaticSummationMethod(the_ESM)
150 integer, intent(in) :: the_ESM
151
152 if ((the_ESM .le. 0) .or. (the_ESM .gt. REACTION_FIELD)) then
153 call handleError("setElectrostaticSummationMethod", "Unsupported Summation Method")
154 endif
155
156 summationMethod = the_ESM
157
158 end subroutine setElectrostaticSummationMethod
159
160 subroutine setScreeningMethod(the_SM)
161 integer, intent(in) :: the_SM
162 screeningMethod = the_SM
163 end subroutine setScreeningMethod
164
165 subroutine setElectrostaticCutoffRadius(thisRcut, thisRsw)
166 real(kind=dp), intent(in) :: thisRcut
167 real(kind=dp), intent(in) :: thisRsw
168 defaultCutoff = thisRcut
169 rrf = defaultCutoff
170 rt = thisRsw
171 haveDefaultCutoff = .true.
172 end subroutine setElectrostaticCutoffRadius
173
174 subroutine setDampingAlpha(thisAlpha)
175 real(kind=dp), intent(in) :: thisAlpha
176 dampingAlpha = thisAlpha
177 alpha2 = dampingAlpha*dampingAlpha
178 haveDampingAlpha = .true.
179 end subroutine setDampingAlpha
180
181 subroutine setReactionFieldDielectric(thisDielectric)
182 real(kind=dp), intent(in) :: thisDielectric
183 dielectric = thisDielectric
184 haveDielectric = .true.
185 end subroutine setReactionFieldDielectric
186
187 subroutine newElectrostaticType(c_ident, is_Charge, is_Dipole, &
188 is_SplitDipole, is_Quadrupole, is_Tap, status)
189
190 integer, intent(in) :: c_ident
191 logical, intent(in) :: is_Charge
192 logical, intent(in) :: is_Dipole
193 logical, intent(in) :: is_SplitDipole
194 logical, intent(in) :: is_Quadrupole
195 logical, intent(in) :: is_Tap
196 integer, intent(out) :: status
197 integer :: nAtypes, myATID, i, j
198
199 status = 0
200 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
201
202 !! Be simple-minded and assume that we need an ElectrostaticMap that
203 !! is the same size as the total number of atom types
204
205 if (.not.allocated(ElectrostaticMap)) then
206
207 nAtypes = getSize(atypes)
208
209 if (nAtypes == 0) then
210 status = -1
211 return
212 end if
213
214 if (.not. allocated(ElectrostaticMap)) then
215 allocate(ElectrostaticMap(nAtypes))
216 endif
217
218 end if
219
220 if (myATID .gt. size(ElectrostaticMap)) then
221 status = -1
222 return
223 endif
224
225 ! set the values for ElectrostaticMap for this atom type:
226
227 ElectrostaticMap(myATID)%c_ident = c_ident
228 ElectrostaticMap(myATID)%is_Charge = is_Charge
229 ElectrostaticMap(myATID)%is_Dipole = is_Dipole
230 ElectrostaticMap(myATID)%is_SplitDipole = is_SplitDipole
231 ElectrostaticMap(myATID)%is_Quadrupole = is_Quadrupole
232 ElectrostaticMap(myATID)%is_Tap = is_Tap
233
234 end subroutine newElectrostaticType
235
236 subroutine setCharge(c_ident, charge, status)
237 integer, intent(in) :: c_ident
238 real(kind=dp), intent(in) :: charge
239 integer, intent(out) :: status
240 integer :: myATID
241
242 status = 0
243 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
244
245 if (.not.allocated(ElectrostaticMap)) then
246 call handleError("electrostatic", "no ElectrostaticMap was present before first call of setCharge!")
247 status = -1
248 return
249 end if
250
251 if (myATID .gt. size(ElectrostaticMap)) then
252 call handleError("electrostatic", "ElectrostaticMap was found to be too small during setCharge!")
253 status = -1
254 return
255 endif
256
257 if (.not.ElectrostaticMap(myATID)%is_Charge) then
258 call handleError("electrostatic", "Attempt to setCharge of an atom type that is not a charge!")
259 status = -1
260 return
261 endif
262
263 ElectrostaticMap(myATID)%charge = charge
264 end subroutine setCharge
265
266 subroutine setDipoleMoment(c_ident, dipole_moment, status)
267 integer, intent(in) :: c_ident
268 real(kind=dp), intent(in) :: dipole_moment
269 integer, intent(out) :: status
270 integer :: myATID
271
272 status = 0
273 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
274
275 if (.not.allocated(ElectrostaticMap)) then
276 call handleError("electrostatic", "no ElectrostaticMap was present before first call of setDipoleMoment!")
277 status = -1
278 return
279 end if
280
281 if (myATID .gt. size(ElectrostaticMap)) then
282 call handleError("electrostatic", "ElectrostaticMap was found to be too small during setDipoleMoment!")
283 status = -1
284 return
285 endif
286
287 if (.not.ElectrostaticMap(myATID)%is_Dipole) then
288 call handleError("electrostatic", "Attempt to setDipoleMoment of an atom type that is not a dipole!")
289 status = -1
290 return
291 endif
292
293 ElectrostaticMap(myATID)%dipole_moment = dipole_moment
294 end subroutine setDipoleMoment
295
296 subroutine setSplitDipoleDistance(c_ident, split_dipole_distance, status)
297 integer, intent(in) :: c_ident
298 real(kind=dp), intent(in) :: split_dipole_distance
299 integer, intent(out) :: status
300 integer :: myATID
301
302 status = 0
303 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
304
305 if (.not.allocated(ElectrostaticMap)) then
306 call handleError("electrostatic", "no ElectrostaticMap was present before first call of setSplitDipoleDistance!")
307 status = -1
308 return
309 end if
310
311 if (myATID .gt. size(ElectrostaticMap)) then
312 call handleError("electrostatic", "ElectrostaticMap was found to be too small during setSplitDipoleDistance!")
313 status = -1
314 return
315 endif
316
317 if (.not.ElectrostaticMap(myATID)%is_SplitDipole) then
318 call handleError("electrostatic", "Attempt to setSplitDipoleDistance of an atom type that is not a splitDipole!")
319 status = -1
320 return
321 endif
322
323 ElectrostaticMap(myATID)%split_dipole_distance = split_dipole_distance
324 end subroutine setSplitDipoleDistance
325
326 subroutine setQuadrupoleMoments(c_ident, quadrupole_moments, status)
327 integer, intent(in) :: c_ident
328 real(kind=dp), intent(in), dimension(3) :: quadrupole_moments
329 integer, intent(out) :: status
330 integer :: myATID, i, j
331
332 status = 0
333 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
334
335 if (.not.allocated(ElectrostaticMap)) then
336 call handleError("electrostatic", "no ElectrostaticMap was present before first call of setQuadrupoleMoments!")
337 status = -1
338 return
339 end if
340
341 if (myATID .gt. size(ElectrostaticMap)) then
342 call handleError("electrostatic", "ElectrostaticMap was found to be too small during setQuadrupoleMoments!")
343 status = -1
344 return
345 endif
346
347 if (.not.ElectrostaticMap(myATID)%is_Quadrupole) then
348 call handleError("electrostatic", "Attempt to setQuadrupoleMoments of an atom type that is not a quadrupole!")
349 status = -1
350 return
351 endif
352
353 do i = 1, 3
354 ElectrostaticMap(myATID)%quadrupole_moments(i) = &
355 quadrupole_moments(i)
356 enddo
357
358 end subroutine setQuadrupoleMoments
359
360
361 function getCharge(atid) result (c)
362 integer, intent(in) :: atid
363 integer :: localError
364 real(kind=dp) :: c
365
366 if (.not.allocated(ElectrostaticMap)) then
367 call handleError("electrostatic", "no ElectrostaticMap was present before first call of getCharge!")
368 return
369 end if
370
371 if (.not.ElectrostaticMap(atid)%is_Charge) then
372 call handleError("electrostatic", "getCharge was called for an atom type that isn't a charge!")
373 return
374 endif
375
376 c = ElectrostaticMap(atid)%charge
377 end function getCharge
378
379 function getDipoleMoment(atid) result (dm)
380 integer, intent(in) :: atid
381 integer :: localError
382 real(kind=dp) :: dm
383
384 if (.not.allocated(ElectrostaticMap)) then
385 call handleError("electrostatic", "no ElectrostaticMap was present before first call of getDipoleMoment!")
386 return
387 end if
388
389 if (.not.ElectrostaticMap(atid)%is_Dipole) then
390 call handleError("electrostatic", "getDipoleMoment was called for an atom type that isn't a dipole!")
391 return
392 endif
393
394 dm = ElectrostaticMap(atid)%dipole_moment
395 end function getDipoleMoment
396
397 subroutine checkSummationMethod()
398
399 if (.not.haveDefaultCutoff) then
400 call handleError("checkSummationMethod", "no Default Cutoff set!")
401 endif
402
403 rcuti = 1.0d0 / defaultCutoff
404 rcuti2 = rcuti*rcuti
405 rcuti3 = rcuti2*rcuti
406 rcuti4 = rcuti2*rcuti2
407
408 if (screeningMethod .eq. DAMPED) then
409 if (.not.haveDampingAlpha) then
410 call handleError("checkSummationMethod", "no Damping Alpha set!")
411 endif
412
413 if (.not.haveDefaultCutoff) then
414 call handleError("checkSummationMethod", "no Default Cutoff set!")
415 endif
416
417 constEXP = exp(-alpha2*defaultCutoff*defaultCutoff)
418 invRootPi = 0.56418958354775628695d0
419 alphaPi = 2.0d0*dampingAlpha*invRootPi
420 f0c = derfc(dampingAlpha*defaultCutoff)
421 f1c = alphaPi*defaultCutoff*constEXP + f0c
422 f2c = alphaPi*2.0d0*alpha2*constEXP*rcuti2
423
424 endif
425
426 if (summationMethod .eq. REACTION_FIELD) then
427 if (haveDielectric) then
428 defaultCutoff2 = defaultCutoff*defaultCutoff
429 preRF = (dielectric-1.0d0) / &
430 ((2.0d0*dielectric+1.0d0)*defaultCutoff2*defaultCutoff)
431 preRF2 = 2.0d0*preRF
432 else
433 call handleError("checkSummationMethod", "Dielectric not set")
434 endif
435
436 endif
437
438 summationMethodChecked = .true.
439 end subroutine checkSummationMethod
440
441
442 subroutine doElectrostaticPair(atom1, atom2, d, rij, r2, sw, &
443 vpair, fpair, pot, eFrame, f, t, do_pot)
444
445 logical, intent(in) :: do_pot
446
447 integer, intent(in) :: atom1, atom2
448 integer :: localError
449
450 real(kind=dp), intent(in) :: rij, r2, sw
451 real(kind=dp), intent(in), dimension(3) :: d
452 real(kind=dp), intent(inout) :: vpair
453 real(kind=dp), intent(inout), dimension(3) :: fpair
454
455 real( kind = dp ) :: pot
456 real( kind = dp ), dimension(9,nLocal) :: eFrame
457 real( kind = dp ), dimension(3,nLocal) :: f
458 real( kind = dp ), dimension(3,nLocal) :: felec
459 real( kind = dp ), dimension(3,nLocal) :: t
460
461 real (kind = dp), dimension(3) :: ux_i, uy_i, uz_i
462 real (kind = dp), dimension(3) :: ux_j, uy_j, uz_j
463 real (kind = dp), dimension(3) :: dudux_i, duduy_i, duduz_i
464 real (kind = dp), dimension(3) :: dudux_j, duduy_j, duduz_j
465
466 logical :: i_is_Charge, i_is_Dipole, i_is_SplitDipole, i_is_Quadrupole
467 logical :: j_is_Charge, j_is_Dipole, j_is_SplitDipole, j_is_Quadrupole
468 logical :: i_is_Tap, j_is_Tap
469 integer :: me1, me2, id1, id2
470 real (kind=dp) :: q_i, q_j, mu_i, mu_j, d_i, d_j
471 real (kind=dp) :: qxx_i, qyy_i, qzz_i
472 real (kind=dp) :: qxx_j, qyy_j, qzz_j
473 real (kind=dp) :: cx_i, cy_i, cz_i
474 real (kind=dp) :: cx_j, cy_j, cz_j
475 real (kind=dp) :: cx2, cy2, cz2
476 real (kind=dp) :: ct_i, ct_j, ct_ij, a1
477 real (kind=dp) :: riji, ri, ri2, ri3, ri4
478 real (kind=dp) :: pref, vterm, epot, dudr, vterm1, vterm2
479 real (kind=dp) :: xhat, yhat, zhat
480 real (kind=dp) :: dudx, dudy, dudz
481 real (kind=dp) :: scale, sc2, bigR
482 real (kind=dp) :: varEXP
483 real (kind=dp) :: limScale
484 real (kind=dp) :: preVal, rfVal
485
486 if (.not.allocated(ElectrostaticMap)) then
487 call handleError("electrostatic", "no ElectrostaticMap was present before first call of do_electrostatic_pair!")
488 return
489 end if
490
491 if (.not.summationMethodChecked) then
492 call checkSummationMethod()
493 endif
494
495 #ifdef IS_MPI
496 me1 = atid_Row(atom1)
497 me2 = atid_Col(atom2)
498 #else
499 me1 = atid(atom1)
500 me2 = atid(atom2)
501 #endif
502
503 !!$ if (rij .ge. defaultCutoff) then
504 !!$ write(*,*) 'warning: rij = ', rij, ' rcut = ', defaultCutoff, ' sw = ', sw
505 !!$ endif
506
507 !! some variables we'll need independent of electrostatic type:
508
509 riji = 1.0d0 / rij
510
511 xhat = d(1) * riji
512 yhat = d(2) * riji
513 zhat = d(3) * riji
514
515 !! logicals
516 i_is_Charge = ElectrostaticMap(me1)%is_Charge
517 i_is_Dipole = ElectrostaticMap(me1)%is_Dipole
518 i_is_SplitDipole = ElectrostaticMap(me1)%is_SplitDipole
519 i_is_Quadrupole = ElectrostaticMap(me1)%is_Quadrupole
520 i_is_Tap = ElectrostaticMap(me1)%is_Tap
521
522 j_is_Charge = ElectrostaticMap(me2)%is_Charge
523 j_is_Dipole = ElectrostaticMap(me2)%is_Dipole
524 j_is_SplitDipole = ElectrostaticMap(me2)%is_SplitDipole
525 j_is_Quadrupole = ElectrostaticMap(me2)%is_Quadrupole
526 j_is_Tap = ElectrostaticMap(me2)%is_Tap
527
528 if (i_is_Charge) then
529 q_i = ElectrostaticMap(me1)%charge
530 endif
531
532 if (i_is_Dipole) then
533 mu_i = ElectrostaticMap(me1)%dipole_moment
534 #ifdef IS_MPI
535 uz_i(1) = eFrame_Row(3,atom1)
536 uz_i(2) = eFrame_Row(6,atom1)
537 uz_i(3) = eFrame_Row(9,atom1)
538 #else
539 uz_i(1) = eFrame(3,atom1)
540 uz_i(2) = eFrame(6,atom1)
541 uz_i(3) = eFrame(9,atom1)
542 #endif
543 ct_i = uz_i(1)*xhat + uz_i(2)*yhat + uz_i(3)*zhat
544
545 if (i_is_SplitDipole) then
546 d_i = ElectrostaticMap(me1)%split_dipole_distance
547 endif
548
549 endif
550
551 if (i_is_Quadrupole) then
552 qxx_i = ElectrostaticMap(me1)%quadrupole_moments(1)
553 qyy_i = ElectrostaticMap(me1)%quadrupole_moments(2)
554 qzz_i = ElectrostaticMap(me1)%quadrupole_moments(3)
555 #ifdef IS_MPI
556 ux_i(1) = eFrame_Row(1,atom1)
557 ux_i(2) = eFrame_Row(4,atom1)
558 ux_i(3) = eFrame_Row(7,atom1)
559 uy_i(1) = eFrame_Row(2,atom1)
560 uy_i(2) = eFrame_Row(5,atom1)
561 uy_i(3) = eFrame_Row(8,atom1)
562 uz_i(1) = eFrame_Row(3,atom1)
563 uz_i(2) = eFrame_Row(6,atom1)
564 uz_i(3) = eFrame_Row(9,atom1)
565 #else
566 ux_i(1) = eFrame(1,atom1)
567 ux_i(2) = eFrame(4,atom1)
568 ux_i(3) = eFrame(7,atom1)
569 uy_i(1) = eFrame(2,atom1)
570 uy_i(2) = eFrame(5,atom1)
571 uy_i(3) = eFrame(8,atom1)
572 uz_i(1) = eFrame(3,atom1)
573 uz_i(2) = eFrame(6,atom1)
574 uz_i(3) = eFrame(9,atom1)
575 #endif
576 cx_i = ux_i(1)*xhat + ux_i(2)*yhat + ux_i(3)*zhat
577 cy_i = uy_i(1)*xhat + uy_i(2)*yhat + uy_i(3)*zhat
578 cz_i = uz_i(1)*xhat + uz_i(2)*yhat + uz_i(3)*zhat
579 endif
580
581 if (j_is_Charge) then
582 q_j = ElectrostaticMap(me2)%charge
583 endif
584
585 if (j_is_Dipole) then
586 mu_j = ElectrostaticMap(me2)%dipole_moment
587 #ifdef IS_MPI
588 uz_j(1) = eFrame_Col(3,atom2)
589 uz_j(2) = eFrame_Col(6,atom2)
590 uz_j(3) = eFrame_Col(9,atom2)
591 #else
592 uz_j(1) = eFrame(3,atom2)
593 uz_j(2) = eFrame(6,atom2)
594 uz_j(3) = eFrame(9,atom2)
595 #endif
596 ct_j = uz_j(1)*xhat + uz_j(2)*yhat + uz_j(3)*zhat
597
598 if (j_is_SplitDipole) then
599 d_j = ElectrostaticMap(me2)%split_dipole_distance
600 endif
601 endif
602
603 if (j_is_Quadrupole) then
604 qxx_j = ElectrostaticMap(me2)%quadrupole_moments(1)
605 qyy_j = ElectrostaticMap(me2)%quadrupole_moments(2)
606 qzz_j = ElectrostaticMap(me2)%quadrupole_moments(3)
607 #ifdef IS_MPI
608 ux_j(1) = eFrame_Col(1,atom2)
609 ux_j(2) = eFrame_Col(4,atom2)
610 ux_j(3) = eFrame_Col(7,atom2)
611 uy_j(1) = eFrame_Col(2,atom2)
612 uy_j(2) = eFrame_Col(5,atom2)
613 uy_j(3) = eFrame_Col(8,atom2)
614 uz_j(1) = eFrame_Col(3,atom2)
615 uz_j(2) = eFrame_Col(6,atom2)
616 uz_j(3) = eFrame_Col(9,atom2)
617 #else
618 ux_j(1) = eFrame(1,atom2)
619 ux_j(2) = eFrame(4,atom2)
620 ux_j(3) = eFrame(7,atom2)
621 uy_j(1) = eFrame(2,atom2)
622 uy_j(2) = eFrame(5,atom2)
623 uy_j(3) = eFrame(8,atom2)
624 uz_j(1) = eFrame(3,atom2)
625 uz_j(2) = eFrame(6,atom2)
626 uz_j(3) = eFrame(9,atom2)
627 #endif
628 cx_j = ux_j(1)*xhat + ux_j(2)*yhat + ux_j(3)*zhat
629 cy_j = uy_j(1)*xhat + uy_j(2)*yhat + uy_j(3)*zhat
630 cz_j = uz_j(1)*xhat + uz_j(2)*yhat + uz_j(3)*zhat
631 endif
632
633 epot = 0.0_dp
634 dudx = 0.0_dp
635 dudy = 0.0_dp
636 dudz = 0.0_dp
637
638 dudux_i = 0.0_dp
639 duduy_i = 0.0_dp
640 duduz_i = 0.0_dp
641
642 dudux_j = 0.0_dp
643 duduy_j = 0.0_dp
644 duduz_j = 0.0_dp
645
646 if (i_is_Charge) then
647
648 if (j_is_Charge) then
649
650 if (summationMethod .eq. SHIFTED_POTENTIAL) then
651 if (screeningMethod .eq. DAMPED) then
652 f0 = derfc(dampingAlpha*rij)
653 varEXP = exp(-alpha2*rij*rij)
654 f1 = alphaPi*rij*varEXP + f0c
655 endif
656
657 vterm = pre11 * q_i * q_j * (riji*f0 - rcuti*f0c)
658 vpair = vpair + vterm
659 epot = epot + sw*vterm
660
661 dudr = -sw*pre11*q_i*q_j * riji * riji * f1
662
663 dudx = dudx + dudr * xhat
664 dudy = dudy + dudr * yhat
665 dudz = dudz + dudr * zhat
666
667 elseif (summationMethod .eq. SHIFTED_FORCE) then
668 if (screeningMethod .eq. DAMPED) then
669 f0 = derfc(dampingAlpha*rij)
670 varEXP = exp(-alpha2*rij*rij)
671 f1 = alphaPi*rij*varEXP + f0
672 endif
673
674 vterm = pre11 * q_i * q_j * ( riji*f0 - rcuti*f0c + &
675 f1c*rcuti2*(rij-defaultCutoff) )
676
677 vpair = vpair + vterm
678 epot = epot + sw*vterm
679
680 dudr = -sw*pre11*q_i*q_j * (riji*riji*f1 - rcuti2*f1c)
681
682 dudx = dudx + dudr * xhat
683 dudy = dudy + dudr * yhat
684 dudz = dudz + dudr * zhat
685
686 elseif (summationMethod .eq. REACTION_FIELD) then
687 preVal = pre11 * q_i * q_j
688 rfVal = preRF*rij*rij
689 vterm = preVal * ( riji + rfVal )
690
691 vpair = vpair + vterm
692 epot = epot + sw*vterm
693
694 dudr = sw * preVal * ( 2.0d0*rfVal - riji )*riji
695
696 dudx = dudx + dudr * xhat
697 dudy = dudy + dudr * yhat
698 dudz = dudz + dudr * zhat
699
700 else
701 vterm = pre11 * q_i * q_j * riji
702 vpair = vpair + vterm
703 epot = epot + sw*vterm
704
705 dudr = - sw * vterm * riji
706
707 dudx = dudx + dudr * xhat
708 dudy = dudy + dudr * yhat
709 dudz = dudz + dudr * zhat
710
711 endif
712
713 endif
714
715 if (j_is_Dipole) then
716
717 pref = pre12 * q_i * mu_j
718
719 !!$ if (summationMethod .eq. UNDAMPED_WOLF) then
720 !!$ ri2 = riji * riji
721 !!$ ri3 = ri2 * riji
722 !!$
723 !!$ pref = pre12 * q_i * mu_j
724 !!$ vterm = - pref * ct_j * (ri2 - rcuti2)
725 !!$ vpair = vpair + vterm
726 !!$ epot = epot + sw*vterm
727 !!$
728 !!$ !! this has a + sign in the () because the rij vector is
729 !!$ !! r_j - r_i and the charge-dipole potential takes the origin
730 !!$ !! as the point dipole, which is atom j in this case.
731 !!$
732 !!$ dudx = dudx - sw*pref * ( ri3*( uz_j(1) - 3.0d0*ct_j*xhat) &
733 !!$ - rcuti3*( uz_j(1) - 3.0d0*ct_j*d(1)*rcuti ) )
734 !!$ dudy = dudy - sw*pref * ( ri3*( uz_j(2) - 3.0d0*ct_j*yhat) &
735 !!$ - rcuti3*( uz_j(2) - 3.0d0*ct_j*d(2)*rcuti ) )
736 !!$ dudz = dudz - sw*pref * ( ri3*( uz_j(3) - 3.0d0*ct_j*zhat) &
737 !!$ - rcuti3*( uz_j(3) - 3.0d0*ct_j*d(3)*rcuti ) )
738 !!$
739 !!$ duduz_j(1) = duduz_j(1) - sw*pref*( ri2*xhat - d(1)*rcuti3 )
740 !!$ duduz_j(2) = duduz_j(2) - sw*pref*( ri2*yhat - d(2)*rcuti3 )
741 !!$ duduz_j(3) = duduz_j(3) - sw*pref*( ri2*zhat - d(3)*rcuti3 )
742 !!$
743 !!$ elseif (summationMethod .eq. REACTION_FIELD) then
744
745 if (summationMethod .eq. REACTION_FIELD) then
746 ri2 = riji * riji
747 ri3 = ri2 * riji
748
749 pref = pre12 * q_i * mu_j
750 vterm = - pref * ct_j * ( ri2 - preRF2*rij )
751 vpair = vpair + vterm
752 epot = epot + sw*vterm
753
754 !! this has a + sign in the () because the rij vector is
755 !! r_j - r_i and the charge-dipole potential takes the origin
756 !! as the point dipole, which is atom j in this case.
757
758 dudx = dudx - sw*pref*( ri3*(uz_j(1) - 3.0d0*ct_j*xhat) - &
759 preRF2*uz_j(1) )
760 dudy = dudy - sw*pref*( ri3*(uz_j(2) - 3.0d0*ct_j*yhat) - &
761 preRF2*uz_j(2) )
762 dudz = dudz - sw*pref*( ri3*(uz_j(3) - 3.0d0*ct_j*zhat) - &
763 preRF2*uz_j(3) )
764 duduz_j(1) = duduz_j(1) - sw*pref * xhat * ( ri2 - preRF2*rij )
765 duduz_j(2) = duduz_j(2) - sw*pref * yhat * ( ri2 - preRF2*rij )
766 duduz_j(3) = duduz_j(3) - sw*pref * zhat * ( ri2 - preRF2*rij )
767
768 else
769 if (j_is_SplitDipole) then
770 BigR = sqrt(r2 + 0.25_dp * d_j * d_j)
771 ri = 1.0_dp / BigR
772 scale = rij * ri
773 else
774 ri = riji
775 scale = 1.0_dp
776 endif
777
778 ri2 = ri * ri
779 ri3 = ri2 * ri
780 sc2 = scale * scale
781
782 pref = pre12 * q_i * mu_j
783 vterm = - pref * ct_j * ri2 * scale
784 vpair = vpair + vterm
785 epot = epot + sw*vterm
786
787 !! this has a + sign in the () because the rij vector is
788 !! r_j - r_i and the charge-dipole potential takes the origin
789 !! as the point dipole, which is atom j in this case.
790
791 dudx = dudx - sw*pref * ri3 * ( uz_j(1) - 3.0d0*ct_j*xhat*sc2)
792 dudy = dudy - sw*pref * ri3 * ( uz_j(2) - 3.0d0*ct_j*yhat*sc2)
793 dudz = dudz - sw*pref * ri3 * ( uz_j(3) - 3.0d0*ct_j*zhat*sc2)
794
795 duduz_j(1) = duduz_j(1) - sw*pref * ri2 * xhat * scale
796 duduz_j(2) = duduz_j(2) - sw*pref * ri2 * yhat * scale
797 duduz_j(3) = duduz_j(3) - sw*pref * ri2 * zhat * scale
798
799 endif
800 endif
801
802 if (j_is_Quadrupole) then
803 ri2 = riji * riji
804 ri3 = ri2 * riji
805 ri4 = ri2 * ri2
806 cx2 = cx_j * cx_j
807 cy2 = cy_j * cy_j
808 cz2 = cz_j * cz_j
809
810 !!$ if (summationMethod .eq. UNDAMPED_WOLF) then
811 !!$ pref = pre14 * q_i / 3.0_dp
812 !!$ vterm1 = pref * ri3*( qxx_j * (3.0_dp*cx2 - 1.0_dp) + &
813 !!$ qyy_j * (3.0_dp*cy2 - 1.0_dp) + &
814 !!$ qzz_j * (3.0_dp*cz2 - 1.0_dp) )
815 !!$ vterm2 = pref * rcuti3*( qxx_j * (3.0_dp*cx2 - 1.0_dp) + &
816 !!$ qyy_j * (3.0_dp*cy2 - 1.0_dp) + &
817 !!$ qzz_j * (3.0_dp*cz2 - 1.0_dp) )
818 !!$ vpair = vpair + ( vterm1 - vterm2 )
819 !!$ epot = epot + sw*( vterm1 - vterm2 )
820 !!$
821 !!$ dudx = dudx - (5.0_dp * &
822 !!$ (vterm1*riji*xhat - vterm2*rcuti2*d(1))) + sw*pref * ( &
823 !!$ (ri4 - rcuti4)*(qxx_j*(6.0_dp*cx_j*ux_j(1)) - &
824 !!$ qxx_j*2.0_dp*(xhat - rcuti*d(1))) + &
825 !!$ (ri4 - rcuti4)*(qyy_j*(6.0_dp*cy_j*uy_j(1)) - &
826 !!$ qyy_j*2.0_dp*(xhat - rcuti*d(1))) + &
827 !!$ (ri4 - rcuti4)*(qzz_j*(6.0_dp*cz_j*uz_j(1)) - &
828 !!$ qzz_j*2.0_dp*(xhat - rcuti*d(1))) )
829 !!$ dudy = dudy - (5.0_dp * &
830 !!$ (vterm1*riji*yhat - vterm2*rcuti2*d(2))) + sw*pref * ( &
831 !!$ (ri4 - rcuti4)*(qxx_j*(6.0_dp*cx_j*ux_j(2)) - &
832 !!$ qxx_j*2.0_dp*(yhat - rcuti*d(2))) + &
833 !!$ (ri4 - rcuti4)*(qyy_j*(6.0_dp*cy_j*uy_j(2)) - &
834 !!$ qyy_j*2.0_dp*(yhat - rcuti*d(2))) + &
835 !!$ (ri4 - rcuti4)*(qzz_j*(6.0_dp*cz_j*uz_j(2)) - &
836 !!$ qzz_j*2.0_dp*(yhat - rcuti*d(2))) )
837 !!$ dudz = dudz - (5.0_dp * &
838 !!$ (vterm1*riji*zhat - vterm2*rcuti2*d(3))) + sw*pref * ( &
839 !!$ (ri4 - rcuti4)*(qxx_j*(6.0_dp*cx_j*ux_j(3)) - &
840 !!$ qxx_j*2.0_dp*(zhat - rcuti*d(3))) + &
841 !!$ (ri4 - rcuti4)*(qyy_j*(6.0_dp*cy_j*uy_j(3)) - &
842 !!$ qyy_j*2.0_dp*(zhat - rcuti*d(3))) + &
843 !!$ (ri4 - rcuti4)*(qzz_j*(6.0_dp*cz_j*uz_j(3)) - &
844 !!$ qzz_j*2.0_dp*(zhat - rcuti*d(3))) )
845 !!$
846 !!$ dudux_j(1) = dudux_j(1) + sw*pref*(ri3*(qxx_j*6.0_dp*cx_j*xhat) -&
847 !!$ rcuti4*(qxx_j*6.0_dp*cx_j*d(1)))
848 !!$ dudux_j(2) = dudux_j(2) + sw*pref*(ri3*(qxx_j*6.0_dp*cx_j*yhat) -&
849 !!$ rcuti4*(qxx_j*6.0_dp*cx_j*d(2)))
850 !!$ dudux_j(3) = dudux_j(3) + sw*pref*(ri3*(qxx_j*6.0_dp*cx_j*zhat) -&
851 !!$ rcuti4*(qxx_j*6.0_dp*cx_j*d(3)))
852 !!$
853 !!$ duduy_j(1) = duduy_j(1) + sw*pref*(ri3*(qyy_j*6.0_dp*cy_j*xhat) -&
854 !!$ rcuti4*(qyy_j*6.0_dp*cx_j*d(1)))
855 !!$ duduy_j(2) = duduy_j(2) + sw*pref*(ri3*(qyy_j*6.0_dp*cy_j*yhat) -&
856 !!$ rcuti4*(qyy_j*6.0_dp*cx_j*d(2)))
857 !!$ duduy_j(3) = duduy_j(3) + sw*pref*(ri3*(qyy_j*6.0_dp*cy_j*zhat) -&
858 !!$ rcuti4*(qyy_j*6.0_dp*cx_j*d(3)))
859 !!$
860 !!$ duduz_j(1) = duduz_j(1) + sw*pref*(ri3*(qzz_j*6.0_dp*cz_j*xhat) -&
861 !!$ rcuti4*(qzz_j*6.0_dp*cx_j*d(1)))
862 !!$ duduz_j(2) = duduz_j(2) + sw*pref*(ri3*(qzz_j*6.0_dp*cz_j*yhat) -&
863 !!$ rcuti4*(qzz_j*6.0_dp*cx_j*d(2)))
864 !!$ duduz_j(3) = duduz_j(3) + sw*pref*(ri3*(qzz_j*6.0_dp*cz_j*zhat) -&
865 !!$ rcuti4*(qzz_j*6.0_dp*cx_j*d(3)))
866 !!$
867 !!$ else
868 pref = pre14 * q_i / 3.0_dp
869 vterm = pref * ri3 * (qxx_j * (3.0_dp*cx2 - 1.0_dp) + &
870 qyy_j * (3.0_dp*cy2 - 1.0_dp) + &
871 qzz_j * (3.0_dp*cz2 - 1.0_dp))
872 vpair = vpair + vterm
873 epot = epot + sw*vterm
874
875 dudx = dudx - 5.0_dp*sw*vterm*riji*xhat + sw*pref * ri4 * ( &
876 qxx_j*(6.0_dp*cx_j*ux_j(1) - 2.0_dp*xhat) + &
877 qyy_j*(6.0_dp*cy_j*uy_j(1) - 2.0_dp*xhat) + &
878 qzz_j*(6.0_dp*cz_j*uz_j(1) - 2.0_dp*xhat) )
879 dudy = dudy - 5.0_dp*sw*vterm*riji*yhat + sw*pref * ri4 * ( &
880 qxx_j*(6.0_dp*cx_j*ux_j(2) - 2.0_dp*yhat) + &
881 qyy_j*(6.0_dp*cy_j*uy_j(2) - 2.0_dp*yhat) + &
882 qzz_j*(6.0_dp*cz_j*uz_j(2) - 2.0_dp*yhat) )
883 dudz = dudz - 5.0_dp*sw*vterm*riji*zhat + sw*pref * ri4 * ( &
884 qxx_j*(6.0_dp*cx_j*ux_j(3) - 2.0_dp*zhat) + &
885 qyy_j*(6.0_dp*cy_j*uy_j(3) - 2.0_dp*zhat) + &
886 qzz_j*(6.0_dp*cz_j*uz_j(3) - 2.0_dp*zhat) )
887
888 dudux_j(1) = dudux_j(1) + sw*pref * ri3*(qxx_j*6.0_dp*cx_j*xhat)
889 dudux_j(2) = dudux_j(2) + sw*pref * ri3*(qxx_j*6.0_dp*cx_j*yhat)
890 dudux_j(3) = dudux_j(3) + sw*pref * ri3*(qxx_j*6.0_dp*cx_j*zhat)
891
892 duduy_j(1) = duduy_j(1) + sw*pref * ri3*(qyy_j*6.0_dp*cy_j*xhat)
893 duduy_j(2) = duduy_j(2) + sw*pref * ri3*(qyy_j*6.0_dp*cy_j*yhat)
894 duduy_j(3) = duduy_j(3) + sw*pref * ri3*(qyy_j*6.0_dp*cy_j*zhat)
895
896 duduz_j(1) = duduz_j(1) + sw*pref * ri3*(qzz_j*6.0_dp*cz_j*xhat)
897 duduz_j(2) = duduz_j(2) + sw*pref * ri3*(qzz_j*6.0_dp*cz_j*yhat)
898 duduz_j(3) = duduz_j(3) + sw*pref * ri3*(qzz_j*6.0_dp*cz_j*zhat)
899
900 !!$ endif
901 endif
902 endif
903
904 if (i_is_Dipole) then
905
906 if (j_is_Charge) then
907
908 pref = pre12 * q_j * mu_i
909
910 !!$ if (summationMethod .eq. UNDAMPED_WOLF) then
911 !!$ ri2 = riji * riji
912 !!$ ri3 = ri2 * riji
913 !!$
914 !!$ pref = pre12 * q_j * mu_i
915 !!$ vterm = pref * ct_i * (ri2 - rcuti2)
916 !!$ vpair = vpair + vterm
917 !!$ epot = epot + sw*vterm
918 !!$
919 !!$ dudx = dudx + sw*pref * ( ri3*( uz_i(1) - 3.0d0*ct_i*xhat) &
920 !!$ - rcuti3*( uz_i(1) - 3.0d0*ct_i*d(1)*rcuti ) )
921 !!$ dudy = dudy + sw*pref * ( ri3*( uz_i(2) - 3.0d0*ct_i*yhat) &
922 !!$ - rcuti3*( uz_i(2) - 3.0d0*ct_i*d(2)*rcuti ) )
923 !!$ dudz = dudz + sw*pref * ( ri3*( uz_i(3) - 3.0d0*ct_i*zhat) &
924 !!$ - rcuti3*( uz_i(3) - 3.0d0*ct_i*d(3)*rcuti ) )
925 !!$
926 !!$ duduz_i(1) = duduz_i(1) + sw*pref*( ri2*xhat - d(1)*rcuti3 )
927 !!$ duduz_i(2) = duduz_i(2) + sw*pref*( ri2*yhat - d(2)*rcuti3 )
928 !!$ duduz_i(3) = duduz_i(3) + sw*pref*( ri2*zhat - d(3)*rcuti3 )
929 !!$
930 !!$ elseif (summationMethod .eq. REACTION_FIELD) then
931 if (summationMethod .eq. REACTION_FIELD) then
932 ri2 = riji * riji
933 ri3 = ri2 * riji
934
935 pref = pre12 * q_j * mu_i
936 vterm = pref * ct_i * ( ri2 - preRF2*rij )
937 vpair = vpair + vterm
938 epot = epot + sw*vterm
939
940 dudx = dudx + sw*pref * ( ri3*(uz_i(1) - 3.0d0*ct_i*xhat) - &
941 preRF2*uz_i(1) )
942 dudy = dudy + sw*pref * ( ri3*(uz_i(2) - 3.0d0*ct_i*yhat) - &
943 preRF2*uz_i(2) )
944 dudz = dudz + sw*pref * ( ri3*(uz_i(3) - 3.0d0*ct_i*zhat) - &
945 preRF2*uz_i(3) )
946
947 duduz_i(1) = duduz_i(1) + sw*pref * xhat * ( ri2 - preRF2*rij )
948 duduz_i(2) = duduz_i(2) + sw*pref * yhat * ( ri2 - preRF2*rij )
949 duduz_i(3) = duduz_i(3) + sw*pref * zhat * ( ri2 - preRF2*rij )
950
951 else
952 if (i_is_SplitDipole) then
953 BigR = sqrt(r2 + 0.25_dp * d_i * d_i)
954 ri = 1.0_dp / BigR
955 scale = rij * ri
956 else
957 ri = riji
958 scale = 1.0_dp
959 endif
960
961 ri2 = ri * ri
962 ri3 = ri2 * ri
963 sc2 = scale * scale
964
965 pref = pre12 * q_j * mu_i
966 vterm = pref * ct_i * ri2 * scale
967 vpair = vpair + vterm
968 epot = epot + sw*vterm
969
970 dudx = dudx + sw*pref * ri3 * ( uz_i(1) - 3.0d0 * ct_i * xhat*sc2)
971 dudy = dudy + sw*pref * ri3 * ( uz_i(2) - 3.0d0 * ct_i * yhat*sc2)
972 dudz = dudz + sw*pref * ri3 * ( uz_i(3) - 3.0d0 * ct_i * zhat*sc2)
973
974 duduz_i(1) = duduz_i(1) + sw*pref * ri2 * xhat * scale
975 duduz_i(2) = duduz_i(2) + sw*pref * ri2 * yhat * scale
976 duduz_i(3) = duduz_i(3) + sw*pref * ri2 * zhat * scale
977 endif
978 endif
979
980 if (j_is_Dipole) then
981
982 !!$ if (summationMethod .eq. UNDAMPED_WOLF) then
983 !!$ ct_ij = uz_i(1)*uz_j(1) + uz_i(2)*uz_j(2) + uz_i(3)*uz_j(3)
984 !!$
985 !!$ ri2 = riji * riji
986 !!$ ri3 = ri2 * riji
987 !!$ ri4 = ri2 * ri2
988 !!$
989 !!$ pref = pre22 * mu_i * mu_j
990 !!$ vterm = pref * (ri3 - rcuti3) * (ct_ij - 3.0d0 * ct_i * ct_j)
991 !!$ vpair = vpair + vterm
992 !!$ epot = epot + sw*vterm
993 !!$
994 !!$ a1 = 5.0d0 * ct_i * ct_j - ct_ij
995 !!$
996 !!$ dudx = dudx + sw*pref*3.0d0*( &
997 !!$ ri4*(a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1)) &
998 !!$ - rcuti4*(a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1)) )
999 !!$ dudy = dudy + sw*pref*3.0d0*( &
1000 !!$ ri4*(a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2)) &
1001 !!$ - rcuti4*(a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2)) )
1002 !!$ dudz = dudz + sw*pref*3.0d0*( &
1003 !!$ ri4*(a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3)) &
1004 !!$ - rcuti4*(a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3)) )
1005 !!$
1006 !!$ duduz_i(1) = duduz_i(1) + sw*pref*(ri3*(uz_j(1)-3.0d0*ct_j*xhat) &
1007 !!$ - rcuti3*(uz_j(1) - 3.0d0*ct_j*xhat))
1008 !!$ duduz_i(2) = duduz_i(2) + sw*pref*(ri3*(uz_j(2)-3.0d0*ct_j*yhat) &
1009 !!$ - rcuti3*(uz_j(2) - 3.0d0*ct_j*yhat))
1010 !!$ duduz_i(3) = duduz_i(3) + sw*pref*(ri3*(uz_j(3)-3.0d0*ct_j*zhat) &
1011 !!$ - rcuti3*(uz_j(3) - 3.0d0*ct_j*zhat))
1012 !!$ duduz_j(1) = duduz_j(1) + sw*pref*(ri3*(uz_i(1)-3.0d0*ct_i*xhat) &
1013 !!$ - rcuti3*(uz_i(1) - 3.0d0*ct_i*xhat))
1014 !!$ duduz_j(2) = duduz_j(2) + sw*pref*(ri3*(uz_i(2)-3.0d0*ct_i*yhat) &
1015 !!$ - rcuti3*(uz_i(2) - 3.0d0*ct_i*yhat))
1016 !!$ duduz_j(3) = duduz_j(3) + sw*pref*(ri3*(uz_i(3)-3.0d0*ct_i*zhat) &
1017 !!$ - rcuti3*(uz_i(3) - 3.0d0*ct_i*zhat))
1018 !!$
1019 !!$ elseif (summationMethod .eq. REACTION_FIELD) then
1020 if (summationMethod .eq. REACTION_FIELD) then
1021 ct_ij = uz_i(1)*uz_j(1) + uz_i(2)*uz_j(2) + uz_i(3)*uz_j(3)
1022
1023 ri2 = riji * riji
1024 ri3 = ri2 * riji
1025 ri4 = ri2 * ri2
1026
1027 pref = pre22 * mu_i * mu_j
1028
1029 vterm = pref*( ri3*(ct_ij - 3.0d0 * ct_i * ct_j) - &
1030 preRF2*ct_ij )
1031 vpair = vpair + vterm
1032 epot = epot + sw*vterm
1033
1034 a1 = 5.0d0 * ct_i * ct_j - ct_ij
1035
1036 dudx = dudx + sw*pref*3.0d0*ri4 &
1037 * (a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1))
1038 dudy = dudy + sw*pref*3.0d0*ri4 &
1039 * (a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2))
1040 dudz = dudz + sw*pref*3.0d0*ri4 &
1041 * (a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3))
1042
1043 duduz_i(1) = duduz_i(1) + sw*pref*(ri3*(uz_j(1)-3.0d0*ct_j*xhat) &
1044 - preRF2*uz_j(1))
1045 duduz_i(2) = duduz_i(2) + sw*pref*(ri3*(uz_j(2)-3.0d0*ct_j*yhat) &
1046 - preRF2*uz_j(2))
1047 duduz_i(3) = duduz_i(3) + sw*pref*(ri3*(uz_j(3)-3.0d0*ct_j*zhat) &
1048 - preRF2*uz_j(3))
1049 duduz_j(1) = duduz_j(1) + sw*pref*(ri3*(uz_i(1)-3.0d0*ct_i*xhat) &
1050 - preRF2*uz_i(1))
1051 duduz_j(2) = duduz_j(2) + sw*pref*(ri3*(uz_i(2)-3.0d0*ct_i*yhat) &
1052 - preRF2*uz_i(2))
1053 duduz_j(3) = duduz_j(3) + sw*pref*(ri3*(uz_i(3)-3.0d0*ct_i*zhat) &
1054 - preRF2*uz_i(3))
1055
1056 else
1057 if (i_is_SplitDipole) then
1058 if (j_is_SplitDipole) then
1059 BigR = sqrt(r2 + 0.25_dp * d_i * d_i + 0.25_dp * d_j * d_j)
1060 else
1061 BigR = sqrt(r2 + 0.25_dp * d_i * d_i)
1062 endif
1063 ri = 1.0_dp / BigR
1064 scale = rij * ri
1065 else
1066 if (j_is_SplitDipole) then
1067 BigR = sqrt(r2 + 0.25_dp * d_j * d_j)
1068 ri = 1.0_dp / BigR
1069 scale = rij * ri
1070 else
1071 ri = riji
1072 scale = 1.0_dp
1073 endif
1074 endif
1075
1076 ct_ij = uz_i(1)*uz_j(1) + uz_i(2)*uz_j(2) + uz_i(3)*uz_j(3)
1077
1078 ri2 = ri * ri
1079 ri3 = ri2 * ri
1080 ri4 = ri2 * ri2
1081 sc2 = scale * scale
1082
1083 pref = pre22 * mu_i * mu_j
1084 vterm = pref * ri3 * (ct_ij - 3.0d0 * ct_i * ct_j * sc2)
1085 vpair = vpair + vterm
1086 epot = epot + sw*vterm
1087
1088 a1 = 5.0d0 * ct_i * ct_j * sc2 - ct_ij
1089
1090 dudx = dudx + sw*pref*3.0d0*ri4*scale &
1091 *(a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1))
1092 dudy = dudy + sw*pref*3.0d0*ri4*scale &
1093 *(a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2))
1094 dudz = dudz + sw*pref*3.0d0*ri4*scale &
1095 *(a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3))
1096
1097 duduz_i(1) = duduz_i(1) + sw*pref*ri3 &
1098 *(uz_j(1) - 3.0d0*ct_j*xhat*sc2)
1099 duduz_i(2) = duduz_i(2) + sw*pref*ri3 &
1100 *(uz_j(2) - 3.0d0*ct_j*yhat*sc2)
1101 duduz_i(3) = duduz_i(3) + sw*pref*ri3 &
1102 *(uz_j(3) - 3.0d0*ct_j*zhat*sc2)
1103
1104 duduz_j(1) = duduz_j(1) + sw*pref*ri3 &
1105 *(uz_i(1) - 3.0d0*ct_i*xhat*sc2)
1106 duduz_j(2) = duduz_j(2) + sw*pref*ri3 &
1107 *(uz_i(2) - 3.0d0*ct_i*yhat*sc2)
1108 duduz_j(3) = duduz_j(3) + sw*pref*ri3 &
1109 *(uz_i(3) - 3.0d0*ct_i*zhat*sc2)
1110 endif
1111 endif
1112 endif
1113
1114 if (i_is_Quadrupole) then
1115 if (j_is_Charge) then
1116
1117 ri2 = riji * riji
1118 ri3 = ri2 * riji
1119 ri4 = ri2 * ri2
1120 cx2 = cx_i * cx_i
1121 cy2 = cy_i * cy_i
1122 cz2 = cz_i * cz_i
1123
1124 !!$ if (summationMethod .eq. UNDAMPED_WOLF) then
1125 !!$ pref = pre14 * q_j / 3.0_dp
1126 !!$ vterm1 = pref * ri3*( qxx_i * (3.0_dp*cx2 - 1.0_dp) + &
1127 !!$ qyy_i * (3.0_dp*cy2 - 1.0_dp) + &
1128 !!$ qzz_i * (3.0_dp*cz2 - 1.0_dp) )
1129 !!$ vterm2 = pref * rcuti3*( qxx_i * (3.0_dp*cx2 - 1.0_dp) + &
1130 !!$ qyy_i * (3.0_dp*cy2 - 1.0_dp) + &
1131 !!$ qzz_i * (3.0_dp*cz2 - 1.0_dp) )
1132 !!$ vpair = vpair + ( vterm1 - vterm2 )
1133 !!$ epot = epot + sw*( vterm1 - vterm2 )
1134 !!$
1135 !!$ dudx = dudx - sw*(5.0_dp*(vterm1*riji*xhat-vterm2*rcuti2*d(1))) +&
1136 !!$ sw*pref * ( (ri4 - rcuti4)*(qxx_i*(6.0_dp*cx_i*ux_i(1)) - &
1137 !!$ qxx_i*2.0_dp*(xhat - rcuti*d(1))) + &
1138 !!$ (ri4 - rcuti4)*(qyy_i*(6.0_dp*cy_i*uy_i(1)) - &
1139 !!$ qyy_i*2.0_dp*(xhat - rcuti*d(1))) + &
1140 !!$ (ri4 - rcuti4)*(qzz_i*(6.0_dp*cz_i*uz_i(1)) - &
1141 !!$ qzz_i*2.0_dp*(xhat - rcuti*d(1))) )
1142 !!$ dudy = dudy - sw*(5.0_dp*(vterm1*riji*yhat-vterm2*rcuti2*d(2))) +&
1143 !!$ sw*pref * ( (ri4 - rcuti4)*(qxx_i*(6.0_dp*cx_i*ux_i(2)) - &
1144 !!$ qxx_i*2.0_dp*(yhat - rcuti*d(2))) + &
1145 !!$ (ri4 - rcuti4)*(qyy_i*(6.0_dp*cy_i*uy_i(2)) - &
1146 !!$ qyy_i*2.0_dp*(yhat - rcuti*d(2))) + &
1147 !!$ (ri4 - rcuti4)*(qzz_i*(6.0_dp*cz_i*uz_i(2)) - &
1148 !!$ qzz_i*2.0_dp*(yhat - rcuti*d(2))) )
1149 !!$ dudz = dudz - sw*(5.0_dp*(vterm1*riji*zhat-vterm2*rcuti2*d(3))) +&
1150 !!$ sw*pref * ( (ri4 - rcuti4)*(qxx_i*(6.0_dp*cx_i*ux_i(3)) - &
1151 !!$ qxx_i*2.0_dp*(zhat - rcuti*d(3))) + &
1152 !!$ (ri4 - rcuti4)*(qyy_i*(6.0_dp*cy_i*uy_i(3)) - &
1153 !!$ qyy_i*2.0_dp*(zhat - rcuti*d(3))) + &
1154 !!$ (ri4 - rcuti4)*(qzz_i*(6.0_dp*cz_i*uz_i(3)) - &
1155 !!$ qzz_i*2.0_dp*(zhat - rcuti*d(3))) )
1156 !!$
1157 !!$ dudux_i(1) = dudux_i(1) + sw*pref*(ri3*(qxx_i*6.0_dp*cx_i*xhat) -&
1158 !!$ rcuti4*(qxx_i*6.0_dp*cx_i*d(1)))
1159 !!$ dudux_i(2) = dudux_i(2) + sw*pref*(ri3*(qxx_i*6.0_dp*cx_i*yhat) -&
1160 !!$ rcuti4*(qxx_i*6.0_dp*cx_i*d(2)))
1161 !!$ dudux_i(3) = dudux_i(3) + sw*pref*(ri3*(qxx_i*6.0_dp*cx_i*zhat) -&
1162 !!$ rcuti4*(qxx_i*6.0_dp*cx_i*d(3)))
1163 !!$
1164 !!$ duduy_i(1) = duduy_i(1) + sw*pref*(ri3*(qyy_i*6.0_dp*cy_i*xhat) -&
1165 !!$ rcuti4*(qyy_i*6.0_dp*cx_i*d(1)))
1166 !!$ duduy_i(2) = duduy_i(2) + sw*pref*(ri3*(qyy_i*6.0_dp*cy_i*yhat) -&
1167 !!$ rcuti4*(qyy_i*6.0_dp*cx_i*d(2)))
1168 !!$ duduy_i(3) = duduy_i(3) + sw*pref*(ri3*(qyy_i*6.0_dp*cy_i*zhat) -&
1169 !!$ rcuti4*(qyy_i*6.0_dp*cx_i*d(3)))
1170 !!$
1171 !!$ duduz_i(1) = duduz_i(1) + sw*pref*(ri3*(qzz_i*6.0_dp*cz_i*xhat) -&
1172 !!$ rcuti4*(qzz_i*6.0_dp*cx_i*d(1)))
1173 !!$ duduz_i(2) = duduz_i(2) + sw*pref*(ri3*(qzz_i*6.0_dp*cz_i*yhat) -&
1174 !!$ rcuti4*(qzz_i*6.0_dp*cx_i*d(2)))
1175 !!$ duduz_i(3) = duduz_i(3) + sw*pref*(ri3*(qzz_i*6.0_dp*cz_i*zhat) -&
1176 !!$ rcuti4*(qzz_i*6.0_dp*cx_i*d(3)))
1177 !!$
1178 !!$ else
1179 pref = pre14 * q_j / 3.0_dp
1180 vterm = pref * ri3 * (qxx_i * (3.0_dp*cx2 - 1.0_dp) + &
1181 qyy_i * (3.0_dp*cy2 - 1.0_dp) + &
1182 qzz_i * (3.0_dp*cz2 - 1.0_dp))
1183 vpair = vpair + vterm
1184 epot = epot + sw*vterm
1185
1186 dudx = dudx - 5.0_dp*sw*vterm*riji*xhat + sw*pref*ri4 * ( &
1187 qxx_i*(6.0_dp*cx_i*ux_i(1) - 2.0_dp*xhat) + &
1188 qyy_i*(6.0_dp*cy_i*uy_i(1) - 2.0_dp*xhat) + &
1189 qzz_i*(6.0_dp*cz_i*uz_i(1) - 2.0_dp*xhat) )
1190 dudy = dudy - 5.0_dp*sw*vterm*riji*yhat + sw*pref*ri4 * ( &
1191 qxx_i*(6.0_dp*cx_i*ux_i(2) - 2.0_dp*yhat) + &
1192 qyy_i*(6.0_dp*cy_i*uy_i(2) - 2.0_dp*yhat) + &
1193 qzz_i*(6.0_dp*cz_i*uz_i(2) - 2.0_dp*yhat) )
1194 dudz = dudz - 5.0_dp*sw*vterm*riji*zhat + sw*pref*ri4 * ( &
1195 qxx_i*(6.0_dp*cx_i*ux_i(3) - 2.0_dp*zhat) + &
1196 qyy_i*(6.0_dp*cy_i*uy_i(3) - 2.0_dp*zhat) + &
1197 qzz_i*(6.0_dp*cz_i*uz_i(3) - 2.0_dp*zhat) )
1198
1199 dudux_i(1) = dudux_i(1) + sw*pref*ri3*(qxx_i*6.0_dp*cx_i*xhat)
1200 dudux_i(2) = dudux_i(2) + sw*pref*ri3*(qxx_i*6.0_dp*cx_i*yhat)
1201 dudux_i(3) = dudux_i(3) + sw*pref*ri3*(qxx_i*6.0_dp*cx_i*zhat)
1202
1203 duduy_i(1) = duduy_i(1) + sw*pref*ri3*(qyy_i*6.0_dp*cy_i*xhat)
1204 duduy_i(2) = duduy_i(2) + sw*pref*ri3*(qyy_i*6.0_dp*cy_i*yhat)
1205 duduy_i(3) = duduy_i(3) + sw*pref*ri3*(qyy_i*6.0_dp*cy_i*zhat)
1206
1207 duduz_i(1) = duduz_i(1) + sw*pref*ri3*(qzz_i*6.0_dp*cz_i*xhat)
1208 duduz_i(2) = duduz_i(2) + sw*pref*ri3*(qzz_i*6.0_dp*cz_i*yhat)
1209 duduz_i(3) = duduz_i(3) + sw*pref*ri3*(qzz_i*6.0_dp*cz_i*zhat)
1210 !!$ endif
1211 endif
1212 endif
1213
1214
1215 if (do_pot) then
1216 #ifdef IS_MPI
1217 pot_row(ELECTROSTATIC_POT,atom1) = pot_row(ELECTROSTATIC_POT,atom1) + 0.5d0*epot
1218 pot_col(ELECTROSTATIC_POT,atom2) = pot_col(ELECTROSTATIC_POT,atom2) + 0.5d0*epot
1219 #else
1220 pot = pot + epot
1221 #endif
1222 endif
1223
1224 #ifdef IS_MPI
1225 f_Row(1,atom1) = f_Row(1,atom1) + dudx
1226 f_Row(2,atom1) = f_Row(2,atom1) + dudy
1227 f_Row(3,atom1) = f_Row(3,atom1) + dudz
1228
1229 f_Col(1,atom2) = f_Col(1,atom2) - dudx
1230 f_Col(2,atom2) = f_Col(2,atom2) - dudy
1231 f_Col(3,atom2) = f_Col(3,atom2) - dudz
1232
1233 if (i_is_Dipole .or. i_is_Quadrupole) then
1234 t_Row(1,atom1)=t_Row(1,atom1) - uz_i(2)*duduz_i(3) + uz_i(3)*duduz_i(2)
1235 t_Row(2,atom1)=t_Row(2,atom1) - uz_i(3)*duduz_i(1) + uz_i(1)*duduz_i(3)
1236 t_Row(3,atom1)=t_Row(3,atom1) - uz_i(1)*duduz_i(2) + uz_i(2)*duduz_i(1)
1237 endif
1238 if (i_is_Quadrupole) then
1239 t_Row(1,atom1)=t_Row(1,atom1) - ux_i(2)*dudux_i(3) + ux_i(3)*dudux_i(2)
1240 t_Row(2,atom1)=t_Row(2,atom1) - ux_i(3)*dudux_i(1) + ux_i(1)*dudux_i(3)
1241 t_Row(3,atom1)=t_Row(3,atom1) - ux_i(1)*dudux_i(2) + ux_i(2)*dudux_i(1)
1242
1243 t_Row(1,atom1)=t_Row(1,atom1) - uy_i(2)*duduy_i(3) + uy_i(3)*duduy_i(2)
1244 t_Row(2,atom1)=t_Row(2,atom1) - uy_i(3)*duduy_i(1) + uy_i(1)*duduy_i(3)
1245 t_Row(3,atom1)=t_Row(3,atom1) - uy_i(1)*duduy_i(2) + uy_i(2)*duduy_i(1)
1246 endif
1247
1248 if (j_is_Dipole .or. j_is_Quadrupole) then
1249 t_Col(1,atom2)=t_Col(1,atom2) - uz_j(2)*duduz_j(3) + uz_j(3)*duduz_j(2)
1250 t_Col(2,atom2)=t_Col(2,atom2) - uz_j(3)*duduz_j(1) + uz_j(1)*duduz_j(3)
1251 t_Col(3,atom2)=t_Col(3,atom2) - uz_j(1)*duduz_j(2) + uz_j(2)*duduz_j(1)
1252 endif
1253 if (j_is_Quadrupole) then
1254 t_Col(1,atom2)=t_Col(1,atom2) - ux_j(2)*dudux_j(3) + ux_j(3)*dudux_j(2)
1255 t_Col(2,atom2)=t_Col(2,atom2) - ux_j(3)*dudux_j(1) + ux_j(1)*dudux_j(3)
1256 t_Col(3,atom2)=t_Col(3,atom2) - ux_j(1)*dudux_j(2) + ux_j(2)*dudux_j(1)
1257
1258 t_Col(1,atom2)=t_Col(1,atom2) - uy_j(2)*duduy_j(3) + uy_j(3)*duduy_j(2)
1259 t_Col(2,atom2)=t_Col(2,atom2) - uy_j(3)*duduy_j(1) + uy_j(1)*duduy_j(3)
1260 t_Col(3,atom2)=t_Col(3,atom2) - uy_j(1)*duduy_j(2) + uy_j(2)*duduy_j(1)
1261 endif
1262
1263 #else
1264 f(1,atom1) = f(1,atom1) + dudx
1265 f(2,atom1) = f(2,atom1) + dudy
1266 f(3,atom1) = f(3,atom1) + dudz
1267
1268 f(1,atom2) = f(1,atom2) - dudx
1269 f(2,atom2) = f(2,atom2) - dudy
1270 f(3,atom2) = f(3,atom2) - dudz
1271
1272 if (i_is_Dipole .or. i_is_Quadrupole) then
1273 t(1,atom1)=t(1,atom1) - uz_i(2)*duduz_i(3) + uz_i(3)*duduz_i(2)
1274 t(2,atom1)=t(2,atom1) - uz_i(3)*duduz_i(1) + uz_i(1)*duduz_i(3)
1275 t(3,atom1)=t(3,atom1) - uz_i(1)*duduz_i(2) + uz_i(2)*duduz_i(1)
1276 endif
1277 if (i_is_Quadrupole) then
1278 t(1,atom1)=t(1,atom1) - ux_i(2)*dudux_i(3) + ux_i(3)*dudux_i(2)
1279 t(2,atom1)=t(2,atom1) - ux_i(3)*dudux_i(1) + ux_i(1)*dudux_i(3)
1280 t(3,atom1)=t(3,atom1) - ux_i(1)*dudux_i(2) + ux_i(2)*dudux_i(1)
1281
1282 t(1,atom1)=t(1,atom1) - uy_i(2)*duduy_i(3) + uy_i(3)*duduy_i(2)
1283 t(2,atom1)=t(2,atom1) - uy_i(3)*duduy_i(1) + uy_i(1)*duduy_i(3)
1284 t(3,atom1)=t(3,atom1) - uy_i(1)*duduy_i(2) + uy_i(2)*duduy_i(1)
1285 endif
1286
1287 if (j_is_Dipole .or. j_is_Quadrupole) then
1288 t(1,atom2)=t(1,atom2) - uz_j(2)*duduz_j(3) + uz_j(3)*duduz_j(2)
1289 t(2,atom2)=t(2,atom2) - uz_j(3)*duduz_j(1) + uz_j(1)*duduz_j(3)
1290 t(3,atom2)=t(3,atom2) - uz_j(1)*duduz_j(2) + uz_j(2)*duduz_j(1)
1291 endif
1292 if (j_is_Quadrupole) then
1293 t(1,atom2)=t(1,atom2) - ux_j(2)*dudux_j(3) + ux_j(3)*dudux_j(2)
1294 t(2,atom2)=t(2,atom2) - ux_j(3)*dudux_j(1) + ux_j(1)*dudux_j(3)
1295 t(3,atom2)=t(3,atom2) - ux_j(1)*dudux_j(2) + ux_j(2)*dudux_j(1)
1296
1297 t(1,atom2)=t(1,atom2) - uy_j(2)*duduy_j(3) + uy_j(3)*duduy_j(2)
1298 t(2,atom2)=t(2,atom2) - uy_j(3)*duduy_j(1) + uy_j(1)*duduy_j(3)
1299 t(3,atom2)=t(3,atom2) - uy_j(1)*duduy_j(2) + uy_j(2)*duduy_j(1)
1300 endif
1301
1302 #endif
1303
1304 #ifdef IS_MPI
1305 id1 = AtomRowToGlobal(atom1)
1306 id2 = AtomColToGlobal(atom2)
1307 #else
1308 id1 = atom1
1309 id2 = atom2
1310 #endif
1311
1312 if (molMembershipList(id1) .ne. molMembershipList(id2)) then
1313
1314 fpair(1) = fpair(1) + dudx
1315 fpair(2) = fpair(2) + dudy
1316 fpair(3) = fpair(3) + dudz
1317
1318 endif
1319
1320 return
1321 end subroutine doElectrostaticPair
1322
1323 subroutine destroyElectrostaticTypes()
1324
1325 if(allocated(ElectrostaticMap)) deallocate(ElectrostaticMap)
1326
1327 end subroutine destroyElectrostaticTypes
1328
1329 subroutine self_self(atom1, eFrame, mypot, t, do_pot)
1330 logical, intent(in) :: do_pot
1331 integer, intent(in) :: atom1
1332 integer :: atid1
1333 real(kind=dp), dimension(9,nLocal) :: eFrame
1334 real(kind=dp), dimension(3,nLocal) :: t
1335 real(kind=dp) :: mu1, c1
1336 real(kind=dp) :: preVal, epot, mypot
1337 real(kind=dp) :: eix, eiy, eiz
1338
1339 ! this is a local only array, so we use the local atom type id's:
1340 atid1 = atid(atom1)
1341
1342 if (.not.summationMethodChecked) then
1343 call checkSummationMethod()
1344 endif
1345
1346 if (summationMethod .eq. REACTION_FIELD) then
1347 if (ElectrostaticMap(atid1)%is_Dipole) then
1348 mu1 = getDipoleMoment(atid1)
1349
1350 preVal = pre22 * preRF2 * mu1*mu1
1351 mypot = mypot - 0.5d0*preVal
1352
1353 ! The self-correction term adds into the reaction field vector
1354
1355 eix = preVal * eFrame(3,atom1)
1356 eiy = preVal * eFrame(6,atom1)
1357 eiz = preVal * eFrame(9,atom1)
1358
1359 ! once again, this is self-self, so only the local arrays are needed
1360 ! even for MPI jobs:
1361
1362 t(1,atom1)=t(1,atom1) - eFrame(6,atom1)*eiz + &
1363 eFrame(9,atom1)*eiy
1364 t(2,atom1)=t(2,atom1) - eFrame(9,atom1)*eix + &
1365 eFrame(3,atom1)*eiz
1366 t(3,atom1)=t(3,atom1) - eFrame(3,atom1)*eiy + &
1367 eFrame(6,atom1)*eix
1368
1369 endif
1370
1371 elseif (summationMethod .eq. SHIFTED_FORCE) then
1372 if (ElectrostaticMap(atid1)%is_Charge) then
1373 c1 = getCharge(atid1)
1374
1375 if (screeningMethod .eq. DAMPED) then
1376 mypot = mypot - (f0c * rcuti * 0.5_dp + &
1377 dampingAlpha*invRootPi) * c1 * c1
1378
1379 else
1380 mypot = mypot - (rcuti * 0.5_dp * c1 * c1)
1381
1382 endif
1383 endif
1384 endif
1385
1386 return
1387 end subroutine self_self
1388
1389 subroutine rf_self_excludes(atom1, atom2, sw, eFrame, d, rij, vpair, myPot, &
1390 f, t, do_pot)
1391 logical, intent(in) :: do_pot
1392 integer, intent(in) :: atom1
1393 integer, intent(in) :: atom2
1394 logical :: i_is_Charge, j_is_Charge
1395 logical :: i_is_Dipole, j_is_Dipole
1396 integer :: atid1
1397 integer :: atid2
1398 real(kind=dp), intent(in) :: rij
1399 real(kind=dp), intent(in) :: sw
1400 real(kind=dp), intent(in), dimension(3) :: d
1401 real(kind=dp), intent(inout) :: vpair
1402 real(kind=dp), dimension(9,nLocal) :: eFrame
1403 real(kind=dp), dimension(3,nLocal) :: f
1404 real(kind=dp), dimension(3,nLocal) :: t
1405 real (kind = dp), dimension(3) :: duduz_i
1406 real (kind = dp), dimension(3) :: duduz_j
1407 real (kind = dp), dimension(3) :: uz_i
1408 real (kind = dp), dimension(3) :: uz_j
1409 real(kind=dp) :: q_i, q_j, mu_i, mu_j
1410 real(kind=dp) :: xhat, yhat, zhat
1411 real(kind=dp) :: ct_i, ct_j
1412 real(kind=dp) :: ri2, ri3, riji, vterm
1413 real(kind=dp) :: pref, preVal, rfVal, myPot
1414 real(kind=dp) :: dudx, dudy, dudz, dudr
1415
1416 if (.not.summationMethodChecked) then
1417 call checkSummationMethod()
1418 endif
1419
1420 dudx = 0.0d0
1421 dudy = 0.0d0
1422 dudz = 0.0d0
1423
1424 riji = 1.0d0/rij
1425
1426 xhat = d(1) * riji
1427 yhat = d(2) * riji
1428 zhat = d(3) * riji
1429
1430 ! this is a local only array, so we use the local atom type id's:
1431 atid1 = atid(atom1)
1432 atid2 = atid(atom2)
1433 i_is_Charge = ElectrostaticMap(atid1)%is_Charge
1434 j_is_Charge = ElectrostaticMap(atid2)%is_Charge
1435 i_is_Dipole = ElectrostaticMap(atid1)%is_Dipole
1436 j_is_Dipole = ElectrostaticMap(atid2)%is_Dipole
1437
1438 if (i_is_Charge.and.j_is_Charge) then
1439 q_i = ElectrostaticMap(atid1)%charge
1440 q_j = ElectrostaticMap(atid2)%charge
1441
1442 preVal = pre11 * q_i * q_j
1443 rfVal = preRF*rij*rij
1444 vterm = preVal * rfVal
1445
1446 myPot = myPot + sw*vterm
1447
1448 dudr = sw*preVal * 2.0d0*rfVal*riji
1449
1450 dudx = dudx + dudr * xhat
1451 dudy = dudy + dudr * yhat
1452 dudz = dudz + dudr * zhat
1453
1454 elseif (i_is_Charge.and.j_is_Dipole) then
1455 q_i = ElectrostaticMap(atid1)%charge
1456 mu_j = ElectrostaticMap(atid2)%dipole_moment
1457 uz_j(1) = eFrame(3,atom2)
1458 uz_j(2) = eFrame(6,atom2)
1459 uz_j(3) = eFrame(9,atom2)
1460 ct_j = uz_j(1)*xhat + uz_j(2)*yhat + uz_j(3)*zhat
1461
1462 ri2 = riji * riji
1463 ri3 = ri2 * riji
1464
1465 pref = pre12 * q_i * mu_j
1466 vterm = - pref * ct_j * ( ri2 - preRF2*rij )
1467 myPot = myPot + sw*vterm
1468
1469 dudx = dudx - sw*pref*( ri3*(uz_j(1)-3.0d0*ct_j*xhat) &
1470 - preRF2*uz_j(1) )
1471 dudy = dudy - sw*pref*( ri3*(uz_j(2)-3.0d0*ct_j*yhat) &
1472 - preRF2*uz_j(2) )
1473 dudz = dudz - sw*pref*( ri3*(uz_j(3)-3.0d0*ct_j*zhat) &
1474 - preRF2*uz_j(3) )
1475
1476 duduz_j(1) = duduz_j(1) - sw * pref * xhat * ( ri2 - preRF2*rij )
1477 duduz_j(2) = duduz_j(2) - sw * pref * yhat * ( ri2 - preRF2*rij )
1478 duduz_j(3) = duduz_j(3) - sw * pref * zhat * ( ri2 - preRF2*rij )
1479
1480 elseif (i_is_Dipole.and.j_is_Charge) then
1481 mu_i = ElectrostaticMap(atid1)%dipole_moment
1482 q_j = ElectrostaticMap(atid2)%charge
1483 uz_i(1) = eFrame(3,atom1)
1484 uz_i(2) = eFrame(6,atom1)
1485 uz_i(3) = eFrame(9,atom1)
1486 ct_i = uz_i(1)*xhat + uz_i(2)*yhat + uz_i(3)*zhat
1487
1488 ri2 = riji * riji
1489 ri3 = ri2 * riji
1490
1491 pref = pre12 * q_j * mu_i
1492 vterm = pref * ct_i * ( ri2 - preRF2*rij )
1493 myPot = myPot + sw*vterm
1494
1495 dudx = dudx + sw*pref*( ri3*(uz_i(1)-3.0d0*ct_i*xhat) &
1496 - preRF2*uz_i(1) )
1497 dudy = dudy + sw*pref*( ri3*(uz_i(2)-3.0d0*ct_i*yhat) &
1498 - preRF2*uz_i(2) )
1499 dudz = dudz + sw*pref*( ri3*(uz_i(3)-3.0d0*ct_i*zhat) &
1500 - preRF2*uz_i(3) )
1501
1502 duduz_i(1) = duduz_i(1) + sw * pref * xhat * ( ri2 - preRF2*rij )
1503 duduz_i(2) = duduz_i(2) + sw * pref * yhat * ( ri2 - preRF2*rij )
1504 duduz_i(3) = duduz_i(3) + sw * pref * zhat * ( ri2 - preRF2*rij )
1505
1506 endif
1507
1508
1509 ! accumulate the forces and torques resulting from the self term
1510 f(1,atom1) = f(1,atom1) + dudx
1511 f(2,atom1) = f(2,atom1) + dudy
1512 f(3,atom1) = f(3,atom1) + dudz
1513
1514 f(1,atom2) = f(1,atom2) - dudx
1515 f(2,atom2) = f(2,atom2) - dudy
1516 f(3,atom2) = f(3,atom2) - dudz
1517
1518 if (i_is_Dipole) then
1519 t(1,atom1)=t(1,atom1) - uz_i(2)*duduz_i(3) + uz_i(3)*duduz_i(2)
1520 t(2,atom1)=t(2,atom1) - uz_i(3)*duduz_i(1) + uz_i(1)*duduz_i(3)
1521 t(3,atom1)=t(3,atom1) - uz_i(1)*duduz_i(2) + uz_i(2)*duduz_i(1)
1522 elseif (j_is_Dipole) then
1523 t(1,atom2)=t(1,atom2) - uz_j(2)*duduz_j(3) + uz_j(3)*duduz_j(2)
1524 t(2,atom2)=t(2,atom2) - uz_j(3)*duduz_j(1) + uz_j(1)*duduz_j(3)
1525 t(3,atom2)=t(3,atom2) - uz_j(1)*duduz_j(2) + uz_j(2)*duduz_j(1)
1526 endif
1527
1528 return
1529 end subroutine rf_self_excludes
1530
1531 end module electrostatic_module