ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-2.0/src/UseTheForce/DarkSide/electrostatic.F90
Revision: 2343
Committed: Tue Oct 4 19:33:22 2005 UTC (18 years, 11 months ago) by chrisfen
File size: 46599 byte(s)
Log Message:
maybe some work on wolf

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