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 2298 by chuckv, Thu Sep 15 02:48:43 2005 UTC vs.
Revision 2715 by chrisfen, Sun Apr 16 02:51:16 2006 UTC

# Line 45 | Line 45
45  
46   !! @author Charles F. Vardeman II
47   !! @author Matthew Meineke
48 < !! @version $Id: doForces.F90,v 1.43 2005-09-15 02:48:43 chuckv Exp $, $Date: 2005-09-15 02:48:43 $, $Name: not supported by cvs2svn $, $Revision: 1.43 $
48 > !! @version $Id: doForces.F90,v 1.77 2006-04-16 02:51:16 chrisfen Exp $, $Date: 2006-04-16 02:51:16 $, $Name: not supported by cvs2svn $, $Revision: 1.77 $
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 74 | Line 75 | module doForces
75   #define __FORTRAN90
76   #include "UseTheForce/fSwitchingFunction.h"
77   #include "UseTheForce/fCutoffPolicy.h"
77 #include "UseTheForce/fCoulombicCorrection.h"
78   #include "UseTheForce/DarkSide/fInteractionMap.h"
79 + #include "UseTheForce/DarkSide/fElectrostaticSummationMethod.h"
80  
81  
82    INTEGER, PARAMETER:: PREPAIR_LOOP = 1
# Line 86 | 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
109  public :: createInteractionHash
110  public :: createGtypeCutoffMap
111  public :: getStickyCut
112  public :: getStickyPowerCut
113  public :: getGayBerneCut
114  public :: getEAMCut
115  public :: getShapeCut
126  
127   #ifdef PROFILE
128    public :: getforcetime
# Line 125 | 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 135 | Line 150 | module doForces
150    end type gtypeCutoffs
151    type(gtypeCutoffs), dimension(:,:), allocatable :: gtypeCutoffMap
152  
138  integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY
139  integer, save :: coulombicCorrection = NONE
140  real(kind=dp),save :: defaultRcut, defaultRsw, defaultRlist
141  real(kind=dp),save :: rcuti
142  
153   contains
154  
155 <  subroutine createInteractionHash(status)
155 >  subroutine createInteractionHash()
156      integer :: nAtypes
147    integer, intent(out) :: status
157      integer :: i
158      integer :: j
159      integer :: iHash
# Line 156 | 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 163 | 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  
168    status = 0  
169
181      if (.not. associated(atypes)) then
182 <       call handleError("atype", "atypes was not present before call of createInteractionHash!")
172 <       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 196 | 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 209 | 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 230 | 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 249 | Line 273 | contains
273      haveInteractionHash = .true.
274    end subroutine createInteractionHash
275  
276 <  subroutine createGtypeCutoffMap(stat)
276 >  subroutine createGtypeCutoffMap()
277  
254    integer, intent(out), optional :: stat
278      logical :: i_is_LJ
279      logical :: i_is_Elect
280      logical :: i_is_Sticky
# Line 259 | 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  
270    stat = 0
296      if (.not. haveInteractionHash) then
297 <       call createInteractionHash(myStatus)      
273 <       if (myStatus .ne. 0) then
274 <          write(default_error, *) 'createInteractionHash failed in doForces!'
275 <          stat = -1
276 <          return
277 <       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 291 | 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
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 <          if (i_is_Shape) then
321 <             thisRcut = getShapeCut(i)
322 <             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
323 <          endif
324 <          
353 >                    
354            if (atypeMaxCutoff(i).gt.biggestAtypeCutoff) then
355               biggestAtypeCutoff = atypeMaxCutoff(i)
356            endif
357 +
358         endif
359      enddo
330  
331    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 361 | 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
410          skin = defaultRlist - defaultRcut
411          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)
420 <     real(kind=dp),intent(in) :: defRcut, defRsw, defRlist
421 <     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, localError)
589 >     if (localError /= 0) then
590 >       write(errMsg, *) 'An error has occured in setting the EAM cutoff'
591 >       call handleError("setCutoffs", errMsg)
592 >     end if
593 >     call set_switch(GROUP_SWITCH, defaultRsw, defaultRcut)
594 >     call setHmatDangerousRcutValue(defaultRcut)
595  
596 +     haveDefaultCutoffs = .true.
597 +     haveGtypeCutoffMap = .false.
598 +   end subroutine setCutoffs
599 +
600 +   subroutine cWasLame()
601 +    
602 +     VisitCutoffsAfterComputing = .true.
603 +     return
604 +    
605 +   end subroutine cWasLame
606 +  
607 +   subroutine setCutoffPolicy(cutPolicy)
608 +    
609       integer, intent(in) :: cutPolicy
610 +    
611       cutoffPolicy = cutPolicy
612 <     call createGtypeCutoffMap()
613 <   end subroutine setCutoffPolicy
436 <    
612 >     haveCutoffPolicy = .true.
613 >     haveGtypeCutoffMap = .false.
614      
615 <  subroutine setSimVariables()
616 <    SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
617 <    SIM_uses_EAM = SimUsesEAM()
441 <    SIM_requires_postpair_calc = SimRequiresPostpairCalc()
442 <    SIM_requires_prepair_calc = SimRequiresPrepairCalc()
443 <    SIM_uses_PBC = SimUsesPBC()
444 <    SIM_uses_RF = SimUsesRF()
615 >   end subroutine setCutoffPolicy
616 >  
617 >   subroutine setElectrostaticMethod( thisESM )
618  
619 <    haveSIMvariables = .true.
619 >     integer, intent(in) :: thisESM
620  
621 <    return
622 <  end subroutine setSimVariables
621 >     electrostaticSummationMethod = thisESM
622 >     haveElectrostaticSummationMethod = .true.
623 >    
624 >   end subroutine setElectrostaticMethod
625  
626 +   subroutine setSkinThickness( thisSkin )
627 +    
628 +     real(kind=dp), intent(in) :: thisSkin
629 +    
630 +     skinThickness = thisSkin
631 +     haveSkinThickness = .true.    
632 +     haveGtypeCutoffMap = .false.
633 +    
634 +   end subroutine setSkinThickness
635 +      
636 +   subroutine setSimVariables()
637 +     SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
638 +     SIM_uses_EAM = SimUsesEAM()
639 +     SIM_requires_postpair_calc = SimRequiresPostpairCalc()
640 +     SIM_requires_prepair_calc = SimRequiresPrepairCalc()
641 +     SIM_uses_PBC = SimUsesPBC()
642 +     SIM_uses_SC = SimUsesSC()
643 +    
644 +     haveSIMvariables = .true.
645 +    
646 +     return
647 +   end subroutine setSimVariables
648 +
649    subroutine doReadyCheck(error)
650      integer, intent(out) :: error
651  
# Line 456 | Line 654 | contains
654      error = 0
655  
656      if (.not. haveInteractionHash) then      
657 <       myStatus = 0      
460 <       call createInteractionHash(myStatus)      
461 <       if (myStatus .ne. 0) then
462 <          write(default_error, *) 'createInteractionHash failed in doForces!'
463 <          error = -1
464 <          return
465 <       endif
657 >       call createInteractionHash()      
658      endif
659  
660      if (.not. haveGtypeCutoffMap) then        
661 <       myStatus = 0      
470 <       call createGtypeCutoffMap(myStatus)      
471 <       if (myStatus .ne. 0) then
472 <          write(default_error, *) 'createGtypeCutoffMap failed in doForces!'
473 <          error = -1
474 <          return
475 <       endif
661 >       call createGtypeCutoffMap()      
662      endif
663  
664 +
665 +    if (VisitCutoffsAfterComputing) then
666 +       call set_switch(GROUP_SWITCH, largestRcut, largestRcut)      
667 +       call setHmatDangerousRcutValue(largestRcut)
668 +    endif
669 +
670 +
671      if (.not. haveSIMvariables) then
672         call setSimVariables()
673      endif
# Line 508 | Line 701 | contains
701    end subroutine doReadyCheck
702  
703  
704 <  subroutine init_FF(use_RF, correctionMethod, dampingAlpha, thisStat)
704 >  subroutine init_FF(thisStat)
705  
513    logical, intent(in) :: use_RF
514    integer, intent(in) :: correctionMethod
515    real(kind=dp), intent(in) :: dampingAlpha
706      integer, intent(out) :: thisStat  
707      integer :: my_status, nMatches
708      integer, pointer :: MatchList(:) => null()
519    real(kind=dp) :: rcut, rrf, rt, dielect
709  
710      !! assume things are copacetic, unless they aren't
711      thisStat = 0
712  
524    !! Fortran's version of a cast:
525    FF_uses_RF = use_RF
526
527    !! set the electrostatic correction method
528    select case(coulombicCorrection)
529    case(NONE)
530       corrMethod = 0
531    case(UNDAMPED_WOLF)
532       corrMethod = 1
533    case(WOLF)
534       corrMethod = 2
535    case (REACTION_FIELD)
536       corrMethod = 3
537    case default
538       call handleError("init_FF", "Unknown Coulombic Correction Method")
539       return
540    end select
541        
713      !! init_FF is called *after* all of the atom types have been
714      !! defined in atype_module using the new_atype subroutine.
715      !!
# Line 549 | Line 720 | contains
720      FF_uses_Dipoles = .false.
721      FF_uses_GayBerne = .false.
722      FF_uses_EAM = .false.
723 +    FF_uses_SC = .false.
724  
725      call getMatchingElementList(atypes, "is_Directional", .true., &
726           nMatches, MatchList)
# Line 565 | Line 737 | contains
737      call getMatchingElementList(atypes, "is_EAM", .true., nMatches, MatchList)
738      if (nMatches .gt. 0) FF_uses_EAM = .true.
739  
740 +    call getMatchingElementList(atypes, "is_SC", .true., nMatches, MatchList)
741 +    if (nMatches .gt. 0) FF_uses_SC = .true.
742  
569    haveSaneForceField = .true.
743  
744 <    !! check to make sure the FF_uses_RF setting makes sense
572 <
573 <    if (FF_uses_Dipoles) then
574 <       if (FF_uses_RF) then
575 <          dielect = getDielect()
576 <          call initialize_rf(dielect)
577 <       endif
578 <    else
579 <       if ((corrMethod == 3) .or. FF_uses_RF) then
580 <          write(default_error,*) 'Using Reaction Field with no dipoles?  Huh?'
581 <          thisStat = -1
582 <          haveSaneForceField = .false.
583 <          return
584 <       endif
585 <    endif
744 >    haveSaneForceField = .true.
745  
746      if (FF_uses_EAM) then
747         call init_EAM_FF(my_status)
# Line 594 | Line 753 | contains
753         end if
754      endif
755  
597    if (FF_uses_GayBerne) then
598       call check_gb_pair_FF(my_status)
599       if (my_status .ne. 0) then
600          thisStat = -1
601          haveSaneForceField = .false.
602          return
603       endif
604    endif
605
756      if (.not. haveNeighborList) then
757         !! Create neighbor lists
758         call expandNeighborList(nLocal, my_status)
# Line 636 | Line 786 | contains
786  
787      !! Stress Tensor
788      real( kind = dp), dimension(9) :: tau  
789 <    real ( kind = dp ) :: pot
789 >    real ( kind = dp ),dimension(LR_POT_TYPES) :: pot
790      logical ( kind = 2) :: do_pot_c, do_stress_c
791      logical :: do_pot
792      logical :: do_stress
793      logical :: in_switching_region
794   #ifdef IS_MPI
795 <    real( kind = DP ) :: pot_local
795 >    real( kind = DP ), dimension(LR_POT_TYPES) :: pot_local
796      integer :: nAtomsInRow
797      integer :: nAtomsInCol
798      integer :: nprocs
# Line 657 | Line 807 | contains
807      integer :: nlist
808      real( kind = DP ) :: ratmsq, rgrpsq, rgrp, vpair, vij
809      real( kind = DP ) :: sw, dswdr, swderiv, mf
810 +    real( kind = DP ) :: rVal
811      real(kind=dp),dimension(3) :: d_atm, d_grp, fpair, fij
812      real(kind=dp) :: rfpot, mu_i, virial
813 +    real(kind=dp):: rCut
814      integer :: me_i, me_j, n_in_i, n_in_j
815      logical :: is_dp_i
816      integer :: neighborListSize
# Line 667 | Line 819 | contains
819      integer :: propPack_i, propPack_j
820      integer :: loopStart, loopEnd, loop
821      integer :: iHash
822 <    real(kind=dp) :: listSkin = 1.0  
822 >    integer :: i1
823 >  
824  
825      !! initialize local variables  
826  
# Line 731 | Line 884 | contains
884         ! (but only on the first time through):
885         if (loop .eq. loopStart) then
886   #ifdef IS_MPI
887 <          call checkNeighborList(nGroupsInRow, q_group_row, listSkin, &
887 >          call checkNeighborList(nGroupsInRow, q_group_row, skinThickness, &
888                 update_nlist)
889   #else
890 <          call checkNeighborList(nGroups, q_group, listSkin, &
890 >          call checkNeighborList(nGroups, q_group, skinThickness, &
891                 update_nlist)
892   #endif
893         endif
# Line 792 | Line 945 | contains
945               me_j = atid(j)
946               call get_interatomic_vector(q_group(:,i), &
947                    q_group(:,j), d_grp, rgrpsq)
948 < #endif
948 > #endif      
949  
950 <             if (rgrpsq < gtypeCutoffMap(groupToGtype(i),groupToGtype(j))%rListsq) then
950 >             if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rListsq) then
951                  if (update_nlist) then
952                     nlist = nlist + 1
953  
# Line 814 | Line 967 | contains
967  
968                     list(nlist) = j
969                  endif
970 +
971  
972 <                if (loop .eq. PAIR_LOOP) then
973 <                   vij = 0.0d0
820 <                   fij(1:3) = 0.0d0
821 <                endif
972 >                
973 >                if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rCutsq) then
974  
975 <                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
976 <                     in_switching_region)
977 <
978 <                n_in_j = groupStartCol(j+1) - groupStartCol(j)
979 <
980 <                do ia = groupStartRow(i), groupStartRow(i+1)-1
981 <
982 <                   atom1 = groupListRow(ia)
983 <
984 <                   inner: do jb = groupStartCol(j), groupStartCol(j+1)-1
985 <
986 <                      atom2 = groupListCol(jb)
987 <
988 <                      if (skipThisPair(atom1, atom2)) cycle inner
989 <
990 <                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
991 <                         d_atm(1:3) = d_grp(1:3)
992 <                         ratmsq = rgrpsq
993 <                      else
994 < #ifdef IS_MPI
995 <                         call get_interatomic_vector(q_Row(:,atom1), &
996 <                              q_Col(:,atom2), d_atm, ratmsq)
997 < #else
998 <                         call get_interatomic_vector(q(:,atom1), &
999 <                              q(:,atom2), d_atm, ratmsq)
1000 < #endif
1001 <                      endif
1002 <
851 <                      if (loop .eq. PREPAIR_LOOP) then
852 < #ifdef IS_MPI                      
853 <                         call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
854 <                              rgrpsq, d_grp, do_pot, do_stress, &
855 <                              eFrame, A, f, t, pot_local)
975 >                   rCut = gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rCut
976 >                   if (loop .eq. PAIR_LOOP) then
977 >                      vij = 0.0d0
978 >                      fij(1:3) = 0.0d0
979 >                   endif
980 >                  
981 >                   call get_switch(rgrpsq, sw, dswdr, rgrp, &
982 >                        group_switch, in_switching_region)
983 >                  
984 >                   n_in_j = groupStartCol(j+1) - groupStartCol(j)
985 >                  
986 >                   do ia = groupStartRow(i), groupStartRow(i+1)-1
987 >                      
988 >                      atom1 = groupListRow(ia)
989 >                      
990 >                      inner: do jb = groupStartCol(j), groupStartCol(j+1)-1
991 >                        
992 >                         atom2 = groupListCol(jb)
993 >                        
994 >                         if (skipThisPair(atom1, atom2))  cycle inner
995 >                        
996 >                         if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
997 >                            d_atm(1:3) = d_grp(1:3)
998 >                            ratmsq = rgrpsq
999 >                         else
1000 > #ifdef IS_MPI
1001 >                            call get_interatomic_vector(q_Row(:,atom1), &
1002 >                                 q_Col(:,atom2), d_atm, ratmsq)
1003   #else
1004 <                         call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
1005 <                              rgrpsq, d_grp, do_pot, do_stress, &
1006 <                              eFrame, A, f, t, pot)
1004 >                            call get_interatomic_vector(q(:,atom1), &
1005 >                                 q(:,atom2), d_atm, ratmsq)
1006 > #endif
1007 >                         endif
1008 >                        
1009 >                         if (loop .eq. PREPAIR_LOOP) then
1010 > #ifdef IS_MPI                      
1011 >                            call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
1012 >                                 rgrpsq, d_grp, rCut, do_pot, do_stress, &
1013 >                                 eFrame, A, f, t, pot_local)
1014 > #else
1015 >                            call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
1016 >                                 rgrpsq, d_grp, rCut, do_pot, do_stress, &
1017 >                                 eFrame, A, f, t, pot)
1018   #endif                                              
1019 <                      else
1019 >                         else
1020   #ifdef IS_MPI                      
1021 <                         call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1022 <                              do_pot, &
1023 <                              eFrame, A, f, t, pot_local, vpair, fpair)
1021 >                            call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1022 >                                 do_pot, eFrame, A, f, t, pot_local, vpair, &
1023 >                                 fpair, d_grp, rgrp, rCut)
1024   #else
1025 <                         call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1026 <                              do_pot,  &
1027 <                              eFrame, A, f, t, pot, vpair, fpair)
1025 >                            call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1026 >                                 do_pot, eFrame, A, f, t, pot, vpair, fpair, &
1027 >                                 d_grp, rgrp, rCut)
1028   #endif
1029 <
1030 <                         vij = vij + vpair
1031 <                         fij(1:3) = fij(1:3) + fpair(1:3)
1032 <                      endif
1033 <                   enddo inner
876 <                enddo
1029 >                            vij = vij + vpair
1030 >                            fij(1:3) = fij(1:3) + fpair(1:3)
1031 >                         endif
1032 >                      enddo inner
1033 >                   enddo
1034  
1035 <                if (loop .eq. PAIR_LOOP) then
1036 <                   if (in_switching_region) then
1037 <                      swderiv = vij*dswdr/rgrp
1038 <                      fij(1) = fij(1) + swderiv*d_grp(1)
1039 <                      fij(2) = fij(2) + swderiv*d_grp(2)
1040 <                      fij(3) = fij(3) + swderiv*d_grp(3)
1041 <
1042 <                      do ia=groupStartRow(i), groupStartRow(i+1)-1
1043 <                         atom1=groupListRow(ia)
1044 <                         mf = mfactRow(atom1)
1035 >                   if (loop .eq. PAIR_LOOP) then
1036 >                      if (in_switching_region) then
1037 >                         swderiv = vij*dswdr/rgrp
1038 >                         fij(1) = fij(1) + swderiv*d_grp(1)
1039 >                         fij(2) = fij(2) + swderiv*d_grp(2)
1040 >                         fij(3) = fij(3) + swderiv*d_grp(3)
1041 >                        
1042 >                         do ia=groupStartRow(i), groupStartRow(i+1)-1
1043 >                            atom1=groupListRow(ia)
1044 >                            mf = mfactRow(atom1)
1045   #ifdef IS_MPI
1046 <                         f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
1047 <                         f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
1048 <                         f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
1046 >                            f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
1047 >                            f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
1048 >                            f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
1049   #else
1050 <                         f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
1051 <                         f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
1052 <                         f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
1050 >                            f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
1051 >                            f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
1052 >                            f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
1053   #endif
1054 <                      enddo
1055 <
1056 <                      do jb=groupStartCol(j), groupStartCol(j+1)-1
1057 <                         atom2=groupListCol(jb)
1058 <                         mf = mfactCol(atom2)
1054 >                         enddo
1055 >                        
1056 >                         do jb=groupStartCol(j), groupStartCol(j+1)-1
1057 >                            atom2=groupListCol(jb)
1058 >                            mf = mfactCol(atom2)
1059   #ifdef IS_MPI
1060 <                         f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
1061 <                         f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
1062 <                         f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
1060 >                            f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
1061 >                            f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
1062 >                            f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
1063   #else
1064 <                         f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
1065 <                         f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
1066 <                         f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
1064 >                            f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
1065 >                            f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
1066 >                            f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
1067   #endif
1068 <                      enddo
1069 <                   endif
1068 >                         enddo
1069 >                      endif
1070  
1071 <                   if (do_stress) call add_stress_tensor(d_grp, fij)
1071 >                      if (do_stress) call add_stress_tensor(d_grp, fij)
1072 >                   endif
1073                  endif
1074 <             end if
1074 >             endif
1075            enddo
1076 +          
1077         enddo outer
1078  
1079         if (update_nlist) then
# Line 974 | Line 1133 | contains
1133  
1134      if (do_pot) then
1135         ! scatter/gather pot_row into the members of my column
1136 <       call scatter(pot_Row, pot_Temp, plan_atom_row)
1137 <
1136 >       do i = 1,LR_POT_TYPES
1137 >          call scatter(pot_Row(i,:), pot_Temp(i,:), plan_atom_row)
1138 >       end do
1139         ! scatter/gather pot_local into all other procs
1140         ! add resultant to get total pot
1141         do i = 1, nlocal
1142 <          pot_local = pot_local + pot_Temp(i)
1142 >          pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES) &
1143 >               + pot_Temp(1:LR_POT_TYPES,i)
1144         enddo
1145  
1146         pot_Temp = 0.0_DP
1147 <
1148 <       call scatter(pot_Col, pot_Temp, plan_atom_col)
1147 >       do i = 1,LR_POT_TYPES
1148 >          call scatter(pot_Col(i,:), pot_Temp(i,:), plan_atom_col)
1149 >       end do
1150         do i = 1, nlocal
1151 <          pot_local = pot_local + pot_Temp(i)
1151 >          pot_local(1:LR_POT_TYPES) = pot_local(1:LR_POT_TYPES)&
1152 >               + pot_Temp(1:LR_POT_TYPES,i)
1153         enddo
1154  
1155      endif
1156   #endif
1157  
1158 <    if (FF_RequiresPostpairCalc() .and. SIM_requires_postpair_calc) then
1158 >    if (SIM_requires_postpair_calc) then
1159 >       do i = 1, nlocal            
1160 >          
1161 >          ! we loop only over the local atoms, so we don't need row and column
1162 >          ! lookups for the types
1163 >          
1164 >          me_i = atid(i)
1165 >          
1166 >          ! is the atom electrostatic?  See if it would have an
1167 >          ! electrostatic interaction with itself
1168 >          iHash = InteractionHash(me_i,me_i)
1169  
1170 <       if ((FF_uses_RF .and. SIM_uses_RF) .or. (corrMethod == 3)) then
998 <
1170 >          if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1171   #ifdef IS_MPI
1172 <          call scatter(rf_Row,rf,plan_atom_row_3d)
1173 <          call scatter(rf_Col,rf_Temp,plan_atom_col_3d)
1002 <          do i = 1,nlocal
1003 <             rf(1:3,i) = rf(1:3,i) + rf_Temp(1:3,i)
1004 <          end do
1005 < #endif
1006 <
1007 <          do i = 1, nLocal
1008 <
1009 <             rfpot = 0.0_DP
1010 < #ifdef IS_MPI
1011 <             me_i = atid_row(i)
1172 >             call self_self(i, eFrame, pot_local(ELECTROSTATIC_POT), &
1173 >                  t, do_pot)
1174   #else
1175 <             me_i = atid(i)
1175 >             call self_self(i, eFrame, pot(ELECTROSTATIC_POT), &
1176 >                  t, do_pot)
1177   #endif
1178 <             iHash = InteractionHash(me_i,me_j)
1178 >          endif
1179 >  
1180 >          
1181 >          if (electrostaticSummationMethod.eq.REACTION_FIELD) then
1182              
1183 <             if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1184 <
1185 <                mu_i = getDipoleMoment(me_i)
1186 <
1187 <                !! The reaction field needs to include a self contribution
1188 <                !! to the field:
1189 <                call accumulate_self_rf(i, mu_i, eFrame)
1190 <                !! Get the reaction field contribution to the
1191 <                !! potential and torques:
1192 <                call reaction_field_final(i, mu_i, eFrame, rfpot, t, do_pot)
1183 >             ! loop over the excludes to accumulate RF stuff we've
1184 >             ! left out of the normal pair loop
1185 >            
1186 >             do i1 = 1, nSkipsForAtom(i)
1187 >                j = skipsForAtom(i, i1)
1188 >                
1189 >                ! prevent overcounting of the skips
1190 >                if (i.lt.j) then
1191 >                   call get_interatomic_vector(q(:,i), &
1192 >                        q(:,j), d_atm, ratmsq)
1193 >                   rVal = dsqrt(ratmsq)
1194 >                   call get_switch(ratmsq, sw, dswdr, rVal, group_switch, &
1195 >                        in_switching_region)
1196   #ifdef IS_MPI
1197 <                pot_local = pot_local + rfpot
1197 >                   call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, &
1198 >                        vpair, pot_local(ELECTROSTATIC_POT), f, t, do_pot)
1199   #else
1200 <                pot = pot + rfpot
1201 <
1200 >                   call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, &
1201 >                        vpair, pot(ELECTROSTATIC_POT), f, t, do_pot)
1202   #endif
1203 <             endif
1204 <          enddo
1205 <       endif
1203 >                endif
1204 >             enddo
1205 >          endif
1206 >       enddo
1207      endif
1208 <
1038 <
1208 >    
1209   #ifdef IS_MPI
1210 <
1210 >    
1211      if (do_pot) then
1212 <       pot = pot + pot_local
1213 <       !! we assume the c code will do the allreduce to get the total potential
1044 <       !! we could do it right here if we needed to...
1212 >       call mpi_allreduce(pot_local, pot, LR_POT_TYPES,mpi_double_precision,mpi_sum, &
1213 >            mpi_comm_world,mpi_err)            
1214      endif
1215 <
1215 >    
1216      if (do_stress) then
1217         call mpi_allreduce(tau_Temp, tau, 9,mpi_double_precision,mpi_sum, &
1218              mpi_comm_world,mpi_err)
1219         call mpi_allreduce(virial_Temp, virial,1,mpi_double_precision,mpi_sum, &
1220              mpi_comm_world,mpi_err)
1221      endif
1222 <
1222 >    
1223   #else
1224 <
1224 >    
1225      if (do_stress) then
1226         tau = tau_Temp
1227         virial = virial_Temp
1228      endif
1229 <
1229 >    
1230   #endif
1231 <
1231 >    
1232    end subroutine do_force_loop
1233  
1234    subroutine do_pair(i, j, rijsq, d, sw, do_pot, &
1235 <       eFrame, A, f, t, pot, vpair, fpair)
1235 >       eFrame, A, f, t, pot, vpair, fpair, d_grp, r_grp, rCut)
1236  
1237 <    real( kind = dp ) :: pot, vpair, sw
1237 >    real( kind = dp ) :: vpair, sw
1238 >    real( kind = dp ), dimension(LR_POT_TYPES) :: pot
1239      real( kind = dp ), dimension(3) :: fpair
1240      real( kind = dp ), dimension(nLocal)   :: mfact
1241      real( kind = dp ), dimension(9,nLocal) :: eFrame
# Line 1076 | Line 1246 | contains
1246      logical, intent(inout) :: do_pot
1247      integer, intent(in) :: i, j
1248      real ( kind = dp ), intent(inout) :: rijsq
1249 <    real ( kind = dp )                :: r
1249 >    real ( kind = dp ), intent(inout) :: r_grp
1250      real ( kind = dp ), intent(inout) :: d(3)
1251 +    real ( kind = dp ), intent(inout) :: d_grp(3)
1252 +    real ( kind = dp ), intent(inout) :: rCut
1253 +    real ( kind = dp ) :: r
1254      integer :: me_i, me_j
1255  
1256      integer :: iHash
# Line 1095 | Line 1268 | contains
1268   #endif
1269  
1270      iHash = InteractionHash(me_i, me_j)
1271 <
1271 >    
1272      if ( iand(iHash, LJ_PAIR).ne.0 ) then
1273 <       call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, do_pot)
1273 >       call do_lj_pair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1274 >            pot(VDW_POT), f, do_pot)
1275      endif
1276 <
1276 >    
1277      if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1278 <       call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1279 <            pot, eFrame, f, t, do_pot, corrMethod, rcuti)
1106 <
1107 <       if ((FF_uses_RF .and. SIM_uses_RF) .or. (corrMethod == 3)) then
1108 <
1109 <          ! CHECK ME (RF needs to know about all electrostatic types)
1110 <          call accumulate_rf(i, j, r, eFrame, sw)
1111 <          call rf_correct_forces(i, j, d, r, eFrame, sw, f, fpair)
1112 <       endif
1113 <
1278 >       call doElectrostaticPair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1279 >            pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot)
1280      endif
1281 <
1281 >    
1282      if ( iand(iHash, STICKY_PAIR).ne.0 ) then
1283         call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1284 <            pot, A, f, t, do_pot)
1284 >            pot(HB_POT), A, f, t, do_pot)
1285      endif
1286 <
1286 >    
1287      if ( iand(iHash, STICKYPOWER_PAIR).ne.0 ) then
1288         call do_sticky_power_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1289 <            pot, A, f, t, do_pot)
1289 >            pot(HB_POT), A, f, t, do_pot)
1290      endif
1291 <
1291 >    
1292      if ( iand(iHash, GAYBERNE_PAIR).ne.0 ) then
1293         call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1294 <            pot, A, f, t, do_pot)
1294 >            pot(VDW_POT), A, f, t, do_pot)
1295      endif
1296      
1297      if ( iand(iHash, GAYBERNE_LJ).ne.0 ) then
1298 < !      call do_gblj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1299 < !           pot, A, f, t, do_pot)
1298 >       call do_gb_lj_pair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1299 >            pot(VDW_POT), A, f, t, do_pot)
1300      endif
1301 <
1301 >    
1302      if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1303 <       call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, &
1304 <            do_pot)
1303 >       call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1304 >            pot(METALLIC_POT), f, do_pot)
1305      endif
1306 <
1306 >    
1307      if ( iand(iHash, SHAPE_PAIR).ne.0 ) then      
1308         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1309 <            pot, A, f, t, do_pot)
1309 >            pot(VDW_POT), A, f, t, do_pot)
1310      endif
1311 <
1311 >    
1312      if ( iand(iHash, SHAPE_LJ).ne.0 ) then      
1313         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1314 <            pot, A, f, t, do_pot)
1314 >            pot(VDW_POT), A, f, t, do_pot)
1315 >    endif
1316 >
1317 >    if ( iand(iHash, SC_PAIR).ne.0 ) then      
1318 >       call do_SC_pair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1319 >            pot(METALLIC_POT), f, do_pot)
1320      endif
1321 +
1322      
1323 +    
1324    end subroutine do_pair
1325  
1326 <  subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, &
1326 >  subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, rCut, &
1327         do_pot, do_stress, eFrame, A, f, t, pot)
1328  
1329 <    real( kind = dp ) :: pot, sw
1329 >    real( kind = dp ) :: sw
1330 >    real( kind = dp ), dimension(LR_POT_TYPES) :: pot
1331      real( kind = dp ), dimension(9,nLocal) :: eFrame
1332      real (kind=dp), dimension(9,nLocal) :: A
1333      real (kind=dp), dimension(3,nLocal) :: f
# Line 1161 | Line 1335 | contains
1335  
1336      logical, intent(inout) :: do_pot, do_stress
1337      integer, intent(in) :: i, j
1338 <    real ( kind = dp ), intent(inout)    :: rijsq, rcijsq
1338 >    real ( kind = dp ), intent(inout)    :: rijsq, rcijsq, rCut
1339      real ( kind = dp )                :: r, rc
1340      real ( kind = dp ), intent(inout) :: d(3), dc(3)
1341  
# Line 1180 | Line 1354 | contains
1354      iHash = InteractionHash(me_i, me_j)
1355  
1356      if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1357 <            call calc_EAM_prepair_rho(i, j, d, r, rijsq )
1357 >            call calc_EAM_prepair_rho(i, j, d, r, rijsq)
1358      endif
1359 +
1360 +    if ( iand(iHash, SC_PAIR).ne.0 ) then      
1361 +            call calc_SC_prepair_rho(i, j, d, r, rijsq, rcut )
1362 +    endif
1363      
1364    end subroutine do_prepair
1365  
1366  
1367    subroutine do_preforce(nlocal,pot)
1368      integer :: nlocal
1369 <    real( kind = dp ) :: pot
1369 >    real( kind = dp ),dimension(LR_POT_TYPES) :: pot
1370  
1371      if (FF_uses_EAM .and. SIM_uses_EAM) then
1372 <       call calc_EAM_preforce_Frho(nlocal,pot)
1372 >       call calc_EAM_preforce_Frho(nlocal,pot(METALLIC_POT))
1373      endif
1374 +    if (FF_uses_SC .and. SIM_uses_SC) then
1375 +       call calc_SC_preforce_Frho(nlocal,pot(METALLIC_POT))
1376 +    endif
1377  
1378  
1379    end subroutine do_preforce
# Line 1277 | Line 1458 | contains
1458      pot_Col = 0.0_dp
1459      pot_Temp = 0.0_dp
1460  
1280    rf_Row = 0.0_dp
1281    rf_Col = 0.0_dp
1282    rf_Temp = 0.0_dp
1283
1461   #endif
1462  
1463      if (FF_uses_EAM .and. SIM_uses_EAM) then
1464         call clean_EAM()
1465      endif
1466  
1290    rf = 0.0_dp
1467      tau_Temp = 0.0_dp
1468      virial_Temp = 0.0_dp
1469    end subroutine zero_work_arrays
# Line 1381 | Line 1557 | contains
1557  
1558    function FF_RequiresPrepairCalc() result(doesit)
1559      logical :: doesit
1560 <    doesit = FF_uses_EAM
1560 >    doesit = FF_uses_EAM .or. FF_uses_SC &
1561 >         .or. FF_uses_MEAM
1562    end function FF_RequiresPrepairCalc
1563  
1387  function FF_RequiresPostpairCalc() result(doesit)
1388    logical :: doesit
1389    doesit = FF_uses_RF
1390    if (corrMethod == 3) doesit = .true.
1391  end function FF_RequiresPostpairCalc
1392
1564   #ifdef PROFILE
1565    function getforcetime() result(totalforcetime)
1566      real(kind=dp) :: totalforcetime

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines