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 2280 by gezelter, Thu Sep 1 20:17:55 2005 UTC vs.
Revision 2306 by chrisfen, Fri Sep 16 20:37:05 2005 UTC

# Line 45 | Line 45
45  
46   !! @author Charles F. Vardeman II
47   !! @author Matthew Meineke
48 < !! @version $Id: doForces.F90,v 1.34 2005-09-01 20:17:55 gezelter Exp $, $Date: 2005-09-01 20:17:55 $, $Name: not supported by cvs2svn $, $Revision: 1.34 $
48 > !! @version $Id: doForces.F90,v 1.45 2005-09-16 20:36:55 chrisfen Exp $, $Date: 2005-09-16 20:36:55 $, $Name: not supported by cvs2svn $, $Revision: 1.45 $
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 91 | Line 91 | module doForces
91    logical, save :: FF_uses_Dipoles
92    logical, save :: FF_uses_GayBerne
93    logical, save :: FF_uses_EAM
94  logical, save :: FF_uses_RF
94  
95    logical, save :: SIM_uses_DirectionalAtoms
96    logical, save :: SIM_uses_EAM
98  logical, save :: SIM_uses_RF
97    logical, save :: SIM_requires_postpair_calc
98    logical, save :: SIM_requires_prepair_calc
99    logical, save :: SIM_uses_PBC
100  
101 <  integer, save :: corrMethod
101 >  integer, save :: electrostaticSummationMethod
102  
103    public :: init_FF
104    public :: setDefaultCutoffs
# Line 136 | Line 134 | module doForces
134  
135    integer, save :: cutoffPolicy = TRADITIONAL_CUTOFF_POLICY
136    real(kind=dp),save :: defaultRcut, defaultRsw, defaultRlist
137 +  real(kind=dp),save :: rcuti
138    
139   contains
140  
# Line 256 | Line 255 | contains
255      logical :: i_is_GB
256      logical :: i_is_EAM
257      logical :: i_is_Shape
258 +    logical :: GtypeFound
259  
260      integer :: myStatus, nAtypes,  i, j, istart, iend, jstart, jend
261      integer :: n_in_i, me_i, ia, g, atom1, nGroupTypes
262 +    integer :: nGroupsInRow
263      real(kind=dp):: thisSigma, bigSigma, thisRcut, tol, skin
264      real(kind=dp) :: biggestAtypeCutoff
265  
# Line 271 | Line 272 | contains
272            return
273         endif
274      endif
275 <
275 > #ifdef IS_MPI
276 >    nGroupsInRow = getNgroupsInRow(plan_group_row)
277 > #endif
278      nAtypes = getSize(atypes)
279 <    
279 > ! Set all of the initial cutoffs to zero.
280 >    atypeMaxCutoff = 0.0_dp
281      do i = 1, nAtypes
282 <       if (SimHasAtype(i)) then          
282 >       if (SimHasAtype(i)) then    
283            call getElementProperty(atypes, i, "is_LennardJones", i_is_LJ)
284            call getElementProperty(atypes, i, "is_Electrostatic", i_is_Elect)
285            call getElementProperty(atypes, i, "is_Sticky", i_is_Sticky)
# Line 284 | Line 288 | contains
288            call getElementProperty(atypes, i, "is_EAM", i_is_EAM)
289            call getElementProperty(atypes, i, "is_Shape", i_is_Shape)
290            
291 +
292            if (i_is_LJ) then
293               thisRcut = getSigma(i) * 2.5_dp
294               if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
# Line 327 | Line 332 | contains
332   #else
333      iend = nGroups
334   #endif
335 <
335 >    
336      !! allocate the groupToGtype and gtypeMaxCutoff here.
337 +    if(.not.allocated(groupToGtype)) then
338 +       allocate(groupToGtype(iend))
339 +       allocate(groupMaxCutoff(iend))
340 +       allocate(gtypeMaxCutoff(iend))
341 +       groupMaxCutoff = 0.0_dp
342 +       gtypeMaxCutoff = 0.0_dp
343 +    endif
344 +    !! first we do a single loop over the cutoff groups to find the
345 +    !! largest cutoff for any atypes present in this group.  We also
346 +    !! create gtypes at this point.
347      
333    !! first we do a single loop over the cutoff groups to find the largest cutoff for any atypes
334    !! present in this group.   We also create gtypes at this point.
348      tol = 1.0d-6
349      
350      do i = istart, iend      
# Line 346 | Line 359 | contains
359   #endif          
360            if (atypeMaxCutoff(me_i).gt.groupMaxCutoff(i)) then
361               groupMaxCutoff(i)=atypeMaxCutoff(me_i)
362 <          endif
362 >          endif          
363         enddo
364 +
365         if (nGroupTypes.eq.0) then
366            nGroupTypes = nGroupTypes + 1
367            gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
368            groupToGtype(i) = nGroupTypes
369         else
370 +          GtypeFound = .false.
371            do g = 1, nGroupTypes
372 <             if ( abs(groupMaxCutoff(i) - gtypeMaxCutoff(g)).gt.tol) then
358 <                nGroupTypes = nGroupTypes + 1
359 <                gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
360 <                groupToGtype(i) = nGroupTypes
361 <             else
372 >             if ( abs(groupMaxCutoff(i) - gtypeMaxCutoff(g)).lt.tol) then
373                  groupToGtype(i) = g
374 +                GtypeFound = .true.
375               endif
376            enddo
377 +          if (.not.GtypeFound) then            
378 +             nGroupTypes = nGroupTypes + 1
379 +             gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
380 +             groupToGtype(i) = nGroupTypes
381 +          endif
382         endif
383 <    enddo
367 <    
368 <    !! allocate the gtypeCutoffMap here.
383 >    enddo    
384  
385 +    !! allocate the gtypeCutoffMap here.
386 +    allocate(gtypeCutoffMap(nGroupTypes,nGroupTypes))
387      !! then we do a double loop over all the group TYPES to find the cutoff
388      !! map between groups of two types
389      
# Line 374 | Line 391 | contains
391         do j = 1, nGroupTypes
392        
393            select case(cutoffPolicy)
394 <             case(TRADITIONAL_CUTOFF_POLICY)
395 <                thisRcut = maxval(gtypeMaxCutoff)
396 <             case(MIX_CUTOFF_POLICY)
397 <                thisRcut = 0.5_dp * (gtypeMaxCutoff(i) + gtypeMaxCutoff(j))
398 <             case(MAX_CUTOFF_POLICY)
399 <                thisRcut = max(gtypeMaxCutoff(i), gtypeMaxCutoff(j))
400 <             case default
401 <                call handleError("createGtypeCutoffMap", "Unknown Cutoff Policy")
402 <                return
403 <          end select      
404 <         gtypeCutoffMap(i,j)%rcut = thisRcut
405 <         gtypeCutoffMap(i,j)%rcutsq = thisRcut*thisRcut
406 <         skin = defaultRlist - defaultRcut
407 <         gtypeCutoffMap(i,j)%rlistsq = (thisRcut + skin)**2
394 >          case(TRADITIONAL_CUTOFF_POLICY)
395 >             thisRcut = maxval(gtypeMaxCutoff)
396 >          case(MIX_CUTOFF_POLICY)
397 >             thisRcut = 0.5_dp * (gtypeMaxCutoff(i) + gtypeMaxCutoff(j))
398 >          case(MAX_CUTOFF_POLICY)
399 >             thisRcut = max(gtypeMaxCutoff(i), gtypeMaxCutoff(j))
400 >          case default
401 >             call handleError("createGtypeCutoffMap", "Unknown Cutoff Policy")
402 >             return
403 >          end select
404 >          gtypeCutoffMap(i,j)%rcut = thisRcut
405 >          gtypeCutoffMap(i,j)%rcutsq = thisRcut*thisRcut
406 >          skin = defaultRlist - defaultRcut
407 >          gtypeCutoffMap(i,j)%rlistsq = (thisRcut + skin)**2
408 >
409         enddo
410      enddo
411      
# Line 402 | Line 420 | contains
420       defaultRsw = defRsw
421       defaultRlist = defRlist
422       cutoffPolicy = cutPolicy
423 +     rcuti = 1.0_dp / defaultRcut
424     end subroutine setDefaultCutoffs
425  
426     subroutine setCutoffPolicy(cutPolicy)
# Line 409 | Line 428 | contains
428       integer, intent(in) :: cutPolicy
429       cutoffPolicy = cutPolicy
430       call createGtypeCutoffMap()
412
431     end subroutine setCutoffPolicy
432      
433      
434    subroutine setSimVariables()
435      SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
436      SIM_uses_EAM = SimUsesEAM()
419    SIM_uses_RF = SimUsesRF()
437      SIM_requires_postpair_calc = SimRequiresPostpairCalc()
438      SIM_requires_prepair_calc = SimRequiresPrepairCalc()
439      SIM_uses_PBC = SimUsesPBC()
# Line 457 | Line 474 | contains
474         call setSimVariables()
475      endif
476  
477 <    if (.not. haveRlist) then
478 <       write(default_error, *) 'rList has not been set in doForces!'
479 <       error = -1
480 <       return
481 <    endif
477 >  !  if (.not. haveRlist) then
478 >  !     write(default_error, *) 'rList has not been set in doForces!'
479 >  !     error = -1
480 >  !     return
481 >  !  endif
482  
483      if (.not. haveNeighborList) then
484         write(default_error, *) 'neighbor list has not been initialized in doForces!'
# Line 486 | Line 503 | contains
503    end subroutine doReadyCheck
504  
505  
506 <  subroutine init_FF(use_RF, use_UW, use_DW, thisStat)
506 >  subroutine init_FF(thisESM, dampingAlpha, thisStat)
507  
508 <    logical, intent(in) :: use_RF
509 <    logical, intent(in) :: use_UW
493 <    logical, intent(in) :: use_DW
508 >    integer, intent(in) :: thisESM
509 >    real(kind=dp), intent(in) :: dampingAlpha
510      integer, intent(out) :: thisStat  
511      integer :: my_status, nMatches
496    integer :: corrMethod
512      integer, pointer :: MatchList(:) => null()
513      real(kind=dp) :: rcut, rrf, rt, dielect
514  
515      !! assume things are copacetic, unless they aren't
516      thisStat = 0
517  
518 <    !! Fortran's version of a cast:
504 <    FF_uses_RF = use_RF
518 >    electrostaticSummationMethod = thisESM
519  
506    !! set the electrostatic correction method
507    if (use_UW) then
508       corrMethod = 1
509    elseif (use_DW) then
510       corrMethod = 2
511    else
512       corrMethod = 0
513    endif
514    
520      !! init_FF is called *after* all of the atom types have been
521      !! defined in atype_module using the new_atype subroutine.
522      !!
# Line 541 | Line 546 | contains
546  
547      haveSaneForceField = .true.
548  
549 <    !! check to make sure the FF_uses_RF setting makes sense
549 >    !! check to make sure the reaction field setting makes sense
550  
551      if (FF_uses_Dipoles) then
552 <       if (FF_uses_RF) then
552 >       if (electrostaticSummationMethod == 3) then
553            dielect = getDielect()
554            call initialize_rf(dielect)
555         endif
556      else
557 <       if (FF_uses_RF) then          
557 >       if (electrostaticSummationMethod == 3) then
558            write(default_error,*) 'Using Reaction Field with no dipoles?  Huh?'
559            thisStat = -1
560            haveSaneForceField = .false.
# Line 967 | Line 972 | contains
972  
973      if (FF_RequiresPostpairCalc() .and. SIM_requires_postpair_calc) then
974  
975 <       if (FF_uses_RF .and. SIM_uses_RF) then
975 >       if (electrostaticSummationMethod == 3) then
976  
977   #ifdef IS_MPI
978            call scatter(rf_Row,rf,plan_atom_row_3d)
# Line 1051 | Line 1056 | contains
1056      real ( kind = dp ), intent(inout) :: rijsq
1057      real ( kind = dp )                :: r
1058      real ( kind = dp ), intent(inout) :: d(3)
1054    real ( kind = dp ) :: ebalance
1059      integer :: me_i, me_j
1060  
1061      integer :: iHash
# Line 1076 | Line 1080 | contains
1080  
1081      if ( iand(iHash, ELECTROSTATIC_PAIR).ne.0 ) then
1082         call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
1083 <            pot, eFrame, f, t, do_pot, corrMethod)
1083 >            pot, eFrame, f, t, do_pot)
1084  
1085 <       if (FF_uses_RF .and. SIM_uses_RF) then
1085 >       if (electrostaticSummationMethod == 3) then
1086  
1087            ! CHECK ME (RF needs to know about all electrostatic types)
1088            call accumulate_rf(i, j, r, eFrame, sw)
# Line 1140 | Line 1144 | contains
1144      real ( kind = dp ), intent(inout) :: d(3), dc(3)
1145  
1146      integer :: me_i, me_j, iHash
1147 +
1148 +    r = sqrt(rijsq)
1149  
1150   #ifdef IS_MPI  
1151      me_i = atid_row(i)
# Line 1358 | Line 1364 | contains
1364  
1365    function FF_RequiresPostpairCalc() result(doesit)
1366      logical :: doesit
1367 <    doesit = FF_uses_RF
1367 >    if (electrostaticSummationMethod == 3) doesit = .true.
1368    end function FF_RequiresPostpairCalc
1369  
1370   #ifdef PROFILE

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines