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 2378 by gezelter, Mon Oct 17 21:47:45 2005 UTC vs.
Revision 2787 by gezelter, Mon Jun 5 18:24:45 2006 UTC

# Line 46 | Line 46 | module gayberne
46    use simulation
47    use atype_module
48    use vector_class
49 +  use linearalgebra
50    use status
51    use lj
52   #ifdef IS_MPI
# Line 59 | Line 60 | module gayberne
60   #define __FORTRAN90
61   #include "UseTheForce/DarkSide/fInteractionMap.h"
62  
63 +  logical, save :: haveGBMap = .false.
64 +  logical, save :: haveMixingMap = .false.
65 +  real(kind=dp), save :: mu = 2.0_dp
66 +  real(kind=dp), save :: nu = 1.0_dp
67 +
68 +
69    public :: newGBtype
70 +  public :: complete_GB_FF
71    public :: do_gb_pair
64  public :: do_gb_lj_pair
72    public :: getGayBerneCut
73    public :: destroyGBtypes
74  
75    type :: GBtype
76       integer          :: atid
77 <     real(kind = dp ) :: sigma
78 <     real(kind = dp ) :: l2b_ratio
77 >     real(kind = dp ) :: d
78 >     real(kind = dp ) :: l
79       real(kind = dp ) :: eps
80       real(kind = dp ) :: eps_ratio
81 <     real(kind = dp ) :: mu
82 <     real(kind = dp ) :: nu
76 <     real(kind = dp ) :: sigma_l
77 <     real(kind = dp ) :: eps_l
81 >     real(kind = dp ) :: dw
82 >     logical          :: isLJ
83    end type GBtype
84 <
84 >  
85    type, private :: GBList
86       integer               :: nGBtypes = 0
87       integer               :: currentGBtype = 0
88       type(GBtype), pointer :: GBtypes(:)      => null()
89       integer, pointer      :: atidToGBtype(:) => null()
90    end type GBList
91 <
91 >  
92    type(GBList), save :: GBMap
93 <
93 >  
94 >  type :: GBMixParameters
95 >     real(kind=DP) :: sigma0
96 >     real(kind=DP) :: eps0
97 >     real(kind=DP) :: dw
98 >     real(kind=DP) :: x2
99 >     real(kind=DP) :: xa2
100 >     real(kind=DP) :: xai2
101 >     real(kind=DP) :: xp2
102 >     real(kind=DP) :: xpap2
103 >     real(kind=DP) :: xpapi2
104 >  end type GBMixParameters
105 >  
106 >  type(GBMixParameters), dimension(:,:), allocatable :: GBMixingMap
107 >  
108   contains
109 <
110 <  subroutine newGBtype(c_ident, sigma, l2b_ratio, eps, eps_ratio, mu, nu, &
92 <       status)
109 >  
110 >  subroutine newGBtype(c_ident, d, l, eps, eps_ratio, dw, status)
111      
112      integer, intent(in) :: c_ident
113 <    real( kind = dp ), intent(in) :: sigma, l2b_ratio, eps, eps_ratio
96 <    real( kind = dp ), intent(in) :: mu, nu
113 >    real( kind = dp ), intent(in) :: d, l, eps, eps_ratio, dw
114      integer, intent(out) :: status
115 <
116 <    integer :: nGBTypes, ntypes, myATID
115 >    
116 >    integer :: nGBTypes, nLJTypes, ntypes, myATID
117      integer, pointer :: MatchList(:) => null()
118      integer :: current, i
119      status = 0
120 <
120 >    
121      if (.not.associated(GBMap%GBtypes)) then
122 <                              
122 >      
123         call getMatchingElementList(atypes, "is_GayBerne", .true., &
124              nGBtypes, MatchList)
125        
126 <       GBMap%nGBtypes = nGBtypes
127 <
128 <       allocate(GBMap%GBtypes(nGBtypes))
129 <
126 >       call getMatchingElementList(atypes, "is_LennardJones", .true., &
127 >            nLJTypes, MatchList)
128 >      
129 >       GBMap%nGBtypes = nGBtypes + nLJTypes
130 >      
131 >       allocate(GBMap%GBtypes(nGBtypes + nLJTypes))
132 >      
133         ntypes = getSize(atypes)
134        
135 <       allocate(GBMap%atidToGBtype(ntypes))
135 >       allocate(GBMap%atidToGBtype(ntypes))      
136 >    endif
137 >    
138 >    GBMap%currentGBtype = GBMap%currentGBtype + 1
139 >    current = GBMap%currentGBtype
140 >    
141 >    myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
142 >    
143 >    GBMap%atidToGBtype(myATID)       = current
144 >    GBMap%GBtypes(current)%atid      = myATID
145 >    GBMap%GBtypes(current)%d         = d
146 >    GBMap%GBtypes(current)%l         = l
147 >    GBMap%GBtypes(current)%eps       = eps
148 >    GBMap%GBtypes(current)%eps_ratio = eps_ratio
149 >    GBMap%GBtypes(current)%dw        = dw
150 >    GBMap%GBtypes(current)%isLJ      = .false.
151 >    
152 >    return
153 >  end subroutine newGBtype
154 >  
155 >  subroutine complete_GB_FF(status)
156 >    integer :: status
157 >    integer :: i, j, l, m, lm, function_type
158 >    real(kind=dp) :: thisDP, sigma
159 >    integer :: alloc_stat, iTheta, iPhi, nSteps, nAtypes, myATID, current
160 >    logical :: thisProperty
161 >    
162 >    status = 0
163 >    if (GBMap%currentGBtype == 0) then
164 >       call handleError("complete_GB_FF", "No members in GBMap")
165 >       status = -1
166 >       return
167 >    end if
168 >    
169 >    nAtypes = getSize(atypes)
170 >    
171 >    if (nAtypes == 0) then
172 >       status = -1
173 >       return
174 >    end if
175 >    
176 >    ! atypes comes from c side
177 >    do i = 1, nAtypes
178        
179 <       !! initialize atidToGBtype to -1 so that we can use this
180 <       !! array to figure out which atom comes first in the GBLJ
181 <       !! routine
179 >       myATID = getFirstMatchingElement(atypes, 'c_ident', i)
180 >       call getElementProperty(atypes, myATID, "is_LennardJones", thisProperty)
181 >      
182 >       if (thisProperty) then
183 >          GBMap%currentGBtype = GBMap%currentGBtype + 1
184 >          current = GBMap%currentGBtype
185 >          
186 >          GBMap%atidToGBtype(myATID) = current
187 >          GBMap%GBtypes(current)%atid      = myATID      
188 >          GBMap%GBtypes(current)%isLJ      = .true.          
189 >          GBMap%GBtypes(current)%d         = getSigma(myATID)
190 >          GBMap%GBtypes(current)%l         = GBMap%GBtypes(current)%d
191 >          GBMap%GBtypes(current)%eps       = getEpsilon(myATID)
192 >          GBMap%GBtypes(current)%eps_ratio = 1.0_dp
193 >          GBMap%GBtypes(current)%dw        = 1.0_dp
194 >          
195 >       endif
196 >      
197 >    end do
198 >    
199 >    haveGBMap = .true.
200 >    
201 >  end subroutine complete_GB_FF
202  
203 <       do i = 1, ntypes
204 <          GBMap%atidToGBtype(i) = -1
205 <       enddo
203 >  subroutine createGBMixingMap()
204 >    integer :: nGBtypes, i, j
205 >    real (kind = dp) :: d1, l1, e1, er1, dw1
206 >    real (kind = dp) :: d2, l2, e2, er2, dw2
207 >    real (kind = dp) :: er, ermu, xp, ap2
208  
209 +    if (GBMap%currentGBtype == 0) then
210 +       call handleError("GB", "No members in GBMap")
211 +       return
212 +    end if
213 +    
214 +    nGBtypes = GBMap%nGBtypes
215 +
216 +    if (.not. allocated(GBMixingMap)) then
217 +       allocate(GBMixingMap(nGBtypes, nGBtypes))
218      endif
219  
220 <    GBMap%currentGBtype = GBMap%currentGBtype + 1
128 <    current = GBMap%currentGBtype
220 >    do i = 1, nGBtypes
221  
222 <    myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
223 <    GBMap%atidToGBtype(myATID)        = current
224 <    GBMap%GBtypes(current)%atid       = myATID
225 <    GBMap%GBtypes(current)%sigma      = sigma
226 <    GBMap%GBtypes(current)%l2b_ratio  = l2b_ratio
135 <    GBMap%GBtypes(current)%eps        = eps
136 <    GBMap%GBtypes(current)%eps_ratio  = eps_ratio
137 <    GBMap%GBtypes(current)%mu         = mu
138 <    GBMap%GBtypes(current)%nu         = nu
139 <    GBMap%GBtypes(current)%sigma_l    = sigma*l2b_ratio
140 <    GBMap%GBtypes(current)%eps_l      = eps*eps_ratio
222 >       d1 = GBMap%GBtypes(i)%d
223 >       l1 = GBMap%GBtypes(i)%l
224 >       e1 = GBMap%GBtypes(i)%eps
225 >       er1 = GBMap%GBtypes(i)%eps_ratio
226 >       dw1 = GBMap%GBtypes(i)%dw
227  
228 <    return
143 <  end subroutine newGBtype
228 >       do j = i, nGBtypes
229  
230 +          d2 = GBMap%GBtypes(j)%d
231 +          l2 = GBMap%GBtypes(j)%l
232 +          e2 = GBMap%GBtypes(j)%eps
233 +          er2 = GBMap%GBtypes(j)%eps_ratio
234 +          dw2 = GBMap%GBtypes(j)%dw
235 +
236 +          GBMixingMap(i,j)%sigma0 = sqrt(d1*d1 + d2*d2)
237 +          GBMixingMap(i,j)%xa2 = (l1*l1 - d1*d1)/(l1*l1 + d2*d2)
238 +          GBMixingMap(i,j)%xai2 = (l2*l2 - d2*d2)/(l2*l2 + d1*d1)
239 +          GBMixingMap(i,j)%x2 = (l1*l1 - d1*d1) * (l2*l2 - d2*d2) / &
240 +               ((l2*l2 + d1*d1) * (l1*l1 + d2*d2))
241 +
242 +          ! assumed LB mixing rules for now:
243 +
244 +          GBMixingMap(i,j)%dw = 0.5_dp * (dw1 + dw2)
245 +          GBMixingMap(i,j)%eps0 = sqrt(e1 * e2)
246 +
247 +          er = sqrt(er1 * er2)
248 +          ermu = er**(1.0_dp / mu)
249 +          xp = (1.0_dp - ermu) / (1.0_dp + ermu)
250 +          ap2 = 1.0_dp / (1.0_dp + ermu)
251 +
252 +          GBMixingMap(i,j)%xp2 = xp*xp
253 +          GBMixingMap(i,j)%xpap2 = xp*ap2
254 +          GBMixingMap(i,j)%xpapi2 = xp/ap2
255 +          
256 +          if (i.ne.j) then
257 +             GBMixingMap(j,i)%sigma0 = GBMixingMap(i,j)%sigma0
258 +             GBMixingMap(j,i)%dw     = GBMixingMap(i,j)%dw    
259 +             GBMixingMap(j,i)%eps0   = GBMixingMap(i,j)%eps0  
260 +             GBMixingMap(j,i)%x2     = GBMixingMap(i,j)%x2    
261 +             GBMixingMap(j,i)%xa2    = GBMixingMap(i,j)%xa2  
262 +             GBMixingMap(j,i)%xai2   = GBMixingMap(i,j)%xai2  
263 +             GBMixingMap(j,i)%xp2    = GBMixingMap(i,j)%xp2  
264 +             GBMixingMap(j,i)%xpap2  = GBMixingMap(i,j)%xpap2
265 +             GBMixingMap(j,i)%xpapi2 = GBMixingMap(i,j)%xpapi2
266 +          endif
267 +       enddo
268 +    enddo
269 +    haveMixingMap = .true.
270 +    
271 +  end subroutine createGBMixingMap
272    
273 +
274    !! gay berne cutoff should be a parameter in globals, this is a temporary
275    !! work around - this should be fixed when gay berne is up and running
276  
277    function getGayBerneCut(atomID) result(cutValue)
278      integer, intent(in) :: atomID
279      integer :: gbt1
280 <    real(kind=dp) :: cutValue, sigma, l2b_ratio
280 >    real(kind=dp) :: cutValue, l, d
281  
282      if (GBMap%currentGBtype == 0) then
283         call handleError("GB", "No members in GBMap")
# Line 157 | Line 285 | contains
285      end if
286  
287      gbt1 = GBMap%atidToGBtype(atomID)
288 <    sigma = GBMap%GBtypes(gbt1)%sigma
289 <    l2b_ratio = GBMap%GBtypes(gbt1)%l2b_ratio
288 >    l = GBMap%GBtypes(gbt1)%l
289 >    d = GBMap%GBtypes(gbt1)%d  
290 >    cutValue = 2.5_dp*max(l,d)
291  
163    cutValue = l2b_ratio*sigma*2.5_dp
292    end function getGayBerneCut
293  
294    subroutine do_gb_pair(atom1, atom2, d, r, r2, sw, vpair, fpair, &
295 <       pot, A, f, t, do_pot)
295 >       pot, Amat, f, t, do_pot)
296      
297      integer, intent(in) :: atom1, atom2
298      integer :: atid1, atid2, gbt1, gbt2, id1, id2
# Line 172 | Line 300 | contains
300      real (kind=dp), dimension(3), intent(in) :: d
301      real (kind=dp), dimension(3), intent(inout) :: fpair
302      real (kind=dp) :: pot, sw, vpair
303 <    real (kind=dp), dimension(9,nLocal) :: A
303 >    real (kind=dp), dimension(9,nLocal) :: Amat
304      real (kind=dp), dimension(3,nLocal) :: f
305      real (kind=dp), dimension(3,nLocal) :: t
306      logical, intent(in) :: do_pot
307 <    real (kind = dp), dimension(3) :: ul1
180 <    real (kind = dp), dimension(3) :: ul2
307 >    real (kind = dp), dimension(3) :: ul1, ul2, rxu1, rxu2, uxu, rhat
308  
309 <    real(kind=dp) :: sigma, l2b_ratio, epsilon, eps_ratio, mu, nu, sigma_l, eps_l
310 <    real(kind=dp) :: chi, chiprime, emu, s2
311 <    real(kind=dp) :: r4, rdotu1, rdotu2, u1dotu2, g, gp, gpi, gmu, gmum
312 <    real(kind=dp) :: curlyE, enu, enum, eps, dotsum, dotdiff, ds2, dd2
313 <    real(kind=dp) :: opXdot, omXdot, opXpdot, omXpdot, pref, gfact
314 <    real(kind=dp) :: BigR, Ri, Ri2, Ri6, Ri7, Ri12, Ri13, R126, R137
315 <    real(kind=dp) :: dru1dx, dru1dy, dru1dz
316 <    real(kind=dp) :: dru2dx, dru2dy, dru2dz
317 <    real(kind=dp) :: dBigRdx, dBigRdy, dBigRdz
318 <    real(kind=dp) :: dBigRdu1x, dBigRdu1y, dBigRdu1z
192 <    real(kind=dp) :: dBigRdu2x, dBigRdu2y, dBigRdu2z
193 <    real(kind=dp) :: dUdx, dUdy, dUdz
194 <    real(kind=dp) :: dUdu1x, dUdu1y, dUdu1z, dUdu2x, dUdu2y, dUdu2z
195 <    real(kind=dp) :: dcE, dcEdu1x, dcEdu1y, dcEdu1z, dcEdu2x, dcEdu2y, dcEdu2z
196 <    real(kind=dp) :: depsdu1x, depsdu1y, depsdu1z, depsdu2x, depsdu2y, depsdu2z
197 <    real(kind=dp) :: drdx, drdy, drdz
198 <    real(kind=dp) :: dgdx, dgdy, dgdz
199 <    real(kind=dp) :: dgdu1x, dgdu1y, dgdu1z, dgdu2x, dgdu2y, dgdu2z
200 <    real(kind=dp) :: dgpdx, dgpdy, dgpdz
201 <    real(kind=dp) :: dgpdu1x, dgpdu1y, dgpdu1z, dgpdu2x, dgpdu2y, dgpdu2z
202 <    real(kind=dp) :: line1a, line1bx, line1by, line1bz
203 <    real(kind=dp) :: line2a, line2bx, line2by, line2bz
204 <    real(kind=dp) :: line3a, line3b, line3, line3x, line3y, line3z
205 <    real(kind=dp) :: term1x, term1y, term1z, term1u1x, term1u1y, term1u1z
206 <    real(kind=dp) :: term1u2x, term1u2y, term1u2z
207 <    real(kind=dp) :: term2a, term2b, term2u1x, term2u1y, term2u1z
208 <    real(kind=dp) :: term2u2x, term2u2y, term2u2z
209 <    real(kind=dp) :: yick1, yick2, mess1, mess2
210 <    
309 >    real (kind = dp) :: sigma0, dw, eps0, x2, xa2, xai2, xp2, xpap2, xpapi2
310 >    real (kind = dp) :: e1, e2, eps, sigma, s3, s03, au, bu, a, b, g, g2
311 >    real (kind = dp) :: U, BigR, R3, R6, R7, R12, R13, H, Hp, fx, fy, fz
312 >    real (kind = dp) :: dUdr, dUda, dUdb, dUdg, pref1, pref2
313 >    logical :: i_is_lj, j_is_lj
314 >
315 >    if (.not.haveMixingMap) then
316 >       call createGBMixingMap()
317 >    endif
318 >
319   #ifdef IS_MPI
320      atid1 = atid_Row(atom1)
321      atid2 = atid_Col(atom2)
# Line 217 | Line 325 | contains
325   #endif
326  
327      gbt1 = GBMap%atidToGBtype(atid1)
328 <    gbt2 = GBMap%atidToGBtype(atid2)
328 >    gbt2 = GBMap%atidToGBtype(atid2)    
329  
330 <    if (gbt1 .eq. gbt2) then
331 <       sigma     = GBMap%GBtypes(gbt1)%sigma      
224 <       l2b_ratio = GBMap%GBtypes(gbt1)%l2b_ratio  
225 <       epsilon   = GBMap%GBtypes(gbt1)%eps        
226 <       eps_ratio = GBMap%GBtypes(gbt1)%eps_ratio  
227 <       mu        = GBMap%GBtypes(gbt1)%mu        
228 <       nu        = GBMap%GBtypes(gbt1)%nu        
229 <       sigma_l   = GBMap%GBtypes(gbt1)%sigma_l    
230 <       eps_l     = GBMap%GBtypes(gbt1)%eps_l      
231 <    else
232 <       call handleError("GB", "GB-pair was called with two different GB types! OOPSE can only handle interactions for one GB type at a time.")
233 <    endif
330 >    i_is_LJ = GBMap%GBTypes(gbt1)%isLJ
331 >    j_is_LJ = GBMap%GBTypes(gbt2)%isLJ
332  
333 <    s2 = (l2b_ratio)**2
334 <    emu = (eps_ratio)**(1.0d0/mu)
335 <
336 <    chi = (s2 - 1.0d0)/(s2 + 1.0d0)
337 <    chiprime = (1.0d0 - emu)/(1.0d0 + emu)
338 <
339 <    r4 = r2*r2
340 <
333 >    sigma0 = GBMixingMap(gbt1, gbt2)%sigma0
334 >    dw     = GBMixingMap(gbt1, gbt2)%dw    
335 >    eps0   = GBMixingMap(gbt1, gbt2)%eps0  
336 >    x2     = GBMixingMap(gbt1, gbt2)%x2    
337 >    xa2    = GBMixingMap(gbt1, gbt2)%xa2  
338 >    xai2   = GBMixingMap(gbt1, gbt2)%xai2  
339 >    xp2    = GBMixingMap(gbt1, gbt2)%xp2  
340 >    xpap2  = GBMixingMap(gbt1, gbt2)%xpap2
341 >    xpapi2 = GBMixingMap(gbt1, gbt2)%xpapi2
342 >    
343   #ifdef IS_MPI
344 <    ul1(1) = A_Row(3,atom1)
345 <    ul1(2) = A_Row(6,atom1)
344 >    ul1(1) = A_Row(7,atom1)
345 >    ul1(2) = A_Row(8,atom1)
346      ul1(3) = A_Row(9,atom1)
347  
348 <    ul2(1) = A_Col(3,atom2)
349 <    ul2(2) = A_Col(6,atom2)
348 >    ul2(1) = A_Col(7,atom2)
349 >    ul2(2) = A_Col(8,atom2)
350      ul2(3) = A_Col(9,atom2)
351   #else
352 <    ul1(1) = A(3,atom1)
353 <    ul1(2) = A(6,atom1)
354 <    ul1(3) = A(9,atom1)
352 >    ul1(1) = Amat(7,atom1)
353 >    ul1(2) = Amat(8,atom1)
354 >    ul1(3) = Amat(9,atom1)
355  
356 <    ul2(1) = A(3,atom2)
357 <    ul2(2) = A(6,atom2)
358 <    ul2(3) = A(9,atom2)
356 >    ul2(1) = Amat(7,atom2)
357 >    ul2(2) = Amat(8,atom2)
358 >    ul2(3) = Amat(9,atom2)
359   #endif
360      
361 <    dru1dx = ul1(1)
362 <    dru2dx = ul2(1)
363 <    dru1dy = ul1(2)
364 <    dru2dy = ul2(2)
365 <    dru1dz = ul1(3)
366 <    dru2dz = ul2(3)
267 <        
268 <    drdx = d(1) / r
269 <    drdy = d(2) / r
270 <    drdz = d(3) / r
271 <    
272 <    ! do some dot products:
273 <    ! NB the r in these dot products is the actual intermolecular vector,
274 <    ! and is not the unit vector in that direction.
275 <    
276 <    rdotu1 = d(1)*ul1(1) + d(2)*ul1(2) + d(3)*ul1(3)
277 <    rdotu2 = d(1)*ul2(1) + d(2)*ul2(2) + d(3)*ul2(3)
278 <    u1dotu2 = ul1(1)*ul2(1) + ul1(2)*ul2(2) +  ul1(3)*ul2(3)
361 >    if (i_is_LJ) then
362 >       a = 0.0_dp
363 >       ul1 = 0.0_dp
364 >    else
365 >       a = d(1)*ul1(1)   + d(2)*ul1(2)   + d(3)*ul1(3)
366 >    endif
367  
368 <    ! This stuff is all for the calculation of g(Chi) and dgdx
369 <    ! Line numbers roughly follow the lines in equation A25 of Luckhurst
370 <    !   et al. Liquid Crystals 8, 451-464 (1990).
371 <    ! We note however, that there are some major typos in that Appendix
372 <    ! of the Luckhurst paper, particularly in equations A23, A29 and A31
373 <    ! We have attempted to correct them below.
286 <    
287 <    dotsum = rdotu1+rdotu2
288 <    dotdiff = rdotu1-rdotu2
289 <    ds2 = dotsum*dotsum
290 <    dd2 = dotdiff*dotdiff
291 <  
292 <    opXdot = 1.0d0 + Chi*u1dotu2
293 <    omXdot = 1.0d0 - Chi*u1dotu2
294 <    opXpdot = 1.0d0 + ChiPrime*u1dotu2
295 <    omXpdot = 1.0d0 - ChiPrime*u1dotu2
296 <  
297 <    line1a = dotsum/opXdot
298 <    line1bx = dru1dx + dru2dx
299 <    line1by = dru1dy + dru2dy
300 <    line1bz = dru1dz + dru2dz
301 <    
302 <    line2a = dotdiff/omXdot
303 <    line2bx = dru1dx - dru2dx
304 <    line2by = dru1dy - dru2dy
305 <    line2bz = dru1dz - dru2dz
306 <    
307 <    term1x = -Chi*(line1a*line1bx + line2a*line2bx)/r2
308 <    term1y = -Chi*(line1a*line1by + line2a*line2by)/r2
309 <    term1z = -Chi*(line1a*line1bz + line2a*line2bz)/r2
310 <    
311 <    line3a = ds2/opXdot
312 <    line3b = dd2/omXdot
313 <    line3 = Chi*(line3a + line3b)/r4
314 <    line3x = d(1)*line3
315 <    line3y = d(2)*line3
316 <    line3z = d(3)*line3
317 <    
318 <    dgdx = term1x + line3x
319 <    dgdy = term1y + line3y
320 <    dgdz = term1z + line3z
368 >    if (j_is_LJ) then
369 >       b = 0.0_dp
370 >       ul2 = 0.0_dp
371 >    else      
372 >       b = d(1)*ul2(1)   + d(2)*ul2(2)   + d(3)*ul2(3)
373 >    endif
374  
375 <    term1u1x = 2.0d0*(line1a+line2a)*d(1)
376 <    term1u1y = 2.0d0*(line1a+line2a)*d(2)
377 <    term1u1z = 2.0d0*(line1a+line2a)*d(3)
378 <    term1u2x = 2.0d0*(line1a-line2a)*d(1)
379 <    term1u2y = 2.0d0*(line1a-line2a)*d(2)
327 <    term1u2z = 2.0d0*(line1a-line2a)*d(3)
328 <    
329 <    term2a = -line3a/opXdot
330 <    term2b =  line3b/omXdot
331 <    
332 <    term2u1x = Chi*ul2(1)*(term2a + term2b)
333 <    term2u1y = Chi*ul2(2)*(term2a + term2b)
334 <    term2u1z = Chi*ul2(3)*(term2a + term2b)
335 <    term2u2x = Chi*ul1(1)*(term2a + term2b)
336 <    term2u2y = Chi*ul1(2)*(term2a + term2b)
337 <    term2u2z = Chi*ul1(3)*(term2a + term2b)
338 <    
339 <    pref = -Chi*0.5d0/r2
375 >    if (i_is_LJ.or.j_is_LJ) then
376 >       g = 0.0_dp
377 >    else
378 >       g = ul1(1)*ul2(1) + ul1(2)*ul2(2) + ul1(3)*ul2(3)
379 >    endif
380  
381 <    dgdu1x = pref*(term1u1x+term2u1x)
382 <    dgdu1y = pref*(term1u1y+term2u1y)
383 <    dgdu1z = pref*(term1u1z+term2u1z)
344 <    dgdu2x = pref*(term1u2x+term2u2x)
345 <    dgdu2y = pref*(term1u2y+term2u2y)
346 <    dgdu2z = pref*(term1u2z+term2u2z)
381 >    au = a / r
382 >    bu = b / r
383 >    g2 = g*g
384  
385 <    g = 1.0d0 - Chi*(line3a + line3b)/(2.0d0*r2)
386 <  
387 <    BigR = (r - sigma*(g**(-0.5d0)) + sigma)/sigma
388 <    Ri = 1.0d0/BigR
389 <    Ri2 = Ri*Ri
390 <    Ri6 = Ri2*Ri2*Ri2
391 <    Ri7 = Ri6*Ri
392 <    Ri12 = Ri6*Ri6
393 <    Ri13 = Ri6*Ri7
385 >    H  = (xa2 * au + xai2 * bu - 2.0_dp*x2*au*bu*g)  / (1.0_dp - x2*g2)
386 >    Hp = (xpap2*au + xpapi2*bu - 2.0_dp*xp2*au*bu*g) / (1.0_dp - xp2*g2)
387 >    sigma = sigma0 / sqrt(1.0_dp - H)
388 >    e1 = 1.0_dp / sqrt(1.0_dp - x2*g2)
389 >    e2 = 1.0_dp - Hp
390 >    eps = eps0 * (e1**nu) * (e2**mu)
391 >    BigR = dw*sigma0 / (r - sigma + dw*sigma0)
392 >    
393 >    R3 = BigR*BigR*BigR
394 >    R6 = R3*R3
395 >    R7 = R6 * BigR
396 >    R12 = R6*R6
397 >    R13 = R6*R7
398  
399 <    gfact = (g**(-1.5d0))*0.5d0
399 >    U = 4.0_dp * eps * (R12 - R6)
400  
401 <    dBigRdx = drdx/sigma + dgdx*gfact
402 <    dBigRdy = drdy/sigma + dgdy*gfact
362 <    dBigRdz = drdz/sigma + dgdz*gfact
401 >    s3 = sigma*sigma*sigma
402 >    s03 = sigma0*sigma0*sigma0
403  
404 <    dBigRdu1x = dgdu1x*gfact
405 <    dBigRdu1y = dgdu1y*gfact
366 <    dBigRdu1z = dgdu1z*gfact
367 <    dBigRdu2x = dgdu2x*gfact
368 <    dBigRdu2y = dgdu2y*gfact
369 <    dBigRdu2z = dgdu2z*gfact
370 <
371 <    ! Now, we must do it again for g(ChiPrime) and dgpdx
404 >    pref1 = - 8.0_dp * eps * mu * (R12 - R6) / (e2 * r)
405 >    pref2 = 8.0_dp * eps * s3 * (6.0_dp*R13 - 3.0_dp*R7) / (dw*r*s03)
406  
407 <    line1a = dotsum/opXpdot
374 <    line2a = dotdiff/omXpdot
375 <    term1x = -ChiPrime*(line1a*line1bx + line2a*line2bx)/r2
376 <    term1y = -ChiPrime*(line1a*line1by + line2a*line2by)/r2
377 <    term1z = -ChiPrime*(line1a*line1bz + line2a*line2bz)/r2
378 <    line3a = ds2/opXpdot
379 <    line3b = dd2/omXpdot
380 <    line3 = ChiPrime*(line3a + line3b)/r4
381 <    line3x = d(1)*line3
382 <    line3y = d(2)*line3
383 <    line3z = d(3)*line3
407 >    dUdr = - (pref1 * Hp + pref2 * (sigma0*sigma0*r/s3 - H))
408      
409 <    dgpdx = term1x + line3x
410 <    dgpdy = term1y + line3y
387 <    dgpdz = term1z + line3z
409 >    dUda = pref1 * (xpap2*au - xp2*bu*g) / (1.0_dp - xp2 * g2) &
410 >         + pref2 * (xa2 * au - x2 *bu*g) / (1.0_dp - x2 * g2)
411      
412 <    term1u1x = 2.00d0*(line1a+line2a)*d(1)
413 <    term1u1y = 2.00d0*(line1a+line2a)*d(2)
391 <    term1u1z = 2.00d0*(line1a+line2a)*d(3)
392 <    term1u2x = 2.0d0*(line1a-line2a)*d(1)
393 <    term1u2y = 2.0d0*(line1a-line2a)*d(2)
394 <    term1u2z = 2.0d0*(line1a-line2a)*d(3)
412 >    dUdb = pref1 * (xpapi2*bu - xp2*au*g) / (1.0_dp - xp2 * g2) &
413 >         + pref2 * (xai2 * bu - x2 *au*g) / (1.0_dp - x2 * g2)
414  
415 <    term2a = -line3a/opXpdot
416 <    term2b =  line3b/omXpdot
417 <    
418 <    term2u1x = ChiPrime*ul2(1)*(term2a + term2b)
419 <    term2u1y = ChiPrime*ul2(2)*(term2a + term2b)
420 <    term2u1z = ChiPrime*ul2(3)*(term2a + term2b)
421 <    term2u2x = ChiPrime*ul1(1)*(term2a + term2b)
403 <    term2u2y = ChiPrime*ul1(2)*(term2a + term2b)
404 <    term2u2z = ChiPrime*ul1(3)*(term2a + term2b)
405 <  
406 <    pref = -ChiPrime*0.5d0/r2
407 <    
408 <    dgpdu1x = pref*(term1u1x+term2u1x)
409 <    dgpdu1y = pref*(term1u1y+term2u1y)
410 <    dgpdu1z = pref*(term1u1z+term2u1z)
411 <    dgpdu2x = pref*(term1u2x+term2u2x)
412 <    dgpdu2y = pref*(term1u2y+term2u2y)
413 <    dgpdu2z = pref*(term1u2z+term2u2z)
414 <    
415 <    gp = 1.0d0 - ChiPrime*(line3a + line3b)/(2.0d0*r2)
416 <    gmu = gp**mu
417 <    gpi = 1.0d0 / gp
418 <    gmum = gmu*gpi
415 >    dUdg = 4.0_dp * eps * nu * (R12 - R6) * x2 * g / (1.0_dp - x2*g2) &
416 >         + 8.0_dp * eps * mu * (R12 - R6) * (xp2*au*bu - Hp*xp2*g) / &
417 >         (1.0_dp - xp2 * g2) / e2 &
418 >         + 8.0_dp * eps * s3 * (3.0_dp * R7 - 6.0_dp * R13) * &
419 >         (x2 * au * bu - H * x2 * g) / (1.0_dp - x2 * g2) / (dw * s03)
420 >            
421 >    rhat = d / r
422  
423 <    curlyE = 1.0d0/dsqrt(1.0d0 - Chi*Chi*u1dotu2*u1dotu2)
424 < !!$
425 < !!$    dcE = -(curlyE**3)*Chi*Chi*u1dotu2
423 <    dcE = (curlyE**3)*Chi*Chi*u1dotu2
423 >    fx = -dUdr * rhat(1) - dUda * ul1(1) - dUdb * ul2(1)
424 >    fy = -dUdr * rhat(2) - dUda * ul1(2) - dUdb * ul2(2)
425 >    fx = -dUdr * rhat(3) - dUda * ul1(3) - dUdb * ul2(3)
426  
427 <    dcEdu1x = dcE*ul2(1)
428 <    dcEdu1y = dcE*ul2(2)
429 <    dcEdu1z = dcE*ul2(3)
430 <    dcEdu2x = dcE*ul1(1)
429 <    dcEdu2y = dcE*ul1(2)
430 <    dcEdu2z = dcE*ul1(3)
431 <    
432 <    enu = curlyE**nu
433 <    enum = enu/curlyE
434 <  
435 <    eps = epsilon*enu*gmu
436 <
437 <    yick1 = epsilon*enu*mu*gmum
438 <    yick2 = epsilon*gmu*nu*enum
439 <
440 <    depsdu1x = yick1*dgpdu1x + yick2*dcEdu1x
441 <    depsdu1y = yick1*dgpdu1y + yick2*dcEdu1y
442 <    depsdu1z = yick1*dgpdu1z + yick2*dcEdu1z
443 <    depsdu2x = yick1*dgpdu2x + yick2*dcEdu2x
444 <    depsdu2y = yick1*dgpdu2y + yick2*dcEdu2y
445 <    depsdu2z = yick1*dgpdu2z + yick2*dcEdu2z
446 <    
447 <    R126 = Ri12 - Ri6
448 <    R137 = 6.0d0*Ri7 - 12.0d0*Ri13
449 <    
450 <    mess1 = gmu*R137
451 <    mess2 = R126*mu*gmum
452 <    
453 <    dUdx = 4.0d0*epsilon*enu*(mess1*dBigRdx + mess2*dgpdx)*sw
454 <    dUdy = 4.0d0*epsilon*enu*(mess1*dBigRdy + mess2*dgpdy)*sw
455 <    dUdz = 4.0d0*epsilon*enu*(mess1*dBigRdz + mess2*dgpdz)*sw
456 <    
457 <    dUdu1x = 4.0d0*(R126*depsdu1x + eps*R137*dBigRdu1x)*sw
458 <    dUdu1y = 4.0d0*(R126*depsdu1y + eps*R137*dBigRdu1y)*sw
459 <    dUdu1z = 4.0d0*(R126*depsdu1z + eps*R137*dBigRdu1z)*sw
460 <    dUdu2x = 4.0d0*(R126*depsdu2x + eps*R137*dBigRdu2x)*sw
461 <    dUdu2y = 4.0d0*(R126*depsdu2y + eps*R137*dBigRdu2y)*sw
462 <    dUdu2z = 4.0d0*(R126*depsdu2z + eps*R137*dBigRdu2z)*sw
463 <      
427 >    rxu1 = cross_product(d, ul1)
428 >    rxu2 = cross_product(d, ul2)    
429 >    uxu = cross_product(ul1, ul2)
430 >          
431   #ifdef IS_MPI
432 <    f_Row(1,atom1) = f_Row(1,atom1) + dUdx
433 <    f_Row(2,atom1) = f_Row(2,atom1) + dUdy
434 <    f_Row(3,atom1) = f_Row(3,atom1) + dUdz
432 >    f_Row(1,atom1) = f_Row(1,atom1) + fx
433 >    f_Row(2,atom1) = f_Row(2,atom1) + fy
434 >    f_Row(3,atom1) = f_Row(3,atom1) + fz
435      
436 <    f_Col(1,atom2) = f_Col(1,atom2) - dUdx
437 <    f_Col(2,atom2) = f_Col(2,atom2) - dUdy
438 <    f_Col(3,atom2) = f_Col(3,atom2) - dUdz
436 >    f_Col(1,atom2) = f_Col(1,atom2) - fx
437 >    f_Col(2,atom2) = f_Col(2,atom2) - fy
438 >    f_Col(3,atom2) = f_Col(3,atom2) - fz
439      
440 <    t_Row(1,atom1) = t_Row(1,atom1)- ul1(3)*dUdu1y + ul1(2)*dUdu1z
441 <    t_Row(2,atom1) = t_Row(2,atom1)- ul1(1)*dUdu1z + ul1(3)*dUdu1x
442 <    t_Row(3,atom1) = t_Row(3,atom1)- ul1(2)*dUdu1x + ul1(1)*dUdu1y
443 <    
444 <    t_Col(1,atom2) = t_Col(1,atom2) - ul2(3)*dUdu2y + ul2(2)*dUdu2z
445 <    t_Col(2,atom2) = t_Col(2,atom2) - ul2(1)*dUdu2z + ul2(3)*dUdu2x
446 <    t_Col(3,atom2) = t_Col(3,atom2) - ul2(2)*dUdu2x + ul2(1)*dUdu2y
440 >    t_Row(1,atom1) = t_Row(1,atom1) + dUda*rxu1(1) - dUdg*uxu(1)
441 >    t_Row(2,atom1) = t_Row(2,atom1) + dUda*rxu1(2) - dUdg*uxu(2)
442 >    t_Row(3,atom1) = t_Row(3,atom1) + dUda*rxu1(3) - dUdg*uxu(3)
443 >                                                                
444 >    t_Col(1,atom2) = t_Col(1,atom2) + dUdb*rxu2(1) + dUdg*uxu(1)
445 >    t_Col(2,atom2) = t_Col(2,atom2) + dUdb*rxu2(2) + dUdg*uxu(2)
446 >    t_Col(3,atom2) = t_Col(3,atom2) + dUdb*rxu2(3) + dUdg*uxu(3)
447   #else
448 <    f(1,atom1) = f(1,atom1) + dUdx
449 <    f(2,atom1) = f(2,atom1) + dUdy
450 <    f(3,atom1) = f(3,atom1) + dUdz
448 >    f(1,atom1) = f(1,atom1) + fx
449 >    f(2,atom1) = f(2,atom1) + fy
450 >    f(3,atom1) = f(3,atom1) + fz
451      
452 <    f(1,atom2) = f(1,atom2) - dUdx
453 <    f(2,atom2) = f(2,atom2) - dUdy
454 <    f(3,atom2) = f(3,atom2) - dUdz
452 >    f(1,atom2) = f(1,atom2) - fx
453 >    f(2,atom2) = f(2,atom2) - fy
454 >    f(3,atom2) = f(3,atom2) - fz
455      
456 <    t(1,atom1) = t(1,atom1)- ul1(3)*dUdu1y + ul1(2)*dUdu1z
457 <    t(2,atom1) = t(2,atom1)- ul1(1)*dUdu1z + ul1(3)*dUdu1x
458 <    t(3,atom1) = t(3,atom1)- ul1(2)*dUdu1x + ul1(1)*dUdu1y
459 <    
460 <    t(1,atom2) = t(1,atom2)- ul2(3)*dUdu2y + ul2(2)*dUdu2z
461 <    t(2,atom2) = t(2,atom2)- ul2(1)*dUdu2z + ul2(3)*dUdu2x
462 <    t(3,atom2) = t(3,atom2)- ul2(2)*dUdu2x + ul2(1)*dUdu2y
456 >    t(1,atom1) = t(1,atom1) +  dUda*rxu1(1) - dUdg*uxu(1)
457 >    t(2,atom1) = t(2,atom1) +  dUda*rxu1(2) - dUdg*uxu(2)
458 >    t(3,atom1) = t(3,atom1) +  dUda*rxu1(3) - dUdg*uxu(3)
459 >                                                        
460 >    t(1,atom2) = t(1,atom2) +  dUdb*rxu2(1) + dUdg*uxu(1)
461 >    t(2,atom2) = t(2,atom2) +  dUdb*rxu2(2) + dUdg*uxu(2)
462 >    t(3,atom2) = t(3,atom2) +  dUdb*rxu2(3) + dUdg*uxu(3)
463   #endif
464    
465      if (do_pot) then
466   #ifdef IS_MPI
467 <       pot_row(VDW_POT,atom1) = pot_row(VDW_POT,atom1) + 2.0d0*eps*R126*sw
468 <       pot_col(VDW_POT,atom2) = pot_col(VDW_POT,atom2) + 2.0d0*eps*R126*sw
467 >       pot_row(VDW_POT,atom1) = pot_row(VDW_POT,atom1) + 0.5d0*U*sw
468 >       pot_col(VDW_POT,atom2) = pot_col(VDW_POT,atom2) + 0.5d0*U*sw
469   #else
470 <       pot = pot + 4.0*eps*R126*sw
470 >       pot = pot + U*sw
471   #endif
472      endif
473      
474 <    vpair = vpair + 4.0*eps*R126
474 >    vpair = vpair + U*sw
475   #ifdef IS_MPI
476      id1 = AtomRowToGlobal(atom1)
477      id2 = AtomColToGlobal(atom2)
# Line 515 | Line 482 | contains
482      
483      if (molMembershipList(id1) .ne. molMembershipList(id2)) then
484        
485 <       fpair(1) = fpair(1) + dUdx
486 <       fpair(2) = fpair(2) + dUdy
487 <       fpair(3) = fpair(3) + dUdz
485 >       fpair(1) = fpair(1) + fx
486 >       fpair(2) = fpair(2) + fy
487 >       fpair(3) = fpair(3) + fz
488        
489      endif
490      
491      return
492    end subroutine do_gb_pair
526
527  subroutine do_gb_lj_pair(atom1, atom2, d, r, r2, sw, vpair, fpair, &
528       pot, A, f, t, do_pot)
529    
530    integer, intent(in) :: atom1, atom2
531    integer :: id1, id2
532    real (kind=dp), intent(inout) :: r, r2
533    real (kind=dp), dimension(3), intent(in) :: d
534    real (kind=dp), dimension(3), intent(inout) :: fpair
535    real (kind=dp) :: pot, sw, vpair
536    real (kind=dp), dimension(9,nLocal) :: A
537    real (kind=dp), dimension(3,nLocal) :: f
538    real (kind=dp), dimension(3,nLocal) :: t
539    logical, intent(in) :: do_pot
540    real (kind = dp), dimension(3) :: ul
541    
542    real(kind=dp) :: gb_sigma, gb_eps, gb_eps_ratio, gb_mu, gb_sigma_l
543    real(kind=dp) :: spar, sperp, slj, par2, perp2, sc, slj2
544    real(kind=dp) :: s_par2mperp2, s_lj2ppar2
545    real(kind=dp) :: enot, eperp, epar, eab, eabf,moom, mum1
546    real(kind=dp) :: dx, dy, dz, drdx,drdy,drdz, rdotu
547    real(kind=dp) :: mess, sab, dsabdct, eprime, deprimedct, depmudct
548    real(kind=dp) :: epmu, depmudx, depmudy, depmudz
549    real(kind=dp) :: depmudux, depmuduy, depmuduz
550    real(kind=dp) :: BigR, dBigRdx, dBigRdy, dBigRdz
551    real(kind=dp) :: dBigRdux, dBigRduy, dBigRduz
552    real(kind=dp) :: dUdx, dUdy, dUdz, dUdux, dUduy, dUduz, e0
553    real(kind=dp) :: Ri, Ri3, Ri6, Ri7, Ri12, Ri13, R126, R137, prefactor
554    real(kind=dp) :: chipoalphap2, chioalpha2, ec, epsnot
555    real(kind=dp) :: drdotudx, drdotudy, drdotudz    
556    real(kind=dp) :: drdotudux, drdotuduy, drdotuduz    
557    real(kind=dp) :: ljeps, ljsigma, sigmaratio, sigmaratioi
558    integer :: ljt1, ljt2, atid1, atid2, gbt1, gbt2
559    logical :: gb_first
560    
561 #ifdef IS_MPI
562    atid1 = atid_Row(atom1)
563    atid2 = atid_Col(atom2)
564 #else
565    atid1 = atid(atom1)
566    atid2 = atid(atom2)
567 #endif
568    
569    gbt1 = GBMap%atidToGBtype(atid1)
570    gbt2 = GBMap%atidToGBtype(atid2)
571    
572    if (gbt1 .eq. -1) then
573       gb_first = .false.
574       if (gbt2 .eq. -1) then
575          call handleError("GB", "GBLJ was called without a GB type.")
576       endif
577    else
578       gb_first = .true.
579       if (gbt2 .ne. -1) then
580          call handleError("GB", "GBLJ was called with two GB types (instead of one).")
581       endif
582    endif
583    
584    ri =1/r
585    
586    dx = d(1)
587    dy = d(2)
588    dz = d(3)
589    
590    drdx = dx *ri
591    drdy = dy *ri
592    drdz = dz *ri
593    
594    if(gb_first)then
595 #ifdef IS_MPI
596       ul(1) = A_Row(3,atom1)
597       ul(2) = A_Row(6,atom1)
598       ul(3) = A_Row(9,atom1)
599 #else
600       ul(1) = A(3,atom1)
601       ul(2) = A(6,atom1)
602       ul(3) = A(9,atom1)      
603 #endif
604       gb_sigma     = GBMap%GBtypes(gbt1)%sigma      
605       gb_eps       = GBMap%GBtypes(gbt1)%eps        
606       gb_eps_ratio = GBMap%GBtypes(gbt1)%eps_ratio  
607       gb_mu        = GBMap%GBtypes(gbt1)%mu        
608       gb_sigma_l   = GBMap%GBtypes(gbt1)%sigma_l
609
610       ljsigma = getSigma(atid2)
611       ljeps = getEpsilon(atid2)
612    else
613 #ifdef IS_MPI
614       ul(1) = A_Col(3,atom2)
615       ul(2) = A_Col(6,atom2)
616       ul(3) = A_Col(9,atom2)
617 #else
618       ul(1) = A(3,atom2)
619       ul(2) = A(6,atom2)
620       ul(3) = A(9,atom2)      
621 #endif
622       gb_sigma     = GBMap%GBtypes(gbt2)%sigma      
623       gb_eps       = GBMap%GBtypes(gbt2)%eps        
624       gb_eps_ratio = GBMap%GBtypes(gbt2)%eps_ratio  
625       gb_mu        = GBMap%GBtypes(gbt2)%mu        
626       gb_sigma_l   = GBMap%GBtypes(gbt2)%sigma_l
627
628       ljsigma = getSigma(atid1)
629       ljeps = getEpsilon(atid1)
630    endif
631  
632    write(*,*) 'd u', dx, dy, dz, ul(1), ul(2), ul(3)
633
634    rdotu = (dx*ul(1)+dy*ul(2)+dz*ul(3))*ri
635  
636    drdotudx = ul(1)*ri-rdotu*dx*ri*ri
637    drdotudy = ul(2)*ri-rdotu*dy*ri*ri
638    drdotudz = ul(3)*ri-rdotu*dz*ri*ri
639    drdotudux = drdx
640    drdotuduy = drdy
641    drdotuduz = drdz
642
643    
644    moom =  1.0d0 / gb_mu
645    mum1 = gb_mu-1
646    
647    sperp = gb_sigma
648    spar =  gb_sigma_l
649    slj = ljsigma
650    slj2 = slj*slj
651
652    chioalpha2 =1-((sperp+slj)*(sperp+slj))/((spar+slj)*(spar+slj))
653    sc = (sperp+slj)/2.0d0
493    
655    par2 = spar*spar
656    perp2 = sperp*sperp
657    s_par2mperp2 = par2 - perp2
658    s_lj2ppar2 = slj2 + par2
659
660    !! check these ! left from old code
661    !! kdaily e0 may need to be (gb_eps + lj_eps)/2
662    
663    eperp = dsqrt(gb_eps*ljeps)
664    epar = eperp*gb_eps_ratio
665    enot = dsqrt(ljeps*eperp)
666    chipoalphap2 = 1+(dsqrt(epar*ljeps)/enot)**moom
667
668    !! mess matches cleaver (eq 20)
669    
670    mess = 1-rdotu*rdotu*chioalpha2
671    sab = 1.0d0/dsqrt(mess)
672
673    write(*,*) 's', sc, sab, rdotu, chioalpha2
674    dsabdct = sc*sab*sab*sab*rdotu*chioalpha2
675      
676    eab = 1-chipoalphap2*rdotu*rdotu
677    eabf = enot*eab**gb_mu
678
679    write(*,*)  'e', enot, chipoalphap2, gb_mu, rdotu, eab, mum1
680
681    depmudct = -2*enot*chipoalphap2*gb_mu*rdotu*eab**mum1
682        
683    BigR = (r - sab*sc + sc)/sc
684    dBigRdx = (drdx -dsabdct*drdotudx)/sc
685    dBigRdy = (drdy -dsabdct*drdotudy)/sc
686    dBigRdz = (drdz -dsabdct*drdotudz)/sc
687    dBigRdux = (-dsabdct*drdotudux)/sc
688    dBigRduy = (-dsabdct*drdotuduy)/sc
689    dBigRduz = (-dsabdct*drdotuduz)/sc
690    
691    write(*,*) 'ds dep', dsabdct, depmudct
692    write(*,*) 'drdotudu', drdotudux, drdotuduy, drdotuduz
693    depmudx = depmudct*drdotudx
694    depmudy = depmudct*drdotudy
695    depmudz = depmudct*drdotudz
696    depmudux = depmudct*drdotudux
697    depmuduy = depmudct*drdotuduy
698    depmuduz = depmudct*drdotuduz
699    
700    Ri = 1.0d0/BigR
701    Ri3 = Ri*Ri*Ri
702    Ri6 = Ri3*Ri3
703    Ri7 = Ri6*Ri
704    Ri12 = Ri6*Ri6
705    Ri13 = Ri6*Ri7
706    R126 = Ri12 - Ri6
707    R137 = 6.0d0*Ri7 - 12.0d0*Ri13
708    
709    prefactor = 4.0d0
710    
711    dUdx = prefactor*(eabf*R137*dBigRdx + R126*depmudx)
712    dUdy = prefactor*(eabf*R137*dBigRdy + R126*depmudy)
713    dUdz = prefactor*(eabf*R137*dBigRdz + R126*depmudz)
714    write(*,*) 'dRdu',  dbigrdux, dbigrduy, dbigrduz
715    write(*,*) 'dEdu',  depmudux, depmuduy, depmuduz
716    dUdux = prefactor*(eabf*R137*dBigRdux + R126*depmudux)
717    dUduy = prefactor*(eabf*R137*dBigRduy + R126*depmuduy)
718    dUduz = prefactor*(eabf*R137*dBigRduz + R126*depmuduz)
719    
720 #ifdef IS_MPI
721    f_Row(1,atom1) = f_Row(1,atom1) - dUdx
722    f_Row(2,atom1) = f_Row(2,atom1) - dUdy
723    f_Row(3,atom1) = f_Row(3,atom1) - dUdz
724    
725    f_Col(1,atom2) = f_Col(1,atom2) + dUdx
726    f_Col(2,atom2) = f_Col(2,atom2) + dUdy
727    f_Col(3,atom2) = f_Col(3,atom2) + dUdz
728    
729    if (gb_first) then
730       t_Row(1,atom1) = t_Row(1,atom1) + ul(2)*dUduz - ul(3)*dUduy
731       t_Row(2,atom1) = t_Row(2,atom1) + ul(3)*dUdux - ul(1)*dUduz
732       t_Row(3,atom1) = t_Row(3,atom1) + ul(1)*dUduy - ul(2)*dUdux
733    else
734       t_Col(1,atom2) = t_Col(1,atom2) + ul(2)*dUduz - ul(3)*dUduy
735       t_Col(2,atom2) = t_Col(2,atom2) + ul(3)*dUdux - ul(1)*dUduz
736       t_Col(3,atom2) = t_Col(3,atom2) + ul(1)*dUduy - ul(2)*dUdux
737    endif
738 #else    
739    f(1,atom1) = f(1,atom1) + dUdx
740    f(2,atom1) = f(2,atom1) + dUdy
741    f(3,atom1) = f(3,atom1) + dUdz
742    
743    f(1,atom2) = f(1,atom2) - dUdx
744    f(2,atom2) = f(2,atom2) - dUdy
745    f(3,atom2) = f(3,atom2) - dUdz
746    
747    ! torques are cross products:
748    
749    write(*,*) 'dU', dUdux, duduy, duduz
750
751    if (gb_first) then
752       t(1,atom1) = t(1,atom1) + ul(2)*dUduz - ul(3)*dUduy
753       t(2,atom1) = t(2,atom1) + ul(3)*dUdux - ul(1)*dUduz
754       t(3,atom1) = t(3,atom1) + ul(1)*dUduy - ul(2)*dUdux
755       write(*,*) 'T1', t(1,atom1), t(2,atom1), t(3,atom1)
756    else
757       t(1,atom2) = t(1,atom2) + ul(2)*dUduz - ul(3)*dUduy
758       t(2,atom2) = t(2,atom2) + ul(3)*dUdux - ul(1)*dUduz
759       t(3,atom2) = t(3,atom2) + ul(1)*dUduy - ul(2)*dUdux
760
761       write(*,*) 'T2', t(1,atom2), t(2,atom2), t(3,atom2)
762    endif
763
764 #endif
765      
766    if (do_pot) then
767 #ifdef IS_MPI
768       pot_row(VDW_POT,atom1) = pot_row(VDW_POT,atom1) + 2.0d0*eps*R126*sw
769       pot_col(VDW_POT,atom2) = pot_col(VDW_POT,atom2) + 2.0d0*eps*R126*sw
770 #else
771       pot = pot + prefactor*eabf*R126*sw
772 #endif
773    endif
774    
775    vpair = vpair + 4.0*epmu*R126
776 #ifdef IS_MPI
777    id1 = AtomRowToGlobal(atom1)
778    id2 = AtomColToGlobal(atom2)
779 #else
780    id1 = atom1
781    id2 = atom2
782 #endif
783    
784    If (Molmembershiplist(Id1) .Ne. Molmembershiplist(Id2)) Then
785      
786       Fpair(1) = Fpair(1) + Dudx
787       Fpair(2) = Fpair(2) + Dudy
788       Fpair(3) = Fpair(3) + Dudz
789      
790    Endif
791    
792    return
793    
794  end subroutine do_gb_lj_pair
795
494    subroutine destroyGBTypes()
495  
496      GBMap%nGBtypes = 0
# Line 808 | Line 506 | contains
506         GBMap%atidToGBtype => null()
507      end if
508      
509 +    haveMixingMap = .false.
510 +    
511    end subroutine destroyGBTypes
512  
513   end module gayberne

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines