ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/mdtools/md_code/f_longRange_module.F90
Revision: 194
Committed: Wed Dec 4 21:19:38 2002 UTC (21 years, 9 months ago) by chuckv
File size: 15351 byte(s)
Log Message:
First addition of mpiDivideLabor to split mpi simulation among processors.

File Contents

# User Rev Content
1 chuckv 167 module long_range_forces
2     use definitions, ONLY : dp, ndim
3     use simulation
4 chuckv 191 #ifdef MPI
5     use mpi_force_module
6     #endif
7 chuckv 167 implicit none
8 chuckv 191 PRIVATE
9 chuckv 167
10 chuckv 191 type, public :: ForceSelecter
11     sequence
12    
13     logical :: is_dipole
14     logical :: is_vdw
15     logical :: is_lj
16     logical :: is_ssd
17 chuckv 167
18 chuckv 191 end type ForceSelecter
19 chuckv 167
20    
21    
22    
23    
24 chuckv 185 contains
25 chuckv 167
26    
27 chuckv 194 subroutine long_range_force(nComponents,nDim,q,rField,t,rF,A,TotPE)
28 chuckv 167
29 chuckv 191 !-------------------- arguments-------------------------->
30     ! integer components
31     integer, intent(in) :: nComponents ! number of Particles
32     integer, intent(in) :: nDim ! number of dimensions
33 chuckv 167
34 chuckv 191 ! real scalars
35 chuckv 194 real( kind = dp ), intent(out), optional :: TotPE ! potential energy
36 chuckv 167
37 chuckv 191 ! real vectors
38     real( kind = dp ),dimension(nDim,nComponents), &
39     intent(inout) :: q ! position vector
40     real( kind = dp ),dimension(nDim,nComponents), &
41     intent(inout) :: f ! force vector
42     real( kind = dp ),dimension(nDim,nComponents), &
43     intent(inout) :: t ! torque vector
44     real( kind = dp ),dimension(nDim,nComponents), &
45 chuckv 194 intent(inout) :: rField ! reaction field vector
46 chuckv 191 real( kind = dp ),dimension(nDim,nDim), &
47     intent(inout) :: A ! rotation matrix
48     !------------------- end arguments------------------------->
49 chuckv 167
50    
51 chuckv 191 !------------------- local variables----------------------->
52     real( kind = dp ), dimension(nDim) :: q_i
53 chuckv 194 real( kind = dp ), dimension(nDim) :: q_ij
54    
55 chuckv 167
56 chuckv 194 logical :: do_pot = .false.
57 chuckv 167
58    
59    
60 chuckv 191 !!$
61     !!$ subroutine long_range_force ( check_exclude, &
62     !!$ pair_i, pair_j, n_pairs, natoms, sigma, epslon, &
63     !!$ box, &
64     !!$ rx, ry, rz, fx, fy, fz, &
65     !!$ v, &
66     !!$ update, point, list, maxnab, &
67     !!$ rx0, ry0, rz0, &
68     !!$ ux, uy, uz, &
69     !!$ tx, ty, tz, &
70     !!$ ex, ey, ez, &
71     !!$ mu, rrf, rtaper, &
72     !!$ dielectric, &
73     !!$ is_dipole, is_vdw, is_lj, is_ssd, &
74     !!$ Axx, Axy, Axz, &
75     !!$ Ayx, Ayy, Ayz, &
76     !!$ Azx, Azy, Azz )
77    
78    
79 chuckv 185
80 chuckv 191 ! This routine implements the Verlet neighbor list for all of
81     ! the long range force calculations. After a pair has been
82     ! determined to lie within the neighbor list, the pair is passed
83     ! to the appropriate force functions.
84    
85     !!$
86     !!$
87     !!$ ! Passed Arguments
88     !!$
89     !!$ integer :: n_pairs ! the number of excluded pairs
90     !!$ integer :: natoms ! the number of atoms in the system
91     !!$ integer :: maxnab ! the max number of neighbors for the verlet list
92     !!$
93     !!$ logical(kind=2) :: check_exclude ! boolean to check for exclusion pairs
94     !!$ logical(kind=2) :: update ! boolean to update the neighbor list
95     !!$
96     !!$ double precision rcut ! the VDW/LJ cutoff radius
97     !!$ double precision rlist ! Verlet list cutoff
98     !!$ double precision box_x, box_y, box_z ! periodic boundry conditions
99     !!$ double precision rrf ! dipole reaction field cutoff
100     !!$ double precision rtaper ! the taper radius of the rxn field
101     !!$ double precision dielectric ! the dielectric cnst. of the rxn field
102     !!$ double precision v ! the potential energy
103     !!$
104     !!$
105     !!$
106     !!$ ! Passed Arrays
107     !!$
108     !!$ integer, dimension(n_pairs):: pair_i, pair_j ! the excluded pairs i and j
109     !!$ integer, dimension(natoms) :: point ! the Verlet list ptr array
110     !!$ integer, dimension(maxnab) :: list ! the verlet list
111     !!$
112     !!$ logical(kind=2), dimension(natoms) :: is_dipole ! dipole boolean array
113     !!$ logical(kind=2), dimension(natoms) :: is_vdw ! VDW boolean array
114     !!$ logical(kind=2), dimension(natoms) :: is_lj ! LJ boolean array
115     !!$ logical(kind=2), dimension(natoms) :: is_ssd ! ssd boolean array
116     !!$
117     !!$ double precision, dimension(natoms) :: sigma ! VDW/LJ distance prmtr.
118     !!$ double precision, dimension(natoms) :: epslon ! VDW/LJ well depth prmtr.
119     !!$ double precision, dimension(natoms) :: rx, ry, rz ! positions
120     !!$ double precision, dimension(natoms) :: fx, fy, fz ! forces
121     !!$ double precision, dimension(natoms) :: rx0, ry0, rz0 ! intial verlet positions
122     !!$ double precision, dimension(natoms) :: ux, uy, uz ! dipole unit vectors
123     !!$ double precision, dimension(natoms) :: tx, ty, tz ! torsions
124     !!$ double precision, dimension(natoms) :: ex, ey, ez ! reacion field
125     !!$ double precision, dimension(natoms) :: mu ! dipole moments
126     !!$ double precision, dimension(natoms) :: Axx, Axy, Axz ! rotational array
127     !!$ double precision, dimension(natoms) :: Ayx, Ayy, Ayz !
128     !!$ double precision, dimension(natoms) :: Azx, Azy, Azz !
129     !!$
130     !!$ ! local variables
131     !!$
132     !!$ double precision rxi, ryi, rzi
133     !!$ double precision rcutsq, rlstsq, rrfsq, rijsq, rij
134     !!$ double precision rxij, ryij, rzij
135     !!$ double precision prerf ! a reaction field preterm
136     !!$
137     !!$ double precision, dimension(9,natoms) :: A
138     !!$
139     !!$ integer :: i, j, k, ix, jx, nlist
140     !!$ integer :: jbeg, jend, jnab
141     !!$
142     !!$ logical :: exclude_temp1, exclude_temp2, exclude
143    
144 chuckv 167
145 chuckv 185 !*******************************************************************
146 chuckv 191 !!$
147     !!$ do i=1, natoms
148     !!$ A(1,i) = Axx(i)
149     !!$ A(2,i) = Axy(i)
150     !!$ A(3,i) = Axz(i)
151     !!$
152     !!$ A(4,i) = Ayx(i)
153     !!$ A(5,i) = Ayy(i)
154     !!$ A(6,i) = Ayz(i)
155     !!$
156     !!$ A(7,i) = Azx(i)
157     !!$ A(8,i) = Azy(i)
158     !!$ A(9,i) = Azz(i)
159     !!$ end do
160 chuckv 167
161    
162 chuckv 194
163     if (present(TotPE)) do_pot = .true.
164    
165 chuckv 185 rlstsq = rlist * rlist
166     rcutsq = rcut * rcut
167     rrfsq = rrf * rrf
168 chuckv 167
169 chuckv 185 prerf = 14.39257d0 * 2.0d0 * ( dielectric - 1.0d0 ) / &
170     ( ( 2.0d0 * dielectric + 1.0d0 ) * rrfsq * rrf )
171 chuckv 167
172 chuckv 191
173 chuckv 185 ! ** zero forces **
174 chuckv 191 f = 0.0_dp
175     t = 0.0_dp
176     rF = 0.0_dp
177 chuckv 167
178 chuckv 191 TotPE = 0.0_dp
179 chuckv 167
180    
181    
182 chuckv 185 if ( update ) then
183 chuckv 167
184    
185 chuckv 185 ! ** save current configuration, construct **
186     ! ** neighbour list and calculate forces **
187 chuckv 167
188 chuckv 185 call long_range_save(natoms,rx,ry,rz,rx0,ry0,rz0)
189 chuckv 167
190 chuckv 185 nlist = 0
191    
192     do i = 1, natoms - 1
193    
194     point(i) = nlist + 1
195    
196 chuckv 194 q_i(1:nDim) = q(1:nDim,i)
197 chuckv 191
198 chuckv 185 rxi = rx(i)
199     ryi = ry(i)
200     rzi = rz(i)
201    
202     do j = i + 1, natoms
203    
204 chuckv 194 q_ij(1:nDim) = q(1:nDim,j) - q_i(1:nDim)
205 chuckv 185 rxij = rx(j) - rxi
206     ryij = ry(j) - ryi
207     rzij = rz(j) - rzi
208    
209     exclude = .false.
210    
211     if( check_exclude ) then
212    
213     do k = 1, n_pairs
214    
215     ! add 1 for c -> fortran indexing
216     ix = pair_i(k) + 1
217     jx = pair_j(k) + 1
218     exclude_temp1 = (i.eq.ix).and.(j.eq.jx)
219     exclude_temp2 = (i.eq.jx).and.(j.eq.ix)
220    
221     if(exclude_temp1.or.exclude_temp2) then
222    
223     exclude = .true.
224     endif
225     enddo
226     endif
227    
228     if(.not.exclude) then
229    
230     rxij = rxij - box_x * dsign( 1.0d0, rxij ) &
231     * int( (dabs( rxij / box_x ) + 0.5d0) )
232     ryij = ryij - box_y * dsign( 1.0d0, ryij ) &
233     * int( (dabs( ryij / box_y ) + 0.5d0) )
234     rzij = rzij - box_z * dsign( 1.0d0, rzij ) &
235     * int( (dabs( rzij / box_z ) + 0.5d0) )
236    
237     rijsq = rxij * rxij + ryij * ryij + rzij * rzij
238    
239     if ( rijsq .lt. rlstsq ) then
240    
241     nlist = nlist + 1
242     list(nlist) = j
243    
244     ! ** remove this check if maxnab is appropriate **
245    
246     if ( nlist .eq. maxnab ) then
247     write(*,*) i, j, nlist, maxnab, rijsq, rlstsq
248     stop 'list too small'
249     endif
250    
251     if ( rijsq .lt. rcutsq ) then
252    
253     if ( is_vdw(i) .and. is_vdw(j) ) then
254     call force_VDW( i, j, rcutsq, rijsq, sigma, epslon, &
255     v, fx, fy, fz, rxij, ryij, rzij, natoms )
256     endif
257    
258     if ( is_lj(i) .and. is_lj(j) ) then
259     call force_lj( i, j, rcutsq, rijsq, sigma, epslon, v, &
260     fx, fy, fz, rxij, ryij, rzij, natoms )
261     endif
262    
263     if( is_ssd(i) .and. is_ssd(j) ) then
264    
265     rij = dsqrt(rijsq);
266    
267     call ssd_forces( natoms, i, j, i, j, rxij, ryij, rzij, &
268     rij, v, rijsq, fx, fy, fz, tx, ty, tz, A )
269     end if
270    
271     endif
272    
273     if( is_dipole(i) .and. is_dipole(j) ) then
274     if( rijsq .lt. rrfsq ) then
275    
276     call dipole_rf( i, j, rrfsq, rijsq, v, rxij, ryij, &
277     rzij, rrf, dielectric, rtaper, natoms, &
278     ux, uy, uz, mu, fx, fy, fz, tx, ty, tz, &
279     ex, ey, ez, prerf )
280     endif
281     end if
282     endif
283     endif
284    
285     enddo
286    
287     end do
288    
289     point(natoms) = nlist + 1
290    
291     else
292    
293    
294     !** use the list to find the neighbours **
295    
296     do i = 1, natoms - 1
297    
298     jbeg = point(i)
299     jend = point(i+1) - 1
300    
301     !** check that atom i has neighbours **
302    
303     if( jbeg .le. jend ) then
304    
305     rxi = rx(i)
306     ryi = ry(i)
307     rzi = rz(i)
308    
309     do jnab = jbeg, jend
310    
311     j = list(jnab)
312    
313     rxij = rx(j) - rxi
314     ryij = ry(j) - ryi
315     rzij = rz(j) - rzi
316    
317     rxij = rxij - box_x * dsign( 1.0d0, rxij ) &
318     * int( dabs( rxij / box_x ) + 0.5d0 )
319     ryij = ryij - box_y * dsign( 1.0d0, ryij ) &
320     * int( dabs( ryij / box_y ) + 0.5d0 )
321     rzij = rzij - box_z * dsign( 1.0d0, rzij ) &
322     * int( dabs( rzij / box_z ) + 0.5d0 )
323    
324     rijsq = rxij * rxij + ryij * ryij + rzij * rzij
325    
326     if ( rijsq .lt. rcutsq ) then
327    
328     if ( is_vdw(i) .and. is_vdw(j) ) then
329     call force_VDW( i, j, rcutsq, rijsq, sigma, epslon, &
330     v, fx, fy, fz, rxij, ryij, rzij, natoms )
331     endif
332    
333     if ( is_lj(i) .and. is_lj(j) ) then
334     call force_lj( i, j, rcutsq, rijsq, sigma, epslon, v, &
335     fx, fy, fz, rxij, ryij, rzij, natoms )
336     endif
337    
338     if( is_ssd(i) .and. is_ssd(j) ) then
339    
340     rij = dsqrt(rijsq);
341    
342     call ssd_forces( natoms, i, j, i, j, rxij, ryij, rzij, &
343     rij, v, rijsq, fx, fy, fz, tx, ty, tz, A )
344     end if
345    
346     endif
347    
348    
349     if( is_dipole(i) .and. is_dipole(j) ) then
350     if( rijsq .lt. rrfsq ) then
351    
352     call dipole_rf( i, j, rrfsq, rijsq, v, rxij, ryij, &
353     rzij, rrf, dielectric, rtaper, natoms, &
354     ux, uy, uz, mu, fx, fy, fz, tx, ty, tz, &
355     ex, ey, ez, prerf )
356     endif
357     endif
358    
359     end do
360     endif
361     end do
362     endif
363    
364     ! calculate the reaction field effect
365    
366 chuckv 167 !!$ call reaction_field( v, prerf, natoms, mu, ux, uy, uz, tx, ty, tz, &
367     !!$ ex, ey, ez, is_dipole )
368    
369    
370 chuckv 185 end subroutine long_range_force
371 chuckv 167
372    
373    
374 chuckv 185 subroutine long_range_check ( rcut, rlist, update, natoms, &
375     rx,ry,rz,rx0,ry0,rz0)
376 chuckv 167
377    
378 chuckv 185 !*******************************************************************
379     !** decides whether the list needs to be reconstructed. **
380     !** **
381     !** principal variables: **
382     !** **
383     !** real rx(n),ry(n),rz(n) atom positions **
384     !** real rx0(n),ry0(n),rz0(n) coordinates at last update **
385     !** real rlist radius of verlet list **
386     !** real rcut cutoff distance for forces **
387     !** real dispmx largest displacement **
388     !** integer n number of atoms **
389     !** logical update if true the list is updated **
390     !** **
391     !** usage: **
392     !** **
393     !** check is called to set update before every call to force. **
394     !*******************************************************************
395 chuckv 167
396    
397 chuckv 185 ! Passed variables
398 chuckv 167
399 chuckv 185 integer :: natoms
400 chuckv 167
401 chuckv 185 logical(kind=2) :: update
402 chuckv 167
403 chuckv 185 double precision rcut, rlist
404 chuckv 167
405 chuckv 185 ! Passed arrays
406     double precision, dimension(natoms) :: rx, ry, rz
407     double precision, dimension(natoms) :: rx0, ry0, rz0
408 chuckv 167
409 chuckv 185 ! local variables
410 chuckv 167
411 chuckv 185 double precision dispmx
412 chuckv 167
413 chuckv 185 integer :: i
414 chuckv 167
415 chuckv 185 !*******************************************************************
416 chuckv 167
417 chuckv 185 !** calculate maximum displacement since last update **
418 chuckv 167
419 chuckv 185 dispmx = 0.0d0
420 chuckv 167
421 chuckv 185 do i = 1, natoms
422    
423     !write(*,*) 'calling displacement', i
424    
425     dispmx = max ( dabs ( rx(i) - rx0(i) ), dispmx )
426     dispmx = max ( dabs ( ry(i) - ry0(i) ), dispmx )
427     dispmx = max ( dabs ( rz(i) - rz0(i) ), dispmx )
428    
429     !write(*,*) 'called displacement', i
430    
431     end do
432    
433     !** a conservative test of the list skin crossing **
434    
435     dispmx = 2.0d0 * dsqrt ( 3.0d0 * dispmx ** 2 )
436    
437     update = ( dispmx .gt. ( rlist - rcut ) )
438    
439    
440     return
441     end subroutine long_range_check
442    
443    
444    
445     subroutine long_range_save(natoms,rx,ry,rz,rx0,ry0,rz0)
446    
447    
448     !*******************************************************************
449     !** saves current configuration for future checking. **
450     !** **
451     !** principal variables: **
452     !** **
453     !** real rx(n),ry(n),rz(n) atom positions **
454     !** real rx0(n),ry0(n),rz0(n) storage locations for save **
455     !** integer n number of atoms **
456     !** **
457     !** usage: **
458     !** **
459     !** save is called whenever the new verlet list is constructed. **
460     !*******************************************************************
461    
462     integer :: i
463    
464     integer :: natoms
465    
466     double precision, dimension(natoms) :: rx, ry, rz
467     double precision, dimension(natoms) :: rx0, ry0, rz0
468    
469     !*******************************************************************
470    
471     do i = 1, natoms
472    
473     rx0(i) = rx(i)
474     ry0(i) = ry(i)
475     rz0(i) = rz(i)
476    
477     end do
478    
479     return
480     end subroutine long_range_save
481    
482 chuckv 167 end module long_range_forces