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 2267 by tim, Fri Jul 29 17:34:06 2005 UTC vs.
Revision 2394 by chrisfen, Sun Oct 23 21:08:08 2005 UTC

# Line 45 | Line 45
45  
46   !! @author Charles F. Vardeman II
47   !! @author Matthew Meineke
48 < !! @version $Id: doForces.F90,v 1.25 2005-07-29 17:34:06 tim Exp $, $Date: 2005-07-29 17:34:06 $, $Name: not supported by cvs2svn $, $Revision: 1.25 $
48 > !! @version $Id: doForces.F90,v 1.62 2005-10-23 21:08:02 chrisfen Exp $, $Date: 2005-10-23 21:08:02 $, $Name: not supported by cvs2svn $, $Revision: 1.62 $
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  
81  logical, save :: haveRlist = .false.
83    logical, save :: haveNeighborList = .false.
84    logical, save :: haveSIMvariables = .false.
85    logical, save :: haveSaneForceField = .false.
86 <  logical, save :: haveInteractionMap = .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
88  logical, save :: FF_uses_LennardJones
89  logical, save :: FF_uses_Electrostatics
90  logical, save :: FF_uses_Charges
92    logical, save :: FF_uses_Dipoles
92  logical, save :: FF_uses_Quadrupoles
93  logical, save :: FF_uses_Sticky
94  logical, save :: FF_uses_StickyPower
93    logical, save :: FF_uses_GayBerne
94    logical, save :: FF_uses_EAM
97  logical, save :: FF_uses_Shapes
98  logical, save :: FF_uses_FLARB
99  logical, save :: FF_uses_RF
95  
96    logical, save :: SIM_uses_DirectionalAtoms
102  logical, save :: SIM_uses_LennardJones
103  logical, save :: SIM_uses_Electrostatics
104  logical, save :: SIM_uses_Charges
105  logical, save :: SIM_uses_Dipoles
106  logical, save :: SIM_uses_Quadrupoles
107  logical, save :: SIM_uses_Sticky
108  logical, save :: SIM_uses_StickyPower
109  logical, save :: SIM_uses_GayBerne
97    logical, save :: SIM_uses_EAM
111  logical, save :: SIM_uses_Shapes
112  logical, save :: SIM_uses_FLARB
113  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
117  logical, save :: SIM_uses_molecular_cutoffs
101  
102 <  !!!GO AWAY---------
120 <  !!!!!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
108 <  !public :: addInteraction
109 <  !public :: setInteractionHash
110 <  !public :: getInteractionHash
111 <  public :: createInteractionMap
112 <  public :: createRcuts
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 134 | Line 118 | module doForces
118    real :: forceTimeInitial, forceTimeFinal
119    integer :: nLoops
120   #endif
137
138  type, public :: Interaction
139     integer :: InteractionHash
140     real(kind=dp) :: rList = 0.0_dp
141     real(kind=dp) :: rListSq = 0.0_dp
142  end type Interaction
121    
122 <  type(Interaction), dimension(:,:),allocatable :: InteractionMap
123 <  
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 +  integer, dimension(:), allocatable, target :: groupToGtypeRow
130 +  integer, dimension(:), pointer :: groupToGtypeCol => null()
131 +
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 <
151 <  subroutine createInteractionMap(status)
147 >  subroutine createInteractionHash(status)
148      integer :: nAtypes
149      integer, intent(out) :: status
150      integer :: i
151      integer :: j
152 <    integer :: ihash
157 <    real(kind=dp) :: myRcut
152 >    integer :: iHash
153      !! Test Types
154      logical :: i_is_LJ
155      logical :: i_is_Elect
# Line 170 | Line 165 | contains
165      logical :: j_is_GB
166      logical :: j_is_EAM
167      logical :: j_is_Shape
168 <    
169 <    status = 0
170 <    
168 >    real(kind=dp) :: myRcut
169 >
170 >    status = 0  
171 >
172      if (.not. associated(atypes)) then
173 <       call handleError("atype", "atypes was not present before call of createDefaultInteractionMap!")
173 >       call handleError("atype", "atypes was not present before call of createInteractionHash!")
174         status = -1
175         return
176      endif
# Line 186 | Line 182 | contains
182         return
183      end if
184  
185 <    if (.not. allocated(InteractionMap)) then
186 <       allocate(InteractionMap(nAtypes,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 +    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)
# Line 241 | Line 247 | contains
247            if (i_is_LJ .and. j_is_Shape) iHash = ior(iHash, SHAPE_LJ)
248  
249  
250 <          InteractionMap(i,j)%InteractionHash = iHash
251 <          InteractionMap(j,i)%InteractionHash = iHash
250 >          InteractionHash(i,j) = iHash
251 >          InteractionHash(j,i) = iHash
252  
253         end do
254  
255      end do
256  
257 <    haveInteractionMap = .true.
258 <  end subroutine createInteractionMap
257 >    haveInteractionHash = .true.
258 >  end subroutine createInteractionHash
259  
260 < ! Query each potential and return the cutoff for that potential. We build the neighbor list based on the largest cutoff value for that atype. Each potential can decide whether to calculate the force for that atype based upon it's own cutoff.
255 <  subroutine createRcuts(defaultRList,stat)
256 <    real(kind=dp), intent(in), optional :: defaultRList
257 <    integer :: iMap
258 <    integer :: map_i,map_j
259 <    real(kind=dp) :: thisRCut = 0.0_dp
260 <    real(kind=dp) :: actualCutoff = 0.0_dp
261 <    integer, intent(out) :: stat
262 <    integer :: nAtypes
263 <    integer :: myStatus
260 >  subroutine createGtypeCutoffMap(stat)
261  
262 <    stat = 0
263 <    if (.not. haveInteractionMap) then
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 <       call createInteractionMap(myStatus)
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, *) 'createInteractionMap failed in doForces!'
284 >          write(default_error, *) 'createInteractionHash failed in doForces!'
285            stat = -1
286            return
287         endif
288      endif
289 <
290 <
289 > #ifdef IS_MPI
290 >    nGroupsInRow = getNgroupsInRow(plan_group_row)
291 >    nGroupsInCol = getNgroupsInCol(plan_group_col)
292 > #endif
293      nAtypes = getSize(atypes)
294 <    !! If we pass a default rcut, set all atypes to that cutoff distance
295 <    if(present(defaultRList)) then
296 <       InteractionMap(:,:)%rList = defaultRList
297 <       InteractionMap(:,:)%rListSq = defaultRList*defaultRList
298 <       haveRlist = .true.
299 <       return
300 <    end if
301 <
302 <    do map_i = 1,nAtypes
303 <       do map_j = map_i,nAtypes
304 <          iMap = InteractionMap(map_i, map_j)%InteractionHash
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 <          if ( iand(iMap, LJ_PAIR).ne.0 ) then
307 <             ! thisRCut = getLJCutOff(map_i,map_j)
308 <             if (thisRcut > actualCutoff) actualCutoff = thisRcut
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            
296          if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then
297             ! thisRCut = getElectrostaticCutOff(map_i,map_j)
298             if (thisRcut > actualCutoff) actualCutoff = thisRcut
299          endif
340            
341 <          if ( iand(iMap, STICKY_PAIR).ne.0 ) then
342 <             ! thisRCut = getStickyCutOff(map_i,map_j)
343 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
304 <           endif
305 <          
306 <           if ( iand(iMap, STICKYPOWER_PAIR).ne.0 ) then
307 <              ! thisRCut = getStickyPowerCutOff(map_i,map_j)
308 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
309 <           endif
310 <          
311 <           if ( iand(iMap, GAYBERNE_PAIR).ne.0 ) then
312 <              ! thisRCut = getGayberneCutOff(map_i,map_j)
313 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
314 <           endif
315 <          
316 <           if ( iand(iMap, GAYBERNE_LJ).ne.0 ) then
317 < !              thisRCut = getGaybrneLJCutOff(map_i,map_j)
318 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
319 <           endif
320 <          
321 <           if ( iand(iMap, EAM_PAIR).ne.0 ) then      
322 < !              thisRCut = getEAMCutOff(map_i,map_j)
323 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
324 <           endif
325 <          
326 <           if ( iand(iMap, SHAPE_PAIR).ne.0 ) then      
327 < !              thisRCut = getShapeCutOff(map_i,map_j)
328 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
329 <           endif
330 <          
331 <           if ( iand(iMap, SHAPE_LJ).ne.0 ) then      
332 < !              thisRCut = getShapeLJCutOff(map_i,map_j)
333 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
334 <           endif
335 <           InteractionMap(map_i, map_j)%rList = actualCutoff
336 <           InteractionMap(map_i, map_j)%rListSq = actualCutoff * actualCutoff
337 <        end do
338 <     end do
339 <     haveRlist = .true.
340 <  end subroutine createRcuts
341 >          if (atypeMaxCutoff(i).gt.biggestAtypeCutoff) then
342 >             biggestAtypeCutoff = atypeMaxCutoff(i)
343 >          endif
344  
345 +       endif
346 +    enddo
347 +  
348  
349 < !!! THIS GOES AWAY FOR SIZE DEPENDENT CUTOFF
350 < !!$  subroutine setRlistDF( this_rlist )
351 < !!$
352 < !!$   real(kind=dp) :: this_rlist
353 < !!$
354 < !!$    rlist = this_rlist
355 < !!$    rlistsq = rlist * rlist
356 < !!$
357 < !!$    haveRlist = .true.
358 < !!$
359 < !!$  end subroutine setRlistDF
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()
358    SIM_uses_LennardJones = SimUsesLennardJones()
359    SIM_uses_Electrostatics = SimUsesElectrostatics()
360    SIM_uses_Charges = SimUsesCharges()
361    SIM_uses_Dipoles = SimUsesDipoles()
362    SIM_uses_Sticky = SimUsesSticky()
363    SIM_uses_StickyPower = SimUsesStickyPower()
364    SIM_uses_GayBerne = SimUsesGayBerne()
571      SIM_uses_EAM = SimUsesEAM()
366    SIM_uses_Shapes = SimUsesShapes()
367    SIM_uses_FLARB = SimUsesFLARB()
368    SIM_uses_RF = SimUsesRF()
572      SIM_requires_postpair_calc = SimRequiresPostpairCalc()
573      SIM_requires_prepair_calc = SimRequiresPrepairCalc()
574      SIM_uses_PBC = SimUsesPBC()
# Line 382 | Line 585 | contains
585  
586      error = 0
587  
588 <    if (.not. haveInteractionMap) 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 createInteractionMap(myStatus)
390 <
598 >    if (.not. haveGtypeCutoffMap) then        
599 >       myStatus = 0      
600 >       call createGtypeCutoffMap(myStatus)      
601         if (myStatus .ne. 0) then
602 <          write(default_error, *) 'createInteractionMap failed in doForces!'
602 >          write(default_error, *) 'createGtypeCutoffMap failed in doForces!'
603            error = -1
604            return
605         endif
# Line 399 | 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 428 | 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
434 <
643 >    integer, intent(in) :: thisESM
644      integer, intent(out) :: thisStat  
645      integer :: my_status, nMatches
646      integer, pointer :: MatchList(:) => null()
# Line 440 | Line 649 | contains
649      !! assume things are copacetic, unless they aren't
650      thisStat = 0
651  
652 <    !! Fortran's version of a cast:
444 <    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 450 | Line 658 | contains
658      !! interactions are used by the force field.    
659  
660      FF_uses_DirectionalAtoms = .false.
453    FF_uses_LennardJones = .false.
454    FF_uses_Electrostatics = .false.
455    FF_uses_Charges = .false.    
661      FF_uses_Dipoles = .false.
457    FF_uses_Sticky = .false.
458    FF_uses_StickyPower = .false.
662      FF_uses_GayBerne = .false.
663      FF_uses_EAM = .false.
461    FF_uses_Shapes = .false.
462    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  
468    call getMatchingElementList(atypes, "is_LennardJones", .true., &
469         nMatches, MatchList)
470    if (nMatches .gt. 0) FF_uses_LennardJones = .true.
471
472    call getMatchingElementList(atypes, "is_Electrostatic", .true., &
473         nMatches, MatchList)
474    if (nMatches .gt. 0) then
475       FF_uses_Electrostatics = .true.
476    endif
477
478    call getMatchingElementList(atypes, "is_Charge", .true., &
479         nMatches, MatchList)
480    if (nMatches .gt. 0) then
481       FF_uses_Charges = .true.  
482       FF_uses_Electrostatics = .true.
483    endif
484
669      call getMatchingElementList(atypes, "is_Dipole", .true., &
670           nMatches, MatchList)
671 <    if (nMatches .gt. 0) then
488 <       FF_uses_Dipoles = .true.
489 <       FF_uses_Electrostatics = .true.
490 <       FF_uses_DirectionalAtoms = .true.
491 <    endif
492 <
493 <    call getMatchingElementList(atypes, "is_Quadrupole", .true., &
494 <         nMatches, MatchList)
495 <    if (nMatches .gt. 0) then
496 <       FF_uses_Quadrupoles = .true.
497 <       FF_uses_Electrostatics = .true.
498 <       FF_uses_DirectionalAtoms = .true.
499 <    endif
500 <
501 <    call getMatchingElementList(atypes, "is_Sticky", .true., nMatches, &
502 <         MatchList)
503 <    if (nMatches .gt. 0) then
504 <       FF_uses_Sticky = .true.
505 <       FF_uses_DirectionalAtoms = .true.
506 <    endif
507 <
508 <    call getMatchingElementList(atypes, "is_StickyPower", .true., nMatches, &
509 <         MatchList)
510 <    if (nMatches .gt. 0) then
511 <       FF_uses_StickyPower = .true.
512 <       FF_uses_DirectionalAtoms = .true.
513 <    endif
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
518 <       FF_uses_GayBerne = .true.
519 <       FF_uses_DirectionalAtoms = .true.
520 <    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  
525    call getMatchingElementList(atypes, "is_Shape", .true., &
526         nMatches, MatchList)
527    if (nMatches .gt. 0) then
528       FF_uses_Shapes = .true.
529       FF_uses_DirectionalAtoms = .true.
530    endif
680  
532    call getMatchingElementList(atypes, "is_FLARB", .true., &
533         nMatches, MatchList)
534    if (nMatches .gt. 0) FF_uses_FLARB = .true.
535
536    !! Assume sanity (for the sake of argument)
681      haveSaneForceField = .true.
538
539    !! check to make sure the FF_uses_RF setting makes sense
540
541    if (FF_uses_dipoles) then
542       if (FF_uses_RF) then
543          dielect = getDielect()
544          call initialize_rf(dielect)
545       endif
546    else
547       if (FF_uses_RF) then          
548          write(default_error,*) 'Using Reaction Field with no dipoles?  Huh?'
549          thisStat = -1
550          haveSaneForceField = .false.
551          return
552       endif
553    endif
554
555    !sticky module does not contain check_sticky_FF anymore
556    !if (FF_uses_sticky) then
557    !   call check_sticky_FF(my_status)
558    !   if (my_status /= 0) then
559    !      thisStat = -1
560    !      haveSaneForceField = .false.
561    !      return
562    !   end if
563    !endif
682  
683      if (FF_uses_EAM) then
684         call init_EAM_FF(my_status)
# Line 572 | Line 690 | contains
690         end if
691      endif
692  
575    if (FF_uses_GayBerne) then
576       call check_gb_pair_FF(my_status)
577       if (my_status .ne. 0) then
578          thisStat = -1
579          haveSaneForceField = .false.
580          return
581       endif
582    endif
583
584    if (FF_uses_GayBerne .and. FF_uses_LennardJones) then
585    endif
586
693      if (.not. haveNeighborList) then
694         !! Create neighbor lists
695         call expandNeighborList(nLocal, my_status)
# Line 617 | 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 647 | Line 753 | contains
753      integer :: localError
754      integer :: propPack_i, propPack_j
755      integer :: loopStart, loopEnd, loop
756 <    integer :: iMap
757 <    real(kind=dp) :: listSkin = 1.0  
756 >    integer :: iHash
757 >    integer :: ig
758 >  
759  
760      !! initialize local variables  
761  
# Line 739 | Line 846 | contains
846   #endif
847         outer: do i = istart, iend
848  
742 #ifdef IS_MPI
743             me_i = atid_row(i)
744 #else
745             me_i = atid(i)
746 #endif
747
849            if (update_nlist) point(i) = nlist + 1
850  
851            n_in_i = groupStartRow(i+1) - groupStartRow(i)
# Line 779 | Line 880 | contains
880               me_j = atid(j)
881               call get_interatomic_vector(q_group(:,i), &
882                    q_group(:,j), d_grp, rgrpsq)
883 < #endif
883 > #endif      
884  
885 <             if (rgrpsq < InteractionMap(me_i,me_j)%rListsq) then
885 >             if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rListsq) then
886                  if (update_nlist) then
887                     nlist = nlist + 1
888  
# Line 848 | Line 949 | contains
949                        else
950   #ifdef IS_MPI                      
951                           call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
952 <                              do_pot, &
953 <                              eFrame, A, f, t, pot_local, vpair, fpair)
952 >                              do_pot, eFrame, A, f, t, pot_local, vpair, &
953 >                              fpair, d_grp, rgrp)
954   #else
955                           call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
956 <                              do_pot,  &
957 <                              eFrame, A, f, t, pot, vpair, fpair)
956 >                              do_pot, eFrame, A, f, t, pot, vpair, fpair, &
957 >                              d_grp, rgrp)
958   #endif
959  
960                           vij = vij + vpair
# Line 902 | Line 1003 | contains
1003                  endif
1004               end if
1005            enddo
1006 +
1007         enddo outer
1008  
1009         if (update_nlist) then
# Line 961 | Line 1063 | contains
1063  
1064      if (do_pot) then
1065         ! scatter/gather pot_row into the members of my column
1066 <       call scatter(pot_Row, pot_Temp, plan_atom_row)
1067 <
1066 >       do i = 1,LR_POT_TYPES
1067 >          call scatter(pot_Row(i,:), pot_Temp(i,:), plan_atom_row)
1068 >       end do
1069         ! scatter/gather pot_local into all other procs
1070         ! add resultant to get total pot
1071         do i = 1, nlocal
1072 <          pot_local = pot_local + pot_Temp(i)
1072 >          pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES) &
1073 >               + pot_Temp(1:LR_POT_TYPES,i)
1074         enddo
1075  
1076         pot_Temp = 0.0_DP
1077 <
1078 <       call scatter(pot_Col, pot_Temp, plan_atom_col)
1077 >       do i = 1,LR_POT_TYPES
1078 >          call scatter(pot_Col(i,:), pot_Temp(i,:), plan_atom_col)
1079 >       end do
1080         do i = 1, nlocal
1081 <          pot_local = pot_local + pot_Temp(i)
1081 >          pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES)&
1082 >               + pot_Temp(1:LR_POT_TYPES,i)
1083         enddo
1084  
1085      endif
1086   #endif
1087  
1088 <    if (FF_RequiresPostpairCalc() .and. SIM_requires_postpair_calc) then
1088 >    if (SIM_requires_postpair_calc) then
1089 >       do i = 1, nlocal            
1090 >          
1091 >          ! we loop only over the local atoms, so we don't need row and column
1092 >          ! lookups for the types
1093  
1094 <       if (FF_uses_RF .and. SIM_uses_RF) then
1095 <
1094 >          me_i = atid(i)
1095 >          
1096 >          ! is the atom electrostatic?  See if it would have an
1097 >          ! electrostatic interaction with itself
1098 >          iHash = InteractionHash(me_i,me_i)
1099 >          
1100 >          if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1101   #ifdef IS_MPI
1102 <          call scatter(rf_Row,rf,plan_atom_row_3d)
1103 <          call scatter(rf_Col,rf_Temp,plan_atom_col_3d)
989 <          do i = 1,nlocal
990 <             rf(1:3,i) = rf(1:3,i) + rf_Temp(1:3,i)
991 <          end do
992 < #endif
993 <
994 <          do i = 1, nLocal
995 <
996 <             rfpot = 0.0_DP
997 < #ifdef IS_MPI
998 <             me_i = atid_row(i)
1102 >             call rf_self_self(i, eFrame, pot_local(ELECTROSTATIC_POT), &
1103 >                  t, do_pot)
1104   #else
1105 <             me_i = atid(i)
1105 >             call rf_self_self(i, eFrame, pot(ELECTROSTATIC_POT), &
1106 >                  t, do_pot)
1107   #endif
1108 <             iMap = InteractionMap(me_i, me_j)%InteractionHash
1109 <            
1004 <             if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then
1005 <
1006 <                mu_i = getDipoleMoment(me_i)
1007 <
1008 <                !! The reaction field needs to include a self contribution
1009 <                !! to the field:
1010 <                call accumulate_self_rf(i, mu_i, eFrame)
1011 <                !! Get the reaction field contribution to the
1012 <                !! potential and torques:
1013 <                call reaction_field_final(i, mu_i, eFrame, rfpot, t, do_pot)
1014 < #ifdef IS_MPI
1015 <                pot_local = pot_local + rfpot
1016 < #else
1017 <                pot = pot + rfpot
1018 <
1019 < #endif
1020 <             endif
1021 <          enddo
1022 <       endif
1108 >          endif
1109 >       enddo
1110      endif
1111 <
1025 <
1111 >    
1112   #ifdef IS_MPI
1113 <
1113 >    
1114      if (do_pot) then
1115 <       pot = pot + pot_local
1116 <       !! we assume the c code will do the allreduce to get the total potential
1031 <       !! we could do it right here if we needed to...
1115 >       call mpi_allreduce(pot_local, pot, LR_POT_TYPES,mpi_double_precision,mpi_sum, &
1116 >            mpi_comm_world,mpi_err)            
1117      endif
1118 <
1118 >    
1119      if (do_stress) then
1120         call mpi_allreduce(tau_Temp, tau, 9,mpi_double_precision,mpi_sum, &
1121              mpi_comm_world,mpi_err)
1122         call mpi_allreduce(virial_Temp, virial,1,mpi_double_precision,mpi_sum, &
1123              mpi_comm_world,mpi_err)
1124      endif
1125 <
1125 >    
1126   #else
1127 <
1127 >    
1128      if (do_stress) then
1129         tau = tau_Temp
1130         virial = virial_Temp
1131      endif
1132 <
1132 >    
1133   #endif
1134 <
1134 >    
1135    end subroutine do_force_loop
1136  
1137    subroutine do_pair(i, j, rijsq, d, sw, do_pot, &
1138 <       eFrame, A, f, t, pot, vpair, fpair)
1138 >       eFrame, A, f, t, pot, vpair, fpair, d_grp, r_grp)
1139  
1140 <    real( kind = dp ) :: pot, vpair, sw
1140 >    real( kind = dp ) :: vpair, sw
1141 >    real( kind = dp ), dimension(LR_POT_TYPES) :: pot
1142      real( kind = dp ), dimension(3) :: fpair
1143      real( kind = dp ), dimension(nLocal)   :: mfact
1144      real( kind = dp ), dimension(9,nLocal) :: eFrame
# Line 1063 | Line 1149 | contains
1149      logical, intent(inout) :: do_pot
1150      integer, intent(in) :: i, j
1151      real ( kind = dp ), intent(inout) :: rijsq
1152 <    real ( kind = dp )                :: r
1152 >    real ( kind = dp ), intent(inout) :: r_grp
1153      real ( kind = dp ), intent(inout) :: d(3)
1154 <    real ( kind = dp ) :: ebalance
1154 >    real ( kind = dp ), intent(inout) :: d_grp(3)
1155 >    real ( kind = dp ) :: r
1156      integer :: me_i, me_j
1157  
1158 <    integer :: iMap
1158 >    integer :: iHash
1159  
1160      r = sqrt(rijsq)
1161      vpair = 0.0d0
# Line 1082 | Line 1169 | contains
1169      me_j = atid(j)
1170   #endif
1171  
1172 <    iMap = InteractionMap(me_i, me_j)%InteractionHash
1172 >    iHash = InteractionHash(me_i, me_j)
1173  
1174 <    if ( iand(iMap, LJ_PAIR).ne.0 ) then
1175 <       call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, do_pot)
1174 >    if ( iand(iHash, LJ_PAIR).ne.0 ) then
1175 >       call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1176 >            pot(VDW_POT), f, do_pot)
1177      endif
1178  
1179 <    if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then
1179 >    if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1180         call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1181 <            pot, eFrame, f, t, do_pot)
1094 <
1095 <       if (FF_uses_RF .and. SIM_uses_RF) then
1096 <
1097 <          ! CHECK ME (RF needs to know about all electrostatic types)
1098 <          call accumulate_rf(i, j, r, eFrame, sw)
1099 <          call rf_correct_forces(i, j, d, r, eFrame, sw, f, fpair)
1100 <       endif
1101 <
1181 >            pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot)
1182      endif
1183  
1184 <    if ( iand(iMap, STICKY_PAIR).ne.0 ) then
1184 >    if ( iand(iHash, STICKY_PAIR).ne.0 ) then
1185         call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1186 <            pot, A, f, t, do_pot)
1186 >            pot(HB_POT), A, f, t, do_pot)
1187      endif
1188  
1189 <    if ( iand(iMap, STICKYPOWER_PAIR).ne.0 ) then
1189 >    if ( iand(iHash, STICKYPOWER_PAIR).ne.0 ) then
1190         call do_sticky_power_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1191 <            pot, A, f, t, do_pot)
1191 >            pot(HB_POT), A, f, t, do_pot)
1192      endif
1193  
1194 <    if ( iand(iMap, GAYBERNE_PAIR).ne.0 ) then
1194 >    if ( iand(iHash, GAYBERNE_PAIR).ne.0 ) then
1195         call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1196 <            pot, A, f, t, do_pot)
1196 >            pot(VDW_POT), A, f, t, do_pot)
1197      endif
1198      
1199 <    if ( iand(iMap, GAYBERNE_LJ).ne.0 ) then
1200 < !      call do_gblj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1201 < !           pot, A, f, t, do_pot)
1199 >    if ( iand(iHash, GAYBERNE_LJ).ne.0 ) then
1200 >       call do_gb_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1201 >            pot(VDW_POT), A, f, t, do_pot)
1202      endif
1203  
1204 <    if ( iand(iMap, EAM_PAIR).ne.0 ) then      
1205 <       call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, &
1206 <            do_pot)
1207 <    endif
1208 <
1209 <    if ( iand(iMap, SHAPE_PAIR).ne.0 ) then      
1204 >    if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1205 >       call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1206 >            pot(METALLIC_POT), f, do_pot)
1207 >    endif
1208 >
1209 >    if ( iand(iHash, SHAPE_PAIR).ne.0 ) then      
1210         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1211 <            pot, A, f, t, do_pot)
1211 >            pot(VDW_POT), A, f, t, do_pot)
1212      endif
1213  
1214 <    if ( iand(iMap, SHAPE_LJ).ne.0 ) then      
1214 >    if ( iand(iHash, SHAPE_LJ).ne.0 ) then      
1215         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1216 <            pot, A, f, t, do_pot)
1216 >            pot(VDW_POT), A, f, t, do_pot)
1217      endif
1218      
1219    end subroutine do_pair
# Line 1141 | Line 1221 | contains
1221    subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, &
1222         do_pot, do_stress, eFrame, A, f, t, pot)
1223  
1224 <    real( kind = dp ) :: pot, sw
1224 >    real( kind = dp ) :: sw
1225 >    real( kind = dp ), dimension(LR_POT_TYPES) :: pot
1226      real( kind = dp ), dimension(9,nLocal) :: eFrame
1227      real (kind=dp), dimension(9,nLocal) :: A
1228      real (kind=dp), dimension(3,nLocal) :: f
# Line 1153 | Line 1234 | contains
1234      real ( kind = dp )                :: r, rc
1235      real ( kind = dp ), intent(inout) :: d(3), dc(3)
1236  
1237 <    integer :: me_i, me_j, iMap
1237 >    integer :: me_i, me_j, iHash
1238  
1239 +    r = sqrt(rijsq)
1240 +
1241   #ifdef IS_MPI  
1242      me_i = atid_row(i)
1243      me_j = atid_col(j)  
# Line 1163 | Line 1246 | contains
1246      me_j = atid(j)  
1247   #endif
1248  
1249 <    iMap = InteractionMap(me_i, me_j)%InteractionHash
1249 >    iHash = InteractionHash(me_i, me_j)
1250  
1251 <    if ( iand(iMap, EAM_PAIR).ne.0 ) then      
1251 >    if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1252              call calc_EAM_prepair_rho(i, j, d, r, rijsq )
1253      endif
1254      
# Line 1174 | Line 1257 | contains
1257  
1258    subroutine do_preforce(nlocal,pot)
1259      integer :: nlocal
1260 <    real( kind = dp ) :: pot
1260 >    real( kind = dp ),dimension(LR_POT_TYPES) :: pot
1261  
1262      if (FF_uses_EAM .and. SIM_uses_EAM) then
1263 <       call calc_EAM_preforce_Frho(nlocal,pot)
1263 >       call calc_EAM_preforce_Frho(nlocal,pot(METALLIC_POT))
1264      endif
1265  
1266  
# Line 1362 | Line 1445 | contains
1445  
1446    function FF_UsesDirectionalAtoms() result(doesit)
1447      logical :: doesit
1448 <    doesit = FF_uses_DirectionalAtoms .or. FF_uses_Dipoles .or. &
1366 <         FF_uses_Quadrupoles .or. FF_uses_Sticky .or. &
1367 <         FF_uses_StickyPower .or. FF_uses_GayBerne .or. FF_uses_Shapes
1448 >    doesit = FF_uses_DirectionalAtoms
1449    end function FF_UsesDirectionalAtoms
1450  
1451    function FF_RequiresPrepairCalc() result(doesit)
# Line 1372 | Line 1453 | contains
1453      doesit = FF_uses_EAM
1454    end function FF_RequiresPrepairCalc
1455  
1375  function FF_RequiresPostpairCalc() result(doesit)
1376    logical :: doesit
1377    doesit = FF_uses_RF
1378  end function FF_RequiresPostpairCalc
1379
1456   #ifdef PROFILE
1457    function getforcetime() result(totalforcetime)
1458      real(kind=dp) :: totalforcetime

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines