ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-3.0/src/UseTheForce/DarkSide/electrostatic.F90
Revision: 2310
Committed: Mon Sep 19 23:21:46 2005 UTC (18 years, 9 months ago) by chrisfen
File size: 45077 byte(s)
Log Message:
Fixed bugs in reaction field, now it appears as though it really is working...

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 #define __FORTRAN90
58 #include "UseTheForce/DarkSide/fElectrostaticSummationMethod.h"
59
60 !! these prefactors convert the multipole interactions into kcal / mol
61 !! all were computed assuming distances are measured in angstroms
62 !! Charge-Charge, assuming charges are measured in electrons
63 real(kind=dp), parameter :: pre11 = 332.0637778_dp
64 !! Charge-Dipole, assuming charges are measured in electrons, and
65 !! dipoles are measured in debyes
66 real(kind=dp), parameter :: pre12 = 69.13373_dp
67 !! Dipole-Dipole, assuming dipoles are measured in debyes
68 real(kind=dp), parameter :: pre22 = 14.39325_dp
69 !! Charge-Quadrupole, assuming charges are measured in electrons, and
70 !! quadrupoles are measured in 10^-26 esu cm^2
71 !! This unit is also known affectionately as an esu centi-barn.
72 real(kind=dp), parameter :: pre14 = 69.13373_dp
73
74 !! variables to handle different summation methods for long-range electrostatics:
75 integer, save :: summationMethod = NONE
76 logical, save :: summationMethodChecked = .false.
77 real(kind=DP), save :: defaultCutoff = 0.0_DP
78 logical, save :: haveDefaultCutoff = .false.
79 real(kind=DP), save :: dampingAlpha = 0.0_DP
80 logical, save :: haveDampingAlpha = .false.
81 real(kind=DP), save :: dielectric = 0.0_DP
82 logical, save :: haveDielectric = .false.
83 real(kind=DP), save :: constERFC = 0.0_DP
84 real(kind=DP), save :: constEXP = 0.0_DP
85 logical, save :: haveDWAconstants = .false.
86 real(kind=dp), save :: rcuti = 0.0_dp
87 real(kind=dp), save :: rcuti2 = 0.0_dp
88 real(kind=dp), save :: rcuti3 = 0.0_dp
89 real(kind=dp), save :: rcuti4 = 0.0_dp
90
91
92 public :: setElectrostaticSummationMethod
93 public :: setElectrostaticCutoffRadius
94 public :: setDampedWolfAlpha
95 public :: setReactionFieldDielectric
96 public :: newElectrostaticType
97 public :: setCharge
98 public :: setDipoleMoment
99 public :: setSplitDipoleDistance
100 public :: setQuadrupoleMoments
101 public :: doElectrostaticPair
102 public :: getCharge
103 public :: getDipoleMoment
104 public :: pre22
105 public :: destroyElectrostaticTypes
106
107 type :: Electrostatic
108 integer :: c_ident
109 logical :: is_Charge = .false.
110 logical :: is_Dipole = .false.
111 logical :: is_SplitDipole = .false.
112 logical :: is_Quadrupole = .false.
113 logical :: is_Tap = .false.
114 real(kind=DP) :: charge = 0.0_DP
115 real(kind=DP) :: dipole_moment = 0.0_DP
116 real(kind=DP) :: split_dipole_distance = 0.0_DP
117 real(kind=DP), dimension(3) :: quadrupole_moments = 0.0_DP
118 end type Electrostatic
119
120 type(Electrostatic), dimension(:), allocatable :: ElectrostaticMap
121
122 contains
123
124 subroutine setElectrostaticSummationMethod(the_ESM)
125 integer, intent(in) :: the_ESM
126
127 if ((the_ESM .le. 0) .or. (the_ESM .gt. REACTION_FIELD)) then
128 call handleError("setElectrostaticSummationMethod", "Unsupported Summation Method")
129 endif
130
131 summationMethod = the_ESM
132 end subroutine setElectrostaticSummationMethod
133
134 subroutine setElectrostaticCutoffRadius(thisRcut)
135 real(kind=dp), intent(in) :: thisRcut
136 defaultCutoff = thisRcut
137 haveDefaultCutoff = .true.
138 end subroutine setElectrostaticCutoffRadius
139
140 subroutine setDampedWolfAlpha(thisAlpha)
141 real(kind=dp), intent(in) :: thisAlpha
142 dampingAlpha = thisAlpha
143 haveDampingAlpha = .true.
144 end subroutine setDampedWolfAlpha
145
146 subroutine setReactionFieldDielectric(thisDielectric)
147 real(kind=dp), intent(in) :: thisDielectric
148 dielectric = thisDielectric
149 haveDielectric = .true.
150 end subroutine setReactionFieldDielectric
151
152 subroutine newElectrostaticType(c_ident, is_Charge, is_Dipole, &
153 is_SplitDipole, is_Quadrupole, is_Tap, status)
154
155 integer, intent(in) :: c_ident
156 logical, intent(in) :: is_Charge
157 logical, intent(in) :: is_Dipole
158 logical, intent(in) :: is_SplitDipole
159 logical, intent(in) :: is_Quadrupole
160 logical, intent(in) :: is_Tap
161 integer, intent(out) :: status
162 integer :: nAtypes, myATID, i, j
163
164 status = 0
165 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
166
167 !! Be simple-minded and assume that we need an ElectrostaticMap that
168 !! is the same size as the total number of atom types
169
170 if (.not.allocated(ElectrostaticMap)) then
171
172 nAtypes = getSize(atypes)
173
174 if (nAtypes == 0) then
175 status = -1
176 return
177 end if
178
179 if (.not. allocated(ElectrostaticMap)) then
180 allocate(ElectrostaticMap(nAtypes))
181 endif
182
183 end if
184
185 if (myATID .gt. size(ElectrostaticMap)) then
186 status = -1
187 return
188 endif
189
190 ! set the values for ElectrostaticMap for this atom type:
191
192 ElectrostaticMap(myATID)%c_ident = c_ident
193 ElectrostaticMap(myATID)%is_Charge = is_Charge
194 ElectrostaticMap(myATID)%is_Dipole = is_Dipole
195 ElectrostaticMap(myATID)%is_SplitDipole = is_SplitDipole
196 ElectrostaticMap(myATID)%is_Quadrupole = is_Quadrupole
197 ElectrostaticMap(myATID)%is_Tap = is_Tap
198
199 end subroutine newElectrostaticType
200
201 subroutine setCharge(c_ident, charge, status)
202 integer, intent(in) :: c_ident
203 real(kind=dp), intent(in) :: charge
204 integer, intent(out) :: status
205 integer :: myATID
206
207 status = 0
208 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
209
210 if (.not.allocated(ElectrostaticMap)) then
211 call handleError("electrostatic", "no ElectrostaticMap was present before first call of setCharge!")
212 status = -1
213 return
214 end if
215
216 if (myATID .gt. size(ElectrostaticMap)) then
217 call handleError("electrostatic", "ElectrostaticMap was found to be too small during setCharge!")
218 status = -1
219 return
220 endif
221
222 if (.not.ElectrostaticMap(myATID)%is_Charge) then
223 call handleError("electrostatic", "Attempt to setCharge of an atom type that is not a charge!")
224 status = -1
225 return
226 endif
227
228 ElectrostaticMap(myATID)%charge = charge
229 end subroutine setCharge
230
231 subroutine setDipoleMoment(c_ident, dipole_moment, status)
232 integer, intent(in) :: c_ident
233 real(kind=dp), intent(in) :: dipole_moment
234 integer, intent(out) :: status
235 integer :: myATID
236
237 status = 0
238 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
239
240 if (.not.allocated(ElectrostaticMap)) then
241 call handleError("electrostatic", "no ElectrostaticMap was present before first call of setDipoleMoment!")
242 status = -1
243 return
244 end if
245
246 if (myATID .gt. size(ElectrostaticMap)) then
247 call handleError("electrostatic", "ElectrostaticMap was found to be too small during setDipoleMoment!")
248 status = -1
249 return
250 endif
251
252 if (.not.ElectrostaticMap(myATID)%is_Dipole) then
253 call handleError("electrostatic", "Attempt to setDipoleMoment of an atom type that is not a dipole!")
254 status = -1
255 return
256 endif
257
258 ElectrostaticMap(myATID)%dipole_moment = dipole_moment
259 end subroutine setDipoleMoment
260
261 subroutine setSplitDipoleDistance(c_ident, split_dipole_distance, status)
262 integer, intent(in) :: c_ident
263 real(kind=dp), intent(in) :: split_dipole_distance
264 integer, intent(out) :: status
265 integer :: myATID
266
267 status = 0
268 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
269
270 if (.not.allocated(ElectrostaticMap)) then
271 call handleError("electrostatic", "no ElectrostaticMap was present before first call of setSplitDipoleDistance!")
272 status = -1
273 return
274 end if
275
276 if (myATID .gt. size(ElectrostaticMap)) then
277 call handleError("electrostatic", "ElectrostaticMap was found to be too small during setSplitDipoleDistance!")
278 status = -1
279 return
280 endif
281
282 if (.not.ElectrostaticMap(myATID)%is_SplitDipole) then
283 call handleError("electrostatic", "Attempt to setSplitDipoleDistance of an atom type that is not a splitDipole!")
284 status = -1
285 return
286 endif
287
288 ElectrostaticMap(myATID)%split_dipole_distance = split_dipole_distance
289 end subroutine setSplitDipoleDistance
290
291 subroutine setQuadrupoleMoments(c_ident, quadrupole_moments, status)
292 integer, intent(in) :: c_ident
293 real(kind=dp), intent(in), dimension(3) :: quadrupole_moments
294 integer, intent(out) :: status
295 integer :: myATID, i, j
296
297 status = 0
298 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
299
300 if (.not.allocated(ElectrostaticMap)) then
301 call handleError("electrostatic", "no ElectrostaticMap was present before first call of setQuadrupoleMoments!")
302 status = -1
303 return
304 end if
305
306 if (myATID .gt. size(ElectrostaticMap)) then
307 call handleError("electrostatic", "ElectrostaticMap was found to be too small during setQuadrupoleMoments!")
308 status = -1
309 return
310 endif
311
312 if (.not.ElectrostaticMap(myATID)%is_Quadrupole) then
313 call handleError("electrostatic", "Attempt to setQuadrupoleMoments of an atom type that is not a quadrupole!")
314 status = -1
315 return
316 endif
317
318 do i = 1, 3
319 ElectrostaticMap(myATID)%quadrupole_moments(i) = &
320 quadrupole_moments(i)
321 enddo
322
323 end subroutine setQuadrupoleMoments
324
325
326 function getCharge(atid) result (c)
327 integer, intent(in) :: atid
328 integer :: localError
329 real(kind=dp) :: c
330
331 if (.not.allocated(ElectrostaticMap)) then
332 call handleError("electrostatic", "no ElectrostaticMap was present before first call of getCharge!")
333 return
334 end if
335
336 if (.not.ElectrostaticMap(atid)%is_Charge) then
337 call handleError("electrostatic", "getCharge was called for an atom type that isn't a charge!")
338 return
339 endif
340
341 c = ElectrostaticMap(atid)%charge
342 end function getCharge
343
344 function getDipoleMoment(atid) result (dm)
345 integer, intent(in) :: atid
346 integer :: localError
347 real(kind=dp) :: dm
348
349 if (.not.allocated(ElectrostaticMap)) then
350 call handleError("electrostatic", "no ElectrostaticMap was present before first call of getDipoleMoment!")
351 return
352 end if
353
354 if (.not.ElectrostaticMap(atid)%is_Dipole) then
355 call handleError("electrostatic", "getDipoleMoment was called for an atom type that isn't a dipole!")
356 return
357 endif
358
359 dm = ElectrostaticMap(atid)%dipole_moment
360 end function getDipoleMoment
361
362 subroutine checkSummationMethod()
363
364 if (.not.haveDefaultCutoff) then
365 call handleError("checkSummationMethod", "no Default Cutoff set!")
366 endif
367
368 rcuti = 1.0d0 / defaultCutoff
369 rcuti2 = rcuti*rcuti
370 rcuti3 = rcuti2*rcuti
371 rcuti4 = rcuti2*rcuti2
372
373 if (summationMethod .eq. DAMPED_WOLF) then
374 if (.not.haveDWAconstants) then
375
376 if (.not.haveDampingAlpha) then
377 call handleError("checkSummationMethod", "no Damping Alpha set!")
378 endif
379
380 if (.not.haveDefaultCutoff) then
381 call handleError("checkSummationMethod", "no Default Cutoff set!")
382 endif
383
384 constEXP = exp(-dampingAlpha*dampingAlpha*defaultCutoff*defaultCutoff)
385 constERFC = erfc(dampingAlpha*defaultCutoff)
386
387 haveDWAconstants = .true.
388 endif
389 endif
390
391 if (summationMethod .eq. REACTION_FIELD) then
392 if (.not.haveDielectric) then
393 call handleError("checkSummationMethod", "no reaction field Dielectric set!")
394 endif
395 endif
396
397 summationMethodChecked = .true.
398 end subroutine checkSummationMethod
399
400
401
402 subroutine doElectrostaticPair(atom1, atom2, d, rij, r2, sw, &
403 vpair, fpair, pot, eFrame, f, t, do_pot)
404
405 logical, intent(in) :: do_pot
406
407 integer, intent(in) :: atom1, atom2
408 integer :: localError
409
410 real(kind=dp), intent(in) :: rij, r2, sw
411 real(kind=dp), intent(in), dimension(3) :: d
412 real(kind=dp), intent(inout) :: vpair
413 real(kind=dp), intent(inout), dimension(3) :: fpair
414
415 real( kind = dp ) :: pot, swi
416 real( kind = dp ), dimension(9,nLocal) :: eFrame
417 real( kind = dp ), dimension(3,nLocal) :: f
418 real( kind = dp ), dimension(3,nLocal) :: t
419
420 real (kind = dp), dimension(3) :: ux_i, uy_i, uz_i
421 real (kind = dp), dimension(3) :: ux_j, uy_j, uz_j
422 real (kind = dp), dimension(3) :: dudux_i, duduy_i, duduz_i
423 real (kind = dp), dimension(3) :: dudux_j, duduy_j, duduz_j
424
425 logical :: i_is_Charge, i_is_Dipole, i_is_SplitDipole, i_is_Quadrupole
426 logical :: j_is_Charge, j_is_Dipole, j_is_SplitDipole, j_is_Quadrupole
427 logical :: i_is_Tap, j_is_Tap
428 integer :: me1, me2, id1, id2
429 real (kind=dp) :: q_i, q_j, mu_i, mu_j, d_i, d_j
430 real (kind=dp) :: qxx_i, qyy_i, qzz_i
431 real (kind=dp) :: qxx_j, qyy_j, qzz_j
432 real (kind=dp) :: cx_i, cy_i, cz_i
433 real (kind=dp) :: cx_j, cy_j, cz_j
434 real (kind=dp) :: cx2, cy2, cz2
435 real (kind=dp) :: ct_i, ct_j, ct_ij, a1
436 real (kind=dp) :: riji, ri, ri2, ri3, ri4
437 real (kind=dp) :: pref, vterm, epot, dudr, vterm1, vterm2
438 real (kind=dp) :: xhat, yhat, zhat
439 real (kind=dp) :: dudx, dudy, dudz
440 real (kind=dp) :: scale, sc2, bigR, switcher, dswitcher
441
442 if (.not.allocated(ElectrostaticMap)) then
443 call handleError("electrostatic", "no ElectrostaticMap was present before first call of do_electrostatic_pair!")
444 return
445 end if
446
447 if (.not.summationMethodChecked) then
448 call checkSummationMethod()
449
450 endif
451
452
453 #ifdef IS_MPI
454 me1 = atid_Row(atom1)
455 me2 = atid_Col(atom2)
456 #else
457 me1 = atid(atom1)
458 me2 = atid(atom2)
459 #endif
460
461 !! some variables we'll need independent of electrostatic type:
462
463 riji = 1.0d0 / rij
464
465 xhat = d(1) * riji
466 yhat = d(2) * riji
467 zhat = d(3) * riji
468
469 swi = 1.0d0 / sw
470
471 !! logicals
472 i_is_Charge = ElectrostaticMap(me1)%is_Charge
473 i_is_Dipole = ElectrostaticMap(me1)%is_Dipole
474 i_is_SplitDipole = ElectrostaticMap(me1)%is_SplitDipole
475 i_is_Quadrupole = ElectrostaticMap(me1)%is_Quadrupole
476 i_is_Tap = ElectrostaticMap(me1)%is_Tap
477
478 j_is_Charge = ElectrostaticMap(me2)%is_Charge
479 j_is_Dipole = ElectrostaticMap(me2)%is_Dipole
480 j_is_SplitDipole = ElectrostaticMap(me2)%is_SplitDipole
481 j_is_Quadrupole = ElectrostaticMap(me2)%is_Quadrupole
482 j_is_Tap = ElectrostaticMap(me2)%is_Tap
483
484 if (i_is_Charge) then
485 q_i = ElectrostaticMap(me1)%charge
486 endif
487
488 if (i_is_Dipole) then
489 mu_i = ElectrostaticMap(me1)%dipole_moment
490 #ifdef IS_MPI
491 uz_i(1) = eFrame_Row(3,atom1)
492 uz_i(2) = eFrame_Row(6,atom1)
493 uz_i(3) = eFrame_Row(9,atom1)
494 #else
495 uz_i(1) = eFrame(3,atom1)
496 uz_i(2) = eFrame(6,atom1)
497 uz_i(3) = eFrame(9,atom1)
498 #endif
499 ct_i = uz_i(1)*xhat + uz_i(2)*yhat + uz_i(3)*zhat
500
501 if (i_is_SplitDipole) then
502 d_i = ElectrostaticMap(me1)%split_dipole_distance
503 endif
504
505 endif
506
507 if (i_is_Quadrupole) then
508 qxx_i = ElectrostaticMap(me1)%quadrupole_moments(1)
509 qyy_i = ElectrostaticMap(me1)%quadrupole_moments(2)
510 qzz_i = ElectrostaticMap(me1)%quadrupole_moments(3)
511 #ifdef IS_MPI
512 ux_i(1) = eFrame_Row(1,atom1)
513 ux_i(2) = eFrame_Row(4,atom1)
514 ux_i(3) = eFrame_Row(7,atom1)
515 uy_i(1) = eFrame_Row(2,atom1)
516 uy_i(2) = eFrame_Row(5,atom1)
517 uy_i(3) = eFrame_Row(8,atom1)
518 uz_i(1) = eFrame_Row(3,atom1)
519 uz_i(2) = eFrame_Row(6,atom1)
520 uz_i(3) = eFrame_Row(9,atom1)
521 #else
522 ux_i(1) = eFrame(1,atom1)
523 ux_i(2) = eFrame(4,atom1)
524 ux_i(3) = eFrame(7,atom1)
525 uy_i(1) = eFrame(2,atom1)
526 uy_i(2) = eFrame(5,atom1)
527 uy_i(3) = eFrame(8,atom1)
528 uz_i(1) = eFrame(3,atom1)
529 uz_i(2) = eFrame(6,atom1)
530 uz_i(3) = eFrame(9,atom1)
531 #endif
532 cx_i = ux_i(1)*xhat + ux_i(2)*yhat + ux_i(3)*zhat
533 cy_i = uy_i(1)*xhat + uy_i(2)*yhat + uy_i(3)*zhat
534 cz_i = uz_i(1)*xhat + uz_i(2)*yhat + uz_i(3)*zhat
535 endif
536
537 if (j_is_Charge) then
538 q_j = ElectrostaticMap(me2)%charge
539 endif
540
541 if (j_is_Dipole) then
542 mu_j = ElectrostaticMap(me2)%dipole_moment
543 #ifdef IS_MPI
544 uz_j(1) = eFrame_Col(3,atom2)
545 uz_j(2) = eFrame_Col(6,atom2)
546 uz_j(3) = eFrame_Col(9,atom2)
547 #else
548 uz_j(1) = eFrame(3,atom2)
549 uz_j(2) = eFrame(6,atom2)
550 uz_j(3) = eFrame(9,atom2)
551 #endif
552 ct_j = uz_j(1)*xhat + uz_j(2)*yhat + uz_j(3)*zhat
553
554 if (j_is_SplitDipole) then
555 d_j = ElectrostaticMap(me2)%split_dipole_distance
556 endif
557 endif
558
559 if (j_is_Quadrupole) then
560 qxx_j = ElectrostaticMap(me2)%quadrupole_moments(1)
561 qyy_j = ElectrostaticMap(me2)%quadrupole_moments(2)
562 qzz_j = ElectrostaticMap(me2)%quadrupole_moments(3)
563 #ifdef IS_MPI
564 ux_j(1) = eFrame_Col(1,atom2)
565 ux_j(2) = eFrame_Col(4,atom2)
566 ux_j(3) = eFrame_Col(7,atom2)
567 uy_j(1) = eFrame_Col(2,atom2)
568 uy_j(2) = eFrame_Col(5,atom2)
569 uy_j(3) = eFrame_Col(8,atom2)
570 uz_j(1) = eFrame_Col(3,atom2)
571 uz_j(2) = eFrame_Col(6,atom2)
572 uz_j(3) = eFrame_Col(9,atom2)
573 #else
574 ux_j(1) = eFrame(1,atom2)
575 ux_j(2) = eFrame(4,atom2)
576 ux_j(3) = eFrame(7,atom2)
577 uy_j(1) = eFrame(2,atom2)
578 uy_j(2) = eFrame(5,atom2)
579 uy_j(3) = eFrame(8,atom2)
580 uz_j(1) = eFrame(3,atom2)
581 uz_j(2) = eFrame(6,atom2)
582 uz_j(3) = eFrame(9,atom2)
583 #endif
584 cx_j = ux_j(1)*xhat + ux_j(2)*yhat + ux_j(3)*zhat
585 cy_j = uy_j(1)*xhat + uy_j(2)*yhat + uy_j(3)*zhat
586 cz_j = uz_j(1)*xhat + uz_j(2)*yhat + uz_j(3)*zhat
587 endif
588
589 !!$ switcher = 1.0d0
590 !!$ dswitcher = 0.0d0
591 !!$ ebalance = 0.0d0
592 !!$ ! weaken the dipole interaction at close range for TAP water
593 !!$ if (j_is_Tap .and. i_is_Tap) then
594 !!$ call calc_switch(rij, mu_i, switcher, dswitcher)
595 !!$ endif
596
597 epot = 0.0_dp
598 dudx = 0.0_dp
599 dudy = 0.0_dp
600 dudz = 0.0_dp
601
602 dudux_i = 0.0_dp
603 duduy_i = 0.0_dp
604 duduz_i = 0.0_dp
605
606 dudux_j = 0.0_dp
607 duduy_j = 0.0_dp
608 duduz_j = 0.0_dp
609
610 if (i_is_Charge) then
611
612 if (j_is_Charge) then
613
614 if (summationMethod .eq. UNDAMPED_WOLF) then
615 vterm = pre11 * q_i * q_j * (riji - rcuti)
616
617 vpair = vpair + vterm
618 epot = epot + sw * vterm
619
620 dudr = - sw * pre11 * q_i * q_j * (riji*riji*riji - rcuti2*rcuti)
621
622 dudx = dudx + dudr * d(1)
623 dudy = dudy + dudr * d(2)
624 dudz = dudz + dudr * d(3)
625
626 else
627 vterm = pre11 * q_i * q_j * riji
628
629 vpair = vpair + vterm
630 epot = epot + sw * vterm
631
632 dudr = - sw * vterm * riji
633
634 dudx = dudx + dudr * xhat
635 dudy = dudy + dudr * yhat
636 dudz = dudz + dudr * zhat
637
638 endif
639
640 endif
641
642 if (j_is_Dipole) then
643
644 pref = sw * pre12 * q_i * mu_j
645
646 if (summationMethod .eq. UNDAMPED_WOLF) then
647 ri2 = riji * riji
648 ri3 = ri2 * riji
649
650 vterm = - pref * ct_j * (ri2 - rcuti2)
651 vpair = vpair + swi*vterm
652 epot = epot + vterm
653
654 !! this has a + sign in the () because the rij vector is
655 !! r_j - r_i and the charge-dipole potential takes the origin
656 !! as the point dipole, which is atom j in this case.
657
658 dudx = dudx - pref * ( ri3*( uz_j(1) - 3.0d0*ct_j*xhat) &
659 - rcuti3*( uz_j(1) - 3.0d0*ct_j*d(1)*rcuti ) )
660 dudy = dudy - pref * ( ri3*( uz_j(2) - 3.0d0*ct_j*yhat) &
661 - rcuti3*( uz_j(2) - 3.0d0*ct_j*d(2)*rcuti ) )
662 dudz = dudz - pref * ( ri3*( uz_j(3) - 3.0d0*ct_j*zhat) &
663 - rcuti3*( uz_j(3) - 3.0d0*ct_j*d(3)*rcuti ) )
664
665 duduz_j(1) = duduz_j(1) - pref*( ri2*xhat - d(1)*rcuti3 )
666 duduz_j(2) = duduz_j(2) - pref*( ri2*yhat - d(2)*rcuti3 )
667 duduz_j(3) = duduz_j(3) - pref*( ri2*zhat - d(3)*rcuti3 )
668
669 else
670 if (j_is_SplitDipole) then
671 BigR = sqrt(r2 + 0.25_dp * d_j * d_j)
672 ri = 1.0_dp / BigR
673 scale = rij * ri
674 else
675 ri = riji
676 scale = 1.0_dp
677 endif
678
679 ri2 = ri * ri
680 ri3 = ri2 * ri
681 sc2 = scale * scale
682
683 vterm = - pref * ct_j * ri2 * scale
684 vpair = vpair + swi * vterm
685 epot = epot + vterm
686
687 !! this has a + sign in the () because the rij vector is
688 !! r_j - r_i and the charge-dipole potential takes the origin
689 !! as the point dipole, which is atom j in this case.
690
691 dudx = dudx - pref * ri3 * ( uz_j(1) - 3.0d0*ct_j*xhat*sc2)
692 dudy = dudy - pref * ri3 * ( uz_j(2) - 3.0d0*ct_j*yhat*sc2)
693 dudz = dudz - pref * ri3 * ( uz_j(3) - 3.0d0*ct_j*zhat*sc2)
694
695 duduz_j(1) = duduz_j(1) - pref * ri2 * xhat * scale
696 duduz_j(2) = duduz_j(2) - pref * ri2 * yhat * scale
697 duduz_j(3) = duduz_j(3) - pref * ri2 * zhat * scale
698
699 endif
700 endif
701
702 if (j_is_Quadrupole) then
703 ri2 = riji * riji
704 ri3 = ri2 * riji
705 ri4 = ri2 * ri2
706 cx2 = cx_j * cx_j
707 cy2 = cy_j * cy_j
708 cz2 = cz_j * cz_j
709
710
711 pref = sw * pre14 * q_i / 3.0_dp
712
713 if (summationMethod .eq. UNDAMPED_WOLF) then
714 vterm1 = pref * ri3*( qxx_j * (3.0_dp*cx2 - 1.0_dp) + &
715 qyy_j * (3.0_dp*cy2 - 1.0_dp) + &
716 qzz_j * (3.0_dp*cz2 - 1.0_dp) )
717 vterm2 = pref * rcuti3*( qxx_j * (3.0_dp*cx2 - 1.0_dp) + &
718 qyy_j * (3.0_dp*cy2 - 1.0_dp) + &
719 qzz_j * (3.0_dp*cz2 - 1.0_dp) )
720 vpair = vpair + swi*( vterm1 - vterm2 )
721 epot = epot + ( vterm1 - vterm2 )
722
723 dudx = dudx - (5.0_dp * &
724 (vterm1*riji*xhat - vterm2*rcuti2*d(1))) + pref * ( &
725 (ri4 - rcuti4)*(qxx_j*(6.0_dp*cx_j*ux_j(1)) - &
726 qxx_j*2.0_dp*(xhat - rcuti*d(1))) + &
727 (ri4 - rcuti4)*(qyy_j*(6.0_dp*cy_j*uy_j(1)) - &
728 qyy_j*2.0_dp*(xhat - rcuti*d(1))) + &
729 (ri4 - rcuti4)*(qzz_j*(6.0_dp*cz_j*uz_j(1)) - &
730 qzz_j*2.0_dp*(xhat - rcuti*d(1))) )
731 dudy = dudy - (5.0_dp * &
732 (vterm1*riji*yhat - vterm2*rcuti2*d(2))) + pref * ( &
733 (ri4 - rcuti4)*(qxx_j*(6.0_dp*cx_j*ux_j(2)) - &
734 qxx_j*2.0_dp*(yhat - rcuti*d(2))) + &
735 (ri4 - rcuti4)*(qyy_j*(6.0_dp*cy_j*uy_j(2)) - &
736 qyy_j*2.0_dp*(yhat - rcuti*d(2))) + &
737 (ri4 - rcuti4)*(qzz_j*(6.0_dp*cz_j*uz_j(2)) - &
738 qzz_j*2.0_dp*(yhat - rcuti*d(2))) )
739 dudz = dudz - (5.0_dp * &
740 (vterm1*riji*zhat - vterm2*rcuti2*d(3))) + pref * ( &
741 (ri4 - rcuti4)*(qxx_j*(6.0_dp*cx_j*ux_j(3)) - &
742 qxx_j*2.0_dp*(zhat - rcuti*d(3))) + &
743 (ri4 - rcuti4)*(qyy_j*(6.0_dp*cy_j*uy_j(3)) - &
744 qyy_j*2.0_dp*(zhat - rcuti*d(3))) + &
745 (ri4 - rcuti4)*(qzz_j*(6.0_dp*cz_j*uz_j(3)) - &
746 qzz_j*2.0_dp*(zhat - rcuti*d(3))) )
747
748 dudux_j(1) = dudux_j(1) + pref * (ri3*(qxx_j*6.0_dp*cx_j*xhat) - &
749 rcuti4*(qxx_j*6.0_dp*cx_j*d(1)))
750 dudux_j(2) = dudux_j(2) + pref * (ri3*(qxx_j*6.0_dp*cx_j*yhat) - &
751 rcuti4*(qxx_j*6.0_dp*cx_j*d(2)))
752 dudux_j(3) = dudux_j(3) + pref * (ri3*(qxx_j*6.0_dp*cx_j*zhat) - &
753 rcuti4*(qxx_j*6.0_dp*cx_j*d(3)))
754
755 duduy_j(1) = duduy_j(1) + pref * (ri3*(qyy_j*6.0_dp*cy_j*xhat) - &
756 rcuti4*(qyy_j*6.0_dp*cx_j*d(1)))
757 duduy_j(2) = duduy_j(2) + pref * (ri3*(qyy_j*6.0_dp*cy_j*yhat) - &
758 rcuti4*(qyy_j*6.0_dp*cx_j*d(2)))
759 duduy_j(3) = duduy_j(3) + pref * (ri3*(qyy_j*6.0_dp*cy_j*zhat) - &
760 rcuti4*(qyy_j*6.0_dp*cx_j*d(3)))
761
762 duduz_j(1) = duduz_j(1) + pref * (ri3*(qzz_j*6.0_dp*cz_j*xhat) - &
763 rcuti4*(qzz_j*6.0_dp*cx_j*d(1)))
764 duduz_j(2) = duduz_j(2) + pref * (ri3*(qzz_j*6.0_dp*cz_j*yhat) - &
765 rcuti4*(qzz_j*6.0_dp*cx_j*d(2)))
766 duduz_j(3) = duduz_j(3) + pref * (ri3*(qzz_j*6.0_dp*cz_j*zhat) - &
767 rcuti4*(qzz_j*6.0_dp*cx_j*d(3)))
768
769 else
770 vterm = pref * ri3 * (qxx_j * (3.0_dp*cx2 - 1.0_dp) + &
771 qyy_j * (3.0_dp*cy2 - 1.0_dp) + &
772 qzz_j * (3.0_dp*cz2 - 1.0_dp))
773 vpair = vpair + swi * vterm
774 epot = epot + vterm
775
776 dudx = dudx - 5.0_dp*vterm*riji*xhat + pref * ri4 * ( &
777 qxx_j*(6.0_dp*cx_j*ux_j(1) - 2.0_dp*xhat) + &
778 qyy_j*(6.0_dp*cy_j*uy_j(1) - 2.0_dp*xhat) + &
779 qzz_j*(6.0_dp*cz_j*uz_j(1) - 2.0_dp*xhat) )
780 dudy = dudy - 5.0_dp*vterm*riji*yhat + pref * ri4 * ( &
781 qxx_j*(6.0_dp*cx_j*ux_j(2) - 2.0_dp*yhat) + &
782 qyy_j*(6.0_dp*cy_j*uy_j(2) - 2.0_dp*yhat) + &
783 qzz_j*(6.0_dp*cz_j*uz_j(2) - 2.0_dp*yhat) )
784 dudz = dudz - 5.0_dp*vterm*riji*zhat + pref * ri4 * ( &
785 qxx_j*(6.0_dp*cx_j*ux_j(3) - 2.0_dp*zhat) + &
786 qyy_j*(6.0_dp*cy_j*uy_j(3) - 2.0_dp*zhat) + &
787 qzz_j*(6.0_dp*cz_j*uz_j(3) - 2.0_dp*zhat) )
788
789 dudux_j(1) = dudux_j(1) + pref * ri3*(qxx_j*6.0_dp*cx_j*xhat)
790 dudux_j(2) = dudux_j(2) + pref * ri3*(qxx_j*6.0_dp*cx_j*yhat)
791 dudux_j(3) = dudux_j(3) + pref * ri3*(qxx_j*6.0_dp*cx_j*zhat)
792
793 duduy_j(1) = duduy_j(1) + pref * ri3*(qyy_j*6.0_dp*cy_j*xhat)
794 duduy_j(2) = duduy_j(2) + pref * ri3*(qyy_j*6.0_dp*cy_j*yhat)
795 duduy_j(3) = duduy_j(3) + pref * ri3*(qyy_j*6.0_dp*cy_j*zhat)
796
797 duduz_j(1) = duduz_j(1) + pref * ri3*(qzz_j*6.0_dp*cz_j*xhat)
798 duduz_j(2) = duduz_j(2) + pref * ri3*(qzz_j*6.0_dp*cz_j*yhat)
799 duduz_j(3) = duduz_j(3) + pref * ri3*(qzz_j*6.0_dp*cz_j*zhat)
800
801 endif
802 endif
803 endif
804
805 if (i_is_Dipole) then
806
807 if (j_is_Charge) then
808
809 pref = sw * pre12 * q_j * mu_i
810
811 if (summationMethod .eq. UNDAMPED_WOLF) then
812 ri2 = riji * riji
813 ri3 = ri2 * riji
814
815 vterm = pref * ct_i * (ri2 - rcuti2)
816 vpair = vpair + swi * vterm
817 epot = epot + vterm
818
819 !! this has a + sign in the () because the rij vector is
820 !! r_j - r_i and the charge-dipole potential takes the origin
821 !! as the point dipole, which is atom j in this case.
822
823 dudx = dudx + pref * ( ri3*( uz_i(1) - 3.0d0*ct_i*xhat) &
824 - rcuti3*( uz_i(1) - 3.0d0*ct_i*d(1)*rcuti ) )
825 dudy = dudy + pref * ( ri3*( uz_i(2) - 3.0d0*ct_i*yhat) &
826 - rcuti3*( uz_i(2) - 3.0d0*ct_i*d(2)*rcuti ) )
827 dudz = dudz + pref * ( ri3*( uz_i(3) - 3.0d0*ct_i*zhat) &
828 - rcuti3*( uz_i(3) - 3.0d0*ct_i*d(3)*rcuti ) )
829
830 duduz_i(1) = duduz_i(1) - pref*( ri2*xhat - d(1)*rcuti3 )
831 duduz_i(2) = duduz_i(2) - pref*( ri2*yhat - d(2)*rcuti3 )
832 duduz_i(3) = duduz_i(3) - pref*( ri2*zhat - d(3)*rcuti3 )
833
834 else
835 if (i_is_SplitDipole) then
836 BigR = sqrt(r2 + 0.25_dp * d_i * d_i)
837 ri = 1.0_dp / BigR
838 scale = rij * ri
839 else
840 ri = riji
841 scale = 1.0_dp
842 endif
843
844 ri2 = ri * ri
845 ri3 = ri2 * ri
846 sc2 = scale * scale
847
848 vterm = pref * ct_i * ri2 * scale
849 vpair = vpair + swi * vterm
850 epot = epot + vterm
851
852 dudx = dudx + pref * ri3 * ( uz_i(1) - 3.0d0 * ct_i * xhat*sc2)
853 dudy = dudy + pref * ri3 * ( uz_i(2) - 3.0d0 * ct_i * yhat*sc2)
854 dudz = dudz + pref * ri3 * ( uz_i(3) - 3.0d0 * ct_i * zhat*sc2)
855
856 duduz_i(1) = duduz_i(1) + pref * ri2 * xhat * scale
857 duduz_i(2) = duduz_i(2) + pref * ri2 * yhat * scale
858 duduz_i(3) = duduz_i(3) + pref * ri2 * zhat * scale
859 endif
860 endif
861
862 if (j_is_Dipole) then
863
864 pref = sw * pre22 * mu_i * mu_j
865
866 if (summationMethod .eq. UNDAMPED_WOLF) then
867 ri2 = riji * riji
868 ri3 = ri2 * riji
869 ri4 = ri2 * ri2
870
871 vterm = pref * (ri3 - rcuti3) * (ct_ij - 3.0d0 * ct_i * ct_j)
872 vpair = vpair + swi * vterm
873 epot = epot + vterm
874
875 a1 = 5.0d0 * ct_i * ct_j - ct_ij
876
877 dudx = dudx + pref*3.0d0*ri4 &
878 *(a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1)) - &
879 pref*3.0d0*rcuti4*(a1*rcuti*d(1)-ct_i*uz_j(1)-ct_j*uz_i(1))
880 dudy = dudy + pref*3.0d0*ri4 &
881 *(a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2)) - &
882 pref*3.0d0*rcuti4*(a1*rcuti*d(2)-ct_i*uz_j(2)-ct_j*uz_i(2))
883 dudz = dudz + pref*3.0d0*ri4 &
884 *(a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3)) - &
885 pref*3.0d0*rcuti4*(a1*rcuti*d(3)-ct_i*uz_j(3)-ct_j*uz_i(3))
886
887 duduz_i(1) = duduz_i(1) + pref*(ri3*(uz_j(1) - 3.0d0*ct_j*xhat) &
888 - rcuti3*(uz_j(1) - 3.0d0*ct_j*d(1)*rcuti))
889 duduz_i(2) = duduz_i(2) + pref*(ri3*(uz_j(2) - 3.0d0*ct_j*yhat) &
890 - rcuti3*(uz_j(2) - 3.0d0*ct_j*d(2)*rcuti))
891 duduz_i(3) = duduz_i(3) + pref*(ri3*(uz_j(3) - 3.0d0*ct_j*zhat) &
892 - rcuti3*(uz_j(3) - 3.0d0*ct_j*d(3)*rcuti))
893 duduz_j(1) = duduz_j(1) + pref*(ri3*(uz_i(1) - 3.0d0*ct_i*xhat) &
894 - rcuti3*(uz_i(1) - 3.0d0*ct_i*d(1)*rcuti))
895 duduz_j(2) = duduz_j(2) + pref*(ri3*(uz_i(2) - 3.0d0*ct_i*yhat) &
896 - rcuti3*(uz_i(2) - 3.0d0*ct_i*d(2)*rcuti))
897 duduz_j(3) = duduz_j(3) + pref*(ri3*(uz_i(3) - 3.0d0*ct_i*zhat) &
898 - rcuti3*(uz_i(3) - 3.0d0*ct_i*d(3)*rcuti))
899 else
900
901 if (i_is_SplitDipole) then
902 if (j_is_SplitDipole) then
903 BigR = sqrt(r2 + 0.25_dp * d_i * d_i + 0.25_dp * d_j * d_j)
904 else
905 BigR = sqrt(r2 + 0.25_dp * d_i * d_i)
906 endif
907 ri = 1.0_dp / BigR
908 scale = rij * ri
909 else
910 if (j_is_SplitDipole) then
911 BigR = sqrt(r2 + 0.25_dp * d_j * d_j)
912 ri = 1.0_dp / BigR
913 scale = rij * ri
914 else
915 ri = riji
916 scale = 1.0_dp
917 endif
918 endif
919
920 ct_ij = uz_i(1)*uz_j(1) + uz_i(2)*uz_j(2) + uz_i(3)*uz_j(3)
921
922 ri2 = ri * ri
923 ri3 = ri2 * ri
924 ri4 = ri2 * ri2
925 sc2 = scale * scale
926
927 vterm = pref * ri3 * (ct_ij - 3.0d0 * ct_i * ct_j * sc2)
928 vpair = vpair + swi * vterm
929 epot = epot + vterm
930
931 a1 = 5.0d0 * ct_i * ct_j * sc2 - ct_ij
932
933 dudx = dudx + pref*3.0d0*ri4*scale &
934 *(a1*xhat-ct_i*uz_j(1)-ct_j*uz_i(1))
935 dudy = dudy + pref*3.0d0*ri4*scale &
936 *(a1*yhat-ct_i*uz_j(2)-ct_j*uz_i(2))
937 dudz = dudz + pref*3.0d0*ri4*scale &
938 *(a1*zhat-ct_i*uz_j(3)-ct_j*uz_i(3))
939
940 duduz_i(1) = duduz_i(1) + pref*ri3 &
941 *(uz_j(1) - 3.0d0*ct_j*xhat*sc2)
942 duduz_i(2) = duduz_i(2) + pref*ri3 &
943 *(uz_j(2) - 3.0d0*ct_j*yhat*sc2)
944 duduz_i(3) = duduz_i(3) + pref*ri3 &
945 *(uz_j(3) - 3.0d0*ct_j*zhat*sc2)
946
947 duduz_j(1) = duduz_j(1) + pref*ri3 &
948 *(uz_i(1) - 3.0d0*ct_i*xhat*sc2)
949 duduz_j(2) = duduz_j(2) + pref*ri3 &
950 *(uz_i(2) - 3.0d0*ct_i*yhat*sc2)
951 duduz_j(3) = duduz_j(3) + pref*ri3 &
952 *(uz_i(3) - 3.0d0*ct_i*zhat*sc2)
953 endif
954 endif
955 endif
956
957 if (i_is_Quadrupole) then
958 if (j_is_Charge) then
959
960 ri2 = riji * riji
961 ri3 = ri2 * riji
962 ri4 = ri2 * ri2
963 cx2 = cx_i * cx_i
964 cy2 = cy_i * cy_i
965 cz2 = cz_i * cz_i
966
967 pref = sw * pre14 * q_j / 3.0_dp
968
969 if (summationMethod .eq. UNDAMPED_WOLF) then
970 vterm1 = pref * ri3*( qxx_i * (3.0_dp*cx2 - 1.0_dp) + &
971 qyy_i * (3.0_dp*cy2 - 1.0_dp) + &
972 qzz_i * (3.0_dp*cz2 - 1.0_dp) )
973 vterm2 = pref * rcuti3*( qxx_i * (3.0_dp*cx2 - 1.0_dp) + &
974 qyy_i * (3.0_dp*cy2 - 1.0_dp) + &
975 qzz_i * (3.0_dp*cz2 - 1.0_dp) )
976 vpair = vpair + swi * ( vterm1 - vterm2 )
977 epot = epot + ( vterm1 - vterm2 )
978
979 dudx = dudx - (5.0_dp*(vterm1*riji*xhat - vterm2*rcuti2*d(1))) + &
980 pref * ( (ri4 - rcuti4)*(qxx_i*(6.0_dp*cx_i*ux_i(1)) - &
981 qxx_i*2.0_dp*(xhat - rcuti*d(1))) + &
982 (ri4 - rcuti4)*(qyy_i*(6.0_dp*cy_i*uy_i(1)) - &
983 qyy_i*2.0_dp*(xhat - rcuti*d(1))) + &
984 (ri4 - rcuti4)*(qzz_i*(6.0_dp*cz_i*uz_i(1)) - &
985 qzz_i*2.0_dp*(xhat - rcuti*d(1))) )
986 dudy = dudy - (5.0_dp*(vterm1*riji*yhat - vterm2*rcuti2*d(2))) + &
987 pref * ( (ri4 - rcuti4)*(qxx_i*(6.0_dp*cx_i*ux_i(2)) - &
988 qxx_i*2.0_dp*(yhat - rcuti*d(2))) + &
989 (ri4 - rcuti4)*(qyy_i*(6.0_dp*cy_i*uy_i(2)) - &
990 qyy_i*2.0_dp*(yhat - rcuti*d(2))) + &
991 (ri4 - rcuti4)*(qzz_i*(6.0_dp*cz_i*uz_i(2)) - &
992 qzz_i*2.0_dp*(yhat - rcuti*d(2))) )
993 dudz = dudz - (5.0_dp*(vterm1*riji*zhat - vterm2*rcuti2*d(3))) + &
994 pref * ( (ri4 - rcuti4)*(qxx_i*(6.0_dp*cx_i*ux_i(3)) - &
995 qxx_i*2.0_dp*(zhat - rcuti*d(3))) + &
996 (ri4 - rcuti4)*(qyy_i*(6.0_dp*cy_i*uy_i(3)) - &
997 qyy_i*2.0_dp*(zhat - rcuti*d(3))) + &
998 (ri4 - rcuti4)*(qzz_i*(6.0_dp*cz_i*uz_i(3)) - &
999 qzz_i*2.0_dp*(zhat - rcuti*d(3))) )
1000
1001 dudux_i(1) = dudux_i(1) + pref * (ri3*(qxx_i*6.0_dp*cx_i*xhat) - &
1002 rcuti4*(qxx_i*6.0_dp*cx_i*d(1)))
1003 dudux_i(2) = dudux_i(2) + pref * (ri3*(qxx_i*6.0_dp*cx_i*yhat) - &
1004 rcuti4*(qxx_i*6.0_dp*cx_i*d(2)))
1005 dudux_i(3) = dudux_i(3) + pref * (ri3*(qxx_i*6.0_dp*cx_i*zhat) - &
1006 rcuti4*(qxx_i*6.0_dp*cx_i*d(3)))
1007
1008 duduy_i(1) = duduy_i(1) + pref * (ri3*(qyy_i*6.0_dp*cy_i*xhat) - &
1009 rcuti4*(qyy_i*6.0_dp*cx_i*d(1)))
1010 duduy_i(2) = duduy_i(2) + pref * (ri3*(qyy_i*6.0_dp*cy_i*yhat) - &
1011 rcuti4*(qyy_i*6.0_dp*cx_i*d(2)))
1012 duduy_i(3) = duduy_i(3) + pref * (ri3*(qyy_i*6.0_dp*cy_i*zhat) - &
1013 rcuti4*(qyy_i*6.0_dp*cx_i*d(3)))
1014
1015 duduz_i(1) = duduz_i(1) + pref * (ri3*(qzz_i*6.0_dp*cz_i*xhat) - &
1016 rcuti4*(qzz_i*6.0_dp*cx_i*d(1)))
1017 duduz_i(2) = duduz_i(2) + pref * (ri3*(qzz_i*6.0_dp*cz_i*yhat) - &
1018 rcuti4*(qzz_i*6.0_dp*cx_i*d(2)))
1019 duduz_i(3) = duduz_i(3) + pref * (ri3*(qzz_i*6.0_dp*cz_i*zhat) - &
1020 rcuti4*(qzz_i*6.0_dp*cx_i*d(3)))
1021
1022 else
1023 vterm = pref * ri3 * (qxx_i * (3.0_dp*cx2 - 1.0_dp) + &
1024 qyy_i * (3.0_dp*cy2 - 1.0_dp) + &
1025 qzz_i * (3.0_dp*cz2 - 1.0_dp))
1026 vpair = vpair + swi * vterm
1027 epot = epot + vterm
1028
1029 dudx = dudx - 5.0_dp*vterm*riji*xhat + pref * ri4 * ( &
1030 qxx_i*(6.0_dp*cx_i*ux_i(1) - 2.0_dp*xhat) + &
1031 qyy_i*(6.0_dp*cy_i*uy_i(1) - 2.0_dp*xhat) + &
1032 qzz_i*(6.0_dp*cz_i*uz_i(1) - 2.0_dp*xhat) )
1033 dudy = dudy - 5.0_dp*vterm*riji*yhat + pref * ri4 * ( &
1034 qxx_i*(6.0_dp*cx_i*ux_i(2) - 2.0_dp*yhat) + &
1035 qyy_i*(6.0_dp*cy_i*uy_i(2) - 2.0_dp*yhat) + &
1036 qzz_i*(6.0_dp*cz_i*uz_i(2) - 2.0_dp*yhat) )
1037 dudz = dudz - 5.0_dp*vterm*riji*zhat + pref * ri4 * ( &
1038 qxx_i*(6.0_dp*cx_i*ux_i(3) - 2.0_dp*zhat) + &
1039 qyy_i*(6.0_dp*cy_i*uy_i(3) - 2.0_dp*zhat) + &
1040 qzz_i*(6.0_dp*cz_i*uz_i(3) - 2.0_dp*zhat) )
1041
1042 dudux_i(1) = dudux_i(1) + pref * ri3*(qxx_i*6.0_dp*cx_i*xhat)
1043 dudux_i(2) = dudux_i(2) + pref * ri3*(qxx_i*6.0_dp*cx_i*yhat)
1044 dudux_i(3) = dudux_i(3) + pref * ri3*(qxx_i*6.0_dp*cx_i*zhat)
1045
1046 duduy_i(1) = duduy_i(1) + pref * ri3*(qyy_i*6.0_dp*cy_i*xhat)
1047 duduy_i(2) = duduy_i(2) + pref * ri3*(qyy_i*6.0_dp*cy_i*yhat)
1048 duduy_i(3) = duduy_i(3) + pref * ri3*(qyy_i*6.0_dp*cy_i*zhat)
1049
1050 duduz_i(1) = duduz_i(1) + pref * ri3*(qzz_i*6.0_dp*cz_i*xhat)
1051 duduz_i(2) = duduz_i(2) + pref * ri3*(qzz_i*6.0_dp*cz_i*yhat)
1052 duduz_i(3) = duduz_i(3) + pref * ri3*(qzz_i*6.0_dp*cz_i*zhat)
1053 endif
1054 endif
1055 endif
1056
1057
1058 if (do_pot) then
1059 #ifdef IS_MPI
1060 pot_row(atom1) = pot_row(atom1) + 0.5d0*epot
1061 pot_col(atom2) = pot_col(atom2) + 0.5d0*epot
1062 #else
1063 pot = pot + epot
1064 #endif
1065 endif
1066
1067 #ifdef IS_MPI
1068 f_Row(1,atom1) = f_Row(1,atom1) + dudx
1069 f_Row(2,atom1) = f_Row(2,atom1) + dudy
1070 f_Row(3,atom1) = f_Row(3,atom1) + dudz
1071
1072 f_Col(1,atom2) = f_Col(1,atom2) - dudx
1073 f_Col(2,atom2) = f_Col(2,atom2) - dudy
1074 f_Col(3,atom2) = f_Col(3,atom2) - dudz
1075
1076 if (i_is_Dipole .or. i_is_Quadrupole) then
1077 t_Row(1,atom1)=t_Row(1,atom1) - uz_i(2)*duduz_i(3) + uz_i(3)*duduz_i(2)
1078 t_Row(2,atom1)=t_Row(2,atom1) - uz_i(3)*duduz_i(1) + uz_i(1)*duduz_i(3)
1079 t_Row(3,atom1)=t_Row(3,atom1) - uz_i(1)*duduz_i(2) + uz_i(2)*duduz_i(1)
1080 endif
1081 if (i_is_Quadrupole) then
1082 t_Row(1,atom1)=t_Row(1,atom1) - ux_i(2)*dudux_i(3) + ux_i(3)*dudux_i(2)
1083 t_Row(2,atom1)=t_Row(2,atom1) - ux_i(3)*dudux_i(1) + ux_i(1)*dudux_i(3)
1084 t_Row(3,atom1)=t_Row(3,atom1) - ux_i(1)*dudux_i(2) + ux_i(2)*dudux_i(1)
1085
1086 t_Row(1,atom1)=t_Row(1,atom1) - uy_i(2)*duduy_i(3) + uy_i(3)*duduy_i(2)
1087 t_Row(2,atom1)=t_Row(2,atom1) - uy_i(3)*duduy_i(1) + uy_i(1)*duduy_i(3)
1088 t_Row(3,atom1)=t_Row(3,atom1) - uy_i(1)*duduy_i(2) + uy_i(2)*duduy_i(1)
1089 endif
1090
1091 if (j_is_Dipole .or. j_is_Quadrupole) then
1092 t_Col(1,atom2)=t_Col(1,atom2) - uz_j(2)*duduz_j(3) + uz_j(3)*duduz_j(2)
1093 t_Col(2,atom2)=t_Col(2,atom2) - uz_j(3)*duduz_j(1) + uz_j(1)*duduz_j(3)
1094 t_Col(3,atom2)=t_Col(3,atom2) - uz_j(1)*duduz_j(2) + uz_j(2)*duduz_j(1)
1095 endif
1096 if (j_is_Quadrupole) then
1097 t_Col(1,atom2)=t_Col(1,atom2) - ux_j(2)*dudux_j(3) + ux_j(3)*dudux_j(2)
1098 t_Col(2,atom2)=t_Col(2,atom2) - ux_j(3)*dudux_j(1) + ux_j(1)*dudux_j(3)
1099 t_Col(3,atom2)=t_Col(3,atom2) - ux_j(1)*dudux_j(2) + ux_j(2)*dudux_j(1)
1100
1101 t_Col(1,atom2)=t_Col(1,atom2) - uy_j(2)*duduy_j(3) + uy_j(3)*duduy_j(2)
1102 t_Col(2,atom2)=t_Col(2,atom2) - uy_j(3)*duduy_j(1) + uy_j(1)*duduy_j(3)
1103 t_Col(3,atom2)=t_Col(3,atom2) - uy_j(1)*duduy_j(2) + uy_j(2)*duduy_j(1)
1104 endif
1105
1106 #else
1107 f(1,atom1) = f(1,atom1) + dudx
1108 f(2,atom1) = f(2,atom1) + dudy
1109 f(3,atom1) = f(3,atom1) + dudz
1110
1111 f(1,atom2) = f(1,atom2) - dudx
1112 f(2,atom2) = f(2,atom2) - dudy
1113 f(3,atom2) = f(3,atom2) - dudz
1114
1115 if (i_is_Dipole .or. i_is_Quadrupole) then
1116 t(1,atom1)=t(1,atom1) - uz_i(2)*duduz_i(3) + uz_i(3)*duduz_i(2)
1117 t(2,atom1)=t(2,atom1) - uz_i(3)*duduz_i(1) + uz_i(1)*duduz_i(3)
1118 t(3,atom1)=t(3,atom1) - uz_i(1)*duduz_i(2) + uz_i(2)*duduz_i(1)
1119 endif
1120 if (i_is_Quadrupole) then
1121 t(1,atom1)=t(1,atom1) - ux_i(2)*dudux_i(3) + ux_i(3)*dudux_i(2)
1122 t(2,atom1)=t(2,atom1) - ux_i(3)*dudux_i(1) + ux_i(1)*dudux_i(3)
1123 t(3,atom1)=t(3,atom1) - ux_i(1)*dudux_i(2) + ux_i(2)*dudux_i(1)
1124
1125 t(1,atom1)=t(1,atom1) - uy_i(2)*duduy_i(3) + uy_i(3)*duduy_i(2)
1126 t(2,atom1)=t(2,atom1) - uy_i(3)*duduy_i(1) + uy_i(1)*duduy_i(3)
1127 t(3,atom1)=t(3,atom1) - uy_i(1)*duduy_i(2) + uy_i(2)*duduy_i(1)
1128 endif
1129
1130 if (j_is_Dipole .or. j_is_Quadrupole) then
1131 t(1,atom2)=t(1,atom2) - uz_j(2)*duduz_j(3) + uz_j(3)*duduz_j(2)
1132 t(2,atom2)=t(2,atom2) - uz_j(3)*duduz_j(1) + uz_j(1)*duduz_j(3)
1133 t(3,atom2)=t(3,atom2) - uz_j(1)*duduz_j(2) + uz_j(2)*duduz_j(1)
1134 endif
1135 if (j_is_Quadrupole) then
1136 t(1,atom2)=t(1,atom2) - ux_j(2)*dudux_j(3) + ux_j(3)*dudux_j(2)
1137 t(2,atom2)=t(2,atom2) - ux_j(3)*dudux_j(1) + ux_j(1)*dudux_j(3)
1138 t(3,atom2)=t(3,atom2) - ux_j(1)*dudux_j(2) + ux_j(2)*dudux_j(1)
1139
1140 t(1,atom2)=t(1,atom2) - uy_j(2)*duduy_j(3) + uy_j(3)*duduy_j(2)
1141 t(2,atom2)=t(2,atom2) - uy_j(3)*duduy_j(1) + uy_j(1)*duduy_j(3)
1142 t(3,atom2)=t(3,atom2) - uy_j(1)*duduy_j(2) + uy_j(2)*duduy_j(1)
1143 endif
1144
1145 #endif
1146
1147 #ifdef IS_MPI
1148 id1 = AtomRowToGlobal(atom1)
1149 id2 = AtomColToGlobal(atom2)
1150 #else
1151 id1 = atom1
1152 id2 = atom2
1153 #endif
1154
1155 if (molMembershipList(id1) .ne. molMembershipList(id2)) then
1156
1157 fpair(1) = fpair(1) + dudx
1158 fpair(2) = fpair(2) + dudy
1159 fpair(3) = fpair(3) + dudz
1160
1161 endif
1162
1163 return
1164 end subroutine doElectrostaticPair
1165
1166 !! calculates the switching functions and their derivatives for a given
1167 subroutine calc_switch(r, mu, scale, dscale)
1168
1169 real (kind=dp), intent(in) :: r, mu
1170 real (kind=dp), intent(inout) :: scale, dscale
1171 real (kind=dp) :: rl, ru, mulow, minRatio, temp, scaleVal
1172
1173 ! distances must be in angstroms
1174 rl = 2.75d0
1175 ru = 3.75d0
1176 mulow = 0.0d0 !3.3856d0 ! 1.84 * 1.84
1177 minRatio = mulow / (mu*mu)
1178 scaleVal = 1.0d0 - minRatio
1179
1180 if (r.lt.rl) then
1181 scale = minRatio
1182 dscale = 0.0d0
1183 elseif (r.gt.ru) then
1184 scale = 1.0d0
1185 dscale = 0.0d0
1186 else
1187 scale = 1.0d0 - scaleVal*((ru + 2.0d0*r - 3.0d0*rl) * (ru-r)**2) &
1188 / ((ru - rl)**3)
1189 dscale = -scaleVal * 6.0d0 * (r-ru)*(r-rl)/((ru - rl)**3)
1190 endif
1191
1192 return
1193 end subroutine calc_switch
1194
1195 subroutine destroyElectrostaticTypes()
1196
1197 if(allocated(ElectrostaticMap)) deallocate(ElectrostaticMap)
1198
1199 end subroutine destroyElectrostaticTypes
1200
1201 end module electrostatic_module