ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-2.0/src/UseTheForce/DarkSide/reactionField.F90
Revision: 2129
Committed: Mon Mar 21 20:51:10 2005 UTC (19 years, 5 months ago) by chrisfen
File size: 9751 byte(s)
Log Message:
Make sure electrostatic_module provides data for reaction_field

File Contents

# User Rev Content
1 gezelter 1930 !!
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 gezelter 1608 module reaction_field
43     use force_globals
44     use definitions
45     use atype_module
46     use vector_class
47     use simulation
48     use status
49 chrisfen 2129 use electrostatic_module
50 gezelter 1608 #ifdef IS_MPI
51     use mpiSimulation
52     #endif
53     implicit none
54    
55     PRIVATE
56    
57     real(kind=dp), save :: rrf = 1.0_dp
58     real(kind=dp), save :: rt
59     real(kind=dp), save :: dielect = 1.0_dp
60     real(kind=dp), save :: rrfsq = 1.0_dp
61     real(kind=dp), save :: pre
62 chrisfen 2129
63 gezelter 1608 logical, save :: haveCutoffs = .false.
64     logical, save :: haveDielectric = .false.
65    
66     PUBLIC::initialize_rf
67     PUBLIC::setCutoffsRF
68     PUBLIC::accumulate_rf
69     PUBLIC::accumulate_self_rf
70     PUBLIC::reaction_field_final
71     PUBLIC::rf_correct_forces
72    
73     contains
74    
75     subroutine initialize_rf(this_dielect)
76     real(kind=dp), intent(in) :: this_dielect
77    
78     dielect = this_dielect
79    
80 chrisfen 2129 pre = pre22 * 2.0d0*(dielect-1.0d0)/((2.0d0*dielect+1.0d0)*rrfsq*rrf)
81 gezelter 1608
82     haveDielectric = .true.
83    
84     return
85     end subroutine initialize_rf
86    
87     subroutine setCutoffsRF( this_rrf, this_rt )
88    
89     real(kind=dp), intent(in) :: this_rrf, this_rt
90    
91     rrf = this_rrf
92     rt = this_rt
93    
94     rrfsq = rrf * rrf
95 chrisfen 2129 pre = pre22 * 2.0d0*(dielect-1.0d0)/((2.0d0*dielect+1.0d0)*rrfsq*rrf)
96 gezelter 1608
97     haveCutoffs = .true.
98    
99     end subroutine setCutoffsRF
100    
101 gezelter 1930 subroutine accumulate_rf(atom1, atom2, rij, eFrame, taper)
102 gezelter 1608
103     integer, intent(in) :: atom1, atom2
104     real (kind = dp), intent(in) :: rij
105 gezelter 1930 real (kind = dp), dimension(9,nLocal) :: eFrame
106 gezelter 1608
107     integer :: me1, me2
108     real (kind = dp), intent(in) :: taper
109     real (kind = dp):: mu1, mu2
110     real (kind = dp), dimension(3) :: ul1
111     real (kind = dp), dimension(3) :: ul2
112    
113     integer :: localError
114    
115     if ((.not.haveDielectric).or.(.not.haveCutoffs)) then
116     write(default_error,*) 'Reaction field not initialized!'
117     return
118 chrisfen 2129 endif
119 gezelter 1608
120     #ifdef IS_MPI
121     me1 = atid_Row(atom1)
122 gezelter 1930 ul1(1) = eFrame_Row(3,atom1)
123     ul1(2) = eFrame_Row(6,atom1)
124     ul1(3) = eFrame_Row(9,atom1)
125 gezelter 1608
126     me2 = atid_Col(atom2)
127 gezelter 1930 ul2(1) = eFrame_Col(3,atom2)
128     ul2(2) = eFrame_Col(6,atom2)
129     ul2(3) = eFrame_Col(9,atom2)
130 gezelter 1608 #else
131     me1 = atid(atom1)
132 gezelter 1930 ul1(1) = eFrame(3,atom1)
133     ul1(2) = eFrame(6,atom1)
134     ul1(3) = eFrame(9,atom1)
135 gezelter 1608
136     me2 = atid(atom2)
137 gezelter 1930 ul2(1) = eFrame(3,atom2)
138     ul2(2) = eFrame(6,atom2)
139     ul2(3) = eFrame(9,atom2)
140 gezelter 1608 #endif
141    
142 chrisfen 2129 mu1 = getDipoleMoment(me1)
143     mu2 = getDipoleMoment(me2)
144 gezelter 1608
145     #ifdef IS_MPI
146     rf_Row(1,atom1) = rf_Row(1,atom1) + ul2(1)*mu2*taper
147     rf_Row(2,atom1) = rf_Row(2,atom1) + ul2(2)*mu2*taper
148     rf_Row(3,atom1) = rf_Row(3,atom1) + ul2(3)*mu2*taper
149    
150     rf_Col(1,atom2) = rf_Col(1,atom2) + ul1(1)*mu1*taper
151     rf_Col(2,atom2) = rf_Col(2,atom2) + ul1(2)*mu1*taper
152     rf_Col(3,atom2) = rf_Col(3,atom2) + ul1(3)*mu1*taper
153     #else
154     rf(1,atom1) = rf(1,atom1) + ul2(1)*mu2*taper
155     rf(2,atom1) = rf(2,atom1) + ul2(2)*mu2*taper
156     rf(3,atom1) = rf(3,atom1) + ul2(3)*mu2*taper
157    
158     rf(1,atom2) = rf(1,atom2) + ul1(1)*mu1*taper
159     rf(2,atom2) = rf(2,atom2) + ul1(2)*mu1*taper
160     rf(3,atom2) = rf(3,atom2) + ul1(3)*mu1*taper
161     #endif
162    
163    
164     return
165     end subroutine accumulate_rf
166    
167 gezelter 1930 subroutine accumulate_self_rf(atom1, mu1, eFrame)
168 gezelter 1608
169     integer, intent(in) :: atom1
170     real(kind=dp), intent(in) :: mu1
171 gezelter 1930 real(kind=dp), dimension(9,nLocal) :: eFrame
172 gezelter 1608
173     !! should work for both MPI and non-MPI version since this is not pairwise.
174 gezelter 1930 rf(1,atom1) = rf(1,atom1) + eFrame(3,atom1)*mu1
175     rf(2,atom1) = rf(2,atom1) + eFrame(6,atom1)*mu1
176     rf(3,atom1) = rf(3,atom1) + eFrame(9,atom1)*mu1
177 gezelter 1608
178     return
179     end subroutine accumulate_self_rf
180    
181 gezelter 1930 subroutine reaction_field_final(a1, mu1, eFrame, rfpot, t, do_pot)
182 gezelter 1608
183     integer, intent(in) :: a1
184     real (kind=dp), intent(in) :: mu1
185     real (kind=dp), intent(inout) :: rfpot
186     logical, intent(in) :: do_pot
187 gezelter 1930 real (kind = dp), dimension(9,nLocal) :: eFrame
188 gezelter 1608 real (kind = dp), dimension(3,nLocal) :: t
189    
190     integer :: localError
191    
192     if ((.not.haveDielectric).or.(.not.haveCutoffs)) then
193     write(default_error,*) 'Reaction field not initialized!'
194     return
195     endif
196    
197     ! compute torques on dipoles:
198     ! pre converts from mu in units of debye to kcal/mol
199    
200     ! The torque contribution is dipole cross reaction_field
201    
202 gezelter 1930 t(1,a1) = t(1,a1) + pre*mu1*(eFrame(6,a1)*rf(3,a1) - eFrame(9,a1)*rf(2,a1))
203     t(2,a1) = t(2,a1) + pre*mu1*(eFrame(9,a1)*rf(1,a1) - eFrame(3,a1)*rf(3,a1))
204     t(3,a1) = t(3,a1) + pre*mu1*(eFrame(3,a1)*rf(2,a1) - eFrame(6,a1)*rf(1,a1))
205 gezelter 1608
206     ! the potential contribution is -1/2 dipole dot reaction_field
207    
208     if (do_pot) then
209     rfpot = rfpot - 0.5d0 * pre * mu1 * &
210 gezelter 1930 (rf(1,a1)*eFrame(3,a1) + rf(2,a1)*eFrame(6,a1) + rf(3,a1)*eFrame(9,a1))
211 gezelter 1608 endif
212    
213     return
214     end subroutine reaction_field_final
215    
216 gezelter 1930 subroutine rf_correct_forces(atom1, atom2, d, rij, eFrame, taper, f, fpair)
217 gezelter 1608
218     integer, intent(in) :: atom1, atom2
219     real(kind=dp), dimension(3), intent(in) :: d
220     real(kind=dp), intent(in) :: rij, taper
221 gezelter 1930 real( kind = dp ), dimension(9,nLocal) :: eFrame
222 gezelter 1608 real( kind = dp ), dimension(3,nLocal) :: f
223     real( kind = dp ), dimension(3), intent(inout) :: fpair
224    
225     real (kind = dp), dimension(3) :: ul1
226     real (kind = dp), dimension(3) :: ul2
227     real (kind = dp) :: dtdr
228     real (kind = dp) :: dudx, dudy, dudz, u1dotu2
229     integer :: me1, me2, id1, id2
230     real (kind = dp) :: mu1, mu2
231    
232     integer :: localError
233    
234     if ((.not.haveDielectric).or.(.not.haveCutoffs)) then
235     write(default_error,*) 'Reaction field not initialized!'
236     return
237     endif
238    
239     if (rij.le.rrf) then
240    
241     if (rij.lt.rt) then
242     dtdr = 0.0d0
243     else
244     ! write(*,*) 'rf correct in taper region'
245     dtdr = 6.0d0*(rij*rij - rij*rt - rij*rrf +rrf*rt)/((rrf-rt)**3)
246     endif
247    
248     #ifdef IS_MPI
249     me1 = atid_Row(atom1)
250 gezelter 1930 ul1(1) = eFrame_Row(3,atom1)
251     ul1(2) = eFrame_Row(6,atom1)
252     ul1(3) = eFrame_Row(9,atom1)
253 gezelter 1608
254     me2 = atid_Col(atom2)
255 gezelter 1930 ul2(1) = eFrame_Col(3,atom2)
256     ul2(2) = eFrame_Col(6,atom2)
257     ul2(3) = eFrame_Col(9,atom2)
258 gezelter 1608 #else
259     me1 = atid(atom1)
260 gezelter 1930 ul1(1) = eFrame(3,atom1)
261     ul1(2) = eFrame(6,atom1)
262     ul1(3) = eFrame(9,atom1)
263 gezelter 1608
264     me2 = atid(atom2)
265 gezelter 1930 ul2(1) = eFrame(3,atom2)
266     ul2(2) = eFrame(6,atom2)
267     ul2(3) = eFrame(9,atom2)
268 gezelter 1608 #endif
269    
270 chrisfen 2129 mu1 = getDipoleMoment(me1)
271     mu2 = getDipoleMoment(me2)
272 gezelter 1608
273     u1dotu2 = ul1(1)*ul2(1) + ul1(2)*ul2(2) + ul1(3)*ul2(3)
274    
275     dudx = - pre*mu1*mu2*u1dotu2*dtdr*d(1)/rij
276     dudy = - pre*mu1*mu2*u1dotu2*dtdr*d(2)/rij
277     dudz = - pre*mu1*mu2*u1dotu2*dtdr*d(3)/rij
278    
279     #ifdef IS_MPI
280     f_Row(1,atom1) = f_Row(1,atom1) + dudx
281     f_Row(2,atom1) = f_Row(2,atom1) + dudy
282     f_Row(3,atom1) = f_Row(3,atom1) + dudz
283    
284     f_Col(1,atom2) = f_Col(1,atom2) - dudx
285     f_Col(2,atom2) = f_Col(2,atom2) - dudy
286     f_Col(3,atom2) = f_Col(3,atom2) - dudz
287     #else
288     f(1,atom1) = f(1,atom1) + dudx
289     f(2,atom1) = f(2,atom1) + dudy
290     f(3,atom1) = f(3,atom1) + dudz
291    
292     f(1,atom2) = f(1,atom2) - dudx
293     f(2,atom2) = f(2,atom2) - dudy
294     f(3,atom2) = f(3,atom2) - dudz
295     #endif
296    
297     #ifdef IS_MPI
298     id1 = AtomRowToGlobal(atom1)
299     id2 = AtomColToGlobal(atom2)
300     #else
301     id1 = atom1
302     id2 = atom2
303     #endif
304    
305     if (molMembershipList(id1) .ne. molMembershipList(id2)) then
306    
307     fpair(1) = fpair(1) + dudx
308     fpair(2) = fpair(2) + dudy
309     fpair(3) = fpair(3) + dudz
310    
311     endif
312    
313     end if
314     return
315     end subroutine rf_correct_forces
316     end module reaction_field