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

Comparing trunk/OOPSE-2.0/src/UseTheForce/DarkSide/LJ.F90 (file contents):
Revision 2270 by tim, Thu May 19 15:49:53 2005 UTC vs.
Revision 2271 by gezelter, Tue Aug 9 22:33:48 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.12 2005-05-19 15:49:53 tim Exp $, $Date: 2005-05-19 15:49:53 $, $Name: not supported by cvs2svn $, $Revision: 1.12 $
46 > !! @version $Id: LJ.F90,v 1.13 2005-08-09 22:33:48 gezelter Exp $, $Date: 2005-08-09 22:33:48 $, $Name: not supported by cvs2svn $, $Revision: 1.13 $
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
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
257  
258 <    status = 0
259 <
216 <    if (.not. allocated(ParameterMap)) then
217 <       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
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
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 >             else
300 >                call handleError("LJ", "No specified or default cutoff value!")
301               endif
302 <          end do
303 <       endif
304 <    end do
302 >          endif
303 >          
304 >          tp6    = MixingMap(i,j)%sigma6/rcut6
305 >          tp12    = tp6**2          
306  
307 +          MixingMap(i,j)%delta =-4.0_DP*MixingMap(i,j)%epsilon*(tp12 - tp6)
308 +       enddo
309 +    enddo
310 +    
311      haveMixingMap = .true.
312 <
312 >    
313    end subroutine createMixingMap
314 <
314 >  
315    subroutine do_lj_pair(atom1, atom2, d, rij, r2, sw, vpair, fpair, &
316         pot, f, do_pot)
317  
318      integer, intent(in) ::  atom1, atom2
319 +    integer :: atid1, atid2, ljt1, ljt2
320      real( kind = dp ), intent(in) :: rij, r2
321      real( kind = dp ) :: pot, sw, vpair
322      real( kind = dp ), dimension(3,nLocal) :: f    
# Line 320 | Line 334 | contains
334      real( kind = dp ) :: t6
335      real( kind = dp ) :: t12
336      real( kind = dp ) :: delta
337 <    logical :: soft_pot
337 >    logical :: isSoftCore, shiftedPot
338      integer :: id1, id2, localError
339  
340      if (.not.haveMixingMap) then
341 <       localError = 0
328 <       call createMixingMap(localError)
329 <       if ( localError .ne. 0 ) then
330 <          call handleError("LJ", "MixingMap creation failed!")
331 <          return
332 <       end if
341 >       call createMixingMap()
342      endif
343  
344      ! Look up the correct parameters in the mixing matrix
345   #ifdef IS_MPI
346 <    sigma6   = MixingMap(atid_Row(atom1),atid_Col(atom2))%sigma6
347 <    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
346 >    atid1 = atid_Row(atom1)
347 >    atid2 = atid_Col(atom2)
348   #else
349 <    sigma6   = MixingMap(atid(atom1),atid(atom2))%sigma6
350 <    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
349 >    atid1 = atid(atom1)
350 >    atid2 = atid(atom2)
351   #endif
352  
353 +    ljt1 = LJMap%atidToLJtype(atid1)
354 +    ljt2 = LJMap%atidToLJtype(atid2)
355 +
356 +    sigma6     = MixingMap(ljt1,ljt2)%sigma6
357 +    epsilon    = MixingMap(ljt1,ljt2)%epsilon
358 +    delta      = MixingMap(ljt1,ljt2)%delta
359 +    isSoftCore = MixingMap(ljt1,ljt2)%isSoftCore
360 +    shiftedPot = MixingMap(ljt1,ljt2)%shiftedPot
361 +
362      r6 = r2 * r2 * r2
363  
364      t6  = sigma6/ r6
365      t12 = t6 * t6    
366  
367 <    if (soft_pot) then
368 <
369 <      pot_temp = 4.0E0_DP * epsilon * t6
370 <      if (LJ_do_shift) then
371 <         pot_temp = pot_temp + delta
372 <      endif
373 <
374 <      vpair = vpair + pot_temp
375 <
376 <      dudr = -sw * 24.0E0_DP * epsilon * t6 / rij
377 <
367 >    if (isSoftCore) then
368 >      
369 >       pot_temp = 4.0E0_DP * epsilon * t6
370 >       if (shiftedPot) then
371 >          pot_temp = pot_temp + delta
372 >       endif
373 >      
374 >       vpair = vpair + pot_temp
375 >      
376 >       dudr = -sw * 24.0E0_DP * epsilon * t6 / rij
377 >      
378      else
379         pot_temp = 4.0E0_DP * epsilon * (t12 - t6)
380 <       if (LJ_do_shift) then
380 >       if (shiftedPot) then
381            pot_temp = pot_temp + delta
382         endif
383 <
383 >      
384         vpair = vpair + pot_temp
385 <
385 >      
386         dudr = sw * 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / rij
387      endif
388  
# Line 428 | Line 442 | contains
442    end subroutine do_lj_pair
443  
444    subroutine destroyLJTypes()
445 <    if(allocated(ParameterMap)) deallocate(ParameterMap)
446 <    if(allocated(MixingMap)) deallocate(MixingMap)
445 >
446 >    LJMap%nLJtypes = 0
447 >    LJMap%currentLJtype = 0
448 >    
449 >    if (associated(LJMap%LJtypes)) then
450 >       deallocate(LJMap%LJtypes)
451 >       LJMap%LJtypes => null()
452 >    end if
453 >    
454 >    if (associated(LJMap%atidToLJtype)) then
455 >       deallocate(LJMap%atidToLJtype)
456 >       LJMap%atidToLJtype => null()
457 >    end if
458 >    
459      haveMixingMap = .false.
460    end subroutine destroyLJTypes
461  
436
462   end module lj

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines