ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-4/src/UseTheForce/DarkSide/gb.F90
(Generate patch)

Comparing trunk/OOPSE-4/src/UseTheForce/DarkSide/gb.F90 (file contents):
Revision 2204 by gezelter, Fri Apr 15 22:04:00 2005 UTC vs.
Revision 2361 by gezelter, Wed Oct 12 21:00:50 2005 UTC

# Line 47 | Line 47 | module gb_pair
47   #ifdef IS_MPI
48    use mpiSimulation
49   #endif
50 <
50 >  
51    implicit none
52  
53    PRIVATE
54 + #define __FORTRAN90
55 + #include "UseTheForce/DarkSide/fInteractionMap.h"
56  
57    logical, save :: gb_pair_initialized = .false.
58    real(kind=dp), save :: gb_sigma
# Line 63 | Line 65 | module gb_pair
65    public :: check_gb_pair_FF
66    public :: set_gb_pair_params
67    public :: do_gb_pair
68 +  public :: getGayBerneCut
69  
70   contains
71  
# Line 76 | Line 79 | contains
79    subroutine set_gb_pair_params(sigma, l2b_ratio, eps, eps_ratio, mu, nu)
80      real( kind = dp ), intent(in) :: sigma, l2b_ratio, eps, eps_ratio
81      real( kind = dp ), intent(in) :: mu, nu
82 <
82 >  
83      gb_sigma = sigma
84      gb_l2b_ratio = l2b_ratio
85      gb_eps = eps
# Line 88 | Line 91 | contains
91      return
92    end subroutine set_gb_pair_params
93  
94 +  !! gay berne cutoff should be a parameter in globals, this is a temporary
95 +  !! work around - this should be fixed when gay berne is up and running
96 +  function getGayBerneCut(atomID) result(cutValue)
97 +    integer, intent(in) :: atomID !! nah... we don't need to use this...
98 +    real(kind=dp) :: cutValue
99  
100 +    cutValue = gb_l2b_ratio*gb_sigma*2.5_dp
101 +  end function getGayBerneCut
102 +
103    subroutine do_gb_pair(atom1, atom2, d, r, r2, sw, vpair, fpair, &
104         pot, A, f, t, do_pot)
105 <
105 >    
106      integer, intent(in) :: atom1, atom2
107      integer :: id1, id2
108      real (kind=dp), intent(inout) :: r, r2
# Line 132 | Line 143 | contains
143      real(kind=dp) :: term2a, term2b, term2u1x, term2u1y, term2u1z
144      real(kind=dp) :: term2u2x, term2u2y, term2u2z
145      real(kind=dp) :: yick1, yick2, mess1, mess2
146 <
146 >    
147      s2 = (gb_l2b_ratio)**2
148      emu = (gb_eps_ratio)**(1.0d0/gb_mu)
149  
# Line 158 | Line 169 | contains
169      ul2(2) = A(6,atom2)
170      ul2(3) = A(9,atom2)
171   #endif
172 <
172 >    
173      dru1dx = ul1(1)
174      dru2dx = ul2(1)
175      dru1dy = ul1(2)
176      dru2dy = ul2(2)
177      dru1dz = ul1(3)
178      dru2dz = ul2(3)
179 <
179 >    
180      drdx = d(1) / r
181      drdy = d(2) / r
182      drdz = d(3) / r
183 <
183 >    
184      ! do some dot products:
185      ! NB the r in these dot products is the actual intermolecular vector,
186      ! and is not the unit vector in that direction.
187 <
187 >    
188      rdotu1 = d(1)*ul1(1) + d(2)*ul1(2) + d(3)*ul1(3)
189      rdotu2 = d(1)*ul2(1) + d(2)*ul2(2) + d(3)*ul2(3)
190      u1dotu2 = ul1(1)*ul2(1) + ul1(2)*ul2(2) +  ul1(3)*ul2(3)
# Line 184 | Line 195 | contains
195      ! We note however, that there are some major typos in that Appendix
196      ! of the Luckhurst paper, particularly in equations A23, A29 and A31
197      ! We have attempted to correct them below.
198 <
198 >    
199      dotsum = rdotu1+rdotu2
200      dotdiff = rdotu1-rdotu2
201      ds2 = dotsum*dotsum
202      dd2 = dotdiff*dotdiff
203 <
203 >  
204      opXdot = 1.0d0 + Chi*u1dotu2
205      omXdot = 1.0d0 - Chi*u1dotu2
206      opXpdot = 1.0d0 + ChiPrime*u1dotu2
207      omXpdot = 1.0d0 - ChiPrime*u1dotu2
208 <
208 >  
209      line1a = dotsum/opXdot
210      line1bx = dru1dx + dru2dx
211      line1by = dru1dy + dru2dy
212      line1bz = dru1dz + dru2dz
213 <
213 >    
214      line2a = dotdiff/omXdot
215      line2bx = dru1dx - dru2dx
216      line2by = dru1dy - dru2dy
217      line2bz = dru1dz - dru2dz
218 <
218 >    
219      term1x = -Chi*(line1a*line1bx + line2a*line2bx)/r2
220      term1y = -Chi*(line1a*line1by + line2a*line2by)/r2
221      term1z = -Chi*(line1a*line1bz + line2a*line2bz)/r2
222 <
222 >    
223      line3a = ds2/opXdot
224      line3b = dd2/omXdot
225      line3 = Chi*(line3a + line3b)/r4
226      line3x = d(1)*line3
227      line3y = d(2)*line3
228      line3z = d(3)*line3
229 <
229 >    
230      dgdx = term1x + line3x
231      dgdy = term1y + line3y
232      dgdz = term1z + line3z
233  
234 <    term1u1x = 2.0d0*(line1a+line2a)*d(1)
235 <    term1u1y = 2.0d0*(line1a+line2a)*d(2)
236 <    term1u1z = 2.0d0*(line1a+line2a)*d(3)
237 <    term1u2x = 2.0d0*(line1a-line2a)*d(1)
238 <    term1u2y = 2.0d0*(line1a-line2a)*d(2)
239 <    term1u2z = 2.0d0*(line1a-line2a)*d(3)
240 <
234 >    term1u1x = (line1a+line2a)*dru1dx
235 >    term1u1y = (line1a+line2a)*dru1dy
236 >    term1u1z = (line1a+line2a)*dru1dz
237 >    term1u2x = (line1a-line2a)*dru2dx
238 >    term1u2y = (line1a-line2a)*dru2dy
239 >    term1u2z = (line1a-line2a)*dru2dz
240 >    
241      term2a = -line3a/opXdot
242      term2b =  line3b/omXdot
243 <
243 >    
244      term2u1x = Chi*ul2(1)*(term2a + term2b)
245      term2u1y = Chi*ul2(2)*(term2a + term2b)
246      term2u1z = Chi*ul2(3)*(term2a + term2b)
247      term2u2x = Chi*ul1(1)*(term2a + term2b)
248      term2u2y = Chi*ul1(2)*(term2a + term2b)
249      term2u2z = Chi*ul1(3)*(term2a + term2b)
250 <
250 >    
251      pref = -Chi*0.5d0/r2
252  
253      dgdu1x = pref*(term1u1x+term2u1x)
# Line 247 | Line 258 | contains
258      dgdu2z = pref*(term1u2z+term2u2z)
259  
260      g = 1.0d0 - Chi*(line3a + line3b)/(2.0d0*r2)
261 <
261 >  
262      BigR = (r - gb_sigma*(g**(-0.5d0)) + gb_sigma)/gb_sigma
263      Ri = 1.0d0/BigR
264      Ri2 = Ri*Ri
# Line 261 | Line 272 | contains
272      dBigRdx = drdx/gb_sigma + dgdx*gfact
273      dBigRdy = drdy/gb_sigma + dgdy*gfact
274      dBigRdz = drdz/gb_sigma + dgdz*gfact
275 +
276      dBigRdu1x = dgdu1x*gfact
277      dBigRdu1y = dgdu1y*gfact
278      dBigRdu1z = dgdu1z*gfact
# Line 281 | Line 293 | contains
293      line3x = d(1)*line3
294      line3y = d(2)*line3
295      line3z = d(3)*line3
296 <
296 >    
297      dgpdx = term1x + line3x
298      dgpdy = term1y + line3y
299      dgpdz = term1z + line3z
300 <
301 <    term1u1x = 2.0d0*(line1a+line2a)*d(1)
302 <    term1u1y = 2.0d0*(line1a+line2a)*d(2)
303 <    term1u1z = 2.0d0*(line1a+line2a)*d(3)
304 <    term1u2x = 2.0d0*(line1a-line2a)*d(1)
305 <    term1u2y = 2.0d0*(line1a-line2a)*d(2)
306 <    term1u2z = 2.0d0*(line1a-line2a)*d(3)
300 >    
301 >    term1u1x = (line1a+line2a)*dru1dx
302 >    term1u1y = (line1a+line2a)*dru1dy
303 >    term1u1z = (line1a+line2a)*dru1dz
304 >    term1u2x = (line1a-line2a)*dru2dx
305 >    term1u2y = (line1a-line2a)*dru2dy
306 >    term1u2z = (line1a-line2a)*dru2dz
307  
308      term2a = -line3a/opXpdot
309      term2b =  line3b/omXpdot
310 <
310 >    
311      term2u1x = ChiPrime*ul2(1)*(term2a + term2b)
312      term2u1y = ChiPrime*ul2(2)*(term2a + term2b)
313      term2u1z = ChiPrime*ul2(3)*(term2a + term2b)
314      term2u2x = ChiPrime*ul1(1)*(term2a + term2b)
315      term2u2y = ChiPrime*ul1(2)*(term2a + term2b)
316      term2u2z = ChiPrime*ul1(3)*(term2a + term2b)
317 <
317 >  
318      pref = -ChiPrime*0.5d0/r2
319 <
319 >    
320      dgpdu1x = pref*(term1u1x+term2u1x)
321      dgpdu1y = pref*(term1u1y+term2u1y)
322      dgpdu1z = pref*(term1u1z+term2u1z)
323      dgpdu2x = pref*(term1u2x+term2u2x)
324      dgpdu2y = pref*(term1u2y+term2u2y)
325      dgpdu2z = pref*(term1u2z+term2u2z)
326 <
326 >    
327      gp = 1.0d0 - ChiPrime*(line3a + line3b)/(2.0d0*r2)
328      gmu = gp**gb_mu
329      gpi = 1.0d0 / gp
330      gmum = gmu*gpi
331  
320    ! write(*,*) atom1, atom2, Chi, u1dotu2
332      curlyE = 1.0d0/dsqrt(1.0d0 - Chi*Chi*u1dotu2*u1dotu2)
333  
334      dcE = (curlyE**3)*Chi*Chi*u1dotu2
335 <
335 >  
336      dcEdu1x = dcE*ul2(1)
337      dcEdu1y = dcE*ul2(2)
338      dcEdu1z = dcE*ul2(3)
339      dcEdu2x = dcE*ul1(1)
340      dcEdu2y = dcE*ul1(2)
341      dcEdu2z = dcE*ul1(3)
342 <
342 >    
343      enu = curlyE**gb_nu
344      enum = enu/curlyE
345 <
345 >  
346      eps = gb_eps*enu*gmu
347  
348      yick1 = gb_eps*enu*gb_mu*gmum
# Line 343 | Line 354 | contains
354      depsdu2x = yick1*dgpdu2x + yick2*dcEdu2x
355      depsdu2y = yick1*dgpdu2y + yick2*dcEdu2y
356      depsdu2z = yick1*dgpdu2z + yick2*dcEdu2z
357 <
357 >    
358      R126 = Ri12 - Ri6
359      R137 = 6.0d0*Ri7 - 12.0d0*Ri13
360 <
360 >    
361      mess1 = gmu*R137
362      mess2 = R126*gb_mu*gmum
363 <
363 >    
364      dUdx = 4.0d0*gb_eps*enu*(mess1*dBigRdx + mess2*dgpdx)*sw
365      dUdy = 4.0d0*gb_eps*enu*(mess1*dBigRdy + mess2*dgpdy)*sw
366      dUdz = 4.0d0*gb_eps*enu*(mess1*dBigRdz + mess2*dgpdz)*sw
367 <
367 >    
368      dUdu1x = 4.0d0*(R126*depsdu1x + eps*R137*dBigRdu1x)*sw
369      dUdu1y = 4.0d0*(R126*depsdu1y + eps*R137*dBigRdu1y)*sw
370      dUdu1z = 4.0d0*(R126*depsdu1z + eps*R137*dBigRdu1z)*sw
371      dUdu2x = 4.0d0*(R126*depsdu2x + eps*R137*dBigRdu2x)*sw
372      dUdu2y = 4.0d0*(R126*depsdu2y + eps*R137*dBigRdu2y)*sw
373      dUdu2z = 4.0d0*(R126*depsdu2z + eps*R137*dBigRdu2z)*sw
374 <
374 >      
375   #ifdef IS_MPI
376      f_Row(1,atom1) = f_Row(1,atom1) + dUdx
377      f_Row(2,atom1) = f_Row(2,atom1) + dUdy
378      f_Row(3,atom1) = f_Row(3,atom1) + dUdz
379 <
379 >    
380      f_Col(1,atom2) = f_Col(1,atom2) - dUdx
381      f_Col(2,atom2) = f_Col(2,atom2) - dUdy
382      f_Col(3,atom2) = f_Col(3,atom2) - dUdz
383 <
383 >    
384      t_Row(1,atom1) = t_Row(1,atom1) - ul1(2)*dUdu1z + ul1(3)*dUdu1y
385      t_Row(2,atom1) = t_Row(2,atom1) - ul1(3)*dUdu1x + ul1(1)*dUdu1z
386      t_Row(3,atom1) = t_Row(3,atom1) - ul1(1)*dUdu1y + ul1(2)*dUdu1x
387 <
387 >    
388      t_Col(1,atom2) = t_Col(1,atom2) - ul2(2)*dUdu2z + ul2(3)*dUdu2y
389      t_Col(2,atom2) = t_Col(2,atom2) - ul2(3)*dUdu2x + ul2(1)*dUdu2z
390      t_Col(3,atom2) = t_Col(3,atom2) - ul2(1)*dUdu2y + ul2(2)*dUdu2x
# Line 381 | Line 392 | contains
392      f(1,atom1) = f(1,atom1) + dUdx
393      f(2,atom1) = f(2,atom1) + dUdy
394      f(3,atom1) = f(3,atom1) + dUdz
395 <
395 >    
396      f(1,atom2) = f(1,atom2) - dUdx
397      f(2,atom2) = f(2,atom2) - dUdy
398      f(3,atom2) = f(3,atom2) - dUdz
399 <
399 >    
400      t(1,atom1) = t(1,atom1) - ul1(2)*dUdu1z + ul1(3)*dUdu1y
401      t(2,atom1) = t(2,atom1) - ul1(3)*dUdu1x + ul1(1)*dUdu1z
402      t(3,atom1) = t(3,atom1) - ul1(1)*dUdu1y + ul1(2)*dUdu1x
403 <
403 >    
404      t(1,atom2) = t(1,atom2) - ul2(2)*dUdu2z + ul2(3)*dUdu2y
405      t(2,atom2) = t(2,atom2) - ul2(3)*dUdu2x + ul2(1)*dUdu2z
406      t(3,atom2) = t(3,atom2) - ul2(1)*dUdu2y + ul2(2)*dUdu2x
407   #endif
408 <
408 >            
409      if (do_pot) then
410   #ifdef IS_MPI
411 <       pot_row(atom1) = pot_row(atom1) + 2.0d0*eps*R126*sw
412 <       pot_col(atom2) = pot_col(atom2) + 2.0d0*eps*R126*sw
411 >       pot_row(VDW_POT,atom1) = pot_row(VDW_POT,atom1) + 2.0d0*eps*R126*sw
412 >       pot_col(VDW_POT,atom2) = pot_col(VDW_POT,atom2) + 2.0d0*eps*R126*sw
413   #else
414         pot = pot + 4.0*eps*R126*sw
415   #endif
# Line 412 | Line 423 | contains
423      id1 = atom1
424      id2 = atom2
425   #endif
426 <
426 >    
427      if (molMembershipList(id1) .ne. molMembershipList(id2)) then
428 <
428 >      
429         fpair(1) = fpair(1) + dUdx
430         fpair(2) = fpair(2) + dUdy
431         fpair(3) = fpair(3) + dUdz
432 <
432 >      
433      endif
434 <
434 >    
435      return
436    end subroutine do_gb_pair
437  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines