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 2204 by gezelter, Fri Apr 15 22:04:00 2005 UTC vs.
Revision 2497 by chuckv, Wed Dec 7 19:58:18 2005 UTC

# Line 43 | Line 43
43   !! Calculates Long Range forces Lennard-Jones interactions.
44   !! @author Charles F. Vardeman II
45   !! @author Matthew Meineke
46 < !! @version $Id: LJ.F90,v 1.11 2005-04-15 22:03:47 gezelter Exp $, $Date: 2005-04-15 22:03:47 $, $Name: not supported by cvs2svn $, $Revision: 1.11 $
46 > !! @version $Id: LJ.F90,v 1.20 2005-12-07 19:58:18 chuckv Exp $, $Date: 2005-12-07 19:58:18 $, $Name: not supported by cvs2svn $, $Revision: 1.20 $
47  
48  
49   module lj
50    use atype_module
51  use switcheroo
51    use vector_class
52    use simulation
53    use status
54 +  use fForceOptions
55   #ifdef IS_MPI
56    use mpiSimulation
57   #endif
# Line 59 | Line 59 | module lj
59  
60    implicit none
61    PRIVATE
62 + #define __FORTRAN90
63 + #include "UseTheForce/DarkSide/fInteractionMap.h"
64  
65    integer, parameter :: DP = selected_real_kind(15)
66  
67 <  type, private :: LjType
68 <     integer :: c_ident
69 <     integer :: atid
67 >  logical, save :: useGeometricDistanceMixing = .false.
68 >  logical, save :: haveMixingMap = .false.
69 >
70 >  real(kind=DP), save :: defaultCutoff = 0.0_DP
71 >  logical, save :: defaultShift = .false.
72 >  logical, save :: haveDefaultCutoff = .false.
73 >
74 >
75 >  type, private :: LJtype
76 >     integer       :: atid
77       real(kind=dp) :: sigma
78       real(kind=dp) :: epsilon
79 <     logical :: soft_pot
80 <  end type LjType
79 >     logical       :: isSoftCore = .false.
80 >  end type LJtype
81  
82 <  type(LjType), dimension(:), allocatable :: ParameterMap
82 >  type, private :: LJList
83 >     integer               :: Nljtypes = 0
84 >     integer               :: currentLJtype = 0
85 >     type(LJtype), pointer :: LJtypes(:)      => null()
86 >     integer, pointer      :: atidToLJtype(:) => null()
87 >  end type LJList
88  
89 <  logical, save :: haveMixingMap = .false.
89 >  type(LJList), save :: LJMap
90  
91    type :: MixParameters
92       real(kind=DP) :: sigma
93       real(kind=DP) :: epsilon
94 <     real(kind=dp)  :: sigma6
95 <     real(kind=dp)  :: tp6
96 <     real(kind=dp)  :: tp12
97 <     real(kind=dp)  :: delta
98 <     logical :: soft_pot    
94 >     real(kind=dp) :: sigma6
95 >     real(kind=dp) :: rCut
96 >     real(kind=dp) :: delta
97 >     logical       :: rCutWasSet = .false.
98 >     logical       :: shiftedPot
99 >     logical       :: isSoftCore = .false.
100    end type MixParameters
101  
102    type(MixParameters), dimension(:,:), allocatable :: MixingMap
103  
104 <  real(kind=DP), save :: LJ_rcut
105 <  logical, save :: have_rcut = .false.
91 <  logical, save :: LJ_do_shift = .false.
92 <  logical, save :: useGeometricDistanceMixing = .false.
93 <
94 <  !! Public methods and data
95 <
96 <  public :: setCutoffLJ
97 <  public :: useGeometricMixing
98 <  public :: do_lj_pair
99 <  public :: newLJtype  
104 >  public :: newLJtype
105 >  public :: setLJDefaultCutoff
106    public :: getSigma
107    public :: getEpsilon
108 <  public :: destroyLJTypes
108 >  public :: do_lj_pair
109 >  public :: destroyLJtypes
110  
111   contains
112  
113 <  subroutine newLJtype(c_ident, sigma, epsilon, soft_pot, status)
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) :: soft_pot
117 >    integer, intent(in) :: isSoftCore
118      integer,intent(out) :: status
119 <    integer :: nATypes, myATID
119 >    integer :: nLJTypes, ntypes, myATID
120      integer, pointer :: MatchList(:) => null()
121 +    integer :: current
122  
123      status = 0
124 +    ! check to see if this is the first time into this routine...
125 +    if (.not.associated(LJMap%LJtypes)) then
126  
127 <    myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
127 >       call getMatchingElementList(atypes, "is_LennardJones", .true., &
128 >            nLJTypes, MatchList)
129 >      
130 >       LJMap%nLJtypes =  nLJTypes
131  
132 <    if (.not.allocated(ParameterMap)) then
132 >       allocate(LJMap%LJtypes(nLJTypes))
133  
134 <       !call getMatchingElementList(atypes, "is_LennardJones", .true., &
122 <       !     nLJTypes, MatchList)
123 <       nAtypes = getSize(atypes)
124 <       if (nAtypes == 0) then
125 <          status = -1
126 <          return
127 <       end if
134 >       ntypes = getSize(atypes)
135  
136 <       if (.not. allocated(ParameterMap)) then
130 <          allocate(ParameterMap(nAtypes))
131 <       endif
132 <
136 >       allocate(LJMap%atidToLJtype(ntypes))
137      end if
138  
139 <    if (myATID .gt. size(ParameterMap)) then
140 <       status = -1
137 <       return
138 <    endif
139 >    LJMap%currentLJtype = LJMap%currentLJtype + 1
140 >    current = LJMap%currentLJtype
141  
142 <    ! set the values for ParameterMap for this atom type:
143 <
144 <    ParameterMap(myATID)%c_ident = c_ident
145 <    ParameterMap(myATID)%atid = myATID
146 <    ParameterMap(myATID)%epsilon = epsilon
147 <    ParameterMap(myATID)%sigma = sigma
148 <    if (soft_pot == 1) then
147 <       ParameterMap(myATID)%soft_pot = .true.
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 <       ParameterMap(myATID)%soft_pot = .false.
150 >       LJMap%LJtypes(current)%isSoftCore = .false.
151      endif
152    end subroutine newLJtype
153  
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 +    !we only want to build LJ Mixing map if LJ is being used.
161 +    if(LJMap%nLJTypes /= 0) then
162 +       call createMixingMap()
163 +    end if
164 +  end subroutine setLJDefaultCutoff
165 +
166    function getSigma(atid) result (s)
167      integer, intent(in) :: atid
168 <    integer :: localError
168 >    integer :: ljt1
169      real(kind=dp) :: s
170  
171 <    if (.not.allocated(ParameterMap)) then
172 <       call handleError("LJ", "no ParameterMap was present before first call of getSigma!")
171 >    if (LJMap%currentLJtype == 0) then
172 >       call handleError("LJ", "No members in LJMap")
173         return
174      end if
175  
176 <    s = ParameterMap(atid)%sigma
176 >    ljt1 = LJMap%atidToLJtype(atid)
177 >    s = LJMap%LJtypes(ljt1)%sigma
178 >
179    end function getSigma
180  
181    function getEpsilon(atid) result (e)
182      integer, intent(in) :: atid
183 <    integer :: localError
183 >    integer :: ljt1
184      real(kind=dp) :: e
185  
186 <    if (.not.allocated(ParameterMap)) then
187 <       call handleError("LJ", "no ParameterMap was present before first call of getEpsilon!")
186 >    if (LJMap%currentLJtype == 0) then
187 >       call handleError("LJ", "No members in LJMap")
188         return
189      end if
190  
191 <    e = ParameterMap(atid)%epsilon
191 >    ljt1 = LJMap%atidToLJtype(atid)
192 >    e = LJMap%LJtypes(ljt1)%epsilon
193 >
194    end function getEpsilon
195  
196 +  subroutine createMixingMap()
197 +    integer :: nLJtypes, i, j
198 +    real ( kind = dp ) :: s1, s2, e1, e2
199 +    real ( kind = dp ) :: rcut6, tp6, tp12
200 +    logical :: isSoftCore1, isSoftCore2, doShift
201  
202 <  subroutine setCutoffLJ(rcut, do_shift, status)
203 <    logical, intent(in):: do_shift
204 <    integer :: status, myStatus
205 <    real(kind=dp) :: rcut
202 >    if (LJMap%currentLJtype == 0) then
203 >       call handleError("LJ", "No members in LJMap")
204 >       return
205 >    end if
206  
207 < #define __FORTRAN90
186 < #include "UseTheForce/fSwitchingFunction.h"
207 >    nLJtypes = LJMap%nLJtypes
208  
209 <    status = 0
209 >    if (.not. allocated(MixingMap)) then
210 >       allocate(MixingMap(nLJtypes, nLJtypes))
211 >    endif
212  
213 <    LJ_rcut = rcut
214 <    LJ_do_shift = do_shift
192 <    call set_switch(LJ_SWITCH, rcut, rcut)
193 <    have_rcut = .true.
213 >    useGeometricDistanceMixing = usesGeometricDistanceMixing()
214 >    do i = 1, nLJtypes
215  
216 <    return
217 <  end subroutine setCutoffLJ
216 >       s1 = LJMap%LJtypes(i)%sigma
217 >       e1 = LJMap%LJtypes(i)%epsilon
218 >       isSoftCore1 = LJMap%LJtypes(i)%isSoftCore
219  
220 <  subroutine useGeometricMixing()
221 <    useGeometricDistanceMixing = .true.
222 <    haveMixingMap = .false.
223 <    return
224 <  end subroutine useGeometricMixing
220 >       do j = i, nLJtypes
221 >          
222 >          s2 = LJMap%LJtypes(j)%sigma
223 >          e2 = LJMap%LJtypes(j)%epsilon
224 >          isSoftCore2 = LJMap%LJtypes(j)%isSoftCore
225 >          
226 >          MixingMap(i,j)%isSoftCore = isSoftCore1 .or. isSoftCore2
227  
228 <  subroutine createMixingMap(status)
229 <    integer :: nATIDs
230 <    integer :: status
231 <    integer :: i
232 <    integer :: j
233 <    real ( kind = dp ) :: Sigma_i, Sigma_j
234 <    real ( kind = dp ) :: Epsilon_i, Epsilon_j
235 <    real ( kind = dp ) :: rcut6
212 <    logical :: i_is_LJ, j_is_LJ
228 >          ! only the distance parameter uses different mixing policies
229 >          if (useGeometricDistanceMixing) then
230 >             MixingMap(i,j)%sigma = dsqrt(s1 * s2)
231 >          else
232 >             MixingMap(i,j)%sigma = 0.5_dp * (s1 + s2)
233 >          endif
234 >          
235 >          MixingMap(i,j)%epsilon = dsqrt(e1 * e2)
236  
237 <    status = 0
237 >          MixingMap(i,j)%sigma6 = (MixingMap(i,j)%sigma)**6
238  
239 <    if (.not. allocated(ParameterMap)) then
240 <       call handleError("LJ", "no ParameterMap was present before call of createMixingMap!")
241 <       status = -1
242 <       return
243 <    endif
239 >          if (haveDefaultCutoff) then
240 >             rcut6 = defaultCutoff**6
241 >             tp6    = MixingMap(i,j)%sigma6/rcut6
242 >             tp12    = tp6**2          
243 >             MixingMap(i,j)%delta =-4.0_DP*MixingMap(i,j)%epsilon*(tp12 - tp6)
244 >             MixingMap(i,j)%shiftedPot = defaultShift
245 >          else
246 >             MixingMap(i,j)%delta = 0.0_DP
247 >             MixingMap(i,j)%shiftedPot = defaultShift
248 >          endif          
249  
250 <    nATIDs = size(ParameterMap)
250 >          if (i.ne.j) then
251 >             MixingMap(j,i)%sigma      = MixingMap(i,j)%sigma
252 >             MixingMap(j,i)%epsilon    = MixingMap(i,j)%epsilon
253 >             MixingMap(j,i)%sigma6     = MixingMap(i,j)%sigma6
254 >             MixingMap(j,i)%rCut       = MixingMap(i,j)%rCut
255 >             MixingMap(j,i)%delta      = MixingMap(i,j)%delta
256 >             MixingMap(j,i)%rCutWasSet = MixingMap(i,j)%rCutWasSet
257 >             MixingMap(j,i)%shiftedPot = MixingMap(i,j)%shiftedPot
258 >             MixingMap(j,i)%isSoftCore = MixingMap(i,j)%isSoftCore
259 >          endif
260  
261 <    if (nATIDs == 0) then
262 <       status = -1
263 <       return
227 <    end if
228 <
229 <    if (.not. allocated(MixingMap)) then
230 <       allocate(MixingMap(nATIDs, nATIDs))
231 <    endif
232 <
233 <    if (.not.have_rcut) then
234 <       status = -1
235 <       return
236 <    endif
237 <
238 <    rcut6 = LJ_rcut**6
239 <
240 <    ! This loops through all atypes, even those that don't support LJ forces.
241 <    do i = 1, nATIDs
242 <       call getElementProperty(atypes, i, "is_LennardJones", i_is_LJ)
243 <       if (i_is_LJ) then
244 <          Epsilon_i = ParameterMap(i)%epsilon
245 <          Sigma_i = ParameterMap(i)%sigma
246 <
247 <          ! do self mixing rule
248 <          MixingMap(i,i)%sigma   = Sigma_i          
249 <          MixingMap(i,i)%sigma6  = Sigma_i ** 6          
250 <          MixingMap(i,i)%tp6     = (MixingMap(i,i)%sigma6)/rcut6          
251 <          MixingMap(i,i)%tp12    = (MixingMap(i,i)%tp6) ** 2
252 <          MixingMap(i,i)%epsilon = Epsilon_i          
253 <          MixingMap(i,i)%delta   = -4.0_DP * MixingMap(i,i)%epsilon * &
254 <               (MixingMap(i,i)%tp12 - MixingMap(i,i)%tp6)
255 <          MixingMap(i,i)%soft_pot = ParameterMap(i)%soft_pot
256 <
257 <          do j = i + 1, nATIDs
258 <             call getElementProperty(atypes, j, "is_LennardJones", j_is_LJ)
259 <
260 <             if (j_is_LJ) then
261 <                Epsilon_j = ParameterMap(j)%epsilon
262 <                Sigma_j = ParameterMap(j)%sigma
263 <
264 <                ! only the distance parameter uses different mixing policies
265 <                if (useGeometricDistanceMixing) then
266 <                   ! only for OPLS as far as we can tell
267 <                   MixingMap(i,j)%sigma = dsqrt(Sigma_i * Sigma_j)
268 <                else
269 <                   ! everyone else
270 <                   MixingMap(i,j)%sigma = 0.5_dp * (Sigma_i + Sigma_j)
271 <                endif
272 <
273 <                ! energy parameter is always geometric mean:
274 <                MixingMap(i,j)%epsilon = dsqrt(Epsilon_i * Epsilon_j)
275 <
276 <                MixingMap(i,j)%sigma6 = (MixingMap(i,j)%sigma)**6
277 <                MixingMap(i,j)%tp6    = MixingMap(i,j)%sigma6/rcut6
278 <                MixingMap(i,j)%tp12    = (MixingMap(i,j)%tp6) ** 2
279 <
280 <                MixingMap(i,j)%delta = -4.0_DP * MixingMap(i,j)%epsilon * &
281 <                     (MixingMap(i,j)%tp12 - MixingMap(i,j)%tp6)
282 <
283 <                MixingMap(i,j)%soft_pot = ParameterMap(i)%soft_pot .or. ParameterMap(j)%soft_pot
284 <
285 <
286 <                MixingMap(j,i)%sigma   = MixingMap(i,j)%sigma
287 <                MixingMap(j,i)%sigma6  = MixingMap(i,j)%sigma6
288 <                MixingMap(j,i)%tp6     = MixingMap(i,j)%tp6
289 <                MixingMap(j,i)%tp12    = MixingMap(i,j)%tp12
290 <                MixingMap(j,i)%epsilon = MixingMap(i,j)%epsilon
291 <                MixingMap(j,i)%delta   = MixingMap(i,j)%delta
292 <                MixingMap(j,i)%soft_pot   = MixingMap(i,j)%soft_pot
293 <             endif
294 <          end do
295 <       endif
296 <    end do
297 <
261 >       enddo
262 >    enddo
263 >    
264      haveMixingMap = .true.
265 <
265 >    
266    end subroutine createMixingMap
267 <
268 <  subroutine do_lj_pair(atom1, atom2, d, rij, r2, sw, vpair, fpair, &
267 >  
268 >  subroutine do_lj_pair(atom1, atom2, d, rij, r2, rcut, sw, vpair, fpair, &
269         pot, f, do_pot)
270 <
270 >    
271      integer, intent(in) ::  atom1, atom2
272 <    real( kind = dp ), intent(in) :: rij, r2
272 >    integer :: atid1, atid2, ljt1, ljt2
273 >    real( kind = dp ), intent(in) :: rij, r2, rcut
274      real( kind = dp ) :: pot, sw, vpair
275      real( kind = dp ), dimension(3,nLocal) :: f    
276      real( kind = dp ), intent(in), dimension(3) :: d
# Line 316 | Line 283 | contains
283      real( kind = dp ) :: pot_temp, dudr
284      real( kind = dp ) :: sigma6
285      real( kind = dp ) :: epsilon
286 <    real( kind = dp ) :: r6
287 <    real( kind = dp ) :: t6
288 <    real( kind = dp ) :: t12
286 >    real( kind = dp ) :: r6, rc6
287 >    real( kind = dp ) :: t6, tp6
288 >    real( kind = dp ) :: t12, tp12
289      real( kind = dp ) :: delta
290 <    logical :: soft_pot
290 >    logical :: isSoftCore, shiftedPot
291      integer :: id1, id2, localError
292  
293      if (.not.haveMixingMap) then
294 <       localError = 0
328 <       call createMixingMap(localError)
329 <       if ( localError .ne. 0 ) then
330 <          call handleError("LJ", "MixingMap creation failed!")
331 <          return
332 <       end if
294 >       call createMixingMap()
295      endif
296  
297      ! Look up the correct parameters in the mixing matrix
298   #ifdef IS_MPI
299 <    sigma6   = MixingMap(atid_Row(atom1),atid_Col(atom2))%sigma6
300 <    epsilon  = MixingMap(atid_Row(atom1),atid_Col(atom2))%epsilon
339 <    delta    = MixingMap(atid_Row(atom1),atid_Col(atom2))%delta
340 <    soft_pot =  MixingMap(atid_Row(atom1),atid_Col(atom2))%soft_pot
299 >    atid1 = atid_Row(atom1)
300 >    atid2 = atid_Col(atom2)
301   #else
302 <    sigma6   = MixingMap(atid(atom1),atid(atom2))%sigma6
303 <    epsilon  = MixingMap(atid(atom1),atid(atom2))%epsilon
344 <    delta    = MixingMap(atid(atom1),atid(atom2))%delta
345 <    soft_pot    = MixingMap(atid(atom1),atid(atom2))%soft_pot
302 >    atid1 = atid(atom1)
303 >    atid2 = atid(atom2)
304   #endif
305  
306 +    ljt1 = LJMap%atidToLJtype(atid1)
307 +    ljt2 = LJMap%atidToLJtype(atid2)
308 +
309 +    sigma6     = MixingMap(ljt1,ljt2)%sigma6
310 +    epsilon    = MixingMap(ljt1,ljt2)%epsilon
311 +    delta      = MixingMap(ljt1,ljt2)%delta
312 +    isSoftCore = MixingMap(ljt1,ljt2)%isSoftCore
313 +    shiftedPot = MixingMap(ljt1,ljt2)%shiftedPot
314 +
315      r6 = r2 * r2 * r2
316  
317      t6  = sigma6/ r6
318      t12 = t6 * t6    
319  
320 <    if (soft_pot) then
321 <       pot_temp = 4.0E0_DP * epsilon * t12
322 <       if (LJ_do_shift) then
320 >    if (isSoftCore) then
321 >      
322 >       pot_temp = 4.0E0_DP * epsilon * t6
323 >       if (shiftedPot) then
324 >          rc6 = rcut**6
325 >          tp6 = sigma6 / rc6
326 >          delta =-4.0_DP*epsilon*(tp6)
327            pot_temp = pot_temp + delta
328         endif
329 <
329 >      
330         vpair = vpair + pot_temp
331 <
332 <       dudr = sw * 24.0E0_DP * epsilon * (-2.0E0_DP)*t12 / rij
333 <
331 >      
332 >       dudr = -sw * 24.0E0_DP * epsilon * t6 / rij
333 >      
334      else
335         pot_temp = 4.0E0_DP * epsilon * (t12 - t6)
336 <       if (LJ_do_shift) then
336 >       if (shiftedPot) then
337 >          rc6 = rcut**6
338 >          tp6 = sigma6 / rc6
339 >          tp12 = tp6*tp6
340 >          delta =-4.0_DP*epsilon*(tp12 - tp6)
341            pot_temp = pot_temp + delta
342         endif
343 <
343 >      
344         vpair = vpair + pot_temp
345 <
345 >      
346         dudr = sw * 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / rij
347      endif
348  
# Line 379 | Line 354 | contains
354      fy = dudr * drdy
355      fz = dudr * drdz
356  
382
357   #ifdef IS_MPI
358      if (do_pot) then
359 <       pot_Row(atom1) = pot_Row(atom1) + sw*pot_temp*0.5
360 <       pot_Col(atom2) = pot_Col(atom2) + sw*pot_temp*0.5
359 >       pot_Row(VDW_POT,atom1) = pot_Row(VDW_POT,atom1) + sw*pot_temp*0.5
360 >       pot_Col(VDW_POT,atom2) = pot_Col(VDW_POT,atom2) + sw*pot_temp*0.5
361      endif
362  
363      f_Row(1,atom1) = f_Row(1,atom1) + fx
# Line 427 | Line 401 | contains
401    end subroutine do_lj_pair
402  
403    subroutine destroyLJTypes()
404 <    if(allocated(ParameterMap)) deallocate(ParameterMap)
405 <    if(allocated(MixingMap)) deallocate(MixingMap)
404 >
405 >    LJMap%nLJtypes = 0
406 >    LJMap%currentLJtype = 0
407 >    
408 >    if (associated(LJMap%LJtypes)) then
409 >       deallocate(LJMap%LJtypes)
410 >       LJMap%LJtypes => null()
411 >    end if
412 >    
413 >    if (associated(LJMap%atidToLJtype)) then
414 >       deallocate(LJMap%atidToLJtype)
415 >       LJMap%atidToLJtype => null()
416 >    end if
417 >    
418      haveMixingMap = .false.
419    end subroutine destroyLJTypes
420  
435
421   end module lj

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines