ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE/libmdtools/calc_sticky_pair.F90
Revision: 635
Committed: Thu Jul 17 20:32:24 2003 UTC (20 years, 11 months ago) by gezelter
File size: 13731 byte(s)
Log Message:
Changes for SSD/E

File Contents

# User Rev Content
1 mmeineke 377 !! This Module Calculates forces due to SSD potential and VDW interactions
2     !! [Chandra and Ichiye, J. Chem. Phys. 111, 2701 (1999)].
3    
4     !! This module contains the Public procedures:
5    
6    
7     !! Corresponds to the force field defined in ssd_FF.cpp
8     !! @author Charles F. Vardeman II
9     !! @author Matthew Meineke
10     !! @author Christopher Fennel
11     !! @author J. Daniel Gezelter
12 gezelter 635 !! @version $Id: calc_sticky_pair.F90,v 1.11 2003-07-17 20:32:24 gezelter Exp $, $Date: 2003-07-17 20:32:24 $, $Name: not supported by cvs2svn $, $Revision: 1.11 $
13 mmeineke 377
14     module sticky_pair
15    
16     use force_globals
17     use definitions
18 chuckv 460 use simulation
19 mmeineke 377 #ifdef IS_MPI
20     use mpiSimulation
21     #endif
22    
23     implicit none
24    
25     PRIVATE
26    
27     logical, save :: sticky_initialized = .false.
28 mmeineke 469 real( kind = dp ), save :: SSD_w0 = 0.0_dp
29     real( kind = dp ), save :: SSD_v0 = 0.0_dp
30 gezelter 635 real( kind = dp ), save :: SSD_v0p = 0.0_dp
31 mmeineke 469 real( kind = dp ), save :: SSD_rl = 0.0_dp
32     real( kind = dp ), save :: SSD_ru = 0.0_dp
33 gezelter 635 real( kind = dp ), save :: SSD_rlp = 0.0_dp
34 mmeineke 469 real( kind = dp ), save :: SSD_rup = 0.0_dp
35 mmeineke 377
36     public :: check_sticky_FF
37     public :: set_sticky_params
38     public :: do_sticky_pair
39    
40     contains
41    
42     subroutine check_sticky_FF(status)
43     integer :: status
44     status = -1
45     if (sticky_initialized) status = 0
46     return
47     end subroutine check_sticky_FF
48    
49 gezelter 635 subroutine set_sticky_params(sticky_w0, sticky_v0, sticky_v0p, &
50     sticky_rl, sticky_ru, sticky_rlp, sticky_rup)
51    
52     real( kind = dp ), intent(in) :: sticky_w0, sticky_v0, sticky_v0p
53     real( kind = dp ), intent(in) :: sticky_rl, sticky_ru
54     real( kind = dp ), intent(in) :: sticky_rlp, sticky_rup
55 mmeineke 377
56     ! we could pass all 5 parameters if we felt like it...
57    
58     SSD_w0 = sticky_w0
59     SSD_v0 = sticky_v0
60 gezelter 635 SSD_v0p = sticky_v0p
61     SSD_rl = sticky_rl
62     SSD_ru = sticky_ru
63     SSD_rlp = sticky_rlp
64     SSD_rup = sticky_rup
65 mmeineke 377
66     sticky_initialized = .true.
67     return
68     end subroutine set_sticky_params
69    
70     subroutine do_sticky_pair(atom1, atom2, d, rij, r2, A, pot, f, t, &
71     do_pot, do_stress)
72 mmeineke 534
73 mmeineke 377 !! This routine does only the sticky portion of the SSD potential
74     !! [Chandra and Ichiye, J. Chem. Phys. 111, 2701 (1999)].
75     !! The Lennard-Jones and dipolar interaction must be handled separately.
76 mmeineke 534
77 mmeineke 377 !! We assume that the rotation matrices have already been calculated
78     !! and placed in the A array.
79 mmeineke 534
80 mmeineke 377 !! i and j are pointers to the two SSD atoms
81    
82     integer, intent(in) :: atom1, atom2
83     real (kind=dp), intent(inout) :: rij, r2
84     real (kind=dp), dimension(3), intent(in) :: d
85     real (kind=dp) :: pot
86 chuckv 460 real (kind=dp), dimension(9,getNlocal()) :: A
87     real (kind=dp), dimension(3,getNlocal()) :: f
88     real (kind=dp), dimension(3,getNlocal()) :: t
89 mmeineke 377 logical, intent(in) :: do_pot, do_stress
90    
91     real (kind=dp) :: xi, yi, zi, xj, yj, zj, xi2, yi2, zi2, xj2, yj2, zj2
92     real (kind=dp) :: r3, r5, r6, s, sp, dsdr, dspdr
93     real (kind=dp) :: wi, wj, w, wip, wjp, wp
94     real (kind=dp) :: dwidx, dwidy, dwidz, dwjdx, dwjdy, dwjdz
95     real (kind=dp) :: dwipdx, dwipdy, dwipdz, dwjpdx, dwjpdy, dwjpdz
96     real (kind=dp) :: dwidux, dwiduy, dwiduz, dwjdux, dwjduy, dwjduz
97     real (kind=dp) :: dwipdux, dwipduy, dwipduz, dwjpdux, dwjpduy, dwjpduz
98     real (kind=dp) :: zif, zis, zjf, zjs, uglyi, uglyj
99     real (kind=dp) :: drdx, drdy, drdz
100     real (kind=dp) :: txi, tyi, tzi, txj, tyj, tzj
101     real (kind=dp) :: fxii, fyii, fzii, fxjj, fyjj, fzjj
102     real (kind=dp) :: fxij, fyij, fzij, fxji, fyji, fzji
103     real (kind=dp) :: fxradial, fyradial, fzradial
104 gezelter 394 real (kind=dp) :: rijtest, rjitest
105 mmeineke 534 real (kind=dp) :: radcomxi, radcomyi, radcomzi
106     real (kind=dp) :: radcomxj, radcomyj, radcomzj
107    
108    
109 mmeineke 377 if (.not.sticky_initialized) then
110     write(*,*) 'Sticky forces not initialized!'
111     return
112     endif
113    
114 mmeineke 534 if ( rij .LE. SSD_rup ) then
115    
116     r3 = r2*rij
117     r5 = r3*r2
118    
119     drdx = d(1) / rij
120     drdy = d(2) / rij
121     drdz = d(3) / rij
122    
123 mmeineke 377 #ifdef IS_MPI
124 mmeineke 534 ! rotate the inter-particle separation into the two different
125     ! body-fixed coordinate systems:
126    
127     xi = A_row(1,atom1)*d(1) + A_row(2,atom1)*d(2) + A_row(3,atom1)*d(3)
128     yi = A_row(4,atom1)*d(1) + A_row(5,atom1)*d(2) + A_row(6,atom1)*d(3)
129     zi = A_row(7,atom1)*d(1) + A_row(8,atom1)*d(2) + A_row(9,atom1)*d(3)
130    
131     ! negative sign because this is the vector from j to i:
132    
133     xj = -(A_Col(1,atom2)*d(1) + A_Col(2,atom2)*d(2) + A_Col(3,atom2)*d(3))
134     yj = -(A_Col(4,atom2)*d(1) + A_Col(5,atom2)*d(2) + A_Col(6,atom2)*d(3))
135     zj = -(A_Col(7,atom2)*d(1) + A_Col(8,atom2)*d(2) + A_Col(9,atom2)*d(3))
136 mmeineke 377 #else
137 mmeineke 534 ! rotate the inter-particle separation into the two different
138     ! body-fixed coordinate systems:
139    
140     xi = a(1,atom1)*d(1) + a(2,atom1)*d(2) + a(3,atom1)*d(3)
141     yi = a(4,atom1)*d(1) + a(5,atom1)*d(2) + a(6,atom1)*d(3)
142     zi = a(7,atom1)*d(1) + a(8,atom1)*d(2) + a(9,atom1)*d(3)
143    
144     ! negative sign because this is the vector from j to i:
145    
146     xj = -(a(1,atom2)*d(1) + a(2,atom2)*d(2) + a(3,atom2)*d(3))
147     yj = -(a(4,atom2)*d(1) + a(5,atom2)*d(2) + a(6,atom2)*d(3))
148     zj = -(a(7,atom2)*d(1) + a(8,atom2)*d(2) + a(9,atom2)*d(3))
149 mmeineke 377 #endif
150    
151 mmeineke 534 xi2 = xi*xi
152     yi2 = yi*yi
153     zi2 = zi*zi
154    
155     xj2 = xj*xj
156     yj2 = yj*yj
157     zj2 = zj*zj
158    
159     call calc_sw_fnc(rij, s, sp, dsdr, dspdr)
160    
161     wi = 2.0d0*(xi2-yi2)*zi / r3
162     wj = 2.0d0*(xj2-yj2)*zj / r3
163     w = wi+wj
164    
165     zif = zi/rij - 0.6d0
166     zis = zi/rij + 0.8d0
167    
168     zjf = zj/rij - 0.6d0
169     zjs = zj/rij + 0.8d0
170    
171     wip = zif*zif*zis*zis - SSD_w0
172     wjp = zjf*zjf*zjs*zjs - SSD_w0
173     wp = wip + wjp
174    
175     if (do_pot) then
176 mmeineke 377 #ifdef IS_MPI
177 gezelter 635 pot_row(atom1) = pot_row(atom1) + 0.25d0*(SSD_v0*s*w + SSD_v0p*sp*wp)
178     pot_col(atom2) = pot_col(atom2) + 0.25d0*(SSD_v0*s*w + SSD_v0p*sp*wp)
179 mmeineke 377 #else
180 gezelter 635 pot = pot + 0.5d0*(SSD_v0*s*w + SSD_v0p*sp*wp)
181 mmeineke 377 #endif
182 mmeineke 534 endif
183    
184     dwidx = 4.0d0*xi*zi/r3 - 6.0d0*xi*zi*(xi2-yi2)/r5
185     dwidy = - 4.0d0*yi*zi/r3 - 6.0d0*yi*zi*(xi2-yi2)/r5
186     dwidz = 2.0d0*(xi2-yi2)/r3 - 6.0d0*zi2*(xi2-yi2)/r5
187    
188     dwjdx = 4.0d0*xj*zj/r3 - 6.0d0*xj*zj*(xj2-yj2)/r5
189     dwjdy = - 4.0d0*yj*zj/r3 - 6.0d0*yj*zj*(xj2-yj2)/r5
190     dwjdz = 2.0d0*(xj2-yj2)/r3 - 6.0d0*zj2*(xj2-yj2)/r5
191    
192     uglyi = zif*zif*zis + zif*zis*zis
193     uglyj = zjf*zjf*zjs + zjf*zjs*zjs
194    
195     dwipdx = -2.0d0*xi*zi*uglyi/r3
196     dwipdy = -2.0d0*yi*zi*uglyi/r3
197     dwipdz = 2.0d0*(1.0d0/rij - zi2/r3)*uglyi
198    
199     dwjpdx = -2.0d0*xj*zj*uglyj/r3
200     dwjpdy = -2.0d0*yj*zj*uglyj/r3
201     dwjpdz = 2.0d0*(1.0d0/rij - zj2/r3)*uglyj
202    
203     dwidux = 4.0d0*(yi*zi2 + 0.5d0*yi*(xi2-yi2))/r3
204     dwiduy = 4.0d0*(xi*zi2 - 0.5d0*xi*(xi2-yi2))/r3
205     dwiduz = - 8.0d0*xi*yi*zi/r3
206    
207     dwjdux = 4.0d0*(yj*zj2 + 0.5d0*yj*(xj2-yj2))/r3
208     dwjduy = 4.0d0*(xj*zj2 - 0.5d0*xj*(xj2-yj2))/r3
209     dwjduz = - 8.0d0*xj*yj*zj/r3
210    
211     dwipdux = 2.0d0*yi*uglyi/rij
212     dwipduy = -2.0d0*xi*uglyi/rij
213     dwipduz = 0.0d0
214    
215     dwjpdux = 2.0d0*yj*uglyj/rij
216     dwjpduy = -2.0d0*xj*uglyj/rij
217     dwjpduz = 0.0d0
218    
219     ! do the torques first since they are easy:
220     ! remember that these are still in the body fixed axes
221    
222 gezelter 635 txi = 0.5d0*(SSD_v0*s*dwidux + SSD_v0p*sp*dwipdux)
223     tyi = 0.5d0*(SSD_v0*s*dwiduy + SSD_v0p*sp*dwipduy)
224     tzi = 0.5d0*(SSD_v0*s*dwiduz + SSD_v0p*sp*dwipduz)
225 mmeineke 534
226 gezelter 635 txj = 0.5d0*(SSD_v0*s*dwjdux + SSD_v0p*sp*dwjpdux)
227     tyj = 0.5d0*(SSD_v0*s*dwjduy + SSD_v0p*sp*dwjpduy)
228     tzj = 0.5d0*(SSD_v0*s*dwjduz + SSD_v0p*sp*dwjpduz)
229 mmeineke 534
230     ! go back to lab frame using transpose of rotation matrix:
231    
232 mmeineke 377 #ifdef IS_MPI
233 mmeineke 534 t_Row(1,atom1) = t_Row(1,atom1) + a_Row(1,atom1)*txi + &
234     a_Row(4,atom1)*tyi + a_Row(7,atom1)*tzi
235     t_Row(2,atom1) = t_Row(2,atom1) + a_Row(2,atom1)*txi + &
236     a_Row(5,atom1)*tyi + a_Row(8,atom1)*tzi
237     t_Row(3,atom1) = t_Row(3,atom1) + a_Row(3,atom1)*txi + &
238     a_Row(6,atom1)*tyi + a_Row(9,atom1)*tzi
239    
240     t_Col(1,atom2) = t_Col(1,atom2) + a_Col(1,atom2)*txj + &
241     a_Col(4,atom2)*tyj + a_Col(7,atom2)*tzj
242     t_Col(2,atom2) = t_Col(2,atom2) + a_Col(2,atom2)*txj + &
243     a_Col(5,atom2)*tyj + a_Col(8,atom2)*tzj
244     t_Col(3,atom2) = t_Col(3,atom2) + a_Col(3,atom2)*txj + &
245     a_Col(6,atom2)*tyj + a_Col(9,atom2)*tzj
246 mmeineke 377 #else
247 mmeineke 534 t(1,atom1) = t(1,atom1) + a(1,atom1)*txi + a(4,atom1)*tyi + a(7,atom1)*tzi
248     t(2,atom1) = t(2,atom1) + a(2,atom1)*txi + a(5,atom1)*tyi + a(8,atom1)*tzi
249     t(3,atom1) = t(3,atom1) + a(3,atom1)*txi + a(6,atom1)*tyi + a(9,atom1)*tzi
250    
251     t(1,atom2) = t(1,atom2) + a(1,atom2)*txj + a(4,atom2)*tyj + a(7,atom2)*tzj
252     t(2,atom2) = t(2,atom2) + a(2,atom2)*txj + a(5,atom2)*tyj + a(8,atom2)*tzj
253     t(3,atom2) = t(3,atom2) + a(3,atom2)*txj + a(6,atom2)*tyj + a(9,atom2)*tzj
254 mmeineke 377 #endif
255 mmeineke 534 ! Now, on to the forces:
256 mmeineke 377
257 mmeineke 534 ! first rotate the i terms back into the lab frame:
258    
259 gezelter 635 radcomxi = SSD_v0*s*dwidx+SSD_v0p*sp*dwipdx
260     radcomyi = SSD_v0*s*dwidy+SSD_v0p*sp*dwipdy
261     radcomzi = SSD_v0*s*dwidz+SSD_v0p*sp*dwipdz
262 mmeineke 534
263 gezelter 635 radcomxj = SSD_v0*s*dwjdx+SSD_v0p*sp*dwjpdx
264     radcomyj = SSD_v0*s*dwjdy+SSD_v0p*sp*dwjpdy
265     radcomzj = SSD_v0*s*dwjdz+SSD_v0p*sp*dwjpdz
266 mmeineke 534
267 mmeineke 377 #ifdef IS_MPI
268 mmeineke 534 fxii = a_Row(1,atom1)*(radcomxi) + &
269     a_Row(4,atom1)*(radcomyi) + &
270     a_Row(7,atom1)*(radcomzi)
271     fyii = a_Row(2,atom1)*(radcomxi) + &
272     a_Row(5,atom1)*(radcomyi) + &
273     a_Row(8,atom1)*(radcomzi)
274     fzii = a_Row(3,atom1)*(radcomxi) + &
275     a_Row(6,atom1)*(radcomyi) + &
276     a_Row(9,atom1)*(radcomzi)
277 mmeineke 377
278 mmeineke 534 fxjj = a_Col(1,atom2)*(radcomxj) + &
279     a_Col(4,atom2)*(radcomyj) + &
280     a_Col(7,atom2)*(radcomzj)
281     fyjj = a_Col(2,atom2)*(radcomxj) + &
282     a_Col(5,atom2)*(radcomyj) + &
283     a_Col(8,atom2)*(radcomzj)
284     fzjj = a_Col(3,atom2)*(radcomxj)+ &
285     a_Col(6,atom2)*(radcomyj) + &
286     a_Col(9,atom2)*(radcomzj)
287 mmeineke 377 #else
288 mmeineke 534 fxii = a(1,atom1)*(radcomxi) + &
289     a(4,atom1)*(radcomyi) + &
290     a(7,atom1)*(radcomzi)
291     fyii = a(2,atom1)*(radcomxi) + &
292     a(5,atom1)*(radcomyi) + &
293     a(8,atom1)*(radcomzi)
294     fzii = a(3,atom1)*(radcomxi) + &
295     a(6,atom1)*(radcomyi) + &
296     a(9,atom1)*(radcomzi)
297 mmeineke 377
298 mmeineke 534 fxjj = a(1,atom2)*(radcomxj) + &
299     a(4,atom2)*(radcomyj) + &
300     a(7,atom2)*(radcomzj)
301     fyjj = a(2,atom2)*(radcomxj) + &
302     a(5,atom2)*(radcomyj) + &
303     a(8,atom2)*(radcomzj)
304     fzjj = a(3,atom2)*(radcomxj)+ &
305     a(6,atom2)*(radcomyj) + &
306     a(9,atom2)*(radcomzj)
307 mmeineke 377 #endif
308    
309 mmeineke 534 fxij = -fxii
310     fyij = -fyii
311     fzij = -fzii
312    
313     fxji = -fxjj
314     fyji = -fyjj
315     fzji = -fzjj
316    
317     ! now assemble these with the radial-only terms:
318    
319 gezelter 635 fxradial = 0.5d0*(SSD_v0*dsdr*drdx*w + SSD_v0p*dspdr*drdx*wp + fxii + fxji)
320     fyradial = 0.5d0*(SSD_v0*dsdr*drdy*w + SSD_v0p*dspdr*drdy*wp + fyii + fyji)
321     fzradial = 0.5d0*(SSD_v0*dsdr*drdz*w + SSD_v0p*dspdr*drdz*wp + fzii + fzji)
322 mmeineke 534
323 mmeineke 377 #ifdef IS_MPI
324 mmeineke 534 f_Row(1,atom1) = f_Row(1,atom1) + fxradial
325     f_Row(2,atom1) = f_Row(2,atom1) + fyradial
326     f_Row(3,atom1) = f_Row(3,atom1) + fzradial
327    
328     f_Col(1,atom2) = f_Col(1,atom2) - fxradial
329     f_Col(2,atom2) = f_Col(2,atom2) - fyradial
330     f_Col(3,atom2) = f_Col(3,atom2) - fzradial
331 mmeineke 377 #else
332 mmeineke 534 f(1,atom1) = f(1,atom1) + fxradial
333     f(2,atom1) = f(2,atom1) + fyradial
334     f(3,atom1) = f(3,atom1) + fzradial
335    
336     f(1,atom2) = f(1,atom2) - fxradial
337     f(2,atom2) = f(2,atom2) - fyradial
338     f(3,atom2) = f(3,atom2) - fzradial
339 mmeineke 377 #endif
340 mmeineke 534
341     if (do_stress) then
342     if (molMembershipList(atom1) .ne. molMembershipList(atom2)) then
343 gezelter 611
344     ! because the d vector is the rj - ri vector, and
345     ! because fxradial, fyradial, and fzradial are the
346     ! (positive) force on atom i (negative on atom j) we need
347     ! a negative sign here:
348    
349     tau_Temp(1) = tau_Temp(1) - d(1) * fxradial
350     tau_Temp(2) = tau_Temp(2) - d(1) * fyradial
351     tau_Temp(3) = tau_Temp(3) - d(1) * fzradial
352     tau_Temp(4) = tau_Temp(4) - d(2) * fxradial
353     tau_Temp(5) = tau_Temp(5) - d(2) * fyradial
354     tau_Temp(6) = tau_Temp(6) - d(2) * fzradial
355     tau_Temp(7) = tau_Temp(7) - d(3) * fxradial
356     tau_Temp(8) = tau_Temp(8) - d(3) * fyradial
357     tau_Temp(9) = tau_Temp(9) - d(3) * fzradial
358    
359 mmeineke 534 virial_Temp = virial_Temp + (tau_Temp(1) + tau_Temp(5) + tau_Temp(9))
360     endif
361 gezelter 483 endif
362 mmeineke 377 endif
363 mmeineke 534
364 mmeineke 377 end subroutine do_sticky_pair
365    
366     !! calculates the switching functions and their derivatives for a given
367     subroutine calc_sw_fnc(r, s, sp, dsdr, dspdr)
368 gezelter 635
369 mmeineke 377 real (kind=dp), intent(in) :: r
370     real (kind=dp), intent(inout) :: s, sp, dsdr, dspdr
371 gezelter 635
372 mmeineke 377 ! distances must be in angstroms
373    
374     if (r.lt.SSD_rl) then
375     s = 1.0d0
376     dsdr = 0.0d0
377 gezelter 635 elseif (r.gt.SSD_ru) then
378     s = 0.0d0
379     dsdr = 0.0d0
380     else
381     s = ((SSD_ru + 2.0d0*r - 3.0d0*SSD_rl) * (SSD_ru-r)**2) / &
382     ((SSD_ru - SSD_rl)**3)
383     dsdr = 6.0d0*(r-SSD_ru)*(r-SSD_rl)/((SSD_ru - SSD_rl)**3)
384     endif
385    
386     if (r.lt.SSD_rlp) then
387     sp = 1.0d0
388 mmeineke 377 dspdr = 0.0d0
389     elseif (r.gt.SSD_rup) then
390     sp = 0.0d0
391     dspdr = 0.0d0
392     else
393 gezelter 635 sp = ((SSD_rup + 2.0d0*r - 3.0d0*SSD_rlp) * (SSD_rup-r)**2) / &
394     ((SSD_rup - SSD_rlp)**3)
395     dspdr = 6.0d0*(r-SSD_rup)*(r-SSD_rlp)/((SSD_rup - SSD_rlp)**3)
396 mmeineke 377 endif
397    
398     return
399     end subroutine calc_sw_fnc
400     end module sticky_pair