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 2317 by chrisfen, Wed Sep 21 17:20:14 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.15 2005-09-21 17:20:14 chrisfen Exp $, $Date: 2005-09-21 17:20:14 $, $Name: not supported by cvs2svn $, $Revision: 1.15 $
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 >    call createMixingMap()
161 >  end subroutine setLJDefaultCutoff
162  
163 <    if (haveCut) then
164 <       status = 0
165 <       call createMixingList(myStatus)
166 <       if (myStatus /= 0) then
167 <          status = -1
168 <          return
169 <       end if
170 <      
141 <       LJ_FF_initialized = .true.
163 >  subroutine setLJUniformCutoff(thisRcut, shiftedPot)
164 >    real(kind=dp), intent(in) :: thisRcut
165 >    logical, intent(in) :: shiftedPot
166 >    integer :: nLJtypes, i, j
167 >
168 >    if (LJMap%currentLJtype == 0) then
169 >       call handleError("LJ", "No members in LJMap")
170 >       return
171      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
172  
173 < #define __FORTRAN90
174 < #include "UseTheForce/fSwitchingFunction.h"
173 >    nLJtypes = LJMap%nLJtypes
174 >    if (.not. allocated(MixingMap)) then
175 >       allocate(MixingMap(nLJtypes, nLJtypes))
176 >    endif
177  
178 <    status = 0
178 >    do i = 1, nLJtypes
179 >       do j = 1, nLJtypes
180 >          MixingMap(i,j)%rCut = thisRcut
181 >          MixingMap(i,j)%shiftedPot = shiftedPot
182 >          MixingMap(i,j)%rCutWasSet = .true.
183 >       enddo
184 >    enddo
185 >    call createMixingMap()
186 >  end subroutine setLJUniformCutoff
187  
188 <    LJ_rcut = rcut
189 <    LJ_do_shift = do_shift
190 <    call set_switch(LJ_SWITCH, rcut, rcut)
191 <    haveCut = .true.
188 >  subroutine setLJCutoffByTypes(atid1, atid2, thisRcut, shiftedPot)
189 >    integer, intent(in) :: atid1, atid2
190 >    real(kind=dp), intent(in) :: thisRcut
191 >    logical, intent(in) :: shiftedPot
192 >    integer :: nLJtypes, ljt1, ljt2
193  
194 <    if (havePolicy) then
195 <       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
194 >    if (LJMap%currentLJtype == 0) then
195 >       call handleError("LJ", "No members in LJMap")
196         return
197      end if
198 <        
199 <    if (.not. associated(ljMixed)) then
200 <       allocate(ljMixed(nAtypes, nAtypes))
198 >
199 >    nLJtypes = LJMap%nLJtypes
200 >    if (.not. allocated(MixingMap)) then
201 >       allocate(MixingMap(nLJtypes, nLJtypes))
202      endif
203  
204 <    rcut6 = LJ_rcut**6
204 >    ljt1 = LJMap%atidToLJtype(atid1)
205 >    ljt2 = LJMap%atidToLJtype(atid2)
206  
207 < ! This loops through all atypes, even those that don't support LJ forces.
208 <    do i = 1, nAtypes
207 >    MixingMap(ljt1,ljt2)%rCut = thisRcut
208 >    MixingMap(ljt1,ljt2)%shiftedPot = shiftedPot
209 >    MixingMap(ljt1,ljt2)%rCutWasSet = .true.
210 >    MixingMap(ljt2,ljt1)%rCut = thisRcut
211 >    MixingMap(ljt2,ljt1)%shiftedPot = shiftedPot
212 >    MixingMap(ljt2,ljt1)%rCutWasSet = .true.
213  
214 <          myEpsilon_i = ljParameterList%ljParams(i)%lj_epsilon
215 <          mySigma_i = ljParameterList%ljParams(i)%lj_sigma
214 >    call createMixingMap()
215 >  end subroutine setLJCutoffByTypes
216 >
217 >  function getSigma(atid) result (s)
218 >    integer, intent(in) :: atid
219 >    integer :: ljt1
220 >    real(kind=dp) :: s
221 >
222 >    if (LJMap%currentLJtype == 0) then
223 >       call handleError("LJ", "No members in LJMap")
224 >       return
225 >    end if
226 >
227 >    ljt1 = LJMap%atidToLJtype(atid)
228 >    s = LJMap%LJtypes(ljt1)%sigma
229 >
230 >  end function getSigma
231 >
232 >  function getEpsilon(atid) result (e)
233 >    integer, intent(in) :: atid
234 >    integer :: ljt1
235 >    real(kind=dp) :: e
236 >
237 >    if (LJMap%currentLJtype == 0) then
238 >       call handleError("LJ", "No members in LJMap")
239 >       return
240 >    end if
241 >
242 >    ljt1 = LJMap%atidToLJtype(atid)
243 >    e = LJMap%LJtypes(ljt1)%epsilon
244 >
245 >  end function getEpsilon
246 >
247 >  subroutine useGeometricMixing()
248 >    useGeometricDistanceMixing = .true.
249 >    haveMixingMap = .false.
250 >    return
251 >  end subroutine useGeometricMixing
252 >
253 >  subroutine createMixingMap()
254 >    integer :: nLJtypes, i, j
255 >    real ( kind = dp ) :: s1, s2, e1, e2
256 >    real ( kind = dp ) :: rcut6, tp6, tp12
257 >    logical :: isSoftCore1, isSoftCore2, doShift
258 >
259 >    if (LJMap%currentLJtype == 0) then
260 >       call handleError("LJ", "No members in LJMap")
261 >       return
262 >    end if
263 >
264 >    nLJtypes = LJMap%nLJtypes
265 >
266 >    if (.not. allocated(MixingMap)) then
267 >       allocate(MixingMap(nLJtypes, nLJtypes))
268 >    endif
269 >
270 >    do i = 1, nLJtypes
271 >
272 >       s1 = LJMap%LJtypes(i)%sigma
273 >       e1 = LJMap%LJtypes(i)%epsilon
274 >       isSoftCore1 = LJMap%LJtypes(i)%isSoftCore
275 >
276 >       do j = i, nLJtypes
277            
278 <          ! do self mixing rule
279 <          ljMixed(i,i)%sigma   = mySigma_i
278 >          s2 = LJMap%LJtypes(j)%sigma
279 >          e2 = LJMap%LJtypes(j)%epsilon
280 >          isSoftCore2 = LJMap%LJtypes(j)%isSoftCore
281            
282 <          ljMixed(i,i)%sigma6  = (ljMixed(i,i)%sigma) ** 6
282 >          MixingMap(i,j)%isSoftCore = isSoftCore1 .or. isSoftCore2
283 >
284 >          ! only the distance parameter uses different mixing policies
285 >          if (useGeometricDistanceMixing) then
286 >             MixingMap(i,j)%sigma = dsqrt(s1 * s2)
287 >          else
288 >             MixingMap(i,j)%sigma = 0.5_dp * (s1 + s2)
289 >          endif
290            
291 <          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
291 >          MixingMap(i,j)%epsilon = dsqrt(e1 * e2)
292  
293 <                myEpsilon_j = ljParameterList%ljParams(j)%lj_epsilon
223 <                mySigma_j = ljParameterList%ljParams(j)%lj_sigma
293 >          MixingMap(i,j)%sigma6 = (MixingMap(i,j)%sigma)**6
294  
295 <                          
296 <                ljMixed(i,j)%sigma  =  &
297 <                     calcLJMix("sigma",mySigma_i, &
298 <                     mySigma_j)
299 <                
300 <                ljMixed(i,j)%sigma6 = &
301 <                     (ljMixed(i,j)%sigma)**6
302 <                
303 <                
304 <                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
295 >          if (MixingMap(i,j)%rCutWasSet) then
296 >             rcut6 = (MixingMap(i,j)%rcut)**6
297 >          else
298 >             if (haveDefaultCutoff) then
299 >                rcut6 = defaultCutoff**6
300 >                doShift = defaultShift
301 >             else
302 >                call handleError("LJ", "No specified or default cutoff value!")
303 >             endif
304 >          endif
305            
306 <          end do
307 <    end do
306 >          tp6    = MixingMap(i,j)%sigma6/rcut6
307 >          tp12    = tp6**2          
308 >          MixingMap(i,j)%delta =-4.0_DP*MixingMap(i,j)%epsilon*(tp12 - tp6)
309 >          MixingMap(i,j)%shiftedPot = doShift
310 >
311 >          if (i.ne.j) then
312 >             MixingMap(j,i)%sigma      = MixingMap(i,j)%sigma
313 >             MixingMap(j,i)%epsilon    = MixingMap(i,j)%epsilon
314 >             MixingMap(j,i)%sigma6     = MixingMap(i,j)%sigma6
315 >             MixingMap(j,i)%rCut       = MixingMap(i,j)%rCut
316 >             MixingMap(j,i)%delta      = MixingMap(i,j)%delta
317 >             MixingMap(j,i)%rCutWasSet = MixingMap(i,j)%rCutWasSet
318 >             MixingMap(j,i)%shiftedPot = MixingMap(i,j)%shiftedPot
319 >             MixingMap(j,i)%isSoftCore = MixingMap(i,j)%isSoftCore
320 >          endif
321 >
322 >       enddo
323 >    enddo
324      
325 <  end subroutine createMixingList
325 >    haveMixingMap = .true.
326 >    
327 >  end subroutine createMixingMap
328    
329    subroutine do_lj_pair(atom1, atom2, d, rij, r2, sw, vpair, fpair, &
330         pot, f, do_pot)
331  
332      integer, intent(in) ::  atom1, atom2
333 +    integer :: atid1, atid2, ljt1, ljt2
334      real( kind = dp ), intent(in) :: rij, r2
335      real( kind = dp ) :: pot, sw, vpair
336      real( kind = dp ), dimension(3,nLocal) :: f    
# Line 277 | Line 348 | contains
348      real( kind = dp ) :: t6
349      real( kind = dp ) :: t12
350      real( kind = dp ) :: delta
351 <    integer :: id1, id2
351 >    logical :: isSoftCore, shiftedPot
352 >    integer :: id1, id2, localError
353  
354 +    if (.not.haveMixingMap) then
355 +       call createMixingMap()
356 +    endif
357 +
358      ! Look up the correct parameters in the mixing matrix
359   #ifdef IS_MPI
360 <    sigma6   = ljMixed(atid_Row(atom1),atid_Col(atom2))%sigma6
361 <    epsilon  = ljMixed(atid_Row(atom1),atid_Col(atom2))%epsilon
286 <    delta    = ljMixed(atid_Row(atom1),atid_Col(atom2))%delta
360 >    atid1 = atid_Row(atom1)
361 >    atid2 = atid_Col(atom2)
362   #else
363 <    sigma6   = ljMixed(atid(atom1),atid(atom2))%sigma6
364 <    epsilon  = ljMixed(atid(atom1),atid(atom2))%epsilon
290 <    delta    = ljMixed(atid(atom1),atid(atom2))%delta
363 >    atid1 = atid(atom1)
364 >    atid2 = atid(atom2)
365   #endif
366  
367 +    ljt1 = LJMap%atidToLJtype(atid1)
368 +    ljt2 = LJMap%atidToLJtype(atid2)
369 +
370 +    sigma6     = MixingMap(ljt1,ljt2)%sigma6
371 +    epsilon    = MixingMap(ljt1,ljt2)%epsilon
372 +    delta      = MixingMap(ljt1,ljt2)%delta
373 +    isSoftCore = MixingMap(ljt1,ljt2)%isSoftCore
374 +    shiftedPot = MixingMap(ljt1,ljt2)%shiftedPot
375 +
376      r6 = r2 * r2 * r2
377 <    
377 >
378      t6  = sigma6/ r6
379      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
380  
381 <    vpair = vpair + pot_temp
381 >    if (isSoftCore) then
382        
383 <    dudr = sw * 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / rij
383 >       pot_temp = 4.0E0_DP * epsilon * t6
384 >       if (shiftedPot) then
385 >          pot_temp = pot_temp + delta
386 >       endif
387        
388 +       vpair = vpair + pot_temp
389 +      
390 +       dudr = -sw * 24.0E0_DP * epsilon * t6 / rij
391 +      
392 +    else
393 +       pot_temp = 4.0E0_DP * epsilon * (t12 - t6)
394 +       if (shiftedPot) then
395 +          pot_temp = pot_temp + delta
396 +       endif
397 +      
398 +       vpair = vpair + pot_temp
399 +      
400 +       dudr = sw * 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / rij
401 +    endif
402 +
403      drdx = d(1) / rij
404      drdy = d(2) / rij
405      drdz = d(3) / rij
406 <      
406 >
407      fx = dudr * drdx
408      fy = dudr * drdy
409      fz = dudr * drdz
410 <    
315 <      
410 >
411   #ifdef IS_MPI
412      if (do_pot) then
413         pot_Row(atom1) = pot_Row(atom1) + sw*pot_temp*0.5
414         pot_Col(atom2) = pot_Col(atom2) + sw*pot_temp*0.5
415      endif
416 <    
416 >
417      f_Row(1,atom1) = f_Row(1,atom1) + fx
418      f_Row(2,atom1) = f_Row(2,atom1) + fy
419      f_Row(3,atom1) = f_Row(3,atom1) + fz
420 <    
420 >
421      f_Col(1,atom2) = f_Col(1,atom2) - fx
422      f_Col(2,atom2) = f_Col(2,atom2) - fy
423      f_Col(3,atom2) = f_Col(3,atom2) - fz      
424 <    
424 >
425   #else
426      if (do_pot) pot = pot + sw*pot_temp
427  
428      f(1,atom1) = f(1,atom1) + fx
429      f(2,atom1) = f(2,atom1) + fy
430      f(3,atom1) = f(3,atom1) + fz
431 <    
431 >
432      f(1,atom2) = f(1,atom2) - fx
433      f(2,atom2) = f(2,atom2) - fy
434      f(3,atom2) = f(3,atom2) - fz
435   #endif
436 <        
436 >
437   #ifdef IS_MPI
438      id1 = AtomRowToGlobal(atom1)
439      id2 = AtomColToGlobal(atom2)
# Line 348 | Line 443 | contains
443   #endif
444  
445      if (molMembershipList(id1) .ne. molMembershipList(id2)) then
446 <      
446 >
447         fpair(1) = fpair(1) + fx
448         fpair(2) = fpair(2) + fy
449         fpair(3) = fpair(3) + fz
# Line 356 | Line 451 | contains
451      endif
452  
453      return    
454 <    
454 >
455    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
456  
457 <    integer, optional :: status  
457 >  subroutine destroyLJTypes()
458  
459 <    myMixParam = 0.0_dp
459 >    LJMap%nLJtypes = 0
460 >    LJMap%currentLJtype = 0
461      
462 <    if (present(status)) status = 0
463 <    select case (LJ_Mixing_Policy)
464 <    case (1)
465 <       select case (thisParam)
466 <       case ("sigma")
467 <          myMixParam = 0.5_dp * (param1 + param2)
468 <       case ("epsilon")
469 <          myMixParam = sqrt(param1 * param2)
470 <       case default
471 <          status = -1
472 <       end select
473 <    case default
387 <       status = -1
388 <    end select
389 <  end function calcLJMix
390 <  
391 < end module lj
462 >    if (associated(LJMap%LJtypes)) then
463 >       deallocate(LJMap%LJtypes)
464 >       LJMap%LJtypes => null()
465 >    end if
466 >    
467 >    if (associated(LJMap%atidToLJtype)) then
468 >       deallocate(LJMap%atidToLJtype)
469 >       LJMap%atidToLJtype => null()
470 >    end if
471 >    
472 >    haveMixingMap = .false.
473 >  end subroutine destroyLJTypes
474  
475 < 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 <
475 > end module lj

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines