ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-2.0/src/UseTheForce/DarkSide/LJ.F90
Revision: 2319
Committed: Wed Sep 21 23:45:48 2005 UTC (18 years, 10 months ago) by chuckv
File size: 13978 byte(s)
Log Message:
Bug fix: If we are not using LJ (say we are using EAM), we probably shouldn't rebuild the LJ mixing map.

File Contents

# Content
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.
44 !! @author Charles F. Vardeman II
45 !! @author Matthew Meineke
46 !! @version $Id: LJ.F90,v 1.16 2005-09-21 23:45:48 chuckv Exp $, $Date: 2005-09-21 23:45:48 $, $Name: not supported by cvs2svn $, $Revision: 1.16 $
47
48
49 module lj
50 use atype_module
51 use vector_class
52 use simulation
53 use status
54 #ifdef IS_MPI
55 use mpiSimulation
56 #endif
57 use force_globals
58
59 implicit none
60 PRIVATE
61
62 integer, parameter :: DP = selected_real_kind(15)
63
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 :: 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 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(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 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 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 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 !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 subroutine setLJUniformCutoff(thisRcut, shiftedPot)
167 real(kind=dp), intent(in) :: thisRcut
168 logical, intent(in) :: shiftedPot
169 integer :: nLJtypes, i, j
170
171 if (LJMap%currentLJtype == 0) then
172 call handleError("LJ", "No members in LJMap")
173 return
174 end if
175
176 nLJtypes = LJMap%nLJtypes
177 if (.not. allocated(MixingMap)) then
178 allocate(MixingMap(nLJtypes, nLJtypes))
179 endif
180
181 do i = 1, nLJtypes
182 do j = 1, nLJtypes
183 MixingMap(i,j)%rCut = thisRcut
184 MixingMap(i,j)%shiftedPot = shiftedPot
185 MixingMap(i,j)%rCutWasSet = .true.
186 enddo
187 enddo
188 call createMixingMap()
189 end subroutine setLJUniformCutoff
190
191 subroutine setLJCutoffByTypes(atid1, atid2, thisRcut, shiftedPot)
192 integer, intent(in) :: atid1, atid2
193 real(kind=dp), intent(in) :: thisRcut
194 logical, intent(in) :: shiftedPot
195 integer :: nLJtypes, ljt1, ljt2
196
197 if (LJMap%currentLJtype == 0) then
198 call handleError("LJ", "No members in LJMap")
199 return
200 end if
201
202 nLJtypes = LJMap%nLJtypes
203 if (.not. allocated(MixingMap)) then
204 allocate(MixingMap(nLJtypes, nLJtypes))
205 endif
206
207 ljt1 = LJMap%atidToLJtype(atid1)
208 ljt2 = LJMap%atidToLJtype(atid2)
209
210 MixingMap(ljt1,ljt2)%rCut = thisRcut
211 MixingMap(ljt1,ljt2)%shiftedPot = shiftedPot
212 MixingMap(ljt1,ljt2)%rCutWasSet = .true.
213 MixingMap(ljt2,ljt1)%rCut = thisRcut
214 MixingMap(ljt2,ljt1)%shiftedPot = shiftedPot
215 MixingMap(ljt2,ljt1)%rCutWasSet = .true.
216
217 call createMixingMap()
218 end subroutine setLJCutoffByTypes
219
220 function getSigma(atid) result (s)
221 integer, intent(in) :: atid
222 integer :: ljt1
223 real(kind=dp) :: s
224
225 if (LJMap%currentLJtype == 0) then
226 call handleError("LJ", "No members in LJMap")
227 return
228 end if
229
230 ljt1 = LJMap%atidToLJtype(atid)
231 s = LJMap%LJtypes(ljt1)%sigma
232
233 end function getSigma
234
235 function getEpsilon(atid) result (e)
236 integer, intent(in) :: atid
237 integer :: ljt1
238 real(kind=dp) :: e
239
240 if (LJMap%currentLJtype == 0) then
241 call handleError("LJ", "No members in LJMap")
242 return
243 end if
244
245 ljt1 = LJMap%atidToLJtype(atid)
246 e = LJMap%LJtypes(ljt1)%epsilon
247
248 end function getEpsilon
249
250 subroutine useGeometricMixing()
251 useGeometricDistanceMixing = .true.
252 haveMixingMap = .false.
253 return
254 end subroutine useGeometricMixing
255
256 subroutine createMixingMap()
257 integer :: nLJtypes, i, j
258 real ( kind = dp ) :: s1, s2, e1, e2
259 real ( kind = dp ) :: rcut6, tp6, tp12
260 logical :: isSoftCore1, isSoftCore2, doShift
261
262 if (LJMap%currentLJtype == 0) then
263 call handleError("LJ", "No members in LJMap")
264 return
265 end if
266
267 nLJtypes = LJMap%nLJtypes
268
269 if (.not. allocated(MixingMap)) then
270 allocate(MixingMap(nLJtypes, nLJtypes))
271 endif
272
273 do i = 1, nLJtypes
274
275 s1 = LJMap%LJtypes(i)%sigma
276 e1 = LJMap%LJtypes(i)%epsilon
277 isSoftCore1 = LJMap%LJtypes(i)%isSoftCore
278
279 do j = i, nLJtypes
280
281 s2 = LJMap%LJtypes(j)%sigma
282 e2 = LJMap%LJtypes(j)%epsilon
283 isSoftCore2 = LJMap%LJtypes(j)%isSoftCore
284
285 MixingMap(i,j)%isSoftCore = isSoftCore1 .or. isSoftCore2
286
287 ! only the distance parameter uses different mixing policies
288 if (useGeometricDistanceMixing) then
289 MixingMap(i,j)%sigma = dsqrt(s1 * s2)
290 else
291 MixingMap(i,j)%sigma = 0.5_dp * (s1 + s2)
292 endif
293
294 MixingMap(i,j)%epsilon = dsqrt(e1 * e2)
295
296 MixingMap(i,j)%sigma6 = (MixingMap(i,j)%sigma)**6
297
298 if (MixingMap(i,j)%rCutWasSet) then
299 rcut6 = (MixingMap(i,j)%rcut)**6
300 else
301 if (haveDefaultCutoff) then
302 rcut6 = defaultCutoff**6
303 doShift = defaultShift
304 else
305 call handleError("LJ", "No specified or default cutoff value!")
306 endif
307 endif
308
309 tp6 = MixingMap(i,j)%sigma6/rcut6
310 tp12 = tp6**2
311 MixingMap(i,j)%delta =-4.0_DP*MixingMap(i,j)%epsilon*(tp12 - tp6)
312 MixingMap(i,j)%shiftedPot = doShift
313
314 if (i.ne.j) then
315 MixingMap(j,i)%sigma = MixingMap(i,j)%sigma
316 MixingMap(j,i)%epsilon = MixingMap(i,j)%epsilon
317 MixingMap(j,i)%sigma6 = MixingMap(i,j)%sigma6
318 MixingMap(j,i)%rCut = MixingMap(i,j)%rCut
319 MixingMap(j,i)%delta = MixingMap(i,j)%delta
320 MixingMap(j,i)%rCutWasSet = MixingMap(i,j)%rCutWasSet
321 MixingMap(j,i)%shiftedPot = MixingMap(i,j)%shiftedPot
322 MixingMap(j,i)%isSoftCore = MixingMap(i,j)%isSoftCore
323 endif
324
325 enddo
326 enddo
327
328 haveMixingMap = .true.
329
330 end subroutine createMixingMap
331
332 subroutine do_lj_pair(atom1, atom2, d, rij, r2, sw, vpair, fpair, &
333 pot, f, do_pot)
334
335 integer, intent(in) :: atom1, atom2
336 integer :: atid1, atid2, ljt1, ljt2
337 real( kind = dp ), intent(in) :: rij, r2
338 real( kind = dp ) :: pot, sw, vpair
339 real( kind = dp ), dimension(3,nLocal) :: f
340 real( kind = dp ), intent(in), dimension(3) :: d
341 real( kind = dp ), intent(inout), dimension(3) :: fpair
342 logical, intent(in) :: do_pot
343
344 ! local Variables
345 real( kind = dp ) :: drdx, drdy, drdz
346 real( kind = dp ) :: fx, fy, fz
347 real( kind = dp ) :: pot_temp, dudr
348 real( kind = dp ) :: sigma6
349 real( kind = dp ) :: epsilon
350 real( kind = dp ) :: r6
351 real( kind = dp ) :: t6
352 real( kind = dp ) :: t12
353 real( kind = dp ) :: delta
354 logical :: isSoftCore, shiftedPot
355 integer :: id1, id2, localError
356
357 if (.not.haveMixingMap) then
358 call createMixingMap()
359 endif
360
361 ! Look up the correct parameters in the mixing matrix
362 #ifdef IS_MPI
363 atid1 = atid_Row(atom1)
364 atid2 = atid_Col(atom2)
365 #else
366 atid1 = atid(atom1)
367 atid2 = atid(atom2)
368 #endif
369
370 ljt1 = LJMap%atidToLJtype(atid1)
371 ljt2 = LJMap%atidToLJtype(atid2)
372
373 sigma6 = MixingMap(ljt1,ljt2)%sigma6
374 epsilon = MixingMap(ljt1,ljt2)%epsilon
375 delta = MixingMap(ljt1,ljt2)%delta
376 isSoftCore = MixingMap(ljt1,ljt2)%isSoftCore
377 shiftedPot = MixingMap(ljt1,ljt2)%shiftedPot
378
379 r6 = r2 * r2 * r2
380
381 t6 = sigma6/ r6
382 t12 = t6 * t6
383
384 if (isSoftCore) then
385
386 pot_temp = 4.0E0_DP * epsilon * t6
387 if (shiftedPot) then
388 pot_temp = pot_temp + delta
389 endif
390
391 vpair = vpair + pot_temp
392
393 dudr = -sw * 24.0E0_DP * epsilon * t6 / rij
394
395 else
396 pot_temp = 4.0E0_DP * epsilon * (t12 - t6)
397 if (shiftedPot) then
398 pot_temp = pot_temp + delta
399 endif
400
401 vpair = vpair + pot_temp
402
403 dudr = sw * 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / rij
404 endif
405
406 drdx = d(1) / rij
407 drdy = d(2) / rij
408 drdz = d(3) / rij
409
410 fx = dudr * drdx
411 fy = dudr * drdy
412 fz = dudr * drdz
413
414 #ifdef IS_MPI
415 if (do_pot) then
416 pot_Row(atom1) = pot_Row(atom1) + sw*pot_temp*0.5
417 pot_Col(atom2) = pot_Col(atom2) + sw*pot_temp*0.5
418 endif
419
420 f_Row(1,atom1) = f_Row(1,atom1) + fx
421 f_Row(2,atom1) = f_Row(2,atom1) + fy
422 f_Row(3,atom1) = f_Row(3,atom1) + fz
423
424 f_Col(1,atom2) = f_Col(1,atom2) - fx
425 f_Col(2,atom2) = f_Col(2,atom2) - fy
426 f_Col(3,atom2) = f_Col(3,atom2) - fz
427
428 #else
429 if (do_pot) pot = pot + sw*pot_temp
430
431 f(1,atom1) = f(1,atom1) + fx
432 f(2,atom1) = f(2,atom1) + fy
433 f(3,atom1) = f(3,atom1) + fz
434
435 f(1,atom2) = f(1,atom2) - fx
436 f(2,atom2) = f(2,atom2) - fy
437 f(3,atom2) = f(3,atom2) - fz
438 #endif
439
440 #ifdef IS_MPI
441 id1 = AtomRowToGlobal(atom1)
442 id2 = AtomColToGlobal(atom2)
443 #else
444 id1 = atom1
445 id2 = atom2
446 #endif
447
448 if (molMembershipList(id1) .ne. molMembershipList(id2)) then
449
450 fpair(1) = fpair(1) + fx
451 fpair(2) = fpair(2) + fy
452 fpair(3) = fpair(3) + fz
453
454 endif
455
456 return
457
458 end subroutine do_lj_pair
459
460 subroutine destroyLJTypes()
461
462 LJMap%nLJtypes = 0
463 LJMap%currentLJtype = 0
464
465 if (associated(LJMap%LJtypes)) then
466 deallocate(LJMap%LJtypes)
467 LJMap%LJtypes => null()
468 end if
469
470 if (associated(LJMap%atidToLJtype)) then
471 deallocate(LJMap%atidToLJtype)
472 LJMap%atidToLJtype => null()
473 end if
474
475 haveMixingMap = .false.
476 end subroutine destroyLJTypes
477
478 end module lj