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 2301 by gezelter, Thu Sep 15 22:05:21 2005 UTC vs.
Revision 2717 by gezelter, Mon Apr 17 21:49:12 2006 UTC

# Line 45 | Line 45
45  
46   !! @author Charles F. Vardeman II
47   !! @author Matthew Meineke
48 < !! @version $Id: doForces.F90,v 1.44 2005-09-15 22:05:17 gezelter Exp $, $Date: 2005-09-15 22:05:17 $, $Name: not supported by cvs2svn $, $Revision: 1.44 $
48 > !! @version $Id: doForces.F90,v 1.78 2006-04-17 21:49:12 gezelter Exp $, $Date: 2006-04-17 21:49:12 $, $Name: not supported by cvs2svn $, $Revision: 1.78 $
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_module
62 <  use gb_pair
61 >  use gayberne
62    use shapes
63    use vector_class
64    use eam
65 +  use suttonchen
66    use status
67 +  use interpolation
68   #ifdef IS_MPI
69    use mpiSimulation
70   #endif
# Line 75 | Line 76 | module doForces
76   #include "UseTheForce/fSwitchingFunction.h"
77   #include "UseTheForce/fCutoffPolicy.h"
78   #include "UseTheForce/DarkSide/fInteractionMap.h"
79 + #include "UseTheForce/DarkSide/fElectrostaticSummationMethod.h"
80  
81  
82    INTEGER, PARAMETER:: PREPAIR_LOOP = 1
# Line 85 | Line 87 | module doForces
87    logical, save :: haveSaneForceField = .false.
88    logical, save :: haveInteractionHash = .false.
89    logical, save :: haveGtypeCutoffMap = .false.
90 <  logical, save :: haveRlist = .false.
90 >  logical, save :: haveDefaultCutoffs = .false.
91 >  logical, save :: haveSkinThickness = .false.
92 >  logical, save :: haveElectrostaticSummationMethod = .false.
93 >  logical, save :: haveCutoffPolicy = .false.
94 >  logical, save :: VisitCutoffsAfterComputing = .false.
95  
96    logical, save :: FF_uses_DirectionalAtoms
97    logical, save :: FF_uses_Dipoles
98    logical, save :: FF_uses_GayBerne
99    logical, save :: FF_uses_EAM
100 <  logical, save :: FF_uses_RF
100 >  logical, save :: FF_uses_SC
101 >  logical, save :: FF_uses_MEAM
102 >
103  
104    logical, save :: SIM_uses_DirectionalAtoms
105    logical, save :: SIM_uses_EAM
106 <  logical, save :: SIM_uses_RF
106 >  logical, save :: SIM_uses_SC
107 >  logical, save :: SIM_uses_MEAM
108    logical, save :: SIM_requires_postpair_calc
109    logical, save :: SIM_requires_prepair_calc
110    logical, save :: SIM_uses_PBC
111  
112 <  integer, save :: corrMethod
112 >  integer, save :: electrostaticSummationMethod
113 >  integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY
114  
115 +  real(kind=dp), save :: defaultRcut, defaultRsw, largestRcut
116 +  real(kind=dp), save :: skinThickness
117 +  logical, save :: defaultDoShift
118 +
119    public :: init_FF
120 <  public :: setDefaultCutoffs
120 >  public :: setCutoffs
121 >  public :: cWasLame
122 >  public :: setElectrostaticMethod
123 >  public :: setCutoffPolicy
124 >  public :: setSkinThickness
125    public :: do_force_loop
108  public :: createInteractionHash
109  public :: createGtypeCutoffMap
110  public :: getStickyCut
111  public :: getStickyPowerCut
112  public :: getGayBerneCut
113  public :: getEAMCut
114  public :: getShapeCut
126  
127   #ifdef PROFILE
128    public :: getforcetime
# Line 124 | Line 135 | module doForces
135    ! Bit hash to determine pair-pair interactions.
136    integer, dimension(:,:), allocatable :: InteractionHash
137    real(kind=dp), dimension(:), allocatable :: atypeMaxCutoff
138 <  real(kind=dp), dimension(:), allocatable :: groupMaxCutoff
139 <  integer, dimension(:), allocatable :: groupToGtype
140 <  real(kind=dp), dimension(:), allocatable :: gtypeMaxCutoff
138 >  real(kind=dp), dimension(:), allocatable, target :: groupMaxCutoffRow
139 >  real(kind=dp), dimension(:), pointer :: groupMaxCutoffCol
140 >
141 >  integer, dimension(:), allocatable, target :: groupToGtypeRow
142 >  integer, dimension(:), pointer :: groupToGtypeCol => null()
143 >
144 >  real(kind=dp), dimension(:), allocatable,target :: gtypeMaxCutoffRow
145 >  real(kind=dp), dimension(:), pointer :: gtypeMaxCutoffCol
146    type ::gtypeCutoffs
147       real(kind=dp) :: rcut
148       real(kind=dp) :: rcutsq
# Line 134 | Line 150 | module doForces
150    end type gtypeCutoffs
151    type(gtypeCutoffs), dimension(:,:), allocatable :: gtypeCutoffMap
152  
137  integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY
138  real(kind=dp),save :: defaultRcut, defaultRsw, defaultRlist
139  real(kind=dp),save :: rcuti
140  
153   contains
154  
155 <  subroutine createInteractionHash(status)
155 >  subroutine createInteractionHash()
156      integer :: nAtypes
145    integer, intent(out) :: status
157      integer :: i
158      integer :: j
159      integer :: iHash
# Line 154 | Line 165 | contains
165      logical :: i_is_GB
166      logical :: i_is_EAM
167      logical :: i_is_Shape
168 +    logical :: i_is_SC
169 +    logical :: i_is_MEAM
170      logical :: j_is_LJ
171      logical :: j_is_Elect
172      logical :: j_is_Sticky
# Line 161 | Line 174 | contains
174      logical :: j_is_GB
175      logical :: j_is_EAM
176      logical :: j_is_Shape
177 +    logical :: j_is_SC
178 +    logical :: j_is_MEAM
179      real(kind=dp) :: myRcut
180  
166    status = 0  
167
181      if (.not. associated(atypes)) then
182 <       call handleError("atype", "atypes was not present before call of createInteractionHash!")
170 <       status = -1
182 >       call handleError("doForces", "atypes was not present before call of createInteractionHash!")
183         return
184      endif
185      
186      nAtypes = getSize(atypes)
187      
188      if (nAtypes == 0) then
189 <       status = -1
189 >       call handleError("doForces", "nAtypes was zero during call of createInteractionHash!")
190         return
191      end if
192  
193      if (.not. allocated(InteractionHash)) then
194         allocate(InteractionHash(nAtypes,nAtypes))
195 +    else
196 +       deallocate(InteractionHash)
197 +       allocate(InteractionHash(nAtypes,nAtypes))
198      endif
199  
200      if (.not. allocated(atypeMaxCutoff)) then
201         allocate(atypeMaxCutoff(nAtypes))
202 +    else
203 +       deallocate(atypeMaxCutoff)
204 +       allocate(atypeMaxCutoff(nAtypes))
205      endif
206          
207      do i = 1, nAtypes
# Line 194 | Line 212 | contains
212         call getElementProperty(atypes, i, "is_GayBerne", i_is_GB)
213         call getElementProperty(atypes, i, "is_EAM", i_is_EAM)
214         call getElementProperty(atypes, i, "is_Shape", i_is_Shape)
215 +       call getElementProperty(atypes, i, "is_SC", i_is_SC)
216 +       call getElementProperty(atypes, i, "is_MEAM", i_is_MEAM)
217  
218         do j = i, nAtypes
219  
# Line 207 | Line 227 | contains
227            call getElementProperty(atypes, j, "is_GayBerne", j_is_GB)
228            call getElementProperty(atypes, j, "is_EAM", j_is_EAM)
229            call getElementProperty(atypes, j, "is_Shape", j_is_Shape)
230 +          call getElementProperty(atypes, j, "is_SC", j_is_SC)
231 +          call getElementProperty(atypes, j, "is_MEAM", j_is_MEAM)
232  
233            if (i_is_LJ .and. j_is_LJ) then
234               iHash = ior(iHash, LJ_PAIR)            
# Line 228 | Line 250 | contains
250               iHash = ior(iHash, EAM_PAIR)
251            endif
252  
253 +          if (i_is_SC .and. j_is_SC) then
254 +             iHash = ior(iHash, SC_PAIR)
255 +          endif
256 +
257            if (i_is_GB .and. j_is_GB) iHash = ior(iHash, GAYBERNE_PAIR)
258            if (i_is_GB .and. j_is_LJ) iHash = ior(iHash, GAYBERNE_LJ)
259            if (i_is_LJ .and. j_is_GB) iHash = ior(iHash, GAYBERNE_LJ)
# Line 247 | Line 273 | contains
273      haveInteractionHash = .true.
274    end subroutine createInteractionHash
275  
276 <  subroutine createGtypeCutoffMap(stat)
276 >  subroutine createGtypeCutoffMap()
277  
252    integer, intent(out), optional :: stat
278      logical :: i_is_LJ
279      logical :: i_is_Elect
280      logical :: i_is_Sticky
# Line 257 | Line 282 | contains
282      logical :: i_is_GB
283      logical :: i_is_EAM
284      logical :: i_is_Shape
285 +    logical :: i_is_SC
286      logical :: GtypeFound
287  
288      integer :: myStatus, nAtypes,  i, j, istart, iend, jstart, jend
289 <    integer :: n_in_i, me_i, ia, g, atom1, nGroupTypes
289 >    integer :: n_in_i, me_i, ia, g, atom1, ja, n_in_j,me_j
290      integer :: nGroupsInRow
291 <    real(kind=dp):: thisSigma, bigSigma, thisRcut, tol, skin
291 >    integer :: nGroupsInCol
292 >    integer :: nGroupTypesRow,nGroupTypesCol
293 >    real(kind=dp):: thisSigma, bigSigma, thisRcut, tradRcut, tol
294      real(kind=dp) :: biggestAtypeCutoff
295  
268    stat = 0
296      if (.not. haveInteractionHash) then
297 <       call createInteractionHash(myStatus)      
271 <       if (myStatus .ne. 0) then
272 <          write(default_error, *) 'createInteractionHash failed in doForces!'
273 <          stat = -1
274 <          return
275 <       endif
297 >       call createInteractionHash()      
298      endif
299   #ifdef IS_MPI
300      nGroupsInRow = getNgroupsInRow(plan_group_row)
301 +    nGroupsInCol = getNgroupsInCol(plan_group_col)
302   #endif
303      nAtypes = getSize(atypes)
304   ! Set all of the initial cutoffs to zero.
# Line 289 | Line 312 | contains
312            call getElementProperty(atypes, i, "is_GayBerne", i_is_GB)
313            call getElementProperty(atypes, i, "is_EAM", i_is_EAM)
314            call getElementProperty(atypes, i, "is_Shape", i_is_Shape)
315 <          
315 >          call getElementProperty(atypes, i, "is_SC", i_is_SC)
316  
317 <          if (i_is_LJ) then
318 <             thisRcut = getSigma(i) * 2.5_dp
319 <             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
320 <          endif
321 <          if (i_is_Elect) then
322 <             thisRcut = defaultRcut
323 <             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
324 <          endif
325 <          if (i_is_Sticky) then
326 <             thisRcut = getStickyCut(i)
327 <             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
328 <          endif
329 <          if (i_is_StickyP) then
330 <             thisRcut = getStickyPowerCut(i)
331 <             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
332 <          endif
333 <          if (i_is_GB) then
334 <             thisRcut = getGayBerneCut(i)
335 <             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
336 <          endif
337 <          if (i_is_EAM) then
338 <             thisRcut = getEAMCut(i)
339 <             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
340 <          endif
341 <          if (i_is_Shape) then
342 <             thisRcut = getShapeCut(i)
343 <             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
317 >          if (haveDefaultCutoffs) then
318 >             atypeMaxCutoff(i) = defaultRcut
319 >          else
320 >             if (i_is_LJ) then          
321 >                thisRcut = getSigma(i) * 2.5_dp
322 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
323 >             endif
324 >             if (i_is_Elect) then
325 >                thisRcut = defaultRcut
326 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
327 >             endif
328 >             if (i_is_Sticky) then
329 >                thisRcut = getStickyCut(i)
330 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
331 >             endif
332 >             if (i_is_StickyP) then
333 >                thisRcut = getStickyPowerCut(i)
334 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
335 >             endif
336 >             if (i_is_GB) then
337 >                thisRcut = getGayBerneCut(i)
338 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
339 >             endif
340 >             if (i_is_EAM) then
341 >                thisRcut = getEAMCut(i)
342 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
343 >             endif
344 >             if (i_is_Shape) then
345 >                thisRcut = getShapeCut(i)
346 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
347 >             endif
348 >             if (i_is_SC) then
349 >                thisRcut = getSCCut(i)
350 >                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
351 >             endif
352            endif
353 <          
353 >                    
354            if (atypeMaxCutoff(i).gt.biggestAtypeCutoff) then
355               biggestAtypeCutoff = atypeMaxCutoff(i)
356            endif
357 +
358         endif
359      enddo
328  
329    nGroupTypes = 0
360      
361      istart = 1
362 +    jstart = 1
363   #ifdef IS_MPI
364      iend = nGroupsInRow
365 +    jend = nGroupsInCol
366   #else
367      iend = nGroups
368 +    jend = nGroups
369   #endif
370      
371      !! allocate the groupToGtype and gtypeMaxCutoff here.
372 <    if(.not.allocated(groupToGtype)) then
373 <       allocate(groupToGtype(iend))
374 <       allocate(groupMaxCutoff(iend))
375 <       allocate(gtypeMaxCutoff(iend))
376 <       groupMaxCutoff = 0.0_dp
377 <       gtypeMaxCutoff = 0.0_dp
372 >    if(.not.allocated(groupToGtypeRow)) then
373 >     !  allocate(groupToGtype(iend))
374 >       allocate(groupToGtypeRow(iend))
375 >    else
376 >       deallocate(groupToGtypeRow)
377 >       allocate(groupToGtypeRow(iend))
378      endif
379 +    if(.not.allocated(groupMaxCutoffRow)) then
380 +       allocate(groupMaxCutoffRow(iend))
381 +    else
382 +       deallocate(groupMaxCutoffRow)
383 +       allocate(groupMaxCutoffRow(iend))
384 +    end if
385 +
386 +    if(.not.allocated(gtypeMaxCutoffRow)) then
387 +       allocate(gtypeMaxCutoffRow(iend))
388 +    else
389 +       deallocate(gtypeMaxCutoffRow)
390 +       allocate(gtypeMaxCutoffRow(iend))
391 +    endif
392 +
393 +
394 + #ifdef IS_MPI
395 +       ! We only allocate new storage if we are in MPI because Ncol /= Nrow
396 +    if(.not.associated(groupToGtypeCol)) then
397 +       allocate(groupToGtypeCol(jend))
398 +    else
399 +       deallocate(groupToGtypeCol)
400 +       allocate(groupToGtypeCol(jend))
401 +    end if
402 +
403 +    if(.not.associated(groupMaxCutoffCol)) then
404 +       allocate(groupMaxCutoffCol(jend))
405 +    else
406 +       deallocate(groupMaxCutoffCol)
407 +       allocate(groupMaxCutoffCol(jend))
408 +    end if
409 +    if(.not.associated(gtypeMaxCutoffCol)) then
410 +       allocate(gtypeMaxCutoffCol(jend))
411 +    else
412 +       deallocate(gtypeMaxCutoffCol)      
413 +       allocate(gtypeMaxCutoffCol(jend))
414 +    end if
415 +
416 +       groupMaxCutoffCol = 0.0_dp
417 +       gtypeMaxCutoffCol = 0.0_dp
418 +
419 + #endif
420 +       groupMaxCutoffRow = 0.0_dp
421 +       gtypeMaxCutoffRow = 0.0_dp
422 +
423 +
424      !! first we do a single loop over the cutoff groups to find the
425      !! largest cutoff for any atypes present in this group.  We also
426      !! create gtypes at this point.
427      
428      tol = 1.0d-6
429 <    
429 >    nGroupTypesRow = 0
430 >    nGroupTypesCol = 0
431      do i = istart, iend      
432         n_in_i = groupStartRow(i+1) - groupStartRow(i)
433 <       groupMaxCutoff(i) = 0.0_dp
433 >       groupMaxCutoffRow(i) = 0.0_dp
434         do ia = groupStartRow(i), groupStartRow(i+1)-1
435            atom1 = groupListRow(ia)
436   #ifdef IS_MPI
# Line 359 | Line 438 | contains
438   #else
439            me_i = atid(atom1)
440   #endif          
441 <          if (atypeMaxCutoff(me_i).gt.groupMaxCutoff(i)) then
442 <             groupMaxCutoff(i)=atypeMaxCutoff(me_i)
441 >          if (atypeMaxCutoff(me_i).gt.groupMaxCutoffRow(i)) then
442 >             groupMaxCutoffRow(i)=atypeMaxCutoff(me_i)
443            endif          
444         enddo
445 +       if (nGroupTypesRow.eq.0) then
446 +          nGroupTypesRow = nGroupTypesRow + 1
447 +          gtypeMaxCutoffRow(nGroupTypesRow) = groupMaxCutoffRow(i)
448 +          groupToGtypeRow(i) = nGroupTypesRow
449 +       else
450 +          GtypeFound = .false.
451 +          do g = 1, nGroupTypesRow
452 +             if ( abs(groupMaxCutoffRow(i) - gtypeMaxCutoffRow(g)).lt.tol) then
453 +                groupToGtypeRow(i) = g
454 +                GtypeFound = .true.
455 +             endif
456 +          enddo
457 +          if (.not.GtypeFound) then            
458 +             nGroupTypesRow = nGroupTypesRow + 1
459 +             gtypeMaxCutoffRow(nGroupTypesRow) = groupMaxCutoffRow(i)
460 +             groupToGtypeRow(i) = nGroupTypesRow
461 +          endif
462 +       endif
463 +    enddo    
464  
465 <       if (nGroupTypes.eq.0) then
466 <          nGroupTypes = nGroupTypes + 1
467 <          gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
468 <          groupToGtype(i) = nGroupTypes
465 > #ifdef IS_MPI
466 >    do j = jstart, jend      
467 >       n_in_j = groupStartCol(j+1) - groupStartCol(j)
468 >       groupMaxCutoffCol(j) = 0.0_dp
469 >       do ja = groupStartCol(j), groupStartCol(j+1)-1
470 >          atom1 = groupListCol(ja)
471 >
472 >          me_j = atid_col(atom1)
473 >
474 >          if (atypeMaxCutoff(me_j).gt.groupMaxCutoffCol(j)) then
475 >             groupMaxCutoffCol(j)=atypeMaxCutoff(me_j)
476 >          endif          
477 >       enddo
478 >
479 >       if (nGroupTypesCol.eq.0) then
480 >          nGroupTypesCol = nGroupTypesCol + 1
481 >          gtypeMaxCutoffCol(nGroupTypesCol) = groupMaxCutoffCol(j)
482 >          groupToGtypeCol(j) = nGroupTypesCol
483         else
484            GtypeFound = .false.
485 <          do g = 1, nGroupTypes
486 <             if ( abs(groupMaxCutoff(i) - gtypeMaxCutoff(g)).lt.tol) then
487 <                groupToGtype(i) = g
485 >          do g = 1, nGroupTypesCol
486 >             if ( abs(groupMaxCutoffCol(j) - gtypeMaxCutoffCol(g)).lt.tol) then
487 >                groupToGtypeCol(j) = g
488                  GtypeFound = .true.
489               endif
490            enddo
491            if (.not.GtypeFound) then            
492 <             nGroupTypes = nGroupTypes + 1
493 <             gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
494 <             groupToGtype(i) = nGroupTypes
492 >             nGroupTypesCol = nGroupTypesCol + 1
493 >             gtypeMaxCutoffCol(nGroupTypesCol) = groupMaxCutoffCol(j)
494 >             groupToGtypeCol(j) = nGroupTypesCol
495            endif
496         endif
497      enddo    
498  
499 + #else
500 + ! Set pointers to information we just found
501 +    nGroupTypesCol = nGroupTypesRow
502 +    groupToGtypeCol => groupToGtypeRow
503 +    gtypeMaxCutoffCol => gtypeMaxCutoffRow
504 +    groupMaxCutoffCol => groupMaxCutoffRow
505 + #endif
506 +
507      !! allocate the gtypeCutoffMap here.
508 <    allocate(gtypeCutoffMap(nGroupTypes,nGroupTypes))
508 >    allocate(gtypeCutoffMap(nGroupTypesRow,nGroupTypesCol))
509      !! then we do a double loop over all the group TYPES to find the cutoff
510      !! map between groups of two types
511 <    
512 <    do i = 1, nGroupTypes
513 <       do j = 1, nGroupTypes
511 >    tradRcut = max(maxval(gtypeMaxCutoffRow),maxval(gtypeMaxCutoffCol))
512 >
513 >    do i = 1, nGroupTypesRow      
514 >       do j = 1, nGroupTypesCol
515        
516            select case(cutoffPolicy)
517            case(TRADITIONAL_CUTOFF_POLICY)
518 <             thisRcut = maxval(gtypeMaxCutoff)
518 >             thisRcut = tradRcut
519            case(MIX_CUTOFF_POLICY)
520 <             thisRcut = 0.5_dp * (gtypeMaxCutoff(i) + gtypeMaxCutoff(j))
520 >             thisRcut = 0.5_dp * (gtypeMaxCutoffRow(i) + gtypeMaxCutoffCol(j))
521            case(MAX_CUTOFF_POLICY)
522 <             thisRcut = max(gtypeMaxCutoff(i), gtypeMaxCutoff(j))
522 >             thisRcut = max(gtypeMaxCutoffRow(i), gtypeMaxCutoffCol(j))
523            case default
524               call handleError("createGtypeCutoffMap", "Unknown Cutoff Policy")
525               return
526            end select
527            gtypeCutoffMap(i,j)%rcut = thisRcut
528 +          
529 +          if (thisRcut.gt.largestRcut) largestRcut = thisRcut
530 +
531            gtypeCutoffMap(i,j)%rcutsq = thisRcut*thisRcut
408          skin = defaultRlist - defaultRcut
409          gtypeCutoffMap(i,j)%rlistsq = (thisRcut + skin)**2
532  
533 +          if (.not.haveSkinThickness) then
534 +             skinThickness = 1.0_dp
535 +          endif
536 +
537 +          gtypeCutoffMap(i,j)%rlistsq = (thisRcut + skinThickness)**2
538 +
539 +          ! sanity check
540 +
541 +          if (haveDefaultCutoffs) then
542 +             if (abs(gtypeCutoffMap(i,j)%rcut - defaultRcut).gt.0.0001) then
543 +                call handleError("createGtypeCutoffMap", "user-specified rCut does not match computed group Cutoff")
544 +             endif
545 +          endif
546         enddo
547      enddo
548 +
549 +    if(allocated(gtypeMaxCutoffRow)) deallocate(gtypeMaxCutoffRow)
550 +    if(allocated(groupMaxCutoffRow)) deallocate(groupMaxCutoffRow)
551 +    if(allocated(atypeMaxCutoff)) deallocate(atypeMaxCutoff)
552 + #ifdef IS_MPI
553 +    if(associated(groupMaxCutoffCol)) deallocate(groupMaxCutoffCol)
554 +    if(associated(gtypeMaxCutoffCol)) deallocate(gtypeMaxCutoffCol)
555 + #endif
556 +    groupMaxCutoffCol => null()
557 +    gtypeMaxCutoffCol => null()
558      
559      haveGtypeCutoffMap = .true.
560     end subroutine createGtypeCutoffMap
561  
562 <   subroutine setDefaultCutoffs(defRcut, defRsw, defRlist, cutPolicy)
418 <     real(kind=dp),intent(in) :: defRcut, defRsw, defRlist
419 <     integer, intent(in) :: cutPolicy
562 >   subroutine setCutoffs(defRcut, defRsw)
563  
564 +     real(kind=dp),intent(in) :: defRcut, defRsw
565 +     character(len = statusMsgSize) :: errMsg
566 +     integer :: localError
567 +
568       defaultRcut = defRcut
569       defaultRsw = defRsw
570 <     defaultRlist = defRlist
571 <     cutoffPolicy = cutPolicy
572 <     rcuti = 1.0_dp / defaultRcut
573 <   end subroutine setDefaultCutoffs
570 >    
571 >     defaultDoShift = .false.
572 >     if (abs(defaultRcut-defaultRsw) .lt. 0.0001) then
573 >        
574 >        write(errMsg, *) &
575 >             'cutoffRadius and switchingRadius are set to the same', newline &
576 >             // tab, 'value.  OOPSE will use shifted ', newline &
577 >             // tab, 'potentials instead of switching functions.'
578 >        
579 >        call handleInfo("setCutoffs", errMsg)
580 >        
581 >        defaultDoShift = .true.
582 >        
583 >     endif
584  
585 <   subroutine setCutoffPolicy(cutPolicy)
585 >     localError = 0
586 >     call setLJDefaultCutoff( defaultRcut, defaultDoShift )
587 >     call setElectrostaticCutoffRadius( defaultRcut, defaultRsw )
588 >     call setCutoffEAM( defaultRcut )
589 >     call setCutoffSC( defaultRcut )
590 >     call set_switch(GROUP_SWITCH, defaultRsw, defaultRcut)
591 >     call setHmatDangerousRcutValue(defaultRcut)
592  
593 +     haveDefaultCutoffs = .true.
594 +     haveGtypeCutoffMap = .false.
595 +   end subroutine setCutoffs
596 +
597 +   subroutine cWasLame()
598 +    
599 +     VisitCutoffsAfterComputing = .true.
600 +     return
601 +    
602 +   end subroutine cWasLame
603 +  
604 +   subroutine setCutoffPolicy(cutPolicy)
605 +    
606       integer, intent(in) :: cutPolicy
607 +    
608       cutoffPolicy = cutPolicy
609 <     call createGtypeCutoffMap()
609 >     haveCutoffPolicy = .true.
610 >     haveGtypeCutoffMap = .false.
611 >    
612     end subroutine setCutoffPolicy
613 <    
614 <    
436 <  subroutine setSimVariables()
437 <    SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
438 <    SIM_uses_EAM = SimUsesEAM()
439 <    SIM_requires_postpair_calc = SimRequiresPostpairCalc()
440 <    SIM_requires_prepair_calc = SimRequiresPrepairCalc()
441 <    SIM_uses_PBC = SimUsesPBC()
442 <    SIM_uses_RF = SimUsesRF()
613 >  
614 >   subroutine setElectrostaticMethod( thisESM )
615  
616 <    haveSIMvariables = .true.
616 >     integer, intent(in) :: thisESM
617  
618 <    return
619 <  end subroutine setSimVariables
618 >     electrostaticSummationMethod = thisESM
619 >     haveElectrostaticSummationMethod = .true.
620 >    
621 >   end subroutine setElectrostaticMethod
622  
623 +   subroutine setSkinThickness( thisSkin )
624 +    
625 +     real(kind=dp), intent(in) :: thisSkin
626 +    
627 +     skinThickness = thisSkin
628 +     haveSkinThickness = .true.    
629 +     haveGtypeCutoffMap = .false.
630 +    
631 +   end subroutine setSkinThickness
632 +      
633 +   subroutine setSimVariables()
634 +     SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
635 +     SIM_uses_EAM = SimUsesEAM()
636 +     SIM_requires_postpair_calc = SimRequiresPostpairCalc()
637 +     SIM_requires_prepair_calc = SimRequiresPrepairCalc()
638 +     SIM_uses_PBC = SimUsesPBC()
639 +     SIM_uses_SC = SimUsesSC()
640 +    
641 +     haveSIMvariables = .true.
642 +    
643 +     return
644 +   end subroutine setSimVariables
645 +
646    subroutine doReadyCheck(error)
647      integer, intent(out) :: error
648  
# Line 454 | Line 651 | contains
651      error = 0
652  
653      if (.not. haveInteractionHash) then      
654 <       myStatus = 0      
458 <       call createInteractionHash(myStatus)      
459 <       if (myStatus .ne. 0) then
460 <          write(default_error, *) 'createInteractionHash failed in doForces!'
461 <          error = -1
462 <          return
463 <       endif
654 >       call createInteractionHash()      
655      endif
656  
657      if (.not. haveGtypeCutoffMap) then        
658 <       myStatus = 0      
659 <       call createGtypeCutoffMap(myStatus)      
660 <       if (myStatus .ne. 0) then
661 <          write(default_error, *) 'createGtypeCutoffMap failed in doForces!'
662 <          error = -1
663 <          return
664 <       endif
658 >       call createGtypeCutoffMap()      
659 >    endif
660 >
661 >
662 >    if (VisitCutoffsAfterComputing) then
663 >       call set_switch(GROUP_SWITCH, largestRcut, largestRcut)      
664 >       call setHmatDangerousRcutValue(largestRcut)
665 >       call setLJsplineRmax(largestRcut)
666 >       call setCutoffEAM(largestRcut)
667 >       call setCutoffSC(largestRcut)
668 >       VisitCutoffsAfterComputing = .false.
669      endif
670  
671 +
672      if (.not. haveSIMvariables) then
673         call setSimVariables()
674      endif
# Line 506 | Line 702 | contains
702    end subroutine doReadyCheck
703  
704  
705 <  subroutine init_FF(use_RF, correctionMethod, dampingAlpha, thisStat)
705 >  subroutine init_FF(thisStat)
706  
511    logical, intent(in) :: use_RF
512    integer, intent(in) :: correctionMethod
513    real(kind=dp), intent(in) :: dampingAlpha
707      integer, intent(out) :: thisStat  
708      integer :: my_status, nMatches
709      integer, pointer :: MatchList(:) => null()
517    real(kind=dp) :: rcut, rrf, rt, dielect
710  
711      !! assume things are copacetic, unless they aren't
712      thisStat = 0
713  
522    !! Fortran's version of a cast:
523    FF_uses_RF = use_RF
524
525        
714      !! init_FF is called *after* all of the atom types have been
715      !! defined in atype_module using the new_atype subroutine.
716      !!
# Line 533 | Line 721 | contains
721      FF_uses_Dipoles = .false.
722      FF_uses_GayBerne = .false.
723      FF_uses_EAM = .false.
724 +    FF_uses_SC = .false.
725  
726      call getMatchingElementList(atypes, "is_Directional", .true., &
727           nMatches, MatchList)
# Line 549 | Line 738 | contains
738      call getMatchingElementList(atypes, "is_EAM", .true., nMatches, MatchList)
739      if (nMatches .gt. 0) FF_uses_EAM = .true.
740  
741 +    call getMatchingElementList(atypes, "is_SC", .true., nMatches, MatchList)
742 +    if (nMatches .gt. 0) FF_uses_SC = .true.
743  
553    haveSaneForceField = .true.
744  
745 <    !! check to make sure the FF_uses_RF setting makes sense
556 <
557 <    if (FF_uses_Dipoles) then
558 <       if (FF_uses_RF) then
559 <          dielect = getDielect()
560 <          call initialize_rf(dielect)
561 <       endif
562 <    else
563 <       if ((corrMethod == 3) .or. FF_uses_RF) then
564 <          write(default_error,*) 'Using Reaction Field with no dipoles?  Huh?'
565 <          thisStat = -1
566 <          haveSaneForceField = .false.
567 <          return
568 <       endif
569 <    endif
745 >    haveSaneForceField = .true.
746  
747      if (FF_uses_EAM) then
748         call init_EAM_FF(my_status)
# Line 578 | Line 754 | contains
754         end if
755      endif
756  
581    if (FF_uses_GayBerne) then
582       call check_gb_pair_FF(my_status)
583       if (my_status .ne. 0) then
584          thisStat = -1
585          haveSaneForceField = .false.
586          return
587       endif
588    endif
589
757      if (.not. haveNeighborList) then
758         !! Create neighbor lists
759         call expandNeighborList(nLocal, my_status)
# Line 620 | Line 787 | contains
787  
788      !! Stress Tensor
789      real( kind = dp), dimension(9) :: tau  
790 <    real ( kind = dp ) :: pot
790 >    real ( kind = dp ),dimension(LR_POT_TYPES) :: pot
791      logical ( kind = 2) :: do_pot_c, do_stress_c
792      logical :: do_pot
793      logical :: do_stress
794      logical :: in_switching_region
795   #ifdef IS_MPI
796 <    real( kind = DP ) :: pot_local
796 >    real( kind = DP ), dimension(LR_POT_TYPES) :: pot_local
797      integer :: nAtomsInRow
798      integer :: nAtomsInCol
799      integer :: nprocs
# Line 641 | Line 808 | contains
808      integer :: nlist
809      real( kind = DP ) :: ratmsq, rgrpsq, rgrp, vpair, vij
810      real( kind = DP ) :: sw, dswdr, swderiv, mf
811 +    real( kind = DP ) :: rVal
812      real(kind=dp),dimension(3) :: d_atm, d_grp, fpair, fij
813      real(kind=dp) :: rfpot, mu_i, virial
814 +    real(kind=dp):: rCut
815      integer :: me_i, me_j, n_in_i, n_in_j
816      logical :: is_dp_i
817      integer :: neighborListSize
# Line 651 | Line 820 | contains
820      integer :: propPack_i, propPack_j
821      integer :: loopStart, loopEnd, loop
822      integer :: iHash
823 <    real(kind=dp) :: listSkin = 1.0  
823 >    integer :: i1
824 >  
825  
826      !! initialize local variables  
827  
# Line 715 | Line 885 | contains
885         ! (but only on the first time through):
886         if (loop .eq. loopStart) then
887   #ifdef IS_MPI
888 <          call checkNeighborList(nGroupsInRow, q_group_row, listSkin, &
888 >          call checkNeighborList(nGroupsInRow, q_group_row, skinThickness, &
889                 update_nlist)
890   #else
891 <          call checkNeighborList(nGroups, q_group, listSkin, &
891 >          call checkNeighborList(nGroups, q_group, skinThickness, &
892                 update_nlist)
893   #endif
894         endif
# Line 776 | Line 946 | contains
946               me_j = atid(j)
947               call get_interatomic_vector(q_group(:,i), &
948                    q_group(:,j), d_grp, rgrpsq)
949 < #endif
949 > #endif      
950  
951 <             if (rgrpsq < gtypeCutoffMap(groupToGtype(i),groupToGtype(j))%rListsq) then
951 >             if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rListsq) then
952                  if (update_nlist) then
953                     nlist = nlist + 1
954  
# Line 798 | Line 968 | contains
968  
969                     list(nlist) = j
970                  endif
971 +
972  
973 <                if (loop .eq. PAIR_LOOP) then
974 <                   vij = 0.0d0
804 <                   fij(1:3) = 0.0d0
805 <                endif
973 >                
974 >                if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rCutsq) then
975  
976 <                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
977 <                     in_switching_region)
978 <
979 <                n_in_j = groupStartCol(j+1) - groupStartCol(j)
980 <
981 <                do ia = groupStartRow(i), groupStartRow(i+1)-1
982 <
983 <                   atom1 = groupListRow(ia)
984 <
985 <                   inner: do jb = groupStartCol(j), groupStartCol(j+1)-1
986 <
987 <                      atom2 = groupListCol(jb)
988 <
989 <                      if (skipThisPair(atom1, atom2)) cycle inner
990 <
991 <                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
992 <                         d_atm(1:3) = d_grp(1:3)
993 <                         ratmsq = rgrpsq
994 <                      else
976 >                   rCut = gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rCut
977 >                   if (loop .eq. PAIR_LOOP) then
978 >                      vij = 0.0d0
979 >                      fij(1) = 0.0_dp
980 >                      fij(2) = 0.0_dp
981 >                      fij(3) = 0.0_dp
982 >                   endif
983 >                  
984 >                   call get_switch(rgrpsq, sw, dswdr, rgrp, &
985 >                        group_switch, in_switching_region)
986 >                  
987 >                   n_in_j = groupStartCol(j+1) - groupStartCol(j)
988 >                  
989 >                   do ia = groupStartRow(i), groupStartRow(i+1)-1
990 >                      
991 >                      atom1 = groupListRow(ia)
992 >                      
993 >                      inner: do jb = groupStartCol(j), groupStartCol(j+1)-1
994 >                        
995 >                         atom2 = groupListCol(jb)
996 >                        
997 >                         if (skipThisPair(atom1, atom2))  cycle inner
998 >                        
999 >                         if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
1000 >                            d_atm(1) = d_grp(1)
1001 >                            d_atm(2) = d_grp(2)
1002 >                            d_atm(3) = d_grp(3)
1003 >                            ratmsq = rgrpsq
1004 >                         else
1005   #ifdef IS_MPI
1006 <                         call get_interatomic_vector(q_Row(:,atom1), &
1007 <                              q_Col(:,atom2), d_atm, ratmsq)
1006 >                            call get_interatomic_vector(q_Row(:,atom1), &
1007 >                                 q_Col(:,atom2), d_atm, ratmsq)
1008   #else
1009 <                         call get_interatomic_vector(q(:,atom1), &
1010 <                              q(:,atom2), d_atm, ratmsq)
1009 >                            call get_interatomic_vector(q(:,atom1), &
1010 >                                 q(:,atom2), d_atm, ratmsq)
1011   #endif
1012 <                      endif
1013 <
1014 <                      if (loop .eq. PREPAIR_LOOP) then
1012 >                         endif
1013 >                        
1014 >                         if (loop .eq. PREPAIR_LOOP) then
1015   #ifdef IS_MPI                      
1016 <                         call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
1017 <                              rgrpsq, d_grp, do_pot, do_stress, &
1018 <                              eFrame, A, f, t, pot_local)
1016 >                            call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
1017 >                                 rgrpsq, d_grp, rCut, do_pot, do_stress, &
1018 >                                 eFrame, A, f, t, pot_local)
1019   #else
1020 <                         call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
1021 <                              rgrpsq, d_grp, do_pot, do_stress, &
1022 <                              eFrame, A, f, t, pot)
1020 >                            call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
1021 >                                 rgrpsq, d_grp, rCut, do_pot, do_stress, &
1022 >                                 eFrame, A, f, t, pot)
1023   #endif                                              
1024 <                      else
1024 >                         else
1025   #ifdef IS_MPI                      
1026 <                         call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1027 <                              do_pot, &
1028 <                              eFrame, A, f, t, pot_local, vpair, fpair)
1026 >                            call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1027 >                                 do_pot, eFrame, A, f, t, pot_local, vpair, &
1028 >                                 fpair, d_grp, rgrp, rCut)
1029   #else
1030 <                         call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1031 <                              do_pot,  &
1032 <                              eFrame, A, f, t, pot, vpair, fpair)
1030 >                            call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1031 >                                 do_pot, eFrame, A, f, t, pot, vpair, fpair, &
1032 >                                 d_grp, rgrp, rCut)
1033   #endif
1034 +                            vij = vij + vpair
1035 +                            fij(1) = fij(1) + fpair(1)
1036 +                            fij(2) = fij(2) + fpair(2)
1037 +                            fij(3) = fij(3) + fpair(3)
1038 +                         endif
1039 +                      enddo inner
1040 +                   enddo
1041  
1042 <                         vij = vij + vpair
1043 <                         fij(1:3) = fij(1:3) + fpair(1:3)
1044 <                      endif
1045 <                   enddo inner
1046 <                enddo
1047 <
1048 <                if (loop .eq. PAIR_LOOP) then
1049 <                   if (in_switching_region) then
1050 <                      swderiv = vij*dswdr/rgrp
1051 <                      fij(1) = fij(1) + swderiv*d_grp(1)
866 <                      fij(2) = fij(2) + swderiv*d_grp(2)
867 <                      fij(3) = fij(3) + swderiv*d_grp(3)
868 <
869 <                      do ia=groupStartRow(i), groupStartRow(i+1)-1
870 <                         atom1=groupListRow(ia)
871 <                         mf = mfactRow(atom1)
1042 >                   if (loop .eq. PAIR_LOOP) then
1043 >                      if (in_switching_region) then
1044 >                         swderiv = vij*dswdr/rgrp
1045 >                         fij(1) = fij(1) + swderiv*d_grp(1)
1046 >                         fij(2) = fij(2) + swderiv*d_grp(2)
1047 >                         fij(3) = fij(3) + swderiv*d_grp(3)
1048 >                        
1049 >                         do ia=groupStartRow(i), groupStartRow(i+1)-1
1050 >                            atom1=groupListRow(ia)
1051 >                            mf = mfactRow(atom1)
1052   #ifdef IS_MPI
1053 <                         f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
1054 <                         f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
1055 <                         f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
1053 >                            f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
1054 >                            f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
1055 >                            f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
1056   #else
1057 <                         f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
1058 <                         f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
1059 <                         f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
1057 >                            f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
1058 >                            f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
1059 >                            f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
1060   #endif
1061 <                      enddo
1062 <
1063 <                      do jb=groupStartCol(j), groupStartCol(j+1)-1
1064 <                         atom2=groupListCol(jb)
1065 <                         mf = mfactCol(atom2)
1061 >                         enddo
1062 >                        
1063 >                         do jb=groupStartCol(j), groupStartCol(j+1)-1
1064 >                            atom2=groupListCol(jb)
1065 >                            mf = mfactCol(atom2)
1066   #ifdef IS_MPI
1067 <                         f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
1068 <                         f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
1069 <                         f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
1067 >                            f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
1068 >                            f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
1069 >                            f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
1070   #else
1071 <                         f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
1072 <                         f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
1073 <                         f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
1071 >                            f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
1072 >                            f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
1073 >                            f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
1074   #endif
1075 <                      enddo
1076 <                   endif
1075 >                         enddo
1076 >                      endif
1077  
1078 <                   if (do_stress) call add_stress_tensor(d_grp, fij)
1078 >                      if (do_stress) call add_stress_tensor(d_grp, fij)
1079 >                   endif
1080                  endif
1081 <             end if
1081 >             endif
1082            enddo
1083 +          
1084         enddo outer
1085  
1086         if (update_nlist) then
# Line 958 | Line 1140 | contains
1140  
1141      if (do_pot) then
1142         ! scatter/gather pot_row into the members of my column
1143 <       call scatter(pot_Row, pot_Temp, plan_atom_row)
1144 <
1143 >       do i = 1,LR_POT_TYPES
1144 >          call scatter(pot_Row(i,:), pot_Temp(i,:), plan_atom_row)
1145 >       end do
1146         ! scatter/gather pot_local into all other procs
1147         ! add resultant to get total pot
1148         do i = 1, nlocal
1149 <          pot_local = pot_local + pot_Temp(i)
1149 >          pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES) &
1150 >               + pot_Temp(1:LR_POT_TYPES,i)
1151         enddo
1152  
1153         pot_Temp = 0.0_DP
1154 <
1155 <       call scatter(pot_Col, pot_Temp, plan_atom_col)
1154 >       do i = 1,LR_POT_TYPES
1155 >          call scatter(pot_Col(i,:), pot_Temp(i,:), plan_atom_col)
1156 >       end do
1157         do i = 1, nlocal
1158 <          pot_local = pot_local + pot_Temp(i)
1158 >          pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES)&
1159 >               + pot_Temp(1:LR_POT_TYPES,i)
1160         enddo
1161  
1162      endif
1163   #endif
1164  
1165 <    if (FF_RequiresPostpairCalc() .and. SIM_requires_postpair_calc) then
1165 >    if (SIM_requires_postpair_calc) then
1166 >       do i = 1, nlocal            
1167 >          
1168 >          ! we loop only over the local atoms, so we don't need row and column
1169 >          ! lookups for the types
1170 >          
1171 >          me_i = atid(i)
1172 >          
1173 >          ! is the atom electrostatic?  See if it would have an
1174 >          ! electrostatic interaction with itself
1175 >          iHash = InteractionHash(me_i,me_i)
1176  
1177 <       if ((FF_uses_RF .and. SIM_uses_RF) .or. (corrMethod == 3)) then
982 <
1177 >          if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1178   #ifdef IS_MPI
1179 <          call scatter(rf_Row,rf,plan_atom_row_3d)
1180 <          call scatter(rf_Col,rf_Temp,plan_atom_col_3d)
986 <          do i = 1,nlocal
987 <             rf(1:3,i) = rf(1:3,i) + rf_Temp(1:3,i)
988 <          end do
989 < #endif
990 <
991 <          do i = 1, nLocal
992 <
993 <             rfpot = 0.0_DP
994 < #ifdef IS_MPI
995 <             me_i = atid_row(i)
1179 >             call self_self(i, eFrame, pot_local(ELECTROSTATIC_POT), &
1180 >                  t, do_pot)
1181   #else
1182 <             me_i = atid(i)
1182 >             call self_self(i, eFrame, pot(ELECTROSTATIC_POT), &
1183 >                  t, do_pot)
1184   #endif
1185 <             iHash = InteractionHash(me_i,me_j)
1186 <            
1187 <             if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1188 <
1189 <                mu_i = getDipoleMoment(me_i)
1190 <
1191 <                !! The reaction field needs to include a self contribution
1192 <                !! to the field:
1193 <                call accumulate_self_rf(i, mu_i, eFrame)
1194 <                !! Get the reaction field contribution to the
1195 <                !! potential and torques:
1196 <                call reaction_field_final(i, mu_i, eFrame, rfpot, t, do_pot)
1197 < #ifdef IS_MPI
1198 <                pot_local = pot_local + rfpot
1185 >          endif
1186 >  
1187 >          
1188 >          if (electrostaticSummationMethod.eq.REACTION_FIELD) then
1189 >            
1190 >             ! loop over the excludes to accumulate RF stuff we've
1191 >             ! left out of the normal pair loop
1192 >            
1193 >             do i1 = 1, nSkipsForAtom(i)
1194 >                j = skipsForAtom(i, i1)
1195 >                
1196 >                ! prevent overcounting of the skips
1197 >                if (i.lt.j) then
1198 >                   call get_interatomic_vector(q(:,i), &
1199 >                        q(:,j), d_atm, ratmsq)
1200 >                   rVal = dsqrt(ratmsq)
1201 >                   call get_switch(ratmsq, sw, dswdr, rVal, group_switch, &
1202 >                        in_switching_region)
1203 > #ifdef IS_MPI
1204 >                   call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, &
1205 >                        vpair, pot_local(ELECTROSTATIC_POT), f, t, do_pot)
1206   #else
1207 <                pot = pot + rfpot
1208 <
1207 >                   call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, &
1208 >                        vpair, pot(ELECTROSTATIC_POT), f, t, do_pot)
1209   #endif
1210 <             endif
1211 <          enddo
1212 <       endif
1210 >                endif
1211 >             enddo
1212 >          endif
1213 >       enddo
1214      endif
1215 <
1022 <
1215 >    
1216   #ifdef IS_MPI
1217 <
1217 >    
1218      if (do_pot) then
1219 <       pot = pot + pot_local
1220 <       !! we assume the c code will do the allreduce to get the total potential
1028 <       !! we could do it right here if we needed to...
1219 >       call mpi_allreduce(pot_local, pot, LR_POT_TYPES,mpi_double_precision,mpi_sum, &
1220 >            mpi_comm_world,mpi_err)            
1221      endif
1222 <
1222 >    
1223      if (do_stress) then
1224         call mpi_allreduce(tau_Temp, tau, 9,mpi_double_precision,mpi_sum, &
1225              mpi_comm_world,mpi_err)
1226         call mpi_allreduce(virial_Temp, virial,1,mpi_double_precision,mpi_sum, &
1227              mpi_comm_world,mpi_err)
1228      endif
1229 <
1229 >    
1230   #else
1231 <
1231 >    
1232      if (do_stress) then
1233         tau = tau_Temp
1234         virial = virial_Temp
1235      endif
1236 <
1236 >    
1237   #endif
1238 <
1238 >    
1239    end subroutine do_force_loop
1240  
1241    subroutine do_pair(i, j, rijsq, d, sw, do_pot, &
1242 <       eFrame, A, f, t, pot, vpair, fpair)
1242 >       eFrame, A, f, t, pot, vpair, fpair, d_grp, r_grp, rCut)
1243  
1244 <    real( kind = dp ) :: pot, vpair, sw
1244 >    real( kind = dp ) :: vpair, sw
1245 >    real( kind = dp ), dimension(LR_POT_TYPES) :: pot
1246      real( kind = dp ), dimension(3) :: fpair
1247      real( kind = dp ), dimension(nLocal)   :: mfact
1248      real( kind = dp ), dimension(9,nLocal) :: eFrame
# Line 1060 | Line 1253 | contains
1253      logical, intent(inout) :: do_pot
1254      integer, intent(in) :: i, j
1255      real ( kind = dp ), intent(inout) :: rijsq
1256 <    real ( kind = dp )                :: r
1256 >    real ( kind = dp ), intent(inout) :: r_grp
1257      real ( kind = dp ), intent(inout) :: d(3)
1258 +    real ( kind = dp ), intent(inout) :: d_grp(3)
1259 +    real ( kind = dp ), intent(inout) :: rCut
1260 +    real ( kind = dp ) :: r
1261      integer :: me_i, me_j
1262  
1263      integer :: iHash
# Line 1079 | Line 1275 | contains
1275   #endif
1276  
1277      iHash = InteractionHash(me_i, me_j)
1278 <
1278 >    
1279      if ( iand(iHash, LJ_PAIR).ne.0 ) then
1280 <       call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, do_pot)
1280 >       call do_lj_pair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1281 >            pot(VDW_POT), f, do_pot)
1282      endif
1283 <
1283 >    
1284      if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1285 <       call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1286 <            pot, eFrame, f, t, do_pot, corrMethod, rcuti)
1090 <
1091 <       if ((FF_uses_RF .and. SIM_uses_RF) .or. (corrMethod == 3)) then
1092 <
1093 <          ! CHECK ME (RF needs to know about all electrostatic types)
1094 <          call accumulate_rf(i, j, r, eFrame, sw)
1095 <          call rf_correct_forces(i, j, d, r, eFrame, sw, f, fpair)
1096 <       endif
1097 <
1285 >       call doElectrostaticPair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1286 >            pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot)
1287      endif
1288 <
1288 >    
1289      if ( iand(iHash, STICKY_PAIR).ne.0 ) then
1290         call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1291 <            pot, A, f, t, do_pot)
1291 >            pot(HB_POT), A, f, t, do_pot)
1292      endif
1293 <
1293 >    
1294      if ( iand(iHash, STICKYPOWER_PAIR).ne.0 ) then
1295         call do_sticky_power_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1296 <            pot, A, f, t, do_pot)
1296 >            pot(HB_POT), A, f, t, do_pot)
1297      endif
1298 <
1298 >    
1299      if ( iand(iHash, GAYBERNE_PAIR).ne.0 ) then
1300         call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1301 <            pot, A, f, t, do_pot)
1301 >            pot(VDW_POT), A, f, t, do_pot)
1302      endif
1303      
1304      if ( iand(iHash, GAYBERNE_LJ).ne.0 ) then
1305 < !      call do_gblj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1306 < !           pot, A, f, t, do_pot)
1305 >       call do_gb_lj_pair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1306 >            pot(VDW_POT), A, f, t, do_pot)
1307      endif
1308 <
1308 >    
1309      if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1310 <       call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, &
1311 <            do_pot)
1310 >       call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1311 >            pot(METALLIC_POT), f, do_pot)
1312      endif
1313 <
1313 >    
1314      if ( iand(iHash, SHAPE_PAIR).ne.0 ) then      
1315         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1316 <            pot, A, f, t, do_pot)
1316 >            pot(VDW_POT), A, f, t, do_pot)
1317      endif
1318 <
1318 >    
1319      if ( iand(iHash, SHAPE_LJ).ne.0 ) then      
1320         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1321 <            pot, A, f, t, do_pot)
1321 >            pot(VDW_POT), A, f, t, do_pot)
1322      endif
1323 +
1324 +    if ( iand(iHash, SC_PAIR).ne.0 ) then      
1325 +       call do_SC_pair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1326 +            pot(METALLIC_POT), f, do_pot)
1327 +    endif
1328 +
1329      
1330 +    
1331    end subroutine do_pair
1332  
1333 <  subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, &
1333 >  subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, rCut, &
1334         do_pot, do_stress, eFrame, A, f, t, pot)
1335  
1336 <    real( kind = dp ) :: pot, sw
1336 >    real( kind = dp ) :: sw
1337 >    real( kind = dp ), dimension(LR_POT_TYPES) :: pot
1338      real( kind = dp ), dimension(9,nLocal) :: eFrame
1339      real (kind=dp), dimension(9,nLocal) :: A
1340      real (kind=dp), dimension(3,nLocal) :: f
# Line 1145 | Line 1342 | contains
1342  
1343      logical, intent(inout) :: do_pot, do_stress
1344      integer, intent(in) :: i, j
1345 <    real ( kind = dp ), intent(inout)    :: rijsq, rcijsq
1345 >    real ( kind = dp ), intent(inout)    :: rijsq, rcijsq, rCut
1346      real ( kind = dp )                :: r, rc
1347      real ( kind = dp ), intent(inout) :: d(3), dc(3)
1348  
# Line 1164 | Line 1361 | contains
1361      iHash = InteractionHash(me_i, me_j)
1362  
1363      if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1364 <            call calc_EAM_prepair_rho(i, j, d, r, rijsq )
1364 >            call calc_EAM_prepair_rho(i, j, d, r, rijsq)
1365      endif
1366 +
1367 +    if ( iand(iHash, SC_PAIR).ne.0 ) then      
1368 +            call calc_SC_prepair_rho(i, j, d, r, rijsq, rcut )
1369 +    endif
1370      
1371    end subroutine do_prepair
1372  
1373  
1374    subroutine do_preforce(nlocal,pot)
1375      integer :: nlocal
1376 <    real( kind = dp ) :: pot
1376 >    real( kind = dp ),dimension(LR_POT_TYPES) :: pot
1377  
1378      if (FF_uses_EAM .and. SIM_uses_EAM) then
1379 <       call calc_EAM_preforce_Frho(nlocal,pot)
1379 >       call calc_EAM_preforce_Frho(nlocal,pot(METALLIC_POT))
1380      endif
1381 +    if (FF_uses_SC .and. SIM_uses_SC) then
1382 +       call calc_SC_preforce_Frho(nlocal,pot(METALLIC_POT))
1383 +    endif
1384  
1385  
1386    end subroutine do_preforce
# Line 1190 | Line 1394 | contains
1394      real( kind = dp ) :: d(3), scaled(3)
1395      integer i
1396  
1397 <    d(1:3) = q_j(1:3) - q_i(1:3)
1397 >    d(1) = q_j(1) - q_i(1)
1398 >    d(2) = q_j(2) - q_i(2)
1399 >    d(3) = q_j(3) - q_i(3)
1400  
1401      ! Wrap back into periodic box if necessary
1402      if ( SIM_uses_PBC ) then
# Line 1213 | Line 1419 | contains
1419         else
1420            ! calc the scaled coordinates.
1421  
1216          do i = 1, 3
1217             scaled(i) = d(i) * HmatInv(i,i)
1422  
1423 <             ! wrap the scaled coordinates
1423 >          scaled(1) = d(1) * HmatInv(1,1)
1424 >          scaled(2) = d(2) * HmatInv(2,2)
1425 >          scaled(3) = d(3) * HmatInv(3,3)
1426 >          
1427 >          ! wrap the scaled coordinates
1428 >          
1429 >          scaled(1) = scaled(1) - dnint(scaled(1))
1430 >          scaled(2) = scaled(2) - dnint(scaled(2))
1431 >          scaled(3) = scaled(3) - dnint(scaled(3))
1432  
1433 <             scaled(i) = scaled(i) - anint(scaled(i))
1433 >          ! calc the wrapped real coordinates from the wrapped scaled
1434 >          ! coordinates
1435  
1436 <             ! calc the wrapped real coordinates from the wrapped scaled
1437 <             ! coordinates
1436 >          d(1) = scaled(1)*Hmat(1,1)
1437 >          d(2) = scaled(2)*Hmat(2,2)
1438 >          d(3) = scaled(3)*Hmat(3,3)
1439  
1226             d(i) = scaled(i)*Hmat(i,i)
1227          enddo
1440         endif
1441  
1442      endif
1443  
1444 <    r_sq = dot_product(d,d)
1444 >    r_sq = d(1)*d(1) + d(2)*d(2) + d(3)*d(3)
1445  
1446    end subroutine get_interatomic_vector
1447  
# Line 1261 | Line 1473 | contains
1473      pot_Col = 0.0_dp
1474      pot_Temp = 0.0_dp
1475  
1264    rf_Row = 0.0_dp
1265    rf_Col = 0.0_dp
1266    rf_Temp = 0.0_dp
1267
1476   #endif
1477  
1478      if (FF_uses_EAM .and. SIM_uses_EAM) then
1479         call clean_EAM()
1480      endif
1481  
1274    rf = 0.0_dp
1482      tau_Temp = 0.0_dp
1483      virial_Temp = 0.0_dp
1484    end subroutine zero_work_arrays
# Line 1365 | Line 1572 | contains
1572  
1573    function FF_RequiresPrepairCalc() result(doesit)
1574      logical :: doesit
1575 <    doesit = FF_uses_EAM
1575 >    doesit = FF_uses_EAM .or. FF_uses_SC &
1576 >         .or. FF_uses_MEAM
1577    end function FF_RequiresPrepairCalc
1578  
1371  function FF_RequiresPostpairCalc() result(doesit)
1372    logical :: doesit
1373    doesit = FF_uses_RF
1374    if (corrMethod == 3) doesit = .true.
1375  end function FF_RequiresPostpairCalc
1376
1579   #ifdef PROFILE
1580    function getforcetime() result(totalforcetime)
1581      real(kind=dp) :: totalforcetime

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines