ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-2.0/src/UseTheForce/DarkSide/electrostatic.F90
Revision: 2402
Committed: Tue Nov 1 19:09:30 2005 UTC (18 years, 10 months ago) by chrisfen
File size: 58341 byte(s)
Log Message:
still fixing up wolf...

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 2402 !!$
424     !!$ subroutine doElectrostaticPair(atom1, atom2, d, rij, r2, sw, &
425     !!$ vpair, fpair, pot, eFrame, f, t, do_pot)
426 gezelter 2095 subroutine doElectrostaticPair(atom1, atom2, d, rij, r2, sw, &
427 chrisfen 2402 vpair, fpair, pot, eFrame, f, t, do_pot, felec)
428 gezelter 2204
429 chrisfen 2402 logical, intent(in) :: do_pot
430 gezelter 2204
431 gezelter 2095 integer, intent(in) :: atom1, atom2
432     integer :: localError
433    
434 chrisfen 2306 real(kind=dp), intent(in) :: rij, r2, sw
435 gezelter 2095 real(kind=dp), intent(in), dimension(3) :: d
436     real(kind=dp), intent(inout) :: vpair
437 chrisfen 2402 real(kind=dp), intent(inout), dimension(3) :: fpair
438     real(kind=dp), intent(inout), dimension(3) :: felec
439 gezelter 2095
440 chrisfen 2325 real( kind = dp ) :: pot
441 gezelter 2095 real( kind = dp ), dimension(9,nLocal) :: eFrame
442     real( kind = dp ), dimension(3,nLocal) :: f
443     real( kind = dp ), dimension(3,nLocal) :: t
444 gezelter 2204
445 gezelter 2123 real (kind = dp), dimension(3) :: ux_i, uy_i, uz_i
446     real (kind = dp), dimension(3) :: ux_j, uy_j, uz_j
447     real (kind = dp), dimension(3) :: dudux_i, duduy_i, duduz_i
448     real (kind = dp), dimension(3) :: dudux_j, duduy_j, duduz_j
449 gezelter 2095
450     logical :: i_is_Charge, i_is_Dipole, i_is_SplitDipole, i_is_Quadrupole
451     logical :: j_is_Charge, j_is_Dipole, j_is_SplitDipole, j_is_Quadrupole
452 chrisfen 2229 logical :: i_is_Tap, j_is_Tap
453 gezelter 2095 integer :: me1, me2, id1, id2
454     real (kind=dp) :: q_i, q_j, mu_i, mu_j, d_i, d_j
455 gezelter 2123 real (kind=dp) :: qxx_i, qyy_i, qzz_i
456     real (kind=dp) :: qxx_j, qyy_j, qzz_j
457     real (kind=dp) :: cx_i, cy_i, cz_i
458     real (kind=dp) :: cx_j, cy_j, cz_j
459     real (kind=dp) :: cx2, cy2, cz2
460 gezelter 2095 real (kind=dp) :: ct_i, ct_j, ct_ij, a1
461 gezelter 2105 real (kind=dp) :: riji, ri, ri2, ri3, ri4
462 chrisfen 2296 real (kind=dp) :: pref, vterm, epot, dudr, vterm1, vterm2
463 gezelter 2105 real (kind=dp) :: xhat, yhat, zhat
464 gezelter 2095 real (kind=dp) :: dudx, dudy, dudz
465 chrisfen 2325 real (kind=dp) :: scale, sc2, bigR
466 chrisfen 2339 real (kind=dp) :: varERFC, varEXP
467 chrisfen 2343 real (kind=dp) :: limScale
468 chrisfen 2394 real (kind=dp) :: preVal, rfVal
469 gezelter 2095
470     if (.not.allocated(ElectrostaticMap)) then
471     call handleError("electrostatic", "no ElectrostaticMap was present before first call of do_electrostatic_pair!")
472     return
473     end if
474    
475 gezelter 2301 if (.not.summationMethodChecked) then
476     call checkSummationMethod()
477     endif
478    
479 gezelter 2095 #ifdef IS_MPI
480     me1 = atid_Row(atom1)
481     me2 = atid_Col(atom2)
482     #else
483     me1 = atid(atom1)
484     me2 = atid(atom2)
485     #endif
486    
487     !! some variables we'll need independent of electrostatic type:
488    
489     riji = 1.0d0 / rij
490 chrisfen 2343
491 gezelter 2105 xhat = d(1) * riji
492     yhat = d(2) * riji
493     zhat = d(3) * riji
494 gezelter 2095
495     !! logicals
496     i_is_Charge = ElectrostaticMap(me1)%is_Charge
497     i_is_Dipole = ElectrostaticMap(me1)%is_Dipole
498     i_is_SplitDipole = ElectrostaticMap(me1)%is_SplitDipole
499     i_is_Quadrupole = ElectrostaticMap(me1)%is_Quadrupole
500 chrisfen 2229 i_is_Tap = ElectrostaticMap(me1)%is_Tap
501 gezelter 2095
502     j_is_Charge = ElectrostaticMap(me2)%is_Charge
503     j_is_Dipole = ElectrostaticMap(me2)%is_Dipole
504     j_is_SplitDipole = ElectrostaticMap(me2)%is_SplitDipole
505     j_is_Quadrupole = ElectrostaticMap(me2)%is_Quadrupole
506 chrisfen 2229 j_is_Tap = ElectrostaticMap(me2)%is_Tap
507 gezelter 2095
508     if (i_is_Charge) then
509     q_i = ElectrostaticMap(me1)%charge
510     endif
511 gezelter 2204
512 gezelter 2095 if (i_is_Dipole) then
513     mu_i = ElectrostaticMap(me1)%dipole_moment
514     #ifdef IS_MPI
515 gezelter 2123 uz_i(1) = eFrame_Row(3,atom1)
516     uz_i(2) = eFrame_Row(6,atom1)
517     uz_i(3) = eFrame_Row(9,atom1)
518 gezelter 2095 #else
519 gezelter 2123 uz_i(1) = eFrame(3,atom1)
520     uz_i(2) = eFrame(6,atom1)
521     uz_i(3) = eFrame(9,atom1)
522 gezelter 2095 #endif
523 gezelter 2123 ct_i = uz_i(1)*xhat + uz_i(2)*yhat + uz_i(3)*zhat
524 gezelter 2095
525     if (i_is_SplitDipole) then
526     d_i = ElectrostaticMap(me1)%split_dipole_distance
527     endif
528 gezelter 2204
529 gezelter 2095 endif
530    
531 gezelter 2123 if (i_is_Quadrupole) then
532     qxx_i = ElectrostaticMap(me1)%quadrupole_moments(1)
533     qyy_i = ElectrostaticMap(me1)%quadrupole_moments(2)
534     qzz_i = ElectrostaticMap(me1)%quadrupole_moments(3)
535     #ifdef IS_MPI
536     ux_i(1) = eFrame_Row(1,atom1)
537     ux_i(2) = eFrame_Row(4,atom1)
538     ux_i(3) = eFrame_Row(7,atom1)
539     uy_i(1) = eFrame_Row(2,atom1)
540     uy_i(2) = eFrame_Row(5,atom1)
541     uy_i(3) = eFrame_Row(8,atom1)
542     uz_i(1) = eFrame_Row(3,atom1)
543     uz_i(2) = eFrame_Row(6,atom1)
544     uz_i(3) = eFrame_Row(9,atom1)
545     #else
546     ux_i(1) = eFrame(1,atom1)
547     ux_i(2) = eFrame(4,atom1)
548     ux_i(3) = eFrame(7,atom1)
549     uy_i(1) = eFrame(2,atom1)
550     uy_i(2) = eFrame(5,atom1)
551     uy_i(3) = eFrame(8,atom1)
552     uz_i(1) = eFrame(3,atom1)
553     uz_i(2) = eFrame(6,atom1)
554     uz_i(3) = eFrame(9,atom1)
555     #endif
556     cx_i = ux_i(1)*xhat + ux_i(2)*yhat + ux_i(3)*zhat
557     cy_i = uy_i(1)*xhat + uy_i(2)*yhat + uy_i(3)*zhat
558     cz_i = uz_i(1)*xhat + uz_i(2)*yhat + uz_i(3)*zhat
559     endif
560    
561 gezelter 2095 if (j_is_Charge) then
562     q_j = ElectrostaticMap(me2)%charge
563     endif
564 gezelter 2204
565 gezelter 2095 if (j_is_Dipole) then
566     mu_j = ElectrostaticMap(me2)%dipole_moment
567     #ifdef IS_MPI
568 gezelter 2123 uz_j(1) = eFrame_Col(3,atom2)
569     uz_j(2) = eFrame_Col(6,atom2)
570     uz_j(3) = eFrame_Col(9,atom2)
571 gezelter 2095 #else
572 gezelter 2123 uz_j(1) = eFrame(3,atom2)
573     uz_j(2) = eFrame(6,atom2)
574     uz_j(3) = eFrame(9,atom2)
575 gezelter 2095 #endif
576 chrisfen 2162 ct_j = uz_j(1)*xhat + uz_j(2)*yhat + uz_j(3)*zhat
577 gezelter 2095
578     if (j_is_SplitDipole) then
579     d_j = ElectrostaticMap(me2)%split_dipole_distance
580     endif
581     endif
582    
583 gezelter 2123 if (j_is_Quadrupole) then
584     qxx_j = ElectrostaticMap(me2)%quadrupole_moments(1)
585     qyy_j = ElectrostaticMap(me2)%quadrupole_moments(2)
586     qzz_j = ElectrostaticMap(me2)%quadrupole_moments(3)
587     #ifdef IS_MPI
588     ux_j(1) = eFrame_Col(1,atom2)
589     ux_j(2) = eFrame_Col(4,atom2)
590     ux_j(3) = eFrame_Col(7,atom2)
591     uy_j(1) = eFrame_Col(2,atom2)
592     uy_j(2) = eFrame_Col(5,atom2)
593     uy_j(3) = eFrame_Col(8,atom2)
594     uz_j(1) = eFrame_Col(3,atom2)
595     uz_j(2) = eFrame_Col(6,atom2)
596     uz_j(3) = eFrame_Col(9,atom2)
597     #else
598     ux_j(1) = eFrame(1,atom2)
599     ux_j(2) = eFrame(4,atom2)
600     ux_j(3) = eFrame(7,atom2)
601     uy_j(1) = eFrame(2,atom2)
602     uy_j(2) = eFrame(5,atom2)
603     uy_j(3) = eFrame(8,atom2)
604     uz_j(1) = eFrame(3,atom2)
605     uz_j(2) = eFrame(6,atom2)
606     uz_j(3) = eFrame(9,atom2)
607     #endif
608     cx_j = ux_j(1)*xhat + ux_j(2)*yhat + ux_j(3)*zhat
609     cy_j = uy_j(1)*xhat + uy_j(2)*yhat + uy_j(3)*zhat
610     cz_j = uz_j(1)*xhat + uz_j(2)*yhat + uz_j(3)*zhat
611     endif
612 chrisfen 2251
613 gezelter 2095 epot = 0.0_dp
614     dudx = 0.0_dp
615     dudy = 0.0_dp
616     dudz = 0.0_dp
617    
618 gezelter 2123 dudux_i = 0.0_dp
619     duduy_i = 0.0_dp
620     duduz_i = 0.0_dp
621 gezelter 2095
622 gezelter 2123 dudux_j = 0.0_dp
623     duduy_j = 0.0_dp
624     duduz_j = 0.0_dp
625 gezelter 2095
626     if (i_is_Charge) then
627    
628     if (j_is_Charge) then
629 gezelter 2204
630 chrisfen 2310 if (summationMethod .eq. UNDAMPED_WOLF) then
631 chrisfen 2296 vterm = pre11 * q_i * q_j * (riji - rcuti)
632     vpair = vpair + vterm
633 chrisfen 2325 epot = epot + sw*vterm
634 chrisfen 2296
635 chrisfen 2402 dudr = -sw*pre11*q_i*q_j * (riji*riji-rcuti2)
636 chrisfen 2296
637 chrisfen 2402 dudx = dudx + dudr * xhat
638     dudy = dudy + dudr * yhat
639     dudz = dudz + dudr * zhat
640 gezelter 2095
641 chrisfen 2339 elseif (summationMethod .eq. DAMPED_WOLF) then
642     varERFC = derfc(dampingAlpha*rij)
643     varEXP = exp(-dampingAlpha*dampingAlpha*rij*rij)
644     vterm = pre11 * q_i * q_j * (varERFC*riji - constERFC*rcuti)
645     vpair = vpair + vterm
646     epot = epot + sw*vterm
647    
648 chrisfen 2402 dudr = -sw*pre11*q_i*q_j * (((varERFC*riji*riji &
649     + alphaPi*varEXP*riji) - (constERFC*rcuti2 &
650     + alphaPi*constEXP*rcuti)) )
651 chrisfen 2339
652 chrisfen 2402 dudx = dudx + dudr * xhat
653     dudy = dudy + dudr * yhat
654     dudz = dudz + dudr * zhat
655 chrisfen 2339
656 chrisfen 2394 elseif (summationMethod .eq. REACTION_FIELD) then
657     preVal = pre11 * q_i * q_j
658     rfVal = preRF*rij*rij
659     vterm = preVal * ( riji + rfVal )
660 chrisfen 2399
661 chrisfen 2394 vpair = vpair + vterm
662     epot = epot + sw*vterm
663    
664     dudr = sw * preVal * ( 2.0d0*rfVal - riji )*riji
665    
666     dudx = dudx + dudr * xhat
667     dudy = dudy + dudr * yhat
668     dudz = dudz + dudr * zhat
669    
670 chrisfen 2296 else
671     vterm = pre11 * q_i * q_j * riji
672     vpair = vpair + vterm
673 chrisfen 2325 epot = epot + sw*vterm
674 chrisfen 2296
675     dudr = - sw * vterm * riji
676    
677     dudx = dudx + dudr * xhat
678     dudy = dudy + dudr * yhat
679     dudz = dudz + dudr * zhat
680    
681     endif
682    
683 gezelter 2095 endif
684    
685     if (j_is_Dipole) then
686    
687 chrisfen 2325 pref = pre12 * q_i * mu_j
688 gezelter 2095
689 chrisfen 2310 if (summationMethod .eq. UNDAMPED_WOLF) then
690 chrisfen 2296 ri2 = riji * riji
691     ri3 = ri2 * riji
692 gezelter 2204
693 chrisfen 2325 pref = pre12 * q_i * mu_j
694 chrisfen 2296 vterm = - pref * ct_j * (ri2 - rcuti2)
695 chrisfen 2325 vpair = vpair + vterm
696     epot = epot + sw*vterm
697 chrisfen 2296
698     !! this has a + sign in the () because the rij vector is
699     !! r_j - r_i and the charge-dipole potential takes the origin
700     !! as the point dipole, which is atom j in this case.
701    
702 chrisfen 2325 dudx = dudx - sw*pref * ( ri3*( uz_j(1) - 3.0d0*ct_j*xhat) &
703 chrisfen 2296 - rcuti3*( uz_j(1) - 3.0d0*ct_j*d(1)*rcuti ) )
704 chrisfen 2325 dudy = dudy - sw*pref * ( ri3*( uz_j(2) - 3.0d0*ct_j*yhat) &
705 chrisfen 2296 - rcuti3*( uz_j(2) - 3.0d0*ct_j*d(2)*rcuti ) )
706 chrisfen 2325 dudz = dudz - sw*pref * ( ri3*( uz_j(3) - 3.0d0*ct_j*zhat) &
707 chrisfen 2296 - rcuti3*( uz_j(3) - 3.0d0*ct_j*d(3)*rcuti ) )
708    
709 chrisfen 2325 duduz_j(1) = duduz_j(1) - sw*pref*( ri2*xhat - d(1)*rcuti3 )
710     duduz_j(2) = duduz_j(2) - sw*pref*( ri2*yhat - d(2)*rcuti3 )
711     duduz_j(3) = duduz_j(3) - sw*pref*( ri2*zhat - d(3)*rcuti3 )
712 gezelter 2095
713 chrisfen 2395 elseif (summationMethod .eq. REACTION_FIELD) then
714 chrisfen 2399 ri2 = riji * riji
715     ri3 = ri2 * riji
716 chrisfen 2395
717     pref = pre12 * q_i * mu_j
718     vterm = - pref * ct_j * ( ri2 - preRF2*rij )
719     vpair = vpair + vterm
720     epot = epot + sw*vterm
721    
722     !! this has a + sign in the () because the rij vector is
723     !! r_j - r_i and the charge-dipole potential takes the origin
724     !! as the point dipole, which is atom j in this case.
725    
726     dudx = dudx - sw*pref*( ri3*(uz_j(1) - 3.0d0*ct_j*xhat) - &
727     preRF2*uz_j(1) )
728     dudy = dudy - sw*pref*( ri3*(uz_j(2) - 3.0d0*ct_j*yhat) - &
729     preRF2*uz_j(2) )
730     dudz = dudz - sw*pref*( ri3*(uz_j(3) - 3.0d0*ct_j*zhat) - &
731     preRF2*uz_j(3) )
732     duduz_j(1) = duduz_j(1) - sw*pref * xhat * ( ri2 - preRF2*rij )
733     duduz_j(2) = duduz_j(2) - sw*pref * yhat * ( ri2 - preRF2*rij )
734     duduz_j(3) = duduz_j(3) - sw*pref * zhat * ( ri2 - preRF2*rij )
735    
736 chrisfen 2296 else
737     if (j_is_SplitDipole) then
738     BigR = sqrt(r2 + 0.25_dp * d_j * d_j)
739     ri = 1.0_dp / BigR
740     scale = rij * ri
741     else
742     ri = riji
743     scale = 1.0_dp
744     endif
745    
746     ri2 = ri * ri
747     ri3 = ri2 * ri
748     sc2 = scale * scale
749 chrisfen 2325
750     pref = pre12 * q_i * mu_j
751 chrisfen 2296 vterm = - pref * ct_j * ri2 * scale
752 chrisfen 2325 vpair = vpair + vterm
753     epot = epot + sw*vterm
754 chrisfen 2296
755     !! this has a + sign in the () because the rij vector is
756     !! r_j - r_i and the charge-dipole potential takes the origin
757     !! as the point dipole, which is atom j in this case.
758    
759 chrisfen 2325 dudx = dudx - sw*pref * ri3 * ( uz_j(1) - 3.0d0*ct_j*xhat*sc2)
760     dudy = dudy - sw*pref * ri3 * ( uz_j(2) - 3.0d0*ct_j*yhat*sc2)
761     dudz = dudz - sw*pref * ri3 * ( uz_j(3) - 3.0d0*ct_j*zhat*sc2)
762 chrisfen 2296
763 chrisfen 2325 duduz_j(1) = duduz_j(1) - sw*pref * ri2 * xhat * scale
764     duduz_j(2) = duduz_j(2) - sw*pref * ri2 * yhat * scale
765     duduz_j(3) = duduz_j(3) - sw*pref * ri2 * zhat * scale
766 gezelter 2095
767 chrisfen 2296 endif
768 gezelter 2095 endif
769 gezelter 2105
770 gezelter 2123 if (j_is_Quadrupole) then
771     ri2 = riji * riji
772     ri3 = ri2 * riji
773 gezelter 2124 ri4 = ri2 * ri2
774 gezelter 2123 cx2 = cx_j * cx_j
775     cy2 = cy_j * cy_j
776     cz2 = cz_j * cz_j
777    
778 chrisfen 2310 if (summationMethod .eq. UNDAMPED_WOLF) then
779 chrisfen 2325 pref = pre14 * q_i / 3.0_dp
780 chrisfen 2296 vterm1 = pref * ri3*( 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     vterm2 = pref * rcuti3*( qxx_j * (3.0_dp*cx2 - 1.0_dp) + &
784     qyy_j * (3.0_dp*cy2 - 1.0_dp) + &
785     qzz_j * (3.0_dp*cz2 - 1.0_dp) )
786 chrisfen 2325 vpair = vpair + ( vterm1 - vterm2 )
787     epot = epot + sw*( vterm1 - vterm2 )
788 chrisfen 2296
789     dudx = dudx - (5.0_dp * &
790 chrisfen 2325 (vterm1*riji*xhat - vterm2*rcuti2*d(1))) + sw*pref * ( &
791 chrisfen 2296 (ri4 - rcuti4)*(qxx_j*(6.0_dp*cx_j*ux_j(1)) - &
792     qxx_j*2.0_dp*(xhat - rcuti*d(1))) + &
793     (ri4 - rcuti4)*(qyy_j*(6.0_dp*cy_j*uy_j(1)) - &
794     qyy_j*2.0_dp*(xhat - rcuti*d(1))) + &
795     (ri4 - rcuti4)*(qzz_j*(6.0_dp*cz_j*uz_j(1)) - &
796     qzz_j*2.0_dp*(xhat - rcuti*d(1))) )
797     dudy = dudy - (5.0_dp * &
798 chrisfen 2325 (vterm1*riji*yhat - vterm2*rcuti2*d(2))) + sw*pref * ( &
799 chrisfen 2296 (ri4 - rcuti4)*(qxx_j*(6.0_dp*cx_j*ux_j(2)) - &
800     qxx_j*2.0_dp*(yhat - rcuti*d(2))) + &
801     (ri4 - rcuti4)*(qyy_j*(6.0_dp*cy_j*uy_j(2)) - &
802     qyy_j*2.0_dp*(yhat - rcuti*d(2))) + &
803     (ri4 - rcuti4)*(qzz_j*(6.0_dp*cz_j*uz_j(2)) - &
804     qzz_j*2.0_dp*(yhat - rcuti*d(2))) )
805     dudz = dudz - (5.0_dp * &
806 chrisfen 2325 (vterm1*riji*zhat - vterm2*rcuti2*d(3))) + sw*pref * ( &
807 chrisfen 2296 (ri4 - rcuti4)*(qxx_j*(6.0_dp*cx_j*ux_j(3)) - &
808     qxx_j*2.0_dp*(zhat - rcuti*d(3))) + &
809     (ri4 - rcuti4)*(qyy_j*(6.0_dp*cy_j*uy_j(3)) - &
810     qyy_j*2.0_dp*(zhat - rcuti*d(3))) + &
811     (ri4 - rcuti4)*(qzz_j*(6.0_dp*cz_j*uz_j(3)) - &
812     qzz_j*2.0_dp*(zhat - rcuti*d(3))) )
813    
814 chrisfen 2325 dudux_j(1) = dudux_j(1) + sw*pref*(ri3*(qxx_j*6.0_dp*cx_j*xhat) -&
815 chrisfen 2296 rcuti4*(qxx_j*6.0_dp*cx_j*d(1)))
816 chrisfen 2325 dudux_j(2) = dudux_j(2) + sw*pref*(ri3*(qxx_j*6.0_dp*cx_j*yhat) -&
817 chrisfen 2296 rcuti4*(qxx_j*6.0_dp*cx_j*d(2)))
818 chrisfen 2325 dudux_j(3) = dudux_j(3) + sw*pref*(ri3*(qxx_j*6.0_dp*cx_j*zhat) -&
819 chrisfen 2296 rcuti4*(qxx_j*6.0_dp*cx_j*d(3)))
820    
821 chrisfen 2325 duduy_j(1) = duduy_j(1) + sw*pref*(ri3*(qyy_j*6.0_dp*cy_j*xhat) -&
822 chrisfen 2296 rcuti4*(qyy_j*6.0_dp*cx_j*d(1)))
823 chrisfen 2325 duduy_j(2) = duduy_j(2) + sw*pref*(ri3*(qyy_j*6.0_dp*cy_j*yhat) -&
824 chrisfen 2296 rcuti4*(qyy_j*6.0_dp*cx_j*d(2)))
825 chrisfen 2325 duduy_j(3) = duduy_j(3) + sw*pref*(ri3*(qyy_j*6.0_dp*cy_j*zhat) -&
826 chrisfen 2296 rcuti4*(qyy_j*6.0_dp*cx_j*d(3)))
827    
828 chrisfen 2325 duduz_j(1) = duduz_j(1) + sw*pref*(ri3*(qzz_j*6.0_dp*cz_j*xhat) -&
829 chrisfen 2296 rcuti4*(qzz_j*6.0_dp*cx_j*d(1)))
830 chrisfen 2325 duduz_j(2) = duduz_j(2) + sw*pref*(ri3*(qzz_j*6.0_dp*cz_j*yhat) -&
831 chrisfen 2296 rcuti4*(qzz_j*6.0_dp*cx_j*d(2)))
832 chrisfen 2325 duduz_j(3) = duduz_j(3) + sw*pref*(ri3*(qzz_j*6.0_dp*cz_j*zhat) -&
833 chrisfen 2296 rcuti4*(qzz_j*6.0_dp*cx_j*d(3)))
834    
835     else
836 chrisfen 2325 pref = pre14 * q_i / 3.0_dp
837 chrisfen 2296 vterm = pref * ri3 * (qxx_j * (3.0_dp*cx2 - 1.0_dp) + &
838     qyy_j * (3.0_dp*cy2 - 1.0_dp) + &
839     qzz_j * (3.0_dp*cz2 - 1.0_dp))
840 chrisfen 2325 vpair = vpair + vterm
841     epot = epot + sw*vterm
842 chrisfen 2296
843 chrisfen 2325 dudx = dudx - 5.0_dp*sw*vterm*riji*xhat + sw*pref * ri4 * ( &
844 chrisfen 2296 qxx_j*(6.0_dp*cx_j*ux_j(1) - 2.0_dp*xhat) + &
845     qyy_j*(6.0_dp*cy_j*uy_j(1) - 2.0_dp*xhat) + &
846     qzz_j*(6.0_dp*cz_j*uz_j(1) - 2.0_dp*xhat) )
847 chrisfen 2325 dudy = dudy - 5.0_dp*sw*vterm*riji*yhat + sw*pref * ri4 * ( &
848 chrisfen 2296 qxx_j*(6.0_dp*cx_j*ux_j(2) - 2.0_dp*yhat) + &
849     qyy_j*(6.0_dp*cy_j*uy_j(2) - 2.0_dp*yhat) + &
850     qzz_j*(6.0_dp*cz_j*uz_j(2) - 2.0_dp*yhat) )
851 chrisfen 2325 dudz = dudz - 5.0_dp*sw*vterm*riji*zhat + sw*pref * ri4 * ( &
852 chrisfen 2296 qxx_j*(6.0_dp*cx_j*ux_j(3) - 2.0_dp*zhat) + &
853     qyy_j*(6.0_dp*cy_j*uy_j(3) - 2.0_dp*zhat) + &
854     qzz_j*(6.0_dp*cz_j*uz_j(3) - 2.0_dp*zhat) )
855    
856 chrisfen 2325 dudux_j(1) = dudux_j(1) + sw*pref * ri3*(qxx_j*6.0_dp*cx_j*xhat)
857     dudux_j(2) = dudux_j(2) + sw*pref * ri3*(qxx_j*6.0_dp*cx_j*yhat)
858     dudux_j(3) = dudux_j(3) + sw*pref * ri3*(qxx_j*6.0_dp*cx_j*zhat)
859 chrisfen 2296
860 chrisfen 2325 duduy_j(1) = duduy_j(1) + sw*pref * ri3*(qyy_j*6.0_dp*cy_j*xhat)
861     duduy_j(2) = duduy_j(2) + sw*pref * ri3*(qyy_j*6.0_dp*cy_j*yhat)
862     duduy_j(3) = duduy_j(3) + sw*pref * ri3*(qyy_j*6.0_dp*cy_j*zhat)
863 chrisfen 2296
864 chrisfen 2325 duduz_j(1) = duduz_j(1) + sw*pref * ri3*(qzz_j*6.0_dp*cz_j*xhat)
865     duduz_j(2) = duduz_j(2) + sw*pref * ri3*(qzz_j*6.0_dp*cz_j*yhat)
866     duduz_j(3) = duduz_j(3) + sw*pref * ri3*(qzz_j*6.0_dp*cz_j*zhat)
867 chrisfen 2296
868     endif
869 gezelter 2123 endif
870 gezelter 2095 endif
871 gezelter 2204
872 gezelter 2095 if (i_is_Dipole) then
873 gezelter 2204
874 gezelter 2095 if (j_is_Charge) then
875 chrisfen 2325
876     pref = pre12 * q_j * mu_i
877    
878 chrisfen 2310 if (summationMethod .eq. UNDAMPED_WOLF) then
879 chrisfen 2296 ri2 = riji * riji
880     ri3 = ri2 * riji
881 gezelter 2204
882 chrisfen 2325 pref = pre12 * q_j * mu_i
883 chrisfen 2296 vterm = pref * ct_i * (ri2 - rcuti2)
884 chrisfen 2325 vpair = vpair + vterm
885     epot = epot + sw*vterm
886 chrisfen 2296
887 chrisfen 2325 dudx = dudx + sw*pref * ( ri3*( uz_i(1) - 3.0d0*ct_i*xhat) &
888 chrisfen 2296 - rcuti3*( uz_i(1) - 3.0d0*ct_i*d(1)*rcuti ) )
889 chrisfen 2325 dudy = dudy + sw*pref * ( ri3*( uz_i(2) - 3.0d0*ct_i*yhat) &
890 chrisfen 2296 - rcuti3*( uz_i(2) - 3.0d0*ct_i*d(2)*rcuti ) )
891 chrisfen 2325 dudz = dudz + sw*pref * ( ri3*( uz_i(3) - 3.0d0*ct_i*zhat) &
892 chrisfen 2296 - rcuti3*( uz_i(3) - 3.0d0*ct_i*d(3)*rcuti ) )
893    
894 chrisfen 2399 duduz_i(1) = duduz_i(1) + sw*pref*( ri2*xhat - d(1)*rcuti3 )
895     duduz_i(2) = duduz_i(2) + sw*pref*( ri2*yhat - d(2)*rcuti3 )
896     duduz_i(3) = duduz_i(3) + sw*pref*( ri2*zhat - d(3)*rcuti3 )
897 gezelter 2095
898 chrisfen 2395 elseif (summationMethod .eq. REACTION_FIELD) then
899 chrisfen 2399 ri2 = riji * riji
900     ri3 = ri2 * riji
901 chrisfen 2395
902     pref = pre12 * q_j * mu_i
903 chrisfen 2399 vterm = pref * ct_i * ( ri2 - preRF2*rij )
904 chrisfen 2395 vpair = vpair + vterm
905     epot = epot + sw*vterm
906    
907 chrisfen 2399 dudx = dudx + sw*pref * ( ri3*(uz_i(1) - 3.0d0*ct_i*xhat) - &
908     preRF2*uz_i(1) )
909     dudy = dudy + sw*pref * ( ri3*(uz_i(2) - 3.0d0*ct_i*yhat) - &
910     preRF2*uz_i(2) )
911     dudz = dudz + sw*pref * ( ri3*(uz_i(3) - 3.0d0*ct_i*zhat) - &
912     preRF2*uz_i(3) )
913 chrisfen 2395
914 chrisfen 2399 duduz_i(1) = duduz_i(1) + sw*pref * xhat * ( ri2 - preRF2*rij )
915     duduz_i(2) = duduz_i(2) + sw*pref * yhat * ( ri2 - preRF2*rij )
916     duduz_i(3) = duduz_i(3) + sw*pref * zhat * ( ri2 - preRF2*rij )
917 chrisfen 2395
918 chrisfen 2296 else
919     if (i_is_SplitDipole) then
920 gezelter 2105 BigR = sqrt(r2 + 0.25_dp * d_i * d_i)
921     ri = 1.0_dp / BigR
922 chrisfen 2296 scale = rij * ri
923     else
924 gezelter 2105 ri = riji
925     scale = 1.0_dp
926     endif
927 chrisfen 2296
928     ri2 = ri * ri
929     ri3 = ri2 * ri
930     sc2 = scale * scale
931 chrisfen 2325
932     pref = pre12 * q_j * mu_i
933 chrisfen 2296 vterm = pref * ct_i * ri2 * scale
934 chrisfen 2325 vpair = vpair + vterm
935     epot = epot + sw*vterm
936 chrisfen 2296
937 chrisfen 2325 dudx = dudx + sw*pref * ri3 * ( uz_i(1) - 3.0d0 * ct_i * xhat*sc2)
938     dudy = dudy + sw*pref * ri3 * ( uz_i(2) - 3.0d0 * ct_i * yhat*sc2)
939     dudz = dudz + sw*pref * ri3 * ( uz_i(3) - 3.0d0 * ct_i * zhat*sc2)
940 chrisfen 2296
941 chrisfen 2325 duduz_i(1) = duduz_i(1) + sw*pref * ri2 * xhat * scale
942     duduz_i(2) = duduz_i(2) + sw*pref * ri2 * yhat * scale
943     duduz_i(3) = duduz_i(3) + sw*pref * ri2 * zhat * scale
944 gezelter 2105 endif
945 chrisfen 2296 endif
946 chrisfen 2325
947 chrisfen 2296 if (j_is_Dipole) then
948 gezelter 2105
949 chrisfen 2310 if (summationMethod .eq. UNDAMPED_WOLF) then
950 chrisfen 2402 !!$ ct_ij = uz_i(1)*uz_j(1) + uz_i(2)*uz_j(2) + uz_i(3)*uz_j(3)
951     !!$
952     !!$ ri2 = riji * riji
953     !!$ ri3 = ri2 * riji
954     !!$ ri4 = ri2 * ri2
955     !!$
956     !!$ pref = pre22 * mu_i * mu_j
957     !!$ vterm = pref * (ri3 - rcuti3) * (ct_ij - 3.0d0 * ct_i * ct_j)
958     !!$ vpair = vpair + vterm
959     !!$ epot = epot + sw*vterm
960     !!$
961     !!$ a1 = 5.0d0 * ct_i * ct_j - ct_ij
962     !!$
963     !!$ dudx = dudx + sw*pref*3.0d0*( &
964     !!$ ri4*(a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1)) &
965     !!$ - rcuti4*(a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1)) )
966     !!$ dudy = dudy + sw*pref*3.0d0*( &
967     !!$ ri4*(a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2)) &
968     !!$ - rcuti4*(a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2)) )
969     !!$ dudz = dudz + sw*pref*3.0d0*( &
970     !!$ ri4*(a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3)) &
971     !!$ - rcuti4*(a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3)) )
972     !!$
973     !!$ duduz_i(1) = duduz_i(1) + sw*pref*(ri3*(uz_j(1)-3.0d0*ct_j*xhat) &
974     !!$ - rcuti3*(uz_j(1) - 3.0d0*ct_j*xhat))
975     !!$ duduz_i(2) = duduz_i(2) + sw*pref*(ri3*(uz_j(2)-3.0d0*ct_j*yhat) &
976     !!$ - rcuti3*(uz_j(2) - 3.0d0*ct_j*yhat))
977     !!$ duduz_i(3) = duduz_i(3) + sw*pref*(ri3*(uz_j(3)-3.0d0*ct_j*zhat) &
978     !!$ - rcuti3*(uz_j(3) - 3.0d0*ct_j*zhat))
979     !!$ duduz_j(1) = duduz_j(1) + sw*pref*(ri3*(uz_i(1)-3.0d0*ct_i*xhat) &
980     !!$ - rcuti3*(uz_i(1) - 3.0d0*ct_i*xhat))
981     !!$ duduz_j(2) = duduz_j(2) + sw*pref*(ri3*(uz_i(2)-3.0d0*ct_i*yhat) &
982     !!$ - rcuti3*(uz_i(2) - 3.0d0*ct_i*yhat))
983     !!$ duduz_j(3) = duduz_j(3) + sw*pref*(ri3*(uz_i(3)-3.0d0*ct_i*zhat) &
984     !!$ - rcuti3*(uz_i(3) - 3.0d0*ct_i*zhat))
985    
986     elseif (summationMethod .eq. DAMPED_WOLF) then
987     ct_ij = uz_i(1)*uz_j(1) + uz_i(2)*uz_j(2) + uz_i(3)*uz_j(3)
988    
989 chrisfen 2296 ri2 = riji * riji
990     ri3 = ri2 * riji
991     ri4 = ri2 * ri2
992 chrisfen 2402 sc2 = scale * scale
993    
994 chrisfen 2325 pref = pre22 * mu_i * mu_j
995 chrisfen 2402 vterm = pref * ri3 * (ct_ij - 3.0d0 * ct_i * ct_j)
996 chrisfen 2325 vpair = vpair + vterm
997     epot = epot + sw*vterm
998 chrisfen 2296
999 chrisfen 2402 a1 = 5.0d0 * ct_i * ct_j * sc2 - ct_ij
1000 chrisfen 2296
1001 chrisfen 2402 dudx = dudx + sw*pref*3.0d0*ri4*(a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1))
1002     dudy = dudy + sw*pref*3.0d0*ri4*(a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2))
1003     dudz = dudz + sw*pref*3.0d0*ri4*(a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3))
1004 chrisfen 2296
1005 chrisfen 2402 duduz_i(1) = duduz_i(1) + sw*pref*ri3 *(uz_j(1) - 3.0d0*ct_j*xhat)
1006     duduz_i(2) = duduz_i(2) + sw*pref*ri3 *(uz_j(2) - 3.0d0*ct_j*yhat)
1007     duduz_i(3) = duduz_i(3) + sw*pref*ri3 *(uz_j(3) - 3.0d0*ct_j*zhat)
1008    
1009     duduz_j(1) = duduz_j(1) + sw*pref*ri3 *(uz_i(1) - 3.0d0*ct_i*xhat)
1010     duduz_j(2) = duduz_j(2) + sw*pref*ri3 *(uz_i(2) - 3.0d0*ct_i*yhat)
1011     duduz_j(3) = duduz_j(3) + sw*pref*ri3 *(uz_i(3) - 3.0d0*ct_i*zhat)
1012    
1013     elseif (summationMethod .eq. REACTION_FIELD) then
1014 chrisfen 2394 ct_ij = uz_i(1)*uz_j(1) + uz_i(2)*uz_j(2) + uz_i(3)*uz_j(3)
1015    
1016     ri2 = riji * riji
1017     ri3 = ri2 * riji
1018     ri4 = ri2 * ri2
1019    
1020     pref = pre22 * mu_i * mu_j
1021    
1022     vterm = pref*( ri3*(ct_ij - 3.0d0 * ct_i * ct_j) - &
1023     preRF2*ct_ij )
1024     vpair = vpair + vterm
1025     epot = epot + sw*vterm
1026    
1027     a1 = 5.0d0 * ct_i * ct_j - ct_ij
1028    
1029     dudx = dudx + sw*pref*3.0d0*ri4 &
1030     * (a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1))
1031     dudy = dudy + sw*pref*3.0d0*ri4 &
1032     * (a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2))
1033     dudz = dudz + sw*pref*3.0d0*ri4 &
1034     * (a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3))
1035    
1036     duduz_i(1) = duduz_i(1) + sw*pref*(ri3*(uz_j(1)-3.0d0*ct_j*xhat) &
1037     - preRF2*uz_j(1))
1038     duduz_i(2) = duduz_i(2) + sw*pref*(ri3*(uz_j(2)-3.0d0*ct_j*yhat) &
1039     - preRF2*uz_j(2))
1040     duduz_i(3) = duduz_i(3) + sw*pref*(ri3*(uz_j(3)-3.0d0*ct_j*zhat) &
1041     - preRF2*uz_j(3))
1042     duduz_j(1) = duduz_j(1) + sw*pref*(ri3*(uz_i(1)-3.0d0*ct_i*xhat) &
1043     - preRF2*uz_i(1))
1044     duduz_j(2) = duduz_j(2) + sw*pref*(ri3*(uz_i(2)-3.0d0*ct_i*yhat) &
1045     - preRF2*uz_i(2))
1046     duduz_j(3) = duduz_j(3) + sw*pref*(ri3*(uz_i(3)-3.0d0*ct_i*zhat) &
1047     - preRF2*uz_i(3))
1048    
1049 chrisfen 2296 else
1050     if (i_is_SplitDipole) then
1051     if (j_is_SplitDipole) then
1052     BigR = sqrt(r2 + 0.25_dp * d_i * d_i + 0.25_dp * d_j * d_j)
1053     else
1054     BigR = sqrt(r2 + 0.25_dp * d_i * d_i)
1055     endif
1056     ri = 1.0_dp / BigR
1057     scale = rij * ri
1058     else
1059     if (j_is_SplitDipole) then
1060     BigR = sqrt(r2 + 0.25_dp * d_j * d_j)
1061     ri = 1.0_dp / BigR
1062     scale = rij * ri
1063     else
1064     ri = riji
1065     scale = 1.0_dp
1066     endif
1067     endif
1068    
1069     ct_ij = uz_i(1)*uz_j(1) + uz_i(2)*uz_j(2) + uz_i(3)*uz_j(3)
1070    
1071     ri2 = ri * ri
1072     ri3 = ri2 * ri
1073     ri4 = ri2 * ri2
1074     sc2 = scale * scale
1075    
1076 chrisfen 2325 pref = pre22 * mu_i * mu_j
1077 chrisfen 2296 vterm = pref * ri3 * (ct_ij - 3.0d0 * ct_i * ct_j * sc2)
1078 chrisfen 2325 vpair = vpair + vterm
1079     epot = epot + sw*vterm
1080 chrisfen 2296
1081     a1 = 5.0d0 * ct_i * ct_j * sc2 - ct_ij
1082    
1083 chrisfen 2325 dudx = dudx + sw*pref*3.0d0*ri4*scale &
1084     *(a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1))
1085     dudy = dudy + sw*pref*3.0d0*ri4*scale &
1086     *(a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2))
1087     dudz = dudz + sw*pref*3.0d0*ri4*scale &
1088     *(a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3))
1089 chrisfen 2296
1090 chrisfen 2325 duduz_i(1) = duduz_i(1) + sw*pref*ri3 &
1091     *(uz_j(1) - 3.0d0*ct_j*xhat*sc2)
1092     duduz_i(2) = duduz_i(2) + sw*pref*ri3 &
1093     *(uz_j(2) - 3.0d0*ct_j*yhat*sc2)
1094     duduz_i(3) = duduz_i(3) + sw*pref*ri3 &
1095     *(uz_j(3) - 3.0d0*ct_j*zhat*sc2)
1096 chrisfen 2296
1097 chrisfen 2325 duduz_j(1) = duduz_j(1) + sw*pref*ri3 &
1098     *(uz_i(1) - 3.0d0*ct_i*xhat*sc2)
1099     duduz_j(2) = duduz_j(2) + sw*pref*ri3 &
1100     *(uz_i(2) - 3.0d0*ct_i*yhat*sc2)
1101     duduz_j(3) = duduz_j(3) + sw*pref*ri3 &
1102     *(uz_i(3) - 3.0d0*ct_i*zhat*sc2)
1103 chrisfen 2296 endif
1104 gezelter 2095 endif
1105     endif
1106 gezelter 2123
1107     if (i_is_Quadrupole) then
1108     if (j_is_Charge) then
1109 gezelter 2204
1110 gezelter 2123 ri2 = riji * riji
1111     ri3 = ri2 * riji
1112 gezelter 2124 ri4 = ri2 * ri2
1113 gezelter 2123 cx2 = cx_i * cx_i
1114     cy2 = cy_i * cy_i
1115     cz2 = cz_i * cz_i
1116 gezelter 2204
1117 chrisfen 2310 if (summationMethod .eq. UNDAMPED_WOLF) then
1118 chrisfen 2325 pref = pre14 * q_j / 3.0_dp
1119 chrisfen 2296 vterm1 = pref * ri3*( 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     vterm2 = pref * rcuti3*( qxx_i * (3.0_dp*cx2 - 1.0_dp) + &
1123     qyy_i * (3.0_dp*cy2 - 1.0_dp) + &
1124     qzz_i * (3.0_dp*cz2 - 1.0_dp) )
1125 chrisfen 2325 vpair = vpair + ( vterm1 - vterm2 )
1126     epot = epot + sw*( vterm1 - vterm2 )
1127 chrisfen 2296
1128 chrisfen 2325 dudx = dudx - sw*(5.0_dp*(vterm1*riji*xhat-vterm2*rcuti2*d(1))) +&
1129     sw*pref * ( (ri4 - rcuti4)*(qxx_i*(6.0_dp*cx_i*ux_i(1)) - &
1130 chrisfen 2296 qxx_i*2.0_dp*(xhat - rcuti*d(1))) + &
1131     (ri4 - rcuti4)*(qyy_i*(6.0_dp*cy_i*uy_i(1)) - &
1132     qyy_i*2.0_dp*(xhat - rcuti*d(1))) + &
1133     (ri4 - rcuti4)*(qzz_i*(6.0_dp*cz_i*uz_i(1)) - &
1134     qzz_i*2.0_dp*(xhat - rcuti*d(1))) )
1135 chrisfen 2325 dudy = dudy - sw*(5.0_dp*(vterm1*riji*yhat-vterm2*rcuti2*d(2))) +&
1136     sw*pref * ( (ri4 - rcuti4)*(qxx_i*(6.0_dp*cx_i*ux_i(2)) - &
1137 chrisfen 2296 qxx_i*2.0_dp*(yhat - rcuti*d(2))) + &
1138     (ri4 - rcuti4)*(qyy_i*(6.0_dp*cy_i*uy_i(2)) - &
1139     qyy_i*2.0_dp*(yhat - rcuti*d(2))) + &
1140     (ri4 - rcuti4)*(qzz_i*(6.0_dp*cz_i*uz_i(2)) - &
1141     qzz_i*2.0_dp*(yhat - rcuti*d(2))) )
1142 chrisfen 2325 dudz = dudz - sw*(5.0_dp*(vterm1*riji*zhat-vterm2*rcuti2*d(3))) +&
1143     sw*pref * ( (ri4 - rcuti4)*(qxx_i*(6.0_dp*cx_i*ux_i(3)) - &
1144 chrisfen 2296 qxx_i*2.0_dp*(zhat - rcuti*d(3))) + &
1145     (ri4 - rcuti4)*(qyy_i*(6.0_dp*cy_i*uy_i(3)) - &
1146     qyy_i*2.0_dp*(zhat - rcuti*d(3))) + &
1147     (ri4 - rcuti4)*(qzz_i*(6.0_dp*cz_i*uz_i(3)) - &
1148     qzz_i*2.0_dp*(zhat - rcuti*d(3))) )
1149    
1150 chrisfen 2325 dudux_i(1) = dudux_i(1) + sw*pref*(ri3*(qxx_i*6.0_dp*cx_i*xhat) -&
1151 chrisfen 2296 rcuti4*(qxx_i*6.0_dp*cx_i*d(1)))
1152 chrisfen 2325 dudux_i(2) = dudux_i(2) + sw*pref*(ri3*(qxx_i*6.0_dp*cx_i*yhat) -&
1153 chrisfen 2296 rcuti4*(qxx_i*6.0_dp*cx_i*d(2)))
1154 chrisfen 2325 dudux_i(3) = dudux_i(3) + sw*pref*(ri3*(qxx_i*6.0_dp*cx_i*zhat) -&
1155 chrisfen 2296 rcuti4*(qxx_i*6.0_dp*cx_i*d(3)))
1156    
1157 chrisfen 2325 duduy_i(1) = duduy_i(1) + sw*pref*(ri3*(qyy_i*6.0_dp*cy_i*xhat) -&
1158 chrisfen 2296 rcuti4*(qyy_i*6.0_dp*cx_i*d(1)))
1159 chrisfen 2325 duduy_i(2) = duduy_i(2) + sw*pref*(ri3*(qyy_i*6.0_dp*cy_i*yhat) -&
1160 chrisfen 2296 rcuti4*(qyy_i*6.0_dp*cx_i*d(2)))
1161 chrisfen 2325 duduy_i(3) = duduy_i(3) + sw*pref*(ri3*(qyy_i*6.0_dp*cy_i*zhat) -&
1162 chrisfen 2296 rcuti4*(qyy_i*6.0_dp*cx_i*d(3)))
1163    
1164 chrisfen 2325 duduz_i(1) = duduz_i(1) + sw*pref*(ri3*(qzz_i*6.0_dp*cz_i*xhat) -&
1165 chrisfen 2296 rcuti4*(qzz_i*6.0_dp*cx_i*d(1)))
1166 chrisfen 2325 duduz_i(2) = duduz_i(2) + sw*pref*(ri3*(qzz_i*6.0_dp*cz_i*yhat) -&
1167 chrisfen 2296 rcuti4*(qzz_i*6.0_dp*cx_i*d(2)))
1168 chrisfen 2325 duduz_i(3) = duduz_i(3) + sw*pref*(ri3*(qzz_i*6.0_dp*cz_i*zhat) -&
1169 chrisfen 2296 rcuti4*(qzz_i*6.0_dp*cx_i*d(3)))
1170 gezelter 2204
1171 chrisfen 2296 else
1172 chrisfen 2325 pref = pre14 * q_j / 3.0_dp
1173 chrisfen 2296 vterm = pref * ri3 * (qxx_i * (3.0_dp*cx2 - 1.0_dp) + &
1174     qyy_i * (3.0_dp*cy2 - 1.0_dp) + &
1175     qzz_i * (3.0_dp*cz2 - 1.0_dp))
1176 chrisfen 2325 vpair = vpair + vterm
1177     epot = epot + sw*vterm
1178 chrisfen 2296
1179 chrisfen 2325 dudx = dudx - 5.0_dp*sw*vterm*riji*xhat + sw*pref*ri4 * ( &
1180 chrisfen 2296 qxx_i*(6.0_dp*cx_i*ux_i(1) - 2.0_dp*xhat) + &
1181     qyy_i*(6.0_dp*cy_i*uy_i(1) - 2.0_dp*xhat) + &
1182     qzz_i*(6.0_dp*cz_i*uz_i(1) - 2.0_dp*xhat) )
1183 chrisfen 2325 dudy = dudy - 5.0_dp*sw*vterm*riji*yhat + sw*pref*ri4 * ( &
1184 chrisfen 2296 qxx_i*(6.0_dp*cx_i*ux_i(2) - 2.0_dp*yhat) + &
1185     qyy_i*(6.0_dp*cy_i*uy_i(2) - 2.0_dp*yhat) + &
1186     qzz_i*(6.0_dp*cz_i*uz_i(2) - 2.0_dp*yhat) )
1187 chrisfen 2325 dudz = dudz - 5.0_dp*sw*vterm*riji*zhat + sw*pref*ri4 * ( &
1188 chrisfen 2296 qxx_i*(6.0_dp*cx_i*ux_i(3) - 2.0_dp*zhat) + &
1189     qyy_i*(6.0_dp*cy_i*uy_i(3) - 2.0_dp*zhat) + &
1190     qzz_i*(6.0_dp*cz_i*uz_i(3) - 2.0_dp*zhat) )
1191    
1192 chrisfen 2325 dudux_i(1) = dudux_i(1) + sw*pref*ri3*(qxx_i*6.0_dp*cx_i*xhat)
1193     dudux_i(2) = dudux_i(2) + sw*pref*ri3*(qxx_i*6.0_dp*cx_i*yhat)
1194     dudux_i(3) = dudux_i(3) + sw*pref*ri3*(qxx_i*6.0_dp*cx_i*zhat)
1195 chrisfen 2296
1196 chrisfen 2325 duduy_i(1) = duduy_i(1) + sw*pref*ri3*(qyy_i*6.0_dp*cy_i*xhat)
1197     duduy_i(2) = duduy_i(2) + sw*pref*ri3*(qyy_i*6.0_dp*cy_i*yhat)
1198     duduy_i(3) = duduy_i(3) + sw*pref*ri3*(qyy_i*6.0_dp*cy_i*zhat)
1199 chrisfen 2296
1200 chrisfen 2325 duduz_i(1) = duduz_i(1) + sw*pref*ri3*(qzz_i*6.0_dp*cz_i*xhat)
1201     duduz_i(2) = duduz_i(2) + sw*pref*ri3*(qzz_i*6.0_dp*cz_i*yhat)
1202     duduz_i(3) = duduz_i(3) + sw*pref*ri3*(qzz_i*6.0_dp*cz_i*zhat)
1203 chrisfen 2296 endif
1204 gezelter 2123 endif
1205     endif
1206 gezelter 2204
1207    
1208 gezelter 2095 if (do_pot) then
1209     #ifdef IS_MPI
1210 chuckv 2355 pot_row(ELECTROSTATIC_POT,atom1) = pot_row(ELECTROSTATIC_POT,atom1) + 0.5d0*epot
1211     pot_col(ELECTROSTATIC_POT,atom2) = pot_col(ELECTROSTATIC_POT,atom2) + 0.5d0*epot
1212 gezelter 2095 #else
1213     pot = pot + epot
1214     #endif
1215     endif
1216 gezelter 2204
1217 gezelter 2095 #ifdef IS_MPI
1218     f_Row(1,atom1) = f_Row(1,atom1) + dudx
1219     f_Row(2,atom1) = f_Row(2,atom1) + dudy
1220     f_Row(3,atom1) = f_Row(3,atom1) + dudz
1221 gezelter 2204
1222 gezelter 2095 f_Col(1,atom2) = f_Col(1,atom2) - dudx
1223     f_Col(2,atom2) = f_Col(2,atom2) - dudy
1224     f_Col(3,atom2) = f_Col(3,atom2) - dudz
1225 gezelter 2204
1226 gezelter 2095 if (i_is_Dipole .or. i_is_Quadrupole) then
1227 gezelter 2123 t_Row(1,atom1)=t_Row(1,atom1) - uz_i(2)*duduz_i(3) + uz_i(3)*duduz_i(2)
1228     t_Row(2,atom1)=t_Row(2,atom1) - uz_i(3)*duduz_i(1) + uz_i(1)*duduz_i(3)
1229     t_Row(3,atom1)=t_Row(3,atom1) - uz_i(1)*duduz_i(2) + uz_i(2)*duduz_i(1)
1230 gezelter 2095 endif
1231 gezelter 2123 if (i_is_Quadrupole) then
1232     t_Row(1,atom1)=t_Row(1,atom1) - ux_i(2)*dudux_i(3) + ux_i(3)*dudux_i(2)
1233     t_Row(2,atom1)=t_Row(2,atom1) - ux_i(3)*dudux_i(1) + ux_i(1)*dudux_i(3)
1234     t_Row(3,atom1)=t_Row(3,atom1) - ux_i(1)*dudux_i(2) + ux_i(2)*dudux_i(1)
1235 gezelter 2095
1236 gezelter 2123 t_Row(1,atom1)=t_Row(1,atom1) - uy_i(2)*duduy_i(3) + uy_i(3)*duduy_i(2)
1237     t_Row(2,atom1)=t_Row(2,atom1) - uy_i(3)*duduy_i(1) + uy_i(1)*duduy_i(3)
1238     t_Row(3,atom1)=t_Row(3,atom1) - uy_i(1)*duduy_i(2) + uy_i(2)*duduy_i(1)
1239     endif
1240    
1241 gezelter 2095 if (j_is_Dipole .or. j_is_Quadrupole) then
1242 gezelter 2123 t_Col(1,atom2)=t_Col(1,atom2) - uz_j(2)*duduz_j(3) + uz_j(3)*duduz_j(2)
1243     t_Col(2,atom2)=t_Col(2,atom2) - uz_j(3)*duduz_j(1) + uz_j(1)*duduz_j(3)
1244     t_Col(3,atom2)=t_Col(3,atom2) - uz_j(1)*duduz_j(2) + uz_j(2)*duduz_j(1)
1245 gezelter 2095 endif
1246 gezelter 2123 if (j_is_Quadrupole) then
1247     t_Col(1,atom2)=t_Col(1,atom2) - ux_j(2)*dudux_j(3) + ux_j(3)*dudux_j(2)
1248     t_Col(2,atom2)=t_Col(2,atom2) - ux_j(3)*dudux_j(1) + ux_j(1)*dudux_j(3)
1249     t_Col(3,atom2)=t_Col(3,atom2) - ux_j(1)*dudux_j(2) + ux_j(2)*dudux_j(1)
1250 gezelter 2095
1251 gezelter 2123 t_Col(1,atom2)=t_Col(1,atom2) - uy_j(2)*duduy_j(3) + uy_j(3)*duduy_j(2)
1252     t_Col(2,atom2)=t_Col(2,atom2) - uy_j(3)*duduy_j(1) + uy_j(1)*duduy_j(3)
1253     t_Col(3,atom2)=t_Col(3,atom2) - uy_j(1)*duduy_j(2) + uy_j(2)*duduy_j(1)
1254     endif
1255    
1256 gezelter 2095 #else
1257     f(1,atom1) = f(1,atom1) + dudx
1258     f(2,atom1) = f(2,atom1) + dudy
1259     f(3,atom1) = f(3,atom1) + dudz
1260 gezelter 2204
1261 gezelter 2095 f(1,atom2) = f(1,atom2) - dudx
1262     f(2,atom2) = f(2,atom2) - dudy
1263     f(3,atom2) = f(3,atom2) - dudz
1264 gezelter 2204
1265 gezelter 2095 if (i_is_Dipole .or. i_is_Quadrupole) then
1266 gezelter 2123 t(1,atom1)=t(1,atom1) - uz_i(2)*duduz_i(3) + uz_i(3)*duduz_i(2)
1267     t(2,atom1)=t(2,atom1) - uz_i(3)*duduz_i(1) + uz_i(1)*duduz_i(3)
1268     t(3,atom1)=t(3,atom1) - uz_i(1)*duduz_i(2) + uz_i(2)*duduz_i(1)
1269 gezelter 2095 endif
1270 gezelter 2123 if (i_is_Quadrupole) then
1271     t(1,atom1)=t(1,atom1) - ux_i(2)*dudux_i(3) + ux_i(3)*dudux_i(2)
1272     t(2,atom1)=t(2,atom1) - ux_i(3)*dudux_i(1) + ux_i(1)*dudux_i(3)
1273     t(3,atom1)=t(3,atom1) - ux_i(1)*dudux_i(2) + ux_i(2)*dudux_i(1)
1274    
1275     t(1,atom1)=t(1,atom1) - uy_i(2)*duduy_i(3) + uy_i(3)*duduy_i(2)
1276     t(2,atom1)=t(2,atom1) - uy_i(3)*duduy_i(1) + uy_i(1)*duduy_i(3)
1277     t(3,atom1)=t(3,atom1) - uy_i(1)*duduy_i(2) + uy_i(2)*duduy_i(1)
1278     endif
1279    
1280 gezelter 2095 if (j_is_Dipole .or. j_is_Quadrupole) then
1281 gezelter 2123 t(1,atom2)=t(1,atom2) - uz_j(2)*duduz_j(3) + uz_j(3)*duduz_j(2)
1282     t(2,atom2)=t(2,atom2) - uz_j(3)*duduz_j(1) + uz_j(1)*duduz_j(3)
1283     t(3,atom2)=t(3,atom2) - uz_j(1)*duduz_j(2) + uz_j(2)*duduz_j(1)
1284 gezelter 2095 endif
1285 gezelter 2123 if (j_is_Quadrupole) then
1286     t(1,atom2)=t(1,atom2) - ux_j(2)*dudux_j(3) + ux_j(3)*dudux_j(2)
1287     t(2,atom2)=t(2,atom2) - ux_j(3)*dudux_j(1) + ux_j(1)*dudux_j(3)
1288     t(3,atom2)=t(3,atom2) - ux_j(1)*dudux_j(2) + ux_j(2)*dudux_j(1)
1289    
1290     t(1,atom2)=t(1,atom2) - uy_j(2)*duduy_j(3) + uy_j(3)*duduy_j(2)
1291     t(2,atom2)=t(2,atom2) - uy_j(3)*duduy_j(1) + uy_j(1)*duduy_j(3)
1292     t(3,atom2)=t(3,atom2) - uy_j(1)*duduy_j(2) + uy_j(2)*duduy_j(1)
1293     endif
1294    
1295 gezelter 2095 #endif
1296 gezelter 2204
1297 gezelter 2095 #ifdef IS_MPI
1298     id1 = AtomRowToGlobal(atom1)
1299     id2 = AtomColToGlobal(atom2)
1300     #else
1301     id1 = atom1
1302     id2 = atom2
1303     #endif
1304    
1305     if (molMembershipList(id1) .ne. molMembershipList(id2)) then
1306 gezelter 2204
1307 gezelter 2095 fpair(1) = fpair(1) + dudx
1308     fpair(2) = fpair(2) + dudy
1309     fpair(3) = fpair(3) + dudz
1310    
1311     endif
1312    
1313     return
1314     end subroutine doElectrostaticPair
1315 chuckv 2189
1316     subroutine destroyElectrostaticTypes()
1317    
1318 gezelter 2204 if(allocated(ElectrostaticMap)) deallocate(ElectrostaticMap)
1319    
1320 chuckv 2189 end subroutine destroyElectrostaticTypes
1321    
1322 chrisfen 2402 subroutine self_self(atom1, eFrame, mypot, t, do_pot)
1323 chrisfen 2394 logical, intent(in) :: do_pot
1324 chrisfen 2381 integer, intent(in) :: atom1
1325 chrisfen 2394 integer :: atid1
1326 chrisfen 2381 real(kind=dp), dimension(9,nLocal) :: eFrame
1327 chrisfen 2394 real(kind=dp), dimension(3,nLocal) :: t
1328 chrisfen 2402 real(kind=dp) :: mu1, c1
1329     real(kind=dp) :: preVal, epot, mypot
1330 chrisfen 2394 real(kind=dp) :: eix, eiy, eiz
1331 chrisfen 2381
1332 chrisfen 2394 ! this is a local only array, so we use the local atom type id's:
1333     atid1 = atid(atom1)
1334 chrisfen 2402
1335     if (.not.summationMethodChecked) then
1336     call checkSummationMethod()
1337     endif
1338 chrisfen 2394
1339 chrisfen 2402 if (summationMethod .eq. REACTION_FIELD) then
1340     if (ElectrostaticMap(atid1)%is_Dipole) then
1341     mu1 = getDipoleMoment(atid1)
1342    
1343     preVal = pre22 * preRF2 * mu1*mu1
1344     mypot = mypot - 0.5d0*preVal
1345    
1346     ! The self-correction term adds into the reaction field vector
1347    
1348     eix = preVal * eFrame(3,atom1)
1349     eiy = preVal * eFrame(6,atom1)
1350     eiz = preVal * eFrame(9,atom1)
1351    
1352     ! once again, this is self-self, so only the local arrays are needed
1353     ! even for MPI jobs:
1354    
1355     t(1,atom1)=t(1,atom1) - eFrame(6,atom1)*eiz + &
1356     eFrame(9,atom1)*eiy
1357     t(2,atom1)=t(2,atom1) - eFrame(9,atom1)*eix + &
1358     eFrame(3,atom1)*eiz
1359     t(3,atom1)=t(3,atom1) - eFrame(3,atom1)*eiy + &
1360     eFrame(6,atom1)*eix
1361    
1362     endif
1363    
1364     elseif (summationMethod .eq. UNDAMPED_WOLF) then
1365     if (ElectrostaticMap(atid1)%is_Charge) then
1366     c1 = getCharge(atid1)
1367    
1368     mypot = mypot - (rcuti * 0.5_dp * c1 * c1)
1369     endif
1370 chrisfen 2394
1371 chrisfen 2402 elseif (summationMethod .eq. DAMPED_WOLF) then
1372     if (ElectrostaticMap(atid1)%is_Charge) then
1373     c1 = getCharge(atid1)
1374    
1375     mypot = mypot - (constERFC * rcuti * 0.5_dp + &
1376     dampingAlpha*invRootPi) * c1 * c1
1377     endif
1378 chrisfen 2381 endif
1379 chrisfen 2394
1380 chrisfen 2381 return
1381 chrisfen 2402 end subroutine self_self
1382 chrisfen 2381
1383 chrisfen 2402 subroutine rf_self_excludes(atom1, atom2, sw, eFrame, d, rij, vpair, myPot, &
1384 chrisfen 2399 f, t, do_pot)
1385     logical, intent(in) :: do_pot
1386     integer, intent(in) :: atom1
1387     integer, intent(in) :: atom2
1388     logical :: i_is_Charge, j_is_Charge
1389     logical :: i_is_Dipole, j_is_Dipole
1390     integer :: atid1
1391     integer :: atid2
1392     real(kind=dp), intent(in) :: rij
1393     real(kind=dp), intent(in) :: sw
1394     real(kind=dp), intent(in), dimension(3) :: d
1395     real(kind=dp), intent(inout) :: vpair
1396     real(kind=dp), dimension(9,nLocal) :: eFrame
1397     real(kind=dp), dimension(3,nLocal) :: f
1398     real(kind=dp), dimension(3,nLocal) :: t
1399     real (kind = dp), dimension(3) :: duduz_i
1400     real (kind = dp), dimension(3) :: duduz_j
1401     real (kind = dp), dimension(3) :: uz_i
1402     real (kind = dp), dimension(3) :: uz_j
1403     real(kind=dp) :: q_i, q_j, mu_i, mu_j
1404     real(kind=dp) :: xhat, yhat, zhat
1405     real(kind=dp) :: ct_i, ct_j
1406     real(kind=dp) :: ri2, ri3, riji, vterm
1407 chrisfen 2402 real(kind=dp) :: pref, preVal, rfVal, myPot
1408 chrisfen 2399 real(kind=dp) :: dudx, dudy, dudz, dudr
1409    
1410 chrisfen 2402 if (.not.summationMethodChecked) then
1411     call checkSummationMethod()
1412 chrisfen 2399 endif
1413    
1414     dudx = 0.0d0
1415     dudy = 0.0d0
1416     dudz = 0.0d0
1417    
1418     riji = 1.0d0/rij
1419    
1420     xhat = d(1) * riji
1421     yhat = d(2) * riji
1422     zhat = d(3) * riji
1423    
1424     ! this is a local only array, so we use the local atom type id's:
1425     atid1 = atid(atom1)
1426     atid2 = atid(atom2)
1427     i_is_Charge = ElectrostaticMap(atid1)%is_Charge
1428     j_is_Charge = ElectrostaticMap(atid2)%is_Charge
1429     i_is_Dipole = ElectrostaticMap(atid1)%is_Dipole
1430     j_is_Dipole = ElectrostaticMap(atid2)%is_Dipole
1431    
1432     if (i_is_Charge.and.j_is_Charge) then
1433     q_i = ElectrostaticMap(atid1)%charge
1434     q_j = ElectrostaticMap(atid2)%charge
1435    
1436     preVal = pre11 * q_i * q_j
1437     rfVal = preRF*rij*rij
1438     vterm = preVal * rfVal
1439    
1440 chrisfen 2402 myPot = myPot + sw*vterm
1441    
1442 chrisfen 2399 dudr = sw*preVal * 2.0d0*rfVal*riji
1443 chrisfen 2402
1444 chrisfen 2399 dudx = dudx + dudr * xhat
1445     dudy = dudy + dudr * yhat
1446     dudz = dudz + dudr * zhat
1447 chrisfen 2402
1448 chrisfen 2399 elseif (i_is_Charge.and.j_is_Dipole) then
1449     q_i = ElectrostaticMap(atid1)%charge
1450     mu_j = ElectrostaticMap(atid2)%dipole_moment
1451     uz_j(1) = eFrame(3,atom2)
1452     uz_j(2) = eFrame(6,atom2)
1453     uz_j(3) = eFrame(9,atom2)
1454     ct_j = uz_j(1)*xhat + uz_j(2)*yhat + uz_j(3)*zhat
1455 chrisfen 2402
1456 chrisfen 2399 ri2 = riji * riji
1457     ri3 = ri2 * riji
1458    
1459     pref = pre12 * q_i * mu_j
1460     vterm = - pref * ct_j * ( ri2 - preRF2*rij )
1461 chrisfen 2402 myPot = myPot + sw*vterm
1462    
1463     dudx = dudx - sw*pref*( ri3*(uz_j(1)-3.0d0*ct_j*xhat) &
1464     - preRF2*uz_j(1) )
1465     dudy = dudy - sw*pref*( ri3*(uz_j(2)-3.0d0*ct_j*yhat) &
1466     - preRF2*uz_j(2) )
1467     dudz = dudz - sw*pref*( ri3*(uz_j(3)-3.0d0*ct_j*zhat) &
1468     - preRF2*uz_j(3) )
1469    
1470 chrisfen 2399 duduz_j(1) = duduz_j(1) - sw * pref * xhat * ( ri2 - preRF2*rij )
1471     duduz_j(2) = duduz_j(2) - sw * pref * yhat * ( ri2 - preRF2*rij )
1472     duduz_j(3) = duduz_j(3) - sw * pref * zhat * ( ri2 - preRF2*rij )
1473 chrisfen 2402
1474 chrisfen 2399 elseif (i_is_Dipole.and.j_is_Charge) then
1475     mu_i = ElectrostaticMap(atid1)%dipole_moment
1476     q_j = ElectrostaticMap(atid2)%charge
1477     uz_i(1) = eFrame(3,atom1)
1478     uz_i(2) = eFrame(6,atom1)
1479     uz_i(3) = eFrame(9,atom1)
1480     ct_i = uz_i(1)*xhat + uz_i(2)*yhat + uz_i(3)*zhat
1481 chrisfen 2402
1482 chrisfen 2399 ri2 = riji * riji
1483     ri3 = ri2 * riji
1484    
1485     pref = pre12 * q_j * mu_i
1486     vterm = pref * ct_i * ( ri2 - preRF2*rij )
1487 chrisfen 2402 myPot = myPot + sw*vterm
1488 chrisfen 2399
1489 chrisfen 2402 dudx = dudx + sw*pref*( ri3*(uz_i(1)-3.0d0*ct_i*xhat) &
1490     - preRF2*uz_i(1) )
1491     dudy = dudy + sw*pref*( ri3*(uz_i(2)-3.0d0*ct_i*yhat) &
1492     - preRF2*uz_i(2) )
1493     dudz = dudz + sw*pref*( ri3*(uz_i(3)-3.0d0*ct_i*zhat) &
1494     - preRF2*uz_i(3) )
1495 chrisfen 2399
1496     duduz_i(1) = duduz_i(1) + sw * pref * xhat * ( ri2 - preRF2*rij )
1497     duduz_i(2) = duduz_i(2) + sw * pref * yhat * ( ri2 - preRF2*rij )
1498     duduz_i(3) = duduz_i(3) + sw * pref * zhat * ( ri2 - preRF2*rij )
1499    
1500     endif
1501 chrisfen 2402
1502    
1503     ! accumulate the forces and torques resulting from the self term
1504 chrisfen 2399 f(1,atom1) = f(1,atom1) + dudx
1505     f(2,atom1) = f(2,atom1) + dudy
1506     f(3,atom1) = f(3,atom1) + dudz
1507    
1508     f(1,atom2) = f(1,atom2) - dudx
1509     f(2,atom2) = f(2,atom2) - dudy
1510     f(3,atom2) = f(3,atom2) - dudz
1511    
1512     if (i_is_Dipole) then
1513     t(1,atom1)=t(1,atom1) - uz_i(2)*duduz_i(3) + uz_i(3)*duduz_i(2)
1514     t(2,atom1)=t(2,atom1) - uz_i(3)*duduz_i(1) + uz_i(1)*duduz_i(3)
1515     t(3,atom1)=t(3,atom1) - uz_i(1)*duduz_i(2) + uz_i(2)*duduz_i(1)
1516     elseif (j_is_Dipole) then
1517     t(1,atom2)=t(1,atom2) - uz_j(2)*duduz_j(3) + uz_j(3)*duduz_j(2)
1518     t(2,atom2)=t(2,atom2) - uz_j(3)*duduz_j(1) + uz_j(1)*duduz_j(3)
1519     t(3,atom2)=t(3,atom2) - uz_j(1)*duduz_j(2) + uz_j(2)*duduz_j(1)
1520     endif
1521    
1522     return
1523     end subroutine rf_self_excludes
1524    
1525 gezelter 2095 end module electrostatic_module