ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-4/src/UseTheForce/DarkSide/LJ.F90
Revision: 2189
Committed: Wed Apr 13 20:36:45 2005 UTC (19 years, 2 months ago) by chuckv
File size: 13272 byte(s)
Log Message:
Added destroy methods for Fortran modules.

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.10 2005-04-13 20:36:45 chuckv Exp $, $Date: 2005-04-13 20:36:45 $, $Name: not supported by cvs2svn $, $Revision: 1.10 $
47
48
49 module lj
50 use atype_module
51 use switcheroo
52 use vector_class
53 use simulation
54 use status
55 #ifdef IS_MPI
56 use mpiSimulation
57 #endif
58 use force_globals
59
60 implicit none
61 PRIVATE
62
63 integer, parameter :: DP = selected_real_kind(15)
64
65 type, private :: LjType
66 integer :: c_ident
67 integer :: atid
68 real(kind=dp) :: sigma
69 real(kind=dp) :: epsilon
70 logical :: soft_pot
71 end type LjType
72
73 type(LjType), dimension(:), allocatable :: ParameterMap
74
75 logical, save :: haveMixingMap = .false.
76
77 type :: MixParameters
78 real(kind=DP) :: sigma
79 real(kind=DP) :: epsilon
80 real(kind=dp) :: sigma6
81 real(kind=dp) :: tp6
82 real(kind=dp) :: tp12
83 real(kind=dp) :: delta
84 logical :: soft_pot
85 end type MixParameters
86
87 type(MixParameters), dimension(:,:), allocatable :: MixingMap
88
89 real(kind=DP), save :: LJ_rcut
90 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
100 public :: getSigma
101 public :: getEpsilon
102 public :: destroyLJTypes
103
104 contains
105
106 subroutine newLJtype(c_ident, sigma, epsilon, soft_pot, status)
107 integer,intent(in) :: c_ident
108 real(kind=dp),intent(in) :: sigma
109 real(kind=dp),intent(in) :: epsilon
110 integer, intent(in) :: soft_pot
111 integer,intent(out) :: status
112 integer :: nATypes, myATID
113 integer, pointer :: MatchList(:) => null()
114
115 status = 0
116
117 myATID = getFirstMatchingElement(atypes, "c_ident", c_ident)
118
119 if (.not.allocated(ParameterMap)) then
120
121 !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
128
129 if (.not. allocated(ParameterMap)) then
130 allocate(ParameterMap(nAtypes))
131 endif
132
133 end if
134
135 if (myATID .gt. size(ParameterMap)) then
136 status = -1
137 return
138 endif
139
140 ! set the values for ParameterMap for this atom type:
141
142 ParameterMap(myATID)%c_ident = c_ident
143 ParameterMap(myATID)%atid = myATID
144 ParameterMap(myATID)%epsilon = epsilon
145 ParameterMap(myATID)%sigma = sigma
146 if (soft_pot == 1) then
147 ParameterMap(myATID)%soft_pot = .true.
148 else
149 ParameterMap(myATID)%soft_pot = .false.
150 endif
151 end subroutine newLJtype
152
153 function getSigma(atid) result (s)
154 integer, intent(in) :: atid
155 integer :: localError
156 real(kind=dp) :: s
157
158 if (.not.allocated(ParameterMap)) then
159 call handleError("LJ", "no ParameterMap was present before first call of getSigma!")
160 return
161 end if
162
163 s = ParameterMap(atid)%sigma
164 end function getSigma
165
166 function getEpsilon(atid) result (e)
167 integer, intent(in) :: atid
168 integer :: localError
169 real(kind=dp) :: e
170
171 if (.not.allocated(ParameterMap)) then
172 call handleError("LJ", "no ParameterMap was present before first call of getEpsilon!")
173 return
174 end if
175
176 e = ParameterMap(atid)%epsilon
177 end function getEpsilon
178
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
198 subroutine useGeometricMixing()
199 useGeometricDistanceMixing = .true.
200 haveMixingMap = .false.
201 return
202 end subroutine useGeometricMixing
203
204 subroutine createMixingMap(status)
205 integer :: nATIDs
206 integer :: status
207 integer :: i
208 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
215
216 if (.not. allocated(ParameterMap)) then
217 call handleError("LJ", "no ParameterMap was present before call of createMixingMap!")
218 status = -1
219 return
220 endif
221
222 nATIDs = size(ParameterMap)
223
224 if (nATIDs == 0) then
225 status = -1
226 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
298 haveMixingMap = .true.
299
300 end subroutine createMixingMap
301
302 subroutine do_lj_pair(atom1, atom2, d, rij, r2, sw, vpair, fpair, &
303 pot, f, do_pot)
304
305 integer, intent(in) :: atom1, atom2
306 real( kind = dp ), intent(in) :: rij, r2
307 real( kind = dp ) :: pot, sw, vpair
308 real( kind = dp ), dimension(3,nLocal) :: f
309 real( kind = dp ), intent(in), dimension(3) :: d
310 real( kind = dp ), intent(inout), dimension(3) :: fpair
311 logical, intent(in) :: do_pot
312
313 ! local Variables
314 real( kind = dp ) :: drdx, drdy, drdz
315 real( kind = dp ) :: fx, fy, fz
316 real( kind = dp ) :: pot_temp, dudr
317 real( kind = dp ) :: sigma6
318 real( kind = dp ) :: epsilon
319 real( kind = dp ) :: r6
320 real( kind = dp ) :: t6
321 real( kind = dp ) :: t12
322 real( kind = dp ) :: delta
323 logical :: soft_pot
324 integer :: id1, id2, localError
325
326 if (.not.haveMixingMap) then
327 localError = 0
328 call createMixingMap(localError)
329 if ( localError .ne. 0 ) then
330 call handleError("LJ", "MixingMap creation failed!")
331 return
332 end if
333 endif
334
335 ! Look up the correct parameters in the mixing matrix
336 #ifdef IS_MPI
337 sigma6 = MixingMap(atid_Row(atom1),atid_Col(atom2))%sigma6
338 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
341 #else
342 sigma6 = MixingMap(atid(atom1),atid(atom2))%sigma6
343 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
346 #endif
347
348 r6 = r2 * r2 * r2
349
350 t6 = sigma6/ r6
351 t12 = t6 * t6
352
353 if (soft_pot) then
354 pot_temp = 4.0E0_DP * epsilon * t12
355 if (LJ_do_shift) then
356 pot_temp = pot_temp + delta
357 endif
358
359 vpair = vpair + pot_temp
360
361 dudr = sw * 24.0E0_DP * epsilon * (-2.0E0_DP)*t12 / rij
362
363 else
364 pot_temp = 4.0E0_DP * epsilon * (t12 - t6)
365 if (LJ_do_shift) then
366 pot_temp = pot_temp + delta
367 endif
368
369 vpair = vpair + pot_temp
370
371 dudr = sw * 24.0E0_DP * epsilon * (t6 - 2.0E0_DP*t12) / rij
372 endif
373
374 drdx = d(1) / rij
375 drdy = d(2) / rij
376 drdz = d(3) / rij
377
378 fx = dudr * drdx
379 fy = dudr * drdy
380 fz = dudr * drdz
381
382
383 #ifdef IS_MPI
384 if (do_pot) then
385 pot_Row(atom1) = pot_Row(atom1) + sw*pot_temp*0.5
386 pot_Col(atom2) = pot_Col(atom2) + sw*pot_temp*0.5
387 endif
388
389 f_Row(1,atom1) = f_Row(1,atom1) + fx
390 f_Row(2,atom1) = f_Row(2,atom1) + fy
391 f_Row(3,atom1) = f_Row(3,atom1) + fz
392
393 f_Col(1,atom2) = f_Col(1,atom2) - fx
394 f_Col(2,atom2) = f_Col(2,atom2) - fy
395 f_Col(3,atom2) = f_Col(3,atom2) - fz
396
397 #else
398 if (do_pot) pot = pot + sw*pot_temp
399
400 f(1,atom1) = f(1,atom1) + fx
401 f(2,atom1) = f(2,atom1) + fy
402 f(3,atom1) = f(3,atom1) + fz
403
404 f(1,atom2) = f(1,atom2) - fx
405 f(2,atom2) = f(2,atom2) - fy
406 f(3,atom2) = f(3,atom2) - fz
407 #endif
408
409 #ifdef IS_MPI
410 id1 = AtomRowToGlobal(atom1)
411 id2 = AtomColToGlobal(atom2)
412 #else
413 id1 = atom1
414 id2 = atom2
415 #endif
416
417 if (molMembershipList(id1) .ne. molMembershipList(id2)) then
418
419 fpair(1) = fpair(1) + fx
420 fpair(2) = fpair(2) + fy
421 fpair(3) = fpair(3) + fz
422
423 endif
424
425 return
426
427 end subroutine do_lj_pair
428
429 subroutine destroyLJTypes()
430 if(allocated(ParameterMap)) deallocate(ParameterMap)
431 if(allocated(MixingMap)) deallocate(MixingMap)
432 haveMixingMap = .false.
433 end subroutine destroyLJTypes
434
435
436 end module lj