ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-2.0/src/UseTheForce/DarkSide/electrostatic.F90
Revision: 2436
Committed: Tue Nov 15 16:38:26 2005 UTC (18 years, 8 months ago) by chrisfen
File size: 59786 byte(s)
Log Message:
fixed a bug in the shifted_potential case

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