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 2367 by kdaily, Fri Oct 14 15:44:37 2005 UTC vs.
Revision 2518 by tim, Fri Dec 16 21:52:50 2005 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
# Line 56 | Line 56 | module gb_pair
56  
57    private
58  
59 <  logical, save :: haveGayBerneLJMap = .false.
60 <  logical, save :: gb_pair_initialized = .false.
61 <  logical, save :: gb_lj_pair_initialized = .false.
62 <  real(kind=dp), save :: gb_sigma
63 <  real(kind=dp), save :: gb_l2b_ratio
64 <  real(kind=dp), save :: gb_eps
65 <  real(kind=dp), save :: gb_eps_ratio
66 <  real(kind=dp), save :: gb_mu
67 <  real(kind=dp), save :: gb_nu
68 <  real(kind=dp), save :: lj_sigma
69 <  real(kind=dp), save :: lj_eps
70 <  real(kind=dp), save :: gb_sigma_l
71 <  real(kind=dp), save :: gb_eps_l
59 > #define __FORTRAN90
60 > #include "UseTheForce/DarkSide/fInteractionMap.h"
61  
62 <  public :: check_gb_pair_FF
74 <  public :: set_gb_pair_params
62 >  public :: newGBtype
63    public :: do_gb_pair
76  public :: getGayBerneCut
77 !!$  public :: check_gb_lj_pair_FF
78 !!$  public :: set_gb_lj_pair_params
64    public :: do_gb_lj_pair
65 <  public :: createGayBerneLJMap
66 <  public :: destroyGayBerneTypes
82 <  public :: complete_GayBerne_FF
83 < !!may not need
84 <  type, private :: LJtype
85 <     integer  :: atid
86 <     real(kind=dp) :: sigma
87 <     real(kind=dp) :: epsilon
88 <  end type LJtype
89 < !!may not need
90 <  type, private :: LJList
91 <     integer       :: Nljtypes =0
92 <     integer       :: currentLJtype= 0
93 <     type(LJtype), pointer :: LJtype(:) =>  null()
94 <     integer, pointer      :: atidToLJtype(:) =>null()
95 <  end type LJList
65 >  public :: getGayBerneCut
66 >  public :: destroyGBtypes
67  
68 <  type(LJList), save :: LJMap
69 <  
70 <  type :: GayBerneLJ
71 < !!$     integer :: atid
72 < !!$     real(kind = dp ),pointer, dimension(:) ::  epsil_GB      =>null()
73 < !!$     real(kind = dp ),pointer, dimension(:) ::  sigma_GB        =>null()
74 < !!$     real(kind = dp ),pointer, dimension(:) ::  epsilon_ratio   =>null()
75 < !!$     real(kind = dp ),pointer, dimension(:) ::  sigma_ratio     =>null()
105 < !!$     real(kind = dp ),pointer, dimension(:) ::  mu              =>null()
106 <    
68 >  type :: GBtype
69 >     integer          :: atid
70 >     real(kind = dp ) :: sigma
71 >     real(kind = dp ) :: l2b_ratio
72 >     real(kind = dp ) :: eps
73 >     real(kind = dp ) :: eps_ratio
74 >     real(kind = dp ) :: mu
75 >     real(kind = dp ) :: nu
76       real(kind = dp ) :: sigma_l
108     real(kind = dp ) :: sigma_s
109     real(kind = dp ) :: sigma_ratio
110     real(kind = dp ) :: eps_s
77       real(kind = dp ) :: eps_l
78 <     real(kind = dp ) :: eps_ratio
113 <     integer          :: c_ident
114 <     integer          :: status
115 <  end type GayBerneLJ
78 >  end type GBtype
79  
80 < !!$  type, private :: gayberneLJlist
81 < !!$     integer:: n_gaybernelj = 0
82 < !!$     integer:: currentgayberneLJ = 0
83 < !!$     type(GayBerneLJ),pointer :: GayBerneLJ(:) => null()
84 < !!$     integer, pointer         :: atidToGayBerneLJ(:) => null()
85 < !!$  end type gayberneLJlist
80 >  type, private :: GBList
81 >     integer               :: nGBtypes = 0
82 >     integer               :: currentGBtype = 0
83 >     type(GBtype), pointer :: GBtypes(:)      => null()
84 >     integer, pointer      :: atidToGBtype(:) => null()
85 >  end type GBList
86  
87 <  type(gayberneLJ), dimension(:), allocatable :: gayBerneLJMap
87 >  type(GBList), save :: GBMap
88  
89   contains
90  
91 <  subroutine check_gb_pair_FF(status)
92 <    integer :: status
93 <    status = -1
94 <    if (gb_pair_initialized) status = 0
132 <    return
133 <  end subroutine check_gb_pair_FF
134 <
135 < !!$  subroutine check_gb_lj_pair_FF(status)
136 < !!$    integer :: status
137 < !!$    status = -1
138 < !!$    if (gb_lj_pair_initialized) status = 0
139 < !!$    return
140 < !!$  end subroutine check_gb_lj_pair_FF
141 <
142 <  subroutine set_gb_pair_params(sigma, l2b_ratio, eps, eps_ratio, mu, nu)
91 >  subroutine newGBtype(c_ident, sigma, l2b_ratio, eps, eps_ratio, mu, nu, &
92 >       status)
93 >    
94 >    integer, intent(in) :: c_ident
95      real( kind = dp ), intent(in) :: sigma, l2b_ratio, eps, eps_ratio
96      real( kind = dp ), intent(in) :: mu, nu
97 <    integer :: ntypes, nljtypes
98 < !!    integer, intent(in) :: c_ident
99 <    integer, pointer :: MatchList(:) => null ()
100 <    integer :: status
101 <    gb_sigma = sigma
150 <    gb_l2b_ratio = l2b_ratio
151 <    gb_eps = eps
152 <    gb_eps_ratio = eps_ratio
153 <    gb_mu = mu
154 <    gb_nu = nu
155 <    gb_sigma_l = gb_sigma*l2b_ratio
156 <    gb_eps_l = gb_eps*gb_eps_ratio
97 >    integer, intent(out) :: status
98 >
99 >    integer :: nGBTypes, ntypes, myATID
100 >    integer, pointer :: MatchList(:) => null()
101 >    integer :: current, i
102      status = 0
103  
104 <
105 <      
104 >    if (.not.associated(GBMap%GBtypes)) then
105 >                              
106 >       call getMatchingElementList(atypes, "is_GayBerne", .true., &
107 >            nGBtypes, MatchList)
108 >      
109 >       GBMap%nGBtypes = nGBtypes
110  
111 <    return
163 <  end subroutine set_gb_pair_params
164 <  
165 < !!$  subroutine set_gb_lj_pair_params(sigma_gb, l2b_ratio, eps_gb, eps_ratio, mu, nu, sigma_lj, eps_lj, c_ident, status)
166 < !!$    real( kind = dp ), intent(in) :: sigma_gb, l2b_ratio, eps_gb, eps_ratio, mu, nu
167 < !!$    real( kind = dp ), intent(in) :: sigma_lj, eps_lj
168 < !!$    integer, intent(in) :: c_ident
169 < !!$    integer :: nLJTYPES, nGayBerneTypes, ntypes, current, status
170 < !!$
171 < !!$    integer :: myATID
172 < !!$    logical :: thisProperty
173 < !!$    real(kind=dp):: fake
174 < !!$    
175 < !!$    status = 0
176 < !!$
177 < !!$    if(.not.associated(LJMap%Ljtype)) then
111 >       allocate(GBMap%GBtypes(nGBtypes))
112  
113 < !!$       call getMatchingElementList(atypes, "is_GayBerne", .true., &
114 < !!$            nGayBerneTypes, MatchList)
115 < !!$      
116 < !!$       call getMatchingElementList(atypes, "is_LennardJones", .true., &
117 < !!$            nLJTypes, MatchList)
118 < !!$
119 < !!$       LJMap%nLJtypes = nLJTypes
186 < !!$
187 < !!$       allocate(LJMap% LJtype(nLJTypes))
188 < !!$
189 < !!$       ntypes = getSize(atypes)
190 < !!$
191 < !!$       allocate(LJMap%atidToLJtype(ntypes))
192 < !!$
193 < !!$   endif
194 < !!$
195 < !!$   LJmap%currentLJtype =  LJMap%currentLJtype + 1
196 < !!$
197 < !!$   current = LJMap%currentLJtype
198 < !!$   LJMap%atidToLJtype(myATID)    = current
199 < !!$   myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
200 < !!$   call getElementProperty(atypes, myATID, "is_LennardJones",thisProperty)
201 < !!$   if(thisProperty) then
202 < !!$
203 < !!$      LJMap%LJtype(current)%atid    = myatid
204 < !!$!!for testing
205 < !!$      fake = getSigma(myATID)
206 < !!$      LJMap%LJtype(current)%sigma   = getSigma(myATID)
207 < !!$      LJMap%LJtype(current)%epsilon = getEpsilon(myATID)
208 < !!$   end if
113 >       ntypes = getSize(atypes)
114 >      
115 >       allocate(GBMap%atidToGBtype(ntypes))
116 >      
117 >       !! initialize atidToGBtype to -1 so that we can use this
118 >       !! array to figure out which atom comes first in the GBLJ
119 >       !! routine
120  
121 < !!$    gb_sigma = sigma_gb
122 < !!$    gb_l2b_ratio = l2b_ratio
123 < !!$    gb_eps = eps_gb
213 < !!$    gb_eps_ratio = eps_ratio
214 < !!    gb_mu = mu
215 < !!    gb_nu = nu
216 < !!$    
217 < !!$    lj_sigma = sigma_lj
218 < !!$    lj_eps = eps_lj
121 >       do i = 1, ntypes
122 >          GBMap%atidToGBtype(i) = -1
123 >       enddo
124  
125 < !!    gb_lj_pair_initialized = .true.
221 < !!$  endsubroutine set_gb_lj_pair_params
125 >    endif
126  
127 <  subroutine createGayBerneLJMap
128 <    integer :: ntypes, i, j
225 <    real(kind=dp) :: s1, s2, e1, e2
226 <    real(kind=dp) :: sigma_s,sigma_l,eps_s, eps_l
227 <    
228 <    if(LJMap%currentLJtype == 0)then
229 <       call handleError("gayberneLJ", "no members in gayberneLJMap")
230 <       return
231 <    end if
127 >    GBMap%currentGBtype = GBMap%currentGBtype + 1
128 >    current = GBMap%currentGBtype
129  
130 <    ntypes = getSize(atypes)
131 <    
132 <    if(.not.allocated(gayBerneLJMap))then
133 <       allocate(gayBerneLJMap(ntypes))
134 <    endif
135 <    
136 <    do i = 1, ntypes
137 <       s1 = LJMap%LJtype(i)%sigma
138 <       e1 = LJMap%LJtype(i)%epsilon
139 <    
140 < !!$       sigma_s = 0.5d0 *(s1+gb_sigma)
141 < !!$       sigma_l = 0.5d0 *(s1+gb_sigma*gb_l2b_ratio)
142 <       sigma_s = gb_sigma
143 <       sigma_l = gb_sigma*gb_l2b_ratio
144 <       gayBerneLJMap(i)%sigma_s = sigma_s
145 <       gayBerneLJMap(i)%sigma_l = sigma_l
249 <       gayBerneLJMap(i)%sigma_ratio = sigma_l/sigma_s
250 <       eps_s = dsqrt(e1*gb_eps)
251 <       eps_l = dsqrt(e1*gb_eps_l)
252 <       gayBerneLJMap(i)%eps_s = eps_s
253 <       gayBerneLJMap(i)%eps_l = eps_l
254 <       gayBerneLJMap(i)%eps_ratio = eps_l/eps_s
255 <    enddo
256 <    haveGayBerneLJMap = .true.
257 <    gb_lj_pair_initialized = .true.
258 <  endsubroutine createGayBerneLJMap
130 >    myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
131 >    GBMap%atidToGBtype(myATID)        = current
132 >    GBMap%GBtypes(current)%atid       = myATID
133 >    GBMap%GBtypes(current)%sigma      = sigma
134 >    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
141 >
142 >    return
143 >  end subroutine newGBtype
144 >
145 >  
146    !! gay berne cutoff should be a parameter in globals, this is a temporary
147    !! work around - this should be fixed when gay berne is up and running
148 +
149    function getGayBerneCut(atomID) result(cutValue)
150 <    integer, intent(in) :: atomID !! nah... we don't need to use this...
151 <    real(kind=dp) :: cutValue
150 >    integer, intent(in) :: atomID
151 >    integer :: gbt1
152 >    real(kind=dp) :: cutValue, sigma, l2b_ratio
153  
154 <    cutValue = gb_l2b_ratio*gb_sigma*2.5_dp
154 >    if (GBMap%currentGBtype == 0) then
155 >       call handleError("GB", "No members in GBMap")
156 >       return
157 >    end if
158 >
159 >    gbt1 = GBMap%atidToGBtype(atomID)
160 >    sigma = GBMap%GBtypes(gbt1)%sigma
161 >    l2b_ratio = GBMap%GBtypes(gbt1)%l2b_ratio
162 >
163 >    cutValue = l2b_ratio*sigma*2.5_dp
164    end function getGayBerneCut
165  
166    subroutine do_gb_pair(atom1, atom2, d, r, r2, sw, vpair, fpair, &
167         pot, A, f, t, do_pot)
168      
169      integer, intent(in) :: atom1, atom2
170 <    integer :: id1, id2
170 >    integer :: atid1, atid2, gbt1, gbt2, id1, id2
171      real (kind=dp), intent(inout) :: r, r2
172      real (kind=dp), dimension(3), intent(in) :: d
173      real (kind=dp), dimension(3), intent(inout) :: fpair
# Line 281 | Line 179 | contains
179      real (kind = dp), dimension(3) :: ul1
180      real (kind = dp), dimension(3) :: ul2
181  
182 +    real(kind=dp) :: sigma, l2b_ratio, epsilon, eps_ratio, mu, nu, sigma_l, eps_l
183      real(kind=dp) :: chi, chiprime, emu, s2
184      real(kind=dp) :: r4, rdotu1, rdotu2, u1dotu2, g, gp, gpi, gmu, gmum
185      real(kind=dp) :: curlyE, enu, enum, eps, dotsum, dotdiff, ds2, dd2
# Line 309 | Line 208 | contains
208      real(kind=dp) :: term2u2x, term2u2y, term2u2z
209      real(kind=dp) :: yick1, yick2, mess1, mess2
210      
211 <    s2 = (gb_l2b_ratio)**2
212 <    emu = (gb_eps_ratio)**(1.0d0/gb_mu)
211 > #ifdef IS_MPI
212 >    atid1 = atid_Row(atom1)
213 >    atid2 = atid_Col(atom2)
214 > #else
215 >    atid1 = atid(atom1)
216 >    atid2 = atid(atom2)
217 > #endif
218  
219 +    gbt1 = GBMap%atidToGBtype(atid1)
220 +    gbt2 = GBMap%atidToGBtype(atid2)
221 +
222 +    if (gbt1 .eq. gbt2) then
223 +       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!")
233 +    endif
234 +
235 +    s2 = (l2b_ratio)**2
236 +    emu = (eps_ratio)**(1.0d0/mu)
237 +
238      chi = (s2 - 1.0d0)/(s2 + 1.0d0)
239      chiprime = (1.0d0 - emu)/(1.0d0 + emu)
240  
241      r4 = r2*r2
242  
243   #ifdef IS_MPI
244 <    ul1(1) = A_Row(3,atom1)
245 <    ul1(2) = A_Row(6,atom1)
244 >    ul1(1) = A_Row(7,atom1)
245 >    ul1(2) = A_Row(8,atom1)
246      ul1(3) = A_Row(9,atom1)
247  
248 <    ul2(1) = A_Col(3,atom2)
249 <    ul2(2) = A_Col(6,atom2)
248 >    ul2(1) = A_Col(7,atom2)
249 >    ul2(2) = A_Col(8,atom2)
250      ul2(3) = A_Col(9,atom2)
251   #else
252 <    ul1(1) = A(3,atom1)
253 <    ul1(2) = A(6,atom1)
252 >    ul1(1) = A(7,atom1)
253 >    ul1(2) = A(8,atom1)
254      ul1(3) = A(9,atom1)
255  
256 <    ul2(1) = A(3,atom2)
257 <    ul2(2) = A(6,atom2)
256 >    ul2(1) = A(7,atom2)
257 >    ul2(2) = A(8,atom2)
258      ul2(3) = A(9,atom2)
336
259   #endif
260      
261      dru1dx = ul1(1)
# Line 343 | Line 265 | contains
265      dru1dz = ul1(3)
266      dru2dz = ul2(3)
267          
346
347
268      drdx = d(1) / r
269      drdy = d(2) / r
270      drdz = d(3) / r
# Line 427 | Line 347 | contains
347  
348      g = 1.0d0 - Chi*(line3a + line3b)/(2.0d0*r2)
349    
350 <    BigR = (r - gb_sigma*(g**(-0.5d0)) + gb_sigma)/gb_sigma
350 >    BigR = (r - sigma*(g**(-0.5d0)) + sigma)/sigma
351      Ri = 1.0d0/BigR
352      Ri2 = Ri*Ri
353      Ri6 = Ri2*Ri2*Ri2
# Line 437 | Line 357 | contains
357  
358      gfact = (g**(-1.5d0))*0.5d0
359  
360 <    dBigRdx = drdx/gb_sigma + dgdx*gfact
361 <    dBigRdy = drdy/gb_sigma + dgdy*gfact
362 <    dBigRdz = drdz/gb_sigma + dgdz*gfact
360 >    dBigRdx = drdx/sigma + dgdx*gfact
361 >    dBigRdy = drdy/sigma + dgdy*gfact
362 >    dBigRdz = drdz/sigma + dgdz*gfact
363  
364      dBigRdu1x = dgdu1x*gfact
365      dBigRdu1y = dgdu1y*gfact
# Line 493 | Line 413 | contains
413      dgpdu2z = pref*(term1u2z+term2u2z)
414      
415      gp = 1.0d0 - ChiPrime*(line3a + line3b)/(2.0d0*r2)
416 <    gmu = gp**gb_mu
416 >    gmu = gp**mu
417      gpi = 1.0d0 / gp
418      gmum = gmu*gpi
419  
420      curlyE = 1.0d0/dsqrt(1.0d0 - Chi*Chi*u1dotu2*u1dotu2)
501 !!$
502 !!$    dcE = -(curlyE**3)*Chi*Chi*u1dotu2
421      dcE = (curlyE**3)*Chi*Chi*u1dotu2
422  
423      dcEdu1x = dcE*ul2(1)
# Line 509 | Line 427 | contains
427      dcEdu2y = dcE*ul1(2)
428      dcEdu2z = dcE*ul1(3)
429      
430 <    enu = curlyE**gb_nu
430 >    enu = curlyE**nu
431      enum = enu/curlyE
432    
433 <    eps = gb_eps*enu*gmu
433 >    eps = epsilon*enu*gmu
434  
435 <    yick1 = gb_eps*enu*gb_mu*gmum
436 <    yick2 = gb_eps*gmu*gb_nu*enum
435 >    yick1 = epsilon*enu*mu*gmum
436 >    yick2 = epsilon*gmu*nu*enum
437  
438      depsdu1x = yick1*dgpdu1x + yick2*dcEdu1x
439      depsdu1y = yick1*dgpdu1y + yick2*dcEdu1y
# Line 528 | Line 446 | contains
446      R137 = 6.0d0*Ri7 - 12.0d0*Ri13
447      
448      mess1 = gmu*R137
449 <    mess2 = R126*gb_mu*gmum
449 >    mess2 = R126*mu*gmum
450      
451 <    dUdx = 4.0d0*gb_eps*enu*(mess1*dBigRdx + mess2*dgpdx)*sw
452 <    dUdy = 4.0d0*gb_eps*enu*(mess1*dBigRdy + mess2*dgpdy)*sw
453 <    dUdz = 4.0d0*gb_eps*enu*(mess1*dBigRdz + mess2*dgpdz)*sw
451 >    dUdx = 4.0d0*epsilon*enu*(mess1*dBigRdx + mess2*dgpdx)*sw
452 >    dUdy = 4.0d0*epsilon*enu*(mess1*dBigRdy + mess2*dgpdy)*sw
453 >    dUdz = 4.0d0*epsilon*enu*(mess1*dBigRdz + mess2*dgpdz)*sw
454      
455      dUdu1x = 4.0d0*(R126*depsdu1x + eps*R137*dBigRdu1x)*sw
456      dUdu1y = 4.0d0*(R126*depsdu1y + eps*R137*dBigRdu1y)*sw
# Line 550 | Line 468 | contains
468      f_Col(2,atom2) = f_Col(2,atom2) - dUdy
469      f_Col(3,atom2) = f_Col(3,atom2) - dUdz
470      
471 <    t_Row(1,atom1) = t_Row(1,atom1)- ul1(3)*dUdu1y + ul1(2)*dUdu1z
472 <    t_Row(2,atom1) = t_Row(2,atom1)- ul1(1)*dUdu1z + ul1(3)*dUdu1x
473 <    t_Row(3,atom1) = t_Row(3,atom1)- ul1(2)*dUdu1x + ul1(1)*dUdu1y
471 >    t_Row(1,atom1) = t_Row(1,atom1) + ul1(3)*dUdu1y - ul1(2)*dUdu1z
472 >    t_Row(2,atom1) = t_Row(2,atom1) + ul1(1)*dUdu1z - ul1(3)*dUdu1x
473 >    t_Row(3,atom1) = t_Row(3,atom1) + ul1(2)*dUdu1x - ul1(1)*dUdu1y
474      
475 <    t_Col(1,atom2) = t_Col(1,atom2) - ul2(3)*dUdu2y + ul2(2)*dUdu2z
476 <    t_Col(2,atom2) = t_Col(2,atom2) - ul2(1)*dUdu2z + ul2(3)*dUdu2x
477 <    t_Col(3,atom2) = t_Col(3,atom2) - ul2(2)*dUdu2x + ul2(1)*dUdu2y
475 >    t_Col(1,atom2) = t_Col(1,atom2) + ul2(3)*dUdu2y - ul2(2)*dUdu2z
476 >    t_Col(2,atom2) = t_Col(2,atom2) + ul2(1)*dUdu2z - ul2(3)*dUdu2x
477 >    t_Col(3,atom2) = t_Col(3,atom2) + ul2(2)*dUdu2x - ul2(1)*dUdu2y
478   #else
479      f(1,atom1) = f(1,atom1) + dUdx
480      f(2,atom1) = f(2,atom1) + dUdy
# Line 566 | Line 484 | contains
484      f(2,atom2) = f(2,atom2) - dUdy
485      f(3,atom2) = f(3,atom2) - dUdz
486      
487 <    t(1,atom1) = t(1,atom1)- ul1(3)*dUdu1y + ul1(2)*dUdu1z
488 <    t(2,atom1) = t(2,atom1)- ul1(1)*dUdu1z + ul1(3)*dUdu1x
489 <    t(3,atom1) = t(3,atom1)- ul1(2)*dUdu1x + ul1(1)*dUdu1y
487 >    t(1,atom1) = t(1,atom1) + ul1(3)*dUdu1y - ul1(2)*dUdu1z
488 >    t(2,atom1) = t(2,atom1) + ul1(1)*dUdu1z - ul1(3)*dUdu1x
489 >    t(3,atom1) = t(3,atom1) + ul1(2)*dUdu1x - ul1(1)*dUdu1y
490      
491 <    t(1,atom2) = t(1,atom2)- ul2(3)*dUdu2y + ul2(2)*dUdu2z
492 <    t(2,atom2) = t(2,atom2)- ul2(1)*dUdu2z + ul2(3)*dUdu2x
493 <    t(3,atom2) = t(3,atom2)- ul2(2)*dUdu2x + ul2(1)*dUdu2y
491 >    t(1,atom2) = t(1,atom2) + ul2(3)*dUdu2y - ul2(2)*dUdu2z
492 >    t(2,atom2) = t(2,atom2) + ul2(1)*dUdu2z - ul2(3)*dUdu2x
493 >    t(3,atom2) = t(3,atom2) + ul2(2)*dUdu2x - ul2(1)*dUdu2y
494   #endif
495    
496      if (do_pot) then
497   #ifdef IS_MPI
498 <       pot_row(atom1) = pot_row(atom1) + 2.0d0*eps*R126*sw
499 <       pot_col(atom2) = pot_col(atom2) + 2.0d0*eps*R126*sw
498 >       pot_row(VDW_POT,atom1) = pot_row(VDW_POT,atom1) + 2.0d0*eps*R126*sw
499 >       pot_col(VDW_POT,atom2) = pot_col(VDW_POT,atom2) + 2.0d0*eps*R126*sw
500   #else
501         pot = pot + 4.0*eps*R126*sw
502   #endif
503      endif
504 <
504 >    
505      vpair = vpair + 4.0*eps*R126
506   #ifdef IS_MPI
507      id1 = AtomRowToGlobal(atom1)
# Line 604 | Line 522 | contains
522      return
523    end subroutine do_gb_pair
524  
525 <  subroutine do_gb_lj_pair(atom1, atom2, d, r, r2, sw, vpair, fpair, &
525 >  subroutine do_gb_lj_pair(atom1, atom2, d, r, r2, rcut, sw, vpair, fpair, &
526         pot, A, f, t, do_pot)
527      
528      integer, intent(in) :: atom1, atom2
529      integer :: id1, id2
530 <    real (kind=dp), intent(inout) :: r, r2
530 >    real (kind=dp), intent(inout) :: r, r2, rcut
531      real (kind=dp), dimension(3), intent(in) :: d
532      real (kind=dp), dimension(3), intent(inout) :: fpair
533      real (kind=dp) :: pot, sw, vpair
# Line 618 | Line 536 | contains
536      real (kind=dp), dimension(3,nLocal) :: t
537      logical, intent(in) :: do_pot
538      real (kind = dp), dimension(3) :: ul
539 <
540 < !!  real(kind=dp) :: lj2, s_lj2pperp2,s_perpppar2,eabnu, epspar
541 <    real(kind=dp) :: spar, sperp, slj, par2, perp2, sc, slj2
542 <    real(kind=dp) :: s_par2mperp2, s_lj2ppar2
543 <    real(kind=dp) :: enot, eperp, epar, eab, eabf,moom, mum1
544 < !!    real(kind=dp) :: e_ljpperp, e_perpmpar, e_ljppar
627 <    real(kind=dp) :: dx, dy, dz, drdx,drdy,drdz, rdotu
628 < !!    real(kind=dp) :: ct, dctdx, dctdy, dctdz, dctdux, dctduy, dctduz
629 <    real(kind=dp) :: mess, sab, dsabdct, eprime, deprimedct, depmudct
539 >    
540 >    real(kind=dp) :: gb_sigma, gb_eps, gb_eps_ratio, gb_mu, gb_l2b_ratio
541 >    real(kind=dp) :: s0, l2, d2, lj2
542 >    real(kind=dp) :: eE, eS, eab, eabf, moom, mum1
543 >    real(kind=dp) :: dx, dy, dz, drdx, drdy, drdz, rdotu
544 >    real(kind=dp) :: mess, sab, dsabdct, depmudct
545      real(kind=dp) :: epmu, depmudx, depmudy, depmudz
546      real(kind=dp) :: depmudux, depmuduy, depmuduz
547      real(kind=dp) :: BigR, dBigRdx, dBigRdy, dBigRdz
548      real(kind=dp) :: dBigRdux, dBigRduy, dBigRduz
549      real(kind=dp) :: dUdx, dUdy, dUdz, dUdux, dUduy, dUduz, e0
550 <    real(kind=dp) :: Ri, Ri3, Ri6, Ri7, Ril2, Ri13, Rl26, R137, prefactor
550 >    real(kind=dp) :: Ri, Ri3, Ri6, Ri7, Ri12, Ri13, R126, R137, prefactor
551      real(kind=dp) :: chipoalphap2, chioalpha2, ec, epsnot
552      real(kind=dp) :: drdotudx, drdotudy, drdotudz    
553 <    real(kind=dp) :: ljeps, ljsigma, sigmaratio, sigmaratioi
554 <    integer :: ljt1, ljt2, atid1, atid2
555 <    logical :: thisProperty
553 >    real(kind=dp) :: drdotudux, drdotuduy, drdotuduz    
554 >    real(kind=dp) :: ljeps, ljsigma
555 >    integer :: ljt1, ljt2, atid1, atid2, gbt1, gbt2
556 >    logical :: gb_first
557 >    
558   #ifdef IS_MPI
559      atid1 = atid_Row(atom1)
560      atid2 = atid_Col(atom2)
# Line 645 | Line 562 | contains
562      atid1 = atid(atom1)
563      atid2 = atid(atom2)
564   #endif
565 +    
566 +    gbt1 = GBMap%atidToGBtype(atid1)
567 +    gbt2 = GBMap%atidToGBtype(atid2)
568 +    
569 +    if (gbt1 .eq. -1) then
570 +       gb_first = .false.
571 +       if (gbt2 .eq. -1) then
572 +          call handleError("GB", "GBLJ was called without a GB type.")
573 +       endif
574 +    else
575 +       gb_first = .true.
576 +       if (gbt2 .ne. -1) then
577 +          call handleError("GB", "GBLJ was called with two GB types (instead of one).")
578 +       endif
579 +    endif
580 +    
581      ri =1/r
582      
583      dx = d(1)
# Line 654 | Line 587 | contains
587      drdx = dx *ri
588      drdy = dy *ri
589      drdz = dz *ri
590 <  
591 <  
659 <
660 <    if(.not.haveGayBerneLJMap) then
661 <       call createGayBerneLJMap()
662 <    endif
663 < !!$   write(*,*) "in gbljpair"
664 <    call getElementProperty(atypes, atid1, "is_LennardJones",thisProperty)
665 < !!$    write(*,*) thisProperty
666 <    if(thisProperty.eqv..true.)then
590 >    
591 >    if(gb_first)then
592   #ifdef IS_MPI
593 <       ul(1) = A_Row(3,atom2)
594 <       ul(2) = A_Row(6,atom2)
595 <       ul(3) = A_Row(9,atom2)
593 >       ul(1) = A_Row(7,atom1)
594 >       ul(2) = A_Row(8,atom1)
595 >       ul(3) = A_Row(9,atom1)
596 > #else
597 >       ul(1) = A(7,atom1)
598 >       ul(2) = A(8,atom1)
599 >       ul(3) = A(9,atom1)      
600 > #endif
601 >       gb_sigma     = GBMap%GBtypes(gbt1)%sigma      
602 >       gb_l2b_ratio = GBMap%GBtypes(gbt1)%l2b_ratio
603 >       gb_eps       = GBMap%GBtypes(gbt1)%eps        
604 >       gb_eps_ratio = GBMap%GBtypes(gbt1)%eps_ratio  
605 >       gb_mu        = GBMap%GBtypes(gbt1)%mu        
606  
607 +       ljsigma = getSigma(atid2)
608 +       ljeps = getEpsilon(atid2)
609 +    else
610 + #ifdef IS_MPI
611 +       ul(1) = A_Col(7,atom2)
612 +       ul(2) = A_Col(8,atom2)
613 +       ul(3) = A_Col(9,atom2)
614   #else
615 <       ul(1) = A(3,atom2)
616 <       ul(2) = A(6,atom2)
617 <       ul(3) = A(9,atom2)
615 >       ul(1) = A(7,atom2)
616 >       ul(2) = A(8,atom2)
617 >       ul(3) = A(9,atom2)    
618   #endif
619 +       gb_sigma     = GBMap%GBtypes(gbt2)%sigma      
620 +       gb_l2b_ratio = GBMap%GBtypes(gbt2)%l2b_ratio
621 +       gb_eps       = GBMap%GBtypes(gbt2)%eps        
622 +       gb_eps_ratio = GBMap%GBtypes(gbt2)%eps_ratio  
623 +       gb_mu        = GBMap%GBtypes(gbt2)%mu        
624  
625 <       rdotu = (dx*ul(1)+dy*ul(2)+dz*ul(3))*ri
625 >       ljsigma = getSigma(atid1)
626 >       ljeps = getEpsilon(atid1)
627 >    endif  
628 >
629 >    rdotu = (dx*ul(1)+dy*ul(2)+dz*ul(3))*ri
630 >  
631 >    drdotudx = ul(1)*ri-rdotu*dx*ri*ri
632 >    drdotudy = ul(2)*ri-rdotu*dy*ri*ri
633 >    drdotudz = ul(3)*ri-rdotu*dz*ri*ri
634 >    drdotudux = drdx
635 >    drdotuduy = drdy
636 >    drdotuduz = drdz
637  
638 <       ljt1 = LJMap%atidtoLJtype(atid1)
639 <       ljt2 = LJMap%atidtoLJtype(atid2)
640 <      
641 <       ljeps =  LJMap%LJtype(ljt1)%epsilon
684 < !!$       write(*,*) "ljeps"
685 < !!$       write(*,*) ljeps
686 <       drdotudx = ul(1)*ri-rdotu*dx*ri*ri
687 <       drdotudy = ul(2)*ri-rdotu*dy*ri*ri
688 <       drdotudz = ul(3)*ri-rdotu*dz*ri*ri
638 >    l2 = (gb_sigma*gb_l2b_ratio)**2
639 >    d2 = gb_sigma**2
640 >    lj2 = ljsigma**2
641 >    s0 = dsqrt(d2 + lj2)
642  
643 <    
691 <       moom =  1.0d0 / gb_mu
692 <       mum1 = gb_mu-1
643 >    chioalpha2 = (l2 - d2)/(l2 + lj2)
644  
645 <       sperp = GayBerneLJMap(ljt1)%sigma_s
646 <       spar =  GayBerneLJMap(ljt1)%sigma_l
647 <       slj = LJMap%LJtype(ljt1)%sigma
648 <       slj2 = slj*slj
649 < !!$       write(*,*) "spar"
699 < !!$       write(*,*) sperp
700 < !!$       write(*,*) spar
701 < !!    chioalpha2 = s_par2mperp2/s_lj2ppar2
702 <       chioalpha2 =1-((sperp+slj)*(sperp+slj))/((spar+slj)*(spar+slj))
703 <       sc = (sperp+slj)/2.0d0
704 <  
705 <       par2 = spar*spar
706 <       perp2 = sperp*sperp
707 <       s_par2mperp2 = par2 - perp2
708 <       s_lj2ppar2 = slj2 + par2
645 >    eE = dsqrt(gb_eps*gb_eps_ratio*ljeps)
646 >    eS = dsqrt(gb_eps*ljeps)
647 >    moom =  1.0d0 / gb_mu
648 >    mum1 = gb_mu-1
649 >    chipoalphap2 = 1 - (eE/eS)**moom
650  
651 +    !! mess matches cleaver (eq 20)
652 +    
653 +    mess = 1-rdotu*rdotu*chioalpha2
654 +    sab = 1.0d0/dsqrt(mess)
655  
656 < !! check these ! left from old code
657 < !! kdaily e0 may need to be (gb_eps + lj_eps)/2
656 >    dsabdct = s0*sab*sab*sab*rdotu*chioalpha2
657 >      
658 >    eab = 1-chipoalphap2*rdotu*rdotu
659 >    eabf = eS*(eab**gb_mu)
660 >
661 >    depmudct = -2*eS*chipoalphap2*gb_mu*rdotu*(eab**mum1)
662 >        
663 >    BigR = (r - sab*s0 + s0)/s0
664 >    dBigRdx = (drdx -dsabdct*drdotudx)/s0
665 >    dBigRdy = (drdy -dsabdct*drdotudy)/s0
666 >    dBigRdz = (drdz -dsabdct*drdotudz)/s0
667 >    dBigRdux = (-dsabdct*drdotudux)/s0
668 >    dBigRduy = (-dsabdct*drdotuduy)/s0
669 >    dBigRduz = (-dsabdct*drdotuduz)/s0
670      
671 <       eperp = dsqrt(gb_eps*ljeps)
672 <       epar = eperp*gb_eps_ratio
673 <       enot = dsqrt(ljeps*eperp)
674 <       chipoalphap2 = 1+(dsqrt(epar*ljeps)/enot)**moom
675 < !! to so mess matchs cleaver (eq 20)
671 >    depmudx = depmudct*drdotudx
672 >    depmudy = depmudct*drdotudy
673 >    depmudz = depmudct*drdotudz
674 >    depmudux = depmudct*drdotudux
675 >    depmuduy = depmudct*drdotuduy
676 >    depmuduz = depmudct*drdotuduz
677      
678 <       mess = 1-rdotu*rdotu*chioalpha2
679 <       sab = 1.0d0/dsqrt(mess)
680 <       dsabdct = sc*sab*sab*sab*rdotu*chioalpha2
681 <      
682 <       eab = 1-chipoalphap2*rdotu*rdotu
683 <       eabf = enot*eab**gb_mu
684 <       depmudct = -2*enot*chipoalphap2*gb_mu*rdotu*eab**mum1
685 <      
686 <      
687 <       BigR = (r - sab*sc + sc)/sc
688 <       dBigRdx = (drdx -dsabdct*drdotudx)/sc
689 <       dBigRdy = (drdy -dsabdct*drdotudy)/sc
690 <       dBigRdz = (drdz -dsabdct*drdotudz)/sc
691 <       dBigRdux = (-dsabdct*drdx)/sc
692 <       dBigRduy = (-dsabdct*drdy)/sc
693 <       dBigRduz = (-dsabdct*drdz)/sc
694 <      
695 <       depmudx = depmudct*drdotudx
696 <       depmudy = depmudct*drdotudy
739 <       depmudz = depmudct*drdotudz
740 <       depmudux = depmudct*drdx
741 <       depmuduy = depmudct*drdy
742 <       depmuduz = depmudct*drdz
743 <      
744 <       Ri = 1.0d0/BigR
745 <       Ri3 = Ri*Ri*Ri
746 <       Ri6 = Ri3*Ri3
747 <       Ri7 = Ri6*Ri
748 <       Ril2 = Ri6*Ri6
749 <       Ri13 = Ri6*Ri7
750 <       Rl26 = Ril2 - Ri6
751 <       R137 = 6.0d0*Ri7 - 12.0d0*Ri13
752 <      
753 <       prefactor = 4.0d0
754 <      
755 <       dUdx = prefactor*(eabf*R137*dBigRdx + Rl26*depmudx)
756 <       dUdy = prefactor*(eabf*R137*dBigRdy + Rl26*depmudy)
757 <       dUdz = prefactor*(eabf*R137*dBigRdz + Rl26*depmudz)
758 <       dUdux = prefactor*(eabf*R137*dBigRdux + Rl26*depmudux)
759 <       dUduy = prefactor*(eabf*R137*dBigRduy + Rl26*depmuduy)
760 <       dUduz = prefactor*(eabf*R137*dBigRduz + Rl26*depmuduz)
761 <      
678 >    Ri = 1.0d0/BigR
679 >    Ri3 = Ri*Ri*Ri
680 >    Ri6 = Ri3*Ri3
681 >    Ri7 = Ri6*Ri
682 >    Ri12 = Ri6*Ri6
683 >    Ri13 = Ri6*Ri7
684 >    R126 = Ri12 - Ri6
685 >    R137 = 6.0d0*Ri7 - 12.0d0*Ri13
686 >    
687 >    prefactor = 4.0d0
688 >    
689 >    dUdx = prefactor*(eabf*R137*dBigRdx + R126*depmudx)*sw
690 >    dUdy = prefactor*(eabf*R137*dBigRdy + R126*depmudy)*sw
691 >    dUdz = prefactor*(eabf*R137*dBigRdz + R126*depmudz)*sw
692 >
693 >    dUdux = prefactor*(eabf*R137*dBigRdux + R126*depmudux)*sw
694 >    dUduy = prefactor*(eabf*R137*dBigRduy + R126*depmuduy)*sw
695 >    dUduz = prefactor*(eabf*R137*dBigRduz + R126*depmuduz)*sw
696 >    
697   #ifdef IS_MPI
698 <       f_Row(1,atom1) = f_Row(1,atom1) - dUdx
699 <       f_Row(2,atom1) = f_Row(2,atom1) - dUdy
700 <       f_Row(3,atom1) = f_Row(3,atom1) - dUdz
698 >    f_Row(1,atom1) = f_Row(1,atom1) + dUdx
699 >    f_Row(2,atom1) = f_Row(2,atom1) + dUdy
700 >    f_Row(3,atom1) = f_Row(3,atom1) + dUdz
701      
702 <       f_Col(1,atom2) = f_Col(1,atom2) + dUdx
703 <       f_Col(2,atom2) = f_Col(2,atom2) + dUdy
704 <       f_Col(3,atom2) = f_Col(3,atom2) + dUdz
705 <      
706 <       t_Row(1,atom2) = t_Row(1,atom1) + ul(2)*dUdu1z - ul(3)*dUdu1y
707 <       t_Row(2,atom2) = t_Row(2,atom1) + ul(3)*dUdu1x - ul(1)*dUdu1z
708 <       t_Row(3,atom2) = t_Row(3,atom1) + ul(1)*dUdu1y - ul(2)*dUdu1x
709 <  
710 < #else
711 <      
712 <       !!kdaily changed flx(gbatom) to f(1,atom1)
713 <       f(1,atom1) = f(1,atom1) + dUdx
714 <       f(2,atom1) = f(2,atom1) + dUdy
715 <       f(3,atom1) = f(3,atom1) + dUdz
716 <      
717 <       !!kdaily changed flx(ljatom) to f(2,atom2)
718 <       f(1,atom2) = f(1,atom2) - dUdx
719 <       f(2,atom2) = f(2,atom2) - dUdy
720 <       f(3,atom2) = f(3,atom2) - dUdz
721 <      
722 <       ! torques are cross products:
723 <       !!kdaily tlx(gbatom) to t(1, atom1)and ulx(gbatom) to u11(atom1)need mpi
724 <       t(1,atom2) = t(1,atom2) + ul(2)*dUduz - ul(3)*dUduy
725 <       t(2,atom2) = t(2,atom2) + ul(3)*dUdux - ul(1)*dUduz
726 <       t(3,atom2) = t(3,atom2) + ul(1)*dUduy - ul(2)*dUdux
727 <      
702 >    f_Col(1,atom2) = f_Col(1,atom2) - dUdx
703 >    f_Col(2,atom2) = f_Col(2,atom2) - dUdy
704 >    f_Col(3,atom2) = f_Col(3,atom2) - dUdz
705 >    
706 >    if (gb_first) then
707 >       t_Row(1,atom1) = t_Row(1,atom1) - ul(2)*dUduz + ul(3)*dUduy
708 >       t_Row(2,atom1) = t_Row(2,atom1) - ul(3)*dUdux + ul(1)*dUduz
709 >       t_Row(3,atom1) = t_Row(3,atom1) - ul(1)*dUduy + ul(2)*dUdux
710 >    else
711 >       t_Col(1,atom2) = t_Col(1,atom2) - ul(2)*dUduz + ul(3)*dUduy
712 >       t_Col(2,atom2) = t_Col(2,atom2) - ul(3)*dUdux + ul(1)*dUduz
713 >       t_Col(3,atom2) = t_Col(3,atom2) - ul(1)*dUduy + ul(2)*dUdux
714 >    endif
715 > #else    
716 >    f(1,atom1) = f(1,atom1) + dUdx
717 >    f(2,atom1) = f(2,atom1) + dUdy
718 >    f(3,atom1) = f(3,atom1) + dUdz
719 >    
720 >    f(1,atom2) = f(1,atom2) - dUdx
721 >    f(2,atom2) = f(2,atom2) - dUdy
722 >    f(3,atom2) = f(3,atom2) - dUdz
723 >    
724 >    ! torques are cross products:    
725 >
726 >    if (gb_first) then
727 >       t(1,atom1) = t(1,atom1) - ul(2)*dUduz + ul(3)*dUduy
728 >       t(2,atom1) = t(2,atom1) - ul(3)*dUdux + ul(1)*dUduz
729 >       t(3,atom1) = t(3,atom1) - ul(1)*dUduy + ul(2)*dUdux
730 >    else
731 >       t(1,atom2) = t(1,atom2) - ul(2)*dUduz + ul(3)*dUduy
732 >       t(2,atom2) = t(2,atom2) - ul(3)*dUdux + ul(1)*dUduz
733 >       t(3,atom2) = t(3,atom2) - ul(1)*dUduy + ul(2)*dUdux
734 >    endif
735 >
736   #endif
737        
738 <       if (do_pot) then
738 >    if (do_pot) then
739   #ifdef IS_MPI
740 <          pot_row(atom1) = pot_row(atom1) + 2.0d0*eps*Rl26*sw
741 <          pot_col(atom2) = pot_col(atom2) + 2.0d0*eps*Rl26*sw
740 >       pot_row(VDW_POT,atom1) = pot_row(VDW_POT,atom1) + 2.0d0*eabf*R126*sw
741 >       pot_col(VDW_POT,atom2) = pot_col(VDW_POT,atom2) + 2.0d0*eabf*R126*sw
742   #else
743 <          pot = pot + prefactor*eabf*Rl26*sw
743 >       pot = pot + prefactor*eabf*R126*sw
744   #endif
745 <       endif
746 <      
747 <       vpair = vpair + 4.0*epmu*Rl26
745 >    endif
746 >    
747 >    vpair = vpair + 4.0*eabf*R126
748   #ifdef IS_MPI
749 <       id1 = AtomRowToGlobal(atom1)
750 <       id2 = AtomColToGlobal(atom2)
749 >    id1 = AtomRowToGlobal(atom1)
750 >    id2 = AtomColToGlobal(atom2)
751   #else
752 <       id1 = atom1
753 <       id2 = atom2
752 >    id1 = atom1
753 >    id2 = atom2
754   #endif
755 +    
756 +    If (Molmembershiplist(Id1) .Ne. Molmembershiplist(Id2)) Then
757        
758 <       If (Molmembershiplist(Id1) .Ne. Molmembershiplist(Id2)) Then
759 <          
760 <          Fpair(1) = Fpair(1) + Dudx
816 <          Fpair(2) = Fpair(2) + Dudy
817 <          Fpair(3) = Fpair(3) + Dudz
818 <          
819 <       Endif
758 >       Fpair(1) = Fpair(1) + Dudx
759 >       Fpair(2) = Fpair(2) + Dudy
760 >       Fpair(3) = Fpair(3) + Dudz
761        
762 <    else
763 <       !!need to do this all over but switch the gb and lj
823 <    endif
762 >    Endif
763 >    
764      return
765 <
765 >    
766    end subroutine do_gb_lj_pair
767  
768 <  subroutine complete_GayBerne_FF(status)
769 <    integer :: nLJTYPES, nGayBerneTypes, ntypes, current, status, natypes
770 <    integer, pointer :: MatchList(:) => null ()
771 <    integer :: i
832 <    integer :: myATID
833 <    logical :: thisProperty
768 >  subroutine destroyGBTypes()
769 >
770 >    GBMap%nGBtypes = 0
771 >    GBMap%currentGBtype = 0
772      
773 <    if(.not.associated(LJMap%Ljtype)) then
774 <      
775 <       natypes = getSize(atypes)
838 <      
839 <       if(nAtypes == 0) then
840 <          status = -1
841 <          return
842 <       end if
843 <      
844 <       call getMatchingElementList(atypes, "is_LennardJones", .true., &
845 <            nLJTypes, MatchList)
846 <      
847 <       LJMap%nLJtypes = nLJTypes
848 <      
849 <       if(nLJTypes ==0) then
850 <          write(*,*)" you broke this thing kyle"
851 <          return
852 <       endif
853 <       allocate(LJMap%LJtype(nLJTypes))
854 <      
855 <       ntypes = getSize(atypes)
856 <      
857 <       allocate(LJMap%atidToLJtype(ntypes))
773 >    if (associated(GBMap%GBtypes)) then
774 >       deallocate(GBMap%GBtypes)
775 >       GBMap%GBtypes => null()
776      end if
777      
778 <    do i =1, ntypes
779 <      
780 <       myATID = getFirstMatchingElement(atypes, 'c_ident', i)
781 <       call getElementProperty(atypes, myATID, "is_LennardJones",thisProperty)
864 <      
865 <       if(thisProperty) then
866 <          current =  LJMap%currentLJtype+1      
867 <          LJMap%currentLJtype =  current          
868 <          
869 <          LJMap%atidToLJtype(myATID)    = current
870 <          LJMap%LJtype(current)%atid    = myATid
871 <          
872 <          LJMap%LJtype(current)%sigma   = getSigma(myATID)
873 <          LJMap%LJtype(current)%epsilon = getEpsilon(myATID)
874 <       endif
875 <      
876 <    enddo
877 <    gb_pair_initialized = .true.
778 >    if (associated(GBMap%atidToGBtype)) then
779 >       deallocate(GBMap%atidToGBtype)
780 >       GBMap%atidToGBtype => null()
781 >    end if
782      
783 <  end subroutine complete_GayBerne_FF
783 >  end subroutine destroyGBTypes
784  
785 <  subroutine destroyGayBerneTypes()
882 <
883 <    LJMap%Nljtypes =0
884 <    LJMap%currentLJtype=0
885 <    if(associated(LJMap%LJtype))then
886 <       deallocate(LJMap%LJtype)
887 <       LJMap%LJtype => null()
888 <    end if
889 <      
890 <    if(associated(LJMap%atidToLJType))then
891 <       deallocate(LJMap%atidToLJType)
892 <       LJMap%atidToLJType => null()
893 <    end if
894 <
895 < !!       deallocate(gayBerneLJMap)
896 <  
897 <    haveGayBerneLJMap = .false.
898 <  end subroutine destroyGayBerneTypes
899 <
900 <
901 <
902 < end module gb_pair
785 > end module gayberne
786      

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines