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 2375 by gezelter, Mon Oct 17 19:12:45 2005 UTC vs.
Revision 2917 by chrisfen, Mon Jul 3 13:18:43 2006 UTC

# Line 45 | Line 45
45  
46   !! @author Charles F. Vardeman II
47   !! @author Matthew Meineke
48 < !! @version $Id: doForces.F90,v 1.59 2005-10-17 19:12:34 gezelter Exp $, $Date: 2005-10-17 19:12:34 $, $Name: not supported by cvs2svn $, $Revision: 1.59 $
48 > !! @version $Id: doForces.F90,v 1.84 2006-07-03 13:18:43 chrisfen Exp $, $Date: 2006-07-03 13:18:43 $, $Name: not supported by cvs2svn $, $Revision: 1.84 $
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
61    use gayberne
62    use shapes
63    use vector_class
64    use eam
65 +  use suttonchen
66    use status
67   #ifdef IS_MPI
68    use mpiSimulation
# Line 72 | Line 72 | module doForces
72    PRIVATE
73  
74   #define __FORTRAN90
75 #include "UseTheForce/fSwitchingFunction.h"
75   #include "UseTheForce/fCutoffPolicy.h"
76   #include "UseTheForce/DarkSide/fInteractionMap.h"
77   #include "UseTheForce/DarkSide/fElectrostaticSummationMethod.h"
78  
80
79    INTEGER, PARAMETER:: PREPAIR_LOOP = 1
80    INTEGER, PARAMETER:: PAIR_LOOP    = 2
81  
# Line 87 | Line 85 | module doForces
85    logical, save :: haveInteractionHash = .false.
86    logical, save :: haveGtypeCutoffMap = .false.
87    logical, save :: haveDefaultCutoffs = .false.
88 <  logical, save :: haveRlist = .false.
88 >  logical, save :: haveSkinThickness = .false.
89 >  logical, save :: haveElectrostaticSummationMethod = .false.
90 >  logical, save :: haveCutoffPolicy = .false.
91 >  logical, save :: VisitCutoffsAfterComputing = .false.
92 >  logical, save :: do_box_dipole = .false.
93  
94    logical, save :: FF_uses_DirectionalAtoms
95    logical, save :: FF_uses_Dipoles
96    logical, save :: FF_uses_GayBerne
97    logical, save :: FF_uses_EAM
98 +  logical, save :: FF_uses_SC
99 +  logical, save :: FF_uses_MEAM
100 +
101  
102    logical, save :: SIM_uses_DirectionalAtoms
103    logical, save :: SIM_uses_EAM
104 +  logical, save :: SIM_uses_SC
105 +  logical, save :: SIM_uses_MEAM
106    logical, save :: SIM_requires_postpair_calc
107    logical, save :: SIM_requires_prepair_calc
108    logical, save :: SIM_uses_PBC
109  
110    integer, save :: electrostaticSummationMethod
111 +  integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY
112  
113 +  real(kind=dp), save :: defaultRcut, defaultRsw, largestRcut
114 +  real(kind=dp), save :: skinThickness
115 +  logical, save :: defaultDoShift
116 +
117    public :: init_FF
118 <  public :: setDefaultCutoffs
118 >  public :: setCutoffs
119 >  public :: cWasLame
120 >  public :: setElectrostaticMethod
121 >  public :: setBoxDipole
122 >  public :: getBoxDipole
123 >  public :: setCutoffPolicy
124 >  public :: setSkinThickness
125    public :: do_force_loop
108  public :: createInteractionHash
109  public :: createGtypeCutoffMap
110  public :: getStickyCut
111  public :: getStickyPowerCut
112  public :: getGayBerneCut
113  public :: getEAMCut
114  public :: getShapeCut
126  
127   #ifdef PROFILE
128    public :: getforcetime
# Line 139 | Line 150 | module doForces
150    end type gtypeCutoffs
151    type(gtypeCutoffs), dimension(:,:), allocatable :: gtypeCutoffMap
152  
153 <  integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY
154 <  real(kind=dp),save :: defaultRcut, defaultRsw, defaultRlist
144 <  real(kind=dp),save :: listSkin
145 <  
153 >  real(kind=dp), dimension(3) :: boxDipole
154 >
155   contains
156  
157 <  subroutine createInteractionHash(status)
157 >  subroutine createInteractionHash()
158      integer :: nAtypes
150    integer, intent(out) :: status
159      integer :: i
160      integer :: j
161      integer :: iHash
# Line 159 | Line 167 | contains
167      logical :: i_is_GB
168      logical :: i_is_EAM
169      logical :: i_is_Shape
170 +    logical :: i_is_SC
171 +    logical :: i_is_MEAM
172      logical :: j_is_LJ
173      logical :: j_is_Elect
174      logical :: j_is_Sticky
# Line 166 | Line 176 | contains
176      logical :: j_is_GB
177      logical :: j_is_EAM
178      logical :: j_is_Shape
179 +    logical :: j_is_SC
180 +    logical :: j_is_MEAM
181      real(kind=dp) :: myRcut
182  
171    status = 0  
172
183      if (.not. associated(atypes)) then
184 <       call handleError("atype", "atypes was not present before call of createInteractionHash!")
175 <       status = -1
184 >       call handleError("doForces", "atypes was not present before call of createInteractionHash!")
185         return
186      endif
187      
188      nAtypes = getSize(atypes)
189      
190      if (nAtypes == 0) then
191 <       status = -1
191 >       call handleError("doForces", "nAtypes was zero during call of createInteractionHash!")
192         return
193      end if
194  
# Line 205 | Line 214 | contains
214         call getElementProperty(atypes, i, "is_GayBerne", i_is_GB)
215         call getElementProperty(atypes, i, "is_EAM", i_is_EAM)
216         call getElementProperty(atypes, i, "is_Shape", i_is_Shape)
217 +       call getElementProperty(atypes, i, "is_SC", i_is_SC)
218 +       call getElementProperty(atypes, i, "is_MEAM", i_is_MEAM)
219  
220         do j = i, nAtypes
221  
# Line 218 | Line 229 | contains
229            call getElementProperty(atypes, j, "is_GayBerne", j_is_GB)
230            call getElementProperty(atypes, j, "is_EAM", j_is_EAM)
231            call getElementProperty(atypes, j, "is_Shape", j_is_Shape)
232 +          call getElementProperty(atypes, j, "is_SC", j_is_SC)
233 +          call getElementProperty(atypes, j, "is_MEAM", j_is_MEAM)
234  
235            if (i_is_LJ .and. j_is_LJ) then
236               iHash = ior(iHash, LJ_PAIR)            
# Line 239 | Line 252 | contains
252               iHash = ior(iHash, EAM_PAIR)
253            endif
254  
255 +          if (i_is_SC .and. j_is_SC) then
256 +             iHash = ior(iHash, SC_PAIR)
257 +          endif
258 +
259            if (i_is_GB .and. j_is_GB) iHash = ior(iHash, GAYBERNE_PAIR)
260            if (i_is_GB .and. j_is_LJ) iHash = ior(iHash, GAYBERNE_LJ)
261            if (i_is_LJ .and. j_is_GB) iHash = ior(iHash, GAYBERNE_LJ)
# Line 258 | Line 275 | contains
275      haveInteractionHash = .true.
276    end subroutine createInteractionHash
277  
278 <  subroutine createGtypeCutoffMap(stat)
278 >  subroutine createGtypeCutoffMap()
279  
263    integer, intent(out), optional :: stat
280      logical :: i_is_LJ
281      logical :: i_is_Elect
282      logical :: i_is_Sticky
# Line 268 | Line 284 | contains
284      logical :: i_is_GB
285      logical :: i_is_EAM
286      logical :: i_is_Shape
287 +    logical :: i_is_SC
288      logical :: GtypeFound
289  
290      integer :: myStatus, nAtypes,  i, j, istart, iend, jstart, jend
# Line 275 | Line 292 | contains
292      integer :: nGroupsInRow
293      integer :: nGroupsInCol
294      integer :: nGroupTypesRow,nGroupTypesCol
295 <    real(kind=dp):: thisSigma, bigSigma, thisRcut, tradRcut, tol, skin
295 >    real(kind=dp):: thisSigma, bigSigma, thisRcut, tradRcut, tol
296      real(kind=dp) :: biggestAtypeCutoff
297  
281    stat = 0
298      if (.not. haveInteractionHash) then
299 <       call createInteractionHash(myStatus)      
284 <       if (myStatus .ne. 0) then
285 <          write(default_error, *) 'createInteractionHash failed in doForces!'
286 <          stat = -1
287 <          return
288 <       endif
299 >       call createInteractionHash()      
300      endif
301   #ifdef IS_MPI
302      nGroupsInRow = getNgroupsInRow(plan_group_row)
# Line 303 | Line 314 | contains
314            call getElementProperty(atypes, i, "is_GayBerne", i_is_GB)
315            call getElementProperty(atypes, i, "is_EAM", i_is_EAM)
316            call getElementProperty(atypes, i, "is_Shape", i_is_Shape)
317 <          
317 >          call getElementProperty(atypes, i, "is_SC", i_is_SC)
318  
319            if (haveDefaultCutoffs) then
320               atypeMaxCutoff(i) = defaultRcut
# Line 336 | Line 347 | contains
347                  thisRcut = getShapeCut(i)
348                  if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
349               endif
350 +             if (i_is_SC) then
351 +                thisRcut = getSCCut(i)
352 +                if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
353 +             endif
354            endif
355 <          
341 <          
355 >                    
356            if (atypeMaxCutoff(i).gt.biggestAtypeCutoff) then
357               biggestAtypeCutoff = atypeMaxCutoff(i)
358            endif
359  
360         endif
361      enddo
348  
349
362      
363      istart = 1
364      jstart = 1
# Line 390 | Line 402 | contains
402         allocate(groupToGtypeCol(jend))
403      end if
404  
405 <    if(.not.associated(groupToGtypeCol)) then
406 <       allocate(groupToGtypeCol(jend))
405 >    if(.not.associated(groupMaxCutoffCol)) then
406 >       allocate(groupMaxCutoffCol(jend))
407      else
408 <       deallocate(groupToGtypeCol)
409 <       allocate(groupToGtypeCol(jend))
408 >       deallocate(groupMaxCutoffCol)
409 >       allocate(groupMaxCutoffCol(jend))
410      end if
411      if(.not.associated(gtypeMaxCutoffCol)) then
412         allocate(gtypeMaxCutoffCol(jend))
# Line 415 | Line 427 | contains
427      !! largest cutoff for any atypes present in this group.  We also
428      !! create gtypes at this point.
429      
430 <    tol = 1.0d-6
430 >    tol = 1.0e-6_dp
431      nGroupTypesRow = 0
432 <
432 >    nGroupTypesCol = 0
433      do i = istart, iend      
434         n_in_i = groupStartRow(i+1) - groupStartRow(i)
435         groupMaxCutoffRow(i) = 0.0_dp
# Line 432 | Line 444 | contains
444               groupMaxCutoffRow(i)=atypeMaxCutoff(me_i)
445            endif          
446         enddo
435
447         if (nGroupTypesRow.eq.0) then
448            nGroupTypesRow = nGroupTypesRow + 1
449            gtypeMaxCutoffRow(nGroupTypesRow) = groupMaxCutoffRow(i)
# Line 495 | Line 506 | contains
506      groupMaxCutoffCol => groupMaxCutoffRow
507   #endif
508  
498
499
500
501
509      !! allocate the gtypeCutoffMap here.
510      allocate(gtypeCutoffMap(nGroupTypesRow,nGroupTypesCol))
511      !! then we do a double loop over all the group TYPES to find the cutoff
512      !! map between groups of two types
513      tradRcut = max(maxval(gtypeMaxCutoffRow),maxval(gtypeMaxCutoffCol))
514  
515 <    do i = 1, nGroupTypesRow
515 >    do i = 1, nGroupTypesRow      
516         do j = 1, nGroupTypesCol
517        
518            select case(cutoffPolicy)
# Line 520 | Line 527 | contains
527               return
528            end select
529            gtypeCutoffMap(i,j)%rcut = thisRcut
530 +          
531 +          if (thisRcut.gt.largestRcut) largestRcut = thisRcut
532 +
533            gtypeCutoffMap(i,j)%rcutsq = thisRcut*thisRcut
534 <          skin = defaultRlist - defaultRcut
535 <          listSkin = skin ! set neighbor list skin thickness
536 <          gtypeCutoffMap(i,j)%rlistsq = (thisRcut + skin)**2
534 >
535 >          if (.not.haveSkinThickness) then
536 >             skinThickness = 1.0_dp
537 >          endif
538  
539 +          gtypeCutoffMap(i,j)%rlistsq = (thisRcut + skinThickness)**2
540 +
541            ! sanity check
542  
543            if (haveDefaultCutoffs) then
# Line 534 | Line 547 | contains
547            endif
548         enddo
549      enddo
550 +
551      if(allocated(gtypeMaxCutoffRow)) deallocate(gtypeMaxCutoffRow)
552      if(allocated(groupMaxCutoffRow)) deallocate(groupMaxCutoffRow)
553      if(allocated(atypeMaxCutoff)) deallocate(atypeMaxCutoff)
# Line 547 | Line 561 | contains
561      haveGtypeCutoffMap = .true.
562     end subroutine createGtypeCutoffMap
563  
564 <   subroutine setDefaultCutoffs(defRcut, defRsw, defRlist, cutPolicy)
551 <     real(kind=dp),intent(in) :: defRcut, defRsw, defRlist
552 <     integer, intent(in) :: cutPolicy
564 >   subroutine setCutoffs(defRcut, defRsw)
565  
566 +     real(kind=dp),intent(in) :: defRcut, defRsw
567 +     character(len = statusMsgSize) :: errMsg
568 +     integer :: localError
569 +
570       defaultRcut = defRcut
571       defaultRsw = defRsw
572 <     defaultRlist = defRlist
573 <     cutoffPolicy = cutPolicy
574 <
572 >    
573 >     defaultDoShift = .false.
574 >     if (abs(defaultRcut-defaultRsw) .lt. 0.0001) then
575 >        
576 >        write(errMsg, *) &
577 >             'cutoffRadius and switchingRadius are set to the same', newline &
578 >             // tab, 'value.  OOPSE will use shifted ', newline &
579 >             // tab, 'potentials instead of switching functions.'
580 >        
581 >        call handleInfo("setCutoffs", errMsg)
582 >        
583 >        defaultDoShift = .true.
584 >        
585 >     endif
586 >    
587 >     localError = 0
588 >     call setLJDefaultCutoff( defaultRcut, defaultDoShift )
589 >     call setElectrostaticCutoffRadius( defaultRcut, defaultRsw )
590 >     call setCutoffEAM( defaultRcut )
591 >     call setCutoffSC( defaultRcut )
592 >     call set_switch(defaultRsw, defaultRcut)
593 >     call setHmatDangerousRcutValue(defaultRcut)
594 >        
595       haveDefaultCutoffs = .true.
596 <   end subroutine setDefaultCutoffs
596 >     haveGtypeCutoffMap = .false.
597  
598 <   subroutine setCutoffPolicy(cutPolicy)
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()
612 >     haveCutoffPolicy = .true.
613 >     haveGtypeCutoffMap = .false.
614 >    
615     end subroutine setCutoffPolicy
616 +  
617 +   subroutine setBoxDipole()
618 +
619 +     do_box_dipole = .true.
620      
621 <    
570 <  subroutine setSimVariables()
571 <    SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
572 <    SIM_uses_EAM = SimUsesEAM()
573 <    SIM_requires_postpair_calc = SimRequiresPostpairCalc()
574 <    SIM_requires_prepair_calc = SimRequiresPrepairCalc()
575 <    SIM_uses_PBC = SimUsesPBC()
621 >   end subroutine setBoxDipole
622  
623 <    haveSIMvariables = .true.
623 >   subroutine getBoxDipole( box_dipole )
624  
625 <    return
580 <  end subroutine setSimVariables
625 >     real(kind=dp), intent(inout), dimension(3) :: box_dipole
626  
627 +     box_dipole = boxDipole
628 +
629 +   end subroutine getBoxDipole
630 +
631 +   subroutine setElectrostaticMethod( thisESM )
632 +
633 +     integer, intent(in) :: thisESM
634 +
635 +     electrostaticSummationMethod = thisESM
636 +     haveElectrostaticSummationMethod = .true.
637 +    
638 +   end subroutine setElectrostaticMethod
639 +
640 +   subroutine setSkinThickness( thisSkin )
641 +    
642 +     real(kind=dp), intent(in) :: thisSkin
643 +    
644 +     skinThickness = thisSkin
645 +     haveSkinThickness = .true.    
646 +     haveGtypeCutoffMap = .false.
647 +    
648 +   end subroutine setSkinThickness
649 +      
650 +   subroutine setSimVariables()
651 +     SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
652 +     SIM_uses_EAM = SimUsesEAM()
653 +     SIM_requires_postpair_calc = SimRequiresPostpairCalc()
654 +     SIM_requires_prepair_calc = SimRequiresPrepairCalc()
655 +     SIM_uses_PBC = SimUsesPBC()
656 +     SIM_uses_SC = SimUsesSC()
657 +
658 +     haveSIMvariables = .true.
659 +    
660 +     return
661 +   end subroutine setSimVariables
662 +
663    subroutine doReadyCheck(error)
664      integer, intent(out) :: error
584
665      integer :: myStatus
666  
667      error = 0
668  
669      if (.not. haveInteractionHash) then      
670 <       myStatus = 0      
591 <       call createInteractionHash(myStatus)      
592 <       if (myStatus .ne. 0) then
593 <          write(default_error, *) 'createInteractionHash failed in doForces!'
594 <          error = -1
595 <          return
596 <       endif
670 >       call createInteractionHash()      
671      endif
672  
673      if (.not. haveGtypeCutoffMap) then        
674 <       myStatus = 0      
601 <       call createGtypeCutoffMap(myStatus)      
602 <       if (myStatus .ne. 0) then
603 <          write(default_error, *) 'createGtypeCutoffMap failed in doForces!'
604 <          error = -1
605 <          return
606 <       endif
674 >       call createGtypeCutoffMap()      
675      endif
676  
677 +    if (VisitCutoffsAfterComputing) then
678 +       call set_switch(largestRcut, largestRcut)      
679 +       call setHmatDangerousRcutValue(largestRcut)
680 +       call setCutoffEAM(largestRcut)
681 +       call setCutoffSC(largestRcut)
682 +       VisitCutoffsAfterComputing = .false.
683 +    endif
684 +
685      if (.not. haveSIMvariables) then
686         call setSimVariables()
687      endif
688  
613  !  if (.not. haveRlist) then
614  !     write(default_error, *) 'rList has not been set in doForces!'
615  !     error = -1
616  !     return
617  !  endif
618
689      if (.not. haveNeighborList) then
690         write(default_error, *) 'neighbor list has not been initialized in doForces!'
691         error = -1
692         return
693      end if
694 <
694 >    
695      if (.not. haveSaneForceField) then
696         write(default_error, *) 'Force Field is not sane in doForces!'
697         error = -1
698         return
699      end if
700 <
700 >    
701   #ifdef IS_MPI
702      if (.not. isMPISimSet()) then
703         write(default_error,*) "ERROR: mpiSimulation has not been initialized!"
# Line 639 | Line 709 | contains
709    end subroutine doReadyCheck
710  
711  
712 <  subroutine init_FF(thisESM, thisStat)
712 >  subroutine init_FF(thisStat)
713  
644    integer, intent(in) :: thisESM
714      integer, intent(out) :: thisStat  
715      integer :: my_status, nMatches
716      integer, pointer :: MatchList(:) => null()
648    real(kind=dp) :: rcut, rrf, rt, dielect
717  
718      !! assume things are copacetic, unless they aren't
719      thisStat = 0
720  
653    electrostaticSummationMethod = thisESM
654
721      !! init_FF is called *after* all of the atom types have been
722      !! defined in atype_module using the new_atype subroutine.
723      !!
# Line 662 | Line 728 | contains
728      FF_uses_Dipoles = .false.
729      FF_uses_GayBerne = .false.
730      FF_uses_EAM = .false.
731 +    FF_uses_SC = .false.
732  
733      call getMatchingElementList(atypes, "is_Directional", .true., &
734           nMatches, MatchList)
# Line 678 | Line 745 | contains
745      call getMatchingElementList(atypes, "is_EAM", .true., nMatches, MatchList)
746      if (nMatches .gt. 0) FF_uses_EAM = .true.
747  
748 +    call getMatchingElementList(atypes, "is_SC", .true., nMatches, MatchList)
749 +    if (nMatches .gt. 0) FF_uses_SC = .true.
750  
751 +
752      haveSaneForceField = .true.
753  
684    !! check to make sure the reaction field setting makes sense
685
686    if (FF_uses_Dipoles) then
687       if (electrostaticSummationMethod == REACTION_FIELD) then
688          dielect = getDielect()
689          call initialize_rf(dielect)
690       endif
691    else
692       if (electrostaticSummationMethod == REACTION_FIELD) then
693          write(default_error,*) 'Using Reaction Field with no dipoles?  Huh?'
694          thisStat = -1
695          haveSaneForceField = .false.
696          return
697       endif
698    endif
699
754      if (FF_uses_EAM) then
755         call init_EAM_FF(my_status)
756         if (my_status /= 0) then
# Line 761 | Line 815 | contains
815      integer :: nlist
816      real( kind = DP ) :: ratmsq, rgrpsq, rgrp, vpair, vij
817      real( kind = DP ) :: sw, dswdr, swderiv, mf
818 +    real( kind = DP ) :: rVal
819      real(kind=dp),dimension(3) :: d_atm, d_grp, fpair, fij
820      real(kind=dp) :: rfpot, mu_i, virial
821 +    real(kind=dp):: rCut
822      integer :: me_i, me_j, n_in_i, n_in_j
823      logical :: is_dp_i
824      integer :: neighborListSize
# Line 771 | Line 827 | contains
827      integer :: propPack_i, propPack_j
828      integer :: loopStart, loopEnd, loop
829      integer :: iHash
830 <  
830 >    integer :: i1
831 >
832 >    !! the variables for the box dipole moment
833 > #ifdef IS_MPI
834 >    integer :: pChgCount_local
835 >    integer :: nChgCount_local
836 >    real(kind=dp) :: pChg_local
837 >    real(kind=dp) :: nChg_local
838 >    real(kind=dp), dimension(3) :: pChgPos_local
839 >    real(kind=dp), dimension(3) :: nChgPos_local
840 >    real(kind=dp), dimension(3) :: dipVec_local
841 > #endif
842 >    integer :: pChgCount
843 >    integer :: nChgCount
844 >    real(kind=dp) :: pChg
845 >    real(kind=dp) :: nChg
846 >    real(kind=dp) :: chg_value
847 >    real(kind=dp), dimension(3) :: pChgPos
848 >    real(kind=dp), dimension(3) :: nChgPos
849 >    real(kind=dp), dimension(3) :: dipVec
850 >    real(kind=dp), dimension(3) :: chgVec
851 >
852 >    !! initialize box dipole variables
853 >    if (do_box_dipole) then
854 > #ifdef IS_MPI
855 >       pChg_local = 0.0_dp
856 >       nChg_local = 0.0_dp
857 >       pChgCount_local = 0
858 >       nChgCount_local = 0
859 >       do i=1, 3
860 >          pChgPos_local = 0.0_dp
861 >          nChgPos_local = 0.0_dp
862 >          dipVec_local = 0.0_dp
863 >       enddo
864 > #endif
865 >       pChg = 0.0_dp
866 >       nChg = 0.0_dp
867 >       pChgCount = 0
868 >       nChgCount = 0
869 >       chg_value = 0.0_dp
870 >      
871 >       do i=1, 3
872 >          pChgPos(i) = 0.0_dp
873 >          nChgPos(i) = 0.0_dp
874 >          dipVec(i) = 0.0_dp
875 >          chgVec(i) = 0.0_dp
876 >          boxDipole(i) = 0.0_dp
877 >       enddo
878 >    endif
879  
880      !! initialize local variables  
881  
# Line 835 | Line 939 | contains
939         ! (but only on the first time through):
940         if (loop .eq. loopStart) then
941   #ifdef IS_MPI
942 <          call checkNeighborList(nGroupsInRow, q_group_row, listSkin, &
942 >          call checkNeighborList(nGroupsInRow, q_group_row, skinThickness, &
943                 update_nlist)
944   #else
945 <          call checkNeighborList(nGroups, q_group, listSkin, &
945 >          call checkNeighborList(nGroups, q_group, skinThickness, &
946                 update_nlist)
947   #endif
948         endif
# Line 918 | Line 1022 | contains
1022  
1023                     list(nlist) = j
1024                  endif
1025 +                
1026 +                if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rCutsq) then
1027  
1028 <                if (loop .eq. PAIR_LOOP) then
1029 <                   vij = 0.0d0
1030 <                   fij(1:3) = 0.0d0
1031 <                endif
1032 <
1033 <                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
1034 <                     in_switching_region)
1035 <
1036 <                n_in_j = groupStartCol(j+1) - groupStartCol(j)
1037 <
1038 <                do ia = groupStartRow(i), groupStartRow(i+1)-1
1039 <
1040 <                   atom1 = groupListRow(ia)
1041 <
1042 <                   inner: do jb = groupStartCol(j), groupStartCol(j+1)-1
1043 <
1044 <                      atom2 = groupListCol(jb)
1045 <
1046 <                      if (skipThisPair(atom1, atom2)) cycle inner
1047 <
1048 <                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
1049 <                         d_atm(1:3) = d_grp(1:3)
1050 <                         ratmsq = rgrpsq
1051 <                      else
1028 >                   rCut = gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rCut
1029 >                   if (loop .eq. PAIR_LOOP) then
1030 >                      vij = 0.0_dp
1031 >                      fij(1) = 0.0_dp
1032 >                      fij(2) = 0.0_dp
1033 >                      fij(3) = 0.0_dp
1034 >                   endif
1035 >                  
1036 >                   call get_switch(rgrpsq, sw, dswdr,rgrp, in_switching_region)
1037 >                  
1038 >                   n_in_j = groupStartCol(j+1) - groupStartCol(j)
1039 >                  
1040 >                   do ia = groupStartRow(i), groupStartRow(i+1)-1
1041 >                      
1042 >                      atom1 = groupListRow(ia)
1043 >                      
1044 >                      inner: do jb = groupStartCol(j), groupStartCol(j+1)-1
1045 >                        
1046 >                         atom2 = groupListCol(jb)
1047 >                        
1048 >                         if (skipThisPair(atom1, atom2))  cycle inner
1049 >                        
1050 >                         if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
1051 >                            d_atm(1) = d_grp(1)
1052 >                            d_atm(2) = d_grp(2)
1053 >                            d_atm(3) = d_grp(3)
1054 >                            ratmsq = rgrpsq
1055 >                         else
1056   #ifdef IS_MPI
1057 <                         call get_interatomic_vector(q_Row(:,atom1), &
1058 <                              q_Col(:,atom2), d_atm, ratmsq)
1057 >                            call get_interatomic_vector(q_Row(:,atom1), &
1058 >                                 q_Col(:,atom2), d_atm, ratmsq)
1059   #else
1060 <                         call get_interatomic_vector(q(:,atom1), &
1061 <                              q(:,atom2), d_atm, ratmsq)
1060 >                            call get_interatomic_vector(q(:,atom1), &
1061 >                                 q(:,atom2), d_atm, ratmsq)
1062   #endif
1063 <                      endif
1064 <
1065 <                      if (loop .eq. PREPAIR_LOOP) then
1063 >                         endif
1064 >                        
1065 >                         if (loop .eq. PREPAIR_LOOP) then
1066   #ifdef IS_MPI                      
1067 <                         call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
1068 <                              rgrpsq, d_grp, do_pot, do_stress, &
1069 <                              eFrame, A, f, t, pot_local)
1067 >                            call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
1068 >                                 rgrpsq, d_grp, rCut, do_pot, do_stress, &
1069 >                                 eFrame, A, f, t, pot_local)
1070   #else
1071 <                         call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
1072 <                              rgrpsq, d_grp, do_pot, do_stress, &
1073 <                              eFrame, A, f, t, pot)
1071 >                            call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
1072 >                                 rgrpsq, d_grp, rCut, do_pot, do_stress, &
1073 >                                 eFrame, A, f, t, pot)
1074   #endif                                              
1075 <                      else
1075 >                         else
1076   #ifdef IS_MPI                      
1077 <                         call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1078 <                              do_pot, &
1079 <                              eFrame, A, f, t, pot_local, vpair, fpair)
1077 >                            call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1078 >                                 do_pot, eFrame, A, f, t, pot_local, vpair, &
1079 >                                 fpair, d_grp, rgrp, rCut)
1080   #else
1081 <                         call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1082 <                              do_pot,  &
1083 <                              eFrame, A, f, t, pot, vpair, fpair)
1081 >                            call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
1082 >                                 do_pot, eFrame, A, f, t, pot, vpair, fpair, &
1083 >                                 d_grp, rgrp, rCut)
1084   #endif
1085 +                            vij = vij + vpair
1086 +                            fij(1) = fij(1) + fpair(1)
1087 +                            fij(2) = fij(2) + fpair(2)
1088 +                            fij(3) = fij(3) + fpair(3)
1089 +                         endif
1090 +                      enddo inner
1091 +                   enddo
1092  
1093 <                         vij = vij + vpair
1094 <                         fij(1:3) = fij(1:3) + fpair(1:3)
1095 <                      endif
1096 <                   enddo inner
1097 <                enddo
1098 <
1099 <                if (loop .eq. PAIR_LOOP) then
1100 <                   if (in_switching_region) then
1101 <                      swderiv = vij*dswdr/rgrp
1102 <                      fij(1) = fij(1) + swderiv*d_grp(1)
986 <                      fij(2) = fij(2) + swderiv*d_grp(2)
987 <                      fij(3) = fij(3) + swderiv*d_grp(3)
988 <
989 <                      do ia=groupStartRow(i), groupStartRow(i+1)-1
990 <                         atom1=groupListRow(ia)
991 <                         mf = mfactRow(atom1)
1093 >                   if (loop .eq. PAIR_LOOP) then
1094 >                      if (in_switching_region) then
1095 >                         swderiv = vij*dswdr/rgrp
1096 >                         fij(1) = fij(1) + swderiv*d_grp(1)
1097 >                         fij(2) = fij(2) + swderiv*d_grp(2)
1098 >                         fij(3) = fij(3) + swderiv*d_grp(3)
1099 >                        
1100 >                         do ia=groupStartRow(i), groupStartRow(i+1)-1
1101 >                            atom1=groupListRow(ia)
1102 >                            mf = mfactRow(atom1)
1103   #ifdef IS_MPI
1104 <                         f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
1105 <                         f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
1106 <                         f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
1104 >                            f_Row(1,atom1) = f_Row(1,atom1) + swderiv*d_grp(1)*mf
1105 >                            f_Row(2,atom1) = f_Row(2,atom1) + swderiv*d_grp(2)*mf
1106 >                            f_Row(3,atom1) = f_Row(3,atom1) + swderiv*d_grp(3)*mf
1107   #else
1108 <                         f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
1109 <                         f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
1110 <                         f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
1108 >                            f(1,atom1) = f(1,atom1) + swderiv*d_grp(1)*mf
1109 >                            f(2,atom1) = f(2,atom1) + swderiv*d_grp(2)*mf
1110 >                            f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
1111   #endif
1112 <                      enddo
1113 <
1114 <                      do jb=groupStartCol(j), groupStartCol(j+1)-1
1115 <                         atom2=groupListCol(jb)
1116 <                         mf = mfactCol(atom2)
1112 >                         enddo
1113 >                        
1114 >                         do jb=groupStartCol(j), groupStartCol(j+1)-1
1115 >                            atom2=groupListCol(jb)
1116 >                            mf = mfactCol(atom2)
1117   #ifdef IS_MPI
1118 <                         f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
1119 <                         f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
1120 <                         f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
1118 >                            f_Col(1,atom2) = f_Col(1,atom2) - swderiv*d_grp(1)*mf
1119 >                            f_Col(2,atom2) = f_Col(2,atom2) - swderiv*d_grp(2)*mf
1120 >                            f_Col(3,atom2) = f_Col(3,atom2) - swderiv*d_grp(3)*mf
1121   #else
1122 <                         f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
1123 <                         f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
1124 <                         f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
1122 >                            f(1,atom2) = f(1,atom2) - swderiv*d_grp(1)*mf
1123 >                            f(2,atom2) = f(2,atom2) - swderiv*d_grp(2)*mf
1124 >                            f(3,atom2) = f(3,atom2) - swderiv*d_grp(3)*mf
1125   #endif
1126 <                      enddo
1127 <                   endif
1126 >                         enddo
1127 >                      endif
1128  
1129 <                   if (do_stress) call add_stress_tensor(d_grp, fij)
1129 >                      if (do_stress) call add_stress_tensor(d_grp, fij)
1130 >                   endif
1131                  endif
1132 <             end if
1132 >             endif
1133            enddo
1134 <
1134 >          
1135         enddo outer
1136  
1137         if (update_nlist) then
# Line 1101 | Line 1213 | contains
1213      endif
1214   #endif
1215  
1216 <    if (FF_RequiresPostpairCalc() .and. SIM_requires_postpair_calc) then
1216 >    if (SIM_requires_postpair_calc) then
1217 >       do i = 1, nlocal            
1218 >          
1219 >          ! we loop only over the local atoms, so we don't need row and column
1220 >          ! lookups for the types
1221 >          
1222 >          me_i = atid(i)
1223 >          
1224 >          ! is the atom electrostatic?  See if it would have an
1225 >          ! electrostatic interaction with itself
1226 >          iHash = InteractionHash(me_i,me_i)
1227  
1228 <       if (electrostaticSummationMethod == REACTION_FIELD) then
1107 <
1228 >          if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1229   #ifdef IS_MPI
1230 <          call scatter(rf_Row,rf,plan_atom_row_3d)
1231 <          call scatter(rf_Col,rf_Temp,plan_atom_col_3d)
1232 <          do i = 1,nlocal
1233 <             rf(1:3,i) = rf(1:3,i) + rf_Temp(1:3,i)
1234 <          end do
1230 >             call self_self(i, eFrame, pot_local(ELECTROSTATIC_POT), &
1231 >                  t, do_pot)
1232 > #else
1233 >             call self_self(i, eFrame, pot(ELECTROSTATIC_POT), &
1234 >                  t, do_pot)
1235   #endif
1236 <
1237 <          do i = 1, nLocal
1238 <
1239 <             rfpot = 0.0_DP
1236 >          endif
1237 >  
1238 >          
1239 >          if (electrostaticSummationMethod.eq.REACTION_FIELD) then
1240 >            
1241 >             ! loop over the excludes to accumulate RF stuff we've
1242 >             ! left out of the normal pair loop
1243 >            
1244 >             do i1 = 1, nSkipsForAtom(i)
1245 >                j = skipsForAtom(i, i1)
1246 >                
1247 >                ! prevent overcounting of the skips
1248 >                if (i.lt.j) then
1249 >                   call get_interatomic_vector(q(:,i), q(:,j), d_atm, ratmsq)
1250 >                   rVal = sqrt(ratmsq)
1251 >                   call get_switch(ratmsq, sw, dswdr, rVal,in_switching_region)
1252   #ifdef IS_MPI
1253 <             me_i = atid_row(i)
1253 >                   call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, &
1254 >                        vpair, pot_local(ELECTROSTATIC_POT), f, t, do_pot)
1255   #else
1256 <             me_i = atid(i)
1256 >                   call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, &
1257 >                        vpair, pot(ELECTROSTATIC_POT), f, t, do_pot)
1258   #endif
1259 <             iHash = InteractionHash(me_i,me_j)
1260 <            
1261 <             if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1259 >                endif
1260 >             enddo
1261 >          endif
1262  
1263 <                mu_i = getDipoleMoment(me_i)
1129 <
1130 <                !! The reaction field needs to include a self contribution
1131 <                !! to the field:
1132 <                call accumulate_self_rf(i, mu_i, eFrame)
1133 <                !! Get the reaction field contribution to the
1134 <                !! potential and torques:
1135 <                call reaction_field_final(i, mu_i, eFrame, rfpot, t, do_pot)
1263 >          if (do_box_dipole) then
1264   #ifdef IS_MPI
1265 <                pot_local(ELECTROSTATIC_POT) = pot_local(ELECTROSTATIC_POT) + rfpot
1265 >             call accumulate_box_dipole(i, eFrame, q(:,i), pChg_local, &
1266 >                  nChg_local, pChgPos_local, nChgPos_local, dipVec_local, &
1267 >                  pChgCount_local, nChgCount_local)
1268   #else
1269 <                pot(ELECTROSTATIC_POT) = pot(ELECTROSTATIC_POT) + rfpot
1270 <
1269 >             call accumulate_box_dipole(i, eFrame, q(:,i), pChg, nChg, &
1270 >                  pChgPos, nChgPos, dipVec, pChgCount, nChgCount)
1271   #endif
1272 <             endif
1273 <          enddo
1144 <       endif
1272 >          endif
1273 >       enddo
1274      endif
1275  
1147
1276   #ifdef IS_MPI
1149
1277      if (do_pot) then
1278 <       pot(1:LR_POT_TYPES) = pot(1:LR_POT_TYPES) &
1279 <            + pot_local(1:LR_POT_TYPES)
1280 <       !! we assume the c code will do the allreduce to get the total potential
1281 <       !! we could do it right here if we needed to...
1278 > #ifdef SINGLE_PRECISION
1279 >       call mpi_allreduce(pot_local, pot, LR_POT_TYPES,mpi_real,mpi_sum, &
1280 >            mpi_comm_world,mpi_err)            
1281 > #else
1282 >       call mpi_allreduce(pot_local, pot, LR_POT_TYPES,mpi_double_precision, &
1283 >            mpi_sum, mpi_comm_world,mpi_err)            
1284 > #endif
1285      endif
1286 <
1286 >    
1287      if (do_stress) then
1288 + #ifdef SINGLE_PRECISION
1289 +       call mpi_allreduce(tau_Temp, tau, 9,mpi_real,mpi_sum, &
1290 +            mpi_comm_world,mpi_err)
1291 +       call mpi_allreduce(virial_Temp, virial,1,mpi_real,mpi_sum, &
1292 +            mpi_comm_world,mpi_err)
1293 + #else
1294         call mpi_allreduce(tau_Temp, tau, 9,mpi_double_precision,mpi_sum, &
1295              mpi_comm_world,mpi_err)
1296         call mpi_allreduce(virial_Temp, virial,1,mpi_double_precision,mpi_sum, &
1297              mpi_comm_world,mpi_err)
1298 + #endif
1299      endif
1300 +    
1301 +    if (do_box_dipole) then
1302  
1303 + #ifdef SINGLE_PRECISION
1304 +       call mpi_allreduce(pChg_local, pChg, 1, mpi_real, mpi_sum, &
1305 +            mpi_comm_world, mpi_err)
1306 +       call mpi_allreduce(nChg_local, nChg, 1, mpi_real, mpi_sum, &
1307 +            mpi_comm_world, mpi_err)
1308 +       call mpi_allreduce(pChgCount_local, pChgCount, 1, mpi_integer, mpi_sum,&
1309 +            mpi_comm_world, mpi_err)
1310 +       call mpi_allreduce(nChgCount_local, nChgCount, 1, mpi_integer, mpi_sum,&
1311 +            mpi_comm_world, mpi_err)
1312 +       call mpi_allreduce(pChgPos_local, pChgPos, 3, mpi_real, mpi_sum, &
1313 +            mpi_comm_world, mpi_err)
1314 +       call mpi_allreduce(nChgPos_local, nChgPos, 3, mpi_real, mpi_sum, &
1315 +            mpi_comm_world, mpi_err)
1316 +       call mpi_allreduce(dipVec_local, dipVec, 3, mpi_real, mpi_sum, &
1317 +            mpi_comm_world, mpi_err)
1318   #else
1319 +       call mpi_allreduce(pChg_local, pChg, 1, mpi_double_precision, mpi_sum, &
1320 +            mpi_comm_world, mpi_err)
1321 +       call mpi_allreduce(nChg_local, nChg, 1, mpi_double_precision, mpi_sum, &
1322 +            mpi_comm_world, mpi_err)
1323 +       call mpi_allreduce(pChgCount_local, pChgCount, 1, mpi_integer,&
1324 +            mpi_sum, mpi_comm_world, mpi_err)
1325 +       call mpi_allreduce(nChgCount_local, nChgCount, 1, mpi_integer,&
1326 +            mpi_sum, mpi_comm_world, mpi_err)
1327 +       call mpi_allreduce(pChgPos_local, pChgPos, 3, mpi_double_precision, &
1328 +            mpi_sum, mpi_comm_world, mpi_err)
1329 +       call mpi_allreduce(nChgPos_local, nChgPos, 3, mpi_double_precision, &
1330 +            mpi_sum, mpi_comm_world, mpi_err)
1331 +       call mpi_allreduce(dipVec_local, dipVec, 3, mpi_double_precision, &
1332 +            mpi_sum, mpi_comm_world, mpi_err)
1333 + #endif
1334  
1335 +    endif
1336 +
1337 + #else
1338 +    
1339      if (do_stress) then
1340         tau = tau_Temp
1341         virial = virial_Temp
1342      endif
1343 <
1343 >    
1344   #endif
1345  
1346 +    if (do_box_dipole) then
1347 +       ! first load the accumulated dipole moment (if dipoles were present)
1348 +       boxDipole(1) = dipVec(1)
1349 +       boxDipole(2) = dipVec(2)
1350 +       boxDipole(3) = dipVec(3)
1351 +
1352 +       ! now include the dipole moment due to charges
1353 +       ! use the lesser of the positive and negative charge totals
1354 +       if (nChg .le. pChg) then
1355 +          chg_value = nChg
1356 +       else
1357 +          chg_value = pChg
1358 +       endif
1359 +      
1360 +       ! find the average positions
1361 +       if (pChgCount .gt. 0 .and. nChgCount .gt. 0) then
1362 +          pChgPos = pChgPos / pChgCount
1363 +          nChgPos = nChgPos / nChgCount
1364 +       endif
1365 +
1366 +       ! dipole is from the negative to the positive (physics notation)
1367 +       chgVec(1) = pChgPos(1) - nChgPos(1)
1368 +       chgVec(2) = pChgPos(2) - nChgPos(2)
1369 +       chgVec(3) = pChgPos(3) - nChgPos(3)
1370 +
1371 +       boxDipole(1) = boxDipole(1) + chgVec(1) * chg_value
1372 +       boxDipole(2) = boxDipole(2) + chgVec(2) * chg_value
1373 +       boxDipole(3) = boxDipole(3) + chgVec(3) * chg_value
1374 +
1375 +    endif
1376 +
1377    end subroutine do_force_loop
1378  
1379    subroutine do_pair(i, j, rijsq, d, sw, do_pot, &
1380 <       eFrame, A, f, t, pot, vpair, fpair)
1380 >       eFrame, A, f, t, pot, vpair, fpair, d_grp, r_grp, rCut)
1381  
1382      real( kind = dp ) :: vpair, sw
1383      real( kind = dp ), dimension(LR_POT_TYPES) :: pot
# Line 1187 | Line 1391 | contains
1391      logical, intent(inout) :: do_pot
1392      integer, intent(in) :: i, j
1393      real ( kind = dp ), intent(inout) :: rijsq
1394 <    real ( kind = dp )                :: r
1394 >    real ( kind = dp ), intent(inout) :: r_grp
1395      real ( kind = dp ), intent(inout) :: d(3)
1396 +    real ( kind = dp ), intent(inout) :: d_grp(3)
1397 +    real ( kind = dp ), intent(inout) :: rCut
1398 +    real ( kind = dp ) :: r
1399 +    real ( kind = dp ) :: a_k, b_k, c_k, d_k, dx
1400      integer :: me_i, me_j
1401 +    integer :: k
1402  
1403      integer :: iHash
1404  
1405      r = sqrt(rijsq)
1406 <    vpair = 0.0d0
1407 <    fpair(1:3) = 0.0d0
1406 >    
1407 >    vpair = 0.0_dp
1408 >    fpair(1:3) = 0.0_dp
1409  
1410   #ifdef IS_MPI
1411      me_i = atid_row(i)
# Line 1206 | Line 1416 | contains
1416   #endif
1417  
1418      iHash = InteractionHash(me_i, me_j)
1419 <
1419 >    
1420      if ( iand(iHash, LJ_PAIR).ne.0 ) then
1421 <       call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1421 >       call do_lj_pair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1422              pot(VDW_POT), f, do_pot)
1423      endif
1424 <
1424 >    
1425      if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1426 <       call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1426 >       call doElectrostaticPair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1427              pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot)
1218
1219       if (electrostaticSummationMethod == REACTION_FIELD) then
1220
1221          ! CHECK ME (RF needs to know about all electrostatic types)
1222          call accumulate_rf(i, j, r, eFrame, sw)
1223          call rf_correct_forces(i, j, d, r, eFrame, sw, f, fpair)
1224       endif
1225
1428      endif
1429 <
1429 >    
1430      if ( iand(iHash, STICKY_PAIR).ne.0 ) then
1431         call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1432              pot(HB_POT), A, f, t, do_pot)
1433      endif
1434 <
1434 >    
1435      if ( iand(iHash, STICKYPOWER_PAIR).ne.0 ) then
1436         call do_sticky_power_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1437              pot(HB_POT), A, f, t, do_pot)
1438      endif
1439 <
1439 >    
1440      if ( iand(iHash, GAYBERNE_PAIR).ne.0 ) then
1441         call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1442              pot(VDW_POT), A, f, t, do_pot)
1443      endif
1444      
1445      if ( iand(iHash, GAYBERNE_LJ).ne.0 ) then
1446 <       call do_gb_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1446 >       call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1447              pot(VDW_POT), A, f, t, do_pot)
1448      endif
1449 <
1449 >    
1450      if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1451         call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1452              pot(METALLIC_POT), f, do_pot)
1453      endif
1454 <
1454 >    
1455      if ( iand(iHash, SHAPE_PAIR).ne.0 ) then      
1456         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1457              pot(VDW_POT), A, f, t, do_pot)
1458      endif
1459 <
1459 >    
1460      if ( iand(iHash, SHAPE_LJ).ne.0 ) then      
1461         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1462              pot(VDW_POT), A, f, t, do_pot)
1463      endif
1464 <    
1464 >
1465 >    if ( iand(iHash, SC_PAIR).ne.0 ) then      
1466 >       call do_SC_pair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1467 >            pot(METALLIC_POT), f, do_pot)
1468 >    endif
1469 >    
1470    end subroutine do_pair
1471  
1472 <  subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, &
1472 >  subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, rCut, &
1473         do_pot, do_stress, eFrame, A, f, t, pot)
1474  
1475      real( kind = dp ) :: sw
# Line 1274 | Line 1481 | contains
1481  
1482      logical, intent(inout) :: do_pot, do_stress
1483      integer, intent(in) :: i, j
1484 <    real ( kind = dp ), intent(inout)    :: rijsq, rcijsq
1484 >    real ( kind = dp ), intent(inout)    :: rijsq, rcijsq, rCut
1485      real ( kind = dp )                :: r, rc
1486      real ( kind = dp ), intent(inout) :: d(3), dc(3)
1487  
1488      integer :: me_i, me_j, iHash
1489  
1490      r = sqrt(rijsq)
1491 <
1491 >    
1492   #ifdef IS_MPI  
1493      me_i = atid_row(i)
1494      me_j = atid_col(j)  
# Line 1293 | Line 1500 | contains
1500      iHash = InteractionHash(me_i, me_j)
1501  
1502      if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1503 <            call calc_EAM_prepair_rho(i, j, d, r, rijsq )
1503 >            call calc_EAM_prepair_rho(i, j, d, r, rijsq)
1504      endif
1505 +
1506 +    if ( iand(iHash, SC_PAIR).ne.0 ) then      
1507 +            call calc_SC_prepair_rho(i, j, d, r, rijsq, rcut )
1508 +    endif
1509      
1510    end subroutine do_prepair
1511  
# Line 1306 | Line 1517 | contains
1517      if (FF_uses_EAM .and. SIM_uses_EAM) then
1518         call calc_EAM_preforce_Frho(nlocal,pot(METALLIC_POT))
1519      endif
1520 <
1521 <
1520 >    if (FF_uses_SC .and. SIM_uses_SC) then
1521 >       call calc_SC_preforce_Frho(nlocal,pot(METALLIC_POT))
1522 >    endif
1523    end subroutine do_preforce
1524  
1525  
# Line 1319 | Line 1531 | contains
1531      real( kind = dp ) :: d(3), scaled(3)
1532      integer i
1533  
1534 <    d(1:3) = q_j(1:3) - q_i(1:3)
1534 >    d(1) = q_j(1) - q_i(1)
1535 >    d(2) = q_j(2) - q_i(2)
1536 >    d(3) = q_j(3) - q_i(3)
1537  
1538      ! Wrap back into periodic box if necessary
1539      if ( SIM_uses_PBC ) then
1540  
1541         if( .not.boxIsOrthorhombic ) then
1542            ! calc the scaled coordinates.
1543 +          ! scaled = matmul(HmatInv, d)
1544  
1545 <          scaled = matmul(HmatInv, d)
1546 <
1545 >          scaled(1) = HmatInv(1,1)*d(1) + HmatInv(1,2)*d(2) + HmatInv(1,3)*d(3)
1546 >          scaled(2) = HmatInv(2,1)*d(1) + HmatInv(2,2)*d(2) + HmatInv(2,3)*d(3)
1547 >          scaled(3) = HmatInv(3,1)*d(1) + HmatInv(3,2)*d(2) + HmatInv(3,3)*d(3)
1548 >          
1549            ! wrap the scaled coordinates
1550  
1551 <          scaled = scaled  - anint(scaled)
1551 >          scaled(1) = scaled(1) - anint(scaled(1), kind=dp)
1552 >          scaled(2) = scaled(2) - anint(scaled(2), kind=dp)
1553 >          scaled(3) = scaled(3) - anint(scaled(3), kind=dp)
1554  
1336
1555            ! calc the wrapped real coordinates from the wrapped scaled
1556            ! coordinates
1557 <
1558 <          d = matmul(Hmat,scaled)
1557 >          ! d = matmul(Hmat,scaled)
1558 >          d(1)= Hmat(1,1)*scaled(1) + Hmat(1,2)*scaled(2) + Hmat(1,3)*scaled(3)
1559 >          d(2)= Hmat(2,1)*scaled(1) + Hmat(2,2)*scaled(2) + Hmat(2,3)*scaled(3)
1560 >          d(3)= Hmat(3,1)*scaled(1) + Hmat(3,2)*scaled(2) + Hmat(3,3)*scaled(3)
1561  
1562         else
1563            ! calc the scaled coordinates.
1564  
1565 <          do i = 1, 3
1566 <             scaled(i) = d(i) * HmatInv(i,i)
1565 >          scaled(1) = d(1) * HmatInv(1,1)
1566 >          scaled(2) = d(2) * HmatInv(2,2)
1567 >          scaled(3) = d(3) * HmatInv(3,3)
1568 >          
1569 >          ! wrap the scaled coordinates
1570 >          
1571 >          scaled(1) = scaled(1) - anint(scaled(1), kind=dp)
1572 >          scaled(2) = scaled(2) - anint(scaled(2), kind=dp)
1573 >          scaled(3) = scaled(3) - anint(scaled(3), kind=dp)
1574  
1575 <             ! wrap the scaled coordinates
1575 >          ! calc the wrapped real coordinates from the wrapped scaled
1576 >          ! coordinates
1577  
1578 <             scaled(i) = scaled(i) - anint(scaled(i))
1578 >          d(1) = scaled(1)*Hmat(1,1)
1579 >          d(2) = scaled(2)*Hmat(2,2)
1580 >          d(3) = scaled(3)*Hmat(3,3)
1581  
1352             ! calc the wrapped real coordinates from the wrapped scaled
1353             ! coordinates
1354
1355             d(i) = scaled(i)*Hmat(i,i)
1356          enddo
1582         endif
1583  
1584      endif
1585  
1586 <    r_sq = dot_product(d,d)
1586 >    r_sq = d(1)*d(1) + d(2)*d(2) + d(3)*d(3)
1587  
1588    end subroutine get_interatomic_vector
1589  
# Line 1390 | Line 1615 | contains
1615      pot_Col = 0.0_dp
1616      pot_Temp = 0.0_dp
1617  
1393    rf_Row = 0.0_dp
1394    rf_Col = 0.0_dp
1395    rf_Temp = 0.0_dp
1396
1618   #endif
1619  
1620      if (FF_uses_EAM .and. SIM_uses_EAM) then
1621         call clean_EAM()
1622      endif
1623  
1403    rf = 0.0_dp
1624      tau_Temp = 0.0_dp
1625      virial_Temp = 0.0_dp
1626    end subroutine zero_work_arrays
# Line 1494 | Line 1714 | contains
1714  
1715    function FF_RequiresPrepairCalc() result(doesit)
1716      logical :: doesit
1717 <    doesit = FF_uses_EAM
1717 >    doesit = FF_uses_EAM .or. FF_uses_SC &
1718 >         .or. FF_uses_MEAM
1719    end function FF_RequiresPrepairCalc
1720  
1500  function FF_RequiresPostpairCalc() result(doesit)
1501    logical :: doesit
1502    if (electrostaticSummationMethod == REACTION_FIELD) doesit = .true.
1503  end function FF_RequiresPostpairCalc
1504
1721   #ifdef PROFILE
1722    function getforcetime() result(totalforcetime)
1723      real(kind=dp) :: totalforcetime

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines