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 2260 by chuckv, Mon Jun 27 22:21:37 2005 UTC vs.
Revision 2269 by chuckv, Tue Aug 9 19:40:56 2005 UTC

# Line 45 | Line 45
45  
46   !! @author Charles F. Vardeman II
47   !! @author Matthew Meineke
48 < !! @version $Id: doForces.F90,v 1.21 2005-06-27 22:21:37 chuckv Exp $, $Date: 2005-06-27 22:21:37 $, $Name: not supported by cvs2svn $, $Revision: 1.21 $
48 > !! @version $Id: doForces.F90,v 1.27 2005-08-09 19:40:56 chuckv Exp $, $Date: 2005-08-09 19:40:56 $, $Name: not supported by cvs2svn $, $Revision: 1.27 $
49  
50  
51   module doForces
# Line 81 | Line 81 | module doForces
81    logical, save :: haveRlist = .false.
82    logical, save :: haveNeighborList = .false.
83    logical, save :: haveSIMvariables = .false.
84  logical, save :: havePropertyMap = .false.
84    logical, save :: haveSaneForceField = .false.
85 +  logical, save :: haveInteractionMap = .false.
86  
87    logical, save :: FF_uses_DirectionalAtoms
88    logical, save :: FF_uses_LennardJones
# Line 116 | Line 116 | module doForces
116    logical, save :: SIM_uses_PBC
117    logical, save :: SIM_uses_molecular_cutoffs
118  
119  !!!GO AWAY---------
120  !!!!!real(kind=dp), save :: rlist, rlistsq
119  
120    public :: init_FF
121    public :: do_force_loop
122   !  public :: setRlistDF
123 +  !public :: addInteraction
124 +  !public :: setInteractionHash
125 +  !public :: getInteractionHash
126 +  public :: createInteractionMap
127 +  public :: createGroupCutoffs
128  
129   #ifdef PROFILE
130    public :: getforcetime
# Line 129 | Line 132 | module doForces
132    real :: forceTimeInitial, forceTimeFinal
133    integer :: nLoops
134   #endif
132
133  type :: Properties
134     logical :: is_Directional   = .false.
135     logical :: is_LennardJones  = .false.
136     logical :: is_Electrostatic = .false.
137     logical :: is_Charge        = .false.
138     logical :: is_Dipole        = .false.
139     logical :: is_Quadrupole    = .false.
140     logical :: is_Sticky        = .false.
141     logical :: is_StickyPower   = .false.
142     logical :: is_GayBerne      = .false.
143     logical :: is_EAM           = .false.
144     logical :: is_Shape         = .false.
145     logical :: is_FLARB         = .false.
146  end type Properties
147
148  type(Properties), dimension(:),allocatable :: PropertyMap
149
150
135    
136 <  type, public :: Interaction
137 <     integer :: InteractionHash
138 <     real(kind=dp) :: rCut
139 <  end type Interaction
140 <  
141 <  type(Interaction), public, dimension(:,:), allocatable :: InteractionMap
142 <  
143 <  !public :: addInteraction
144 <  !public :: setInteractionHash
145 <  !public :: getInteractionHash
146 <  public :: createInteractionMap
136 > !! Variables for cutoff mapping and interaction mapping
137 > ! Bit hash to determine pair-pair interactions.
138 >  integer, dimension(:,:),allocatable :: InteractionHash
139 > !! Cuttoffs in OOPSE are handled on a Group-Group pair basis.
140 > ! Largest cutoff for atypes for all potentials
141 >  real(kind=dp), dimension(:), allocatable :: atypeMaxCuttoff
142 > ! Largest cutoff for groups
143 >  real(kind=dp), dimension(:), allocatable :: groupMaxCutoff
144 > ! Group to Gtype transformation Map
145 >  integer,dimension(:), allocatable :: groupToGtype
146 > ! Group Type Max Cutoff
147 >  real(kind=dp), dimension(:), allocatable :: gtypeMaxCutoff
148 > ! GroupType definition
149 >  type ::gtype
150 >     real(kind=dp) :: rcut ! Group Cutoff
151 >     real(kind=dp) :: rcutsq ! Group Cutoff Squared
152 >     real(kind=dp) :: rlistsq ! List cutoff Squared    
153 >  end type gtype
154  
155 +  type(gtype), dimension(:,:), allocatable :: gtypeCutoffMap
156 +  
157   contains
158  
159  
160    subroutine createInteractionMap(status)
161      integer :: nAtypes
162 <    integer :: status
162 >    integer, intent(out) :: status
163      integer :: i
164      integer :: j
165      integer :: ihash
166      real(kind=dp) :: myRcut
167 < ! Test Types
167 >    !! Test Types
168      logical :: i_is_LJ
169      logical :: i_is_Elect
170      logical :: i_is_Sticky
# Line 187 | Line 180 | contains
180      logical :: j_is_EAM
181      logical :: j_is_Shape
182      
183 <    
183 >    status = 0  
184 >
185      if (.not. associated(atypes)) then
186 <       call handleError("atype", "atypes was not present before call of createDefaultInteractionMap!")
186 >       call handleError("atype", "atypes was not present before call of createDefaultInteractionHash!")
187         status = -1
188         return
189      endif
# Line 201 | Line 195 | contains
195         return
196      end if
197  
198 <    if (.not. allocated(InteractionMap)) then
199 <       allocate(InteractionMap(nAtypes,nAtypes))
198 >    if (.not. allocated(InteractionHash)) then
199 >       allocate(InteractionHash(nAtypes,nAtypes))
200      endif
201          
202      do i = 1, nAtypes
# Line 228 | Line 222 | contains
222            call getElementProperty(atypes, j, "is_Shape", j_is_Shape)
223  
224            if (i_is_LJ .and. j_is_LJ) then
225 <             iHash = ior(iHash, LJ_PAIR)
232 <            
233 <
234 <
225 >             iHash = ior(iHash, LJ_PAIR)            
226            endif
227 <
227 >          
228 >          if (i_is_Elect .and. j_is_Elect) then
229 >             iHash = ior(iHash, ELECTROSTATIC_PAIR)
230 >          endif
231 >          
232 >          if (i_is_Sticky .and. j_is_Sticky) then
233 >             iHash = ior(iHash, STICKY_PAIR)
234 >          endif
235  
236 +          if (i_is_StickyP .and. j_is_StickyP) then
237 +             iHash = ior(iHash, STICKYPOWER_PAIR)
238 +          endif
239  
240 <          if (i_is_Elect .and. j_is_Elect) iHash = ior(iHash, ELECTROSTATIC_PAIR)
241 <          if (i_is_Sticky .and. j_is_Sticky) iHash = ior(iHash, STICKY_PAIR)
242 <          if (i_is_StickyP .and. j_is_StickyP) iHash = ior(iHash, STICKYPOWER_PAIR)
240 >          if (i_is_EAM .and. j_is_EAM) then
241 >             iHash = ior(iHash, EAM_PAIR)
242 >          endif
243  
243          if (i_is_EAM .and. j_is_EAM) iHash = ior(iHash, EAM_PAIR)
244
244            if (i_is_GB .and. j_is_GB) iHash = ior(iHash, GAYBERNE_PAIR)
245            if (i_is_GB .and. j_is_LJ) iHash = ior(iHash, GAYBERNE_LJ)
246            if (i_is_LJ .and. j_is_GB) iHash = ior(iHash, GAYBERNE_LJ)
# Line 251 | Line 250 | contains
250            if (i_is_LJ .and. j_is_Shape) iHash = ior(iHash, SHAPE_LJ)
251  
252  
253 <          InteractionMap(i,j)%InteractionHash = iHash
254 <          InteractionMap(j,i)%InteractionHash = iHash
253 >          InteractionHash(i,j) = iHash
254 >          InteractionHash(j,i) = iHash
255  
256         end do
257  
258      end do
259 +
260 +    haveInteractionMap = .true.
261    end subroutine createInteractionMap
262  
263 +  subroutine createGroupCutoffs(skinThickness,defaultrList,stat)
264 +    real(kind=dp), intent(in), optional :: defaultRList
265 +    real(kind-dp), intent(in), :: skinThickenss
266 +  ! Query each potential and return the cutoff for that potential. We
267 +  ! build the neighbor list based on the largest cutoff value for that
268 +  ! atype. Each potential can decide whether to calculate the force for
269 +  ! that atype based upon it's own cutoff.
270 +  
271  
272 +    real(kind=dp), intent(in), optional :: defaultRCut, defaultSkinThickness
273  
274 < !!! THIS GOES AWAY FOR SIZE DEPENDENT CUTOFF
275 < !!$  subroutine setRlistDF( this_rlist )
276 < !!$
277 < !!$   real(kind=dp) :: this_rlist
278 < !!$
269 < !!$    rlist = this_rlist
270 < !!$    rlistsq = rlist * rlist
271 < !!$
272 < !!$    haveRlist = .true.
273 < !!$
274 < !!$  end subroutine setRlistDF
275 <
276 <  subroutine createPropertyMap(status)
274 >    integer :: iMap
275 >    integer :: map_i,map_j
276 >    real(kind=dp) :: thisRCut = 0.0_dp
277 >    real(kind=dp) :: actualCutoff = 0.0_dp
278 >    integer, intent(out) :: stat
279      integer :: nAtypes
280 <    integer :: status
279 <    integer :: i
280 <    logical :: thisProperty
281 <    real (kind=DP) :: thisDPproperty
280 >    integer :: myStatus
281  
282 <    status = 0
282 >    stat = 0
283 >    if (.not. haveInteractionMap) then
284  
285 <    nAtypes = getSize(atypes)
285 >       call createInteractionMap(myStatus)
286  
287 <    if (nAtypes == 0) then
288 <       status = -1
289 <       return
290 <    end if
291 <
292 <    if (.not. allocated(PropertyMap)) then
293 <       allocate(PropertyMap(nAtypes))
287 >       if (myStatus .ne. 0) then
288 >          write(default_error, *) 'createInteractionMap failed in doForces!'
289 >          stat = -1
290 >          return
291 >       endif
292      endif
293  
294 <    do i = 1, nAtypes
295 <       call getElementProperty(atypes, i, "is_Directional", thisProperty)
296 <       PropertyMap(i)%is_Directional = thisProperty
294 >    nAtypes = getSize(atypes)
295 >    !! If we pass a default rcut, set all atypes to that cutoff distance
296 >    if(present(defaultRList)) then
297 >       InteractionMap(:,:)%rCut = defaultRCut
298 >       InteractionMap(:,:)%rCutSq = defaultRCut*defaultRCut
299 >       InteractionMap(:,:)%rListSq = (defaultRCut+defaultSkinThickness)**2
300 >       haveRlist = .true.
301 >       return
302 >    end if
303  
304 <       call getElementProperty(atypes, i, "is_LennardJones", thisProperty)
305 <       PropertyMap(i)%is_LennardJones = thisProperty
304 >    do map_i = 1,nAtypes
305 >       do map_j = map_i,nAtypes
306 >          iMap = InteractionMap(map_i, map_j)%InteractionHash
307 >          
308 >          if ( iand(iMap, LJ_PAIR).ne.0 ) then
309 >             ! thisRCut = getLJCutOff(map_i,map_j)
310 >             if (thisRcut > actualCutoff) actualCutoff = thisRcut
311 >          endif
312 >          
313 >          if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then
314 >             ! thisRCut = getElectrostaticCutOff(map_i,map_j)
315 >             if (thisRcut > actualCutoff) actualCutoff = thisRcut
316 >          endif
317 >          
318 >          if ( iand(iMap, STICKY_PAIR).ne.0 ) then
319 >             ! thisRCut = getStickyCutOff(map_i,map_j)
320 >              if (thisRcut > actualCutoff) actualCutoff = thisRcut
321 >           endif
322 >          
323 >           if ( iand(iMap, STICKYPOWER_PAIR).ne.0 ) then
324 >              ! thisRCut = getStickyPowerCutOff(map_i,map_j)
325 >              if (thisRcut > actualCutoff) actualCutoff = thisRcut
326 >           endif
327 >          
328 >           if ( iand(iMap, GAYBERNE_PAIR).ne.0 ) then
329 >              ! thisRCut = getGayberneCutOff(map_i,map_j)
330 >              if (thisRcut > actualCutoff) actualCutoff = thisRcut
331 >           endif
332 >          
333 >           if ( iand(iMap, GAYBERNE_LJ).ne.0 ) then
334 > !              thisRCut = getGaybrneLJCutOff(map_i,map_j)
335 >              if (thisRcut > actualCutoff) actualCutoff = thisRcut
336 >           endif
337 >          
338 >           if ( iand(iMap, EAM_PAIR).ne.0 ) then      
339 > !              thisRCut = getEAMCutOff(map_i,map_j)
340 >              if (thisRcut > actualCutoff) actualCutoff = thisRcut
341 >           endif
342 >          
343 >           if ( iand(iMap, SHAPE_PAIR).ne.0 ) then      
344 > !              thisRCut = getShapeCutOff(map_i,map_j)
345 >              if (thisRcut > actualCutoff) actualCutoff = thisRcut
346 >           endif
347 >          
348 >           if ( iand(iMap, SHAPE_LJ).ne.0 ) then      
349 > !              thisRCut = getShapeLJCutOff(map_i,map_j)
350 >              if (thisRcut > actualCutoff) actualCutoff = thisRcut
351 >           endif
352 >           InteractionMap(map_i, map_j)%rCut = actualCutoff
353 >           InteractionMap(map_i, map_j)%rCutSq = actualCutoff * actualCutoff
354 >           InteractionMap(map_i, map_j)%rListSq = (actualCutoff + skinThickness)**2
355  
356 <       call getElementProperty(atypes, i, "is_Electrostatic", thisProperty)
357 <       PropertyMap(i)%is_Electrostatic = thisProperty
356 >           InteractionMap(map_j, map_i)%rCut = InteractionMap(map_i, map_j)%rCut
357 >           InteractionMap(map_j, map_i)%rCutSq = InteractionMap(map_i, map_j)%rCutSq
358 >           InteractionMap(map_j, map_i)%rListSq = InteractionMap(map_i, map_j)%rListSq
359 >        end do
360 >     end do
361 >     ! now the groups
362  
306       call getElementProperty(atypes, i, "is_Charge", thisProperty)
307       PropertyMap(i)%is_Charge = thisProperty
363  
309       call getElementProperty(atypes, i, "is_Dipole", thisProperty)
310       PropertyMap(i)%is_Dipole = thisProperty
364  
365 <       call getElementProperty(atypes, i, "is_Quadrupole", thisProperty)
366 <       PropertyMap(i)%is_Quadrupole = thisProperty
314 <
315 <       call getElementProperty(atypes, i, "is_Sticky", thisProperty)
316 <       PropertyMap(i)%is_Sticky = thisProperty
317 <      
318 <       call getElementProperty(atypes, i, "is_StickyPower", thisProperty)
319 <       PropertyMap(i)%is_StickyPower = thisProperty
365 >     haveRlist = .true.
366 >   end subroutine createGroupCutoffs
367  
321       call getElementProperty(atypes, i, "is_GayBerne", thisProperty)
322       PropertyMap(i)%is_GayBerne = thisProperty
323
324       call getElementProperty(atypes, i, "is_EAM", thisProperty)
325       PropertyMap(i)%is_EAM = thisProperty
326
327       call getElementProperty(atypes, i, "is_Shape", thisProperty)
328       PropertyMap(i)%is_Shape = thisProperty
329
330       call getElementProperty(atypes, i, "is_FLARB", thisProperty)
331       PropertyMap(i)%is_FLARB = thisProperty
332    end do
333
334    havePropertyMap = .true.
335
336  end subroutine createPropertyMap
337
368    subroutine setSimVariables()
369      SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
370      SIM_uses_LennardJones = SimUsesLennardJones()
# Line 364 | Line 394 | contains
394  
395      error = 0
396  
397 <    if (.not. havePropertyMap) then
398 <
399 <       myStatus = 0
400 <
401 <       call createPropertyMap(myStatus)
372 <
397 >    if (.not. haveInteractionMap) then
398 >      
399 >       myStatus = 0      
400 >       call createInteractionMap(myStatus)
401 >      
402         if (myStatus .ne. 0) then
403 <          write(default_error, *) 'createPropertyMap failed in doForces!'
403 >          write(default_error, *) 'createInteractionMap failed in doForces!'
404            error = -1
405            return
406         endif
# Line 629 | Line 658 | contains
658      integer :: localError
659      integer :: propPack_i, propPack_j
660      integer :: loopStart, loopEnd, loop
661 <
661 >    integer :: iMap
662      real(kind=dp) :: listSkin = 1.0  
663  
664      !! initialize local variables  
# Line 721 | Line 750 | contains
750   #endif
751         outer: do i = istart, iend
752  
753 + #ifdef IS_MPI
754 +             me_i = atid_row(i)
755 + #else
756 +             me_i = atid(i)
757 + #endif
758 +
759            if (update_nlist) point(i) = nlist + 1
760  
761            n_in_i = groupStartRow(i+1) - groupStartRow(i)
# Line 748 | Line 783 | contains
783               endif
784  
785   #ifdef IS_MPI
786 +             me_j = atid_col(j)
787               call get_interatomic_vector(q_group_Row(:,i), &
788                    q_group_Col(:,j), d_grp, rgrpsq)
789   #else
790 +             me_j = atid(j)
791               call get_interatomic_vector(q_group(:,i), &
792                    q_group(:,j), d_grp, rgrpsq)
793   #endif
794  
795 <             if (rgrpsq < rlistsq) then
795 >             if (rgrpsq < InteractionMap(me_i,me_j)%rListsq) then
796                  if (update_nlist) then
797                     nlist = nlist + 1
798  
# Line 973 | Line 1010 | contains
1010   #else
1011               me_i = atid(i)
1012   #endif
1013 <
1014 <             if (PropertyMap(me_i)%is_Dipole) then
1013 >             iMap = InteractionHash(me_i,me_j)
1014 >            
1015 >             if ( iand(iMap, ELECTROSTATIC_PAIR).ne.0 ) then
1016  
1017                  mu_i = getDipoleMoment(me_i)
1018  
# Line 1065 | Line 1103 | contains
1103         call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1104              pot, eFrame, f, t, do_pot)
1105  
1106 <       if (FF_uses_dipoles .and. SIM_uses_dipoles) then                
1107 <          if ( PropertyMap(me_i)%is_Dipole .and. &
1108 <               PropertyMap(me_j)%is_Dipole) then
1109 <             if (FF_uses_RF .and. SIM_uses_RF) then
1110 <                call accumulate_rf(i, j, r, eFrame, sw)
1073 <                call rf_correct_forces(i, j, d, r, eFrame, sw, f, fpair)
1074 <             endif
1075 <          endif
1106 >       if (FF_uses_RF .and. SIM_uses_RF) then
1107 >
1108 >          ! CHECK ME (RF needs to know about all electrostatic types)
1109 >          call accumulate_rf(i, j, r, eFrame, sw)
1110 >          call rf_correct_forces(i, j, d, r, eFrame, sw, f, fpair)
1111         endif
1112 +
1113      endif
1114  
1115      if ( iand(iMap, STICKY_PAIR).ne.0 ) then
# Line 1092 | Line 1128 | contains
1128      endif
1129      
1130      if ( iand(iMap, GAYBERNE_LJ).ne.0 ) then
1131 <       call do_gblj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1132 <            pot, A, f, t, do_pot)
1131 > !      call do_gblj_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
1132 > !           pot, A, f, t, do_pot)
1133      endif
1134  
1135      if ( iand(iMap, EAM_PAIR).ne.0 ) then      

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines