ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/mdtools/md_code/f_longRange_module.F90
Revision: 191
Committed: Mon Dec 2 19:12:42 2002 UTC (21 years, 9 months ago) by chuckv
File size: 15341 byte(s)
Log Message:
Addition of c wrapper header for for fortran module proceedures.

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