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 2309 by chrisfen, Sun Sep 18 20:45:38 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.46 2005-09-18 20:45:38 chrisfen Exp $, $Date: 2005-09-18 20:45:38 $, $Name: not supported by cvs2svn $, $Revision: 1.46 $
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_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_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 :: 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
106  public :: createInteractionHash
107  public :: createGtypeCutoffMap
108  public :: getStickyCut
109  public :: getStickyPowerCut
110  public :: getGayBerneCut
111  public :: getEAMCut
112  public :: getShapeCut
126  
127   #ifdef PROFILE
128    public :: getforcetime
# Line 122 | 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 132 | Line 150 | module doForces
150    end type gtypeCutoffs
151    type(gtypeCutoffs), dimension(:,:), allocatable :: gtypeCutoffMap
152  
135  integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY
136  real(kind=dp),save :: defaultRcut, defaultRsw, defaultRlist
137  
153   contains
154  
155 <  subroutine createInteractionHash(status)
155 >  subroutine createInteractionHash()
156      integer :: nAtypes
142    integer, intent(out) :: status
157      integer :: i
158      integer :: j
159      integer :: iHash
# Line 151 | 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 158 | 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  
163    status = 0  
164
181      if (.not. associated(atypes)) then
182 <       call handleError("atype", "atypes was not present before call of createInteractionHash!")
167 <       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          
# Line 191 | 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 204 | 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 225 | 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 244 | Line 273 | contains
273      haveInteractionHash = .true.
274    end subroutine createInteractionHash
275  
276 <  subroutine createGtypeCutoffMap(stat)
276 >  subroutine createGtypeCutoffMap()
277  
249    integer, intent(out), optional :: stat
278      logical :: i_is_LJ
279      logical :: i_is_Elect
280      logical :: i_is_Sticky
# Line 254 | 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  
265    stat = 0
296      if (.not. haveInteractionHash) then
297 <       call createInteractionHash(myStatus)      
268 <       if (myStatus .ne. 0) then
269 <          write(default_error, *) 'createInteractionHash failed in doForces!'
270 <          stat = -1
271 <          return
272 <       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 286 | 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
325  
326    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 356 | 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
405          skin = defaultRlist - defaultRcut
406          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)
415 <     real(kind=dp),intent(in) :: defRcut, defRsw, defRlist
416 <     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 <   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 +   subroutine setElectrostaticMethod( thisESM )
615 +
616 +     integer, intent(in) :: thisESM
617 +
618 +     electrostaticSummationMethod = thisESM
619 +     haveElectrostaticSummationMethod = .true.
620      
621 +   end subroutine setElectrostaticMethod
622 +
623 +   subroutine setSkinThickness( thisSkin )
624      
625 <  subroutine setSimVariables()
626 <    SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
627 <    SIM_uses_EAM = SimUsesEAM()
628 <    SIM_requires_postpair_calc = SimRequiresPostpairCalc()
629 <    SIM_requires_prepair_calc = SimRequiresPrepairCalc()
630 <    SIM_uses_PBC = SimUsesPBC()
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  
439    haveSIMvariables = .true.
440
441    return
442  end subroutine setSimVariables
443
646    subroutine doReadyCheck(error)
647      integer, intent(out) :: error
648  
# Line 449 | Line 651 | contains
651      error = 0
652  
653      if (.not. haveInteractionHash) then      
654 <       myStatus = 0      
453 <       call createInteractionHash(myStatus)      
454 <       if (myStatus .ne. 0) then
455 <          write(default_error, *) 'createInteractionHash failed in doForces!'
456 <          error = -1
457 <          return
458 <       endif
654 >       call createInteractionHash()      
655      endif
656  
657      if (.not. haveGtypeCutoffMap) then        
658 <       myStatus = 0      
463 <       call createGtypeCutoffMap(myStatus)      
464 <       if (myStatus .ne. 0) then
465 <          write(default_error, *) 'createGtypeCutoffMap failed in doForces!'
466 <          error = -1
467 <          return
468 <       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 501 | Line 702 | contains
702    end subroutine doReadyCheck
703  
704  
705 <  subroutine init_FF(thisESM, thisStat)
705 >  subroutine init_FF(thisStat)
706  
506    integer, intent(in) :: thisESM
507    real(kind=dp), intent(in) :: dampingAlpha
707      integer, intent(out) :: thisStat  
708      integer :: my_status, nMatches
709      integer, pointer :: MatchList(:) => null()
511    real(kind=dp) :: rcut, rrf, rt, dielect
710  
711      !! assume things are copacetic, unless they aren't
712      thisStat = 0
713  
516    electrostaticSummationMethod = thisESM
517
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 525 | 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 541 | 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  
545    haveSaneForceField = .true.
744  
745 <    !! check to make sure the reaction field setting makes sense
548 <
549 <    if (FF_uses_Dipoles) then
550 <       if (electrostaticSummationMethod == 3) then
551 <          dielect = getDielect()
552 <          call initialize_rf(dielect)
553 <       endif
554 <    else
555 <       if (electrostaticSummationMethod == 3) then
556 <          write(default_error,*) 'Using Reaction Field with no dipoles?  Huh?'
557 <          thisStat = -1
558 <          haveSaneForceField = .false.
559 <          return
560 <       endif
561 <    endif
745 >    haveSaneForceField = .true.
746  
747      if (FF_uses_EAM) then
748         call init_EAM_FF(my_status)
# Line 570 | Line 754 | contains
754         end if
755      endif
756  
573    if (FF_uses_GayBerne) then
574       call check_gb_pair_FF(my_status)
575       if (my_status .ne. 0) then
576          thisStat = -1
577          haveSaneForceField = .false.
578          return
579       endif
580    endif
581
757      if (.not. haveNeighborList) then
758         !! Create neighbor lists
759         call expandNeighborList(nLocal, my_status)
# Line 612 | 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 633 | 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 643 | 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 707 | 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 768 | 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 790 | Line 968 | contains
968  
969                     list(nlist) = j
970                  endif
971 <
794 <                if (loop .eq. PAIR_LOOP) then
795 <                   vij = 0.0d0
796 <                   fij(1:3) = 0.0d0
797 <                endif
971 >
972  
973 <                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
974 <                     in_switching_region)
973 >                
974 >                if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rCutsq) then
975  
976 <                n_in_j = groupStartCol(j+1) - groupStartCol(j)
977 <
978 <                do ia = groupStartRow(i), groupStartRow(i+1)-1
979 <
980 <                   atom1 = groupListRow(ia)
981 <
982 <                   inner: do jb = groupStartCol(j), groupStartCol(j+1)-1
983 <
984 <                      atom2 = groupListCol(jb)
985 <
986 <                      if (skipThisPair(atom1, atom2)) cycle inner
987 <
988 <                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
989 <                         d_atm(1:3) = d_grp(1:3)
990 <                         ratmsq = rgrpsq
991 <                      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)
858 <                      fij(2) = fij(2) + swderiv*d_grp(2)
859 <                      fij(3) = fij(3) + swderiv*d_grp(3)
860 <
861 <                      do ia=groupStartRow(i), groupStartRow(i+1)-1
862 <                         atom1=groupListRow(ia)
863 <                         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 950 | 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 (electrostaticSummationMethod == 3) then
974 <
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)
978 <          do i = 1,nlocal
979 <             rf(1:3,i) = rf(1:3,i) + rf_Temp(1:3,i)
980 <          end do
981 < #endif
982 <
983 <          do i = 1, nLocal
984 <
985 <             rfpot = 0.0_DP
986 < #ifdef IS_MPI
987 <             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)
1185 >          endif
1186 >  
1187 >          
1188 >          if (electrostaticSummationMethod.eq.REACTION_FIELD) then
1189              
1190 <             if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1191 <
1192 <                mu_i = getDipoleMoment(me_i)
1193 <
1194 <                !! The reaction field needs to include a self contribution
1195 <                !! to the field:
1196 <                call accumulate_self_rf(i, mu_i, eFrame)
1197 <                !! Get the reaction field contribution to the
1198 <                !! potential and torques:
1199 <                call reaction_field_final(i, mu_i, eFrame, rfpot, t, do_pot)
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 <                pot_local = pot_local + rfpot
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 <
1014 <
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
1020 <       !! 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 1052 | 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 1071 | 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)
1082 <
1083 <       if (electrostaticSummationMethod == 3) then
1084 <
1085 <          ! CHECK ME (RF needs to know about all electrostatic types)
1086 <          call accumulate_rf(i, j, r, eFrame, sw)
1087 <          call rf_correct_forces(i, j, d, r, eFrame, sw, f, fpair)
1088 <       endif
1089 <
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)
1110 <    endif
1111 <
1112 <    if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1113 <       call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, &
1114 <            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, &
1311 >            pot(METALLIC_POT), f, do_pot)
1312 >    endif
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 1137 | 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 1156 | 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 1182 | 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 1205 | Line 1419 | contains
1419         else
1420            ! calc the scaled coordinates.
1421  
1208          do i = 1, 3
1209             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  
1218             d(i) = scaled(i)*Hmat(i,i)
1219          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 1253 | Line 1473 | contains
1473      pot_Col = 0.0_dp
1474      pot_Temp = 0.0_dp
1475  
1256    rf_Row = 0.0_dp
1257    rf_Col = 0.0_dp
1258    rf_Temp = 0.0_dp
1259
1476   #endif
1477  
1478      if (FF_uses_EAM .and. SIM_uses_EAM) then
1479         call clean_EAM()
1480      endif
1481  
1266    rf = 0.0_dp
1482      tau_Temp = 0.0_dp
1483      virial_Temp = 0.0_dp
1484    end subroutine zero_work_arrays
# Line 1357 | 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  
1363  function FF_RequiresPostpairCalc() result(doesit)
1364    logical :: doesit
1365    if (electrostaticSummationMethod == 3) doesit = .true.
1366  end function FF_RequiresPostpairCalc
1367
1579   #ifdef PROFILE
1580    function getforcetime() result(totalforcetime)
1581      real(kind=dp) :: totalforcetime

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines