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 2461 by gezelter, Mon Nov 21 22:59:02 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.19 2005-11-21 22:59:01 gezelter Exp $, $Date: 2005-11-21 22:59:01 $, $Name: not supported by cvs2svn $, $Revision: 1.19 $
47  
48  
49   module lj
50    use atype_module
51  use switcheroo
51    use vector_class
52    use simulation
53    use status
# Line 59 | Line 58 | module lj
58  
59    implicit none
60    PRIVATE
61 + #define __FORTRAN90
62 + #include "UseTheForce/DarkSide/fInteractionMap.h"
63  
64    integer, parameter :: DP = selected_real_kind(15)
65  
66 <  type, private :: LjType
67 <     integer :: c_ident
68 <     integer :: atid
66 >  logical, save :: useGeometricDistanceMixing = .false.
67 >  logical, save :: haveMixingMap = .false.
68 >
69 >  real(kind=DP), save :: defaultCutoff = 0.0_DP
70 >  logical, save :: defaultShift = .false.
71 >  logical, save :: haveDefaultCutoff = .false.
72 >
73 >
74 >  type, private :: LJtype
75 >     integer       :: atid
76       real(kind=dp) :: sigma
77       real(kind=dp) :: epsilon
78 <     logical :: soft_pot
79 <  end type LjType
78 >     logical       :: isSoftCore = .false.
79 >  end type LJtype
80  
81 <  type(LjType), dimension(:), allocatable :: ParameterMap
81 >  type, private :: LJList
82 >     integer               :: Nljtypes = 0
83 >     integer               :: currentLJtype = 0
84 >     type(LJtype), pointer :: LJtypes(:)      => null()
85 >     integer, pointer      :: atidToLJtype(:) => null()
86 >  end type LJList
87  
88 <  logical, save :: haveMixingMap = .false.
88 >  type(LJList), save :: LJMap
89  
90    type :: MixParameters
91       real(kind=DP) :: sigma
92       real(kind=DP) :: epsilon
93 <     real(kind=dp)  :: sigma6
94 <     real(kind=dp)  :: tp6
95 <     real(kind=dp)  :: tp12
96 <     real(kind=dp)  :: delta
97 <     logical :: soft_pot    
93 >     real(kind=dp) :: sigma6
94 >     real(kind=dp) :: rCut
95 >     real(kind=dp) :: delta
96 >     logical       :: rCutWasSet = .false.
97 >     logical       :: shiftedPot
98 >     logical       :: isSoftCore = .false.
99    end type MixParameters
100  
101    type(MixParameters), dimension(:,:), allocatable :: MixingMap
102  
103 <  real(kind=DP), save :: LJ_rcut
104 <  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  
103 >  public :: newLJtype
104 >  public :: setLJDefaultCutoff
105    public :: getSigma
106    public :: getEpsilon
107 <  public :: destroyLJTypes
107 >  public :: useGeometricMixing
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  
179
180  subroutine setCutoffLJ(rcut, do_shift, status)
181    logical, intent(in):: do_shift
182    integer :: status, myStatus
183    real(kind=dp) :: rcut
184
185 #define __FORTRAN90
186 #include "UseTheForce/fSwitchingFunction.h"
187
188    status = 0
189
190    LJ_rcut = rcut
191    LJ_do_shift = do_shift
192    call set_switch(LJ_SWITCH, rcut, rcut)
193    have_rcut = .true.
194
195    return
196  end subroutine setCutoffLJ
197
196    subroutine useGeometricMixing()
197      useGeometricDistanceMixing = .true.
198      haveMixingMap = .false.
199      return
200    end subroutine useGeometricMixing
201  
202 <  subroutine createMixingMap(status)
203 <    integer :: nATIDs
204 <    integer :: status
205 <    integer :: i
206 <    integer :: j
209 <    real ( kind = dp ) :: Sigma_i, Sigma_j
210 <    real ( kind = dp ) :: Epsilon_i, Epsilon_j
211 <    real ( kind = dp ) :: rcut6
212 <    logical :: i_is_LJ, j_is_LJ
202 >  subroutine createMixingMap()
203 >    integer :: nLJtypes, i, j
204 >    real ( kind = dp ) :: s1, s2, e1, e2
205 >    real ( kind = dp ) :: rcut6, tp6, tp12
206 >    logical :: isSoftCore1, isSoftCore2, doShift
207  
208 <    status = 0
209 <
216 <    if (.not. allocated(ParameterMap)) then
217 <       call handleError("LJ", "no ParameterMap was present before call of createMixingMap!")
218 <       status = -1
208 >    if (LJMap%currentLJtype == 0) then
209 >       call handleError("LJ", "No members in LJMap")
210         return
220    endif
221
222    nATIDs = size(ParameterMap)
223
224    if (nATIDs == 0) then
225       status = -1
226       return
211      end if
212  
213 +    nLJtypes = LJMap%nLJtypes
214 +
215      if (.not. allocated(MixingMap)) then
216 <       allocate(MixingMap(nATIDs, nATIDs))
216 >       allocate(MixingMap(nLJtypes, nLJtypes))
217      endif
218  
219 <    if (.not.have_rcut) then
234 <       status = -1
235 <       return
236 <    endif
219 >    do i = 1, nLJtypes
220  
221 <    rcut6 = LJ_rcut**6
222 <
223 <    ! 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
221 >       s1 = LJMap%LJtypes(i)%sigma
222 >       e1 = LJMap%LJtypes(i)%epsilon
223 >       isSoftCore1 = LJMap%LJtypes(i)%isSoftCore
224  
225 <          ! do self mixing rule
226 <          MixingMap(i,i)%sigma   = Sigma_i          
227 <          MixingMap(i,i)%sigma6  = Sigma_i ** 6          
228 <          MixingMap(i,i)%tp6     = (MixingMap(i,i)%sigma6)/rcut6          
229 <          MixingMap(i,i)%tp12    = (MixingMap(i,i)%tp6) ** 2
230 <          MixingMap(i,i)%epsilon = Epsilon_i          
231 <          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
225 >       do j = i, nLJtypes
226 >          
227 >          s2 = LJMap%LJtypes(j)%sigma
228 >          e2 = LJMap%LJtypes(j)%epsilon
229 >          isSoftCore2 = LJMap%LJtypes(j)%isSoftCore
230 >          
231 >          MixingMap(i,j)%isSoftCore = isSoftCore1 .or. isSoftCore2
232  
233 <          do j = i + 1, nATIDs
234 <             call getElementProperty(atypes, j, "is_LennardJones", j_is_LJ)
233 >          ! only the distance parameter uses different mixing policies
234 >          if (useGeometricDistanceMixing) then
235 >             MixingMap(i,j)%sigma = dsqrt(s1 * s2)
236 >          else
237 >             MixingMap(i,j)%sigma = 0.5_dp * (s1 + s2)
238 >          endif
239 >          
240 >          MixingMap(i,j)%epsilon = dsqrt(e1 * e2)
241  
242 <             if (j_is_LJ) then
261 <                Epsilon_j = ParameterMap(j)%epsilon
262 <                Sigma_j = ParameterMap(j)%sigma
242 >          MixingMap(i,j)%sigma6 = (MixingMap(i,j)%sigma)**6
243  
244 <                ! only the distance parameter uses different mixing policies
245 <                if (useGeometricDistanceMixing) then
246 <                   ! only for OPLS as far as we can tell
247 <                   MixingMap(i,j)%sigma = dsqrt(Sigma_i * Sigma_j)
248 <                else
249 <                   ! everyone else
250 <                   MixingMap(i,j)%sigma = 0.5_dp * (Sigma_i + Sigma_j)
251 <                endif
244 >          if (haveDefaultCutoff) then
245 >             rcut6 = defaultCutoff**6
246 >             tp6    = MixingMap(i,j)%sigma6/rcut6
247 >             tp12    = tp6**2          
248 >             MixingMap(i,j)%delta =-4.0_DP*MixingMap(i,j)%epsilon*(tp12 - tp6)
249 >             MixingMap(i,j)%shiftedPot = defaultShift
250 >          else
251 >             MixingMap(i,j)%delta = 0.0_DP
252 >             MixingMap(i,j)%shiftedPot = defaultShift
253 >          endif          
254  
255 <                ! energy parameter is always geometric mean:
256 <                MixingMap(i,j)%epsilon = dsqrt(Epsilon_i * Epsilon_j)
255 >          if (i.ne.j) then
256 >             MixingMap(j,i)%sigma      = MixingMap(i,j)%sigma
257 >             MixingMap(j,i)%epsilon    = MixingMap(i,j)%epsilon
258 >             MixingMap(j,i)%sigma6     = MixingMap(i,j)%sigma6
259 >             MixingMap(j,i)%rCut       = MixingMap(i,j)%rCut
260 >             MixingMap(j,i)%delta      = MixingMap(i,j)%delta
261 >             MixingMap(j,i)%rCutWasSet = MixingMap(i,j)%rCutWasSet
262 >             MixingMap(j,i)%shiftedPot = MixingMap(i,j)%shiftedPot
263 >             MixingMap(j,i)%isSoftCore = MixingMap(i,j)%isSoftCore
264 >          endif
265  
266 <                MixingMap(i,j)%sigma6 = (MixingMap(i,j)%sigma)**6
267 <                MixingMap(i,j)%tp6    = MixingMap(i,j)%sigma6/rcut6
268 <                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 <
266 >       enddo
267 >    enddo
268 >    
269      haveMixingMap = .true.
270 <
270 >    
271    end subroutine createMixingMap
272 <
273 <  subroutine do_lj_pair(atom1, atom2, d, rij, r2, sw, vpair, fpair, &
272 >  
273 >  subroutine do_lj_pair(atom1, atom2, d, rij, r2, rcut, sw, vpair, fpair, &
274         pot, f, do_pot)
275 <
275 >    
276      integer, intent(in) ::  atom1, atom2
277 <    real( kind = dp ), intent(in) :: rij, r2
277 >    integer :: atid1, atid2, ljt1, ljt2
278 >    real( kind = dp ), intent(in) :: rij, r2, rcut
279      real( kind = dp ) :: pot, sw, vpair
280      real( kind = dp ), dimension(3,nLocal) :: f    
281      real( kind = dp ), intent(in), dimension(3) :: d
# Line 316 | Line 288 | contains
288      real( kind = dp ) :: pot_temp, dudr
289      real( kind = dp ) :: sigma6
290      real( kind = dp ) :: epsilon
291 <    real( kind = dp ) :: r6
292 <    real( kind = dp ) :: t6
293 <    real( kind = dp ) :: t12
291 >    real( kind = dp ) :: r6, rc6
292 >    real( kind = dp ) :: t6, tp6
293 >    real( kind = dp ) :: t12, tp12
294      real( kind = dp ) :: delta
295 <    logical :: soft_pot
295 >    logical :: isSoftCore, shiftedPot
296      integer :: id1, id2, localError
297  
298      if (.not.haveMixingMap) then
299 <       localError = 0
328 <       call createMixingMap(localError)
329 <       if ( localError .ne. 0 ) then
330 <          call handleError("LJ", "MixingMap creation failed!")
331 <          return
332 <       end if
299 >       call createMixingMap()
300      endif
301  
302      ! Look up the correct parameters in the mixing matrix
303   #ifdef IS_MPI
304 <    sigma6   = MixingMap(atid_Row(atom1),atid_Col(atom2))%sigma6
305 <    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
304 >    atid1 = atid_Row(atom1)
305 >    atid2 = atid_Col(atom2)
306   #else
307 <    sigma6   = MixingMap(atid(atom1),atid(atom2))%sigma6
308 <    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
307 >    atid1 = atid(atom1)
308 >    atid2 = atid(atom2)
309   #endif
310  
311 +    ljt1 = LJMap%atidToLJtype(atid1)
312 +    ljt2 = LJMap%atidToLJtype(atid2)
313 +
314 +    sigma6     = MixingMap(ljt1,ljt2)%sigma6
315 +    epsilon    = MixingMap(ljt1,ljt2)%epsilon
316 +    delta      = MixingMap(ljt1,ljt2)%delta
317 +    isSoftCore = MixingMap(ljt1,ljt2)%isSoftCore
318 +    shiftedPot = MixingMap(ljt1,ljt2)%shiftedPot
319 +
320      r6 = r2 * r2 * r2
321  
322      t6  = sigma6/ r6
323      t12 = t6 * t6    
324  
325 <    if (soft_pot) then
326 <       pot_temp = 4.0E0_DP * epsilon * t12
327 <       if (LJ_do_shift) then
325 >    if (isSoftCore) then
326 >      
327 >       pot_temp = 4.0E0_DP * epsilon * t6
328 >       if (shiftedPot) then
329 >          rc6 = rcut**6
330 >          tp6 = sigma6 / rc6
331 >          delta =-4.0_DP*epsilon*(tp6)
332            pot_temp = pot_temp + delta
333         endif
334 <
334 >      
335         vpair = vpair + pot_temp
336 <
337 <       dudr = sw * 24.0E0_DP * epsilon * (-2.0E0_DP)*t12 / rij
338 <
336 >      
337 >       dudr = -sw * 24.0E0_DP * epsilon * t6 / rij
338 >      
339      else
340         pot_temp = 4.0E0_DP * epsilon * (t12 - t6)
341 <       if (LJ_do_shift) then
341 >       if (shiftedPot) then
342 >          rc6 = rcut**6
343 >          tp6 = sigma6 / rc6
344 >          tp12 = tp6*tp6
345 >          delta =-4.0_DP*epsilon*(tp12 - tp6)
346            pot_temp = pot_temp + delta
347         endif
348 <
348 >      
349         vpair = vpair + pot_temp
350 <
350 >      
351         dudr = sw * 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / rij
352      endif
353  
# Line 379 | Line 359 | contains
359      fy = dudr * drdy
360      fz = dudr * drdz
361  
382
362   #ifdef IS_MPI
363      if (do_pot) then
364 <       pot_Row(atom1) = pot_Row(atom1) + sw*pot_temp*0.5
365 <       pot_Col(atom2) = pot_Col(atom2) + sw*pot_temp*0.5
364 >       pot_Row(VDW_POT,atom1) = pot_Row(VDW_POT,atom1) + sw*pot_temp*0.5
365 >       pot_Col(VDW_POT,atom2) = pot_Col(VDW_POT,atom2) + sw*pot_temp*0.5
366      endif
367  
368      f_Row(1,atom1) = f_Row(1,atom1) + fx
# Line 427 | Line 406 | contains
406    end subroutine do_lj_pair
407  
408    subroutine destroyLJTypes()
409 <    if(allocated(ParameterMap)) deallocate(ParameterMap)
410 <    if(allocated(MixingMap)) deallocate(MixingMap)
409 >
410 >    LJMap%nLJtypes = 0
411 >    LJMap%currentLJtype = 0
412 >    
413 >    if (associated(LJMap%LJtypes)) then
414 >       deallocate(LJMap%LJtypes)
415 >       LJMap%LJtypes => null()
416 >    end if
417 >    
418 >    if (associated(LJMap%atidToLJtype)) then
419 >       deallocate(LJMap%atidToLJtype)
420 >       LJMap%atidToLJtype => null()
421 >    end if
422 >    
423      haveMixingMap = .false.
424    end subroutine destroyLJTypes
425  
435
426   end module lj

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines