ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/OpenMD/trunk/src/UseTheForce/DarkSide/MetalNonMetal.F90
Revision: 1238
Committed: Thu Apr 24 21:06:05 2008 UTC (17 years, 3 months ago) by gezelter
File size: 29377 byte(s)
Log Message:
Changing functional form

File Contents

# Content
1 !!
2 !! Copyright (c) 2007 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
43 !! Calculates Metal-Non Metal interactions.
44 !! @author Charles F. Vardeman II
45 !! @version $Id: MetalNonMetal.F90,v 1.11 2008-04-24 21:04:27 gezelter Exp $, $Date: 2008-04-24 21:04:27 $, $Name: not supported by cvs2svn $, $Revision: 1.11 $
46
47
48 module MetalNonMetal
49 use definitions
50 use atype_module
51 use vector_class
52 use simulation
53 use status
54 use fForceOptions
55 #ifdef IS_MPI
56 use mpiSimulation
57 #endif
58 use force_globals
59
60 implicit none
61 PRIVATE
62 #define __FORTRAN90
63 #include "UseTheForce/DarkSide/fInteractionMap.h"
64 #include "UseTheForce/DarkSide/fMnMInteractions.h"
65
66 logical, save :: useGeometricDistanceMixing = .false.
67 logical, save :: haveInteractionLookup = .false.
68
69 real(kind=DP), save :: defaultCutoff = 0.0_DP
70
71 logical, save :: defaultShiftPot = .false.
72 logical, save :: defaultShiftFrc = .false.
73 logical, save :: haveDefaultCutoff = .false.
74
75 type :: MnMinteraction
76 integer :: metal_atid
77 integer :: nonmetal_atid
78 integer :: interaction_type
79 real(kind=dp) :: R0
80 real(kind=dp) :: D0
81 real(kind=dp) :: beta0
82 real(kind=dp) :: betaH
83 real(kind=dp) :: ca1
84 real(kind=dp) :: cb1
85 real(kind=dp) :: sigma
86 real(kind=dp) :: epsilon
87 real(kind=dp) :: rCut = 0.0_dp
88 logical :: rCutWasSet = .false.
89 logical :: shiftedPot = .false.
90 logical :: shiftedFrc = .false.
91 end type MnMinteraction
92
93 type :: MnMinteractionMap
94 PRIVATE
95 integer :: initialCapacity = 10
96 integer :: capacityIncrement = 0
97 integer :: interactionCount = 0
98 type(MnMinteraction), pointer :: interactions(:) => null()
99 end type MnMinteractionMap
100
101 type (MnMInteractionMap), pointer :: MnM_Map
102
103 integer, allocatable, dimension(:,:) :: MnMinteractionLookup
104
105 public :: setMnMDefaultCutoff
106 public :: addInteraction
107 public :: deleteInteractions
108 public :: MNMtype
109 public :: do_mnm_pair
110
111 contains
112
113
114 subroutine do_mnm_pair(Atom1, Atom2, D, Rij, R2, Rcut, Sw, Vpair, Fpair, &
115 Pot, A, F,t, Do_pot)
116 integer, intent(in) :: atom1, atom2
117 integer :: atid1, atid2, ljt1, ljt2
118 real( kind = dp ), intent(in) :: rij, r2, rcut
119 real( kind = dp ) :: pot, sw, vpair
120 real( kind = dp ), intent(inout), dimension(3,nLocal) :: f
121 real (kind=dp), intent(in), dimension(9,nLocal) :: A
122 real (kind=dp), intent(inout), dimension(3,nLocal) :: t
123 real( kind = dp ), intent(in), dimension(3) :: d
124 real( kind = dp ), intent(inout), dimension(3) :: fpair
125 logical, intent(in) :: do_pot
126
127 integer :: interaction_id
128 integer :: interaction_type
129
130 #ifdef IS_MPI
131 atid1 = atid_Row(atom1)
132 atid2 = atid_Col(atom2)
133 #else
134 atid1 = atid(atom1)
135 atid2 = atid(atom2)
136 #endif
137
138 if(.not.haveInteractionLookup) then
139 call createInteractionLookup(MnM_MAP)
140 haveInteractionLookup =.true.
141 end if
142
143 interaction_id = MnMinteractionLookup(atid1, atid2)
144 interaction_type = MnM_Map%interactions(interaction_id)%interaction_type
145
146
147
148 select case (interaction_type)
149 case (MNM_LENNARDJONES)
150 call calc_mnm_lennardjones(Atom1, Atom2, D, Rij, R2, Rcut, Sw, Vpair, &
151 Fpair, Pot, F, Do_pot, interaction_id)
152 case(MNM_REPULSIVEMORSE, MNM_SHIFTEDMORSE)
153 call calc_mnm_morse(Atom1, Atom2, D, Rij, R2, Rcut, Sw, Vpair, Fpair, &
154 Pot, F, Do_pot, interaction_id, interaction_type)
155 case(MNM_MAW)
156 call calc_mnm_maw(Atom1, Atom2, D, Rij, R2, Rcut, Sw, Vpair, Fpair, &
157 Pot,A, F,t, Do_pot, interaction_id)
158 case default
159 call handleError("MetalNonMetal","Unknown interaction type")
160 end select
161
162 end subroutine do_mnm_pair
163
164 subroutine calc_mnm_lennardjones(Atom1, Atom2, D, Rij, R2, Rcut, Sw, Vpair, &
165 Fpair, Pot, F, Do_pot, interaction_id)
166
167 integer, intent(in) :: atom1, atom2
168 real( kind = dp ), intent(in) :: rij, r2, rcut
169 real( kind = dp ) :: pot, sw, vpair
170 real( kind = dp ), intent(inout), dimension(3,nLocal) :: f
171 real( kind = dp ), intent(in), dimension(3) :: d
172 real( kind = dp ), intent(inout), dimension(3) :: fpair
173 logical, intent(in) :: do_pot
174 integer, intent(in) :: interaction_id
175
176 ! local Variables
177 real( kind = dp ) :: drdx, drdy, drdz
178 real( kind = dp ) :: fx, fy, fz
179 real( kind = dp ) :: myPot, myPotC, myDeriv, myDerivC, ros, rcos
180 real( kind = dp ) :: pot_temp, dudr
181 real( kind = dp ) :: sigmai
182 real( kind = dp ) :: epsilon
183 logical :: isSoftCore, shiftedPot, shiftedFrc
184 integer :: id1, id2, localError
185
186 sigmai = 1.0_dp / MnM_Map%interactions(interaction_id)%sigma
187 epsilon = MnM_Map%interactions(interaction_id)%epsilon
188 shiftedPot = MnM_Map%interactions(interaction_id)%shiftedPot
189 shiftedFrc = MnM_Map%interactions(interaction_id)%shiftedFrc
190
191 ros = rij * sigmai
192
193 call getLJfunc(ros, myPot, myDeriv)
194
195 if (shiftedPot) then
196 rcos = rcut * sigmai
197 call getLJfunc(rcos, myPotC, myDerivC)
198 myDerivC = 0.0_dp
199 elseif (shiftedFrc) then
200 rcos = rcut * sigmai
201 call getLJfunc(rcos, myPotC, myDerivC)
202 myPotC = myPotC + myDerivC * (rij - rcut) * sigmai
203 else
204 myPotC = 0.0_dp
205 myDerivC = 0.0_dp
206 endif
207
208 pot_temp = epsilon * (myPot - myPotC)
209 vpair = vpair + pot_temp
210 dudr = sw * epsilon * (myDeriv - myDerivC) * sigmai
211
212 drdx = d(1) / rij
213 drdy = d(2) / rij
214 drdz = d(3) / rij
215
216 fx = dudr * drdx
217 fy = dudr * drdy
218 fz = dudr * drdz
219
220 #ifdef IS_MPI
221 if (do_pot) then
222 pot_Row(VDW_POT,atom1) = pot_Row(VDW_POT,atom1) + sw*pot_temp*0.5
223 pot_Col(VDW_POT,atom2) = pot_Col(VDW_POT,atom2) + sw*pot_temp*0.5
224 endif
225
226 f_Row(1,atom1) = f_Row(1,atom1) + fx
227 f_Row(2,atom1) = f_Row(2,atom1) + fy
228 f_Row(3,atom1) = f_Row(3,atom1) + fz
229
230 f_Col(1,atom2) = f_Col(1,atom2) - fx
231 f_Col(2,atom2) = f_Col(2,atom2) - fy
232 f_Col(3,atom2) = f_Col(3,atom2) - fz
233
234 #else
235 if (do_pot) pot = pot + sw*pot_temp
236
237 f(1,atom1) = f(1,atom1) + fx
238 f(2,atom1) = f(2,atom1) + fy
239 f(3,atom1) = f(3,atom1) + fz
240
241 f(1,atom2) = f(1,atom2) - fx
242 f(2,atom2) = f(2,atom2) - fy
243 f(3,atom2) = f(3,atom2) - fz
244 #endif
245
246 #ifdef IS_MPI
247 id1 = AtomRowToGlobal(atom1)
248 id2 = AtomColToGlobal(atom2)
249 #else
250 id1 = atom1
251 id2 = atom2
252 #endif
253
254 if (molMembershipList(id1) .ne. molMembershipList(id2)) then
255
256 fpair(1) = fpair(1) + fx
257 fpair(2) = fpair(2) + fy
258 fpair(3) = fpair(3) + fz
259
260 endif
261 return
262 end subroutine calc_mnm_lennardjones
263
264 subroutine calc_mnm_morse(Atom1, Atom2, D, Rij, R2, Rcut, Sw, Vpair, Fpair, &
265 Pot, f, Do_pot, interaction_id, interaction_type)
266 integer, intent(in) :: atom1, atom2
267 real( kind = dp ), intent(in) :: rij, r2, rcut
268 real( kind = dp ) :: pot, sw, vpair
269 real( kind = dp ), intent(inout), dimension(3,nLocal) :: f
270 real( kind = dp ), intent(in), dimension(3) :: d
271 real( kind = dp ), intent(inout), dimension(3) :: fpair
272 logical, intent(in) :: do_pot
273 integer, intent(in) :: interaction_id, interaction_type
274 logical :: shiftedPot, shiftedFrc
275
276 ! Local Variables
277 real(kind=dp) :: Beta0
278 real(kind=dp) :: R0
279 real(kind=dp) :: D0
280 real(kind=dp) :: expt
281 real(kind=dp) :: expt2
282 real(kind=dp) :: expfnc
283 real(kind=dp) :: expfnc2
284 real(kind=dp) :: D_expt
285 real(kind=dp) :: D_expt2
286 real(kind=dp) :: rcos
287 real(kind=dp) :: exptC
288 real(kind=dp) :: expt2C
289 real(kind=dp) :: expfncC
290 real(kind=dp) :: expfnc2C
291 real(kind=dp) :: D_expt2C
292 real(kind=dp) :: D_exptC
293
294 real(kind=dp) :: myPot
295 real(kind=dp) :: myPotC
296 real(kind=dp) :: myDeriv
297 real(kind=dp) :: myDerivC
298 real(kind=dp) :: pot_temp
299 real(kind=dp) :: fx,fy,fz
300 real(kind=dp) :: drdx,drdy,drdz
301 real(kind=dp) :: dudr
302 integer :: id1,id2
303
304
305 D0 = MnM_Map%interactions(interaction_id)%D0
306 R0 = MnM_Map%interactions(interaction_id)%r0
307 Beta0 = MnM_Map%interactions(interaction_id)%Beta0
308 shiftedPot = MnM_Map%interactions(interaction_id)%shiftedPot
309 shiftedFrc = MnM_Map%interactions(interaction_id)%shiftedFrc
310
311 ! V(r) = D_e exp(-a(r-re)(exp(-a(r-re))-2)
312
313 expt = -beta0*(rij - R0)
314 expfnc = exp(expt)
315 expfnc2 = expfnc*expfnc
316
317 if (shiftedPot .or. shiftedFrc) then
318 exptC = -beta0*(rcut - R0)
319 expfncC = exp(exptC)
320 expfnc2C = expfncC*expfncC
321 endif
322
323 select case (interaction_type)
324 case (MNM_SHIFTEDMORSE)
325
326 myPot = D0 * (expfnc2 - 2.0_dp * expfnc)
327 myDeriv = 2.0*D0*beta0*(expfnc - expfnc2)
328
329 if (shiftedPot) then
330 myPotC = D0 * (expfnc2C - 2.0_dp * expfncC)
331 myDerivC = 0.0_dp
332 elseif (shiftedFrc) then
333 myPotC = D0 * (expfnc2C - 2.0_dp * expfncC)
334 myDerivC = 2.0*D0*beta0*(expfnc2C - expfnc2C)
335 myPotC = myPotC + myDerivC * (rij - rcut)
336 else
337 myPotC = 0.0_dp
338 myDerivC = 0.0_dp
339 endif
340
341 case (MNM_REPULSIVEMORSE)
342
343 myPot = D0 * expfnc2
344 myDeriv = -2.0_dp * D0 * beta0 * expfnc2
345
346 if (shiftedPot) then
347 myPotC = D0 * expfnc2C
348 myDerivC = 0.0_dp
349 elseif (shiftedFrc) then
350 myPotC = D0 * expfnc2C
351 myDerivC = -2.0_dp * D0* beta0 * expfnc2C
352 myPotC = myPotC + myDerivC * (rij - rcut)
353 else
354 myPotC = 0.0_dp
355 myDerivC = 0.0_dp
356 endif
357 end select
358
359 pot_temp = (myPot - myPotC)
360 vpair = vpair + pot_temp
361 dudr = sw * (myDeriv - myDerivC)
362
363 drdx = d(1) / rij
364 drdy = d(2) / rij
365 drdz = d(3) / rij
366
367 fx = dudr * drdx
368 fy = dudr * drdy
369 fz = dudr * drdz
370
371 #ifdef IS_MPI
372 if (do_pot) then
373 pot_Row(VDW_POT,atom1) = pot_Row(VDW_POT,atom1) + sw*pot_temp*0.5
374 pot_Col(VDW_POT,atom2) = pot_Col(VDW_POT,atom2) + sw*pot_temp*0.5
375 endif
376
377 f_Row(1,atom1) = f_Row(1,atom1) + fx
378 f_Row(2,atom1) = f_Row(2,atom1) + fy
379 f_Row(3,atom1) = f_Row(3,atom1) + fz
380
381 f_Col(1,atom2) = f_Col(1,atom2) - fx
382 f_Col(2,atom2) = f_Col(2,atom2) - fy
383 f_Col(3,atom2) = f_Col(3,atom2) - fz
384
385 #else
386 if (do_pot) pot = pot + sw*pot_temp
387
388 f(1,atom1) = f(1,atom1) + fx
389 f(2,atom1) = f(2,atom1) + fy
390 f(3,atom1) = f(3,atom1) + fz
391
392 f(1,atom2) = f(1,atom2) - fx
393 f(2,atom2) = f(2,atom2) - fy
394 f(3,atom2) = f(3,atom2) - fz
395 #endif
396
397 #ifdef IS_MPI
398 id1 = AtomRowToGlobal(atom1)
399 id2 = AtomColToGlobal(atom2)
400 #else
401 id1 = atom1
402 id2 = atom2
403 #endif
404
405 if (molMembershipList(id1) .ne. molMembershipList(id2)) then
406
407 fpair(1) = fpair(1) + fx
408 fpair(2) = fpair(2) + fy
409 fpair(3) = fpair(3) + fz
410
411 endif
412
413 return
414 end subroutine calc_mnm_morse
415
416 subroutine calc_mnm_maw(Atom1, Atom2, D, Rij, R2, Rcut, Sw, Vpair, Fpair, &
417 Pot, A, F,t, Do_pot, interaction_id)
418 integer, intent(in) :: atom1, atom2
419 real( kind = dp ), intent(in) :: rij, r2, rcut
420 real( kind = dp ) :: pot, sw, vpair
421 real( kind = dp ), intent(inout), dimension(3,nLocal) :: f
422 real (kind=dp),intent(in), dimension(9,nLocal) :: A
423 real (kind=dp),intent(inout), dimension(3,nLocal) :: t
424
425 real( kind = dp ), intent(in), dimension(3) :: d
426 real( kind = dp ), intent(inout), dimension(3) :: fpair
427 logical, intent(in) :: do_pot
428
429 integer, intent(in) :: interaction_id
430
431 real(kind = dp) :: D0, R0, beta0, ca1, cb1, pot_temp
432 real(kind = dp) :: expt0, expfnc0, expfnc02
433 real(kind = dp) :: exptH, expfncH, expfncH2
434 real(kind = dp) :: x, y, z, x2, y2, z2, r3, r4
435 real(kind = dp) :: drdx, drdy, drdz
436 real(kind = dp) :: dvdx, dvdy, dvdz
437 real(kind = dp) :: Vang, dVangdx, dVangdy, dVangdz
438 real(kind = dp) :: dVangdux, dVangduy, dVangduz
439 real(kind = dp) :: dVmorsedr
440 real(kind = dp) :: Vmorse, dVmorsedx, dVmorsedy, dVmorsedz
441 real(kind = dp) :: a1, b1, s
442 real(kind = dp) :: da1dx, da1dy, da1dz, da1dux, da1duy, da1duz
443 real(kind = dp) :: db1dx, db1dy, db1dz, db1dux, db1duy, db1duz
444 real(kind = dp) :: fx, fy, fz, tx, ty, tz, fxl, fyl, fzl
445 real(kind = dp), parameter :: st = sqrt(3.0_dp)
446 integer :: atid1, atid2, id1, id2
447 logical :: shiftedPot, shiftedFrc
448
449 #ifdef IS_MPI
450 atid1 = atid_Row(atom1)
451 atid2 = atid_Col(atom2)
452
453 if (atid2.eq.MnM_Map%interactions(interaction_id)%metal_atid) then
454 ! rotate the inter-particle separation into the two different
455 ! body-fixed coordinate systems:
456
457 x = A_row(1,atom1)*d(1) + A_row(2,atom1)*d(2) + A_row(3,atom1)*d(3)
458 y = A_row(4,atom1)*d(1) + A_row(5,atom1)*d(2) + A_row(6,atom1)*d(3)
459 z = A_row(7,atom1)*d(1) + A_row(8,atom1)*d(2) + A_row(9,atom1)*d(3)
460 else
461 ! negative sign because this is the vector from j to i:
462
463 x = -(A_Col(1,atom2)*d(1) + A_Col(2,atom2)*d(2) + A_Col(3,atom2)*d(3))
464 y = -(A_Col(4,atom2)*d(1) + A_Col(5,atom2)*d(2) + A_Col(6,atom2)*d(3))
465 z = -(A_Col(7,atom2)*d(1) + A_Col(8,atom2)*d(2) + A_Col(9,atom2)*d(3))
466 endif
467
468 #else
469 atid1 = atid(atom1)
470 atid2 = atid(atom2)
471
472 if (atid2.eq.MnM_Map%interactions(interaction_id)%metal_atid) then
473 ! rotate the inter-particle separation into the two different
474 ! body-fixed coordinate systems:
475
476 x = a(1,atom1)*d(1) + a(2,atom1)*d(2) + a(3,atom1)*d(3)
477 y = a(4,atom1)*d(1) + a(5,atom1)*d(2) + a(6,atom1)*d(3)
478 z = a(7,atom1)*d(1) + a(8,atom1)*d(2) + a(9,atom1)*d(3)
479 else
480 ! negative sign because this is the vector from j to i:
481
482 x = -(a(1,atom2)*d(1) + a(2,atom2)*d(2) + a(3,atom2)*d(3))
483 y = -(a(4,atom2)*d(1) + a(5,atom2)*d(2) + a(6,atom2)*d(3))
484 z = -(a(7,atom2)*d(1) + a(8,atom2)*d(2) + a(9,atom2)*d(3))
485 endif
486
487 #endif
488
489 D0 = MnM_Map%interactions(interaction_id)%D0
490 R0 = MnM_Map%interactions(interaction_id)%r0
491 beta0 = MnM_Map%interactions(interaction_id)%beta0
492 ca1 = MnM_Map%interactions(interaction_id)%ca1
493 cb1 = MnM_Map%interactions(interaction_id)%cb1
494
495 shiftedPot = MnM_Map%interactions(interaction_id)%shiftedPot
496 shiftedFrc = MnM_Map%interactions(interaction_id)%shiftedFrc
497
498 expt0 = -beta0*(rij - R0)
499 expfnc0 = exp(expt0)
500 expfnc02 = expfnc0*expfnc0
501
502 !!$ if (shiftedPot .or. shiftedFrc) then
503 !!$ exptC0 = -beta0*(rcut - R0)
504 !!$ expfncC0 = exp(exptC0)
505 !!$ expfncC02 = expfncC0*expfncC0
506 !!$ exptCH = -betaH*(rcut - R0)
507 !!$ expfncCH = exp(exptCH)
508 !!$ expfncCH2 = expfncCH*expfncCH
509 !!$ endif
510
511 drdx = x / rij
512 drdy = y / rij
513 drdz = z / rij
514
515 x2 = x*x
516 y2 = y*y
517 z2 = z*z
518 r3 = r2*rij
519 r4 = r2*r2
520
521 Vmorse = D0 * (expfnc02 - 2.0_dp * expfnc0)
522
523 ! angular modulation of morse part of potential to approximate
524 ! the squares of the two HOMO lone pair orbitals in water:
525 !
526 ! s = 1 / (4 pi)
527 ! a1 = (s + pz)^2 = (1 - sqrt(3)*cos(theta))^2 / (4 pi)
528 ! b1 = px^2 = 3 * (sin(theta)*cos(phi))^2 / (4 pi)
529
530 ! we'll leave out the 4 pi for now
531
532 s = 1.0_dp
533 a1 = (1.0_dp + st * z / rij )**2
534 b1 = 3.0_dp * (x2 - y2)/ r2
535
536 Vang = s + ca1 * a1 + cb1 * b1
537
538 pot_temp = Vmorse*Vang
539
540 vpair = vpair + pot_temp
541
542 if (do_pot) then
543 #ifdef IS_MPI
544 pot_row(VDW_POT,atom1) = pot_row(VDW_POT,atom1) + 0.5_dp*pot_temp*sw
545 pot_col(VDW_POT,atom2) = pot_col(VDW_POT,atom2) + 0.5_dp*pot_temp*sw
546 #else
547 pot = pot + pot_temp*sw
548 #endif
549 endif
550
551 dVmorsedr = 2.0_dp*D0*beta0*(expfnc0 - expfnc02)
552
553 dVmorsedx = dVmorsedr * drdx
554 dVmorsedy = dVmorsedr * drdy
555 dVmorsedz = dVmorsedr * drdz
556
557 da1dx = 2.0_dp * st * x * z / r3 - 6.0_dp * x * z2 / r4
558 da1dy = 2.0_dp * st * y * z / r3 - 6.0_dp * y * z2 / r4
559 da1dz = 2.0_dp * st * (x2 + y2) * (st * z - rij ) / r4
560
561 db1dx = 6.0_dp * x * z2 / r4
562 db1dy = 6.0_dp * y * z2 / r4
563 db1dz = -6.0_dp * (x2 + y2) * z / r4
564
565 dVangdx = ca1 * da1dx + cb1 * db1dx
566 dVangdy = ca1 * da1dy + cb1 * db1dy
567 dVangdz = ca1 * da1dz + cb1 * db1dz
568
569 ! chain rule to put these back on x, y, z
570 dvdx = Vang * dVmorsedx + Vmorse * dVangdx
571 dvdy = Vang * dVmorsedy + Vmorse * dVangdy
572 dvdz = Vang * dVmorsedz + Vmorse * dVangdz
573
574 ! Torques for Vang using method of Price:
575 ! S. L. Price, A. J. Stone, and M. Alderton, Mol. Phys. 52, 987 (1984).
576
577 da1dux = 6.0_dp * y * z / r2 - 2.0_dp * st * y / rij
578 da1duy = -6.0_dp * x * z / r2 + 2.0_dp * st * x / rij
579 da1duz = 0.0_dp
580
581 db1dux = 6.0_dp * y * z / r2
582 db1duy = 6.0_dp * x * z / r2
583 db1duz = -12.0_dp * y * x / r2
584
585 dVangdux = ca1 * da1dux + cb1 * db1dux
586 dVangduy = ca1 * da1duy + cb1 * db1duy
587 dVangduz = ca1 * da1duz + cb1 * db1duz
588
589 ! do the torques first since they are easy:
590 ! remember that these are still in the body fixed axes
591
592 tx = Vmorse * dVangdux * sw
593 ty = Vmorse * dVangduy * sw
594 tz = Vmorse * dVangduz * sw
595
596 ! go back to lab frame using transpose of rotation matrix:
597
598 #ifdef IS_MPI
599 if (atid2.eq.MnM_Map%interactions(interaction_id)%metal_atid) then
600 t_Row(1,atom1) = t_Row(1,atom1) + a_Row(1,atom1)*tx + &
601 a_Row(4,atom1)*ty + a_Row(7,atom1)*tz
602 t_Row(2,atom1) = t_Row(2,atom1) + a_Row(2,atom1)*tx + &
603 a_Row(5,atom1)*ty + a_Row(8,atom1)*tz
604 t_Row(3,atom1) = t_Row(3,atom1) + a_Row(3,atom1)*tx + &
605 a_Row(6,atom1)*ty + a_Row(9,atom1)*tz
606 else
607 t_Col(1,atom2) = t_Col(1,atom2) + a_Col(1,atom2)*tx + &
608 a_Col(4,atom2)*ty + a_Col(7,atom2)*tz
609 t_Col(2,atom2) = t_Col(2,atom2) + a_Col(2,atom2)*tx + &
610 a_Col(5,atom2)*ty + a_Col(8,atom2)*tz
611 t_Col(3,atom2) = t_Col(3,atom2) + a_Col(3,atom2)*tx + &
612 a_Col(6,atom2)*ty + a_Col(9,atom2)*tz
613 endif
614 #else
615 if (atid2.eq.MnM_Map%interactions(interaction_id)%metal_atid) then
616 t(1,atom1) = t(1,atom1) + a(1,atom1)*tx + a(4,atom1)*ty + &
617 a(7,atom1)*tz
618 t(2,atom1) = t(2,atom1) + a(2,atom1)*tx + a(5,atom1)*ty + &
619 a(8,atom1)*tz
620 t(3,atom1) = t(3,atom1) + a(3,atom1)*tx + a(6,atom1)*ty + &
621 a(9,atom1)*tz
622 else
623 t(1,atom2) = t(1,atom2) + a(1,atom2)*tx + a(4,atom2)*ty + &
624 a(7,atom2)*tz
625 t(2,atom2) = t(2,atom2) + a(2,atom2)*tx + a(5,atom2)*ty + &
626 a(8,atom2)*tz
627 t(3,atom2) = t(3,atom2) + a(3,atom2)*tx + a(6,atom2)*ty + &
628 a(9,atom2)*tz
629 endif
630 #endif
631 ! Now, on to the forces (still in body frame of water)
632
633 fx = dvdx * sw
634 fy = dvdy * sw
635 fz = dvdz * sw
636
637 ! rotate the terms back into the lab frame:
638
639 #ifdef IS_MPI
640 if (atid2.eq.MnM_Map%interactions(interaction_id)%metal_atid) then
641 fxl = a_Row(1,atom1)*fx + a_Row(4,atom1)*fy + a_Row(7,atom1)*fz
642 fyl = a_Row(2,atom1)*fx + a_Row(5,atom1)*fy + a_Row(8,atom1)*fz
643 fzl = a_Row(3,atom1)*fx + a_Row(6,atom1)*fy + a_Row(9,atom1)*fz
644 else
645 ! negative sign because this is the vector from j to i:
646 fxl = -(a_Col(1,atom2)*fx + a_Col(4,atom2)*fy + a_Col(7,atom2)*fz)
647 fyl = -(a_Col(2,atom2)*fx + a_Col(5,atom2)*fy + a_Col(8,atom2)*fz)
648 fzl = -(a_Col(3,atom2)*fx + a_Col(6,atom2)*fy + a_Col(9,atom2)*fz)
649 endif
650 f_Row(1,atom1) = f_Row(1,atom1) + fxl
651 f_Row(2,atom1) = f_Row(2,atom1) + fyl
652 f_Row(3,atom1) = f_Row(3,atom1) + fzl
653
654 f_Col(1,atom2) = f_Col(1,atom2) - fxl
655 f_Col(2,atom2) = f_Col(2,atom2) - fyl
656 f_Col(3,atom2) = f_Col(3,atom2) - fzl
657 #else
658 if (atid2.eq.MnM_Map%interactions(interaction_id)%metal_atid) then
659 fxl = a(1,atom1)*fx + a(4,atom1)*fy + a(7,atom1)*fz
660 fyl = a(2,atom1)*fx + a(5,atom1)*fy + a(8,atom1)*fz
661 fzl = a(3,atom1)*fx + a(6,atom1)*fy + a(9,atom1)*fz
662 else
663 ! negative sign because this is the vector from j to i:
664 fxl = -(a(1,atom2)*fx + a(4,atom2)*fy + a(7,atom2)*fz)
665 fyl = -(a(2,atom2)*fx + a(5,atom2)*fy + a(8,atom2)*fz)
666 fzl = -(a(3,atom2)*fx + a(6,atom2)*fy + a(9,atom2)*fz)
667 endif
668 f(1,atom1) = f(1,atom1) + fxl
669 f(2,atom1) = f(2,atom1) + fyl
670 f(3,atom1) = f(3,atom1) + fzl
671
672 f(1,atom2) = f(1,atom2) - fxl
673 f(2,atom2) = f(2,atom2) - fyl
674 f(3,atom2) = f(3,atom2) - fzl
675 #endif
676
677 #ifdef IS_MPI
678 id1 = AtomRowToGlobal(atom1)
679 id2 = AtomColToGlobal(atom2)
680 #else
681 id1 = atom1
682 id2 = atom2
683 #endif
684
685 if (molMembershipList(id1) .ne. molMembershipList(id2)) then
686
687 fpair(1) = fpair(1) + fxl
688 fpair(2) = fpair(2) + fyl
689 fpair(3) = fpair(3) + fzl
690
691 endif
692
693 return
694 end subroutine calc_mnm_maw
695
696
697 subroutine setMnMDefaultCutoff(thisRcut, shiftedPot, shiftedFrc)
698 real(kind=dp), intent(in) :: thisRcut
699 logical, intent(in) :: shiftedPot
700 logical, intent(in) :: shiftedFrc
701 integer i, nInteractions
702 defaultCutoff = thisRcut
703 defaultShiftPot = shiftedPot
704 defaultShiftFrc = shiftedFrc
705
706 if (associated(MnM_Map)) then
707 if(MnM_Map%interactionCount /= 0) then
708 nInteractions = MnM_Map%interactionCount
709
710 do i = 1, nInteractions
711 MnM_Map%interactions(i)%shiftedPot = shiftedPot
712 MnM_Map%interactions(i)%shiftedFrc = shiftedFrc
713 MnM_Map%interactions(i)%rCut = thisRcut
714 MnM_Map%interactions(i)%rCutWasSet = .true.
715 enddo
716 end if
717 end if
718
719 end subroutine setMnMDefaultCutoff
720
721 subroutine copyAllData(v1, v2)
722 type(MnMinteractionMap), pointer :: v1
723 type(MnMinteractionMap), pointer :: v2
724 integer :: i, j
725
726 do i = 1, v1%interactionCount
727 v2%interactions(i) = v1%interactions(i)
728 enddo
729
730 v2%interactionCount = v1%interactionCount
731 return
732 end subroutine copyAllData
733
734 subroutine addInteraction(myInteraction)
735 type(MNMtype) :: myInteraction
736 type(MnMinteraction) :: nt
737 integer :: id
738
739 nt%interaction_type = myInteraction%MNMInteractionType
740 nt%metal_atid = &
741 getFirstMatchingElement(atypes, "c_ident", myInteraction%metal_atid)
742 nt%nonmetal_atid = &
743 getFirstMatchingElement(atypes, "c_ident", myInteraction%nonmetal_atid)
744
745 select case (nt%interaction_type)
746 case (MNM_LENNARDJONES)
747 nt%sigma = myInteraction%sigma
748 nt%epsilon = myInteraction%epsilon
749 case(MNM_REPULSIVEMORSE, MNM_SHIFTEDMORSE)
750 nt%R0 = myInteraction%R0
751 nt%D0 = myInteraction%D0
752 nt%beta0 = myInteraction%beta0
753 case(MNM_MAW)
754 nt%R0 = myInteraction%R0
755 nt%D0 = myInteraction%D0
756 nt%beta0 = myInteraction%beta0
757 nt%ca1 = myInteraction%ca1
758 nt%cb1 = myInteraction%cb1
759 case default
760 call handleError("MNM", "Unknown Interaction type")
761 end select
762
763 if (.not. associated(MnM_Map)) then
764 call ensureCapacityHelper(MnM_Map, 1)
765 else
766 call ensureCapacityHelper(MnM_Map, MnM_Map%interactionCount + 1)
767 end if
768
769 MnM_Map%interactionCount = MnM_Map%interactionCount + 1
770 id = MnM_Map%interactionCount
771 MnM_Map%interactions(id) = nt
772 end subroutine addInteraction
773
774 subroutine ensureCapacityHelper(this, minCapacity)
775 type(MnMinteractionMap), pointer :: this, that
776 integer, intent(in) :: minCapacity
777 integer :: oldCapacity
778 integer :: newCapacity
779 logical :: resizeFlag
780
781 resizeFlag = .false.
782
783 ! first time: allocate a new vector with default size
784
785 if (.not. associated(this)) then
786 this => MnMinitialize(minCapacity, 0)
787 endif
788
789 oldCapacity = size(this%interactions)
790
791 if (minCapacity > oldCapacity) then
792 if (this%capacityIncrement .gt. 0) then
793 newCapacity = oldCapacity + this%capacityIncrement
794 else
795 newCapacity = oldCapacity * 2
796 endif
797 if (newCapacity .lt. minCapacity) then
798 newCapacity = minCapacity
799 endif
800 resizeFlag = .true.
801 else
802 newCapacity = oldCapacity
803 endif
804
805 if (resizeFlag) then
806 that => MnMinitialize(newCapacity, this%capacityIncrement)
807 call copyAllData(this, that)
808 this => MnMdestroy(this)
809 this => that
810 endif
811 end subroutine ensureCapacityHelper
812
813 function MnMinitialize(cap, capinc) result(this)
814 integer, intent(in) :: cap, capinc
815 integer :: error
816 type(MnMinteractionMap), pointer :: this
817
818 nullify(this)
819
820 if (cap < 0) then
821 write(*,*) 'Bogus Capacity:', cap
822 return
823 endif
824 allocate(this,stat=error)
825 if ( error /= 0 ) then
826 write(*,*) 'Could not allocate MnMinteractionMap!'
827 return
828 end if
829
830 this%initialCapacity = cap
831 this%capacityIncrement = capinc
832
833 allocate(this%interactions(this%initialCapacity), stat=error)
834 if(error /= 0) write(*,*) 'Could not allocate MnMinteraction!'
835
836 end function MnMinitialize
837
838 subroutine createInteractionLookup(this)
839 type (MnMInteractionMap),pointer :: this
840 integer :: biggestAtid, i, metal_atid, nonmetal_atid, error
841
842 biggestAtid=-1
843 do i = 1, this%interactionCount
844 metal_atid = this%interactions(i)%metal_atid
845 nonmetal_atid = this%interactions(i)%nonmetal_atid
846
847 if (metal_atid .gt. biggestAtid) biggestAtid = metal_atid
848 if (nonmetal_atid .gt. biggestAtid) biggestAtid = nonmetal_atid
849 enddo
850
851 allocate(MnMinteractionLookup(biggestAtid,biggestAtid), stat=error)
852 if (error /= 0) write(*,*) 'Could not allocate MnMinteractionLookup'
853
854 do i = 1, this%interactionCount
855 metal_atid = this%interactions(i)%metal_atid
856 nonmetal_atid = this%interactions(i)%nonmetal_atid
857
858 MnMinteractionLookup(metal_atid, nonmetal_atid) = i
859 MnMinteractionLookup(nonmetal_atid, metal_atid) = i
860 enddo
861 end subroutine createInteractionLookup
862
863 function MnMdestroy(this) result(null_this)
864 logical :: done
865 type(MnMinteractionMap), pointer :: this
866 type(MnMinteractionMap), pointer :: null_this
867
868 if (.not. associated(this)) then
869 null_this => null()
870 return
871 end if
872
873 !! Walk down the list and deallocate each of the map's components
874 if(associated(this%interactions)) then
875 deallocate(this%interactions)
876 this%interactions=>null()
877 endif
878 deallocate(this)
879 this => null()
880 null_this => null()
881 end function MnMdestroy
882
883 subroutine deleteInteractions()
884 MnM_Map => MnMdestroy(MnM_Map)
885 return
886 end subroutine deleteInteractions
887
888 subroutine getLJfunc(r, myPot, myDeriv)
889
890 real(kind=dp), intent(in) :: r
891 real(kind=dp), intent(inout) :: myPot, myDeriv
892 real(kind=dp) :: ri, ri2, ri6, ri7, ri12, ri13
893 real(kind=dp) :: a, b, c, d, dx
894 integer :: j
895
896 ri = 1.0_DP / r
897 ri2 = ri*ri
898 ri6 = ri2*ri2*ri2
899 ri7 = ri6*ri
900 ri12 = ri6*ri6
901 ri13 = ri12*ri
902
903 myPot = 4.0_DP * (ri12 - ri6)
904 myDeriv = 24.0_DP * (ri7 - 2.0_DP * ri13)
905
906 return
907 end subroutine getLJfunc
908
909 subroutine getSoftFunc(r, myPot, myDeriv)
910
911 real(kind=dp), intent(in) :: r
912 real(kind=dp), intent(inout) :: myPot, myDeriv
913 real(kind=dp) :: ri, ri2, ri6, ri7
914 real(kind=dp) :: a, b, c, d, dx
915 integer :: j
916
917 ri = 1.0_DP / r
918 ri2 = ri*ri
919 ri6 = ri2*ri2*ri2
920 ri7 = ri6*ri
921 myPot = 4.0_DP * (ri6)
922 myDeriv = - 24.0_DP * ri7
923
924 return
925 end subroutine getSoftFunc
926 end module MetalNonMetal