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 2398 by chrisfen, Wed Oct 26 23:31:18 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.63 2005-10-26 23:31:18 chrisfen Exp $, $Date: 2005-10-26 23:31:18 $, $Name: not supported by cvs2svn $, $Revision: 1.63 $
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 62 | Line 62 | module doForces
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 86 | Line 88 | module doForces
88    logical, save :: haveInteractionHash = .false.
89    logical, save :: haveGtypeCutoffMap = .false.
90    logical, save :: haveDefaultCutoffs = .false.
91 <  logical, save :: haveRlist = .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
107  public :: createInteractionHash
108  public :: createGtypeCutoffMap
109  public :: getStickyCut
110  public :: getStickyPowerCut
111  public :: getGayBerneCut
112  public :: getEAMCut
113  public :: getShapeCut
126  
127   #ifdef PROFILE
128    public :: getforcetime
# Line 138 | Line 150 | module doForces
150    end type gtypeCutoffs
151    type(gtypeCutoffs), dimension(:,:), allocatable :: gtypeCutoffMap
152  
141  integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY
142  real(kind=dp),save :: defaultRcut, defaultRsw, defaultRlist
143  real(kind=dp),save :: listSkin
144  
153   contains
154  
155 <  subroutine createInteractionHash(status)
155 >  subroutine createInteractionHash()
156      integer :: nAtypes
149    integer, intent(out) :: status
157      integer :: i
158      integer :: j
159      integer :: iHash
# Line 158 | 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 165 | 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  
170    status = 0  
171
181      if (.not. associated(atypes)) then
182 <       call handleError("atype", "atypes was not present before call of createInteractionHash!")
174 <       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  
# Line 204 | 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 217 | 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 238 | 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 257 | Line 273 | contains
273      haveInteractionHash = .true.
274    end subroutine createInteractionHash
275  
276 <  subroutine createGtypeCutoffMap(stat)
276 >  subroutine createGtypeCutoffMap()
277  
262    integer, intent(out), optional :: stat
278      logical :: i_is_LJ
279      logical :: i_is_Elect
280      logical :: i_is_Sticky
# Line 267 | 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
# Line 274 | Line 290 | contains
290      integer :: nGroupsInRow
291      integer :: nGroupsInCol
292      integer :: nGroupTypesRow,nGroupTypesCol
293 <    real(kind=dp):: thisSigma, bigSigma, thisRcut, tradRcut, tol, skin
293 >    real(kind=dp):: thisSigma, bigSigma, thisRcut, tradRcut, tol
294      real(kind=dp) :: biggestAtypeCutoff
295  
280    stat = 0
296      if (.not. haveInteractionHash) then
297 <       call createInteractionHash(myStatus)      
283 <       if (myStatus .ne. 0) then
284 <          write(default_error, *) 'createInteractionHash failed in doForces!'
285 <          stat = -1
286 <          return
287 <       endif
297 >       call createInteractionHash()      
298      endif
299   #ifdef IS_MPI
300      nGroupsInRow = getNgroupsInRow(plan_group_row)
# Line 302 | 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 (haveDefaultCutoffs) then
318               atypeMaxCutoff(i) = defaultRcut
# Line 335 | Line 345 | contains
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 <          
340 <          
353 >                    
354            if (atypeMaxCutoff(i).gt.biggestAtypeCutoff) then
355               biggestAtypeCutoff = atypeMaxCutoff(i)
356            endif
357  
358         endif
359      enddo
347  
348
360      
361      istart = 1
362      jstart = 1
# Line 389 | Line 400 | contains
400         allocate(groupToGtypeCol(jend))
401      end if
402  
403 <    if(.not.associated(groupToGtypeCol)) then
404 <       allocate(groupToGtypeCol(jend))
403 >    if(.not.associated(groupMaxCutoffCol)) then
404 >       allocate(groupMaxCutoffCol(jend))
405      else
406 <       deallocate(groupToGtypeCol)
407 <       allocate(groupToGtypeCol(jend))
406 >       deallocate(groupMaxCutoffCol)
407 >       allocate(groupMaxCutoffCol(jend))
408      end if
409      if(.not.associated(gtypeMaxCutoffCol)) then
410         allocate(gtypeMaxCutoffCol(jend))
# Line 416 | Line 427 | contains
427      
428      tol = 1.0d-6
429      nGroupTypesRow = 0
430 <
430 >    nGroupTypesCol = 0
431      do i = istart, iend      
432         n_in_i = groupStartRow(i+1) - groupStartRow(i)
433         groupMaxCutoffRow(i) = 0.0_dp
# Line 431 | Line 442 | contains
442               groupMaxCutoffRow(i)=atypeMaxCutoff(me_i)
443            endif          
444         enddo
434
445         if (nGroupTypesRow.eq.0) then
446            nGroupTypesRow = nGroupTypesRow + 1
447            gtypeMaxCutoffRow(nGroupTypesRow) = groupMaxCutoffRow(i)
# Line 494 | Line 504 | contains
504      groupMaxCutoffCol => groupMaxCutoffRow
505   #endif
506  
497
498
499
500
507      !! allocate the gtypeCutoffMap here.
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      tradRcut = max(maxval(gtypeMaxCutoffRow),maxval(gtypeMaxCutoffCol))
512  
513 <    do i = 1, nGroupTypesRow
513 >    do i = 1, nGroupTypesRow      
514         do j = 1, nGroupTypesCol
515        
516            select case(cutoffPolicy)
# Line 519 | Line 525 | contains
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
523          skin = defaultRlist - defaultRcut
524          listSkin = skin ! set neighbor list skin thickness
525          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
# Line 533 | Line 545 | contains
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)
# Line 546 | Line 559 | contains
559      haveGtypeCutoffMap = .true.
560     end subroutine createGtypeCutoffMap
561  
562 <   subroutine setDefaultCutoffs(defRcut, defRsw, defRlist, cutPolicy)
550 <     real(kind=dp),intent(in) :: defRcut, defRsw, defRlist
551 <     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
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 +     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 <   end subroutine setDefaultCutoffs
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 <
605 >    
606       integer, intent(in) :: cutPolicy
607 +    
608       cutoffPolicy = cutPolicy
609 <     call createGtypeCutoffMap()
610 <   end subroutine setCutoffPolicy
567 <    
609 >     haveCutoffPolicy = .true.
610 >     haveGtypeCutoffMap = .false.
611      
612 <  subroutine setSimVariables()
613 <    SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
614 <    SIM_uses_EAM = SimUsesEAM()
572 <    SIM_requires_postpair_calc = SimRequiresPostpairCalc()
573 <    SIM_requires_prepair_calc = SimRequiresPrepairCalc()
574 <    SIM_uses_PBC = SimUsesPBC()
612 >   end subroutine setCutoffPolicy
613 >  
614 >   subroutine setElectrostaticMethod( thisESM )
615  
616 <    haveSIMvariables = .true.
616 >     integer, intent(in) :: thisESM
617  
618 <    return
619 <  end subroutine setSimVariables
618 >     electrostaticSummationMethod = thisESM
619 >     haveElectrostaticSummationMethod = .true.
620 >    
621 >   end subroutine setElectrostaticMethod
622  
623 +   subroutine setSkinThickness( thisSkin )
624 +    
625 +     real(kind=dp), intent(in) :: thisSkin
626 +    
627 +     skinThickness = thisSkin
628 +     haveSkinThickness = .true.    
629 +     haveGtypeCutoffMap = .false.
630 +    
631 +   end subroutine setSkinThickness
632 +      
633 +   subroutine setSimVariables()
634 +     SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
635 +     SIM_uses_EAM = SimUsesEAM()
636 +     SIM_requires_postpair_calc = SimRequiresPostpairCalc()
637 +     SIM_requires_prepair_calc = SimRequiresPrepairCalc()
638 +     SIM_uses_PBC = SimUsesPBC()
639 +     SIM_uses_SC = SimUsesSC()
640 +    
641 +     haveSIMvariables = .true.
642 +    
643 +     return
644 +   end subroutine setSimVariables
645 +
646    subroutine doReadyCheck(error)
647      integer, intent(out) :: error
648  
# Line 586 | Line 651 | contains
651      error = 0
652  
653      if (.not. haveInteractionHash) then      
654 <       myStatus = 0      
590 <       call createInteractionHash(myStatus)      
591 <       if (myStatus .ne. 0) then
592 <          write(default_error, *) 'createInteractionHash failed in doForces!'
593 <          error = -1
594 <          return
595 <       endif
654 >       call createInteractionHash()      
655      endif
656  
657      if (.not. haveGtypeCutoffMap) then        
658 <       myStatus = 0      
600 <       call createGtypeCutoffMap(myStatus)      
601 <       if (myStatus .ne. 0) then
602 <          write(default_error, *) 'createGtypeCutoffMap failed in doForces!'
603 <          error = -1
604 <          return
605 <       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 638 | Line 702 | contains
702    end subroutine doReadyCheck
703  
704  
705 <  subroutine init_FF(thisESM, thisStat)
705 >  subroutine init_FF(thisStat)
706  
643    integer, intent(in) :: thisESM
707      integer, intent(out) :: thisStat  
708      integer :: my_status, nMatches
709      integer, pointer :: MatchList(:) => null()
647    real(kind=dp) :: rcut, rrf, rt, dielect
710  
711      !! assume things are copacetic, unless they aren't
712      thisStat = 0
713  
652    electrostaticSummationMethod = thisESM
653
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 661 | 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 677 | 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  
744 +
745      haveSaneForceField = .true.
746  
747      if (FF_uses_EAM) then
# Line 747 | Line 811 | contains
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 756 | Line 821 | contains
821      integer :: loopStart, loopEnd, loop
822      integer :: iHash
823      integer :: i1
759    logical :: indirect_only
824    
825  
826      !! initialize local variables  
# Line 821 | 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 904 | Line 968 | contains
968  
969                     list(nlist) = j
970                  endif
971 +
972  
973 <                if (loop .eq. PAIR_LOOP) then
974 <                   vij = 0.0d0
910 <                   fij(1:3) = 0.0d0
911 <                endif
912 <
913 <                call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
914 <                     in_switching_region)
915 <
916 <                n_in_j = groupStartCol(j+1) - groupStartCol(j)
973 >                
974 >                if (rgrpsq < gtypeCutoffMap(groupToGtypeRow(i),groupToGtypeCol(j))%rCutsq) then
975  
976 <                do ia = groupStartRow(i), groupStartRow(i+1)-1
977 <
978 <                   atom1 = groupListRow(ia)
979 <
980 <                   inner: do jb = groupStartCol(j), groupStartCol(j+1)-1
981 <
982 <                      atom2 = groupListCol(jb)
983 <
984 <                      indirect_only = .false.
985 <    
986 <                      if (skipThisPair(atom1, atom2)) then
987 <                         if (electrostaticSummationMethod.ne.REACTION_FIELD) then
988 <                            cycle inner
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
932                            indirect_only = .true.
933                         endif
934                      endif
935    
936
937                      if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
938                         d_atm(1:3) = d_grp(1:3)
939                         ratmsq = rgrpsq
940                      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, eFrame, A, f, t, pot_local, vpair, &
1028 <                              fpair, d_grp, rgrp, indirect_only)
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, eFrame, A, f, t, pot, vpair, fpair, &
1032 <                              d_grp, rgrp, indirect_only)
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)
981 <                      fij(2) = fij(2) + swderiv*d_grp(2)
982 <                      fij(3) = fij(3) + swderiv*d_grp(3)
983 <
984 <                      do ia=groupStartRow(i), groupStartRow(i+1)-1
985 <                         atom1=groupListRow(ia)
986 <                         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 <
1083 >          
1084         enddo outer
1085  
1086         if (update_nlist) then
# Line 1110 | Line 1176 | contains
1176  
1177            if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1178   #ifdef IS_MPI
1179 <             call rf_self_self(i, eFrame, pot_local(ELECTROSTATIC_POT), &
1179 >             call self_self(i, eFrame, pot_local(ELECTROSTATIC_POT), &
1180                    t, do_pot)
1181   #else
1182 <             call rf_self_self(i, eFrame, pot(ELECTROSTATIC_POT), &
1182 >             call self_self(i, eFrame, pot(ELECTROSTATIC_POT), &
1183                    t, do_pot)
1184   #endif
1185            endif
1186    
1187 <          ! loop over the excludes to accumulate any additional RF components
1188 <
1123 <          do i1 = 1, nSkipsForAtom(i)
1124 <             j = skipsForAtom(i, i1)
1187 >          
1188 >          if (electrostaticSummationMethod.eq.REACTION_FIELD) then
1189              
1190 <             ! prevent overcounting of the skips
1191 <             if (i.lt.j) then
1192 <                call get_interatomic_vector(q(:,i), &
1193 <                     q(:,j), d_atm, ratmsq)
1194 <                rVal = dsqrt(ratmsq)
1195 <                call get_switch(ratmsq, sw, dswdr, rVal, group_switch, &
1196 <                     in_switching_region)
1190 >             ! loop over the excludes to accumulate RF stuff we've
1191 >             ! left out of the normal pair loop
1192 >            
1193 >             do i1 = 1, nSkipsForAtom(i)
1194 >                j = skipsForAtom(i, i1)
1195 >                
1196 >                ! prevent overcounting of the skips
1197 >                if (i.lt.j) then
1198 >                   call get_interatomic_vector(q(:,i), &
1199 >                        q(:,j), d_atm, ratmsq)
1200 >                   rVal = dsqrt(ratmsq)
1201 >                   call get_switch(ratmsq, sw, dswdr, rVal, group_switch, &
1202 >                        in_switching_region)
1203   #ifdef IS_MPI
1204 <                call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, vpair, &
1205 <                     pot_local(ELECTROSTATIC_POT), f, t, do_pot)
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 <                call rf_self_excludes(i, j, sw, eFrame, d_atm, rVal, vpair, &
1208 <                     pot(ELECTROSTATIC_POT), f, t, do_pot)
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 <       enddo      
1210 >                endif
1211 >             enddo
1212 >          endif
1213 >       enddo
1214      endif
1215      
1216   #ifdef IS_MPI
# Line 1168 | Line 1239 | contains
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, d_grp, r_grp, indirect_only)
1242 >       eFrame, A, f, t, pot, vpair, fpair, d_grp, r_grp, rCut)
1243  
1244      real( kind = dp ) :: vpair, sw
1245      real( kind = dp ), dimension(LR_POT_TYPES) :: pot
# Line 1180 | Line 1251 | contains
1251      real( kind = dp ), dimension(3,nLocal) :: t
1252  
1253      logical, intent(inout) :: do_pot
1183    logical, intent(inout) :: indirect_only
1254      integer, intent(in) :: i, j
1255      real ( kind = dp ), intent(inout) :: rijsq
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  
# Line 1204 | Line 1275 | contains
1275   #endif
1276  
1277      iHash = InteractionHash(me_i, me_j)
1278 +    
1279 +    if ( iand(iHash, LJ_PAIR).ne.0 ) then
1280 +       call do_lj_pair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1281 +            pot(VDW_POT), f, do_pot)
1282 +    endif
1283 +    
1284 +    if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1285 +       call doElectrostaticPair(i, j, d, r, rijsq, rcut, sw, vpair, fpair, &
1286 +            pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot)
1287 +    endif
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(HB_POT), A, f, t, do_pot)
1292 +    endif
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(HB_POT), A, f, t, do_pot)
1297 +    endif
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(VDW_POT), A, f, t, do_pot)
1302 +    endif
1303 +    
1304 +    if ( iand(iHash, GAYBERNE_LJ).ne.0 ) then
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 +    
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(VDW_POT), A, f, t, do_pot)
1317 +    endif
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(VDW_POT), A, f, t, do_pot)
1322 +    endif
1323  
1324 <    if (indirect_only) then
1325 <       if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1326 <          call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1211 <               pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot, indirect_only)
1212 <       endif
1213 <    else
1214 <          
1215 <       if ( iand(iHash, LJ_PAIR).ne.0 ) then
1216 <          call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1217 <               pot(VDW_POT), f, do_pot)
1218 <       endif
1219 <
1220 <       if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1221 <          call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1222 <               pot(ELECTROSTATIC_POT), eFrame, f, t, do_pot, indirect_only)
1223 <       endif
1224 <      
1225 <       if ( iand(iHash, STICKY_PAIR).ne.0 ) then
1226 <          call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1227 <               pot(HB_POT), A, f, t, do_pot)
1228 <       endif
1229 <      
1230 <       if ( iand(iHash, STICKYPOWER_PAIR).ne.0 ) then
1231 <          call do_sticky_power_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1232 <               pot(HB_POT), A, f, t, do_pot)
1233 <       endif
1234 <      
1235 <       if ( iand(iHash, GAYBERNE_PAIR).ne.0 ) then
1236 <          call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1237 <               pot(VDW_POT), A, f, t, do_pot)
1238 <       endif
1239 <      
1240 <       if ( iand(iHash, GAYBERNE_LJ).ne.0 ) then
1241 <          call do_gb_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1242 <               pot(VDW_POT), A, f, t, do_pot)
1243 <       endif
1244 <      
1245 <       if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1246 <          call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1247 <               pot(METALLIC_POT), f, do_pot)
1248 <       endif
1249 <      
1250 <       if ( iand(iHash, SHAPE_PAIR).ne.0 ) then      
1251 <          call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1252 <               pot(VDW_POT), A, f, t, do_pot)
1253 <       endif
1254 <      
1255 <       if ( iand(iHash, SHAPE_LJ).ne.0 ) then      
1256 <          call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1257 <               pot(VDW_POT), A, f, t, do_pot)
1258 <       endif
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 ) :: sw
# Line 1272 | 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 1291 | 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  
# Line 1304 | Line 1378 | contains
1378      if (FF_uses_EAM .and. SIM_uses_EAM) then
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 1317 | 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 1340 | Line 1419 | contains
1419         else
1420            ! calc the scaled coordinates.
1421  
1422 <          do i = 1, 3
1423 <             scaled(i) = d(i) * HmatInv(i,i)
1422 >
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 <             ! wrap the scaled coordinates
1433 >          ! calc the wrapped real coordinates from the wrapped scaled
1434 >          ! coordinates
1435  
1436 <             scaled(i) = scaled(i) - anint(scaled(i))
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  
1350             ! calc the wrapped real coordinates from the wrapped scaled
1351             ! coordinates
1352
1353             d(i) = scaled(i)*Hmat(i,i)
1354          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 1388 | Line 1473 | contains
1473      pot_Col = 0.0_dp
1474      pot_Temp = 0.0_dp
1475  
1391    rf_Row = 0.0_dp
1392    rf_Col = 0.0_dp
1393    rf_Temp = 0.0_dp
1394
1476   #endif
1477  
1478      if (FF_uses_EAM .and. SIM_uses_EAM) then
1479         call clean_EAM()
1480      endif
1481  
1401    rf = 0.0_dp
1482      tau_Temp = 0.0_dp
1483      virial_Temp = 0.0_dp
1484    end subroutine zero_work_arrays
# Line 1492 | 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  
1579   #ifdef PROFILE

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines