ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE_old/src/mdtools/libmdCode/do_Forces.F90
(Generate patch)

Comparing trunk/OOPSE_old/src/mdtools/libmdCode/do_Forces.F90 (file contents):
Revision 331 by chuckv, Thu Mar 13 00:33:18 2003 UTC vs.
Revision 332 by gezelter, Thu Mar 13 15:28:43 2003 UTC

# Line 4 | Line 4
4  
5   !! @author Charles F. Vardeman II
6   !! @author Matthew Meineke
7 < !! @version $Id: do_Forces.F90,v 1.17 2003-03-13 00:33:18 chuckv Exp $, $Date: 2003-03-13 00:33:18 $, $Name: not supported by cvs2svn $, $Revision: 1.17 $
7 > !! @version $Id: do_Forces.F90,v 1.18 2003-03-13 15:28:43 gezelter Exp $, $Date: 2003-03-13 15:28:43 $, $Name: not supported by cvs2svn $, $Revision: 1.18 $
8  
9  
10  
# Line 16 | Line 16 | module do_Forces
16    use lj
17    use sticky_pair
18    use dipole_dipole
19 +  use reaction_field
20  
21   #ifdef IS_MPI
22    use mpiSimulation
# Line 31 | Line 32 | module do_Forces
32    logical, save :: FF_uses_GB
33    logical, save :: FF_uses_EAM
34  
34
35    public :: init_FF
36    public :: do_force_loop
37  
38   contains
39  
40 <  subroutine init_FF(thisStat)
40 >  subroutine init_FF(LJ_mix_policy, use_RF_c, thisStat)
41 >    logical(kind = 2), intent(in) :: use_RF_c
42 >    logical :: use_RF_f
43      integer, intent(out) :: thisStat  
44 <    integer :: my_status
45 <    character(len = 100) :: mix_Policy
44 >    integer :: my_status, nMatches
45 >    character(len = 100) :: LJ_mix_Policy
46 >    integer, pointer :: MatchList(:)
47 >    
48 >    !! Fortran's version of a cast:
49 >    use_RF_f = use_RF_c
50  
51 <    ! be a smarter subroutine.
46 <    mix_Policy = "FIXME"
51 >    !! assume things are copacetic, unless they aren't
52      thisStat = 0
53 <    call init_lj_FF(mix_Policy,my_status)
53 >    
54 >    !! init_FF is called *after* all of the atom types have been
55 >    !! defined in atype_module using the new_atype subroutine.
56 >    !!
57 >    !! this will scan through the known atypes and figure out what
58 >    !! interactions are used by the force field.    
59 >
60 >    FF_uses_LJ = .false.
61 >    FF_uses_sticky = .false.
62 >    FF_uses_dipoles = .false.
63 >    FF_uses_GB = .false.
64 >    FF_uses_EAM = .false.
65 >    
66 >    call getMatchingElementList(atypes, "is_LJ", .true., nMatches, MatchList)
67 >    deallocate(MatchList)
68 >    if (nMatches .gt. 0) FF_uses_LJ = .true.
69 >
70 >    call getMatchingElementList(atypes, "is_DP", .true., nMatches, MatchList)
71 >    deallocate(MatchList)
72 >    if (nMatches .gt. 0) FF_uses_dipoles = .true.
73 >
74 >    call getMatchingElementList(atypes, "is_Sticky", .true., nMatches, &
75 >         MatchList)
76 >    deallocate(MatchList)
77 >    if (nMatches .gt. 0) FF_uses_Sticky = .true.
78 >    
79 >    call getMatchingElementList(atypes, "is_GB", .true., nMatches, MatchList)
80 >    deallocate(MatchList)
81 >    if (nMatches .gt. 0) FF_uses_GB = .true.
82 >
83 >    call getMatchingElementList(atypes, "is_EAM", .true., nMatches, MatchList)
84 >    deallocate(MatchList)
85 >    if (nMatches .gt. 0) FF_uses_EAM = .true.
86 >
87 >    !! check to make sure the use_RF setting makes sense
88 >    if (use_RF_f) then
89 >       if (FF_uses_dipoles) then
90 >          FF_uses_RF = .true.
91 >          call initialize_rf()
92 >       else
93 >          write(default_error,*) 'Using Reaction Field with no dipoles?  Huh?'
94 >          thisStat = -1
95 >          return
96 >       endif
97 >    endif
98 >    
99 >    call init_lj_FF(LJ_mix_Policy, my_status)
100      if (my_status /= 0) then
101         thisStat = -1
102         return
# Line 390 | Line 441 | contains
441   #endif
442      
443    end subroutine do_force_loop
393
394
395 !! Calculate any pre-force loop components and update nlist if necessary.
396  subroutine do_preForce(updateNlist)
397    logical, intent(inout) :: updateNlist
444  
399
400
401  end subroutine do_preForce
402
403  !! Calculate any post force loop components, i.e. reaction field, etc.
404  subroutine do_postForce()
405
406
407
408  end subroutine do_postForce
409
445    subroutine do_pair(i, j, rijsq, d, do_pot, do_stress)
446  
447      real( kind = dp ) :: pot
# Line 502 | Line 537 | contains
537  
538    subroutine check_initialization(error)
539      integer, intent(out) :: error
540 <
540 >    
541      error = 0
542      ! Make sure we are properly initialized.
543 <    if (.not. do_Forces_initialized) then
543 >    if (.not. do_forces_initialized) then
544         write(default_error,*) "ERROR: do_Forces has not been initialized!"
545         error = -1
546         return
547      endif
548 +
549   #ifdef IS_MPI
550      if (.not. isMPISimSet()) then
551         write(default_error,*) "ERROR: mpiSimulation has not been initialized!"
# Line 517 | Line 553 | contains
553         return
554      endif
555   #endif
556 <
556 >    
557      return
558    end subroutine check_initialization
559  
# Line 547 | Line 583 | contains
583      pot_Col = 0.0_dp
584      pot_Temp = 0.0_dp
585  
586 +    rf_Row = 0.0_dp
587 +    rf_Col = 0.0_dp
588 +    rf_Temp = 0.0_dp
589 +
590   #endif
591  
592 +    rf = 0.0_dp
593      tau_Temp = 0.0_dp
594      virial_Temp = 0.0_dp
595      
# Line 560 | Line 601 | contains
601    !! Also checks to see if i and j are the same particle.
602  
603    function checkExcludes(atom1,atom2) result(do_cycle)
604 <    !--------------- Arguments--------------------------
564 <    ! Index i
604 >    
605      integer,intent(in) :: atom1
566    ! Index j
606      integer,intent(in), optional :: atom2
568    ! Result do_cycle
607      logical :: do_cycle
608 <    !--------------- Local variables--------------------
571 <    integer :: tag_i
572 <    integer :: tag_j
608 >    integer :: unique_id_1, unique_id_2
609      integer :: i, j
610 <    !--------------- END DECLARATIONS------------------  
610 >
611      do_cycle = .false.
612      
613   #ifdef IS_MPI
614 <    tag_i = tagRow(atom1)
614 >    unique_id_1 = tagRow(atom1)
615   #else
616 <    tag_i = tag(atom1)
616 >    unique_id_1 = tag(atom1)
617   #endif
618      
619      !! Check global excludes first
620      if (.not. present(atom2)) then
621         do i = 1, nExcludes_global
622 <          if (excludeGlobal(i) == tag_i) then
622 >          if (excludesGlobal(i) == unique_id_1) then
623               do_cycle = .true.
624               return
625            end if
# Line 592 | Line 628 | contains
628      end if
629  
630      !! we return if atom2 not present here.
595    tag_j = tagColumn(atom2)
631      
632 <    if (tag_i == tag_j) then
632 > #ifdef IS_MPI
633 >    unique_id_2 = tagColumn(atom2)
634 > #else
635 >    unique_id_2 = tag(atom2)
636 > #endif
637 >    
638 >    if (unique_id_1 == unique_id_2) then
639         do_cycle = .true.
640         return
641      end if
642      
643 <    if (tag_i < tag_j) then
644 <       if (mod(tag_i + tag_j,2) == 0) do_cycle = .true.
643 >    if (unique_id_1 < unique_id_2) then
644 >       if (mod(unique_id_1 + unique_id_2,2) == 0) do_cycle = .true.
645         return
646      else                
647 <       if (mod(tag_i + tag_j,2) == 1) do_cycle = .true.
647 >       if (mod(unique_id_1 + unique_id_2,2) == 1) do_cycle = .true.
648      endif
649 <            
649 >    
650      do i = 1, nExcludes_local
651 <       if ((tag_i == excludesLocal(1,i)) .and. (excludesLocal(2,i) < 0)) then
651 >       if ((unique_id_1 == excludesLocal(1,i)) .and.  &
652 >            (excludesLocal(2,i) < 0)) then
653            do_cycle = .true.
654            return
655         end if
656      end do
657      
616    
658    end function checkExcludes
659  
660    function FF_UsesDirectionalAtoms() result(doesit)

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines