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 1930 by gezelter, Wed Jan 12 22:41:40 2005 UTC vs.
Revision 2926 by gezelter, Fri Jul 7 19:44:54 2006 UTC

# Line 40 | Line 40 | module gb_pair
40   !!
41  
42  
43 < module gb_pair
43 > module gayberne
44    use force_globals
45    use definitions
46    use simulation
47 +  use atype_module
48 +  use vector_class
49 +  use linearalgebra
50 +  use status
51 +  use lj
52 +  use fForceOptions
53   #ifdef IS_MPI
54    use mpiSimulation
55   #endif
56    
57    implicit none
58  
59 <  PRIVATE
59 >  private
60  
61 <  logical, save :: gb_pair_initialized = .false.
62 <  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
61 > #define __FORTRAN90
62 > #include "UseTheForce/DarkSide/fInteractionMap.h"
63  
64 <  public :: check_gb_pair_FF
65 <  public :: set_gb_pair_params
64 >  logical, save :: haveGBMap = .false.
65 >  logical, save :: haveMixingMap = .false.
66 >  real(kind=dp), save :: mu = 2.0_dp
67 >  real(kind=dp), save :: nu = 1.0_dp
68 >
69 >
70 >  public :: newGBtype
71 >  public :: complete_GB_FF
72    public :: do_gb_pair
73 +  public :: getGayBerneCut
74 +  public :: destroyGBtypes
75  
76 +  type :: GBtype
77 +     integer          :: atid
78 +     real(kind = dp ) :: d
79 +     real(kind = dp ) :: l
80 +     real(kind = dp ) :: eps
81 +     real(kind = dp ) :: eps_ratio
82 +     real(kind = dp ) :: dw
83 +     logical          :: isLJ
84 +  end type GBtype
85 +  
86 +  type, private :: GBList
87 +     integer               :: nGBtypes = 0
88 +     integer               :: currentGBtype = 0
89 +     type(GBtype), pointer :: GBtypes(:)      => null()
90 +     integer, pointer      :: atidToGBtype(:) => null()
91 +  end type GBList
92 +  
93 +  type(GBList), save :: GBMap
94 +  
95 +  type :: GBMixParameters
96 +     real(kind=DP) :: sigma0
97 +     real(kind=DP) :: eps0
98 +     real(kind=DP) :: dw
99 +     real(kind=DP) :: x2
100 +     real(kind=DP) :: xa2
101 +     real(kind=DP) :: xai2
102 +     real(kind=DP) :: xp2
103 +     real(kind=DP) :: xpap2
104 +     real(kind=DP) :: xpapi2
105 +  end type GBMixParameters
106 +  
107 +  type(GBMixParameters), dimension(:,:), allocatable :: GBMixingMap
108 +  
109   contains
110 <
111 <  subroutine check_gb_pair_FF(status)
112 <    integer :: status
113 <    status = -1
114 <    if (gb_pair_initialized) status = 0
110 >  
111 >  subroutine newGBtype(c_ident, d, l, eps, eps_ratio, dw, status)
112 >    
113 >    integer, intent(in) :: c_ident
114 >    real( kind = dp ), intent(in) :: d, l, eps, eps_ratio, dw
115 >    integer, intent(out) :: status
116 >    
117 >    integer :: nGBTypes, nLJTypes, ntypes, myATID
118 >    integer, pointer :: MatchList(:) => null()
119 >    integer :: current, i
120 >    status = 0
121 >    
122 >    if (.not.associated(GBMap%GBtypes)) then
123 >      
124 >       call getMatchingElementList(atypes, "is_GayBerne", .true., &
125 >            nGBtypes, MatchList)
126 >      
127 >       call getMatchingElementList(atypes, "is_LennardJones", .true., &
128 >            nLJTypes, MatchList)
129 >      
130 >       GBMap%nGBtypes = nGBtypes + nLJTypes
131 >      
132 >       allocate(GBMap%GBtypes(nGBtypes + nLJTypes))
133 >      
134 >       ntypes = getSize(atypes)
135 >      
136 >       allocate(GBMap%atidToGBtype(ntypes))      
137 >    endif
138 >    
139 >    GBMap%currentGBtype = GBMap%currentGBtype + 1
140 >    current = GBMap%currentGBtype
141 >    
142 >    myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
143 >    
144 >    GBMap%atidToGBtype(myATID)       = current
145 >    GBMap%GBtypes(current)%atid      = myATID
146 >    GBMap%GBtypes(current)%d         = d
147 >    GBMap%GBtypes(current)%l         = l
148 >    GBMap%GBtypes(current)%eps       = eps
149 >    GBMap%GBtypes(current)%eps_ratio = eps_ratio
150 >    GBMap%GBtypes(current)%dw        = dw
151 >    GBMap%GBtypes(current)%isLJ      = .false.
152 >    
153      return
154 <  end subroutine check_gb_pair_FF
154 >  end subroutine newGBtype
155 >  
156 >  subroutine complete_GB_FF(status)
157 >    integer :: status
158 >    integer :: i, j, l, m, lm, function_type
159 >    real(kind=dp) :: thisDP, sigma
160 >    integer :: alloc_stat, iTheta, iPhi, nSteps, nAtypes, myATID, current
161 >    logical :: thisProperty
162 >    
163 >    status = 0
164 >    if (GBMap%currentGBtype == 0) then
165 >       call handleError("complete_GB_FF", "No members in GBMap")
166 >       status = -1
167 >       return
168 >    end if
169 >    
170 >    nAtypes = getSize(atypes)
171 >    
172 >    if (nAtypes == 0) then
173 >       status = -1
174 >       return
175 >    end if
176 >    
177 >    ! atypes comes from c side
178 >    do i = 1, nAtypes
179 >      
180 >       myATID = getFirstMatchingElement(atypes, 'c_ident', i)
181 >       call getElementProperty(atypes, myATID, "is_LennardJones", thisProperty)
182 >      
183 >       if (thisProperty) then
184 >          GBMap%currentGBtype = GBMap%currentGBtype + 1
185 >          current = GBMap%currentGBtype
186 >          
187 >          GBMap%atidToGBtype(myATID) = current
188 >          GBMap%GBtypes(current)%atid      = myATID      
189 >          GBMap%GBtypes(current)%isLJ      = .true.          
190 >          GBMap%GBtypes(current)%d         = getSigma(myATID)
191 >          GBMap%GBtypes(current)%l         = GBMap%GBtypes(current)%d
192 >          GBMap%GBtypes(current)%eps       = getEpsilon(myATID)
193 >          GBMap%GBtypes(current)%eps_ratio = 1.0_dp
194 >          GBMap%GBtypes(current)%dw        = 1.0_dp
195 >          
196 >       endif
197 >      
198 >    end do
199 >    
200 >    haveGBMap = .true.
201  
202 <  subroutine set_gb_pair_params(sigma, l2b_ratio, eps, eps_ratio, mu, nu)
203 <    real( kind = dp ), intent(in) :: sigma, l2b_ratio, eps, eps_ratio
78 <    real( kind = dp ), intent(in) :: mu, nu
79 <  
80 <    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
202 >    
203 >  end subroutine complete_GB_FF
204  
205 <    gb_pair_initialized = .true.
206 <    return
207 <  end subroutine set_gb_pair_params
205 >  subroutine createGBMixingMap()
206 >    integer :: nGBtypes, i, j
207 >    real (kind = dp) :: d1, l1, e1, er1, dw1
208 >    real (kind = dp) :: d2, l2, e2, er2, dw2
209 >    real (kind = dp) :: er, ermu, xp, ap2
210  
211 +    if (GBMap%currentGBtype == 0) then
212 +       call handleError("GB", "No members in GBMap")
213 +       return
214 +    end if
215 +    
216 +    nGBtypes = GBMap%nGBtypes
217  
218 +    if (.not. allocated(GBMixingMap)) then
219 +       allocate(GBMixingMap(nGBtypes, nGBtypes))
220 +    endif
221 +
222 +    do i = 1, nGBtypes
223 +
224 +       d1 = GBMap%GBtypes(i)%d
225 +       l1 = GBMap%GBtypes(i)%l
226 +       e1 = GBMap%GBtypes(i)%eps
227 +       er1 = GBMap%GBtypes(i)%eps_ratio
228 +       dw1 = GBMap%GBtypes(i)%dw
229 +
230 +       do j = i, nGBtypes
231 +
232 +          d2 = GBMap%GBtypes(j)%d
233 +          l2 = GBMap%GBtypes(j)%l
234 +          e2 = GBMap%GBtypes(j)%eps
235 +          er2 = GBMap%GBtypes(j)%eps_ratio
236 +          dw2 = GBMap%GBtypes(j)%dw
237 + !         write(*,*) 'd2 = ', d2,l2, d1,l2
238 + !          GBMixingMap(i,j)%sigma0 = sqrt(d1*d1 + d2*d2)
239 +          GBMixingMap(i,j)%sigma0 = 0.5_dp*(d1 + d2)
240 +          GBMixingMap(i,j)%xa2 = (l1*l1 - d1*d1)/(l1*l1 + d2*d2)
241 +          GBMixingMap(i,j)%xai2 = (l2*l2 - d2*d2)/(l2*l2 + d1*d1)
242 +          GBMixingMap(i,j)%x2 = (l1*l1 - d1*d1) * (l2*l2 - d2*d2) / &
243 +               ((l2*l2 + d1*d1) * (l1*l1 + d2*d2))
244 +
245 +          ! assumed LB mixing rules for now:
246 +
247 +          GBMixingMap(i,j)%dw = 0.5_dp * (dw1 + dw2)
248 +          GBMixingMap(i,j)%eps0 = sqrt(e1 * e2)
249 +
250 +          er = sqrt(er1 * er2)
251 +          ermu = er**(1.0_dp / mu)
252 +          xp = (1.0_dp - ermu) / (1.0_dp + ermu)
253 +          ap2 = 1.0_dp / (1.0_dp + ermu)
254 +
255 +          GBMixingMap(i,j)%xp2 = xp*xp
256 +          GBMixingMap(i,j)%xpap2 = xp*ap2
257 +          GBMixingMap(i,j)%xpapi2 = xp/ap2
258 +          
259 +          if (i.ne.j) then
260 +             GBMixingMap(j,i)%sigma0 = GBMixingMap(i,j)%sigma0
261 +             GBMixingMap(j,i)%dw     = GBMixingMap(i,j)%dw    
262 +             GBMixingMap(j,i)%eps0   = GBMixingMap(i,j)%eps0  
263 +             GBMixingMap(j,i)%x2     = GBMixingMap(i,j)%x2    
264 +             GBMixingMap(j,i)%xa2    = GBMixingMap(i,j)%xa2  
265 +             GBMixingMap(j,i)%xai2   = GBMixingMap(i,j)%xai2  
266 +             GBMixingMap(j,i)%xp2    = GBMixingMap(i,j)%xp2  
267 +             GBMixingMap(j,i)%xpap2  = GBMixingMap(i,j)%xpap2
268 +             GBMixingMap(j,i)%xpapi2 = GBMixingMap(i,j)%xpapi2
269 +          endif
270 +       enddo
271 +    enddo
272 +    haveMixingMap = .true.
273 +    mu = getGayBerneMu()
274 +    nu = getGayBerneNu()    
275 +  end subroutine createGBMixingMap
276 +  
277 +
278 +  !! gay berne cutoff should be a parameter in globals, this is a temporary
279 +  !! work around - this should be fixed when gay berne is up and running
280 +
281 +  function getGayBerneCut(atomID) result(cutValue)
282 +    integer, intent(in) :: atomID
283 +    integer :: gbt1
284 +    real(kind=dp) :: cutValue, l, d
285 +
286 +    if (GBMap%currentGBtype == 0) then
287 +       call handleError("GB", "No members in GBMap")
288 +       return
289 +    end if
290 +
291 +    gbt1 = GBMap%atidToGBtype(atomID)
292 +    l = GBMap%GBtypes(gbt1)%l
293 +    d = GBMap%GBtypes(gbt1)%d  
294 +    cutValue = 2.5_dp*max(l,d)
295 +
296 +  end function getGayBerneCut
297 +
298    subroutine do_gb_pair(atom1, atom2, d, r, r2, sw, vpair, fpair, &
299 <       pot, A, f, t, do_pot)
299 >       pot, Amat, f, t, do_pot)
300      
301      integer, intent(in) :: atom1, atom2
302 <    integer :: id1, id2
302 >    integer :: atid1, atid2, gbt1, gbt2, id1, id2
303      real (kind=dp), intent(inout) :: r, r2
304      real (kind=dp), dimension(3), intent(in) :: d
305      real (kind=dp), dimension(3), intent(inout) :: fpair
306      real (kind=dp) :: pot, sw, vpair
307 <    real (kind=dp), dimension(9,nLocal) :: A
307 >    real (kind=dp), dimension(9,nLocal) :: Amat
308      real (kind=dp), dimension(3,nLocal) :: f
309      real (kind=dp), dimension(3,nLocal) :: t
310      logical, intent(in) :: do_pot
311 <    real (kind = dp), dimension(3) :: ul1
106 <    real (kind = dp), dimension(3) :: ul2
311 >    real (kind = dp), dimension(3) :: ul1, ul2, rxu1, rxu2, uxu, rhat
312  
313 <    real(kind=dp) :: chi, chiprime, emu, s2
314 <    real(kind=dp) :: r4, rdotu1, rdotu2, u1dotu2, g, gp, gpi, gmu, gmum
315 <    real(kind=dp) :: curlyE, enu, enum, eps, dotsum, dotdiff, ds2, dd2
316 <    real(kind=dp) :: opXdot, omXdot, opXpdot, omXpdot, pref, gfact
317 <    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 <    
136 <    s2 = (gb_l2b_ratio)**2
137 <    emu = (gb_eps_ratio)**(1.0d0/gb_mu)
313 >    real (kind = dp) :: sigma0, dw, eps0, x2, xa2, xai2, xp2, xpap2, xpapi2
314 >    real (kind = dp) :: e1, e2, eps, sigma, s3, s03, au2, bu2, au, bu, a, b, g, g2
315 >    real (kind = dp) :: U, BigR, R3, R6, R7, R12, R13, H, Hp, fx, fy, fz
316 >    real (kind = dp) :: dUdr, dUda, dUdb, dUdg, pref1, pref2
317 >    logical :: i_is_lj, j_is_lj
318  
319 <    chi = (s2 - 1.0d0)/(s2 + 1.0d0)
320 <    chiprime = (1.0d0 - emu)/(1.0d0 + emu)
319 >    if (.not.haveMixingMap) then
320 >       call createGBMixingMap()
321 >    endif
322  
323 <    r4 = r2*r2
323 > #ifdef IS_MPI
324 >    atid1 = atid_Row(atom1)
325 >    atid2 = atid_Col(atom2)
326 > #else
327 >    atid1 = atid(atom1)
328 >    atid2 = atid(atom2)
329 > #endif
330  
331 +    gbt1 = GBMap%atidToGBtype(atid1)
332 +    gbt2 = GBMap%atidToGBtype(atid2)    
333 +
334 +    i_is_LJ = GBMap%GBTypes(gbt1)%isLJ
335 +    j_is_LJ = GBMap%GBTypes(gbt2)%isLJ
336 +
337 +    sigma0 = GBMixingMap(gbt1, gbt2)%sigma0
338 +    dw     = GBMixingMap(gbt1, gbt2)%dw    
339 +    eps0   = GBMixingMap(gbt1, gbt2)%eps0  
340 +    x2     = GBMixingMap(gbt1, gbt2)%x2    
341 +    xa2    = GBMixingMap(gbt1, gbt2)%xa2  
342 +    xai2   = GBMixingMap(gbt1, gbt2)%xai2  
343 +    xp2    = GBMixingMap(gbt1, gbt2)%xp2  
344 +    xpap2  = GBMixingMap(gbt1, gbt2)%xpap2
345 +    xpapi2 = GBMixingMap(gbt1, gbt2)%xpapi2
346 +    
347   #ifdef IS_MPI
348 <    ul1(1) = A_Row(3,atom1)
349 <    ul1(2) = A_Row(6,atom1)
348 >    ul1(1) = A_Row(7,atom1)
349 >    ul1(2) = A_Row(8,atom1)
350      ul1(3) = A_Row(9,atom1)
351  
352 <    ul2(1) = A_Col(3,atom2)
353 <    ul2(2) = A_Col(6,atom2)
352 >    ul2(1) = A_Col(7,atom2)
353 >    ul2(2) = A_Col(8,atom2)
354      ul2(3) = A_Col(9,atom2)
355   #else
356 <    ul1(1) = A(3,atom1)
357 <    ul1(2) = A(6,atom1)
358 <    ul1(3) = A(9,atom1)
356 >    ul1(1) = Amat(7,atom1)
357 >    ul1(2) = Amat(8,atom1)
358 >    ul1(3) = Amat(9,atom1)
359  
360 <    ul2(1) = A(3,atom2)
361 <    ul2(2) = A(6,atom2)
362 <    ul2(3) = A(9,atom2)
360 >    ul2(1) = Amat(7,atom2)
361 >    ul2(2) = Amat(8,atom2)
362 >    ul2(3) = Amat(9,atom2)
363   #endif
364      
365 <    dru1dx = ul1(1)
366 <    dru2dx = ul2(1)
367 <    dru1dy = ul1(2)
368 <    dru2dy = ul2(2)
369 <    dru1dz = ul1(3)
370 <    dru2dz = ul2(3)
168 <    
169 <    drdx = d(1) / r
170 <    drdy = d(2) / r
171 <    drdz = d(3) / r
172 <    
173 <    ! 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 <    
177 <    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 <    
188 <    dotsum = rdotu1+rdotu2
189 <    dotdiff = rdotu1-rdotu2
190 <    ds2 = dotsum*dotsum
191 <    dd2 = dotdiff*dotdiff
192 <  
193 <    opXdot = 1.0d0 + Chi*u1dotu2
194 <    omXdot = 1.0d0 - Chi*u1dotu2
195 <    opXpdot = 1.0d0 + ChiPrime*u1dotu2
196 <    omXpdot = 1.0d0 - ChiPrime*u1dotu2
197 <  
198 <    line1a = dotsum/opXdot
199 <    line1bx = dru1dx + dru2dx
200 <    line1by = dru1dy + dru2dy
201 <    line1bz = dru1dz + dru2dz
202 <    
203 <    line2a = dotdiff/omXdot
204 <    line2bx = dru1dx - dru2dx
205 <    line2by = dru1dy - dru2dy
206 <    line2bz = dru1dz - dru2dz
207 <    
208 <    term1x = -Chi*(line1a*line1bx + line2a*line2bx)/r2
209 <    term1y = -Chi*(line1a*line1by + line2a*line2by)/r2
210 <    term1z = -Chi*(line1a*line1bz + line2a*line2bz)/r2
211 <    
212 <    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 <    
219 <    dgdx = term1x + line3x
220 <    dgdy = term1y + line3y
221 <    dgdz = term1z + line3z
365 >    if (i_is_LJ) then
366 >       a = 0.0_dp
367 >       ul1 = 0.0_dp
368 >    else
369 >       a = d(1)*ul1(1)   + d(2)*ul1(2)   + d(3)*ul1(3)
370 >    endif
371  
372 <    term1u1x = 2.0d0*(line1a+line2a)*d(1)
373 <    term1u1y = 2.0d0*(line1a+line2a)*d(2)
374 <    term1u1z = 2.0d0*(line1a+line2a)*d(3)
375 <    term1u2x = 2.0d0*(line1a-line2a)*d(1)
376 <    term1u2y = 2.0d0*(line1a-line2a)*d(2)
377 <    term1u2z = 2.0d0*(line1a-line2a)*d(3)
229 <    
230 <    term2a = -line3a/opXdot
231 <    term2b =  line3b/omXdot
232 <    
233 <    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 <    
240 <    pref = -Chi*0.5d0/r2
372 >    if (j_is_LJ) then
373 >       b = 0.0_dp
374 >       ul2 = 0.0_dp
375 >    else      
376 >       b = d(1)*ul2(1)   + d(2)*ul2(2)   + d(3)*ul2(3)
377 >    endif
378  
379 <    dgdu1x = pref*(term1u1x+term2u1x)
380 <    dgdu1y = pref*(term1u1y+term2u1y)
381 <    dgdu1z = pref*(term1u1z+term2u1z)
382 <    dgdu2x = pref*(term1u2x+term2u2x)
383 <    dgdu2y = pref*(term1u2y+term2u2y)
247 <    dgdu2z = pref*(term1u2z+term2u2z)
379 >    if (i_is_LJ.or.j_is_LJ) then
380 >       g = 0.0_dp
381 >    else
382 >       g = ul1(1)*ul2(1) + ul1(2)*ul2(2) + ul1(3)*ul2(3)
383 >    endif
384  
385 <    g = 1.0d0 - Chi*(line3a + line3b)/(2.0d0*r2)
386 <  
251 <    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
385 >    au = a / r
386 >    bu = b / r
387  
388 <    gfact = (g**(-1.5d0))*0.5d0
388 >    au2 = au * au
389 >    bu2 = bu * bu
390 >    g2 = g * g
391  
392 <    dBigRdx = drdx/gb_sigma + dgdx*gfact
393 <    dBigRdy = drdy/gb_sigma + dgdy*gfact
263 <    dBigRdz = drdz/gb_sigma + dgdz*gfact
264 <    dBigRdu1x = dgdu1x*gfact
265 <    dBigRdu1y = dgdu1y*gfact
266 <    dBigRdu1z = dgdu1z*gfact
267 <    dBigRdu2x = dgdu2x*gfact
268 <    dBigRdu2y = dgdu2y*gfact
269 <    dBigRdu2z = dgdu2z*gfact
270 <  
271 <    ! Now, we must do it again for g(ChiPrime) and dgpdx
392 >    H  = (xa2 * au2 + xai2 * bu2 - 2.0_dp*x2*au*bu*g)  / (1.0_dp - x2*g2)
393 >    Hp = (xpap2*au2 + xpapi2*bu2 - 2.0_dp*xp2*au*bu*g) / (1.0_dp - xp2*g2)
394  
395 <    line1a = dotsum/opXpdot
396 <    line2a = dotdiff/omXpdot
397 <    term1x = -ChiPrime*(line1a*line1bx + line2a*line2bx)/r2
398 <    term1y = -ChiPrime*(line1a*line1by + line2a*line2by)/r2
399 <    term1z = -ChiPrime*(line1a*line1bz + line2a*line2bz)/r2
278 <    line3a = ds2/opXpdot
279 <    line3b = dd2/omXpdot
280 <    line3 = ChiPrime*(line3a + line3b)/r4
281 <    line3x = d(1)*line3
282 <    line3y = d(2)*line3
283 <    line3z = d(3)*line3
395 >    sigma = sigma0 / sqrt(1.0_dp - H)
396 >    e1 = 1.0_dp / sqrt(1.0_dp - x2*g2)
397 >    e2 = 1.0_dp - Hp
398 >    eps = eps0 * (e1**nu) * (e2**mu)
399 >    BigR = dw*sigma0 / (r - sigma + dw*sigma0)
400      
401 <    dgpdx = term1x + line3x
402 <    dgpdy = term1y + line3y
403 <    dgpdz = term1z + line3z
404 <    
405 <    term1u1x = 2.0d0*(line1a+line2a)*d(1)
290 <    term1u1y = 2.0d0*(line1a+line2a)*d(2)
291 <    term1u1z = 2.0d0*(line1a+line2a)*d(3)
292 <    term1u2x = 2.0d0*(line1a-line2a)*d(1)
293 <    term1u2y = 2.0d0*(line1a-line2a)*d(2)
294 <    term1u2z = 2.0d0*(line1a-line2a)*d(3)
295 <    
296 <    term2a = -line3a/opXpdot
297 <    term2b =  line3b/omXpdot
298 <    
299 <    term2u1x = ChiPrime*ul2(1)*(term2a + term2b)
300 <    term2u1y = ChiPrime*ul2(2)*(term2a + term2b)
301 <    term2u1z = ChiPrime*ul2(3)*(term2a + term2b)
302 <    term2u2x = ChiPrime*ul1(1)*(term2a + term2b)
303 <    term2u2y = ChiPrime*ul1(2)*(term2a + term2b)
304 <    term2u2z = ChiPrime*ul1(3)*(term2a + term2b)
305 <  
306 <    pref = -ChiPrime*0.5d0/r2
307 <    
308 <    dgpdu1x = pref*(term1u1x+term2u1x)
309 <    dgpdu1y = pref*(term1u1y+term2u1y)
310 <    dgpdu1z = pref*(term1u1z+term2u1z)
311 <    dgpdu2x = pref*(term1u2x+term2u2x)
312 <    dgpdu2y = pref*(term1u2y+term2u2y)
313 <    dgpdu2z = pref*(term1u2z+term2u2z)
314 <    
315 <    gp = 1.0d0 - ChiPrime*(line3a + line3b)/(2.0d0*r2)
316 <    gmu = gp**gb_mu
317 <    gpi = 1.0d0 / gp
318 <    gmum = gmu*gpi
319 <  
320 <    ! write(*,*) atom1, atom2, Chi, u1dotu2
321 <    curlyE = 1.0d0/dsqrt(1.0d0 - Chi*Chi*u1dotu2*u1dotu2)
401 >    R3 = BigR*BigR*BigR
402 >    R6 = R3*R3
403 >    R7 = R6 * BigR
404 >    R12 = R6*R6
405 >    R13 = R6*R7
406  
407 <    dcE = (curlyE**3)*Chi*Chi*u1dotu2
408 <  
409 <    dcEdu1x = dcE*ul2(1)
410 <    dcEdu1y = dcE*ul2(2)
411 <    dcEdu1z = dcE*ul2(3)
412 <    dcEdu2x = dcE*ul1(1)
413 <    dcEdu2y = dcE*ul1(2)
414 <    dcEdu2z = dcE*ul1(3)
407 >    U = 4.0_dp * eps * (R12 - R6)
408 >
409 >    s3 = sigma*sigma*sigma
410 >    s03 = sigma0*sigma0*sigma0
411 >
412 >    pref1 = - 8.0_dp * eps * mu * (R12 - R6) / (e2 * r)
413 >
414 >    pref2 = 8.0_dp * eps * s3 * (6.0_dp*R13 - 3.0_dp*R7) / (dw*r*s03)
415 >
416 >    dUdr = - (pref1 * Hp + pref2 * (sigma0*sigma0*r/s3 + H))
417      
418 <    enu = curlyE**gb_nu
419 <    enum = enu/curlyE
334 <  
335 <    eps = gb_eps*enu*gmu
418 >    dUda = pref1 * (xpap2*au - xp2*bu*g) / (1.0_dp - xp2 * g2) &
419 >         + pref2 * (xa2 * au - x2 *bu*g) / (1.0_dp - x2 * g2)
420  
421 <    yick1 = gb_eps*enu*gb_mu*gmum
422 <    yick2 = gb_eps*gmu*gb_nu*enum
421 >    dUdb = pref1 * (xpapi2*bu - xp2*au*g) / (1.0_dp - xp2 * g2) &
422 >         + pref2 * (xai2 * bu - x2 *au*g) / (1.0_dp - x2 * g2)
423  
424 <    depsdu1x = yick1*dgpdu1x + yick2*dcEdu1x
425 <    depsdu1y = yick1*dgpdu1y + yick2*dcEdu1y
426 <    depsdu1z = yick1*dgpdu1z + yick2*dcEdu1z
427 <    depsdu2x = yick1*dgpdu2x + yick2*dcEdu2x
428 <    depsdu2y = yick1*dgpdu2y + yick2*dcEdu2y
429 <    depsdu2z = yick1*dgpdu2z + yick2*dcEdu2z
424 >    dUdg = 4.0_dp * eps * nu * (R12 - R6) * x2 * g / (1.0_dp - x2*g2) &
425 >         + 8.0_dp * eps * mu * (R12 - R6) * (xp2*au*bu - Hp*xp2*g) / &
426 >         (1.0_dp - xp2 * g2) / e2 &
427 >         + 8.0_dp * eps * s3 * (3.0_dp * R7 - 6.0_dp * R13) * &  
428 >         (x2 * au * bu - H * x2 * g) / (1.0_dp - x2 * g2) / (dw * s03)
429 >
430 >            
431 >    rhat = d / r
432 >
433 >    fx = dUdr * rhat(1) + dUda * ul1(1) + dUdb * ul2(1)
434 >    fy = dUdr * rhat(2) + dUda * ul1(2) + dUdb * ul2(2)
435 >    fz = dUdr * rhat(3) + dUda * ul1(3) + dUdb * ul2(3)    
436 >
437 >    rxu1 = cross_product(d, ul1)
438 >    rxu2 = cross_product(d, ul2)    
439 >    uxu = cross_product(ul1, ul2)
440      
441 <    R126 = Ri12 - Ri6
442 <    R137 = 6.0d0*Ri7 - 12.0d0*Ri13
443 <    
444 <    mess1 = gmu*R137
445 <    mess2 = R126*gb_mu*gmum
446 <    
447 <    dUdx = 4.0d0*gb_eps*enu*(mess1*dBigRdx + mess2*dgpdx)*sw
448 <    dUdy = 4.0d0*gb_eps*enu*(mess1*dBigRdy + mess2*dgpdy)*sw
449 <    dUdz = 4.0d0*gb_eps*enu*(mess1*dBigRdz + mess2*dgpdz)*sw
450 <    
451 <    dUdu1x = 4.0d0*(R126*depsdu1x + eps*R137*dBigRdu1x)*sw
452 <    dUdu1y = 4.0d0*(R126*depsdu1y + eps*R137*dBigRdu1y)*sw
453 <    dUdu1z = 4.0d0*(R126*depsdu1z + eps*R137*dBigRdu1z)*sw
454 <    dUdu2x = 4.0d0*(R126*depsdu2x + eps*R137*dBigRdu2x)*sw
455 <    dUdu2y = 4.0d0*(R126*depsdu2y + eps*R137*dBigRdu2y)*sw
362 <    dUdu2z = 4.0d0*(R126*depsdu2z + eps*R137*dBigRdu2z)*sw
363 <      
441 > !!$    write(*,*) 'pref = ' , pref1, pref2
442 > !!$    write(*,*) 'rxu1 = ' , rxu1(1), rxu1(2), rxu1(3)
443 > !!$    write(*,*) 'rxu2 = ' , rxu2(1), rxu2(2), rxu2(3)
444 > !!$    write(*,*) 'uxu = ' , uxu(1), uxu(2), uxu(3)
445 > !!$    write(*,*) 'dUda = ', dUda, dudb, dudg, dudr
446 > !!$    write(*,*) 'H = ', H,hp,sigma, e1, e2, BigR
447 > !!$    write(*,*) 'chi = ', xa2, xai2, x2
448 > !!$    write(*,*) 'chip = ', xpap2, xpapi2, xp2
449 > !!$    write(*,*) 'eps = ', eps0, e1, e2, eps
450 > !!$    write(*,*) 'U =', U, pref1, pref2
451 > !!$    write(*,*) 'f =', fx, fy, fz
452 > !!$    write(*,*) 'au =', au, bu, g
453 > !!$    
454 >        
455 >  
456   #ifdef IS_MPI
457 <    f_Row(1,atom1) = f_Row(1,atom1) + dUdx
458 <    f_Row(2,atom1) = f_Row(2,atom1) + dUdy
459 <    f_Row(3,atom1) = f_Row(3,atom1) + dUdz
457 >    f_Row(1,atom1) = f_Row(1,atom1) + fx
458 >    f_Row(2,atom1) = f_Row(2,atom1) + fy
459 >    f_Row(3,atom1) = f_Row(3,atom1) + fz
460      
461 <    f_Col(1,atom2) = f_Col(1,atom2) - dUdx
462 <    f_Col(2,atom2) = f_Col(2,atom2) - dUdy
463 <    f_Col(3,atom2) = f_Col(3,atom2) - dUdz
461 >    f_Col(1,atom2) = f_Col(1,atom2) - fx
462 >    f_Col(2,atom2) = f_Col(2,atom2) - fy
463 >    f_Col(3,atom2) = f_Col(3,atom2) - fz
464      
465 <    t_Row(1,atom1) = t_Row(1,atom1) - ul1(2)*dUdu1z + ul1(3)*dUdu1y
466 <    t_Row(2,atom1) = t_Row(2,atom1) - ul1(3)*dUdu1x + ul1(1)*dUdu1z
467 <    t_Row(3,atom1) = t_Row(3,atom1) - ul1(1)*dUdu1y + ul1(2)*dUdu1x
468 <    
469 <    t_Col(1,atom2) = t_Col(1,atom2) - ul2(2)*dUdu2z + ul2(3)*dUdu2y
470 <    t_Col(2,atom2) = t_Col(2,atom2) - ul2(3)*dUdu2x + ul2(1)*dUdu2z
471 <    t_Col(3,atom2) = t_Col(3,atom2) - ul2(1)*dUdu2y + ul2(2)*dUdu2x
465 >    t_Row(1,atom1) = t_Row(1,atom1) + dUda*rxu1(1) - dUdg*uxu(1)
466 >    t_Row(2,atom1) = t_Row(2,atom1) + dUda*rxu1(2) - dUdg*uxu(2)
467 >    t_Row(3,atom1) = t_Row(3,atom1) + dUda*rxu1(3) - dUdg*uxu(3)
468 >                                                                
469 >    t_Col(1,atom2) = t_Col(1,atom2) + dUdb*rxu2(1) + dUdg*uxu(1)
470 >    t_Col(2,atom2) = t_Col(2,atom2) + dUdb*rxu2(2) + dUdg*uxu(2)
471 >    t_Col(3,atom2) = t_Col(3,atom2) + dUdb*rxu2(3) + dUdg*uxu(3)
472   #else
473 <    f(1,atom1) = f(1,atom1) + dUdx
474 <    f(2,atom1) = f(2,atom1) + dUdy
475 <    f(3,atom1) = f(3,atom1) + dUdz
473 >    f(1,atom1) = f(1,atom1) + fx
474 >    f(2,atom1) = f(2,atom1) + fy
475 >    f(3,atom1) = f(3,atom1) + fz
476      
477 <    f(1,atom2) = f(1,atom2) - dUdx
478 <    f(2,atom2) = f(2,atom2) - dUdy
479 <    f(3,atom2) = f(3,atom2) - dUdz
477 >    f(1,atom2) = f(1,atom2) - fx
478 >    f(2,atom2) = f(2,atom2) - fy
479 >    f(3,atom2) = f(3,atom2) - fz
480      
481 <    t(1,atom1) = t(1,atom1) - ul1(2)*dUdu1z + ul1(3)*dUdu1y
482 <    t(2,atom1) = t(2,atom1) - ul1(3)*dUdu1x + ul1(1)*dUdu1z
483 <    t(3,atom1) = t(3,atom1) - ul1(1)*dUdu1y + ul1(2)*dUdu1x
484 <    
485 <    t(1,atom2) = t(1,atom2) - ul2(2)*dUdu2z + ul2(3)*dUdu2y
486 <    t(2,atom2) = t(2,atom2) - ul2(3)*dUdu2x + ul2(1)*dUdu2z
487 <    t(3,atom2) = t(3,atom2) - ul2(1)*dUdu2y + ul2(2)*dUdu2x
481 >    t(1,atom1) = t(1,atom1) +  dUda*rxu1(1) - dUdg*uxu(1)
482 >    t(2,atom1) = t(2,atom1) +  dUda*rxu1(2) - dUdg*uxu(2)
483 >    t(3,atom1) = t(3,atom1) +  dUda*rxu1(3) - dUdg*uxu(3)
484 >                                                        
485 >    t(1,atom2) = t(1,atom2) +  dUdb*rxu2(1) + dUdg*uxu(1)
486 >    t(2,atom2) = t(2,atom2) +  dUdb*rxu2(2) + dUdg*uxu(2)
487 >    t(3,atom2) = t(3,atom2) +  dUdb*rxu2(3) + dUdg*uxu(3)
488   #endif
489 <            
489 >  
490      if (do_pot) then
491   #ifdef IS_MPI
492 <       pot_row(atom1) = pot_row(atom1) + 2.0d0*eps*R126*sw
493 <       pot_col(atom2) = pot_col(atom2) + 2.0d0*eps*R126*sw
492 >       pot_row(VDW_POT,atom1) = pot_row(VDW_POT,atom1) + 0.5d0*U*sw
493 >       pot_col(VDW_POT,atom2) = pot_col(VDW_POT,atom2) + 0.5d0*U*sw
494   #else
495 <       pot = pot + 4.0*eps*R126*sw
495 >       pot = pot + U*sw
496   #endif
497      endif
498 <
499 <    vpair = vpair + 4.0*eps*R126
498 >    
499 >    vpair = vpair + U*sw
500   #ifdef IS_MPI
501      id1 = AtomRowToGlobal(atom1)
502      id2 = AtomColToGlobal(atom2)
# Line 415 | Line 507 | contains
507      
508      if (molMembershipList(id1) .ne. molMembershipList(id2)) then
509        
510 <       fpair(1) = fpair(1) + dUdx
511 <       fpair(2) = fpair(2) + dUdy
512 <       fpair(3) = fpair(3) + dUdz
510 >       fpair(1) = fpair(1) + fx
511 >       fpair(2) = fpair(2) + fy
512 >       fpair(3) = fpair(3) + fz
513        
514      endif
515      
516      return
517    end subroutine do_gb_pair
518 +  
519 +  subroutine destroyGBTypes()
520  
521 < end module gb_pair
521 >    GBMap%nGBtypes = 0
522 >    GBMap%currentGBtype = 0
523 >    
524 >    if (associated(GBMap%GBtypes)) then
525 >       deallocate(GBMap%GBtypes)
526 >       GBMap%GBtypes => null()
527 >    end if
528 >    
529 >    if (associated(GBMap%atidToGBtype)) then
530 >       deallocate(GBMap%atidToGBtype)
531 >       GBMap%atidToGBtype => null()
532 >    end if
533 >    
534 >    haveMixingMap = .false.
535 >    
536 >  end subroutine destroyGBTypes
537  
538 <
539 <  subroutine set_gb_pair_params(sigma, l2b_ratio, eps, eps_ratio, mu, nu)
431 <    use definitions, ONLY : dp
432 <    use gb_pair, ONLY : module_set_gb_pair_params => set_gb_pair_params
433 <    real( kind = dp ), intent(inout) :: sigma, l2b_ratio, eps, eps_ratio
434 <    real( kind = dp ), intent(inout) :: mu, nu
435 <    call module_set_gb_pair_params(sigma, l2b_ratio, eps, eps_ratio, mu, nu)
436 < end subroutine set_gb_pair_params
538 > end module gayberne
539 >    

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines