ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-4/src/UseTheForce/DarkSide/gb.F90
Revision: 2226
Committed: Tue May 17 02:09:25 2005 UTC (19 years, 1 month ago) by kdaily
File size: 13806 byte(s)
Log Message:
added gb

File Contents

# User Rev Content
1 gezelter 1930 !!
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    
43 gezelter 1608 module gb_pair
44     use force_globals
45     use definitions
46     use simulation
47     #ifdef IS_MPI
48     use mpiSimulation
49     #endif
50 kdaily 2226
51 gezelter 1608 implicit none
52    
53     PRIVATE
54    
55     logical, save :: gb_pair_initialized = .false.
56     real(kind=dp), save :: gb_sigma
57     real(kind=dp), save :: gb_l2b_ratio
58     real(kind=dp), save :: gb_eps
59     real(kind=dp), save :: gb_eps_ratio
60     real(kind=dp), save :: gb_mu
61     real(kind=dp), save :: gb_nu
62    
63     public :: check_gb_pair_FF
64     public :: set_gb_pair_params
65     public :: do_gb_pair
66    
67     contains
68    
69     subroutine check_gb_pair_FF(status)
70     integer :: status
71     status = -1
72     if (gb_pair_initialized) status = 0
73     return
74     end subroutine check_gb_pair_FF
75    
76     subroutine set_gb_pair_params(sigma, l2b_ratio, eps, eps_ratio, mu, nu)
77     real( kind = dp ), intent(in) :: sigma, l2b_ratio, eps, eps_ratio
78     real( kind = dp ), intent(in) :: mu, nu
79 kdaily 2226
80 gezelter 1608 gb_sigma = sigma
81     gb_l2b_ratio = l2b_ratio
82     gb_eps = eps
83     gb_eps_ratio = eps_ratio
84     gb_mu = mu
85     gb_nu = nu
86    
87     gb_pair_initialized = .true.
88     return
89     end subroutine set_gb_pair_params
90    
91    
92     subroutine do_gb_pair(atom1, atom2, d, r, r2, sw, vpair, fpair, &
93 gezelter 1930 pot, A, f, t, do_pot)
94 kdaily 2226
95 gezelter 1608 integer, intent(in) :: atom1, atom2
96     integer :: id1, id2
97     real (kind=dp), intent(inout) :: r, r2
98     real (kind=dp), dimension(3), intent(in) :: d
99     real (kind=dp), dimension(3), intent(inout) :: fpair
100     real (kind=dp) :: pot, sw, vpair
101 gezelter 1930 real (kind=dp), dimension(9,nLocal) :: A
102 gezelter 1608 real (kind=dp), dimension(3,nLocal) :: f
103     real (kind=dp), dimension(3,nLocal) :: t
104     logical, intent(in) :: do_pot
105     real (kind = dp), dimension(3) :: ul1
106     real (kind = dp), dimension(3) :: ul2
107    
108     real(kind=dp) :: chi, chiprime, emu, s2
109     real(kind=dp) :: r4, rdotu1, rdotu2, u1dotu2, g, gp, gpi, gmu, gmum
110     real(kind=dp) :: curlyE, enu, enum, eps, dotsum, dotdiff, ds2, dd2
111     real(kind=dp) :: opXdot, omXdot, opXpdot, omXpdot, pref, gfact
112     real(kind=dp) :: BigR, Ri, Ri2, Ri6, Ri7, Ri12, Ri13, R126, R137
113     real(kind=dp) :: dru1dx, dru1dy, dru1dz
114     real(kind=dp) :: dru2dx, dru2dy, dru2dz
115     real(kind=dp) :: dBigRdx, dBigRdy, dBigRdz
116     real(kind=dp) :: dBigRdu1x, dBigRdu1y, dBigRdu1z
117     real(kind=dp) :: dBigRdu2x, dBigRdu2y, dBigRdu2z
118     real(kind=dp) :: dUdx, dUdy, dUdz
119     real(kind=dp) :: dUdu1x, dUdu1y, dUdu1z, dUdu2x, dUdu2y, dUdu2z
120     real(kind=dp) :: dcE, dcEdu1x, dcEdu1y, dcEdu1z, dcEdu2x, dcEdu2y, dcEdu2z
121     real(kind=dp) :: depsdu1x, depsdu1y, depsdu1z, depsdu2x, depsdu2y, depsdu2z
122     real(kind=dp) :: drdx, drdy, drdz
123     real(kind=dp) :: dgdx, dgdy, dgdz
124     real(kind=dp) :: dgdu1x, dgdu1y, dgdu1z, dgdu2x, dgdu2y, dgdu2z
125     real(kind=dp) :: dgpdx, dgpdy, dgpdz
126     real(kind=dp) :: dgpdu1x, dgpdu1y, dgpdu1z, dgpdu2x, dgpdu2y, dgpdu2z
127     real(kind=dp) :: line1a, line1bx, line1by, line1bz
128     real(kind=dp) :: line2a, line2bx, line2by, line2bz
129     real(kind=dp) :: line3a, line3b, line3, line3x, line3y, line3z
130     real(kind=dp) :: term1x, term1y, term1z, term1u1x, term1u1y, term1u1z
131     real(kind=dp) :: term1u2x, term1u2y, term1u2z
132     real(kind=dp) :: term2a, term2b, term2u1x, term2u1y, term2u1z
133     real(kind=dp) :: term2u2x, term2u2y, term2u2z
134     real(kind=dp) :: yick1, yick2, mess1, mess2
135 kdaily 2226
136 gezelter 1608 s2 = (gb_l2b_ratio)**2
137     emu = (gb_eps_ratio)**(1.0d0/gb_mu)
138    
139     chi = (s2 - 1.0d0)/(s2 + 1.0d0)
140     chiprime = (1.0d0 - emu)/(1.0d0 + emu)
141    
142     r4 = r2*r2
143    
144     #ifdef IS_MPI
145 gezelter 1930 ul1(1) = A_Row(3,atom1)
146     ul1(2) = A_Row(6,atom1)
147     ul1(3) = A_Row(9,atom1)
148 gezelter 1608
149 gezelter 1930 ul2(1) = A_Col(3,atom2)
150     ul2(2) = A_Col(6,atom2)
151     ul2(3) = A_Col(9,atom2)
152 gezelter 1608 #else
153 gezelter 1930 ul1(1) = A(3,atom1)
154     ul1(2) = A(6,atom1)
155     ul1(3) = A(9,atom1)
156 gezelter 1608
157 gezelter 1930 ul2(1) = A(3,atom2)
158     ul2(2) = A(6,atom2)
159     ul2(3) = A(9,atom2)
160 gezelter 1608 #endif
161 kdaily 2226
162 gezelter 1608 dru1dx = ul1(1)
163     dru2dx = ul2(1)
164     dru1dy = ul1(2)
165     dru2dy = ul2(2)
166     dru1dz = ul1(3)
167     dru2dz = ul2(3)
168 kdaily 2226
169 gezelter 1608 drdx = d(1) / r
170     drdy = d(2) / r
171     drdz = d(3) / r
172 kdaily 2226
173 gezelter 1608 ! do some dot products:
174     ! NB the r in these dot products is the actual intermolecular vector,
175     ! and is not the unit vector in that direction.
176 kdaily 2226
177 gezelter 1608 rdotu1 = d(1)*ul1(1) + d(2)*ul1(2) + d(3)*ul1(3)
178     rdotu2 = d(1)*ul2(1) + d(2)*ul2(2) + d(3)*ul2(3)
179     u1dotu2 = ul1(1)*ul2(1) + ul1(2)*ul2(2) + ul1(3)*ul2(3)
180    
181     ! This stuff is all for the calculation of g(Chi) and dgdx
182     ! Line numbers roughly follow the lines in equation A25 of Luckhurst
183     ! et al. Liquid Crystals 8, 451-464 (1990).
184     ! We note however, that there are some major typos in that Appendix
185     ! of the Luckhurst paper, particularly in equations A23, A29 and A31
186     ! We have attempted to correct them below.
187 kdaily 2226
188 gezelter 1608 dotsum = rdotu1+rdotu2
189     dotdiff = rdotu1-rdotu2
190     ds2 = dotsum*dotsum
191     dd2 = dotdiff*dotdiff
192 kdaily 2226
193 gezelter 1608 opXdot = 1.0d0 + Chi*u1dotu2
194     omXdot = 1.0d0 - Chi*u1dotu2
195     opXpdot = 1.0d0 + ChiPrime*u1dotu2
196     omXpdot = 1.0d0 - ChiPrime*u1dotu2
197 kdaily 2226
198 gezelter 1608 line1a = dotsum/opXdot
199     line1bx = dru1dx + dru2dx
200     line1by = dru1dy + dru2dy
201     line1bz = dru1dz + dru2dz
202 kdaily 2226
203 gezelter 1608 line2a = dotdiff/omXdot
204     line2bx = dru1dx - dru2dx
205     line2by = dru1dy - dru2dy
206     line2bz = dru1dz - dru2dz
207 kdaily 2226
208 gezelter 1608 term1x = -Chi*(line1a*line1bx + line2a*line2bx)/r2
209     term1y = -Chi*(line1a*line1by + line2a*line2by)/r2
210     term1z = -Chi*(line1a*line1bz + line2a*line2bz)/r2
211 kdaily 2226
212 gezelter 1608 line3a = ds2/opXdot
213     line3b = dd2/omXdot
214     line3 = Chi*(line3a + line3b)/r4
215     line3x = d(1)*line3
216     line3y = d(2)*line3
217     line3z = d(3)*line3
218 kdaily 2226
219 gezelter 1608 dgdx = term1x + line3x
220     dgdy = term1y + line3y
221     dgdz = term1z + line3z
222    
223 kdaily 2226 term1u1x = (line1a+line2a)*dru1dx
224     term1u1y = (line1a+line2a)*dru1dy
225     term1u1z = (line1a+line2a)*dru1dz
226     term1u2x = (line1a-line2a)*dru2dx
227     term1u2y = (line1a-line2a)*dru2dy
228     term1u2z = (line1a-line2a)*dru2dz
229    
230 gezelter 1608 term2a = -line3a/opXdot
231     term2b = line3b/omXdot
232 kdaily 2226
233 gezelter 1608 term2u1x = Chi*ul2(1)*(term2a + term2b)
234     term2u1y = Chi*ul2(2)*(term2a + term2b)
235     term2u1z = Chi*ul2(3)*(term2a + term2b)
236     term2u2x = Chi*ul1(1)*(term2a + term2b)
237     term2u2y = Chi*ul1(2)*(term2a + term2b)
238     term2u2z = Chi*ul1(3)*(term2a + term2b)
239 kdaily 2226
240 gezelter 1608 pref = -Chi*0.5d0/r2
241    
242     dgdu1x = pref*(term1u1x+term2u1x)
243     dgdu1y = pref*(term1u1y+term2u1y)
244     dgdu1z = pref*(term1u1z+term2u1z)
245     dgdu2x = pref*(term1u2x+term2u2x)
246     dgdu2y = pref*(term1u2y+term2u2y)
247     dgdu2z = pref*(term1u2z+term2u2z)
248    
249     g = 1.0d0 - Chi*(line3a + line3b)/(2.0d0*r2)
250 kdaily 2226
251 gezelter 1608 BigR = (r - gb_sigma*(g**(-0.5d0)) + gb_sigma)/gb_sigma
252     Ri = 1.0d0/BigR
253     Ri2 = Ri*Ri
254     Ri6 = Ri2*Ri2*Ri2
255     Ri7 = Ri6*Ri
256     Ri12 = Ri6*Ri6
257     Ri13 = Ri6*Ri7
258    
259     gfact = (g**(-1.5d0))*0.5d0
260    
261     dBigRdx = drdx/gb_sigma + dgdx*gfact
262     dBigRdy = drdy/gb_sigma + dgdy*gfact
263     dBigRdz = drdz/gb_sigma + dgdz*gfact
264 kdaily 2226
265 gezelter 1608 dBigRdu1x = dgdu1x*gfact
266     dBigRdu1y = dgdu1y*gfact
267     dBigRdu1z = dgdu1z*gfact
268     dBigRdu2x = dgdu2x*gfact
269     dBigRdu2y = dgdu2y*gfact
270     dBigRdu2z = dgdu2z*gfact
271 gezelter 2204
272 gezelter 1608 ! Now, we must do it again for g(ChiPrime) and dgpdx
273    
274     line1a = dotsum/opXpdot
275     line2a = dotdiff/omXpdot
276     term1x = -ChiPrime*(line1a*line1bx + line2a*line2bx)/r2
277     term1y = -ChiPrime*(line1a*line1by + line2a*line2by)/r2
278     term1z = -ChiPrime*(line1a*line1bz + line2a*line2bz)/r2
279     line3a = ds2/opXpdot
280     line3b = dd2/omXpdot
281     line3 = ChiPrime*(line3a + line3b)/r4
282     line3x = d(1)*line3
283     line3y = d(2)*line3
284     line3z = d(3)*line3
285 kdaily 2226
286 gezelter 1608 dgpdx = term1x + line3x
287     dgpdy = term1y + line3y
288     dgpdz = term1z + line3z
289 kdaily 2226
290     term1u1x = (line1a+line2a)*dru1dx
291     term1u1y = (line1a+line2a)*dru1dy
292     term1u1z = (line1a+line2a)*dru1dz
293     term1u2x = (line1a-line2a)*dru2dx
294     term1u2y = (line1a-line2a)*dru2dy
295     term1u2z = (line1a-line2a)*dru2dz
296 gezelter 2204
297 gezelter 1608 term2a = -line3a/opXpdot
298     term2b = line3b/omXpdot
299 kdaily 2226
300 gezelter 1608 term2u1x = ChiPrime*ul2(1)*(term2a + term2b)
301     term2u1y = ChiPrime*ul2(2)*(term2a + term2b)
302     term2u1z = ChiPrime*ul2(3)*(term2a + term2b)
303     term2u2x = ChiPrime*ul1(1)*(term2a + term2b)
304     term2u2y = ChiPrime*ul1(2)*(term2a + term2b)
305     term2u2z = ChiPrime*ul1(3)*(term2a + term2b)
306 kdaily 2226
307 gezelter 1608 pref = -ChiPrime*0.5d0/r2
308 kdaily 2226
309 gezelter 1608 dgpdu1x = pref*(term1u1x+term2u1x)
310     dgpdu1y = pref*(term1u1y+term2u1y)
311     dgpdu1z = pref*(term1u1z+term2u1z)
312     dgpdu2x = pref*(term1u2x+term2u2x)
313     dgpdu2y = pref*(term1u2y+term2u2y)
314     dgpdu2z = pref*(term1u2z+term2u2z)
315 kdaily 2226
316 gezelter 1608 gp = 1.0d0 - ChiPrime*(line3a + line3b)/(2.0d0*r2)
317     gmu = gp**gb_mu
318     gpi = 1.0d0 / gp
319     gmum = gmu*gpi
320 gezelter 2204
321 gezelter 1608 curlyE = 1.0d0/dsqrt(1.0d0 - Chi*Chi*u1dotu2*u1dotu2)
322    
323     dcE = (curlyE**3)*Chi*Chi*u1dotu2
324 kdaily 2226
325 gezelter 1608 dcEdu1x = dcE*ul2(1)
326     dcEdu1y = dcE*ul2(2)
327     dcEdu1z = dcE*ul2(3)
328     dcEdu2x = dcE*ul1(1)
329     dcEdu2y = dcE*ul1(2)
330     dcEdu2z = dcE*ul1(3)
331 kdaily 2226
332 gezelter 1608 enu = curlyE**gb_nu
333     enum = enu/curlyE
334 kdaily 2226
335 gezelter 1608 eps = gb_eps*enu*gmu
336    
337     yick1 = gb_eps*enu*gb_mu*gmum
338     yick2 = gb_eps*gmu*gb_nu*enum
339    
340     depsdu1x = yick1*dgpdu1x + yick2*dcEdu1x
341     depsdu1y = yick1*dgpdu1y + yick2*dcEdu1y
342     depsdu1z = yick1*dgpdu1z + yick2*dcEdu1z
343     depsdu2x = yick1*dgpdu2x + yick2*dcEdu2x
344     depsdu2y = yick1*dgpdu2y + yick2*dcEdu2y
345     depsdu2z = yick1*dgpdu2z + yick2*dcEdu2z
346 kdaily 2226
347 gezelter 1608 R126 = Ri12 - Ri6
348     R137 = 6.0d0*Ri7 - 12.0d0*Ri13
349 kdaily 2226
350 gezelter 1608 mess1 = gmu*R137
351     mess2 = R126*gb_mu*gmum
352 kdaily 2226
353 gezelter 1608 dUdx = 4.0d0*gb_eps*enu*(mess1*dBigRdx + mess2*dgpdx)*sw
354     dUdy = 4.0d0*gb_eps*enu*(mess1*dBigRdy + mess2*dgpdy)*sw
355     dUdz = 4.0d0*gb_eps*enu*(mess1*dBigRdz + mess2*dgpdz)*sw
356 kdaily 2226
357 gezelter 1608 dUdu1x = 4.0d0*(R126*depsdu1x + eps*R137*dBigRdu1x)*sw
358     dUdu1y = 4.0d0*(R126*depsdu1y + eps*R137*dBigRdu1y)*sw
359     dUdu1z = 4.0d0*(R126*depsdu1z + eps*R137*dBigRdu1z)*sw
360     dUdu2x = 4.0d0*(R126*depsdu2x + eps*R137*dBigRdu2x)*sw
361     dUdu2y = 4.0d0*(R126*depsdu2y + eps*R137*dBigRdu2y)*sw
362     dUdu2z = 4.0d0*(R126*depsdu2z + eps*R137*dBigRdu2z)*sw
363 kdaily 2226
364 gezelter 1608 #ifdef IS_MPI
365     f_Row(1,atom1) = f_Row(1,atom1) + dUdx
366     f_Row(2,atom1) = f_Row(2,atom1) + dUdy
367     f_Row(3,atom1) = f_Row(3,atom1) + dUdz
368 kdaily 2226
369 gezelter 1608 f_Col(1,atom2) = f_Col(1,atom2) - dUdx
370     f_Col(2,atom2) = f_Col(2,atom2) - dUdy
371     f_Col(3,atom2) = f_Col(3,atom2) - dUdz
372 kdaily 2226
373 gezelter 1608 t_Row(1,atom1) = t_Row(1,atom1) - ul1(2)*dUdu1z + ul1(3)*dUdu1y
374     t_Row(2,atom1) = t_Row(2,atom1) - ul1(3)*dUdu1x + ul1(1)*dUdu1z
375     t_Row(3,atom1) = t_Row(3,atom1) - ul1(1)*dUdu1y + ul1(2)*dUdu1x
376 kdaily 2226
377 gezelter 1608 t_Col(1,atom2) = t_Col(1,atom2) - ul2(2)*dUdu2z + ul2(3)*dUdu2y
378     t_Col(2,atom2) = t_Col(2,atom2) - ul2(3)*dUdu2x + ul2(1)*dUdu2z
379     t_Col(3,atom2) = t_Col(3,atom2) - ul2(1)*dUdu2y + ul2(2)*dUdu2x
380     #else
381     f(1,atom1) = f(1,atom1) + dUdx
382     f(2,atom1) = f(2,atom1) + dUdy
383     f(3,atom1) = f(3,atom1) + dUdz
384 kdaily 2226
385 gezelter 1608 f(1,atom2) = f(1,atom2) - dUdx
386     f(2,atom2) = f(2,atom2) - dUdy
387     f(3,atom2) = f(3,atom2) - dUdz
388 kdaily 2226
389 gezelter 1608 t(1,atom1) = t(1,atom1) - ul1(2)*dUdu1z + ul1(3)*dUdu1y
390     t(2,atom1) = t(2,atom1) - ul1(3)*dUdu1x + ul1(1)*dUdu1z
391     t(3,atom1) = t(3,atom1) - ul1(1)*dUdu1y + ul1(2)*dUdu1x
392 kdaily 2226
393 gezelter 1608 t(1,atom2) = t(1,atom2) - ul2(2)*dUdu2z + ul2(3)*dUdu2y
394     t(2,atom2) = t(2,atom2) - ul2(3)*dUdu2x + ul2(1)*dUdu2z
395     t(3,atom2) = t(3,atom2) - ul2(1)*dUdu2y + ul2(2)*dUdu2x
396     #endif
397 kdaily 2226
398 gezelter 1608 if (do_pot) then
399     #ifdef IS_MPI
400     pot_row(atom1) = pot_row(atom1) + 2.0d0*eps*R126*sw
401     pot_col(atom2) = pot_col(atom2) + 2.0d0*eps*R126*sw
402     #else
403     pot = pot + 4.0*eps*R126*sw
404     #endif
405     endif
406    
407     vpair = vpair + 4.0*eps*R126
408     #ifdef IS_MPI
409     id1 = AtomRowToGlobal(atom1)
410     id2 = AtomColToGlobal(atom2)
411     #else
412     id1 = atom1
413     id2 = atom2
414     #endif
415 kdaily 2226
416 gezelter 1608 if (molMembershipList(id1) .ne. molMembershipList(id2)) then
417 kdaily 2226
418 gezelter 1608 fpair(1) = fpair(1) + dUdx
419     fpair(2) = fpair(2) + dUdy
420     fpair(3) = fpair(3) + dUdz
421 kdaily 2226
422 gezelter 1608 endif
423 kdaily 2226
424 gezelter 1608 return
425     end subroutine do_gb_pair
426    
427     end module gb_pair