ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-2.0/src/UseTheForce/DarkSide/electrostatic.F90
Revision: 2405
Committed: Tue Nov 1 19:24:57 2005 UTC (18 years, 10 months ago) by chrisfen
File size: 58156 byte(s)
Log Message:
removed some testing code...

File Contents

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