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

Comparing trunk/OOPSE-4/src/UseTheForce/DarkSide/LJ.F90 (file contents):
Revision 1624 by chuckv, Thu Oct 21 15:25:30 2004 UTC vs.
Revision 2289 by gezelter, Wed Sep 14 19:02:33 2005 UTC

# Line 1 | Line 1
1 + !!
2 + !! Copyright (c) 2005 The University of Notre Dame. All Rights Reserved.
3 + !!
4 + !! The University of Notre Dame grants you ("Licensee") a
5 + !! non-exclusive, royalty free, license to use, modify and
6 + !! redistribute this software in source and binary code form, provided
7 + !! that the following conditions are met:
8 + !!
9 + !! 1. Acknowledgement of the program authors must be made in any
10 + !!    publication of scientific results based in part on use of the
11 + !!    program.  An acceptable form of acknowledgement is citation of
12 + !!    the article in which the program was described (Matthew
13 + !!    A. Meineke, Charles F. Vardeman II, Teng Lin, Christopher
14 + !!    J. Fennell and J. Daniel Gezelter, "OOPSE: An Object-Oriented
15 + !!    Parallel Simulation Engine for Molecular Dynamics,"
16 + !!    J. Comput. Chem. 26, pp. 252-271 (2005))
17 + !!
18 + !! 2. Redistributions of source code must retain the above copyright
19 + !!    notice, this list of conditions and the following disclaimer.
20 + !!
21 + !! 3. Redistributions in binary form must reproduce the above copyright
22 + !!    notice, this list of conditions and the following disclaimer in the
23 + !!    documentation and/or other materials provided with the
24 + !!    distribution.
25 + !!
26 + !! This software is provided "AS IS," without a warranty of any
27 + !! kind. All express or implied conditions, representations and
28 + !! warranties, including any implied warranty of merchantability,
29 + !! fitness for a particular purpose or non-infringement, are hereby
30 + !! excluded.  The University of Notre Dame and its licensors shall not
31 + !! be liable for any damages suffered by licensee as a result of
32 + !! using, modifying or distributing the software or its
33 + !! derivatives. In no event will the University of Notre Dame or its
34 + !! licensors be liable for any lost revenue, profit or data, or for
35 + !! direct, indirect, special, consequential, incidental or punitive
36 + !! damages, however caused and regardless of the theory of liability,
37 + !! arising out of the use of or inability to use software, even if the
38 + !! University of Notre Dame has been advised of the possibility of
39 + !! such damages.
40 + !!
41 +
42 +
43   !! Calculates Long Range forces Lennard-Jones interactions.
2 !! Corresponds to the force field defined in lj_FF.cpp
44   !! @author Charles F. Vardeman II
45   !! @author Matthew Meineke
46 < !! @version $Id: LJ.F90,v 1.2 2004-10-21 15:25:30 chuckv Exp $, $Date: 2004-10-21 15:25:30 $, $Name: not supported by cvs2svn $, $Revision: 1.2 $
46 > !! @version $Id: LJ.F90,v 1.14 2005-09-14 19:02:33 gezelter Exp $, $Date: 2005-09-14 19:02:33 $, $Name: not supported by cvs2svn $, $Revision: 1.14 $
47  
48 +
49   module lj
50    use atype_module
9  use switcheroo
51    use vector_class
52    use simulation
53 +  use status
54   #ifdef IS_MPI
55    use mpiSimulation
56   #endif
# Line 16 | Line 58 | module lj
58  
59    implicit none
60    PRIVATE
61 <  
61 >
62    integer, parameter :: DP = selected_real_kind(15)
63  
64 < #define __FORTRAN90
65 < #include "UseTheForce/fForceField.h"
64 >  logical, save :: useGeometricDistanceMixing = .false.
65 >  logical, save :: haveMixingMap = .false.
66  
67 <  integer, save :: LJ_Mixing_Policy
68 <  real(kind=DP), save :: LJ_rcut
69 <  logical, save :: havePolicy = .false.
70 <  logical, save :: haveCut = .false.
71 <  logical, save :: LJ_do_shift = .false.
72 <  
73 <  !! Logical has lj force field module been initialized?
74 <  
75 <  logical, save :: LJ_FF_initialized = .false.
76 <  
77 <  !! Public methods and data
78 <  public :: init_LJ_FF
79 <  public :: setCutoffLJ
80 <  public :: do_lj_pair
67 >  real(kind=DP), save :: defaultCutoff = 0.0_DP
68 >  logical, save :: defaultShift = .false.
69 >  logical, save :: haveDefaultCutoff = .false.
70 >
71 >
72 >  type, private :: LJtype
73 >     integer       :: atid
74 >     real(kind=dp) :: sigma
75 >     real(kind=dp) :: epsilon
76 >     logical       :: isSoftCore = .false.
77 >  end type LJtype
78 >
79 >  type, private :: LJList
80 >     integer               :: nLJtypes = 0
81 >     integer               :: currentLJtype = 0
82 >     type(LJtype), pointer :: LJtypes(:)      => null()
83 >     integer, pointer      :: atidToLJtype(:) => null()
84 >  end type LJList
85 >
86 >  type(LJList), save :: LJMap
87 >
88 >  type :: MixParameters
89 >     real(kind=DP) :: sigma
90 >     real(kind=DP) :: epsilon
91 >     real(kind=dp) :: sigma6
92 >     real(kind=dp) :: rCut
93 >     real(kind=dp) :: delta
94 >     logical       :: rCutWasSet = .false.
95 >     logical       :: shiftedPot
96 >     logical       :: isSoftCore = .false.
97 >  end type MixParameters
98 >
99 >  type(MixParameters), dimension(:,:), allocatable :: MixingMap
100 >
101    public :: newLJtype
102 <  
103 <  !! structure for lj type parameters
104 <  type, private :: ljType
105 <    integer :: lj_ident
106 <    real(kind=dp) :: lj_sigma
107 <    real(kind=dp) :: lj_epsilon
108 <  end type ljType
109 <  
110 <  !! List of lj type parameters
49 <  type, private :: ljTypeList
50 <    integer  :: n_lj_types = 0
51 <    integer  :: currentAddition = 0
52 <    type(ljType), pointer :: ljParams(:) => null()
53 <  end type ljTypeList
54 <  
55 <  !! The list of lj Parameters
56 <  type (ljTypeList), save :: ljParameterList
57 <  
58 <  
59 <  type :: lj_mixed_params
60 <     !! Lennard-Jones epsilon
61 <     real ( kind = dp )  :: epsilon = 0.0_dp
62 <     !! Lennard-Jones Sigma
63 <     real ( kind = dp )  :: sigma = 0.0_dp
64 <     !! Lennard-Jones Sigma to sixth
65 <     real ( kind = dp )  :: sigma6 = 0.0_dp
66 <     !!
67 <     real ( kind = dp )  :: tp6
68 <     real ( kind = dp )  :: tp12
69 <     real ( kind = dp )  :: delta  = 0.0_dp
70 <  end type lj_mixed_params
71 <  
72 <  type (lj_mixed_params), dimension(:,:), pointer :: ljMixed
73 <  
74 <  
75 <  
102 >  public :: setLJDefaultCutoff
103 >  public :: setLJUniformCutoff
104 >  public :: setLJCutoffByTypes
105 >  public :: getSigma
106 >  public :: getEpsilon
107 >  public :: useGeometricMixing
108 >  public :: do_lj_pair
109 >  public :: destroyLJtypes
110 >
111   contains
112  
113 <  subroutine newLJtype(ident,lj_sigma,lj_epsilon,status)
114 <    integer,intent(in) :: ident
115 <    real(kind=dp),intent(in) :: lj_sigma
116 <    real(kind=dp),intent(in) :: lj_epsilon
113 >  subroutine newLJtype(c_ident, sigma, epsilon, isSoftCore, status)
114 >    integer,intent(in) :: c_ident
115 >    real(kind=dp),intent(in) :: sigma
116 >    real(kind=dp),intent(in) :: epsilon
117 >    integer, intent(in) :: isSoftCore
118      integer,intent(out) :: status
119 <    
120 <    integer,pointer                        :: Matchlist(:) => null()
119 >    integer :: nLJTypes, ntypes, myATID
120 >    integer, pointer :: MatchList(:) => null()
121      integer :: current
122 <    integer :: nAtypes
122 >
123      status = 0
124 <    
125 <        !! Assume that atypes has already been set and get the total number of types in atypes
90 <  
91 <  
124 >    ! check to see if this is the first time into this routine...
125 >    if (.not.associated(LJMap%LJtypes)) then
126  
127 <    ! check to see if this is the first time into
128 <    if (.not.associated(ljParameterList%ljParams)) then
129 <       call getMatchingElementList(atypes, "is_lj", .true., nAtypes, MatchList)
130 <       ljParameterList%n_lj_types = nAtypes
131 <       if (nAtypes == 0) then
132 <         status = -1
133 <         return
134 <       end if
135 <       allocate(ljParameterList%ljParams(nAtypes))
127 >       call getMatchingElementList(atypes, "is_LennardJones", .true., &
128 >            nLJTypes, MatchList)
129 >      
130 >       LJMap%nLJtypes =  nLJTypes
131 >
132 >       allocate(LJMap%LJtypes(nLJTypes))
133 >
134 >       ntypes = getSize(atypes)
135 >
136 >       allocate(LJMap%atidToLJtype(ntypes))
137      end if
138  
139 <    ljParameterList%currentAddition = ljParameterList%currentAddition + 1
140 <    current = ljParameterList%currentAddition
141 <    
142 <    ! set the values for ljParameterList
143 <    ljParameterList%ljParams(current)%lj_ident = ident
144 <    ljParameterList%ljParams(current)%lj_epsilon = lj_epsilon
145 <    ljParameterList%ljParams(current)%lj_sigma = lj_sigma
146 <    
147 <  end subroutine newLJtype
148 <  
114 <  subroutine init_LJ_FF(mix_Policy, status)
115 <    integer, intent(in) :: mix_Policy
116 <    integer, intent(out) :: status
117 <    integer :: myStatus
118 <    
119 <    if (mix_Policy == LB_MIXING_RULE) then
120 <       LJ_Mixing_Policy = LB_MIXING_RULE
139 >    LJMap%currentLJtype = LJMap%currentLJtype + 1
140 >    current = LJMap%currentLJtype
141 >
142 >    myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
143 >    LJMap%atidToLJtype(myATID)        = current
144 >    LJMap%LJtypes(current)%atid       = myATID
145 >    LJMap%LJtypes(current)%sigma      = sigma
146 >    LJMap%LJtypes(current)%epsilon    = epsilon
147 >    if (isSoftCore .eq. 1) then
148 >       LJMap%LJtypes(current)%isSoftCore = .true.
149      else
150 <       if (mix_Policy == EXPLICIT_MIXING_RULE) then
123 <          LJ_Mixing_Policy = EXPLICIT_MIXING_RULE
124 <       else
125 <          write(*,*) 'Unknown Mixing Policy!'
126 <          status = -1
127 <          return
128 <       endif
150 >       LJMap%LJtypes(current)%isSoftCore = .false.
151      endif
152 +  end subroutine newLJtype
153  
154 <    havePolicy = .true.
154 >  subroutine setLJDefaultCutoff(thisRcut, shiftedPot)
155 >    real(kind=dp), intent(in) :: thisRcut
156 >    logical, intent(in) :: shiftedPot
157 >    defaultCutoff = thisRcut
158 >    defaultShift = shiftedPot
159 >    haveDefaultCutoff = .true.
160 >  end subroutine setLJDefaultCutoff
161  
162 <    if (haveCut) then
163 <       status = 0
164 <       call createMixingList(myStatus)
165 <       if (myStatus /= 0) then
166 <          status = -1
167 <          return
168 <       end if
169 <      
141 <       LJ_FF_initialized = .true.
162 >  subroutine setLJUniformCutoff(thisRcut, shiftedPot)
163 >    real(kind=dp), intent(in) :: thisRcut
164 >    logical, intent(in) :: shiftedPot
165 >    integer :: nLJtypes, i, j
166 >
167 >    if (LJMap%currentLJtype == 0) then
168 >       call handleError("LJ", "No members in LJMap")
169 >       return
170      end if
143  
144  end subroutine init_LJ_FF
145  
146  subroutine setCutoffLJ(rcut, do_shift, status)
147    logical, intent(in):: do_shift
148    integer :: status, myStatus
149    real(kind=dp) :: rcut
171  
172 < #define __FORTRAN90
173 < #include "UseTheForce/fSwitchingFunction.h"
172 >    nLJtypes = LJMap%nLJtypes
173 >    if (.not. allocated(MixingMap)) then
174 >       allocate(MixingMap(nLJtypes, nLJtypes))
175 >    endif
176  
177 <    status = 0
177 >    do i = 1, nLJtypes
178 >       do j = 1, nLJtypes
179 >          MixingMap(i,j)%rCut = thisRcut
180 >          MixingMap(i,j)%shiftedPot = shiftedPot
181 >          MixingMap(i,j)%rCutWasSet = .true.
182 >       enddo
183 >    enddo
184 >    call createMixingMap()
185 >  end subroutine setLJUniformCutoff
186  
187 <    LJ_rcut = rcut
188 <    LJ_do_shift = do_shift
189 <    call set_switch(LJ_SWITCH, rcut, rcut)
190 <    haveCut = .true.
187 >  subroutine setLJCutoffByTypes(atid1, atid2, thisRcut, shiftedPot)
188 >    integer, intent(in) :: atid1, atid2
189 >    real(kind=dp), intent(in) :: thisRcut
190 >    logical, intent(in) :: shiftedPot
191 >    integer :: nLJtypes, ljt1, ljt2
192  
193 <    if (havePolicy) then
194 <       status = 0
163 <       call createMixingList(myStatus)
164 <       if (myStatus /= 0) then
165 <          status = -1
166 <          return
167 <       end if
168 <      
169 <       LJ_FF_initialized = .true.
170 <    end if    
171 <    
172 <    return
173 <  end subroutine setCutoffLJ
174 <  
175 <  subroutine createMixingList(status)
176 <    integer :: nAtypes
177 <    integer :: status
178 <    integer :: i
179 <    integer :: j
180 <    real ( kind = dp ) :: mySigma_i,mySigma_j
181 <    real ( kind = dp ) :: myEpsilon_i,myEpsilon_j
182 <    real ( kind = dp ) :: rcut6
183 <    logical :: I_isLJ, J_isLJ
184 <    status = 0
185 <    
186 <    ! we only allocate this array to the number of lj_atypes
187 <    nAtypes = size(ljParameterList%ljParams)
188 <    if (nAtypes == 0) then
189 <       status = -1
193 >    if (LJMap%currentLJtype == 0) then
194 >       call handleError("LJ", "No members in LJMap")
195         return
196      end if
197 <        
198 <    if (.not. associated(ljMixed)) then
199 <       allocate(ljMixed(nAtypes, nAtypes))
197 >
198 >    nLJtypes = LJMap%nLJtypes
199 >    if (.not. allocated(MixingMap)) then
200 >       allocate(MixingMap(nLJtypes, nLJtypes))
201      endif
202  
203 <    rcut6 = LJ_rcut**6
203 >    ljt1 = LJMap%atidToLJtype(atid1)
204 >    ljt2 = LJMap%atidToLJtype(atid2)
205  
206 < ! This loops through all atypes, even those that don't support LJ forces.
207 <    do i = 1, nAtypes
206 >    MixingMap(ljt1,ljt2)%rCut = thisRcut
207 >    MixingMap(ljt1,ljt2)%shiftedPot = shiftedPot
208 >    MixingMap(ljt1,ljt2)%rCutWasSet = .true.
209 >    MixingMap(ljt2,ljt1)%rCut = thisRcut
210 >    MixingMap(ljt2,ljt1)%shiftedPot = shiftedPot
211 >    MixingMap(ljt2,ljt1)%rCutWasSet = .true.
212  
213 <          myEpsilon_i = ljParameterList%ljParams(i)%lj_epsilon
214 <          mySigma_i = ljParameterList%ljParams(i)%lj_sigma
213 >    call createMixingMap()
214 >  end subroutine setLJCutoffByTypes
215 >
216 >  function getSigma(atid) result (s)
217 >    integer, intent(in) :: atid
218 >    integer :: ljt1
219 >    real(kind=dp) :: s
220 >
221 >    if (LJMap%currentLJtype == 0) then
222 >       call handleError("LJ", "No members in LJMap")
223 >       return
224 >    end if
225 >
226 >    ljt1 = LJMap%atidToLJtype(atid)
227 >    s = LJMap%LJtypes(ljt1)%sigma
228 >
229 >  end function getSigma
230 >
231 >  function getEpsilon(atid) result (e)
232 >    integer, intent(in) :: atid
233 >    integer :: ljt1
234 >    real(kind=dp) :: e
235 >
236 >    if (LJMap%currentLJtype == 0) then
237 >       call handleError("LJ", "No members in LJMap")
238 >       return
239 >    end if
240 >
241 >    ljt1 = LJMap%atidToLJtype(atid)
242 >    e = LJMap%LJtypes(ljt1)%epsilon
243 >
244 >  end function getEpsilon
245 >
246 >  subroutine useGeometricMixing()
247 >    useGeometricDistanceMixing = .true.
248 >    haveMixingMap = .false.
249 >    return
250 >  end subroutine useGeometricMixing
251 >
252 >  subroutine createMixingMap()
253 >    integer :: nLJtypes, i, j
254 >    real ( kind = dp ) :: s1, s2, e1, e2
255 >    real ( kind = dp ) :: rcut6, tp6, tp12
256 >    logical :: isSoftCore1, isSoftCore2, doShift
257 >
258 >    if (LJMap%currentLJtype == 0) then
259 >       call handleError("LJ", "No members in LJMap")
260 >       return
261 >    end if
262 >
263 >    nLJtypes = LJMap%nLJtypes
264 >
265 >    if (.not. allocated(MixingMap)) then
266 >       allocate(MixingMap(nLJtypes, nLJtypes))
267 >    endif
268 >
269 >    do i = 1, nLJtypes
270 >
271 >       s1 = LJMap%LJtypes(i)%sigma
272 >       e1 = LJMap%LJtypes(i)%epsilon
273 >       isSoftCore1 = LJMap%LJtypes(i)%isSoftCore
274 >
275 >       do j = i, nLJtypes
276            
277 <          ! do self mixing rule
278 <          ljMixed(i,i)%sigma   = mySigma_i
277 >          s2 = LJMap%LJtypes(j)%sigma
278 >          e2 = LJMap%LJtypes(j)%epsilon
279 >          isSoftCore2 = LJMap%LJtypes(j)%isSoftCore
280            
281 <          ljMixed(i,i)%sigma6  = (ljMixed(i,i)%sigma) ** 6
281 >          MixingMap(i,j)%isSoftCore = isSoftCore1 .or. isSoftCore2
282 >
283 >          ! only the distance parameter uses different mixing policies
284 >          if (useGeometricDistanceMixing) then
285 >             MixingMap(i,j)%sigma = dsqrt(s1 * s2)
286 >          else
287 >             MixingMap(i,j)%sigma = 0.5_dp * (s1 + s2)
288 >          endif
289            
290 <          ljMixed(i,i)%tp6     = (ljMixed(i,i)%sigma6)/rcut6
211 <          
212 <          ljMixed(i,i)%tp12    = (ljMixed(i,i)%tp6) ** 2
213 <          
214 <          
215 <          ljMixed(i,i)%epsilon = myEpsilon_i
216 <          
217 <          ljMixed(i,i)%delta = -4.0_DP * ljMixed(i,i)%epsilon * &
218 <            (ljMixed(i,i)%tp12 - ljMixed(i,i)%tp6)
219 <          
220 <          do j = i + 1, nAtypes
290 >          MixingMap(i,j)%epsilon = dsqrt(e1 * e2)
291  
292 <                myEpsilon_j = ljParameterList%ljParams(j)%lj_epsilon
223 <                mySigma_j = ljParameterList%ljParams(j)%lj_sigma
292 >          MixingMap(i,j)%sigma6 = (MixingMap(i,j)%sigma)**6
293  
294 <                          
295 <                ljMixed(i,j)%sigma  =  &
296 <                     calcLJMix("sigma",mySigma_i, &
297 <                     mySigma_j)
298 <                
299 <                ljMixed(i,j)%sigma6 = &
300 <                     (ljMixed(i,j)%sigma)**6
301 <                
302 <                
303 <                ljMixed(i,j)%tp6     = ljMixed(i,j)%sigma6/rcut6
235 <                
236 <                ljMixed(i,j)%tp12    = (ljMixed(i,j)%tp6) ** 2
237 <                
238 <                
239 <                ljMixed(i,j)%epsilon = &
240 <                     calcLJMix("epsilon",myEpsilon_i, &
241 <                     myEpsilon_j)
242 <                
243 <                ljMixed(i,j)%delta = -4.0_DP * ljMixed(i,j)%epsilon * &
244 <                     (ljMixed(i,j)%tp12 - ljMixed(i,j)%tp6)
245 <                
246 <                
247 <                ljMixed(j,i)%sigma   = ljMixed(i,j)%sigma
248 <                ljMixed(j,i)%sigma6  = ljMixed(i,j)%sigma6
249 <                ljMixed(j,i)%tp6     = ljMixed(i,j)%tp6
250 <                ljMixed(j,i)%tp12    = ljMixed(i,j)%tp12
251 <                ljMixed(j,i)%epsilon = ljMixed(i,j)%epsilon
252 <                ljMixed(j,i)%delta   = ljMixed(i,j)%delta
294 >          if (MixingMap(i,j)%rCutWasSet) then
295 >             rcut6 = (MixingMap(i,j)%rcut)**6
296 >          else
297 >             if (haveDefaultCutoff) then
298 >                rcut6 = defaultCutoff**6
299 >                doShift = defaultShift
300 >             else
301 >                call handleError("LJ", "No specified or default cutoff value!")
302 >             endif
303 >          endif
304            
305 <          end do
306 <    end do
305 >          tp6    = MixingMap(i,j)%sigma6/rcut6
306 >          tp12    = tp6**2          
307 >          MixingMap(i,j)%delta =-4.0_DP*MixingMap(i,j)%epsilon*(tp12 - tp6)
308 >          MixingMap(i,j)%shiftedPot = doShift
309 >
310 >          if (i.ne.j) then
311 >             MixingMap(j,i)%sigma      = MixingMap(i,j)%sigma
312 >             MixingMap(j,i)%epsilon    = MixingMap(i,j)%epsilon
313 >             MixingMap(j,i)%sigma6     = MixingMap(i,j)%sigma6
314 >             MixingMap(j,i)%rCut       = MixingMap(i,j)%rCut
315 >             MixingMap(j,i)%delta      = MixingMap(i,j)%delta
316 >             MixingMap(j,i)%rCutWasSet = MixingMap(i,j)%rCutWasSet
317 >             MixingMap(j,i)%shiftedPot = MixingMap(i,j)%shiftedPot
318 >             MixingMap(j,i)%isSoftCore = MixingMap(i,j)%isSoftCore
319 >          endif
320 >
321 >       enddo
322 >    enddo
323      
324 <  end subroutine createMixingList
324 >    haveMixingMap = .true.
325 >    
326 >  end subroutine createMixingMap
327    
328    subroutine do_lj_pair(atom1, atom2, d, rij, r2, sw, vpair, fpair, &
329         pot, f, do_pot)
330  
331      integer, intent(in) ::  atom1, atom2
332 +    integer :: atid1, atid2, ljt1, ljt2
333      real( kind = dp ), intent(in) :: rij, r2
334      real( kind = dp ) :: pot, sw, vpair
335      real( kind = dp ), dimension(3,nLocal) :: f    
# Line 277 | Line 347 | contains
347      real( kind = dp ) :: t6
348      real( kind = dp ) :: t12
349      real( kind = dp ) :: delta
350 <    integer :: id1, id2
350 >    logical :: isSoftCore, shiftedPot
351 >    integer :: id1, id2, localError
352  
353 +    if (.not.haveMixingMap) then
354 +       call createMixingMap()
355 +    endif
356 +
357      ! Look up the correct parameters in the mixing matrix
358   #ifdef IS_MPI
359 <    sigma6   = ljMixed(atid_Row(atom1),atid_Col(atom2))%sigma6
360 <    epsilon  = ljMixed(atid_Row(atom1),atid_Col(atom2))%epsilon
286 <    delta    = ljMixed(atid_Row(atom1),atid_Col(atom2))%delta
359 >    atid1 = atid_Row(atom1)
360 >    atid2 = atid_Col(atom2)
361   #else
362 <    sigma6   = ljMixed(atid(atom1),atid(atom2))%sigma6
363 <    epsilon  = ljMixed(atid(atom1),atid(atom2))%epsilon
290 <    delta    = ljMixed(atid(atom1),atid(atom2))%delta
362 >    atid1 = atid(atom1)
363 >    atid2 = atid(atom2)
364   #endif
365  
366 +    ljt1 = LJMap%atidToLJtype(atid1)
367 +    ljt2 = LJMap%atidToLJtype(atid2)
368 +
369 +    sigma6     = MixingMap(ljt1,ljt2)%sigma6
370 +    epsilon    = MixingMap(ljt1,ljt2)%epsilon
371 +    delta      = MixingMap(ljt1,ljt2)%delta
372 +    isSoftCore = MixingMap(ljt1,ljt2)%isSoftCore
373 +    shiftedPot = MixingMap(ljt1,ljt2)%shiftedPot
374 +
375      r6 = r2 * r2 * r2
376 <    
376 >
377      t6  = sigma6/ r6
378      t12 = t6 * t6    
297  
298    pot_temp = 4.0E0_DP * epsilon * (t12 - t6)
299    if (LJ_do_shift) then
300       pot_temp = pot_temp + delta
301    endif
379  
380 <    vpair = vpair + pot_temp
380 >    if (isSoftCore) then
381        
382 <    dudr = sw * 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / rij
382 >       pot_temp = 4.0E0_DP * epsilon * t6
383 >       if (shiftedPot) then
384 >          pot_temp = pot_temp + delta
385 >       endif
386        
387 +       vpair = vpair + pot_temp
388 +      
389 +       dudr = -sw * 24.0E0_DP * epsilon * t6 / rij
390 +      
391 +    else
392 +       pot_temp = 4.0E0_DP * epsilon * (t12 - t6)
393 +       if (shiftedPot) then
394 +          pot_temp = pot_temp + delta
395 +       endif
396 +      
397 +       vpair = vpair + pot_temp
398 +      
399 +       dudr = sw * 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / rij
400 +    endif
401 +
402      drdx = d(1) / rij
403      drdy = d(2) / rij
404      drdz = d(3) / rij
405 <      
405 >
406      fx = dudr * drdx
407      fy = dudr * drdy
408      fz = dudr * drdz
409 <    
315 <      
409 >
410   #ifdef IS_MPI
411      if (do_pot) then
412         pot_Row(atom1) = pot_Row(atom1) + sw*pot_temp*0.5
413         pot_Col(atom2) = pot_Col(atom2) + sw*pot_temp*0.5
414      endif
415 <    
415 >
416      f_Row(1,atom1) = f_Row(1,atom1) + fx
417      f_Row(2,atom1) = f_Row(2,atom1) + fy
418      f_Row(3,atom1) = f_Row(3,atom1) + fz
419 <    
419 >
420      f_Col(1,atom2) = f_Col(1,atom2) - fx
421      f_Col(2,atom2) = f_Col(2,atom2) - fy
422      f_Col(3,atom2) = f_Col(3,atom2) - fz      
423 <    
423 >
424   #else
425      if (do_pot) pot = pot + sw*pot_temp
426  
427      f(1,atom1) = f(1,atom1) + fx
428      f(2,atom1) = f(2,atom1) + fy
429      f(3,atom1) = f(3,atom1) + fz
430 <    
430 >
431      f(1,atom2) = f(1,atom2) - fx
432      f(2,atom2) = f(2,atom2) - fy
433      f(3,atom2) = f(3,atom2) - fz
434   #endif
435 <        
435 >
436   #ifdef IS_MPI
437      id1 = AtomRowToGlobal(atom1)
438      id2 = AtomColToGlobal(atom2)
# Line 348 | Line 442 | contains
442   #endif
443  
444      if (molMembershipList(id1) .ne. molMembershipList(id2)) then
445 <      
445 >
446         fpair(1) = fpair(1) + fx
447         fpair(2) = fpair(2) + fy
448         fpair(3) = fpair(3) + fz
# Line 356 | Line 450 | contains
450      endif
451  
452      return    
453 <    
453 >
454    end subroutine do_lj_pair
361  
362  
363  !! Calculates the mixing for sigma or epslon
364  
365  function calcLJMix(thisParam,param1,param2,status) result(myMixParam)
366    character(len=*) :: thisParam
367    real(kind = dp)  :: param1
368    real(kind = dp)  :: param2
369    real(kind = dp ) :: myMixParam
455  
456 <    integer, optional :: status  
456 >  subroutine destroyLJTypes()
457  
458 <    myMixParam = 0.0_dp
458 >    LJMap%nLJtypes = 0
459 >    LJMap%currentLJtype = 0
460      
461 <    if (present(status)) status = 0
462 <    select case (LJ_Mixing_Policy)
463 <    case (1)
464 <       select case (thisParam)
465 <       case ("sigma")
466 <          myMixParam = 0.5_dp * (param1 + param2)
467 <       case ("epsilon")
468 <          myMixParam = sqrt(param1 * param2)
469 <       case default
470 <          status = -1
471 <       end select
472 <    case default
387 <       status = -1
388 <    end select
389 <  end function calcLJMix
390 <  
391 < end module lj
461 >    if (associated(LJMap%LJtypes)) then
462 >       deallocate(LJMap%LJtypes)
463 >       LJMap%LJtypes => null()
464 >    end if
465 >    
466 >    if (associated(LJMap%atidToLJtype)) then
467 >       deallocate(LJMap%atidToLJtype)
468 >       LJMap%atidToLJtype => null()
469 >    end if
470 >    
471 >    haveMixingMap = .false.
472 >  end subroutine destroyLJTypes
473  
474 < subroutine newLJtype(ident,lj_sigma,lj_epsilon,status)
394 <    use lj, ONLY : module_newLJtype => newLJtype
395 <    integer, parameter :: DP = selected_real_kind(15)
396 <    integer,intent(inout) :: ident
397 <    real(kind=dp),intent(inout) :: lj_sigma
398 <    real(kind=dp),intent(inout) :: lj_epsilon
399 <    integer,intent(inout) :: status
400 <
401 <    call module_newLJtype(ident,lj_sigma,lj_epsilon,status)
402 <
403 < end subroutine newLJtype
404 <
474 > end module lj

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines