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 2266 by chuckv, Thu Jul 28 22:12:45 2005 UTC vs.
Revision 2298 by chuckv, Thu Sep 15 02:48:43 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.43 2005-09-15 02:48:43 chuckv Exp $, $Date: 2005-09-15 02:48:43 $, $Name: not supported by cvs2svn $, $Revision: 1.43 $
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
293 <          iMap = InteractionMap(map_i, map_j)%InteractionHash
283 > ! Set all of the initial cutoffs to zero.
284 >    atypeMaxCutoff = 0.0_dp
285 >    do i = 1, nAtypes
286 >       if (SimHasAtype(i)) then    
287 >          call getElementProperty(atypes, i, "is_LennardJones", i_is_LJ)
288 >          call getElementProperty(atypes, i, "is_Electrostatic", i_is_Elect)
289 >          call getElementProperty(atypes, i, "is_Sticky", i_is_Sticky)
290 >          call getElementProperty(atypes, i, "is_StickyPower", i_is_StickyP)
291 >          call getElementProperty(atypes, i, "is_GayBerne", i_is_GB)
292 >          call getElementProperty(atypes, i, "is_EAM", i_is_EAM)
293 >          call getElementProperty(atypes, i, "is_Shape", i_is_Shape)
294            
295 <          if ( iand(iMap, LJ_PAIR).ne.0 ) then
296 < !            thisRCut = getLJCutOff(map_i,map_j)
297 <             if (thisRcut > actualCutoff) actualCutoff = thisRcut
295 >
296 >          if (i_is_LJ) then
297 >             thisRcut = getSigma(i) * 2.5_dp
298 >             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
299            endif
300 <          
301 <          if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then
302 < !            thisRCut = getElectrostaticCutOff(map_i,map_j)
296 <             if (thisRcut > actualCutoff) actualCutoff = thisRcut
300 >          if (i_is_Elect) then
301 >             thisRcut = defaultRcut
302 >             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
303            endif
304 +          if (i_is_Sticky) then
305 +             thisRcut = getStickyCut(i)
306 +             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
307 +          endif
308 +          if (i_is_StickyP) then
309 +             thisRcut = getStickyPowerCut(i)
310 +             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
311 +          endif
312 +          if (i_is_GB) then
313 +             thisRcut = getGayBerneCut(i)
314 +             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
315 +          endif
316 +          if (i_is_EAM) then
317 +             thisRcut = getEAMCut(i)
318 +             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
319 +          endif
320 +          if (i_is_Shape) then
321 +             thisRcut = getShapeCut(i)
322 +             if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
323 +          endif
324            
325 <          if ( iand(iMap, STICKY_PAIR).ne.0 ) then
326 < !             thisRCut = getStickyCutOff(map_i,map_j)
327 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
328 <           endif
329 <          
330 <           if ( iand(iMap, STICKYPOWER_PAIR).ne.0 ) then
331 < !              thisRCut = getStickyPowerCutOff(map_i,map_j)
332 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
333 <           endif
334 <          
335 <           if ( iand(iMap, GAYBERNE_PAIR).ne.0 ) then
336 < !              thisRCut = getGayberneCutOff(map_i,map_j)
337 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
338 <           endif
339 <          
340 <           if ( iand(iMap, GAYBERNE_LJ).ne.0 ) then
341 < !              thisRCut = getGaybrneLJCutOff(map_i,map_j)
342 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
343 <           endif
344 <          
345 <           if ( iand(iMap, EAM_PAIR).ne.0 ) then      
346 < !              thisRCut = getEAMCutOff(map_i,map_j)
347 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
348 <           endif
349 <          
350 <           if ( iand(iMap, SHAPE_PAIR).ne.0 ) then      
351 < !              thisRCut = getShapeCutOff(map_i,map_j)
352 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
353 <           endif
354 <          
355 <           if ( iand(iMap, SHAPE_LJ).ne.0 ) then      
356 < !              thisRCut = getShapeLJCutOff(map_i,map_j)
357 <              if (thisRcut > actualCutoff) actualCutoff = thisRcut
358 <           endif
359 <           InteractionMap(map_i, map_j)%rList = actualCutoff
360 <           InteractionMap(map_i, map_j)%rListSq = actualCutoff * actualCutoff
361 <        end do
362 <     end do
363 <          haveRlist = .true.
364 <  end subroutine createRcuts
365 <
366 <
367 < !!! 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
325 >          if (atypeMaxCutoff(i).gt.biggestAtypeCutoff) then
326 >             biggestAtypeCutoff = atypeMaxCutoff(i)
327 >          endif
328 >       endif
329 >    enddo
330 >  
331 >    nGroupTypes = 0
332 >    
333 >    istart = 1
334 > #ifdef IS_MPI
335 >    iend = nGroupsInRow
336 > #else
337 >    iend = nGroups
338 > #endif
339 >    
340 >    !! allocate the groupToGtype and gtypeMaxCutoff here.
341 >    if(.not.allocated(groupToGtype)) then
342 >       allocate(groupToGtype(iend))
343 >       allocate(groupMaxCutoff(iend))
344 >       allocate(gtypeMaxCutoff(iend))
345 >       groupMaxCutoff = 0.0_dp
346 >       gtypeMaxCutoff = 0.0_dp
347 >    endif
348 >    !! first we do a single loop over the cutoff groups to find the
349 >    !! largest cutoff for any atypes present in this group.  We also
350 >    !! create gtypes at this point.
351 >    
352 >    tol = 1.0d-6
353 >    
354 >    do i = istart, iend      
355 >       n_in_i = groupStartRow(i+1) - groupStartRow(i)
356 >       groupMaxCutoff(i) = 0.0_dp
357 >       do ia = groupStartRow(i), groupStartRow(i+1)-1
358 >          atom1 = groupListRow(ia)
359 > #ifdef IS_MPI
360 >          me_i = atid_row(atom1)
361 > #else
362 >          me_i = atid(atom1)
363 > #endif          
364 >          if (atypeMaxCutoff(me_i).gt.groupMaxCutoff(i)) then
365 >             groupMaxCutoff(i)=atypeMaxCutoff(me_i)
366 >          endif          
367 >       enddo
368  
369 +       if (nGroupTypes.eq.0) then
370 +          nGroupTypes = nGroupTypes + 1
371 +          gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
372 +          groupToGtype(i) = nGroupTypes
373 +       else
374 +          GtypeFound = .false.
375 +          do g = 1, nGroupTypes
376 +             if ( abs(groupMaxCutoff(i) - gtypeMaxCutoff(g)).lt.tol) then
377 +                groupToGtype(i) = g
378 +                GtypeFound = .true.
379 +             endif
380 +          enddo
381 +          if (.not.GtypeFound) then            
382 +             nGroupTypes = nGroupTypes + 1
383 +             gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
384 +             groupToGtype(i) = nGroupTypes
385 +          endif
386 +       endif
387 +    enddo    
388  
389 +    !! allocate the gtypeCutoffMap here.
390 +    allocate(gtypeCutoffMap(nGroupTypes,nGroupTypes))
391 +    !! then we do a double loop over all the group TYPES to find the cutoff
392 +    !! map between groups of two types
393 +    
394 +    do i = 1, nGroupTypes
395 +       do j = 1, nGroupTypes
396 +      
397 +          select case(cutoffPolicy)
398 +          case(TRADITIONAL_CUTOFF_POLICY)
399 +             thisRcut = maxval(gtypeMaxCutoff)
400 +          case(MIX_CUTOFF_POLICY)
401 +             thisRcut = 0.5_dp * (gtypeMaxCutoff(i) + gtypeMaxCutoff(j))
402 +          case(MAX_CUTOFF_POLICY)
403 +             thisRcut = max(gtypeMaxCutoff(i), gtypeMaxCutoff(j))
404 +          case default
405 +             call handleError("createGtypeCutoffMap", "Unknown Cutoff Policy")
406 +             return
407 +          end select
408 +          gtypeCutoffMap(i,j)%rcut = thisRcut
409 +          gtypeCutoffMap(i,j)%rcutsq = thisRcut*thisRcut
410 +          skin = defaultRlist - defaultRcut
411 +          gtypeCutoffMap(i,j)%rlistsq = (thisRcut + skin)**2
412 +
413 +       enddo
414 +    enddo
415 +    
416 +    haveGtypeCutoffMap = .true.
417 +   end subroutine createGtypeCutoffMap
418 +
419 +   subroutine setDefaultCutoffs(defRcut, defRsw, defRlist, cutPolicy)
420 +     real(kind=dp),intent(in) :: defRcut, defRsw, defRlist
421 +     integer, intent(in) :: cutPolicy
422 +
423 +     defaultRcut = defRcut
424 +     defaultRsw = defRsw
425 +     defaultRlist = defRlist
426 +     cutoffPolicy = cutPolicy
427 +     rcuti = 1.0_dp / defaultRcut
428 +   end subroutine setDefaultCutoffs
429 +
430 +   subroutine setCutoffPolicy(cutPolicy)
431 +
432 +     integer, intent(in) :: cutPolicy
433 +     cutoffPolicy = cutPolicy
434 +     call createGtypeCutoffMap()
435 +   end subroutine setCutoffPolicy
436 +    
437 +    
438    subroutine setSimVariables()
439      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()
440      SIM_uses_EAM = SimUsesEAM()
364    SIM_uses_Shapes = SimUsesShapes()
365    SIM_uses_FLARB = SimUsesFLARB()
366    SIM_uses_RF = SimUsesRF()
441      SIM_requires_postpair_calc = SimRequiresPostpairCalc()
442      SIM_requires_prepair_calc = SimRequiresPrepairCalc()
443      SIM_uses_PBC = SimUsesPBC()
444 +    SIM_uses_RF = SimUsesRF()
445  
446      haveSIMvariables = .true.
447  
# Line 380 | Line 455 | contains
455  
456      error = 0
457  
458 <    if (.not. haveInteractionMap) then
458 >    if (.not. haveInteractionHash) then      
459 >       myStatus = 0      
460 >       call createInteractionHash(myStatus)      
461 >       if (myStatus .ne. 0) then
462 >          write(default_error, *) 'createInteractionHash failed in doForces!'
463 >          error = -1
464 >          return
465 >       endif
466 >    endif
467  
468 <       myStatus = 0
469 <
470 <       call createInteractionMap(myStatus)
388 <
468 >    if (.not. haveGtypeCutoffMap) then        
469 >       myStatus = 0      
470 >       call createGtypeCutoffMap(myStatus)      
471         if (myStatus .ne. 0) then
472 <          write(default_error, *) 'createInteractionMap failed in doForces!'
472 >          write(default_error, *) 'createGtypeCutoffMap failed in doForces!'
473            error = -1
474            return
475         endif
# Line 397 | Line 479 | contains
479         call setSimVariables()
480      endif
481  
482 <    if (.not. haveRlist) then
483 <       write(default_error, *) 'rList has not been set in doForces!'
484 <       error = -1
485 <       return
486 <    endif
482 >  !  if (.not. haveRlist) then
483 >  !     write(default_error, *) 'rList has not been set in doForces!'
484 >  !     error = -1
485 >  !     return
486 >  !  endif
487  
488      if (.not. haveNeighborList) then
489         write(default_error, *) 'neighbor list has not been initialized in doForces!'
# Line 426 | Line 508 | contains
508    end subroutine doReadyCheck
509  
510  
511 <  subroutine init_FF(use_RF_c, thisStat)
511 >  subroutine init_FF(use_RF, correctionMethod, dampingAlpha, thisStat)
512  
513 <    logical, intent(in) :: use_RF_c
514 <
513 >    logical, intent(in) :: use_RF
514 >    integer, intent(in) :: correctionMethod
515 >    real(kind=dp), intent(in) :: dampingAlpha
516      integer, intent(out) :: thisStat  
517      integer :: my_status, nMatches
518      integer, pointer :: MatchList(:) => null()
# Line 439 | Line 522 | contains
522      thisStat = 0
523  
524      !! Fortran's version of a cast:
525 <    FF_uses_RF = use_RF_c
525 >    FF_uses_RF = use_RF
526  
527 +    !! set the electrostatic correction method
528 +    select case(coulombicCorrection)
529 +    case(NONE)
530 +       corrMethod = 0
531 +    case(UNDAMPED_WOLF)
532 +       corrMethod = 1
533 +    case(WOLF)
534 +       corrMethod = 2
535 +    case (REACTION_FIELD)
536 +       corrMethod = 3
537 +    case default
538 +       call handleError("init_FF", "Unknown Coulombic Correction Method")
539 +       return
540 +    end select
541 +        
542      !! init_FF is called *after* all of the atom types have been
543      !! defined in atype_module using the new_atype subroutine.
544      !!
# Line 448 | Line 546 | contains
546      !! interactions are used by the force field.    
547  
548      FF_uses_DirectionalAtoms = .false.
451    FF_uses_LennardJones = .false.
452    FF_uses_Electrostatics = .false.
453    FF_uses_Charges = .false.    
549      FF_uses_Dipoles = .false.
455    FF_uses_Sticky = .false.
456    FF_uses_StickyPower = .false.
550      FF_uses_GayBerne = .false.
551      FF_uses_EAM = .false.
459    FF_uses_Shapes = .false.
460    FF_uses_FLARB = .false.
552  
553      call getMatchingElementList(atypes, "is_Directional", .true., &
554           nMatches, MatchList)
555      if (nMatches .gt. 0) FF_uses_DirectionalAtoms = .true.
556  
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
557      call getMatchingElementList(atypes, "is_Dipole", .true., &
558           nMatches, MatchList)
559 <    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
559 >    if (nMatches .gt. 0) FF_uses_Dipoles = .true.
560      
561      call getMatchingElementList(atypes, "is_GayBerne", .true., &
562           nMatches, MatchList)
563 <    if (nMatches .gt. 0) then
516 <       FF_uses_GayBerne = .true.
517 <       FF_uses_DirectionalAtoms = .true.
518 <    endif
563 >    if (nMatches .gt. 0) FF_uses_GayBerne = .true.
564  
565      call getMatchingElementList(atypes, "is_EAM", .true., nMatches, MatchList)
566      if (nMatches .gt. 0) FF_uses_EAM = .true.
567  
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
568  
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)
569      haveSaneForceField = .true.
570  
571      !! check to make sure the FF_uses_RF setting makes sense
572  
573 <    if (FF_uses_dipoles) then
573 >    if (FF_uses_Dipoles) then
574         if (FF_uses_RF) then
575            dielect = getDielect()
576            call initialize_rf(dielect)
577         endif
578      else
579 <       if (FF_uses_RF) then          
579 >       if ((corrMethod == 3) .or. FF_uses_RF) then
580            write(default_error,*) 'Using Reaction Field with no dipoles?  Huh?'
581            thisStat = -1
582            haveSaneForceField = .false.
583            return
584         endif
585      endif
552
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
586  
587      if (FF_uses_EAM) then
588         call init_EAM_FF(my_status)
# Line 579 | Line 603 | contains
603         endif
604      endif
605  
582    if (FF_uses_GayBerne .and. FF_uses_LennardJones) then
583    endif
584
606      if (.not. haveNeighborList) then
607         !! Create neighbor lists
608         call expandNeighborList(nLocal, my_status)
# Line 645 | Line 666 | contains
666      integer :: localError
667      integer :: propPack_i, propPack_j
668      integer :: loopStart, loopEnd, loop
669 <    integer :: iMap
669 >    integer :: iHash
670      real(kind=dp) :: listSkin = 1.0  
671  
672      !! initialize local variables  
# Line 743 | Line 764 | contains
764  
765            if (update_nlist) then
766   #ifdef IS_MPI
746             me_i = atid_row(i)
767               jstart = 1
768               jend = nGroupsInCol
769   #else
750             me_i = atid(i)
770               jstart = i+1
771               jend = nGroups
772   #endif
# Line 775 | Line 794 | contains
794                    q_group(:,j), d_grp, rgrpsq)
795   #endif
796  
797 <             if (rgrpsq < InteractionMap(me_i,me_j)%rListsq) then
797 >             if (rgrpsq < gtypeCutoffMap(groupToGtype(i),groupToGtype(j))%rListsq) then
798                  if (update_nlist) then
799                     nlist = nlist + 1
800  
# Line 975 | Line 994 | contains
994  
995      if (FF_RequiresPostpairCalc() .and. SIM_requires_postpair_calc) then
996  
997 <       if (FF_uses_RF .and. SIM_uses_RF) then
997 >       if ((FF_uses_RF .and. SIM_uses_RF) .or. (corrMethod == 3)) then
998  
999   #ifdef IS_MPI
1000            call scatter(rf_Row,rf,plan_atom_row_3d)
# Line 993 | Line 1012 | contains
1012   #else
1013               me_i = atid(i)
1014   #endif
1015 <             iMap = InteractionMap(me_i, me_j)%InteractionHash
1015 >             iHash = InteractionHash(me_i,me_j)
1016              
1017 <             if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then
1017 >             if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1018  
1019                  mu_i = getDipoleMoment(me_i)
1020  
# Line 1059 | Line 1078 | contains
1078      real ( kind = dp ), intent(inout) :: rijsq
1079      real ( kind = dp )                :: r
1080      real ( kind = dp ), intent(inout) :: d(3)
1062    real ( kind = dp ) :: ebalance
1081      integer :: me_i, me_j
1082  
1083 <    integer :: iMap
1083 >    integer :: iHash
1084  
1085      r = sqrt(rijsq)
1086      vpair = 0.0d0
# Line 1076 | Line 1094 | contains
1094      me_j = atid(j)
1095   #endif
1096  
1097 <    iMap = InteractionMap(me_i, me_j)%InteractionHash
1097 >    iHash = InteractionHash(me_i, me_j)
1098  
1099 <    if ( iand(iMap, LJ_PAIR).ne.0 ) then
1099 >    if ( iand(iHash, LJ_PAIR).ne.0 ) then
1100         call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, do_pot)
1101      endif
1102  
1103 <    if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then
1103 >    if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1104         call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1105 <            pot, eFrame, f, t, do_pot)
1105 >            pot, eFrame, f, t, do_pot, corrMethod, rcuti)
1106  
1107 <       if (FF_uses_RF .and. SIM_uses_RF) then
1107 >       if ((FF_uses_RF .and. SIM_uses_RF) .or. (corrMethod == 3)) then
1108  
1109            ! CHECK ME (RF needs to know about all electrostatic types)
1110            call accumulate_rf(i, j, r, eFrame, sw)
# Line 1095 | Line 1113 | contains
1113  
1114      endif
1115  
1116 <    if ( iand(iMap, STICKY_PAIR).ne.0 ) then
1116 >    if ( iand(iHash, STICKY_PAIR).ne.0 ) then
1117         call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1118              pot, A, f, t, do_pot)
1119      endif
1120  
1121 <    if ( iand(iMap, STICKYPOWER_PAIR).ne.0 ) then
1121 >    if ( iand(iHash, STICKYPOWER_PAIR).ne.0 ) then
1122         call do_sticky_power_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1123              pot, A, f, t, do_pot)
1124      endif
1125  
1126 <    if ( iand(iMap, GAYBERNE_PAIR).ne.0 ) then
1126 >    if ( iand(iHash, GAYBERNE_PAIR).ne.0 ) then
1127         call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1128              pot, A, f, t, do_pot)
1129      endif
1130      
1131 <    if ( iand(iMap, GAYBERNE_LJ).ne.0 ) then
1131 >    if ( iand(iHash, GAYBERNE_LJ).ne.0 ) then
1132   !      call do_gblj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1133   !           pot, A, f, t, do_pot)
1134      endif
1135  
1136 <    if ( iand(iMap, EAM_PAIR).ne.0 ) then      
1136 >    if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1137         call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, &
1138              do_pot)
1139      endif
1140  
1141 <    if ( iand(iMap, SHAPE_PAIR).ne.0 ) then      
1141 >    if ( iand(iHash, SHAPE_PAIR).ne.0 ) then      
1142         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1143              pot, A, f, t, do_pot)
1144      endif
1145  
1146 <    if ( iand(iMap, SHAPE_LJ).ne.0 ) then      
1146 >    if ( iand(iHash, SHAPE_LJ).ne.0 ) then      
1147         call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1148              pot, A, f, t, do_pot)
1149      endif
# Line 1147 | Line 1165 | contains
1165      real ( kind = dp )                :: r, rc
1166      real ( kind = dp ), intent(inout) :: d(3), dc(3)
1167  
1168 <    integer :: me_i, me_j, iMap
1168 >    integer :: me_i, me_j, iHash
1169  
1170 +    r = sqrt(rijsq)
1171 +
1172   #ifdef IS_MPI  
1173      me_i = atid_row(i)
1174      me_j = atid_col(j)  
# Line 1157 | Line 1177 | contains
1177      me_j = atid(j)  
1178   #endif
1179  
1180 <    iMap = InteractionMap(me_i, me_j)%InteractionHash
1180 >    iHash = InteractionHash(me_i, me_j)
1181  
1182 <    if ( iand(iMap, EAM_PAIR).ne.0 ) then      
1182 >    if ( iand(iHash, EAM_PAIR).ne.0 ) then      
1183              call calc_EAM_prepair_rho(i, j, d, r, rijsq )
1184      endif
1185      
# Line 1356 | Line 1376 | contains
1376  
1377    function FF_UsesDirectionalAtoms() result(doesit)
1378      logical :: doesit
1379 <    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
1379 >    doesit = FF_uses_DirectionalAtoms
1380    end function FF_UsesDirectionalAtoms
1381  
1382    function FF_RequiresPrepairCalc() result(doesit)
# Line 1369 | Line 1387 | contains
1387    function FF_RequiresPostpairCalc() result(doesit)
1388      logical :: doesit
1389      doesit = FF_uses_RF
1390 +    if (corrMethod == 3) doesit = .true.
1391    end function FF_RequiresPostpairCalc
1392  
1393   #ifdef PROFILE

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines