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

Comparing trunk/OOPSE-3.0/src/UseTheForce/doForces.F90 (file contents):
Revision 2281 by gezelter, Thu Sep 1 22:56:20 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.35 2005-09-01 22:56:20 gezelter Exp $, $Date: 2005-09-01 22:56:20 $, $Name: not supported by cvs2svn $, $Revision: 1.35 $
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    
283            call getElementProperty(atypes, i, "is_LennardJones", i_is_LJ)
# 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 <          atypeMaxCutoff(i) = 0.0_dp
291 >
292            if (i_is_LJ) then
293               thisRcut = getSigma(i) * 2.5_dp
294               if (thisRCut .gt. atypeMaxCutoff(i)) atypeMaxCutoff(i) = thisRCut
# Line 330 | Line 334 | contains
334   #endif
335      
336      !! allocate the groupToGtype and gtypeMaxCutoff here.
337 <    
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.
# Line 349 | 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
361 <                nGroupTypes = nGroupTypes + 1
362 <                gtypeMaxCutoff(nGroupTypes) = groupMaxCutoff(i)
363 <                groupToGtype(i) = nGroupTypes
364 <             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
384 <    
383 >    enddo    
384 >
385      !! allocate the gtypeCutoffMap here.
386 <    
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 391 | Line 405 | contains
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      
412      haveGtypeCutoffMap = .true.
413 <  end subroutine createGtypeCutoffMap
399 <  
400 <  subroutine setDefaultCutoffs(defRcut, defRsw, defRlist, cutPolicy)
401 <    real(kind=dp),intent(in) :: defRcut, defRsw, defRlist
402 <    integer, intent(in) :: cutPolicy
403 <    
404 <    defaultRcut = defRcut
405 <    defaultRsw = defRsw
406 <    defaultRlist = defRlist
407 <    cutoffPolicy = cutPolicy
408 <  end subroutine setDefaultCutoffs
409 <  
410 <  subroutine setCutoffPolicy(cutPolicy)
413 >   end subroutine createGtypeCutoffMap
414  
415 +   subroutine setDefaultCutoffs(defRcut, defRsw, defRlist, cutPolicy)
416 +     real(kind=dp),intent(in) :: defRcut, defRsw, defRlist
417       integer, intent(in) :: cutPolicy
418 +
419 +     defaultRcut = defRcut
420 +     defaultRsw = defRsw
421 +     defaultRlist = defRlist
422       cutoffPolicy = cutPolicy
423 <     call createGtypeCutoffMap()
423 >     rcuti = 1.0_dp / defaultRcut
424 >   end subroutine setDefaultCutoffs
425  
426 +   subroutine setCutoffPolicy(cutPolicy)
427 +
428 +     integer, intent(in) :: cutPolicy
429 +     cutoffPolicy = cutPolicy
430 +     call createGtypeCutoffMap()
431     end subroutine setCutoffPolicy
432      
433      
434    subroutine setSimVariables()
435      SIM_uses_DirectionalAtoms = SimUsesDirectionalAtoms()
436      SIM_uses_EAM = SimUsesEAM()
422    SIM_uses_RF = SimUsesRF()
437      SIM_requires_postpair_calc = SimRequiresPostpairCalc()
438      SIM_requires_prepair_calc = SimRequiresPrepairCalc()
439      SIM_uses_PBC = SimUsesPBC()
# Line 460 | 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 489 | 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
496 <    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
499    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:
507 <    FF_uses_RF = use_RF
518 >    electrostaticSummationMethod = thisESM
519  
509    !! set the electrostatic correction method
510    if (use_UW) then
511       corrMethod = 1
512    elseif (use_DW) then
513       corrMethod = 2
514    else
515       corrMethod = 0
516    endif
517    
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 544 | 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 970 | 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 1054 | Line 1056 | contains
1056      real ( kind = dp ), intent(inout) :: rijsq
1057      real ( kind = dp )                :: r
1058      real ( kind = dp ), intent(inout) :: d(3)
1057    real ( kind = dp ) :: ebalance
1059      integer :: me_i, me_j
1060  
1061      integer :: iHash
# Line 1079 | 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 1143 | 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 1361 | 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