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 2289 by gezelter, Wed Sep 14 19:02:33 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.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
51  use switcheroo
51    use vector_class
52    use simulation
53    use status
# Line 62 | Line 61 | module lj
61  
62    integer, parameter :: DP = selected_real_kind(15)
63  
64 <  type, private :: LjType
65 <     integer :: c_ident
66 <     integer :: atid
64 >  logical, save :: useGeometricDistanceMixing = .false.
65 >  logical, save :: haveMixingMap = .false.
66 >
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 :: soft_pot
77 <  end type LjType
76 >     logical       :: isSoftCore = .false.
77 >  end type LJtype
78  
79 <  type(LjType), dimension(:), allocatable :: ParameterMap
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 <  logical, save :: haveMixingMap = .false.
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)  :: tp6
93 <     real(kind=dp)  :: tp12
94 <     real(kind=dp)  :: delta
95 <     logical :: soft_pot    
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 <  real(kind=DP), save :: LJ_rcut
102 <  logical, save :: have_rcut = .false.
103 <  logical, save :: LJ_do_shift = .false.
104 <  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  
101 >  public :: newLJtype
102 >  public :: setLJDefaultCutoff
103 >  public :: setLJUniformCutoff
104 >  public :: setLJCutoffByTypes
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
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 >       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 >  end subroutine setLJDefaultCutoff
161 >
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
171 +
172 +    nLJtypes = LJMap%nLJtypes
173 +    if (.not. allocated(MixingMap)) then
174 +       allocate(MixingMap(nLJtypes, nLJtypes))
175      endif
176  
177 <    ! set the values for ParameterMap for this atom type:
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 <    ParameterMap(myATID)%c_ident = c_ident
188 <    ParameterMap(myATID)%atid = myATID
189 <    ParameterMap(myATID)%epsilon = epsilon
190 <    ParameterMap(myATID)%sigma = sigma
191 <    if (soft_pot == 1) then
192 <       ParameterMap(myATID)%soft_pot = .true.
193 <    else
194 <       ParameterMap(myATID)%soft_pot = .false.
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 (LJMap%currentLJtype == 0) then
194 >       call handleError("LJ", "No members in LJMap")
195 >       return
196 >    end if
197 >
198 >    nLJtypes = LJMap%nLJtypes
199 >    if (.not. allocated(MixingMap)) then
200 >       allocate(MixingMap(nLJtypes, nLJtypes))
201      endif
151  end subroutine newLJtype
202  
203 +    ljt1 = LJMap%atidToLJtype(atid1)
204 +    ljt2 = LJMap%atidToLJtype(atid2)
205 +
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 +    call createMixingMap()
214 +  end subroutine setLJCutoffByTypes
215 +
216    function getSigma(atid) result (s)
217      integer, intent(in) :: atid
218 <    integer :: localError
218 >    integer :: ljt1
219      real(kind=dp) :: s
220  
221 <    if (.not.allocated(ParameterMap)) then
222 <       call handleError("LJ", "no ParameterMap was present before first call of getSigma!")
221 >    if (LJMap%currentLJtype == 0) then
222 >       call handleError("LJ", "No members in LJMap")
223         return
224      end if
225  
226 <    s = ParameterMap(atid)%sigma
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 :: localError
233 >    integer :: ljt1
234      real(kind=dp) :: e
235  
236 <    if (.not.allocated(ParameterMap)) then
237 <       call handleError("LJ", "no ParameterMap was present before first call of getEpsilon!")
236 >    if (LJMap%currentLJtype == 0) then
237 >       call handleError("LJ", "No members in LJMap")
238         return
239      end if
240  
241 <    e = ParameterMap(atid)%epsilon
241 >    ljt1 = LJMap%atidToLJtype(atid)
242 >    e = LJMap%LJtypes(ljt1)%epsilon
243 >
244    end function getEpsilon
245  
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
246    subroutine useGeometricMixing()
247      useGeometricDistanceMixing = .true.
248      haveMixingMap = .false.
249      return
250    end subroutine useGeometricMixing
251  
252 <  subroutine createMixingMap(status)
253 <    integer :: nATIDs
254 <    integer :: status
255 <    integer :: i
256 <    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
213 <
214 <    status = 0
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 (.not. allocated(ParameterMap)) then
259 <       call handleError("LJ", "no ParameterMap was present before call of createMixingMap!")
218 <       status = -1
258 >    if (LJMap%currentLJtype == 0) then
259 >       call handleError("LJ", "No members in LJMap")
260         return
220    endif
221
222    nATIDs = size(ParameterMap)
223
224    if (nATIDs == 0) then
225       status = -1
226       return
261      end if
262  
263 +    nLJtypes = LJMap%nLJtypes
264 +
265      if (.not. allocated(MixingMap)) then
266 <       allocate(MixingMap(nATIDs, nATIDs))
266 >       allocate(MixingMap(nLJtypes, nLJtypes))
267      endif
268  
269 <    if (.not.have_rcut) then
234 <       status = -1
235 <       return
236 <    endif
269 >    do i = 1, nLJtypes
270  
271 <    rcut6 = LJ_rcut**6
271 >       s1 = LJMap%LJtypes(i)%sigma
272 >       e1 = LJMap%LJtypes(i)%epsilon
273 >       isSoftCore1 = LJMap%LJtypes(i)%isSoftCore
274  
275 <    ! This loops through all atypes, even those that don't support LJ forces.
276 <    do i = 1, nATIDs
277 <       call getElementProperty(atypes, i, "is_LennardJones", i_is_LJ)
278 <       if (i_is_LJ) then
279 <          Epsilon_i = ParameterMap(i)%epsilon
280 <          Sigma_i = ParameterMap(i)%sigma
275 >       do j = i, nLJtypes
276 >          
277 >          s2 = LJMap%LJtypes(j)%sigma
278 >          e2 = LJMap%LJtypes(j)%epsilon
279 >          isSoftCore2 = LJMap%LJtypes(j)%isSoftCore
280 >          
281 >          MixingMap(i,j)%isSoftCore = isSoftCore1 .or. isSoftCore2
282  
283 <          ! do self mixing rule
284 <          MixingMap(i,i)%sigma   = Sigma_i          
285 <          MixingMap(i,i)%sigma6  = Sigma_i ** 6          
286 <          MixingMap(i,i)%tp6     = (MixingMap(i,i)%sigma6)/rcut6          
287 <          MixingMap(i,i)%tp12    = (MixingMap(i,i)%tp6) ** 2
288 <          MixingMap(i,i)%epsilon = Epsilon_i          
289 <          MixingMap(i,i)%delta   = -4.0_DP * MixingMap(i,i)%epsilon * &
290 <               (MixingMap(i,i)%tp12 - MixingMap(i,i)%tp6)
255 <          MixingMap(i,i)%soft_pot = ParameterMap(i)%soft_pot
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 >          MixingMap(i,j)%epsilon = dsqrt(e1 * e2)
291  
292 <          do j = i + 1, nATIDs
258 <             call getElementProperty(atypes, j, "is_LennardJones", j_is_LJ)
292 >          MixingMap(i,j)%sigma6 = (MixingMap(i,j)%sigma)**6
293  
294 <             if (j_is_LJ) then
295 <                Epsilon_j = ParameterMap(j)%epsilon
296 <                Sigma_j = ParameterMap(j)%sigma
297 <
298 <                ! only the distance parameter uses different mixing policies
299 <                if (useGeometricDistanceMixing) then
300 <                   ! only for OPLS as far as we can tell
301 <                   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
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 <          end do
304 <       endif
305 <    end do
303 >          endif
304 >          
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 <    haveMixingMap = .true.
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 +    haveMixingMap = .true.
325 +    
326    end subroutine createMixingMap
327 <
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 320 | Line 347 | contains
347      real( kind = dp ) :: t6
348      real( kind = dp ) :: t12
349      real( kind = dp ) :: delta
350 <    logical :: soft_pot
350 >    logical :: isSoftCore, shiftedPot
351      integer :: id1, id2, localError
352  
353      if (.not.haveMixingMap) then
354 <       localError = 0
328 <       call createMixingMap(localError)
329 <       if ( localError .ne. 0 ) then
330 <          call handleError("LJ", "MixingMap creation failed!")
331 <          return
332 <       end if
354 >       call createMixingMap()
355      endif
356  
357      ! Look up the correct parameters in the mixing matrix
358   #ifdef IS_MPI
359 <    sigma6   = MixingMap(atid_Row(atom1),atid_Col(atom2))%sigma6
360 <    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
359 >    atid1 = atid_Row(atom1)
360 >    atid2 = atid_Col(atom2)
361   #else
362 <    sigma6   = MixingMap(atid(atom1),atid(atom2))%sigma6
363 <    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
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  
377      t6  = sigma6/ r6
378      t12 = t6 * t6    
379  
380 <    if (soft_pot) then
381 <       pot_temp = 4.0E0_DP * epsilon * t12
382 <       if (LJ_do_shift) then
380 >    if (isSoftCore) then
381 >      
382 >       pot_temp = 4.0E0_DP * epsilon * t6
383 >       if (shiftedPot) then
384            pot_temp = pot_temp + delta
385         endif
386 <
386 >      
387         vpair = vpair + pot_temp
388 <
389 <       dudr = sw * 24.0E0_DP * epsilon * (-2.0E0_DP)*t12 / rij
390 <
388 >      
389 >       dudr = -sw * 24.0E0_DP * epsilon * t6 / rij
390 >      
391      else
392         pot_temp = 4.0E0_DP * epsilon * (t12 - t6)
393 <       if (LJ_do_shift) then
393 >       if (shiftedPot) then
394            pot_temp = pot_temp + delta
395         endif
396 <
396 >      
397         vpair = vpair + pot_temp
398 <
398 >      
399         dudr = sw * 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / rij
400      endif
401  
# Line 379 | Line 407 | contains
407      fy = dudr * drdy
408      fz = dudr * drdz
409  
382
410   #ifdef IS_MPI
411      if (do_pot) then
412         pot_Row(atom1) = pot_Row(atom1) + sw*pot_temp*0.5
# Line 427 | Line 454 | contains
454    end subroutine do_lj_pair
455  
456    subroutine destroyLJTypes()
457 <    if(allocated(ParameterMap)) deallocate(ParameterMap)
458 <    if(allocated(MixingMap)) deallocate(MixingMap)
457 >
458 >    LJMap%nLJtypes = 0
459 >    LJMap%currentLJtype = 0
460 >    
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  
435
474   end module lj

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines