ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-4/src/UseTheForce/DarkSide/electrostatic.F90
Revision: 2231
Committed: Wed May 18 18:31:40 2005 UTC (19 years, 3 months ago) by chrisfen
File size: 30821 byte(s)
Log Message:
Modifications to temper the dipolar strength in the first solvation shell for tap

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 gezelter 2118 !! these prefactors convert the multipole interactions into kcal / mol
58     !! all were computed assuming distances are measured in angstroms
59     !! Charge-Charge, assuming charges are measured in electrons
60 gezelter 2095 real(kind=dp), parameter :: pre11 = 332.0637778_dp
61 gezelter 2118 !! Charge-Dipole, assuming charges are measured in electrons, and
62     !! dipoles are measured in debyes
63     real(kind=dp), parameter :: pre12 = 69.13373_dp
64     !! Dipole-Dipole, assuming dipoles are measured in debyes
65     real(kind=dp), parameter :: pre22 = 14.39325_dp
66     !! Charge-Quadrupole, assuming charges are measured in electrons, and
67     !! quadrupoles are measured in 10^-26 esu cm^2
68     !! This unit is also known affectionately as an esu centi-barn.
69     real(kind=dp), parameter :: pre14 = 69.13373_dp
70 gezelter 2095
71     public :: newElectrostaticType
72     public :: setCharge
73     public :: setDipoleMoment
74     public :: setSplitDipoleDistance
75     public :: setQuadrupoleMoments
76     public :: doElectrostaticPair
77     public :: getCharge
78     public :: getDipoleMoment
79 chrisfen 2129 public :: pre22
80 chuckv 2189 public :: destroyElectrostaticTypes
81 gezelter 2095
82     type :: Electrostatic
83     integer :: c_ident
84     logical :: is_Charge = .false.
85     logical :: is_Dipole = .false.
86     logical :: is_SplitDipole = .false.
87     logical :: is_Quadrupole = .false.
88 chrisfen 2229 logical :: is_Tap = .false.
89 gezelter 2095 real(kind=DP) :: charge = 0.0_DP
90     real(kind=DP) :: dipole_moment = 0.0_DP
91     real(kind=DP) :: split_dipole_distance = 0.0_DP
92     real(kind=DP), dimension(3) :: quadrupole_moments = 0.0_DP
93     end type Electrostatic
94    
95     type(Electrostatic), dimension(:), allocatable :: ElectrostaticMap
96    
97     contains
98    
99     subroutine newElectrostaticType(c_ident, is_Charge, is_Dipole, &
100 chrisfen 2229 is_SplitDipole, is_Quadrupole, is_Tap, status)
101 gezelter 2204
102 gezelter 2095 integer, intent(in) :: c_ident
103     logical, intent(in) :: is_Charge
104     logical, intent(in) :: is_Dipole
105     logical, intent(in) :: is_SplitDipole
106     logical, intent(in) :: is_Quadrupole
107 chrisfen 2229 logical, intent(in) :: is_Tap
108 gezelter 2095 integer, intent(out) :: status
109     integer :: nAtypes, myATID, i, j
110    
111     status = 0
112     myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
113 gezelter 2204
114 gezelter 2095 !! Be simple-minded and assume that we need an ElectrostaticMap that
115     !! is the same size as the total number of atom types
116    
117     if (.not.allocated(ElectrostaticMap)) then
118 gezelter 2204
119 gezelter 2095 nAtypes = getSize(atypes)
120 gezelter 2204
121 gezelter 2095 if (nAtypes == 0) then
122     status = -1
123     return
124     end if
125 gezelter 2204
126 gezelter 2095 if (.not. allocated(ElectrostaticMap)) then
127     allocate(ElectrostaticMap(nAtypes))
128     endif
129 gezelter 2204
130 gezelter 2095 end if
131    
132     if (myATID .gt. size(ElectrostaticMap)) then
133     status = -1
134     return
135     endif
136 gezelter 2204
137 gezelter 2095 ! set the values for ElectrostaticMap for this atom type:
138    
139     ElectrostaticMap(myATID)%c_ident = c_ident
140     ElectrostaticMap(myATID)%is_Charge = is_Charge
141     ElectrostaticMap(myATID)%is_Dipole = is_Dipole
142     ElectrostaticMap(myATID)%is_SplitDipole = is_SplitDipole
143     ElectrostaticMap(myATID)%is_Quadrupole = is_Quadrupole
144 chrisfen 2229 ElectrostaticMap(myATID)%is_Tap = is_Tap
145 gezelter 2204
146 gezelter 2095 end subroutine newElectrostaticType
147    
148     subroutine setCharge(c_ident, charge, status)
149     integer, intent(in) :: c_ident
150     real(kind=dp), intent(in) :: charge
151     integer, intent(out) :: status
152     integer :: myATID
153    
154     status = 0
155     myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
156    
157     if (.not.allocated(ElectrostaticMap)) then
158     call handleError("electrostatic", "no ElectrostaticMap was present before first call of setCharge!")
159     status = -1
160     return
161     end if
162    
163     if (myATID .gt. size(ElectrostaticMap)) then
164     call handleError("electrostatic", "ElectrostaticMap was found to be too small during setCharge!")
165     status = -1
166     return
167     endif
168    
169     if (.not.ElectrostaticMap(myATID)%is_Charge) then
170     call handleError("electrostatic", "Attempt to setCharge of an atom type that is not a charge!")
171     status = -1
172     return
173 gezelter 2204 endif
174 gezelter 2095
175     ElectrostaticMap(myATID)%charge = charge
176     end subroutine setCharge
177    
178     subroutine setDipoleMoment(c_ident, dipole_moment, status)
179     integer, intent(in) :: c_ident
180     real(kind=dp), intent(in) :: dipole_moment
181     integer, intent(out) :: status
182     integer :: myATID
183    
184     status = 0
185     myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
186    
187     if (.not.allocated(ElectrostaticMap)) then
188     call handleError("electrostatic", "no ElectrostaticMap was present before first call of setDipoleMoment!")
189     status = -1
190     return
191     end if
192    
193     if (myATID .gt. size(ElectrostaticMap)) then
194     call handleError("electrostatic", "ElectrostaticMap was found to be too small during setDipoleMoment!")
195     status = -1
196     return
197     endif
198    
199     if (.not.ElectrostaticMap(myATID)%is_Dipole) then
200     call handleError("electrostatic", "Attempt to setDipoleMoment of an atom type that is not a dipole!")
201     status = -1
202     return
203     endif
204    
205     ElectrostaticMap(myATID)%dipole_moment = dipole_moment
206     end subroutine setDipoleMoment
207    
208     subroutine setSplitDipoleDistance(c_ident, split_dipole_distance, status)
209     integer, intent(in) :: c_ident
210     real(kind=dp), intent(in) :: split_dipole_distance
211     integer, intent(out) :: status
212     integer :: myATID
213    
214     status = 0
215     myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
216    
217     if (.not.allocated(ElectrostaticMap)) then
218     call handleError("electrostatic", "no ElectrostaticMap was present before first call of setSplitDipoleDistance!")
219     status = -1
220     return
221     end if
222    
223     if (myATID .gt. size(ElectrostaticMap)) then
224     call handleError("electrostatic", "ElectrostaticMap was found to be too small during setSplitDipoleDistance!")
225     status = -1
226     return
227     endif
228    
229     if (.not.ElectrostaticMap(myATID)%is_SplitDipole) then
230     call handleError("electrostatic", "Attempt to setSplitDipoleDistance of an atom type that is not a splitDipole!")
231     status = -1
232     return
233     endif
234    
235     ElectrostaticMap(myATID)%split_dipole_distance = split_dipole_distance
236     end subroutine setSplitDipoleDistance
237    
238     subroutine setQuadrupoleMoments(c_ident, quadrupole_moments, status)
239     integer, intent(in) :: c_ident
240     real(kind=dp), intent(in), dimension(3) :: quadrupole_moments
241     integer, intent(out) :: status
242     integer :: myATID, i, j
243    
244     status = 0
245     myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
246    
247     if (.not.allocated(ElectrostaticMap)) then
248     call handleError("electrostatic", "no ElectrostaticMap was present before first call of setQuadrupoleMoments!")
249     status = -1
250     return
251     end if
252    
253     if (myATID .gt. size(ElectrostaticMap)) then
254     call handleError("electrostatic", "ElectrostaticMap was found to be too small during setQuadrupoleMoments!")
255     status = -1
256     return
257     endif
258    
259     if (.not.ElectrostaticMap(myATID)%is_Quadrupole) then
260     call handleError("electrostatic", "Attempt to setQuadrupoleMoments of an atom type that is not a quadrupole!")
261     status = -1
262     return
263     endif
264 gezelter 2204
265 gezelter 2095 do i = 1, 3
266 gezelter 2204 ElectrostaticMap(myATID)%quadrupole_moments(i) = &
267     quadrupole_moments(i)
268     enddo
269 gezelter 2095
270     end subroutine setQuadrupoleMoments
271    
272 gezelter 2204
273 gezelter 2095 function getCharge(atid) result (c)
274     integer, intent(in) :: atid
275     integer :: localError
276     real(kind=dp) :: c
277 gezelter 2204
278 gezelter 2095 if (.not.allocated(ElectrostaticMap)) then
279     call handleError("electrostatic", "no ElectrostaticMap was present before first call of getCharge!")
280     return
281     end if
282 gezelter 2204
283 gezelter 2095 if (.not.ElectrostaticMap(atid)%is_Charge) then
284     call handleError("electrostatic", "getCharge was called for an atom type that isn't a charge!")
285     return
286     endif
287 gezelter 2204
288 gezelter 2095 c = ElectrostaticMap(atid)%charge
289     end function getCharge
290    
291     function getDipoleMoment(atid) result (dm)
292     integer, intent(in) :: atid
293     integer :: localError
294     real(kind=dp) :: dm
295 gezelter 2204
296 gezelter 2095 if (.not.allocated(ElectrostaticMap)) then
297     call handleError("electrostatic", "no ElectrostaticMap was present before first call of getDipoleMoment!")
298     return
299     end if
300 gezelter 2204
301 gezelter 2095 if (.not.ElectrostaticMap(atid)%is_Dipole) then
302     call handleError("electrostatic", "getDipoleMoment was called for an atom type that isn't a dipole!")
303     return
304     endif
305 gezelter 2204
306 gezelter 2095 dm = ElectrostaticMap(atid)%dipole_moment
307     end function getDipoleMoment
308    
309     subroutine doElectrostaticPair(atom1, atom2, d, rij, r2, sw, &
310 chrisfen 2231 vpair, fpair, pot, eFrame, f, t, do_pot, ebalance)
311 gezelter 2204
312 gezelter 2095 logical, intent(in) :: do_pot
313 gezelter 2204
314 gezelter 2095 integer, intent(in) :: atom1, atom2
315     integer :: localError
316    
317     real(kind=dp), intent(in) :: rij, r2, sw
318     real(kind=dp), intent(in), dimension(3) :: d
319     real(kind=dp), intent(inout) :: vpair
320     real(kind=dp), intent(inout), dimension(3) :: fpair
321 chrisfen 2231 real(kind=dp), intent(inout) :: ebalance
322 gezelter 2095
323     real( kind = dp ) :: pot
324     real( kind = dp ), dimension(9,nLocal) :: eFrame
325     real( kind = dp ), dimension(3,nLocal) :: f
326     real( kind = dp ), dimension(3,nLocal) :: t
327 gezelter 2204
328 gezelter 2123 real (kind = dp), dimension(3) :: ux_i, uy_i, uz_i
329     real (kind = dp), dimension(3) :: ux_j, uy_j, uz_j
330     real (kind = dp), dimension(3) :: dudux_i, duduy_i, duduz_i
331     real (kind = dp), dimension(3) :: dudux_j, duduy_j, duduz_j
332 gezelter 2095
333     logical :: i_is_Charge, i_is_Dipole, i_is_SplitDipole, i_is_Quadrupole
334     logical :: j_is_Charge, j_is_Dipole, j_is_SplitDipole, j_is_Quadrupole
335 chrisfen 2229 logical :: i_is_Tap, j_is_Tap
336 gezelter 2095 integer :: me1, me2, id1, id2
337     real (kind=dp) :: q_i, q_j, mu_i, mu_j, d_i, d_j
338 gezelter 2123 real (kind=dp) :: qxx_i, qyy_i, qzz_i
339     real (kind=dp) :: qxx_j, qyy_j, qzz_j
340     real (kind=dp) :: cx_i, cy_i, cz_i
341     real (kind=dp) :: cx_j, cy_j, cz_j
342     real (kind=dp) :: cx2, cy2, cz2
343 gezelter 2095 real (kind=dp) :: ct_i, ct_j, ct_ij, a1
344 gezelter 2105 real (kind=dp) :: riji, ri, ri2, ri3, ri4
345 gezelter 2095 real (kind=dp) :: pref, vterm, epot, dudr
346 gezelter 2105 real (kind=dp) :: xhat, yhat, zhat
347 gezelter 2095 real (kind=dp) :: dudx, dudy, dudz
348 chrisfen 2229 real (kind=dp) :: scale, sc2, bigR, switcher, dswitcher
349 gezelter 2095
350     if (.not.allocated(ElectrostaticMap)) then
351     call handleError("electrostatic", "no ElectrostaticMap was present before first call of do_electrostatic_pair!")
352     return
353     end if
354    
355     #ifdef IS_MPI
356     me1 = atid_Row(atom1)
357     me2 = atid_Col(atom2)
358     #else
359     me1 = atid(atom1)
360     me2 = atid(atom2)
361     #endif
362    
363     !! some variables we'll need independent of electrostatic type:
364    
365     riji = 1.0d0 / rij
366    
367 gezelter 2105 xhat = d(1) * riji
368     yhat = d(2) * riji
369     zhat = d(3) * riji
370 gezelter 2095
371     !! logicals
372     i_is_Charge = ElectrostaticMap(me1)%is_Charge
373     i_is_Dipole = ElectrostaticMap(me1)%is_Dipole
374     i_is_SplitDipole = ElectrostaticMap(me1)%is_SplitDipole
375     i_is_Quadrupole = ElectrostaticMap(me1)%is_Quadrupole
376 chrisfen 2229 i_is_Tap = ElectrostaticMap(me1)%is_Tap
377 gezelter 2095
378     j_is_Charge = ElectrostaticMap(me2)%is_Charge
379     j_is_Dipole = ElectrostaticMap(me2)%is_Dipole
380     j_is_SplitDipole = ElectrostaticMap(me2)%is_SplitDipole
381     j_is_Quadrupole = ElectrostaticMap(me2)%is_Quadrupole
382 chrisfen 2229 j_is_Tap = ElectrostaticMap(me2)%is_Tap
383 gezelter 2095
384     if (i_is_Charge) then
385     q_i = ElectrostaticMap(me1)%charge
386     endif
387 gezelter 2204
388 gezelter 2095 if (i_is_Dipole) then
389     mu_i = ElectrostaticMap(me1)%dipole_moment
390     #ifdef IS_MPI
391 gezelter 2123 uz_i(1) = eFrame_Row(3,atom1)
392     uz_i(2) = eFrame_Row(6,atom1)
393     uz_i(3) = eFrame_Row(9,atom1)
394 gezelter 2095 #else
395 gezelter 2123 uz_i(1) = eFrame(3,atom1)
396     uz_i(2) = eFrame(6,atom1)
397     uz_i(3) = eFrame(9,atom1)
398 gezelter 2095 #endif
399 gezelter 2123 ct_i = uz_i(1)*xhat + uz_i(2)*yhat + uz_i(3)*zhat
400 gezelter 2095
401     if (i_is_SplitDipole) then
402     d_i = ElectrostaticMap(me1)%split_dipole_distance
403     endif
404 gezelter 2204
405 gezelter 2095 endif
406    
407 gezelter 2123 if (i_is_Quadrupole) then
408     qxx_i = ElectrostaticMap(me1)%quadrupole_moments(1)
409     qyy_i = ElectrostaticMap(me1)%quadrupole_moments(2)
410     qzz_i = ElectrostaticMap(me1)%quadrupole_moments(3)
411     #ifdef IS_MPI
412     ux_i(1) = eFrame_Row(1,atom1)
413     ux_i(2) = eFrame_Row(4,atom1)
414     ux_i(3) = eFrame_Row(7,atom1)
415     uy_i(1) = eFrame_Row(2,atom1)
416     uy_i(2) = eFrame_Row(5,atom1)
417     uy_i(3) = eFrame_Row(8,atom1)
418     uz_i(1) = eFrame_Row(3,atom1)
419     uz_i(2) = eFrame_Row(6,atom1)
420     uz_i(3) = eFrame_Row(9,atom1)
421     #else
422     ux_i(1) = eFrame(1,atom1)
423     ux_i(2) = eFrame(4,atom1)
424     ux_i(3) = eFrame(7,atom1)
425     uy_i(1) = eFrame(2,atom1)
426     uy_i(2) = eFrame(5,atom1)
427     uy_i(3) = eFrame(8,atom1)
428     uz_i(1) = eFrame(3,atom1)
429     uz_i(2) = eFrame(6,atom1)
430     uz_i(3) = eFrame(9,atom1)
431     #endif
432     cx_i = ux_i(1)*xhat + ux_i(2)*yhat + ux_i(3)*zhat
433     cy_i = uy_i(1)*xhat + uy_i(2)*yhat + uy_i(3)*zhat
434     cz_i = uz_i(1)*xhat + uz_i(2)*yhat + uz_i(3)*zhat
435     endif
436    
437 gezelter 2095 if (j_is_Charge) then
438     q_j = ElectrostaticMap(me2)%charge
439     endif
440 gezelter 2204
441 gezelter 2095 if (j_is_Dipole) then
442     mu_j = ElectrostaticMap(me2)%dipole_moment
443     #ifdef IS_MPI
444 gezelter 2123 uz_j(1) = eFrame_Col(3,atom2)
445     uz_j(2) = eFrame_Col(6,atom2)
446     uz_j(3) = eFrame_Col(9,atom2)
447 gezelter 2095 #else
448 gezelter 2123 uz_j(1) = eFrame(3,atom2)
449     uz_j(2) = eFrame(6,atom2)
450     uz_j(3) = eFrame(9,atom2)
451 gezelter 2095 #endif
452 chrisfen 2162 ct_j = uz_j(1)*xhat + uz_j(2)*yhat + uz_j(3)*zhat
453 gezelter 2095
454     if (j_is_SplitDipole) then
455     d_j = ElectrostaticMap(me2)%split_dipole_distance
456     endif
457     endif
458    
459 gezelter 2123 if (j_is_Quadrupole) then
460     qxx_j = ElectrostaticMap(me2)%quadrupole_moments(1)
461     qyy_j = ElectrostaticMap(me2)%quadrupole_moments(2)
462     qzz_j = ElectrostaticMap(me2)%quadrupole_moments(3)
463     #ifdef IS_MPI
464     ux_j(1) = eFrame_Col(1,atom2)
465     ux_j(2) = eFrame_Col(4,atom2)
466     ux_j(3) = eFrame_Col(7,atom2)
467     uy_j(1) = eFrame_Col(2,atom2)
468     uy_j(2) = eFrame_Col(5,atom2)
469     uy_j(3) = eFrame_Col(8,atom2)
470     uz_j(1) = eFrame_Col(3,atom2)
471     uz_j(2) = eFrame_Col(6,atom2)
472     uz_j(3) = eFrame_Col(9,atom2)
473     #else
474     ux_j(1) = eFrame(1,atom2)
475     ux_j(2) = eFrame(4,atom2)
476     ux_j(3) = eFrame(7,atom2)
477     uy_j(1) = eFrame(2,atom2)
478     uy_j(2) = eFrame(5,atom2)
479     uy_j(3) = eFrame(8,atom2)
480     uz_j(1) = eFrame(3,atom2)
481     uz_j(2) = eFrame(6,atom2)
482     uz_j(3) = eFrame(9,atom2)
483     #endif
484     cx_j = ux_j(1)*xhat + ux_j(2)*yhat + ux_j(3)*zhat
485     cy_j = uy_j(1)*xhat + uy_j(2)*yhat + uy_j(3)*zhat
486     cz_j = uz_j(1)*xhat + uz_j(2)*yhat + uz_j(3)*zhat
487     endif
488 chrisfen 2229
489     switcher = 1.0d0
490     dswitcher = 0.0d0
491 chrisfen 2231 ebalance = 0.0d0
492     ! weaken the dipole interaction at close range for TAP water
493 chrisfen 2229 ! if (j_is_Tap .and. i_is_Tap) then
494     ! call calc_switch(rij, mu_i, switcher, dswitcher)
495     ! endif
496 gezelter 2123
497 gezelter 2095 epot = 0.0_dp
498     dudx = 0.0_dp
499     dudy = 0.0_dp
500     dudz = 0.0_dp
501    
502 gezelter 2123 dudux_i = 0.0_dp
503     duduy_i = 0.0_dp
504     duduz_i = 0.0_dp
505 gezelter 2095
506 gezelter 2123 dudux_j = 0.0_dp
507     duduy_j = 0.0_dp
508     duduz_j = 0.0_dp
509 gezelter 2095
510     if (i_is_Charge) then
511    
512     if (j_is_Charge) then
513 gezelter 2204
514 gezelter 2095 vterm = pre11 * q_i * q_j * riji
515     vpair = vpair + vterm
516     epot = epot + sw*vterm
517    
518     dudr = - sw * vterm * riji
519    
520 chrisfen 2162 dudx = dudx + dudr * xhat
521     dudy = dudy + dudr * yhat
522     dudz = dudz + dudr * zhat
523 gezelter 2204
524 gezelter 2095 endif
525    
526     if (j_is_Dipole) then
527    
528 gezelter 2105 if (j_is_SplitDipole) then
529     BigR = sqrt(r2 + 0.25_dp * d_j * d_j)
530     ri = 1.0_dp / BigR
531     scale = rij * ri
532     else
533     ri = riji
534     scale = 1.0_dp
535     endif
536 gezelter 2095
537 gezelter 2105 ri2 = ri * ri
538     ri3 = ri2 * ri
539     sc2 = scale * scale
540 gezelter 2204
541 gezelter 2095 pref = pre12 * q_i * mu_j
542 chrisfen 2153 vterm = - pref * ct_j * ri2 * scale
543 gezelter 2095 vpair = vpair + vterm
544     epot = epot + sw * vterm
545    
546 gezelter 2105 !! this has a + sign in the () because the rij vector is
547     !! r_j - r_i and the charge-dipole potential takes the origin
548     !! as the point dipole, which is atom j in this case.
549 gezelter 2095
550 chrisfen 2153 dudx = dudx - pref * sw * ri3 * ( uz_j(1) - 3.0d0*ct_j*xhat*sc2)
551     dudy = dudy - pref * sw * ri3 * ( uz_j(2) - 3.0d0*ct_j*yhat*sc2)
552     dudz = dudz - pref * sw * ri3 * ( uz_j(3) - 3.0d0*ct_j*zhat*sc2)
553 gezelter 2105
554 gezelter 2123 duduz_j(1) = duduz_j(1) - pref * sw * ri2 * xhat * scale
555     duduz_j(2) = duduz_j(2) - pref * sw * ri2 * yhat * scale
556     duduz_j(3) = duduz_j(3) - pref * sw * ri2 * zhat * scale
557 gezelter 2204
558 gezelter 2095 endif
559 gezelter 2105
560 gezelter 2123 if (j_is_Quadrupole) then
561     ri2 = riji * riji
562     ri3 = ri2 * riji
563 gezelter 2124 ri4 = ri2 * ri2
564 gezelter 2123 cx2 = cx_j * cx_j
565     cy2 = cy_j * cy_j
566     cz2 = cz_j * cz_j
567    
568 gezelter 2127
569 chrisfen 2162 pref = pre14 * q_i / 3.0_dp
570 gezelter 2123 vterm = pref * ri3 * (qxx_j * (3.0_dp*cx2 - 1.0_dp) + &
571     qyy_j * (3.0_dp*cy2 - 1.0_dp) + &
572     qzz_j * (3.0_dp*cz2 - 1.0_dp))
573     vpair = vpair + vterm
574     epot = epot + sw * vterm
575    
576 chrisfen 2156 dudx = dudx - 5.0_dp*sw*vterm*riji*xhat + pref * sw * ri4 * ( &
577 gezelter 2123 qxx_j*(6.0_dp*cx_j*ux_j(1) - 2.0_dp*xhat) + &
578     qyy_j*(6.0_dp*cy_j*uy_j(1) - 2.0_dp*xhat) + &
579     qzz_j*(6.0_dp*cz_j*uz_j(1) - 2.0_dp*xhat) )
580 chrisfen 2156 dudy = dudy - 5.0_dp*sw*vterm*riji*yhat + pref * sw * ri4 * ( &
581 gezelter 2123 qxx_j*(6.0_dp*cx_j*ux_j(2) - 2.0_dp*yhat) + &
582     qyy_j*(6.0_dp*cy_j*uy_j(2) - 2.0_dp*yhat) + &
583     qzz_j*(6.0_dp*cz_j*uz_j(2) - 2.0_dp*yhat) )
584 chrisfen 2156 dudz = dudz - 5.0_dp*sw*vterm*riji*zhat + pref * sw * ri4 * ( &
585 gezelter 2123 qxx_j*(6.0_dp*cx_j*ux_j(3) - 2.0_dp*zhat) + &
586     qyy_j*(6.0_dp*cy_j*uy_j(3) - 2.0_dp*zhat) + &
587     qzz_j*(6.0_dp*cz_j*uz_j(3) - 2.0_dp*zhat) )
588 gezelter 2204
589 gezelter 2123 dudux_j(1) = dudux_j(1) + pref * sw * ri3 * (qxx_j*6.0_dp*cx_j*xhat)
590     dudux_j(2) = dudux_j(2) + pref * sw * ri3 * (qxx_j*6.0_dp*cx_j*yhat)
591     dudux_j(3) = dudux_j(3) + pref * sw * ri3 * (qxx_j*6.0_dp*cx_j*zhat)
592    
593     duduy_j(1) = duduy_j(1) + pref * sw * ri3 * (qyy_j*6.0_dp*cy_j*xhat)
594     duduy_j(2) = duduy_j(2) + pref * sw * ri3 * (qyy_j*6.0_dp*cy_j*yhat)
595     duduy_j(3) = duduy_j(3) + pref * sw * ri3 * (qyy_j*6.0_dp*cy_j*zhat)
596    
597     duduz_j(1) = duduz_j(1) + pref * sw * ri3 * (qzz_j*6.0_dp*cz_j*xhat)
598     duduz_j(2) = duduz_j(2) + pref * sw * ri3 * (qzz_j*6.0_dp*cz_j*yhat)
599     duduz_j(3) = duduz_j(3) + pref * sw * ri3 * (qzz_j*6.0_dp*cz_j*zhat)
600     endif
601    
602 gezelter 2095 endif
603 gezelter 2204
604 gezelter 2095 if (i_is_Dipole) then
605 gezelter 2204
606 gezelter 2095 if (j_is_Charge) then
607    
608 gezelter 2105 if (i_is_SplitDipole) then
609     BigR = sqrt(r2 + 0.25_dp * d_i * d_i)
610     ri = 1.0_dp / BigR
611     scale = rij * ri
612     else
613     ri = riji
614     scale = 1.0_dp
615     endif
616 gezelter 2095
617 gezelter 2105 ri2 = ri * ri
618     ri3 = ri2 * ri
619     sc2 = scale * scale
620 gezelter 2204
621 gezelter 2095 pref = pre12 * q_j * mu_i
622 gezelter 2105 vterm = pref * ct_i * ri2 * scale
623 gezelter 2095 vpair = vpair + vterm
624     epot = epot + sw * vterm
625    
626 gezelter 2123 dudx = dudx + pref * sw * ri3 * ( uz_i(1) - 3.0d0 * ct_i * xhat*sc2)
627     dudy = dudy + pref * sw * ri3 * ( uz_i(2) - 3.0d0 * ct_i * yhat*sc2)
628     dudz = dudz + pref * sw * ri3 * ( uz_i(3) - 3.0d0 * ct_i * zhat*sc2)
629 gezelter 2095
630 gezelter 2123 duduz_i(1) = duduz_i(1) + pref * sw * ri2 * xhat * scale
631     duduz_i(2) = duduz_i(2) + pref * sw * ri2 * yhat * scale
632     duduz_i(3) = duduz_i(3) + pref * sw * ri2 * zhat * scale
633 gezelter 2095 endif
634    
635     if (j_is_Dipole) then
636    
637 gezelter 2105 if (i_is_SplitDipole) then
638     if (j_is_SplitDipole) then
639     BigR = sqrt(r2 + 0.25_dp * d_i * d_i + 0.25_dp * d_j * d_j)
640     else
641     BigR = sqrt(r2 + 0.25_dp * d_i * d_i)
642     endif
643     ri = 1.0_dp / BigR
644     scale = rij * ri
645     else
646     if (j_is_SplitDipole) then
647     BigR = sqrt(r2 + 0.25_dp * d_j * d_j)
648     ri = 1.0_dp / BigR
649     scale = rij * ri
650     else
651     ri = riji
652     scale = 1.0_dp
653     endif
654     endif
655    
656 gezelter 2123 ct_ij = uz_i(1)*uz_j(1) + uz_i(2)*uz_j(2) + uz_i(3)*uz_j(3)
657 gezelter 2105
658     ri2 = ri * ri
659     ri3 = ri2 * ri
660 gezelter 2095 ri4 = ri2 * ri2
661 gezelter 2105 sc2 = scale * scale
662 gezelter 2095
663     pref = pre22 * mu_i * mu_j
664 gezelter 2105 vterm = pref * ri3 * (ct_ij - 3.0d0 * ct_i * ct_j * sc2)
665 chrisfen 2231 ebalance = vterm * (1.0d0 - switcher)
666     vpair = vpair + switcher * vterm
667     epot = epot + sw * switcher * vterm
668 gezelter 2204
669 gezelter 2105 a1 = 5.0d0 * ct_i * ct_j * sc2 - ct_ij
670 gezelter 2095
671 chrisfen 2229 dudx = dudx + switcher*pref*sw*3.0d0*ri4*scale &
672     *(a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1)) + vterm*dswitcher
673     dudy = dudy + switcher*pref*sw*3.0d0*ri4*scale &
674     *(a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2)) + vterm*dswitcher
675     dudz = dudz + switcher*pref*sw*3.0d0*ri4*scale &
676     *(a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3)) + vterm*dswitcher
677 gezelter 2095
678 chrisfen 2229 duduz_i(1) = duduz_i(1) + switcher*pref*sw*ri3 &
679     *(uz_j(1) - 3.0d0*ct_j*xhat*sc2)
680     duduz_i(2) = duduz_i(2) + switcher*pref*sw*ri3 &
681     *(uz_j(2) - 3.0d0*ct_j*yhat*sc2)
682     duduz_i(3) = duduz_i(3) + switcher*pref*sw*ri3 &
683     *(uz_j(3) - 3.0d0*ct_j*zhat*sc2)
684 gezelter 2095
685 chrisfen 2229 duduz_j(1) = duduz_j(1) + switcher*pref*sw*ri3 &
686     *(uz_i(1) - 3.0d0*ct_i*xhat*sc2)
687     duduz_j(2) = duduz_j(2) + switcher*pref*sw*ri3 &
688     *(uz_i(2) - 3.0d0*ct_i*yhat*sc2)
689     duduz_j(3) = duduz_j(3) + switcher*pref*sw*ri3 &
690     *(uz_i(3) - 3.0d0*ct_i*zhat*sc2)
691 gezelter 2095 endif
692    
693     endif
694 gezelter 2123
695     if (i_is_Quadrupole) then
696     if (j_is_Charge) then
697 gezelter 2204
698 gezelter 2123 ri2 = riji * riji
699     ri3 = ri2 * riji
700 gezelter 2124 ri4 = ri2 * ri2
701 gezelter 2123 cx2 = cx_i * cx_i
702     cy2 = cy_i * cy_i
703     cz2 = cz_i * cz_i
704 gezelter 2204
705 chrisfen 2162 pref = pre14 * q_j / 3.0_dp
706 gezelter 2123 vterm = pref * ri3 * (qxx_i * (3.0_dp*cx2 - 1.0_dp) + &
707     qyy_i * (3.0_dp*cy2 - 1.0_dp) + &
708     qzz_i * (3.0_dp*cz2 - 1.0_dp))
709     vpair = vpair + vterm
710     epot = epot + sw * vterm
711 gezelter 2204
712 chrisfen 2156 dudx = dudx - 5.0_dp*sw*vterm*riji*xhat + pref * sw * ri4 * ( &
713 gezelter 2123 qxx_i*(6.0_dp*cx_i*ux_i(1) - 2.0_dp*xhat) + &
714     qyy_i*(6.0_dp*cy_i*uy_i(1) - 2.0_dp*xhat) + &
715     qzz_i*(6.0_dp*cz_i*uz_i(1) - 2.0_dp*xhat) )
716 chrisfen 2156 dudy = dudy - 5.0_dp*sw*vterm*riji*yhat + pref * sw * ri4 * ( &
717 gezelter 2123 qxx_i*(6.0_dp*cx_i*ux_i(2) - 2.0_dp*yhat) + &
718     qyy_i*(6.0_dp*cy_i*uy_i(2) - 2.0_dp*yhat) + &
719     qzz_i*(6.0_dp*cz_i*uz_i(2) - 2.0_dp*yhat) )
720 chrisfen 2156 dudz = dudz - 5.0_dp*sw*vterm*riji*zhat + pref * sw * ri4 * ( &
721 gezelter 2123 qxx_i*(6.0_dp*cx_i*ux_i(3) - 2.0_dp*zhat) + &
722     qyy_i*(6.0_dp*cy_i*uy_i(3) - 2.0_dp*zhat) + &
723     qzz_i*(6.0_dp*cz_i*uz_i(3) - 2.0_dp*zhat) )
724 gezelter 2204
725 gezelter 2123 dudux_i(1) = dudux_i(1) + pref * sw * ri3 * (qxx_i*6.0_dp*cx_i*xhat)
726     dudux_i(2) = dudux_i(2) + pref * sw * ri3 * (qxx_i*6.0_dp*cx_i*yhat)
727     dudux_i(3) = dudux_i(3) + pref * sw * ri3 * (qxx_i*6.0_dp*cx_i*zhat)
728 gezelter 2204
729 gezelter 2123 duduy_i(1) = duduy_i(1) + pref * sw * ri3 * (qyy_i*6.0_dp*cy_i*xhat)
730     duduy_i(2) = duduy_i(2) + pref * sw * ri3 * (qyy_i*6.0_dp*cy_i*yhat)
731     duduy_i(3) = duduy_i(3) + pref * sw * ri3 * (qyy_i*6.0_dp*cy_i*zhat)
732 gezelter 2204
733 gezelter 2123 duduz_i(1) = duduz_i(1) + pref * sw * ri3 * (qzz_i*6.0_dp*cz_i*xhat)
734     duduz_i(2) = duduz_i(2) + pref * sw * ri3 * (qzz_i*6.0_dp*cz_i*yhat)
735     duduz_i(3) = duduz_i(3) + pref * sw * ri3 * (qzz_i*6.0_dp*cz_i*zhat)
736     endif
737     endif
738 gezelter 2204
739    
740 gezelter 2095 if (do_pot) then
741     #ifdef IS_MPI
742     pot_row(atom1) = pot_row(atom1) + 0.5d0*epot
743     pot_col(atom2) = pot_col(atom2) + 0.5d0*epot
744     #else
745     pot = pot + epot
746     #endif
747     endif
748 gezelter 2204
749 gezelter 2095 #ifdef IS_MPI
750     f_Row(1,atom1) = f_Row(1,atom1) + dudx
751     f_Row(2,atom1) = f_Row(2,atom1) + dudy
752     f_Row(3,atom1) = f_Row(3,atom1) + dudz
753 gezelter 2204
754 gezelter 2095 f_Col(1,atom2) = f_Col(1,atom2) - dudx
755     f_Col(2,atom2) = f_Col(2,atom2) - dudy
756     f_Col(3,atom2) = f_Col(3,atom2) - dudz
757 gezelter 2204
758 gezelter 2095 if (i_is_Dipole .or. i_is_Quadrupole) then
759 gezelter 2123 t_Row(1,atom1)=t_Row(1,atom1) - uz_i(2)*duduz_i(3) + uz_i(3)*duduz_i(2)
760     t_Row(2,atom1)=t_Row(2,atom1) - uz_i(3)*duduz_i(1) + uz_i(1)*duduz_i(3)
761     t_Row(3,atom1)=t_Row(3,atom1) - uz_i(1)*duduz_i(2) + uz_i(2)*duduz_i(1)
762 gezelter 2095 endif
763 gezelter 2123 if (i_is_Quadrupole) then
764     t_Row(1,atom1)=t_Row(1,atom1) - ux_i(2)*dudux_i(3) + ux_i(3)*dudux_i(2)
765     t_Row(2,atom1)=t_Row(2,atom1) - ux_i(3)*dudux_i(1) + ux_i(1)*dudux_i(3)
766     t_Row(3,atom1)=t_Row(3,atom1) - ux_i(1)*dudux_i(2) + ux_i(2)*dudux_i(1)
767 gezelter 2095
768 gezelter 2123 t_Row(1,atom1)=t_Row(1,atom1) - uy_i(2)*duduy_i(3) + uy_i(3)*duduy_i(2)
769     t_Row(2,atom1)=t_Row(2,atom1) - uy_i(3)*duduy_i(1) + uy_i(1)*duduy_i(3)
770     t_Row(3,atom1)=t_Row(3,atom1) - uy_i(1)*duduy_i(2) + uy_i(2)*duduy_i(1)
771     endif
772    
773 gezelter 2095 if (j_is_Dipole .or. j_is_Quadrupole) then
774 gezelter 2123 t_Col(1,atom2)=t_Col(1,atom2) - uz_j(2)*duduz_j(3) + uz_j(3)*duduz_j(2)
775     t_Col(2,atom2)=t_Col(2,atom2) - uz_j(3)*duduz_j(1) + uz_j(1)*duduz_j(3)
776     t_Col(3,atom2)=t_Col(3,atom2) - uz_j(1)*duduz_j(2) + uz_j(2)*duduz_j(1)
777 gezelter 2095 endif
778 gezelter 2123 if (j_is_Quadrupole) then
779     t_Col(1,atom2)=t_Col(1,atom2) - ux_j(2)*dudux_j(3) + ux_j(3)*dudux_j(2)
780     t_Col(2,atom2)=t_Col(2,atom2) - ux_j(3)*dudux_j(1) + ux_j(1)*dudux_j(3)
781     t_Col(3,atom2)=t_Col(3,atom2) - ux_j(1)*dudux_j(2) + ux_j(2)*dudux_j(1)
782 gezelter 2095
783 gezelter 2123 t_Col(1,atom2)=t_Col(1,atom2) - uy_j(2)*duduy_j(3) + uy_j(3)*duduy_j(2)
784     t_Col(2,atom2)=t_Col(2,atom2) - uy_j(3)*duduy_j(1) + uy_j(1)*duduy_j(3)
785     t_Col(3,atom2)=t_Col(3,atom2) - uy_j(1)*duduy_j(2) + uy_j(2)*duduy_j(1)
786     endif
787    
788 gezelter 2095 #else
789     f(1,atom1) = f(1,atom1) + dudx
790     f(2,atom1) = f(2,atom1) + dudy
791     f(3,atom1) = f(3,atom1) + dudz
792 gezelter 2204
793 gezelter 2095 f(1,atom2) = f(1,atom2) - dudx
794     f(2,atom2) = f(2,atom2) - dudy
795     f(3,atom2) = f(3,atom2) - dudz
796 gezelter 2204
797 gezelter 2095 if (i_is_Dipole .or. i_is_Quadrupole) then
798 gezelter 2123 t(1,atom1)=t(1,atom1) - uz_i(2)*duduz_i(3) + uz_i(3)*duduz_i(2)
799     t(2,atom1)=t(2,atom1) - uz_i(3)*duduz_i(1) + uz_i(1)*duduz_i(3)
800     t(3,atom1)=t(3,atom1) - uz_i(1)*duduz_i(2) + uz_i(2)*duduz_i(1)
801 gezelter 2095 endif
802 gezelter 2123 if (i_is_Quadrupole) then
803     t(1,atom1)=t(1,atom1) - ux_i(2)*dudux_i(3) + ux_i(3)*dudux_i(2)
804     t(2,atom1)=t(2,atom1) - ux_i(3)*dudux_i(1) + ux_i(1)*dudux_i(3)
805     t(3,atom1)=t(3,atom1) - ux_i(1)*dudux_i(2) + ux_i(2)*dudux_i(1)
806    
807     t(1,atom1)=t(1,atom1) - uy_i(2)*duduy_i(3) + uy_i(3)*duduy_i(2)
808     t(2,atom1)=t(2,atom1) - uy_i(3)*duduy_i(1) + uy_i(1)*duduy_i(3)
809     t(3,atom1)=t(3,atom1) - uy_i(1)*duduy_i(2) + uy_i(2)*duduy_i(1)
810     endif
811    
812 gezelter 2095 if (j_is_Dipole .or. j_is_Quadrupole) then
813 gezelter 2123 t(1,atom2)=t(1,atom2) - uz_j(2)*duduz_j(3) + uz_j(3)*duduz_j(2)
814     t(2,atom2)=t(2,atom2) - uz_j(3)*duduz_j(1) + uz_j(1)*duduz_j(3)
815     t(3,atom2)=t(3,atom2) - uz_j(1)*duduz_j(2) + uz_j(2)*duduz_j(1)
816 gezelter 2095 endif
817 gezelter 2123 if (j_is_Quadrupole) then
818     t(1,atom2)=t(1,atom2) - ux_j(2)*dudux_j(3) + ux_j(3)*dudux_j(2)
819     t(2,atom2)=t(2,atom2) - ux_j(3)*dudux_j(1) + ux_j(1)*dudux_j(3)
820     t(3,atom2)=t(3,atom2) - ux_j(1)*dudux_j(2) + ux_j(2)*dudux_j(1)
821    
822     t(1,atom2)=t(1,atom2) - uy_j(2)*duduy_j(3) + uy_j(3)*duduy_j(2)
823     t(2,atom2)=t(2,atom2) - uy_j(3)*duduy_j(1) + uy_j(1)*duduy_j(3)
824     t(3,atom2)=t(3,atom2) - uy_j(1)*duduy_j(2) + uy_j(2)*duduy_j(1)
825     endif
826    
827 gezelter 2095 #endif
828 gezelter 2204
829 gezelter 2095 #ifdef IS_MPI
830     id1 = AtomRowToGlobal(atom1)
831     id2 = AtomColToGlobal(atom2)
832     #else
833     id1 = atom1
834     id2 = atom2
835     #endif
836    
837     if (molMembershipList(id1) .ne. molMembershipList(id2)) then
838 gezelter 2204
839 gezelter 2095 fpair(1) = fpair(1) + dudx
840     fpair(2) = fpair(2) + dudy
841     fpair(3) = fpair(3) + dudz
842    
843     endif
844    
845     return
846     end subroutine doElectrostaticPair
847 chuckv 2189
848 chrisfen 2229 !! calculates the switching functions and their derivatives for a given
849     subroutine calc_switch(r, mu, scale, dscale)
850 gezelter 2204
851 chrisfen 2229 real (kind=dp), intent(in) :: r, mu
852     real (kind=dp), intent(inout) :: scale, dscale
853     real (kind=dp) :: rl, ru, mulow, minRatio, temp, scaleVal
854    
855     ! distances must be in angstroms
856     rl = 2.75d0
857 chrisfen 2231 ru = 3.75d0
858     mulow = 0.0d0 !3.3856d0 ! 1.84 * 1.84
859 chrisfen 2229 minRatio = mulow / (mu*mu)
860     scaleVal = 1.0d0 - minRatio
861    
862     if (r.lt.rl) then
863     scale = minRatio
864     dscale = 0.0d0
865     elseif (r.gt.ru) then
866     scale = 1.0d0
867     dscale = 0.0d0
868     else
869     scale = 1.0d0 - scaleVal*((ru + 2.0d0*r - 3.0d0*rl) * (ru-r)**2) &
870     / ((ru - rl)**3)
871     dscale = -scaleVal * 6.0d0 * (r-ru)*(r-rl)/((ru - rl)**3)
872     endif
873    
874     return
875     end subroutine calc_switch
876    
877 chuckv 2189 subroutine destroyElectrostaticTypes()
878    
879 gezelter 2204 if(allocated(ElectrostaticMap)) deallocate(ElectrostaticMap)
880    
881 chuckv 2189 end subroutine destroyElectrostaticTypes
882    
883 gezelter 2095 end module electrostatic_module