ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-3.0/src/UseTheForce/DarkSide/electrostatic.F90
Revision: 2231
Committed: Wed May 18 18:31:40 2005 UTC (19 years, 2 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

# Content
1 !!
2 !! Copyright (c) 2005 The University of Notre Dame. All Rights Reserved.
3 !!
4 !! The University of Notre Dame grants you ("Licensee") a
5 !! non-exclusive, royalty free, license to use, modify and
6 !! redistribute this software in source and binary code form, provided
7 !! that the following conditions are met:
8 !!
9 !! 1. Acknowledgement of the program authors must be made in any
10 !! publication of scientific results based in part on use of the
11 !! program. An acceptable form of acknowledgement is citation of
12 !! the article in which the program was described (Matthew
13 !! A. Meineke, Charles F. Vardeman II, Teng Lin, Christopher
14 !! J. Fennell and J. Daniel Gezelter, "OOPSE: An Object-Oriented
15 !! Parallel Simulation Engine for Molecular Dynamics,"
16 !! J. Comput. Chem. 26, pp. 252-271 (2005))
17 !!
18 !! 2. Redistributions of source code must retain the above copyright
19 !! notice, this list of conditions and the following disclaimer.
20 !!
21 !! 3. Redistributions in binary form must reproduce the above copyright
22 !! notice, this list of conditions and the following disclaimer in the
23 !! documentation and/or other materials provided with the
24 !! distribution.
25 !!
26 !! This software is provided "AS IS," without a warranty of any
27 !! kind. All express or implied conditions, representations and
28 !! warranties, including any implied warranty of merchantability,
29 !! fitness for a particular purpose or non-infringement, are hereby
30 !! excluded. The University of Notre Dame and its licensors shall not
31 !! be liable for any damages suffered by licensee as a result of
32 !! using, modifying or distributing the software or its
33 !! derivatives. In no event will the University of Notre Dame or its
34 !! licensors be liable for any lost revenue, profit or data, or for
35 !! direct, indirect, special, consequential, incidental or punitive
36 !! damages, however caused and regardless of the theory of liability,
37 !! arising out of the use of or inability to use software, even if the
38 !! University of Notre Dame has been advised of the possibility of
39 !! such damages.
40 !!
41
42 module electrostatic_module
43
44 use force_globals
45 use definitions
46 use atype_module
47 use vector_class
48 use simulation
49 use status
50 #ifdef IS_MPI
51 use mpiSimulation
52 #endif
53 implicit none
54
55 PRIVATE
56
57 !! 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 real(kind=dp), parameter :: pre11 = 332.0637778_dp
61 !! 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
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 public :: pre22
80 public :: destroyElectrostaticTypes
81
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 logical :: is_Tap = .false.
89 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 is_SplitDipole, is_Quadrupole, is_Tap, status)
101
102 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 logical, intent(in) :: is_Tap
108 integer, intent(out) :: status
109 integer :: nAtypes, myATID, i, j
110
111 status = 0
112 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
113
114 !! 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
119 nAtypes = getSize(atypes)
120
121 if (nAtypes == 0) then
122 status = -1
123 return
124 end if
125
126 if (.not. allocated(ElectrostaticMap)) then
127 allocate(ElectrostaticMap(nAtypes))
128 endif
129
130 end if
131
132 if (myATID .gt. size(ElectrostaticMap)) then
133 status = -1
134 return
135 endif
136
137 ! 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 ElectrostaticMap(myATID)%is_Tap = is_Tap
145
146 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 endif
174
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
265 do i = 1, 3
266 ElectrostaticMap(myATID)%quadrupole_moments(i) = &
267 quadrupole_moments(i)
268 enddo
269
270 end subroutine setQuadrupoleMoments
271
272
273 function getCharge(atid) result (c)
274 integer, intent(in) :: atid
275 integer :: localError
276 real(kind=dp) :: c
277
278 if (.not.allocated(ElectrostaticMap)) then
279 call handleError("electrostatic", "no ElectrostaticMap was present before first call of getCharge!")
280 return
281 end if
282
283 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
288 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
296 if (.not.allocated(ElectrostaticMap)) then
297 call handleError("electrostatic", "no ElectrostaticMap was present before first call of getDipoleMoment!")
298 return
299 end if
300
301 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
306 dm = ElectrostaticMap(atid)%dipole_moment
307 end function getDipoleMoment
308
309 subroutine doElectrostaticPair(atom1, atom2, d, rij, r2, sw, &
310 vpair, fpair, pot, eFrame, f, t, do_pot, ebalance)
311
312 logical, intent(in) :: do_pot
313
314 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 real(kind=dp), intent(inout) :: ebalance
322
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
328 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
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 logical :: i_is_Tap, j_is_Tap
336 integer :: me1, me2, id1, id2
337 real (kind=dp) :: q_i, q_j, mu_i, mu_j, d_i, d_j
338 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 real (kind=dp) :: ct_i, ct_j, ct_ij, a1
344 real (kind=dp) :: riji, ri, ri2, ri3, ri4
345 real (kind=dp) :: pref, vterm, epot, dudr
346 real (kind=dp) :: xhat, yhat, zhat
347 real (kind=dp) :: dudx, dudy, dudz
348 real (kind=dp) :: scale, sc2, bigR, switcher, dswitcher
349
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 xhat = d(1) * riji
368 yhat = d(2) * riji
369 zhat = d(3) * riji
370
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 i_is_Tap = ElectrostaticMap(me1)%is_Tap
377
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 j_is_Tap = ElectrostaticMap(me2)%is_Tap
383
384 if (i_is_Charge) then
385 q_i = ElectrostaticMap(me1)%charge
386 endif
387
388 if (i_is_Dipole) then
389 mu_i = ElectrostaticMap(me1)%dipole_moment
390 #ifdef IS_MPI
391 uz_i(1) = eFrame_Row(3,atom1)
392 uz_i(2) = eFrame_Row(6,atom1)
393 uz_i(3) = eFrame_Row(9,atom1)
394 #else
395 uz_i(1) = eFrame(3,atom1)
396 uz_i(2) = eFrame(6,atom1)
397 uz_i(3) = eFrame(9,atom1)
398 #endif
399 ct_i = uz_i(1)*xhat + uz_i(2)*yhat + uz_i(3)*zhat
400
401 if (i_is_SplitDipole) then
402 d_i = ElectrostaticMap(me1)%split_dipole_distance
403 endif
404
405 endif
406
407 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 if (j_is_Charge) then
438 q_j = ElectrostaticMap(me2)%charge
439 endif
440
441 if (j_is_Dipole) then
442 mu_j = ElectrostaticMap(me2)%dipole_moment
443 #ifdef IS_MPI
444 uz_j(1) = eFrame_Col(3,atom2)
445 uz_j(2) = eFrame_Col(6,atom2)
446 uz_j(3) = eFrame_Col(9,atom2)
447 #else
448 uz_j(1) = eFrame(3,atom2)
449 uz_j(2) = eFrame(6,atom2)
450 uz_j(3) = eFrame(9,atom2)
451 #endif
452 ct_j = uz_j(1)*xhat + uz_j(2)*yhat + uz_j(3)*zhat
453
454 if (j_is_SplitDipole) then
455 d_j = ElectrostaticMap(me2)%split_dipole_distance
456 endif
457 endif
458
459 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
489 switcher = 1.0d0
490 dswitcher = 0.0d0
491 ebalance = 0.0d0
492 ! weaken the dipole interaction at close range for TAP water
493 ! if (j_is_Tap .and. i_is_Tap) then
494 ! call calc_switch(rij, mu_i, switcher, dswitcher)
495 ! endif
496
497 epot = 0.0_dp
498 dudx = 0.0_dp
499 dudy = 0.0_dp
500 dudz = 0.0_dp
501
502 dudux_i = 0.0_dp
503 duduy_i = 0.0_dp
504 duduz_i = 0.0_dp
505
506 dudux_j = 0.0_dp
507 duduy_j = 0.0_dp
508 duduz_j = 0.0_dp
509
510 if (i_is_Charge) then
511
512 if (j_is_Charge) then
513
514 vterm = pre11 * q_i * q_j * riji
515 vpair = vpair + vterm
516 epot = epot + sw*vterm
517
518 dudr = - sw * vterm * riji
519
520 dudx = dudx + dudr * xhat
521 dudy = dudy + dudr * yhat
522 dudz = dudz + dudr * zhat
523
524 endif
525
526 if (j_is_Dipole) then
527
528 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
537 ri2 = ri * ri
538 ri3 = ri2 * ri
539 sc2 = scale * scale
540
541 pref = pre12 * q_i * mu_j
542 vterm = - pref * ct_j * ri2 * scale
543 vpair = vpair + vterm
544 epot = epot + sw * vterm
545
546 !! 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
550 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
554 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
558 endif
559
560 if (j_is_Quadrupole) then
561 ri2 = riji * riji
562 ri3 = ri2 * riji
563 ri4 = ri2 * ri2
564 cx2 = cx_j * cx_j
565 cy2 = cy_j * cy_j
566 cz2 = cz_j * cz_j
567
568
569 pref = pre14 * q_i / 3.0_dp
570 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 dudx = dudx - 5.0_dp*sw*vterm*riji*xhat + pref * sw * ri4 * ( &
577 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 dudy = dudy - 5.0_dp*sw*vterm*riji*yhat + pref * sw * ri4 * ( &
581 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 dudz = dudz - 5.0_dp*sw*vterm*riji*zhat + pref * sw * ri4 * ( &
585 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
589 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 endif
603
604 if (i_is_Dipole) then
605
606 if (j_is_Charge) then
607
608 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
617 ri2 = ri * ri
618 ri3 = ri2 * ri
619 sc2 = scale * scale
620
621 pref = pre12 * q_j * mu_i
622 vterm = pref * ct_i * ri2 * scale
623 vpair = vpair + vterm
624 epot = epot + sw * vterm
625
626 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
630 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 endif
634
635 if (j_is_Dipole) then
636
637 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 ct_ij = uz_i(1)*uz_j(1) + uz_i(2)*uz_j(2) + uz_i(3)*uz_j(3)
657
658 ri2 = ri * ri
659 ri3 = ri2 * ri
660 ri4 = ri2 * ri2
661 sc2 = scale * scale
662
663 pref = pre22 * mu_i * mu_j
664 vterm = pref * ri3 * (ct_ij - 3.0d0 * ct_i * ct_j * sc2)
665 ebalance = vterm * (1.0d0 - switcher)
666 vpair = vpair + switcher * vterm
667 epot = epot + sw * switcher * vterm
668
669 a1 = 5.0d0 * ct_i * ct_j * sc2 - ct_ij
670
671 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
678 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
685 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 endif
692
693 endif
694
695 if (i_is_Quadrupole) then
696 if (j_is_Charge) then
697
698 ri2 = riji * riji
699 ri3 = ri2 * riji
700 ri4 = ri2 * ri2
701 cx2 = cx_i * cx_i
702 cy2 = cy_i * cy_i
703 cz2 = cz_i * cz_i
704
705 pref = pre14 * q_j / 3.0_dp
706 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
712 dudx = dudx - 5.0_dp*sw*vterm*riji*xhat + pref * sw * ri4 * ( &
713 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 dudy = dudy - 5.0_dp*sw*vterm*riji*yhat + pref * sw * ri4 * ( &
717 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 dudz = dudz - 5.0_dp*sw*vterm*riji*zhat + pref * sw * ri4 * ( &
721 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
725 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
729 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
733 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
739
740 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
749 #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
754 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
758 if (i_is_Dipole .or. i_is_Quadrupole) then
759 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 endif
763 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
768 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 if (j_is_Dipole .or. j_is_Quadrupole) then
774 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 endif
778 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
783 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 #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
793 f(1,atom2) = f(1,atom2) - dudx
794 f(2,atom2) = f(2,atom2) - dudy
795 f(3,atom2) = f(3,atom2) - dudz
796
797 if (i_is_Dipole .or. i_is_Quadrupole) then
798 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 endif
802 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 if (j_is_Dipole .or. j_is_Quadrupole) then
813 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 endif
817 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 #endif
828
829 #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
839 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
848 !! calculates the switching functions and their derivatives for a given
849 subroutine calc_switch(r, mu, scale, dscale)
850
851 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 ru = 3.75d0
858 mulow = 0.0d0 !3.3856d0 ! 1.84 * 1.84
859 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 subroutine destroyElectrostaticTypes()
878
879 if(allocated(ElectrostaticMap)) deallocate(ElectrostaticMap)
880
881 end subroutine destroyElectrostaticTypes
882
883 end module electrostatic_module