ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-4/src/UseTheForce/doForces.F90
(Generate patch)

Comparing trunk/OOPSE-4/src/UseTheForce/doForces.F90 (file contents):
Revision 2204 by gezelter, Fri Apr 15 22:04:00 2005 UTC vs.
Revision 2398 by chrisfen, Wed Oct 26 23:31:18 2005 UTC

# Line 45 | Line 45
45  
46   !! @author Charles F. Vardeman II
47   !! @author Matthew Meineke
48 < !! @version $Id: doForces.F90,v 1.13 2005-04-15 22:03:37 gezelter Exp $, $Date: 2005-04-15 22:03:37 $, $Name: not supported by cvs2svn $, $Revision: 1.13 $
48 > !! @version $Id: doForces.F90,v 1.63 2005-10-26 23:31:18 chrisfen Exp $, $Date: 2005-10-26 23:31:18 $, $Name: not supported by cvs2svn $, $Revision: 1.63 $
49  
50  
51   module doForces
# Line 58 | Line 58 | module doForces
58    use lj
59    use sticky
60    use electrostatic_module
61 <  use reaction_field
62 <  use gb_pair
61 >  use gayberne
62    use shapes
63    use vector_class
64    use eam
# Line 73 | Line 72 | module doForces
72  
73   #define __FORTRAN90
74   #include "UseTheForce/fSwitchingFunction.h"
75 + #include "UseTheForce/fCutoffPolicy.h"
76 + #include "UseTheForce/DarkSide/fInteractionMap.h"
77 + #include "UseTheForce/DarkSide/fElectrostaticSummationMethod.h"
78  
79 +
80    INTEGER, PARAMETER:: PREPAIR_LOOP = 1
81    INTEGER, PARAMETER:: PAIR_LOOP    = 2
82  
80  logical, save :: haveRlist = .false.
83    logical, save :: haveNeighborList = .false.
84    logical, save :: haveSIMvariables = .false.
83  logical, save :: havePropertyMap = .false.
85    logical, save :: haveSaneForceField = .false.
86 +  logical, save :: haveInteractionHash = .false.
87 +  logical, save :: haveGtypeCutoffMap = .false.
88 +  logical, save :: haveDefaultCutoffs = .false.
89 +  logical, save :: haveRlist = .false.
90  
91    logical, save :: FF_uses_DirectionalAtoms
87  logical, save :: FF_uses_LennardJones
88  logical, save :: FF_uses_Electrostatics
89  logical, save :: FF_uses_Charges
92    logical, save :: FF_uses_Dipoles
91  logical, save :: FF_uses_Quadrupoles
92  logical, save :: FF_uses_sticky
93    logical, save :: FF_uses_GayBerne
94    logical, save :: FF_uses_EAM
95  logical, save :: FF_uses_Shapes
96  logical, save :: FF_uses_FLARB
97  logical, save :: FF_uses_RF
95  
96    logical, save :: SIM_uses_DirectionalAtoms
100  logical, save :: SIM_uses_LennardJones
101  logical, save :: SIM_uses_Electrostatics
102  logical, save :: SIM_uses_Charges
103  logical, save :: SIM_uses_Dipoles
104  logical, save :: SIM_uses_Quadrupoles
105  logical, save :: SIM_uses_Sticky
106  logical, save :: SIM_uses_GayBerne
97    logical, save :: SIM_uses_EAM
108  logical, save :: SIM_uses_Shapes
109  logical, save :: SIM_uses_FLARB
110  logical, save :: SIM_uses_RF
98    logical, save :: SIM_requires_postpair_calc
99    logical, save :: SIM_requires_prepair_calc
100    logical, save :: SIM_uses_PBC
114  logical, save :: SIM_uses_molecular_cutoffs
101  
102 <  real(kind=dp), save :: rlist, rlistsq
102 >  integer, save :: electrostaticSummationMethod
103  
104    public :: init_FF
105 +  public :: setDefaultCutoffs
106    public :: do_force_loop
107 <  public :: setRlistDF
107 >  public :: createInteractionHash
108 >  public :: createGtypeCutoffMap
109 >  public :: getStickyCut
110 >  public :: getStickyPowerCut
111 >  public :: getGayBerneCut
112 >  public :: getEAMCut
113 >  public :: getShapeCut
114  
115   #ifdef PROFILE
116    public :: getforcetime
# Line 125 | Line 118 | module doForces
118    real :: forceTimeInitial, forceTimeFinal
119    integer :: nLoops
120   #endif
121 +  
122 +  !! Variables for cutoff mapping and interaction mapping
123 +  ! Bit hash to determine pair-pair interactions.
124 +  integer, dimension(:,:), allocatable :: InteractionHash
125 +  real(kind=dp), dimension(:), allocatable :: atypeMaxCutoff
126 +  real(kind=dp), dimension(:), allocatable, target :: groupMaxCutoffRow
127 +  real(kind=dp), dimension(:), pointer :: groupMaxCutoffCol
128  
129 <  type :: Properties
130 <     logical :: is_Directional   = .false.
131 <     logical :: is_LennardJones  = .false.
132 <     logical :: is_Electrostatic = .false.
133 <     logical :: is_Charge        = .false.
134 <     logical :: is_Dipole        = .false.
135 <     logical :: is_Quadrupole    = .false.
136 <     logical :: is_Sticky        = .false.
137 <     logical :: is_GayBerne      = .false.
138 <     logical :: is_EAM           = .false.
139 <     logical :: is_Shape         = .false.
140 <     logical :: is_FLARB         = .false.
141 <  end type Properties
129 >  integer, dimension(:), allocatable, target :: groupToGtypeRow
130 >  integer, dimension(:), pointer :: groupToGtypeCol => null()
131  
132 <  type(Properties), dimension(:),allocatable :: PropertyMap
132 >  real(kind=dp), dimension(:), allocatable,target :: gtypeMaxCutoffRow
133 >  real(kind=dp), dimension(:), pointer :: gtypeMaxCutoffCol
134 >  type ::gtypeCutoffs
135 >     real(kind=dp) :: rcut
136 >     real(kind=dp) :: rcutsq
137 >     real(kind=dp) :: rlistsq
138 >  end type gtypeCutoffs
139 >  type(gtypeCutoffs), dimension(:,:), allocatable :: gtypeCutoffMap
140  
141 +  integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY
142 +  real(kind=dp),save :: defaultRcut, defaultRsw, defaultRlist
143 +  real(kind=dp),save :: listSkin
144 +  
145   contains
146  
147 <  subroutine setRlistDF( this_rlist )
148 <
149 <    real(kind=dp) :: this_rlist
150 <
151 <    rlist = this_rlist
152 <    rlistsq = rlist * rlist
153 <
154 <    haveRlist = .true.
155 <
156 <  end subroutine setRlistDF
157 <
158 <  subroutine createPropertyMap(status)
147 >  subroutine createInteractionHash(status)
148      integer :: nAtypes
149 <    integer :: status
149 >    integer, intent(out) :: status
150      integer :: i
151 <    logical :: thisProperty
152 <    real (kind=DP) :: thisDPproperty
151 >    integer :: j
152 >    integer :: iHash
153 >    !! Test Types
154 >    logical :: i_is_LJ
155 >    logical :: i_is_Elect
156 >    logical :: i_is_Sticky
157 >    logical :: i_is_StickyP
158 >    logical :: i_is_GB
159 >    logical :: i_is_EAM
160 >    logical :: i_is_Shape
161 >    logical :: j_is_LJ
162 >    logical :: j_is_Elect
163 >    logical :: j_is_Sticky
164 >    logical :: j_is_StickyP
165 >    logical :: j_is_GB
166 >    logical :: j_is_EAM
167 >    logical :: j_is_Shape
168 >    real(kind=dp) :: myRcut
169  
170 <    status = 0
170 >    status = 0  
171  
172 +    if (.not. associated(atypes)) then
173 +       call handleError("atype", "atypes was not present before call of createInteractionHash!")
174 +       status = -1
175 +       return
176 +    endif
177 +    
178      nAtypes = getSize(atypes)
179 <
179 >    
180      if (nAtypes == 0) then
181         status = -1
182         return
183      end if
184  
185 <    if (.not. allocated(PropertyMap)) then
186 <       allocate(PropertyMap(nAtypes))
185 >    if (.not. allocated(InteractionHash)) then
186 >       allocate(InteractionHash(nAtypes,nAtypes))
187 >    else
188 >       deallocate(InteractionHash)
189 >       allocate(InteractionHash(nAtypes,nAtypes))
190      endif
191  
192 <    do i = 1, nAtypes
193 <       call getElementProperty(atypes, i, "is_Directional", thisProperty)
194 <       PropertyMap(i)%is_Directional = thisProperty
192 >    if (.not. allocated(atypeMaxCutoff)) then
193 >       allocate(atypeMaxCutoff(nAtypes))
194 >    else
195 >       deallocate(atypeMaxCutoff)
196 >       allocate(atypeMaxCutoff(nAtypes))
197 >    endif
198 >        
199 >    do i = 1, nAtypes
200 >       call getElementProperty(atypes, i, "is_LennardJones", i_is_LJ)
201 >       call getElementProperty(atypes, i, "is_Electrostatic", i_is_Elect)
202 >       call getElementProperty(atypes, i, "is_Sticky", i_is_Sticky)
203 >       call getElementProperty(atypes, i, "is_StickyPower", i_is_StickyP)
204 >       call getElementProperty(atypes, i, "is_GayBerne", i_is_GB)
205 >       call getElementProperty(atypes, i, "is_EAM", i_is_EAM)
206 >       call getElementProperty(atypes, i, "is_Shape", i_is_Shape)
207  
208 <       call getElementProperty(atypes, i, "is_LennardJones", thisProperty)
183 <       PropertyMap(i)%is_LennardJones = thisProperty
208 >       do j = i, nAtypes
209  
210 <       call getElementProperty(atypes, i, "is_Electrostatic", thisProperty)
211 <       PropertyMap(i)%is_Electrostatic = thisProperty
210 >          iHash = 0
211 >          myRcut = 0.0_dp
212  
213 <       call getElementProperty(atypes, i, "is_Charge", thisProperty)
214 <       PropertyMap(i)%is_Charge = thisProperty
213 >          call getElementProperty(atypes, j, "is_LennardJones", j_is_LJ)
214 >          call getElementProperty(atypes, j, "is_Electrostatic", j_is_Elect)
215 >          call getElementProperty(atypes, j, "is_Sticky", j_is_Sticky)
216 >          call getElementProperty(atypes, j, "is_StickyPower", j_is_StickyP)
217 >          call getElementProperty(atypes, j, "is_GayBerne", j_is_GB)
218 >          call getElementProperty(atypes, j, "is_EAM", j_is_EAM)
219 >          call getElementProperty(atypes, j, "is_Shape", j_is_Shape)
220  
221 <       call getElementProperty(atypes, i, "is_Dipole", thisProperty)
222 <       PropertyMap(i)%is_Dipole = thisProperty
221 >          if (i_is_LJ .and. j_is_LJ) then
222 >             iHash = ior(iHash, LJ_PAIR)            
223 >          endif
224 >          
225 >          if (i_is_Elect .and. j_is_Elect) then
226 >             iHash = ior(iHash, ELECTROSTATIC_PAIR)
227 >          endif
228 >          
229 >          if (i_is_Sticky .and. j_is_Sticky) then
230 >             iHash = ior(iHash, STICKY_PAIR)
231 >          endif
232  
233 <       call getElementProperty(atypes, i, "is_Quadrupole", thisProperty)
234 <       PropertyMap(i)%is_Quadrupole = thisProperty
233 >          if (i_is_StickyP .and. j_is_StickyP) then
234 >             iHash = ior(iHash, STICKYPOWER_PAIR)
235 >          endif
236  
237 <       call getElementProperty(atypes, i, "is_Sticky", thisProperty)
238 <       PropertyMap(i)%is_Sticky = thisProperty
237 >          if (i_is_EAM .and. j_is_EAM) then
238 >             iHash = ior(iHash, EAM_PAIR)
239 >          endif
240  
241 <       call getElementProperty(atypes, i, "is_GayBerne", thisProperty)
242 <       PropertyMap(i)%is_GayBerne = thisProperty
241 >          if (i_is_GB .and. j_is_GB) iHash = ior(iHash, GAYBERNE_PAIR)
242 >          if (i_is_GB .and. j_is_LJ) iHash = ior(iHash, GAYBERNE_LJ)
243 >          if (i_is_LJ .and. j_is_GB) iHash = ior(iHash, GAYBERNE_LJ)
244  
245 <       call getElementProperty(atypes, i, "is_EAM", thisProperty)
246 <       PropertyMap(i)%is_EAM = thisProperty
245 >          if (i_is_Shape .and. j_is_Shape) iHash = ior(iHash, SHAPE_PAIR)
246 >          if (i_is_Shape .and. j_is_LJ) iHash = ior(iHash, SHAPE_LJ)
247 >          if (i_is_LJ .and. j_is_Shape) iHash = ior(iHash, SHAPE_LJ)
248  
206       call getElementProperty(atypes, i, "is_Shape", thisProperty)
207       PropertyMap(i)%is_Shape = thisProperty
249  
250 <       call getElementProperty(atypes, i, "is_FLARB", thisProperty)
251 <       PropertyMap(i)%is_FLARB = thisProperty
250 >          InteractionHash(i,j) = iHash
251 >          InteractionHash(j,i) = iHash
252 >
253 >       end do
254 >
255      end do
256  
257 <    havePropertyMap = .true.
257 >    haveInteractionHash = .true.
258 >  end subroutine createInteractionHash
259  
260 <  end subroutine createPropertyMap
260 >  subroutine createGtypeCutoffMap(stat)
261 >
262 >    integer, intent(out), optional :: stat
263 >    logical :: i_is_LJ
264 >    logical :: i_is_Elect
265 >    logical :: i_is_Sticky
266 >    logical :: i_is_StickyP
267 >    logical :: i_is_GB
268 >    logical :: i_is_EAM
269 >    logical :: i_is_Shape
270 >    logical :: GtypeFound
271 >
272 >    integer :: myStatus, nAtypes,  i, j, istart, iend, jstart, jend
273 >    integer :: n_in_i, me_i, ia, g, atom1, ja, n_in_j,me_j
274 >    integer :: nGroupsInRow
275 >    integer :: nGroupsInCol
276 >    integer :: nGroupTypesRow,nGroupTypesCol
277 >    real(kind=dp):: thisSigma, bigSigma, thisRcut, tradRcut, tol, skin
278 >    real(kind=dp) :: biggestAtypeCutoff
279 >
280 >    stat = 0
281 >    if (.not. haveInteractionHash) then
282 >       call createInteractionHash(myStatus)      
283 >       if (myStatus .ne. 0) then
284 >          write(default_error, *) 'createInteractionHash failed in doForces!'
285 >          stat = -1
286 >          return
287 >       endif
288 >    endif
289 > #ifdef IS_MPI
290 >    nGroupsInRow = getNgroupsInRow(plan_group_row)
291 >    nGroupsInCol = getNgroupsInCol(plan_group_col)
292 > #endif
293 >    nAtypes = getSize(atypes)
294 > ! Set all of the initial cutoffs to zero.
295 >    atypeMaxCutoff = 0.0_dp
296 >    do i = 1, nAtypes
297 >       if (SimHasAtype(i)) then    
298 >          call getElementProperty(atypes, i, "is_LennardJones", i_is_LJ)
299 >          call getElementProperty(atypes, i, "is_Electrostatic", i_is_Elect)
300 >          call getElementProperty(atypes, i, "is_Sticky", i_is_Sticky)
301 >          call getElementProperty(atypes, i, "is_StickyPower", i_is_StickyP)
302 >          call getElementProperty(atypes, i, "is_GayBerne", i_is_GB)
303 >          call getElementProperty(atypes, i, "is_EAM", i_is_EAM)
304 >          call getElementProperty(atypes, i, "is_Shape", i_is_Shape)
305 >          
306 >
307 >          if (haveDefaultCutoffs) then
308 >             atypeMaxCutoff(i) = defaultRcut
309 >          else
310 >             if (i_is_LJ) then          
311 >                thisRcut = getSigma(i) * 2.5_dp
312 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
313 >             endif
314 >             if (i_is_Elect) then
315 >                thisRcut = defaultRcut
316 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
317 >             endif
318 >             if (i_is_Sticky) then
319 >                thisRcut = getStickyCut(i)
320 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
321 >             endif
322 >             if (i_is_StickyP) then
323 >                thisRcut = getStickyPowerCut(i)
324 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
325 >             endif
326 >             if (i_is_GB) then
327 >                thisRcut = getGayBerneCut(i)
328 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
329 >             endif
330 >             if (i_is_EAM) then
331 >                thisRcut = getEAMCut(i)
332 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
333 >             endif
334 >             if (i_is_Shape) then
335 >                thisRcut = getShapeCut(i)
336 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
337 >             endif
338 >          endif
339 >          
340 >          
341 >          if (atypeMaxCutoff(i).gt.biggestAtypeCutoff) then
342 >             biggestAtypeCutoff = atypeMaxCutoff(i)
343 >          endif
344 >
345 >       endif
346 >    enddo
347 >  
348 >
349 >    
350 >    istart = 1
351 >    jstart = 1
352 > #ifdef IS_MPI
353 >    iend = nGroupsInRow
354 >    jend = nGroupsInCol
355 > #else
356 >    iend = nGroups
357 >    jend = nGroups
358 > #endif
359 >    
360 >    !! allocate the groupToGtype and gtypeMaxCutoff here.
361 >    if(.not.allocated(groupToGtypeRow)) then
362 >     !  allocate(groupToGtype(iend))
363 >       allocate(groupToGtypeRow(iend))
364 >    else
365 >       deallocate(groupToGtypeRow)
366 >       allocate(groupToGtypeRow(iend))
367 >    endif
368 >    if(.not.allocated(groupMaxCutoffRow)) then
369 >       allocate(groupMaxCutoffRow(iend))
370 >    else
371 >       deallocate(groupMaxCutoffRow)
372 >       allocate(groupMaxCutoffRow(iend))
373 >    end if
374 >
375 >    if(.not.allocated(gtypeMaxCutoffRow)) then
376 >       allocate(gtypeMaxCutoffRow(iend))
377 >    else
378 >       deallocate(gtypeMaxCutoffRow)
379 >       allocate(gtypeMaxCutoffRow(iend))
380 >    endif
381 >
382 >
383 > #ifdef IS_MPI
384 >       ! We only allocate new storage if we are in MPI because Ncol /= Nrow
385 >    if(.not.associated(groupToGtypeCol)) then
386 >       allocate(groupToGtypeCol(jend))
387 >    else
388 >       deallocate(groupToGtypeCol)
389 >       allocate(groupToGtypeCol(jend))
390 >    end if
391 >
392 >    if(.not.associated(groupToGtypeCol)) then
393 >       allocate(groupToGtypeCol(jend))
394 >    else
395 >       deallocate(groupToGtypeCol)
396 >       allocate(groupToGtypeCol(jend))
397 >    end if
398 >    if(.not.associated(gtypeMaxCutoffCol)) then
399 >       allocate(gtypeMaxCutoffCol(jend))
400 >    else
401 >       deallocate(gtypeMaxCutoffCol)      
402 >       allocate(gtypeMaxCutoffCol(jend))
403 >    end if
404 >
405 >       groupMaxCutoffCol = 0.0_dp
406 >       gtypeMaxCutoffCol = 0.0_dp
407 >
408 > #endif
409 >       groupMaxCutoffRow = 0.0_dp
410 >       gtypeMaxCutoffRow = 0.0_dp
411 >
412 >
413 >    !! first we do a single loop over the cutoff groups to find the
414 >    !! largest cutoff for any atypes present in this group.  We also
415 >    !! create gtypes at this point.
416 >    
417 >    tol = 1.0d-6
418 >    nGroupTypesRow = 0
419 >
420 >    do i = istart, iend      
421 >       n_in_i = groupStartRow(i+1) - groupStartRow(i)
422 >       groupMaxCutoffRow(i) = 0.0_dp
423 >       do ia = groupStartRow(i), groupStartRow(i+1)-1
424 >          atom1 = groupListRow(ia)
425 > #ifdef IS_MPI
426 >          me_i = atid_row(atom1)
427 > #else
428 >          me_i = atid(atom1)
429 > #endif          
430 >          if (atypeMaxCutoff(me_i).gt.groupMaxCutoffRow(i)) then
431 >             groupMaxCutoffRow(i)=atypeMaxCutoff(me_i)
432 >          endif          
433 >       enddo
434 >
435 >       if (nGroupTypesRow.eq.0) then
436 >          nGroupTypesRow = nGroupTypesRow + 1
437 >          gtypeMaxCutoffRow(nGroupTypesRow) = groupMaxCutoffRow(i)
438 >          groupToGtypeRow(i) = nGroupTypesRow
439 >       else
440 >          GtypeFound = .false.
441 >          do g = 1, nGroupTypesRow
442 >             if ( abs(groupMaxCutoffRow(i) - gtypeMaxCutoffRow(g)).lt.tol) then
443 >                groupToGtypeRow(i) = g
444 >                GtypeFound = .true.
445 >             endif
446 >          enddo
447 >          if (.not.GtypeFound) then            
448 >             nGroupTypesRow = nGroupTypesRow + 1
449 >             gtypeMaxCutoffRow(nGroupTypesRow) = groupMaxCutoffRow(i)
450 >             groupToGtypeRow(i) = nGroupTypesRow
451 >          endif
452 >       endif
453 >    enddo    
454 >
455 > #ifdef IS_MPI
456 >    do j = jstart, jend      
457 >       n_in_j = groupStartCol(j+1) - groupStartCol(j)
458 >       groupMaxCutoffCol(j) = 0.0_dp
459 >       do ja = groupStartCol(j), groupStartCol(j+1)-1
460 >          atom1 = groupListCol(ja)
461 >
462 >          me_j = atid_col(atom1)
463 >
464 >          if (atypeMaxCutoff(me_j).gt.groupMaxCutoffCol(j)) then
465 >             groupMaxCutoffCol(j)=atypeMaxCutoff(me_j)
466 >          endif          
467 >       enddo
468 >
469 >       if (nGroupTypesCol.eq.0) then
470 >          nGroupTypesCol = nGroupTypesCol + 1
471 >          gtypeMaxCutoffCol(nGroupTypesCol) = groupMaxCutoffCol(j)
472 >          groupToGtypeCol(j) = nGroupTypesCol
473 >       else
474 >          GtypeFound = .false.
475 >          do g = 1, nGroupTypesCol
476 >             if ( abs(groupMaxCutoffCol(j) - gtypeMaxCutoffCol(g)).lt.tol) then
477 >                groupToGtypeCol(j) = g
478 >                GtypeFound = .true.
479 >             endif
480 >          enddo
481 >          if (.not.GtypeFound) then            
482 >             nGroupTypesCol = nGroupTypesCol + 1
483 >             gtypeMaxCutoffCol(nGroupTypesCol) = groupMaxCutoffCol(j)
484 >             groupToGtypeCol(j) = nGroupTypesCol
485 >          endif
486 >       endif
487 >    enddo    
488 >
489 > #else
490 > ! Set pointers to information we just found
491 >    nGroupTypesCol = nGroupTypesRow
492 >    groupToGtypeCol => groupToGtypeRow
493 >    gtypeMaxCutoffCol => gtypeMaxCutoffRow
494 >    groupMaxCutoffCol => groupMaxCutoffRow
495 > #endif
496 >
497 >
498 >
499 >
500 >
501 >    !! allocate the gtypeCutoffMap here.
502 >    allocate(gtypeCutoffMap(nGroupTypesRow,nGroupTypesCol))
503 >    !! then we do a double loop over all the group TYPES to find the cutoff
504 >    !! map between groups of two types
505 >    tradRcut = max(maxval(gtypeMaxCutoffRow),maxval(gtypeMaxCutoffCol))
506 >
507 >    do i = 1, nGroupTypesRow
508 >       do j = 1, nGroupTypesCol
509 >      
510 >          select case(cutoffPolicy)
511 >          case(TRADITIONAL_CUTOFF_POLICY)
512 >             thisRcut = tradRcut
513 >          case(MIX_CUTOFF_POLICY)
514 >             thisRcut = 0.5_dp * (gtypeMaxCutoffRow(i) + gtypeMaxCutoffCol(j))
515 >          case(MAX_CUTOFF_POLICY)
516 >             thisRcut = max(gtypeMaxCutoffRow(i), gtypeMaxCutoffCol(j))
517 >          case default
518 >             call handleError("createGtypeCutoffMap", "Unknown Cutoff Policy")
519 >             return
520 >          end select
521 >          gtypeCutoffMap(i,j)%rcut = thisRcut
522 >          gtypeCutoffMap(i,j)%rcutsq = thisRcut*thisRcut
523 >          skin = defaultRlist - defaultRcut
524 >          listSkin = skin ! set neighbor list skin thickness
525 >          gtypeCutoffMap(i,j)%rlistsq = (thisRcut + skin)**2
526 >
527 >          ! sanity check
528 >
529 >          if (haveDefaultCutoffs) then
530 >             if (abs(gtypeCutoffMap(i,j)%rcut - defaultRcut).gt.0.0001) then
531 >                call handleError("createGtypeCutoffMap", "user-specified rCut does not match computed group Cutoff")
532 >             endif
533 >          endif
534 >       enddo
535 >    enddo
536 >    if(allocated(gtypeMaxCutoffRow)) deallocate(gtypeMaxCutoffRow)
537 >    if(allocated(groupMaxCutoffRow)) deallocate(groupMaxCutoffRow)
538 >    if(allocated(atypeMaxCutoff)) deallocate(atypeMaxCutoff)
539 > #ifdef IS_MPI
540 >    if(associated(groupMaxCutoffCol)) deallocate(groupMaxCutoffCol)
541 >    if(associated(gtypeMaxCutoffCol)) deallocate(gtypeMaxCutoffCol)
542 > #endif
543 >    groupMaxCutoffCol => null()
544 >    gtypeMaxCutoffCol => null()
545 >    
546 >    haveGtypeCutoffMap = .true.
547 >   end subroutine createGtypeCutoffMap
548 >
549 >   subroutine setDefaultCutoffs(defRcut, defRsw, defRlist, cutPolicy)
550 >     real(kind=dp),intent(in) :: defRcut, defRsw, defRlist
551 >     integer, intent(in) :: cutPolicy
552  
553 +     defaultRcut = defRcut
554 +     defaultRsw = defRsw
555 +     defaultRlist = defRlist
556 +     cutoffPolicy = cutPolicy
557 +
558 +     haveDefaultCutoffs = .true.
559 +   end subroutine setDefaultCutoffs
560 +
561 +   subroutine setCutoffPolicy(cutPolicy)
562 +
563 +     integer, intent(in) :: cutPolicy
564 +     cutoffPolicy = cutPolicy
565 +     call createGtypeCutoffMap()
566 +   end subroutine setCutoffPolicy
567 +    
568 +    
569    subroutine setSimVariables()
570      SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
219    SIM_uses_LennardJones = SimUsesLennardJones()
220    SIM_uses_Electrostatics = SimUsesElectrostatics()
221    SIM_uses_Charges = SimUsesCharges()
222    SIM_uses_Dipoles = SimUsesDipoles()
223    SIM_uses_Sticky = SimUsesSticky()
224    SIM_uses_GayBerne = SimUsesGayBerne()
571      SIM_uses_EAM = SimUsesEAM()
226    SIM_uses_Shapes = SimUsesShapes()
227    SIM_uses_FLARB = SimUsesFLARB()
228    SIM_uses_RF = SimUsesRF()
572      SIM_requires_postpair_calc = SimRequiresPostpairCalc()
573      SIM_requires_prepair_calc = SimRequiresPrepairCalc()
574      SIM_uses_PBC = SimUsesPBC()
# Line 242 | Line 585 | contains
585  
586      error = 0
587  
588 <    if (.not. havePropertyMap) then
588 >    if (.not. haveInteractionHash) then      
589 >       myStatus = 0      
590 >       call createInteractionHash(myStatus)      
591 >       if (myStatus .ne. 0) then
592 >          write(default_error, *) 'createInteractionHash failed in doForces!'
593 >          error = -1
594 >          return
595 >       endif
596 >    endif
597  
598 <       myStatus = 0
599 <
600 <       call createPropertyMap(myStatus)
250 <
598 >    if (.not. haveGtypeCutoffMap) then        
599 >       myStatus = 0      
600 >       call createGtypeCutoffMap(myStatus)      
601         if (myStatus .ne. 0) then
602 <          write(default_error, *) 'createPropertyMap failed in doForces!'
602 >          write(default_error, *) 'createGtypeCutoffMap failed in doForces!'
603            error = -1
604            return
605         endif
# Line 259 | Line 609 | contains
609         call setSimVariables()
610      endif
611  
612 <    if (.not. haveRlist) then
613 <       write(default_error, *) 'rList has not been set in doForces!'
614 <       error = -1
615 <       return
616 <    endif
612 >  !  if (.not. haveRlist) then
613 >  !     write(default_error, *) 'rList has not been set in doForces!'
614 >  !     error = -1
615 >  !     return
616 >  !  endif
617  
618      if (.not. haveNeighborList) then
619         write(default_error, *) 'neighbor list has not been initialized in doForces!'
# Line 288 | Line 638 | contains
638    end subroutine doReadyCheck
639  
640  
641 <  subroutine init_FF(use_RF_c, thisStat)
641 >  subroutine init_FF(thisESM, thisStat)
642  
643 <    logical, intent(in) :: use_RF_c
294 <
643 >    integer, intent(in) :: thisESM
644      integer, intent(out) :: thisStat  
645      integer :: my_status, nMatches
646      integer, pointer :: MatchList(:) => null()
# Line 300 | Line 649 | contains
649      !! assume things are copacetic, unless they aren't
650      thisStat = 0
651  
652 <    !! Fortran's version of a cast:
304 <    FF_uses_RF = use_RF_c
652 >    electrostaticSummationMethod = thisESM
653  
654      !! init_FF is called *after* all of the atom types have been
655      !! defined in atype_module using the new_atype subroutine.
# Line 310 | Line 658 | contains
658      !! interactions are used by the force field.    
659  
660      FF_uses_DirectionalAtoms = .false.
313    FF_uses_LennardJones = .false.
314    FF_uses_Electrostatics = .false.
315    FF_uses_Charges = .false.    
661      FF_uses_Dipoles = .false.
317    FF_uses_Sticky = .false.
662      FF_uses_GayBerne = .false.
663      FF_uses_EAM = .false.
320    FF_uses_Shapes = .false.
321    FF_uses_FLARB = .false.
664  
665      call getMatchingElementList(atypes, "is_Directional", .true., &
666           nMatches, MatchList)
667      if (nMatches .gt. 0) FF_uses_DirectionalAtoms = .true.
668  
327    call getMatchingElementList(atypes, "is_LennardJones", .true., &
328         nMatches, MatchList)
329    if (nMatches .gt. 0) FF_uses_LennardJones = .true.
330
331    call getMatchingElementList(atypes, "is_Electrostatic", .true., &
332         nMatches, MatchList)
333    if (nMatches .gt. 0) then
334       FF_uses_Electrostatics = .true.
335    endif
336
337    call getMatchingElementList(atypes, "is_Charge", .true., &
338         nMatches, MatchList)
339    if (nMatches .gt. 0) then
340       FF_uses_Charges = .true.  
341       FF_uses_Electrostatics = .true.
342    endif
343
669      call getMatchingElementList(atypes, "is_Dipole", .true., &
670           nMatches, MatchList)
671 <    if (nMatches .gt. 0) then
672 <       FF_uses_Dipoles = .true.
348 <       FF_uses_Electrostatics = .true.
349 <       FF_uses_DirectionalAtoms = .true.
350 <    endif
351 <
352 <    call getMatchingElementList(atypes, "is_Quadrupole", .true., &
353 <         nMatches, MatchList)
354 <    if (nMatches .gt. 0) then
355 <       FF_uses_Quadrupoles = .true.
356 <       FF_uses_Electrostatics = .true.
357 <       FF_uses_DirectionalAtoms = .true.
358 <    endif
359 <
360 <    call getMatchingElementList(atypes, "is_Sticky", .true., nMatches, &
361 <         MatchList)
362 <    if (nMatches .gt. 0) then
363 <       FF_uses_Sticky = .true.
364 <       FF_uses_DirectionalAtoms = .true.
365 <    endif
366 <
671 >    if (nMatches .gt. 0) FF_uses_Dipoles = .true.
672 >    
673      call getMatchingElementList(atypes, "is_GayBerne", .true., &
674           nMatches, MatchList)
675 <    if (nMatches .gt. 0) then
370 <       FF_uses_GayBerne = .true.
371 <       FF_uses_DirectionalAtoms = .true.
372 <    endif
675 >    if (nMatches .gt. 0) FF_uses_GayBerne = .true.
676  
677      call getMatchingElementList(atypes, "is_EAM", .true., nMatches, MatchList)
678      if (nMatches .gt. 0) FF_uses_EAM = .true.
679  
377    call getMatchingElementList(atypes, "is_Shape", .true., &
378         nMatches, MatchList)
379    if (nMatches .gt. 0) then
380       FF_uses_Shapes = .true.
381       FF_uses_DirectionalAtoms = .true.
382    endif
680  
384    call getMatchingElementList(atypes, "is_FLARB", .true., &
385         nMatches, MatchList)
386    if (nMatches .gt. 0) FF_uses_FLARB = .true.
387
388    !! Assume sanity (for the sake of argument)
681      haveSaneForceField = .true.
390
391    !! check to make sure the FF_uses_RF setting makes sense
392
393    if (FF_uses_dipoles) then
394       if (FF_uses_RF) then
395          dielect = getDielect()
396          call initialize_rf(dielect)
397       endif
398    else
399       if (FF_uses_RF) then          
400          write(default_error,*) 'Using Reaction Field with no dipoles?  Huh?'
401          thisStat = -1
402          haveSaneForceField = .false.
403          return
404       endif
405    endif
682  
407    !sticky module does not contain check_sticky_FF anymore
408    !if (FF_uses_sticky) then
409    !   call check_sticky_FF(my_status)
410    !   if (my_status /= 0) then
411    !      thisStat = -1
412    !      haveSaneForceField = .false.
413    !      return
414    !   end if
415    !endif
416
683      if (FF_uses_EAM) then
684         call init_EAM_FF(my_status)
685         if (my_status /= 0) then
# Line 424 | Line 690 | contains
690         end if
691      endif
692  
427    if (FF_uses_GayBerne) then
428       call check_gb_pair_FF(my_status)
429       if (my_status .ne. 0) then
430          thisStat = -1
431          haveSaneForceField = .false.
432          return
433       endif
434    endif
435
436    if (FF_uses_GayBerne .and. FF_uses_LennardJones) then
437    endif
438
693      if (.not. haveNeighborList) then
694         !! Create neighbor lists
695         call expandNeighborList(nLocal, my_status)
# Line 469 | Line 723 | contains
723  
724      !! Stress Tensor
725      real( kind = dp), dimension(9) :: tau  
726 <    real ( kind = dp ) :: pot
726 >    real ( kind = dp ),dimension(LR_POT_TYPES) :: pot
727      logical ( kind = 2) :: do_pot_c, do_stress_c
728      logical :: do_pot
729      logical :: do_stress
730      logical :: in_switching_region
731   #ifdef IS_MPI
732 <    real( kind = DP ) :: pot_local
732 >    real( kind = DP ), dimension(LR_POT_TYPES) :: pot_local
733      integer :: nAtomsInRow
734      integer :: nAtomsInCol
735      integer :: nprocs
# Line 490 | Line 744 | contains
744      integer :: nlist
745      real( kind = DP ) :: ratmsq, rgrpsq, rgrp, vpair, vij
746      real( kind = DP ) :: sw, dswdr, swderiv, mf
747 +    real( kind = DP ) :: rVal
748      real(kind=dp),dimension(3) :: d_atm, d_grp, fpair, fij
749      real(kind=dp) :: rfpot, mu_i, virial
750      integer :: me_i, me_j, n_in_i, n_in_j
# Line 499 | Line 754 | contains
754      integer :: localError
755      integer :: propPack_i, propPack_j
756      integer :: loopStart, loopEnd, loop
757 +    integer :: iHash
758 +    integer :: i1
759 +    logical :: indirect_only
760 +  
761  
503    real(kind=dp) :: listSkin = 1.0  
504
762      !! initialize local variables  
763  
764   #ifdef IS_MPI
# Line 618 | Line 875 | contains
875               endif
876  
877   #ifdef IS_MPI
878 +             me_j = atid_col(j)
879               call get_interatomic_vector(q_group_Row(:,i), &
880                    q_group_Col(:,j), d_grp, rgrpsq)
881   #else
882 +             me_j = atid(j)
883               call get_interatomic_vector(q_group(:,i), &
884                    q_group(:,j), d_grp, rgrpsq)
885 < #endif
885 > #endif      
886  
887 <             if (rgrpsq < rlistsq) then
887 >             if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rListsq) then
888                  if (update_nlist) then
889                     nlist = nlist + 1
890  
# Line 664 | Line 923 | contains
923  
924                        atom2 = groupListCol(jb)
925  
926 <                      if (skipThisPair(atom1, atom2)) cycle inner
926 >                      indirect_only = .false.
927 >    
928 >                      if (skipThisPair(atom1, atom2)) then
929 >                         if (electrostaticSummationMethod.ne.REACTION_FIELD) then
930 >                            cycle inner
931 >                         else
932 >                            indirect_only = .true.
933 >                         endif
934 >                      endif
935 >    
936  
937                        if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
938                           d_atm(1:3) = d_grp(1:3)
# Line 692 | Line 960 | contains
960                        else
961   #ifdef IS_MPI                      
962                           call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
963 <                              do_pot, &
964 <                              eFrame, A, f, t, pot_local, vpair, fpair)
963 >                              do_pot, eFrame, A, f, t, pot_local, vpair, &
964 >                              fpair, d_grp, rgrp, indirect_only)
965   #else
966                           call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
967 <                              do_pot,  &
968 <                              eFrame, A, f, t, pot, vpair, fpair)
967 >                              do_pot, eFrame, A, f, t, pot, vpair, fpair, &
968 >                              d_grp, rgrp, indirect_only)
969   #endif
970  
971                           vij = vij + vpair
# Line 746 | Line 1014 | contains
1014                  endif
1015               end if
1016            enddo
1017 +
1018         enddo outer
1019  
1020         if (update_nlist) then
# Line 805 | Line 1074 | contains
1074  
1075      if (do_pot) then
1076         ! scatter/gather pot_row into the members of my column
1077 <       call scatter(pot_Row, pot_Temp, plan_atom_row)
1078 <
1077 >       do i = 1,LR_POT_TYPES
1078 >          call scatter(pot_Row(i,:), pot_Temp(i,:), plan_atom_row)
1079 >       end do
1080         ! scatter/gather pot_local into all other procs
1081         ! add resultant to get total pot
1082         do i = 1, nlocal
1083 <          pot_local = pot_local + pot_Temp(i)
1083 >          pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES) &
1084 >               + pot_Temp(1:LR_POT_TYPES,i)
1085         enddo
1086  
1087         pot_Temp = 0.0_DP
1088 <
1089 <       call scatter(pot_Col, pot_Temp, plan_atom_col)
1088 >       do i = 1,LR_POT_TYPES
1089 >          call scatter(pot_Col(i,:), pot_Temp(i,:), plan_atom_col)
1090 >       end do
1091         do i = 1, nlocal
1092 <          pot_local = pot_local + pot_Temp(i)
1092 >          pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES)&
1093 >               + pot_Temp(1:LR_POT_TYPES,i)
1094         enddo
1095  
1096      endif
1097   #endif
1098  
1099 <    if (FF_RequiresPostpairCalc() .and. SIM_requires_postpair_calc) then
1099 >    if (SIM_requires_postpair_calc) then
1100 >       do i = 1, nlocal            
1101 >          
1102 >          ! we loop only over the local atoms, so we don't need row and column
1103 >          ! lookups for the types
1104 >          
1105 >          me_i = atid(i)
1106 >          
1107 >          ! is the atom electrostatic?  See if it would have an
1108 >          ! electrostatic interaction with itself
1109 >          iHash = InteractionHash(me_i,me_i)
1110  
1111 <       if (FF_uses_RF .and. SIM_uses_RF) then
829 <
1111 >          if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1112   #ifdef IS_MPI
1113 <          call scatter(rf_Row,rf,plan_atom_row_3d)
1114 <          call scatter(rf_Col,rf_Temp,plan_atom_col_3d)
833 <          do i = 1,nlocal
834 <             rf(1:3,i) = rf(1:3,i) + rf_Temp(1:3,i)
835 <          end do
836 < #endif
837 <
838 <          do i = 1, nLocal
839 <
840 <             rfpot = 0.0_DP
841 < #ifdef IS_MPI
842 <             me_i = atid_row(i)
1113 >             call rf_self_self(i, eFrame, pot_local(ELECTROSTATIC_POT), &
1114 >                  t, do_pot)
1115   #else
1116 <             me_i = atid(i)
1116 >             call rf_self_self(i, eFrame, pot(ELECTROSTATIC_POT), &
1117 >                  t, do_pot)
1118   #endif
1119 +          endif
1120 +  
1121 +          ! loop over the excludes to accumulate any additional RF components
1122  
1123 <             if (PropertyMap(me_i)%is_Dipole) then
1124 <
1125 <                mu_i = getDipoleMoment(me_i)
1126 <
1127 <                !! The reaction field needs to include a self contribution
1128 <                !! to the field:
1129 <                call accumulate_self_rf(i, mu_i, eFrame)
1130 <                !! Get the reaction field contribution to the
1131 <                !! potential and torques:
1132 <                call reaction_field_final(i, mu_i, eFrame, rfpot, t, do_pot)
1123 >          do i1 = 1, nSkipsForAtom(i)
1124 >             j = skipsForAtom(i, i1)
1125 >            
1126 >             ! prevent overcounting of the skips
1127 >             if (i.lt.j) then
1128 >                call get_interatomic_vector(q(:,i), &
1129 >                     q(:,j), d_atm, ratmsq)
1130 >                rVal = dsqrt(ratmsq)
1131 >                call get_switch(ratmsq, sw, dswdr, rVal, group_switch, &
1132 >                     in_switching_region)
1133   #ifdef IS_MPI
1134 <                pot_local = pot_local + rfpot
1134 >                call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, vpair, &
1135 >                     pot_local(ELECTROSTATIC_POT), f, t, do_pot)
1136   #else
1137 <                pot = pot + rfpot
1138 <
1137 >                call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, vpair, &
1138 >                     pot(ELECTROSTATIC_POT), f, t, do_pot)
1139   #endif
1140               endif
1141            enddo
1142 <       endif
1142 >       enddo      
1143      endif
1144 <
868 <
1144 >    
1145   #ifdef IS_MPI
1146 <
1146 >    
1147      if (do_pot) then
1148 <       pot = pot + pot_local
1149 <       !! we assume the c code will do the allreduce to get the total potential
874 <       !! we could do it right here if we needed to...
1148 >       call mpi_allreduce(pot_local, pot, LR_POT_TYPES,mpi_double_precision,mpi_sum, &
1149 >            mpi_comm_world,mpi_err)            
1150      endif
1151 <
1151 >    
1152      if (do_stress) then
1153         call mpi_allreduce(tau_Temp, tau, 9,mpi_double_precision,mpi_sum, &
1154              mpi_comm_world,mpi_err)
1155         call mpi_allreduce(virial_Temp, virial,1,mpi_double_precision,mpi_sum, &
1156              mpi_comm_world,mpi_err)
1157      endif
1158 <
1158 >    
1159   #else
1160 <
1160 >    
1161      if (do_stress) then
1162         tau = tau_Temp
1163         virial = virial_Temp
1164      endif
1165 <
1165 >    
1166   #endif
1167 <
1167 >    
1168    end subroutine do_force_loop
1169  
1170    subroutine do_pair(i, j, rijsq, d, sw, do_pot, &
1171 <       eFrame, A, f, t, pot, vpair, fpair)
1171 >       eFrame, A, f, t, pot, vpair, fpair, d_grp, r_grp, indirect_only)
1172  
1173 <    real( kind = dp ) :: pot, vpair, sw
1173 >    real( kind = dp ) :: vpair, sw
1174 >    real( kind = dp ), dimension(LR_POT_TYPES) :: pot
1175      real( kind = dp ), dimension(3) :: fpair
1176      real( kind = dp ), dimension(nLocal)   :: mfact
1177      real( kind = dp ), dimension(9,nLocal) :: eFrame
# Line 904 | Line 1180 | contains
1180      real( kind = dp ), dimension(3,nLocal) :: t
1181  
1182      logical, intent(inout) :: do_pot
1183 +    logical, intent(inout) :: indirect_only
1184      integer, intent(in) :: i, j
1185      real ( kind = dp ), intent(inout) :: rijsq
1186 <    real ( kind = dp )                :: r
1186 >    real ( kind = dp ), intent(inout) :: r_grp
1187      real ( kind = dp ), intent(inout) :: d(3)
1188 +    real ( kind = dp ), intent(inout) :: d_grp(3)
1189 +    real ( kind = dp ) :: r
1190      integer :: me_i, me_j
1191  
1192 +    integer :: iHash
1193 +
1194      r = sqrt(rijsq)
1195      vpair = 0.0d0
1196      fpair(1:3) = 0.0d0
# Line 922 | Line 1203 | contains
1203      me_j = atid(j)
1204   #endif
1205  
1206 <    !    write(*,*) i, j, me_i, me_j
1206 >    iHash = InteractionHash(me_i, me_j)
1207  
1208 <    if (FF_uses_LennardJones .and. SIM_uses_LennardJones) then
1209 <
929 <       if ( PropertyMap(me_i)%is_LennardJones .and. &
930 <            PropertyMap(me_j)%is_LennardJones ) then
931 <          call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, do_pot)
932 <       endif
933 <
934 <    endif
935 <
936 <    if (FF_uses_Electrostatics .and. SIM_uses_Electrostatics) then
937 <
938 <       if (PropertyMap(me_i)%is_Electrostatic .and. &
939 <            PropertyMap(me_j)%is_Electrostatic) then
1208 >    if (indirect_only) then
1209 >       if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1210            call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1211 <               pot, eFrame, f, t, do_pot)
1211 >               pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot, indirect_only)
1212         endif
1213 <
1214 <       if (FF_uses_dipoles .and. SIM_uses_dipoles) then      
1215 <          if ( PropertyMap(me_i)%is_Dipole .and. &
1216 <               PropertyMap(me_j)%is_Dipole) then
1217 <             if (FF_uses_RF .and. SIM_uses_RF) then
948 <                call accumulate_rf(i, j, r, eFrame, sw)
949 <                call rf_correct_forces(i, j, d, r, eFrame, sw, f, fpair)
950 <             endif
951 <          endif
1213 >    else
1214 >          
1215 >       if ( iand(iHash, LJ_PAIR).ne.0 ) then
1216 >          call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1217 >               pot(VDW_POT), f, do_pot)
1218         endif
953    endif
1219  
1220 <
1221 <    if (FF_uses_Sticky .and. SIM_uses_sticky) then
1222 <
958 <       if ( PropertyMap(me_i)%is_Sticky .and. PropertyMap(me_j)%is_Sticky) then
959 <          call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
960 <               pot, A, f, t, do_pot)
1220 >       if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1221 >          call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1222 >               pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot, indirect_only)
1223         endif
1224 <
1225 <    endif
1226 <
1227 <
1228 <    if (FF_uses_GayBerne .and. SIM_uses_GayBerne) then
1229 <
1230 <       if ( PropertyMap(me_i)%is_GayBerne .and. &
1231 <            PropertyMap(me_j)%is_GayBerne) then
1224 >      
1225 >       if ( iand(iHash, STICKY_PAIR).ne.0 ) then
1226 >          call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1227 >               pot(HB_POT), A, f, t, do_pot)
1228 >       endif
1229 >      
1230 >       if ( iand(iHash, STICKYPOWER_PAIR).ne.0 ) then
1231 >          call do_sticky_power_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1232 >               pot(HB_POT), A, f, t, do_pot)
1233 >       endif
1234 >      
1235 >       if ( iand(iHash, GAYBERNE_PAIR).ne.0 ) then
1236            call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1237 <               pot, A, f, t, do_pot)
1237 >               pot(VDW_POT), A, f, t, do_pot)
1238         endif
1239 <
1240 <    endif
1241 <
1242 <    if (FF_uses_EAM .and. SIM_uses_EAM) then
977 <
978 <       if ( PropertyMap(me_i)%is_EAM .and. PropertyMap(me_j)%is_EAM) then
979 <          call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, &
980 <               do_pot)
1239 >      
1240 >       if ( iand(iHash, GAYBERNE_LJ).ne.0 ) then
1241 >          call do_gb_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1242 >               pot(VDW_POT), A, f, t, do_pot)
1243         endif
1244 <
1245 <    endif
1246 <
1247 <
986 <    !    write(*,*) PropertyMap(me_i)%is_Shape,PropertyMap(me_j)%is_Shape
987 <
988 <    if (FF_uses_Shapes .and. SIM_uses_Shapes) then
989 <       if ( PropertyMap(me_i)%is_Shape .and. &
990 <            PropertyMap(me_j)%is_Shape ) then
991 <          call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
992 <               pot, A, f, t, do_pot)
1244 >      
1245 >       if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1246 >          call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1247 >               pot(METALLIC_POT), f, do_pot)
1248         endif
1249 <
1249 >      
1250 >       if ( iand(iHash, SHAPE_PAIR).ne.0 ) then      
1251 >          call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1252 >               pot(VDW_POT), A, f, t, do_pot)
1253 >       endif
1254 >      
1255 >       if ( iand(iHash, SHAPE_LJ).ne.0 ) then      
1256 >          call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1257 >               pot(VDW_POT), A, f, t, do_pot)
1258 >       endif
1259      endif
1260 <
1260 >    
1261    end subroutine do_pair
1262  
1263    subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, &
1264         do_pot, do_stress, eFrame, A, f, t, pot)
1265  
1266 <    real( kind = dp ) :: pot, sw
1266 >    real( kind = dp ) :: sw
1267 >    real( kind = dp ), dimension(LR_POT_TYPES) :: pot
1268      real( kind = dp ), dimension(9,nLocal) :: eFrame
1269      real (kind=dp), dimension(9,nLocal) :: A
1270      real (kind=dp), dimension(3,nLocal) :: f
# Line 1011 | Line 1276 | contains
1276      real ( kind = dp )                :: r, rc
1277      real ( kind = dp ), intent(inout) :: d(3), dc(3)
1278  
1279 <    logical :: is_EAM_i, is_EAM_j
1279 >    integer :: me_i, me_j, iHash
1280  
1016    integer :: me_i, me_j
1017
1018
1281      r = sqrt(rijsq)
1020    if (SIM_uses_molecular_cutoffs) then
1021       rc = sqrt(rcijsq)
1022    else
1023       rc = r
1024    endif
1282  
1026
1283   #ifdef IS_MPI  
1284      me_i = atid_row(i)
1285      me_j = atid_col(j)  
# Line 1032 | Line 1288 | contains
1288      me_j = atid(j)  
1289   #endif
1290  
1291 <    if (FF_uses_EAM .and. SIM_uses_EAM) then
1291 >    iHash = InteractionHash(me_i, me_j)
1292  
1293 <       if (PropertyMap(me_i)%is_EAM .and. PropertyMap(me_j)%is_EAM) &
1293 >    if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1294              call calc_EAM_prepair_rho(i, j, d, r, rijsq )
1039
1295      endif
1296 <
1296 >    
1297    end subroutine do_prepair
1298  
1299  
1300    subroutine do_preforce(nlocal,pot)
1301      integer :: nlocal
1302 <    real( kind = dp ) :: pot
1302 >    real( kind = dp ),dimension(LR_POT_TYPES) :: pot
1303  
1304      if (FF_uses_EAM .and. SIM_uses_EAM) then
1305 <       call calc_EAM_preforce_Frho(nlocal,pot)
1305 >       call calc_EAM_preforce_Frho(nlocal,pot(METALLIC_POT))
1306      endif
1307  
1308  
# Line 1232 | Line 1487 | contains
1487  
1488    function FF_UsesDirectionalAtoms() result(doesit)
1489      logical :: doesit
1490 <    doesit = FF_uses_DirectionalAtoms .or. FF_uses_Dipoles .or. &
1236 <         FF_uses_Quadrupoles .or. FF_uses_Sticky .or. &
1237 <         FF_uses_GayBerne .or. FF_uses_Shapes
1490 >    doesit = FF_uses_DirectionalAtoms
1491    end function FF_UsesDirectionalAtoms
1492  
1493    function FF_RequiresPrepairCalc() result(doesit)
# Line 1242 | Line 1495 | contains
1495      doesit = FF_uses_EAM
1496    end function FF_RequiresPrepairCalc
1497  
1245  function FF_RequiresPostpairCalc() result(doesit)
1246    logical :: doesit
1247    doesit = FF_uses_RF
1248  end function FF_RequiresPostpairCalc
1249
1498   #ifdef PROFILE
1499    function getforcetime() result(totalforcetime)
1500      real(kind=dp) :: totalforcetime

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines