ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-2.0/src/UseTheForce/doForces.F90
(Generate patch)

Comparing trunk/OOPSE-2.0/src/UseTheForce/doForces.F90 (file contents):
Revision 2266 by chuckv, Thu Jul 28 22:12:45 2005 UTC vs.
Revision 2295 by chrisfen, Thu Sep 15 00:13:15 2005 UTC

# Line 45 | Line 45
45  
46   !! @author Charles F. Vardeman II
47   !! @author Matthew Meineke
48 < !! @version $Id: doForces.F90,v 1.24 2005-07-28 22:12:45 chuckv Exp $, $Date: 2005-07-28 22:12:45 $, $Name: not supported by cvs2svn $, $Revision: 1.24 $
48 > !! @version $Id: doForces.F90,v 1.42 2005-09-15 00:13:14 chrisfen Exp $, $Date: 2005-09-15 00:13:14 $, $Name: not supported by cvs2svn $, $Revision: 1.42 $
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
61 >  use reaction_field_module
62    use gb_pair
63    use shapes
64    use vector_class
# Line 73 | Line 73 | module doForces
73  
74   #define __FORTRAN90
75   #include "UseTheForce/fSwitchingFunction.h"
76 + #include "UseTheForce/fCutoffPolicy.h"
77 + #include "UseTheForce/fCoulombicCorrection.h"
78   #include "UseTheForce/DarkSide/fInteractionMap.h"
79  
80 +
81    INTEGER, PARAMETER:: PREPAIR_LOOP = 1
82    INTEGER, PARAMETER:: PAIR_LOOP    = 2
83  
81  logical, save :: haveRlist = .false.
84    logical, save :: haveNeighborList = .false.
85    logical, save :: haveSIMvariables = .false.
86    logical, save :: haveSaneForceField = .false.
87 <  logical, save :: haveInteractionMap = .false.
87 >  logical, save :: haveInteractionHash = .false.
88 >  logical, save :: haveGtypeCutoffMap = .false.
89 >  logical, save :: haveRlist = .false.
90  
91    logical, save :: FF_uses_DirectionalAtoms
88  logical, save :: FF_uses_LennardJones
89  logical, save :: FF_uses_Electrostatics
90  logical, save :: FF_uses_Charges
92    logical, save :: FF_uses_Dipoles
92  logical, save :: FF_uses_Quadrupoles
93  logical, save :: FF_uses_Sticky
94  logical, save :: FF_uses_StickyPower
93    logical, save :: FF_uses_GayBerne
94    logical, save :: FF_uses_EAM
97  logical, save :: FF_uses_Shapes
98  logical, save :: FF_uses_FLARB
95    logical, save :: FF_uses_RF
96  
97    logical, save :: SIM_uses_DirectionalAtoms
102  logical, save :: SIM_uses_LennardJones
103  logical, save :: SIM_uses_Electrostatics
104  logical, save :: SIM_uses_Charges
105  logical, save :: SIM_uses_Dipoles
106  logical, save :: SIM_uses_Quadrupoles
107  logical, save :: SIM_uses_Sticky
108  logical, save :: SIM_uses_StickyPower
109  logical, save :: SIM_uses_GayBerne
98    logical, save :: SIM_uses_EAM
111  logical, save :: SIM_uses_Shapes
112  logical, save :: SIM_uses_FLARB
99    logical, save :: SIM_uses_RF
100    logical, save :: SIM_requires_postpair_calc
101    logical, save :: SIM_requires_prepair_calc
102    logical, save :: SIM_uses_PBC
117  logical, save :: SIM_uses_molecular_cutoffs
103  
104 <  !!!GO AWAY---------
120 <  !!!!!real(kind=dp), save :: rlist, rlistsq
104 >  integer, save :: corrMethod
105  
106    public :: init_FF
107 +  public :: setDefaultCutoffs
108    public :: do_force_loop
109 < !  public :: setRlistDF
110 <  !public :: addInteraction
111 <  !public :: setInteractionHash
112 <  !public :: getInteractionHash
113 <  public :: createInteractionMap
114 <  public :: createRcuts
109 >  public :: createInteractionHash
110 >  public :: createGtypeCutoffMap
111 >  public :: getStickyCut
112 >  public :: getStickyPowerCut
113 >  public :: getGayBerneCut
114 >  public :: getEAMCut
115 >  public :: getShapeCut
116  
117   #ifdef PROFILE
118    public :: getforcetime
# Line 134 | Line 120 | module doForces
120    real :: forceTimeInitial, forceTimeFinal
121    integer :: nLoops
122   #endif
137
138  type, public :: Interaction
139     integer :: InteractionHash
140     real(kind=dp) :: rList = 0.0_dp
141     real(kind=dp) :: rListSq = 0.0_dp
142  end type Interaction
123    
124 <  type(Interaction), dimension(:,:),allocatable :: InteractionMap
125 <  
124 >  !! Variables for cutoff mapping and interaction mapping
125 >  ! Bit hash to determine pair-pair interactions.
126 >  integer, dimension(:,:), allocatable :: InteractionHash
127 >  real(kind=dp), dimension(:), allocatable :: atypeMaxCutoff
128 >  real(kind=dp), dimension(:), allocatable :: groupMaxCutoff
129 >  integer, dimension(:), allocatable :: groupToGtype
130 >  real(kind=dp), dimension(:), allocatable :: gtypeMaxCutoff
131 >  type ::gtypeCutoffs
132 >     real(kind=dp) :: rcut
133 >     real(kind=dp) :: rcutsq
134 >     real(kind=dp) :: rlistsq
135 >  end type gtypeCutoffs
136 >  type(gtypeCutoffs), dimension(:,:), allocatable :: gtypeCutoffMap
137  
138 +  integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY
139 +  integer, save :: coulombicCorrection = NONE
140 +  real(kind=dp),save :: defaultRcut, defaultRsw, defaultRlist
141 +  real(kind=dp),save :: rcuti
142    
143   contains
144  
145 <
151 <  subroutine createInteractionMap(status)
145 >  subroutine createInteractionHash(status)
146      integer :: nAtypes
147      integer, intent(out) :: status
148      integer :: i
149      integer :: j
150 <    integer :: ihash
151 <    real(kind=dp) :: myRcut
158 < ! Test Types
150 >    integer :: iHash
151 >    !! Test Types
152      logical :: i_is_LJ
153      logical :: i_is_Elect
154      logical :: i_is_Sticky
# Line 170 | Line 163 | contains
163      logical :: j_is_GB
164      logical :: j_is_EAM
165      logical :: j_is_Shape
166 <    
167 <    status = 0
168 <    
166 >    real(kind=dp) :: myRcut
167 >
168 >    status = 0  
169 >
170      if (.not. associated(atypes)) then
171 <       call handleError("atype", "atypes was not present before call of createDefaultInteractionMap!")
171 >       call handleError("atype", "atypes was not present before call of createInteractionHash!")
172         status = -1
173         return
174      endif
# Line 186 | Line 180 | contains
180         return
181      end if
182  
183 <    if (.not. allocated(InteractionMap)) then
184 <       allocate(InteractionMap(nAtypes,nAtypes))
183 >    if (.not. allocated(InteractionHash)) then
184 >       allocate(InteractionHash(nAtypes,nAtypes))
185      endif
186 +
187 +    if (.not. allocated(atypeMaxCutoff)) then
188 +       allocate(atypeMaxCutoff(nAtypes))
189 +    endif
190          
191      do i = 1, nAtypes
192         call getElementProperty(atypes, i, "is_LennardJones", i_is_LJ)
# Line 241 | Line 239 | contains
239            if (i_is_LJ .and. j_is_Shape) iHash = ior(iHash, SHAPE_LJ)
240  
241  
242 <          InteractionMap(i,j)%InteractionHash = iHash
243 <          InteractionMap(j,i)%InteractionHash = iHash
242 >          InteractionHash(i,j) = iHash
243 >          InteractionHash(j,i) = iHash
244  
245         end do
246  
247      end do
250  end subroutine createInteractionMap
248  
249 < ! Query each potential and return the cutoff for that potential. We build the neighbor list based on the largest cutoff value for that atype. Each potential can decide whether to calculate the force for that atype based upon it's own cutoff.
250 <  subroutine createRcuts(defaultRList,stat)
254 <    real(kind=dp), intent(in), optional :: defaultRList
255 <    integer :: iMap
256 <    integer :: map_i,map_j
257 <    real(kind=dp) :: thisRCut = 0.0_dp
258 <    real(kind=dp) :: actualCutoff = 0.0_dp
259 <    integer, intent(out) :: stat
260 <    integer :: nAtypes
261 <    integer :: myStatus
249 >    haveInteractionHash = .true.
250 >  end subroutine createInteractionHash
251  
252 <    stat = 0
264 <    if (.not. haveInteractionMap) then
252 >  subroutine createGtypeCutoffMap(stat)
253  
254 <       call createInteractionMap(myStatus)
254 >    integer, intent(out), optional :: stat
255 >    logical :: i_is_LJ
256 >    logical :: i_is_Elect
257 >    logical :: i_is_Sticky
258 >    logical :: i_is_StickyP
259 >    logical :: i_is_GB
260 >    logical :: i_is_EAM
261 >    logical :: i_is_Shape
262 >    logical :: GtypeFound
263  
264 +    integer :: myStatus, nAtypes,  i, j, istart, iend, jstart, jend
265 +    integer :: n_in_i, me_i, ia, g, atom1, nGroupTypes
266 +    integer :: nGroupsInRow
267 +    real(kind=dp):: thisSigma, bigSigma, thisRcut, tol, skin
268 +    real(kind=dp) :: biggestAtypeCutoff
269 +
270 +    stat = 0
271 +    if (.not. haveInteractionHash) then
272 +       call createInteractionHash(myStatus)      
273         if (myStatus .ne. 0) then
274 <          write(default_error, *) 'createInteractionMap failed in doForces!'
274 >          write(default_error, *) 'createInteractionHash failed in doForces!'
275            stat = -1
276            return
277         endif
278      endif
279 <
280 <
279 > #ifdef IS_MPI
280 >    nGroupsInRow = getNgroupsInRow(plan_group_row)
281 > #endif
282      nAtypes = getSize(atypes)
283 < ! If we pass a default rcut, set all atypes to that cutoff distance
284 <    if(present(defaultRList)) then
285 <       InteractionMap(:,:)%rList = defaultRList
286 <       InteractionMap(:,:)%rListSq = defaultRList*defaultRList
287 <       haveRlist = .true.
288 <       return
289 <    end if
290 <
291 <    do map_i = 1,nAtypes
292 <       do map_j = map_i,nAtypes
287 <          iMap = InteractionMap(map_i, map_j)%InteractionHash
283 >    
284 >    do i = 1, nAtypes
285 >       if (SimHasAtype(i)) then    
286 >          call getElementProperty(atypes, i, "is_LennardJones", i_is_LJ)
287 >          call getElementProperty(atypes, i, "is_Electrostatic", i_is_Elect)
288 >          call getElementProperty(atypes, i, "is_Sticky", i_is_Sticky)
289 >          call getElementProperty(atypes, i, "is_StickyPower", i_is_StickyP)
290 >          call getElementProperty(atypes, i, "is_GayBerne", i_is_GB)
291 >          call getElementProperty(atypes, i, "is_EAM", i_is_EAM)
292 >          call getElementProperty(atypes, i, "is_Shape", i_is_Shape)
293            
294 <          if ( iand(iMap, LJ_PAIR).ne.0 ) then
295 < !            thisRCut = getLJCutOff(map_i,map_j)
296 <             if (thisRcut > actualCutoff) actualCutoff = thisRcut
294 >          atypeMaxCutoff(i) = 0.0_dp
295 >          if (i_is_LJ) then
296 >             thisRcut = getSigma(i) * 2.5_dp
297 >             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
298            endif
299 <          
300 <          if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then
301 < !            thisRCut = getElectrostaticCutOff(map_i,map_j)
296 <             if (thisRcut > actualCutoff) actualCutoff = thisRcut
299 >          if (i_is_Elect) then
300 >             thisRcut = defaultRcut
301 >             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
302            endif
303 +          if (i_is_Sticky) then
304 +             thisRcut = getStickyCut(i)
305 +             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
306 +          endif
307 +          if (i_is_StickyP) then
308 +             thisRcut = getStickyPowerCut(i)
309 +             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
310 +          endif
311 +          if (i_is_GB) then
312 +             thisRcut = getGayBerneCut(i)
313 +             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
314 +          endif
315 +          if (i_is_EAM) then
316 +             thisRcut = getEAMCut(i)
317 +             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
318 +          endif
319 +          if (i_is_Shape) then
320 +             thisRcut = getShapeCut(i)
321 +             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
322 +          endif
323            
324 <          if ( iand(iMap, STICKY_PAIR).ne.0 ) then
325 < !             thisRCut = getStickyCutOff(map_i,map_j)
326 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
327 <           endif
328 <          
329 <           if ( iand(iMap, STICKYPOWER_PAIR).ne.0 ) then
330 < !              thisRCut = getStickyPowerCutOff(map_i,map_j)
331 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
332 <           endif
333 <          
334 <           if ( iand(iMap, GAYBERNE_PAIR).ne.0 ) then
335 < !              thisRCut = getGayberneCutOff(map_i,map_j)
336 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
337 <           endif
338 <          
339 <           if ( iand(iMap, GAYBERNE_LJ).ne.0 ) then
340 < !              thisRCut = getGaybrneLJCutOff(map_i,map_j)
341 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
342 <           endif
343 <          
344 <           if ( iand(iMap, EAM_PAIR).ne.0 ) then      
345 < !              thisRCut = getEAMCutOff(map_i,map_j)
346 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
347 <           endif
348 <          
349 <           if ( iand(iMap, SHAPE_PAIR).ne.0 ) then      
350 < !              thisRCut = getShapeCutOff(map_i,map_j)
351 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
352 <           endif
353 <          
354 <           if ( iand(iMap, SHAPE_LJ).ne.0 ) then      
355 < !              thisRCut = getShapeLJCutOff(map_i,map_j)
356 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
357 <           endif
358 <           InteractionMap(map_i, map_j)%rList = actualCutoff
359 <           InteractionMap(map_i, map_j)%rListSq = actualCutoff * actualCutoff
360 <        end do
361 <     end do
362 <          haveRlist = .true.
363 <  end subroutine createRcuts
364 <
340 <
341 < !!! THIS GOES AWAY FOR SIZE DEPENDENT CUTOFF
342 < !!$  subroutine setRlistDF( this_rlist )
343 < !!$
344 < !!$   real(kind=dp) :: this_rlist
345 < !!$
346 < !!$    rlist = this_rlist
347 < !!$    rlistsq = rlist * rlist
348 < !!$
349 < !!$    haveRlist = .true.
350 < !!$
351 < !!$  end subroutine setRlistDF
324 >          if (atypeMaxCutoff(i).gt.biggestAtypeCutoff) then
325 >             biggestAtypeCutoff = atypeMaxCutoff(i)
326 >          endif
327 >       endif
328 >    enddo
329 >  
330 >    nGroupTypes = 0
331 >    
332 >    istart = 1
333 > #ifdef IS_MPI
334 >    iend = nGroupsInRow
335 > #else
336 >    iend = nGroups
337 > #endif
338 >    
339 >    !! allocate the groupToGtype and gtypeMaxCutoff here.
340 >    if(.not.allocated(groupToGtype)) then
341 >       allocate(groupToGtype(iend))
342 >       allocate(groupMaxCutoff(iend))
343 >       allocate(gtypeMaxCutoff(iend))
344 >    endif
345 >    !! first we do a single loop over the cutoff groups to find the
346 >    !! largest cutoff for any atypes present in this group.  We also
347 >    !! create gtypes at this point.
348 >    
349 >    tol = 1.0d-6
350 >    
351 >    do i = istart, iend      
352 >       n_in_i = groupStartRow(i+1) - groupStartRow(i)
353 >       groupMaxCutoff(i) = 0.0_dp
354 >       do ia = groupStartRow(i), groupStartRow(i+1)-1
355 >          atom1 = groupListRow(ia)
356 > #ifdef IS_MPI
357 >          me_i = atid_row(atom1)
358 > #else
359 >          me_i = atid(atom1)
360 > #endif          
361 >          if (atypeMaxCutoff(me_i).gt.groupMaxCutoff(i)) then
362 >             groupMaxCutoff(i)=atypeMaxCutoff(me_i)
363 >          endif          
364 >       enddo
365  
366 +       if (nGroupTypes.eq.0) then
367 +          nGroupTypes = nGroupTypes + 1
368 +          gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
369 +          groupToGtype(i) = nGroupTypes
370 +       else
371 +          GtypeFound = .false.
372 +          do g = 1, nGroupTypes
373 +             if ( abs(groupMaxCutoff(i) - gtypeMaxCutoff(g)).lt.tol) then
374 +                groupToGtype(i) = g
375 +                GtypeFound = .true.
376 +             endif
377 +          enddo
378 +          if (.not.GtypeFound) then            
379 +             nGroupTypes = nGroupTypes + 1
380 +             gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
381 +             groupToGtype(i) = nGroupTypes
382 +          endif
383 +       endif
384 +    enddo    
385  
386 +    !! allocate the gtypeCutoffMap here.
387 +    allocate(gtypeCutoffMap(nGroupTypes,nGroupTypes))
388 +    !! then we do a double loop over all the group TYPES to find the cutoff
389 +    !! map between groups of two types
390 +    
391 +    do i = 1, nGroupTypes
392 +       do j = 1, nGroupTypes
393 +      
394 +          select case(cutoffPolicy)
395 +          case(TRADITIONAL_CUTOFF_POLICY)
396 +             thisRcut = maxval(gtypeMaxCutoff)
397 +          case(MIX_CUTOFF_POLICY)
398 +             thisRcut = 0.5_dp * (gtypeMaxCutoff(i) + gtypeMaxCutoff(j))
399 +          case(MAX_CUTOFF_POLICY)
400 +             thisRcut = max(gtypeMaxCutoff(i), gtypeMaxCutoff(j))
401 +          case default
402 +             call handleError("createGtypeCutoffMap", "Unknown Cutoff Policy")
403 +             return
404 +          end select
405 +          gtypeCutoffMap(i,j)%rcut = thisRcut
406 +          gtypeCutoffMap(i,j)%rcutsq = thisRcut*thisRcut
407 +          skin = defaultRlist - defaultRcut
408 +          gtypeCutoffMap(i,j)%rlistsq = (thisRcut + skin)**2
409 +
410 +       enddo
411 +    enddo
412 +    
413 +    haveGtypeCutoffMap = .true.
414 +   end subroutine createGtypeCutoffMap
415 +
416 +   subroutine setDefaultCutoffs(defRcut, defRsw, defRlist, cutPolicy)
417 +     real(kind=dp),intent(in) :: defRcut, defRsw, defRlist
418 +     integer, intent(in) :: cutPolicy
419 +
420 +     defaultRcut = defRcut
421 +     defaultRsw = defRsw
422 +     defaultRlist = defRlist
423 +     cutoffPolicy = cutPolicy
424 +     rcuti = 1.0_dp / defaultRcut
425 +   end subroutine setDefaultCutoffs
426 +
427 +   subroutine setCutoffPolicy(cutPolicy)
428 +
429 +     integer, intent(in) :: cutPolicy
430 +     cutoffPolicy = cutPolicy
431 +     call createGtypeCutoffMap()
432 +   end subroutine setCutoffPolicy
433 +    
434 +    
435    subroutine setSimVariables()
436      SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
356    SIM_uses_LennardJones = SimUsesLennardJones()
357    SIM_uses_Electrostatics = SimUsesElectrostatics()
358    SIM_uses_Charges = SimUsesCharges()
359    SIM_uses_Dipoles = SimUsesDipoles()
360    SIM_uses_Sticky = SimUsesSticky()
361    SIM_uses_StickyPower = SimUsesStickyPower()
362    SIM_uses_GayBerne = SimUsesGayBerne()
437      SIM_uses_EAM = SimUsesEAM()
364    SIM_uses_Shapes = SimUsesShapes()
365    SIM_uses_FLARB = SimUsesFLARB()
366    SIM_uses_RF = SimUsesRF()
438      SIM_requires_postpair_calc = SimRequiresPostpairCalc()
439      SIM_requires_prepair_calc = SimRequiresPrepairCalc()
440      SIM_uses_PBC = SimUsesPBC()
441 +    SIM_uses_RF = SimUsesRF()
442  
443      haveSIMvariables = .true.
444  
# Line 380 | Line 452 | contains
452  
453      error = 0
454  
455 <    if (.not. haveInteractionMap) then
455 >    if (.not. haveInteractionHash) then      
456 >       myStatus = 0      
457 >       call createInteractionHash(myStatus)      
458 >       if (myStatus .ne. 0) then
459 >          write(default_error, *) 'createInteractionHash failed in doForces!'
460 >          error = -1
461 >          return
462 >       endif
463 >    endif
464  
465 <       myStatus = 0
466 <
467 <       call createInteractionMap(myStatus)
388 <
465 >    if (.not. haveGtypeCutoffMap) then        
466 >       myStatus = 0      
467 >       call createGtypeCutoffMap(myStatus)      
468         if (myStatus .ne. 0) then
469 <          write(default_error, *) 'createInteractionMap failed in doForces!'
469 >          write(default_error, *) 'createGtypeCutoffMap failed in doForces!'
470            error = -1
471            return
472         endif
# Line 397 | Line 476 | contains
476         call setSimVariables()
477      endif
478  
479 <    if (.not. haveRlist) then
480 <       write(default_error, *) 'rList has not been set in doForces!'
481 <       error = -1
482 <       return
483 <    endif
479 >  !  if (.not. haveRlist) then
480 >  !     write(default_error, *) 'rList has not been set in doForces!'
481 >  !     error = -1
482 >  !     return
483 >  !  endif
484  
485      if (.not. haveNeighborList) then
486         write(default_error, *) 'neighbor list has not been initialized in doForces!'
# Line 426 | Line 505 | contains
505    end subroutine doReadyCheck
506  
507  
508 <  subroutine init_FF(use_RF_c, thisStat)
508 >  subroutine init_FF(use_RF, correctionMethod, dampingAlpha, thisStat)
509  
510 <    logical, intent(in) :: use_RF_c
511 <
510 >    logical, intent(in) :: use_RF
511 >    integer, intent(in) :: correctionMethod
512 >    real(kind=dp), intent(in) :: dampingAlpha
513      integer, intent(out) :: thisStat  
514      integer :: my_status, nMatches
515      integer, pointer :: MatchList(:) => null()
# Line 439 | Line 519 | contains
519      thisStat = 0
520  
521      !! Fortran's version of a cast:
522 <    FF_uses_RF = use_RF_c
522 >    FF_uses_RF = use_RF
523  
524 +    !! set the electrostatic correction method
525 +    select case(coulombicCorrection)
526 +    case(NONE)
527 +       corrMethod = 0
528 +    case(UNDAMPED_WOLF)
529 +       corrMethod = 1
530 +    case(WOLF)
531 +       corrMethod = 2
532 +    case (REACTION_FIELD)
533 +       corrMethod = 3
534 +    case default
535 +       call handleError("init_FF", "Unknown Coulombic Correction Method")
536 +       return
537 +    end select
538 +        
539      !! init_FF is called *after* all of the atom types have been
540      !! defined in atype_module using the new_atype subroutine.
541      !!
# Line 448 | Line 543 | contains
543      !! interactions are used by the force field.    
544  
545      FF_uses_DirectionalAtoms = .false.
451    FF_uses_LennardJones = .false.
452    FF_uses_Electrostatics = .false.
453    FF_uses_Charges = .false.    
546      FF_uses_Dipoles = .false.
455    FF_uses_Sticky = .false.
456    FF_uses_StickyPower = .false.
547      FF_uses_GayBerne = .false.
548      FF_uses_EAM = .false.
459    FF_uses_Shapes = .false.
460    FF_uses_FLARB = .false.
549  
550      call getMatchingElementList(atypes, "is_Directional", .true., &
551           nMatches, MatchList)
552      if (nMatches .gt. 0) FF_uses_DirectionalAtoms = .true.
553  
466    call getMatchingElementList(atypes, "is_LennardJones", .true., &
467         nMatches, MatchList)
468    if (nMatches .gt. 0) FF_uses_LennardJones = .true.
469
470    call getMatchingElementList(atypes, "is_Electrostatic", .true., &
471         nMatches, MatchList)
472    if (nMatches .gt. 0) then
473       FF_uses_Electrostatics = .true.
474    endif
475
476    call getMatchingElementList(atypes, "is_Charge", .true., &
477         nMatches, MatchList)
478    if (nMatches .gt. 0) then
479       FF_uses_Charges = .true.  
480       FF_uses_Electrostatics = .true.
481    endif
482
554      call getMatchingElementList(atypes, "is_Dipole", .true., &
555           nMatches, MatchList)
556 <    if (nMatches .gt. 0) then
486 <       FF_uses_Dipoles = .true.
487 <       FF_uses_Electrostatics = .true.
488 <       FF_uses_DirectionalAtoms = .true.
489 <    endif
490 <
491 <    call getMatchingElementList(atypes, "is_Quadrupole", .true., &
492 <         nMatches, MatchList)
493 <    if (nMatches .gt. 0) then
494 <       FF_uses_Quadrupoles = .true.
495 <       FF_uses_Electrostatics = .true.
496 <       FF_uses_DirectionalAtoms = .true.
497 <    endif
498 <
499 <    call getMatchingElementList(atypes, "is_Sticky", .true., nMatches, &
500 <         MatchList)
501 <    if (nMatches .gt. 0) then
502 <       FF_uses_Sticky = .true.
503 <       FF_uses_DirectionalAtoms = .true.
504 <    endif
505 <
506 <    call getMatchingElementList(atypes, "is_StickyPower", .true., nMatches, &
507 <         MatchList)
508 <    if (nMatches .gt. 0) then
509 <       FF_uses_StickyPower = .true.
510 <       FF_uses_DirectionalAtoms = .true.
511 <    endif
556 >    if (nMatches .gt. 0) FF_uses_Dipoles = .true.
557      
558      call getMatchingElementList(atypes, "is_GayBerne", .true., &
559           nMatches, MatchList)
560 <    if (nMatches .gt. 0) then
516 <       FF_uses_GayBerne = .true.
517 <       FF_uses_DirectionalAtoms = .true.
518 <    endif
560 >    if (nMatches .gt. 0) FF_uses_GayBerne = .true.
561  
562      call getMatchingElementList(atypes, "is_EAM", .true., nMatches, MatchList)
563      if (nMatches .gt. 0) FF_uses_EAM = .true.
564  
523    call getMatchingElementList(atypes, "is_Shape", .true., &
524         nMatches, MatchList)
525    if (nMatches .gt. 0) then
526       FF_uses_Shapes = .true.
527       FF_uses_DirectionalAtoms = .true.
528    endif
565  
530    call getMatchingElementList(atypes, "is_FLARB", .true., &
531         nMatches, MatchList)
532    if (nMatches .gt. 0) FF_uses_FLARB = .true.
533
534    !! Assume sanity (for the sake of argument)
566      haveSaneForceField = .true.
567  
568      !! check to make sure the FF_uses_RF setting makes sense
569  
570 <    if (FF_uses_dipoles) then
570 >    if (FF_uses_Dipoles) then
571         if (FF_uses_RF) then
572            dielect = getDielect()
573            call initialize_rf(dielect)
574         endif
575      else
576 <       if (FF_uses_RF) then          
576 >       if ((corrMethod == 3) .or. FF_uses_RF) then
577            write(default_error,*) 'Using Reaction Field with no dipoles?  Huh?'
578            thisStat = -1
579            haveSaneForceField = .false.
# Line 550 | Line 581 | contains
581         endif
582      endif
583  
553    !sticky module does not contain check_sticky_FF anymore
554    !if (FF_uses_sticky) then
555    !   call check_sticky_FF(my_status)
556    !   if (my_status /= 0) then
557    !      thisStat = -1
558    !      haveSaneForceField = .false.
559    !      return
560    !   end if
561    !endif
562
584      if (FF_uses_EAM) then
585         call init_EAM_FF(my_status)
586         if (my_status /= 0) then
# Line 579 | Line 600 | contains
600         endif
601      endif
602  
582    if (FF_uses_GayBerne .and. FF_uses_LennardJones) then
583    endif
584
603      if (.not. haveNeighborList) then
604         !! Create neighbor lists
605         call expandNeighborList(nLocal, my_status)
# Line 645 | Line 663 | contains
663      integer :: localError
664      integer :: propPack_i, propPack_j
665      integer :: loopStart, loopEnd, loop
666 <    integer :: iMap
666 >    integer :: iHash
667      real(kind=dp) :: listSkin = 1.0  
668  
669      !! initialize local variables  
# Line 743 | Line 761 | contains
761  
762            if (update_nlist) then
763   #ifdef IS_MPI
746             me_i = atid_row(i)
764               jstart = 1
765               jend = nGroupsInCol
766   #else
750             me_i = atid(i)
767               jstart = i+1
768               jend = nGroups
769   #endif
# Line 775 | Line 791 | contains
791                    q_group(:,j), d_grp, rgrpsq)
792   #endif
793  
794 <             if (rgrpsq < InteractionMap(me_i,me_j)%rListsq) then
794 >             if (rgrpsq < gtypeCutoffMap(groupToGtype(i),groupToGtype(j))%rListsq) then
795                  if (update_nlist) then
796                     nlist = nlist + 1
797  
# Line 975 | Line 991 | contains
991  
992      if (FF_RequiresPostpairCalc() .and. SIM_requires_postpair_calc) then
993  
994 <       if (FF_uses_RF .and. SIM_uses_RF) then
994 >       if ((FF_uses_RF .and. SIM_uses_RF) .or. (corrMethod == 3)) then
995  
996   #ifdef IS_MPI
997            call scatter(rf_Row,rf,plan_atom_row_3d)
# Line 993 | Line 1009 | contains
1009   #else
1010               me_i = atid(i)
1011   #endif
1012 <             iMap = InteractionMap(me_i, me_j)%InteractionHash
1012 >             iHash = InteractionHash(me_i,me_j)
1013              
1014 <             if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then
1014 >             if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1015  
1016                  mu_i = getDipoleMoment(me_i)
1017  
# Line 1059 | Line 1075 | contains
1075      real ( kind = dp ), intent(inout) :: rijsq
1076      real ( kind = dp )                :: r
1077      real ( kind = dp ), intent(inout) :: d(3)
1062    real ( kind = dp ) :: ebalance
1078      integer :: me_i, me_j
1079  
1080 <    integer :: iMap
1080 >    integer :: iHash
1081  
1082      r = sqrt(rijsq)
1083      vpair = 0.0d0
# Line 1076 | Line 1091 | contains
1091      me_j = atid(j)
1092   #endif
1093  
1094 <    iMap = InteractionMap(me_i, me_j)%InteractionHash
1094 >    iHash = InteractionHash(me_i, me_j)
1095  
1096 <    if ( iand(iMap, LJ_PAIR).ne.0 ) then
1096 >    if ( iand(iHash, LJ_PAIR).ne.0 ) then
1097         call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, do_pot)
1098      endif
1099  
1100 <    if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then
1100 >    if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1101         call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1102 <            pot, eFrame, f, t, do_pot)
1102 >            pot, eFrame, f, t, do_pot, corrMethod, rcuti)
1103  
1104 <       if (FF_uses_RF .and. SIM_uses_RF) then
1104 >       if ((FF_uses_RF .and. SIM_uses_RF) .or. (corrMethod == 3)) then
1105  
1106            ! CHECK ME (RF needs to know about all electrostatic types)
1107            call accumulate_rf(i, j, r, eFrame, sw)
# Line 1095 | Line 1110 | contains
1110  
1111      endif
1112  
1113 <    if ( iand(iMap, STICKY_PAIR).ne.0 ) then
1113 >    if ( iand(iHash, STICKY_PAIR).ne.0 ) then
1114         call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1115              pot, A, f, t, do_pot)
1116      endif
1117  
1118 <    if ( iand(iMap, STICKYPOWER_PAIR).ne.0 ) then
1118 >    if ( iand(iHash, STICKYPOWER_PAIR).ne.0 ) then
1119         call do_sticky_power_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1120              pot, A, f, t, do_pot)
1121      endif
1122  
1123 <    if ( iand(iMap, GAYBERNE_PAIR).ne.0 ) then
1123 >    if ( iand(iHash, GAYBERNE_PAIR).ne.0 ) then
1124         call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1125              pot, A, f, t, do_pot)
1126      endif
1127      
1128 <    if ( iand(iMap, GAYBERNE_LJ).ne.0 ) then
1128 >    if ( iand(iHash, GAYBERNE_LJ).ne.0 ) then
1129   !      call do_gblj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1130   !           pot, A, f, t, do_pot)
1131      endif
1132  
1133 <    if ( iand(iMap, EAM_PAIR).ne.0 ) then      
1133 >    if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1134         call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, &
1135              do_pot)
1136      endif
1137  
1138 <    if ( iand(iMap, SHAPE_PAIR).ne.0 ) then      
1138 >    if ( iand(iHash, SHAPE_PAIR).ne.0 ) then      
1139         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1140              pot, A, f, t, do_pot)
1141      endif
1142  
1143 <    if ( iand(iMap, SHAPE_LJ).ne.0 ) then      
1143 >    if ( iand(iHash, SHAPE_LJ).ne.0 ) then      
1144         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1145              pot, A, f, t, do_pot)
1146      endif
# Line 1147 | Line 1162 | contains
1162      real ( kind = dp )                :: r, rc
1163      real ( kind = dp ), intent(inout) :: d(3), dc(3)
1164  
1165 <    integer :: me_i, me_j, iMap
1165 >    integer :: me_i, me_j, iHash
1166  
1167 +    r = sqrt(rijsq)
1168 +
1169   #ifdef IS_MPI  
1170      me_i = atid_row(i)
1171      me_j = atid_col(j)  
# Line 1157 | Line 1174 | contains
1174      me_j = atid(j)  
1175   #endif
1176  
1177 <    iMap = InteractionMap(me_i, me_j)%InteractionHash
1177 >    iHash = InteractionHash(me_i, me_j)
1178  
1179 <    if ( iand(iMap, EAM_PAIR).ne.0 ) then      
1179 >    if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1180              call calc_EAM_prepair_rho(i, j, d, r, rijsq )
1181      endif
1182      
# Line 1356 | Line 1373 | contains
1373  
1374    function FF_UsesDirectionalAtoms() result(doesit)
1375      logical :: doesit
1376 <    doesit = FF_uses_DirectionalAtoms .or. FF_uses_Dipoles .or. &
1360 <         FF_uses_Quadrupoles .or. FF_uses_Sticky .or. &
1361 <         FF_uses_StickyPower .or. FF_uses_GayBerne .or. FF_uses_Shapes
1376 >    doesit = FF_uses_DirectionalAtoms
1377    end function FF_UsesDirectionalAtoms
1378  
1379    function FF_RequiresPrepairCalc() result(doesit)
# Line 1369 | Line 1384 | contains
1384    function FF_RequiresPostpairCalc() result(doesit)
1385      logical :: doesit
1386      doesit = FF_uses_RF
1387 +    if (corrMethod == 3) doesit = .true.
1388    end function FF_RequiresPostpairCalc
1389  
1390   #ifdef PROFILE

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines