ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE_old/src/mdtools/libmdCode/do_Forces.F90
(Generate patch)

Comparing trunk/OOPSE_old/src/mdtools/libmdCode/do_Forces.F90 (file contents):
Revision 309 by gezelter, Mon Mar 10 23:19:23 2003 UTC vs.
Revision 331 by chuckv, Thu Mar 13 00:33:18 2003 UTC

# Line 4 | Line 4
4  
5   !! @author Charles F. Vardeman II
6   !! @author Matthew Meineke
7 < !! @version $Id: do_Forces.F90,v 1.9 2003-03-10 23:19:23 gezelter Exp $, $Date: 2003-03-10 23:19:23 $, $Name: not supported by cvs2svn $, $Revision: 1.9 $
7 > !! @version $Id: do_Forces.F90,v 1.17 2003-03-13 00:33:18 chuckv Exp $, $Date: 2003-03-13 00:33:18 $, $Name: not supported by cvs2svn $, $Revision: 1.17 $
8  
9  
10  
11   module do_Forces
12    use simulation
13    use definitions
14 <  use forceGlobals
15 <  use atype_typedefs
16 <  use neighborLists
17 <
18 <  
14 >  use atype_module
15 >  use neighborLists  
16    use lj
17 <  use sticky_FF
17 >  use sticky_pair
18    use dipole_dipole
22  use gb_FF
19  
20   #ifdef IS_MPI
21    use mpiSimulation
# Line 27 | Line 23 | public :: do_force_loop
23    implicit none
24    PRIVATE
25  
26 < public :: do_force_loop
26 >  logical, save :: do_forces_initialized = .false.
27 >  logical, save :: FF_uses_LJ
28 >  logical, save :: FF_uses_sticky
29 >  logical, save :: FF_uses_dipoles
30 >  logical, save :: FF_uses_RF
31 >  logical, save :: FF_uses_GB
32 >  logical, save :: FF_uses_EAM
33  
32 contains
34  
35 < !! Does force loop over i,j pairs. Calls do_pair to calculates forces.
36 < !------------------------------------------------------------->
36 <  subroutine do_force_loop(q,A,mu,u_l,f,t,tau,potE,do_pot,FFerror)
37 < !! Position array provided by C, dimensioned by getNlocal
38 <    real ( kind = dp ), dimension(3,getNlocal()) :: q
39 <  !! Rotation Matrix for each long range particle in simulation.
40 <    real( kind = dp), dimension(9,getNlocal()) :: A
35 >  public :: init_FF
36 >  public :: do_force_loop
37  
38 <  !! Magnitude dipole moment
43 <    real( kind = dp ), dimension(3,getNlocal()) :: mu
44 <  !! Unit vectors for dipoles (lab frame)
45 <    real( kind = dp ), dimension(3,getNlocal()) :: u_l
46 < !! Force array provided by C, dimensioned by getNlocal
47 <    real ( kind = dp ), dimension(3,getNlocal()) :: f
48 < !! Torsion array provided by C, dimensioned by getNlocal
49 <    real( kind = dp ), dimension(3,getNlocal()) :: t
38 > contains
39  
40 < !! Stress Tensor
41 <    real( kind = dp), dimension(9) :: tau
40 >  subroutine init_FF(thisStat)
41 >    integer, intent(out) :: thisStat  
42 >    integer :: my_status
43 >    character(len = 100) :: mix_Policy
44  
45 <    real ( kind = dp ) :: potE
46 <    logical ( kind = 2) :: do_pot
47 <    integer :: FFerror
48 <
45 >    ! be a smarter subroutine.
46 >    mix_Policy = "FIXME"
47 >    thisStat = 0
48 >    call init_lj_FF(mix_Policy,my_status)
49 >    if (my_status /= 0) then
50 >       thisStat = -1
51 >       return
52 >    end if
53      
54 <    type(atype), pointer :: Atype_i
55 <    type(atype), pointer :: Atype_j
54 >    call check_sticky_FF(my_status)
55 >    if (my_status /= 0) then
56 >       thisStat = -1
57 >       return
58 >    end if
59 >    
60 >    do_forces_initialized = .true.    
61 >    
62 >  end subroutine init_FF
63  
64  
65  
66 <
67 <  
68 <
66 >  !! Does force loop over i,j pairs. Calls do_pair to calculates forces.
67 >  !------------------------------------------------------------->
68 >  subroutine do_force_loop(q, A, u_l, f, t, tau, pot, do_pot_c, do_stress_c, &
69 >       error)
70 >    !! Position array provided by C, dimensioned by getNlocal
71 >    real ( kind = dp ), dimension(3,getNlocal()) :: q
72 >    !! Rotation Matrix for each long range particle in simulation.
73 >    real( kind = dp), dimension(9,getNlocal()) :: A    
74 >    !! Unit vectors for dipoles (lab frame)
75 >    real( kind = dp ), dimension(3,getNlocal()) :: u_l
76 >    !! Force array provided by C, dimensioned by getNlocal
77 >    real ( kind = dp ), dimension(3,getNlocal()) :: f
78 >    !! Torsion array provided by C, dimensioned by getNlocal
79 >    real( kind = dp ), dimension(3,getNlocal()) :: t    
80 >    !! Stress Tensor
81 >    real( kind = dp), dimension(9) :: tau  
82 >    real ( kind = dp ) :: pot
83 >    logical ( kind = 2) :: do_pot_c, do_stress_c
84 >    logical :: do_pot
85 >    logical :: do_stress
86   #ifdef IS_MPI
87 <  real( kind = DP ) :: pot_local
88 <
89 < !! Local arrays needed for MPI
71 <
72 < #endif
73 <
74 <
75 <
76 <  real( kind = DP )   :: pe
77 <  logical             :: update_nlist
78 <
79 <
80 <  integer ::  i, j, jbeg, jend, jnab, idim, jdim, idim2, jdim2, dim, dim2
81 <  integer :: nlist
82 <  integer :: j_start
83 <
84 <  real( kind = DP ) ::  r_ij, pot, ftmp, dudr, d2, drdx1, kt1, kt2, kt3, ktmp
85 <
86 <  real( kind = DP ) ::  rx_ij, ry_ij, rz_ij, rijsq
87 <  real( kind = DP ) ::  rlistsq, rcutsq,rlist,rcut
88 <
89 <  
90 <
91 < ! a rig that need to be fixed.
92 < #ifdef IS_MPI
93 <  real( kind = dp ) :: pe_local
94 <  integer :: nlocal
87 >    real( kind = DP ) :: pot_local
88 >    integer :: nrow
89 >    integer :: ncol
90   #endif
91 <  integer :: nrow
92 <  integer :: ncol
93 <  integer :: natoms
94 <  integer :: neighborListSize
95 <  integer :: listerror
96 < !! should we calculate the stress tensor
97 <  logical  :: do_stress = .false.
91 >    integer :: nlocal
92 >    integer :: natoms    
93 >    logical :: update_nlist  
94 >    integer :: i, j, jbeg, jend, jnab
95 >    integer :: nlist
96 >    real( kind = DP ) ::  rijsq, rlistsq, rcutsq, rlist, rcut
97 >    real(kind=dp),dimension(3) :: d
98 >    real(kind=dp) :: rfpot, mu_i, virial
99 >    integer :: me_i
100 >    logical :: is_dp_i
101 >    integer :: neighborListSize
102 >    integer :: listerror, error
103 >    integer :: localError
104  
105 +    !! initialize local variables  
106  
105  FFerror = 0
106
107 ! Make sure we are properly initialized.
108  if (.not. isFFInit) then
109     write(default_error,*) "ERROR: lj_FF has not been properly initialized"
110     FFerror = -1
111     return
112  endif
107   #ifdef IS_MPI
108 <    if (.not. isMPISimSet()) then
109 <     write(default_error,*) "ERROR: mpiSimulation has not been properly initialized"
110 <     FFerror = -1
111 <     return
112 <  endif
108 >    nlocal = getNlocal()
109 >    nrow   = getNrow(plan_row)
110 >    ncol   = getNcol(plan_col)
111 > #else
112 >    nlocal = getNlocal()
113 >    natoms = nlocal
114   #endif
115  
116 < !! initialize local variables  
117 <  natoms = getNlocal()
118 <  call getRcut(rcut,rcut2=rcutsq)
119 <  call getRlist(rlist,rlistsq)
116 >    call getRcut(rcut,rc2=rcutsq)
117 >    call getRlist(rlist,rlistsq)
118 >    
119 >    call check_initialization(localError)
120 >    if ( localError .ne. 0 ) then
121 >       error = -1
122 >       return
123 >    end if
124 >    call zero_work_arrays()
125  
126 < !! Find ensemble
127 <  if (isEnsemble("NPT")) do_stress = .true.
128 < !! set to wrap
129 <  if (isPBC()) wrap = .true.
126 >    do_pot = do_pot_c
127 >    do_stress = do_stress_c
128  
129 <
130 <
133 <  
134 < !! See if we need to update neighbor lists
135 <  call check(q,update_nlist)
136 <
137 < !--------------WARNING...........................
138 < ! Zero variables, NOTE:::: Forces are zeroed in C
139 < ! Zeroing them here could delete previously computed
140 < ! Forces.
141 < !------------------------------------------------
142 <  call zero_module_variables()
143 <
144 <
145 < ! communicate MPI positions
129 >    ! Gather all information needed by all force loops:
130 >    
131   #ifdef IS_MPI    
132 +
133      call gather(q,q_Row,plan_row3d)
134      call gather(q,q_Col,plan_col3d)
135 <
136 <    call gather(u_l,u_l_Row,plan_row3d)
137 <    call gather(u_l,u_l_Col,plan_col3d)
138 <
139 <    call gather(A,A_Row,plan_row_rotation)
140 <    call gather(A,A_Col,plan_col_rotation)
135 >        
136 >    if (FF_UsesDirectionalAtoms() .and. SimUsesDirectionalAtoms()) then
137 >       call gather(u_l,u_l_Row,plan_row3d)
138 >       call gather(u_l,u_l_Col,plan_col3d)
139 >      
140 >       call gather(A,A_Row,plan_row_rotation)
141 >       call gather(A,A_Col,plan_col_rotation)
142 >    endif
143 >    
144   #endif
145 <
146 <
145 >    
146 >    if (FF_RequiresPrepairCalc() .and. SimRequiresPrepairCalc()) then
147 >       !! See if we need to update neighbor lists
148 >       call checkNeighborList(nlocal, q, rcut, rlist, update_nlist)  
149 >       !! if_mpi_gather_stuff_for_prepair
150 >       !! do_prepair_loop_if_needed
151 >       !! if_mpi_scatter_stuff_from_prepair
152 >       !! if_mpi_gather_stuff_from_prepair_to_main_loop
153 >    else
154 >       !! See if we need to update neighbor lists
155 >       call checkNeighborList(nlocal, q, rcut, rlist, update_nlist)  
156 >    endif
157 >    
158   #ifdef IS_MPI
159      
160      if (update_nlist) then
161        
162 <       ! save current configuration, contruct neighbor list,
163 <       ! and calculate forces
162 >       !! save current configuration, construct neighbor list,
163 >       !! and calculate forces
164         call save_neighborList(q)
165        
166         neighborListSize = getNeighborListSize()
167 <       nlist = 0
167 >       nlist = 0      
168        
169       nrow = getNrow(plan_row)
170       ncol = getNcol(plan_col)
171       nlocal = getNlocal()
172      
169         do i = 1, nrow
170            point(i) = nlist + 1
175          Atype_i => identPtrListRow(i)%this
171            
172            inner: do j = 1, ncol
178             Atype_j => identPtrListColumn(j)%this
173              
174 <             call get_interatomic_vector(i,j,q_Row(:,i),q_Col(:,j),&
181 <                  rxij,ryij,rzij,rijsq,r)
174 >             if (checkExcludes(i,j)) cycle inner
175              
176 <             ! skip the loop if the atoms are identical
184 <             if (mpi_cycle_jLoop(i,j)) cycle inner:
176 >             call get_interatomic_vector(q_Row(:,i), q_Col(:,j), d, rijsq)
177              
178               if (rijsq <  rlistsq) then            
179                  
180                  nlist = nlist + 1
181                  
182                  if (nlist > neighborListSize) then
183 <                   call expandList(listerror)
183 >                   call expandNeighborList(nlocal, listerror)
184                     if (listerror /= 0) then
185 <                      FFerror = -1
185 >                      error = -1
186                        write(DEFAULT_ERROR,*) "ERROR: nlist > list size and max allocations exceeded."
187                        return
188                     end if
189                  endif
190                  
191                  list(nlist) = j
192 <                
201 <                
192 >                                
193                  if (rijsq <  rcutsq) then
194 <                   call do_pair(Atype_i,Atype_j,i,j,r,rxij,ryij,rzij)
194 >                   call do_pair(i, j, rijsq, d, do_pot, do_stress)
195                  endif
196               endif
197            enddo inner
# Line 208 | Line 199 | contains
199  
200         point(nrow + 1) = nlist + 1
201        
202 <    else !! (update)
202 >    else  !! (of update_check)
203  
204         ! use the list to find the neighbors
205         do i = 1, nrow
# Line 216 | Line 207 | contains
207            JEND = POINT(i+1) - 1
208            ! check thiat molecule i has neighbors
209            if (jbeg .le. jend) then
210 <
220 <             Atype_i => identPtrListRow(i)%this
210 >            
211               do jnab = jbeg, jend
212                  j = list(jnab)
213 <                Atype_j = identPtrListColumn(j)%this
214 <                call get_interatomic_vector(i,j,q_Row(:,i),q_Col(:,j),&
215 <                     rxij,ryij,rzij,rijsq,r)
216 <                
227 <                call do_pair(Atype_i,Atype_j,i,j,r,rxij,ryij,rzij)
213 >
214 >                call get_interatomic_vector(q_Row(:,i), q_Col(:,j), d, rijsq)
215 >                call do_pair(i, j, rijsq, d, do_pot, do_stress)
216 >
217               enddo
218            endif
219         enddo
220      endif
221 <
221 >    
222   #else
223      
224      if (update_nlist) then
# Line 241 | Line 230 | contains
230         neighborListSize = getNeighborListSize()
231         nlist = 0
232        
244    
233         do i = 1, natoms-1
234            point(i) = nlist + 1
235 <          Atype_i   => identPtrList(i)%this
248 <
235 >          
236            inner: do j = i+1, natoms
237 <             Atype_j   => identPtrList(j)%this
238 <             call get_interatomic_vector(i,j,q(:,i),q(:,j),&
239 <                  rxij,ryij,rzij,rijsq,r)
237 >            
238 >             if (checkExcludes(i,j)) cycle inner
239 >            
240 >             call get_interatomic_vector(q(:,i), q(:,j), d, rijsq)
241            
242               if (rijsq <  rlistsq) then
243 <
243 >                
244                  nlist = nlist + 1
245                  
246                  if (nlist > neighborListSize) then
247 <                   call expandList(listerror)
247 >                   call expandList(natoms, listerror)
248                     if (listerror /= 0) then
249 <                      FFerror = -1
249 >                      error = -1
250                        write(DEFAULT_ERROR,*) "ERROR: nlist > list size and max allocations exceeded."
251                        return
252                     end if
253                  endif
254                  
255                  list(nlist) = j
256 <
269 <    
256 >                
257                  if (rijsq <  rcutsq) then
258 <                   call do_pair(Atype_i,Atype_j,i,j,r,rxij,ryij,rzij)
258 >                   call do_pair(i, j, rijsq, d, do_pot, do_stress)
259                  endif
260               endif
261            enddo inner
# Line 279 | Line 266 | contains
266      else !! (update)
267        
268         ! use the list to find the neighbors
269 <       do i = 1, nrow
269 >       do i = 1, natoms-1
270            JBEG = POINT(i)
271            JEND = POINT(i+1) - 1
272            ! check thiat molecule i has neighbors
273            if (jbeg .le. jend) then
274              
288             Atype_i => identPtrList(i)%this
275               do jnab = jbeg, jend
276                  j = list(jnab)
277 <                Atype_j = identPtrList(j)%this
278 <                call get_interatomic_vector(i,j,q(:,i),q(:,j),&
279 <                     rxij,ryij,rzij,rijsq,r)
280 <                call do_pair(Atype_i,Atype_j,i,j,r,rxij,ryij,rzij)
277 >
278 >                call get_interatomic_vector(q(:,i), q(:,j), d, rijsq)
279 >                call do_pair(i, j, rijsq, d, do_pot, do_stress)
280 >
281               enddo
282            endif
283         enddo
284      endif
285 <
285 >    
286   #endif
287 <
288 <
287 >    
288 >    ! phew, done with main loop.
289 >    
290   #ifdef IS_MPI
304    !! distribute all reaction field stuff (or anything for post-pair):
305    call scatter(rflRow,rflTemp1,plan_row3d)
306    call scatter(rflCol,rflTemp2,plan_col3d)
307    do i = 1,nlocal
308       rflTemp(1:3,i) = rflTemp1(1:3,i) + rflTemp2(1:3,i)
309    end do
310 #endif
311
312 ! This is the post-pair loop:
313 #ifdef IS_MPI
314
315    if (system_has_postpair_atoms) then
316       do i = 1, nlocal
317          Atype_i => identPtrListRow(i)%this
318          call do_postpair(i, Atype_i)
319       enddo
320    endif
321
322 #else
323
324    if (system_has_postpair_atoms) then
325       do i = 1, natoms
326          Atype_i => identPtr(i)%this
327          call do_postpair(i, Atype_i)
328       enddo
329    endif
330
331 #endif
332
333
334 #ifdef IS_MPI
291      !!distribute forces
292 <
292 >    
293      call scatter(f_Row,f,plan_row3d)
294      call scatter(f_Col,f_temp,plan_col3d)
295      do i = 1,nlocal
296         f(1:3,i) = f(1:3,i) + f_temp(1:3,i)
297      end do
298 <
299 <    if (doTorque()) then
298 >    
299 >    if (FF_UsesDirectionalAtoms() .and. SimUsesDirectionalAtoms()) then
300         call scatter(t_Row,t,plan_row3d)
301         call scatter(t_Col,t_temp,plan_col3d)
302 <    
302 >      
303         do i = 1,nlocal
304            t(1:3,i) = t(1:3,i) + t_temp(1:3,i)
305         end do
# Line 366 | Line 322 | contains
322            pot_local = pot_local + pot_Temp(i)
323         enddo
324        
325 +    endif    
326 + #endif
327 +
328 +    if (FF_RequiresPostpairCalc() .and. SimRequiresPostpairCalc()) then
329 +      
330 +       if (FF_uses_RF .and. SimUsesRF()) then
331 +          
332 + #ifdef IS_MPI
333 +          call scatter(rf_Row,rf,plan_row3d)
334 +          call scatter(rf_Col,rf_Temp,plan_col3d)
335 +          do i = 1,nlocal
336 +             rf(1:3,i) = rf(1:3,i) + rf_Temp(1:3,i)
337 +          end do
338 + #endif
339 +          
340 +          do i = 1, getNlocal()
341 +
342 +             rfpot = 0.0_DP
343 + #ifdef IS_MPI
344 +             me_i = atid_row(i)
345 + #else
346 +             me_i = atid(i)
347 + #endif
348 +             call getElementProperty(atypes, me_i, "is_DP", is_DP_i)      
349 +             if ( is_DP_i ) then
350 +                call getElementProperty(atypes, me_i, "dipole_moment", mu_i)
351 +                !! The reaction field needs to include a self contribution
352 +                !! to the field:
353 +                call accumulate_self_rf(i, mu_i, u_l)            
354 +                !! Get the reaction field contribution to the
355 +                !! potential and torques:
356 +                call reaction_field_final(i, mu_i, u_l, rfpot, t, do_pot)
357 + #ifdef IS_MPI
358 +                pot_local = pot_local + rfpot
359 + #else
360 +                pot = pot + rfpot
361 + #endif
362 +             endif            
363 +          enddo
364 +       endif
365 +    endif
366 +
367 +
368 + #ifdef IS_MPI
369 +
370 +    if (do_pot) then
371         pot = pot_local
372 +       !! we assume the c code will do the allreduce to get the total potential
373 +       !! we could do it right here if we needed to...
374      endif
375  
376 <    if (doStress()) then
377 <       mpi_allreduce(tau, tau_Temp,9,mpi_double_precision,mpi_sum, &
376 >    if (do_stress) then
377 >       call mpi_allreduce(tau, tau_Temp,9,mpi_double_precision,mpi_sum, &
378              mpi_comm_world,mpi_err)
379 <       mpi_allreduce(virial, virial_Temp,1,mpi_double_precision,mpi_sum, &
379 >       call mpi_allreduce(virial, virial_Temp,1,mpi_double_precision,mpi_sum, &
380              mpi_comm_world,mpi_err)
381      endif
382  
383 < #endif
383 > #else
384  
385 <    if (doStress()) then
385 >    if (do_stress) then
386         tau = tau_Temp
387         virial = virial_Temp
388      endif
389  
390 + #endif
391 +    
392    end subroutine do_force_loop
393  
394  
# Line 394 | Line 400 | contains
400  
401    end subroutine do_preForce
402  
403 <
398 <
399 <
400 <
401 <
402 <
403 <
404 <
405 <
406 <
407 <
408 <
409 < !! Calculate any post force loop components, i.e. reaction field, etc.
403 >  !! Calculate any post force loop components, i.e. reaction field, etc.
404    subroutine do_postForce()
405  
406  
407  
408    end subroutine do_postForce
409  
410 +  subroutine do_pair(i, j, rijsq, d, do_pot, do_stress)
411  
412 +    real( kind = dp ) :: pot
413 +    real( kind = dp ), dimension(3,getNlocal()) :: u_l
414 +    real (kind=dp), dimension(9,getNlocal()) :: A
415 +    real (kind=dp), dimension(3,getNlocal()) :: f
416 +    real (kind=dp), dimension(3,getNlocal()) :: t
417  
418 +    logical, intent(inout) :: do_pot, do_stress
419 +    integer, intent(in) :: i, j
420 +    real ( kind = dp ), intent(inout)    :: rijsq
421 +    real ( kind = dp )                :: r
422 +    real ( kind = dp ), intent(inout) :: d(3)
423 +    logical :: is_LJ_i, is_LJ_j
424 +    logical :: is_DP_i, is_DP_j
425 +    logical :: is_Sticky_i, is_Sticky_j
426 +    integer :: me_i, me_j
427  
428 <
420 <
421 <
422 <
423 <
424 <
425 <
426 <
427 <
428 <
429 <
430 <
431 <
432 <  subroutine do_pair(atype_i,atype_j,i,j,r_ij,rx_ij,ry_ij,rz_ij)
433 <    type (atype ), pointer, intent(inout) :: atype_i
434 <    type (atype ), pointer, intent(inout) :: atype_j
435 <    integer :: i
436 <    integer :: j
437 <    real ( kind = dp ), intent(inout) :: rx_ij
438 <    real ( kind = dp ), intent(inout) :: ry_ij
439 <    real ( kind = dp ), intent(inout) :: rz_ij
440 <
441 <
442 <    real( kind = dp ) :: fx = 0.0_dp
443 <    real( kind = dp ) :: fy = 0.0_dp
444 <    real( kind = dp ) :: fz = 0.0_dp  
445 <  
446 <    real( kind = dp ) ::  drdx = 0.0_dp
447 <    real( kind = dp ) ::  drdy = 0.0_dp
448 <    real( kind = dp ) ::  drdz = 0.0_dp
428 >    r = sqrt(rijsq)
429      
450
430   #ifdef IS_MPI
431  
432 <    if (Atype_i%is_LJ .and. Atype_j%is_LJ) then
433 <       call do_lj_pair(i, j, atype_i, atype_j, rx_ij, ry_ij, rz_ij, r_ij, &
455 <            pot, f)
456 <    endif
432 >    me_i = atid_row(i)
433 >    me_j = atid_col(j)
434  
435 <    if (Atype_i%is_dp .and. Atype_j%is_dp) then
435 > #else
436  
437 <       call do_dipole_pair(i, j, atype_i, atype_j, rx_ij, ry_ij, rz_ij, r_ij, &
438 <            rt, rrf, pot, u_l, f, t)
437 >    me_i = atid(i)
438 >    me_j = atid(j)
439  
440 <       if (do_reaction_field) then
464 <          call accumulate_rf(i, j, r_ij, rt, rrf)
465 <       endif
440 > #endif
441  
467    endif
442  
443 <    if (Atype_i%is_sticky .and. Atype_j%is_sticky) then
444 <       call getstickyforce(r, pot, dudr, Atype_i, Atype_j)
443 >    if (FF_uses_LJ .and. SimUsesLJ()) then
444 >       call getElementProperty(atypes, me_i, "is_LJ", is_LJ_i)
445 >       call getElementProperty(atypes, me_j, "is_LJ", is_LJ_j)
446 >      
447 >       if ( is_LJ_i .and. is_LJ_j ) &
448 >            call do_lj_pair(i, j, d, r, rijsq, pot, f, do_pot, do_stress)
449      endif
450 +      
451  
452 < #else
453 <
454 <    if (Atype_i%is_LJ .and. Atype_j%is_LJ) then
455 <       call do_lj_pair(i, j, atype_i, atype_j, rx_ij, ry_ij, rz_ij, r_ij, &
456 <            pot, f)
452 >    if (FF_uses_dipoles .and. SimUsesDipoles()) then
453 >       call getElementProperty(atypes, me_i, "is_DP", is_DP_i)
454 >       call getElementProperty(atypes, me_j, "is_DP", is_DP_j)
455 >      
456 >       if ( is_DP_i .and. is_DP_j ) then
457 >          
458 >          call do_dipole_pair(i, j, d, r, pot, u_l, f, t, do_pot, do_stress)
459 >          
460 >          if (FF_uses_RF .and. SimUsesRF()) then
461 >            
462 >             call accumulate_rf(i, j, r, u_l)
463 >             call rf_correct_forces(i, j, d, r, u_l, f, do_stress)
464 >            
465 >          endif
466 >          
467 >       endif
468      endif
469  
470 <    if (Atype_i%is_dp .and. Atype_j%is_dp) then
481 <       call do_dipole_pair(i, j, atype_i, atype_j, rx_ij, ry_ij, rz_ij, r_ij, &
482 <            rt, rrf, pot, u_l, f, t)
470 >    if (FF_uses_Sticky .and. SimUsesSticky()) then
471  
472 <       if (do_reaction_field) then
473 <          call accumulate_rf(i, j, r_ij, rt, rrf)
472 >       call getElementProperty(atypes, me_i, "is_Sticky", is_Sticky_i)
473 >       call getElementProperty(atypes, me_j, "is_Sticky", is_Sticky_j)
474 >      
475 >       if ( is_Sticky_i .and. is_Sticky_j ) then
476 >          call do_sticky_pair(i, j, d, r, rijsq, A, pot, f, t, &
477 >               do_pot, do_stress)
478         endif
487
479      endif
489
490    if (Atype_i%is_sticky .and. Atype_j%is_sticky) then
491       call getstickyforce(r,pot,dudr, Atype_i, Atype_j)
492    endif
493
494 #endif
495
480        
481    end subroutine do_pair
482  
483  
484 +  subroutine get_interatomic_vector(q_i, q_j, d, r_sq)
485 +    
486 +    real (kind = dp), dimension(3) :: q_i
487 +    real (kind = dp), dimension(3) :: q_j
488 +    real ( kind = dp ), intent(out) :: r_sq
489 +    real( kind = dp ) :: d(3)
490  
491 +    d(1:3) = q_i(1:3) - q_j(1:3)
492 +    
493 +    ! Wrap back into periodic box if necessary
494 +    if ( SimUsesPBC() ) then
495 +       d(1:3) = d(1:3) - box(1:3) * sign(1.0_dp,box(1:3)) * &
496 +            int(abs(d(1:3)/box(1:3) + 0.5_dp))
497 +    endif
498 +    
499 +    r_sq = dot_product(d,d)
500 +        
501 +  end subroutine get_interatomic_vector
502  
503 +  subroutine check_initialization(error)
504 +    integer, intent(out) :: error
505  
506 +    error = 0
507 +    ! Make sure we are properly initialized.
508 +    if (.not. do_Forces_initialized) then
509 +       write(default_error,*) "ERROR: do_Forces has not been initialized!"
510 +       error = -1
511 +       return
512 +    endif
513 + #ifdef IS_MPI
514 +    if (.not. isMPISimSet()) then
515 +       write(default_error,*) "ERROR: mpiSimulation has not been initialized!"
516 +       error = -1
517 +       return
518 +    endif
519 + #endif
520  
521 +    return
522 +  end subroutine check_initialization
523  
524 <
525 <
526 <
527 <
509 <
510 <
524 >  
525 >  subroutine zero_work_arrays()
526 >    
527 > #ifdef IS_MPI
528  
529 <
530 <
514 <  subroutine get_interatomic_vector(q_i,q_j,rx_ij,ry_ij,rz_ij,r_sq,r_ij)
515 < !---------------- Arguments-------------------------------
516 <   !! index i
517 <
518 <    !! Position array
519 <    real (kind = dp), dimension(3) :: q_i
520 <    real (kind = dp), dimension(3) :: q_j
521 <    !! x component of vector between i and j
522 <    real ( kind = dp ), intent(out)  :: rx_ij
523 <    !! y component of vector between i and j
524 <    real ( kind = dp ), intent(out)  :: ry_ij
525 <    !! z component of vector between i and j
526 <    real ( kind = dp ), intent(out)  :: rz_ij
527 <    !! magnitude of r squared
528 <    real ( kind = dp ), intent(out) :: r_sq
529 <    !! magnitude of vector r between atoms i and j.
530 <    real ( kind = dp ), intent(out) :: r_ij
531 <    !! wrap into periodic box.
532 <    logical, intent(in) :: wrap
533 <
534 < !--------------- Local Variables---------------------------
535 <    !! Distance between i and j
536 <    real( kind = dp ) :: d(3)
537 < !---------------- END DECLARATIONS-------------------------
538 <
539 <
540 < ! Find distance between i and j
541 <    d(1:3) = q_i(1:3) - q_j(1:3)
542 <
543 < ! Wrap back into periodic box if necessary
544 <    if ( wrap ) then
545 <       d(1:3) = d(1:3) - thisSim%box(1:3) * sign(1.0_dp,thisSim%box(1:3)) * &
546 <            int(abs(d(1:3)/thisSim%box(1:3) + 0.5_dp)
547 <    end if
529 >    q_Row = 0.0_dp
530 >    q_Col = 0.0_dp  
531      
532 < !   Find Magnitude of the vector
533 <    r_sq = dot_product(d,d)
551 <    r_ij = sqrt(r_sq)
552 <
553 < !   Set each component for force calculation
554 <    rx_ij = d(1)
555 <    ry_ij = d(2)
556 <    rz_ij = d(3)
557 <
558 <
559 <  end subroutine get_interatomic_vector
560 <
561 <  subroutine zero_module_variables()
562 <
563 < #ifndef IS_MPI
564 <
565 <    pe = 0.0E0_DP
566 <    tauTemp = 0.0_dp
567 <    fTemp = 0.0_dp
568 <    tTemp = 0.0_dp
569 < #else
570 <    qRow = 0.0_dp
571 <    qCol = 0.0_dp
532 >    u_l_Row = 0.0_dp
533 >    u_l_Col = 0.0_dp
534      
535 <    muRow = 0.0_dp
536 <    muCol = 0.0_dp
535 >    A_Row = 0.0_dp
536 >    A_Col = 0.0_dp
537      
538 <    u_lRow = 0.0_dp
539 <    u_lCol = 0.0_dp
540 <    
541 <    ARow = 0.0_dp
542 <    ACol = 0.0_dp
543 <    
544 <    fRow = 0.0_dp
583 <    fCol = 0.0_dp
584 <    
585 <  
586 <    tRow = 0.0_dp
587 <    tCol = 0.0_dp
538 >    f_Row = 0.0_dp
539 >    f_Col = 0.0_dp
540 >    f_Temp = 0.0_dp
541 >      
542 >    t_Row = 0.0_dp
543 >    t_Col = 0.0_dp
544 >    t_Temp = 0.0_dp
545  
546 <  
546 >    pot_Row = 0.0_dp
547 >    pot_Col = 0.0_dp
548 >    pot_Temp = 0.0_dp
549  
591    eRow = 0.0_dp
592    eCol = 0.0_dp
593    eTemp = 0.0_dp
550   #endif
551  
552 <  end subroutine zero_module_variables
552 >    tau_Temp = 0.0_dp
553 >    virial_Temp = 0.0_dp
554 >    
555 >  end subroutine zero_work_arrays
556 >  
557  
558 +  !! Function to properly build neighbor lists in MPI using newtons 3rd law.
559 +  !! We don't want 2 processors doing the same i j pair twice.
560 +  !! Also checks to see if i and j are the same particle.
561  
599 !! Function to properly build neighbor lists in MPI using newtons 3rd law.
600 !! We don't want 2 processors doing the same i j pair twice.
601 !! Also checks to see if i and j are the same particle.
562    function checkExcludes(atom1,atom2) result(do_cycle)
563 < !--------------- Arguments--------------------------
564 < ! Index i
563 >    !--------------- Arguments--------------------------
564 >    ! Index i
565      integer,intent(in) :: atom1
566 < ! Index j
566 >    ! Index j
567      integer,intent(in), optional :: atom2
568 < ! Result do_cycle
568 >    ! Result do_cycle
569      logical :: do_cycle
570 < !--------------- Local variables--------------------
570 >    !--------------- Local variables--------------------
571      integer :: tag_i
572      integer :: tag_j
573 <    integer :: i
574 < !--------------- END DECLARATIONS------------------  
573 >    integer :: i, j
574 >    !--------------- END DECLARATIONS------------------  
575      do_cycle = .false.
576 <
576 >    
577   #ifdef IS_MPI
578      tag_i = tagRow(atom1)
579   #else
580      tag_i = tag(atom1)
581   #endif
582 <
583 < !! Check global excludes first
582 >    
583 >    !! Check global excludes first
584      if (.not. present(atom2)) then
585 <       do i = 1,nGlobalExcludes
585 >       do i = 1, nExcludes_global
586            if (excludeGlobal(i) == tag_i) then
587               do_cycle = .true.
588               return
# Line 631 | Line 591 | contains
591         return !! return after checking globals
592      end if
593  
594 < !! we return if j not present here.
595 <    tag_j = tagColumn(j)
596 <
637 <
638 <
594 >    !! we return if atom2 not present here.
595 >    tag_j = tagColumn(atom2)
596 >    
597      if (tag_i == tag_j) then
598         do_cycle = .true.
599         return
600      end if
601 <
601 >    
602      if (tag_i < tag_j) then
603         if (mod(tag_i + tag_j,2) == 0) do_cycle = .true.
604         return
605      else                
606         if (mod(tag_i + tag_j,2) == 1) do_cycle = .true.
607      endif
608 <
609 <
610 <
653 <    do i = 1, nLocalExcludes
654 <       if (tag_i = excludes(1,i) .and. excludes(2,i) < 0) then
608 >            
609 >    do i = 1, nExcludes_local
610 >       if ((tag_i == excludesLocal(1,i)) .and. (excludesLocal(2,i) < 0)) then
611            do_cycle = .true.
612            return
613         end if
614      end do
615 <      
616 <
615 >    
616 >    
617    end function checkExcludes
618  
619 <
619 >  function FF_UsesDirectionalAtoms() result(doesit)
620 >    logical :: doesit
621 >    doesit = FF_uses_dipoles .or. FF_uses_sticky .or. &
622 >         FF_uses_GB .or. FF_uses_RF
623 >  end function FF_UsesDirectionalAtoms
624 >  
625 >  function FF_RequiresPrepairCalc() result(doesit)
626 >    logical :: doesit
627 >    doesit = FF_uses_EAM
628 >  end function FF_RequiresPrepairCalc
629 >  
630 >  function FF_RequiresPostpairCalc() result(doesit)
631 >    logical :: doesit
632 >    doesit = FF_uses_RF
633 >  end function FF_RequiresPostpairCalc
634 >  
635   end module do_Forces

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines