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 1650 by gezelter, Tue Oct 26 22:24:52 2004 UTC vs.
Revision 2204 by gezelter, Fri Apr 15 22:04:00 2005 UTC

# Line 1 | Line 1
1 + !!
2 + !! Copyright (c) 2005 The University of Notre Dame. All Rights Reserved.
3 + !!
4 + !! The University of Notre Dame grants you ("Licensee") a
5 + !! non-exclusive, royalty free, license to use, modify and
6 + !! redistribute this software in source and binary code form, provided
7 + !! that the following conditions are met:
8 + !!
9 + !! 1. Acknowledgement of the program authors must be made in any
10 + !!    publication of scientific results based in part on use of the
11 + !!    program.  An acceptable form of acknowledgement is citation of
12 + !!    the article in which the program was described (Matthew
13 + !!    A. Meineke, Charles F. Vardeman II, Teng Lin, Christopher
14 + !!    J. Fennell and J. Daniel Gezelter, "OOPSE: An Object-Oriented
15 + !!    Parallel Simulation Engine for Molecular Dynamics,"
16 + !!    J. Comput. Chem. 26, pp. 252-271 (2005))
17 + !!
18 + !! 2. Redistributions of source code must retain the above copyright
19 + !!    notice, this list of conditions and the following disclaimer.
20 + !!
21 + !! 3. Redistributions in binary form must reproduce the above copyright
22 + !!    notice, this list of conditions and the following disclaimer in the
23 + !!    documentation and/or other materials provided with the
24 + !!    distribution.
25 + !!
26 + !! This software is provided "AS IS," without a warranty of any
27 + !! kind. All express or implied conditions, representations and
28 + !! warranties, including any implied warranty of merchantability,
29 + !! fitness for a particular purpose or non-infringement, are hereby
30 + !! excluded.  The University of Notre Dame and its licensors shall not
31 + !! be liable for any damages suffered by licensee as a result of
32 + !! using, modifying or distributing the software or its
33 + !! derivatives. In no event will the University of Notre Dame or its
34 + !! licensors be liable for any lost revenue, profit or data, or for
35 + !! direct, indirect, special, consequential, incidental or punitive
36 + !! damages, however caused and regardless of the theory of liability,
37 + !! arising out of the use of or inability to use software, even if the
38 + !! University of Notre Dame has been advised of the possibility of
39 + !! such damages.
40 + !!
41 +
42   !! doForces.F90
43   !! module doForces
44   !! Calculates Long Range forces.
45  
46   !! @author Charles F. Vardeman II
47   !! @author Matthew Meineke
48 < !! @version $Id: doForces.F90,v 1.5 2004-10-26 22:24:44 gezelter Exp $, $Date: 2004-10-26 22:24:44 $, $Name: not supported by cvs2svn $, $Revision: 1.5 $
48 > !! @version $Id: doForces.F90,v 1.13 2005-04-15 22:03:37 gezelter Exp $, $Date: 2005-04-15 22:03:37 $, $Name: not supported by cvs2svn $, $Revision: 1.13 $
49  
50 +
51   module doForces
52    use force_globals
53    use simulation
# Line 14 | Line 56 | module doForces
56    use switcheroo
57    use neighborLists  
58    use lj
59 <  use sticky_pair
60 <  use dipole_dipole
19 <  use charge_charge
59 >  use sticky
60 >  use electrostatic_module
61    use reaction_field
62    use gb_pair
63    use shapes
# Line 41 | Line 82 | module doForces
82    logical, save :: haveSIMvariables = .false.
83    logical, save :: havePropertyMap = .false.
84    logical, save :: haveSaneForceField = .false.
85 <  
85 >
86    logical, save :: FF_uses_DirectionalAtoms
87    logical, save :: FF_uses_LennardJones
88 <  logical, save :: FF_uses_Electrostatic
89 <  logical, save :: FF_uses_charges
90 <  logical, save :: FF_uses_dipoles
88 >  logical, save :: FF_uses_Electrostatics
89 >  logical, save :: FF_uses_Charges
90 >  logical, save :: FF_uses_Dipoles
91 >  logical, save :: FF_uses_Quadrupoles
92    logical, save :: FF_uses_sticky
93    logical, save :: FF_uses_GayBerne
94    logical, save :: FF_uses_EAM
# Line 59 | Line 101 | module doForces
101    logical, save :: SIM_uses_Electrostatics
102    logical, save :: SIM_uses_Charges
103    logical, save :: SIM_uses_Dipoles
104 +  logical, save :: SIM_uses_Quadrupoles
105    logical, save :: SIM_uses_Sticky
106    logical, save :: SIM_uses_GayBerne
107    logical, save :: SIM_uses_EAM
# Line 89 | Line 132 | module doForces
132       logical :: is_Electrostatic = .false.
133       logical :: is_Charge        = .false.
134       logical :: is_Dipole        = .false.
135 +     logical :: is_Quadrupole    = .false.
136       logical :: is_Sticky        = .false.
137       logical :: is_GayBerne      = .false.
138       logical :: is_EAM           = .false.
# Line 101 | Line 145 | contains
145   contains
146  
147    subroutine setRlistDF( this_rlist )
148 <    
148 >
149      real(kind=dp) :: this_rlist
150  
151      rlist = this_rlist
152      rlistsq = rlist * rlist
153 <    
153 >
154      haveRlist = .true.
155  
156 <  end subroutine setRlistDF    
156 >  end subroutine setRlistDF
157  
158    subroutine createPropertyMap(status)
159      integer :: nAtypes
# Line 126 | Line 170 | contains
170         status = -1
171         return
172      end if
173 <        
173 >
174      if (.not. allocated(PropertyMap)) then
175         allocate(PropertyMap(nAtypes))
176      endif
# Line 137 | Line 181 | contains
181  
182         call getElementProperty(atypes, i, "is_LennardJones", thisProperty)
183         PropertyMap(i)%is_LennardJones = thisProperty
184 <      
184 >
185         call getElementProperty(atypes, i, "is_Electrostatic", thisProperty)
186         PropertyMap(i)%is_Electrostatic = thisProperty
187  
188         call getElementProperty(atypes, i, "is_Charge", thisProperty)
189         PropertyMap(i)%is_Charge = thisProperty
190 <      
190 >
191         call getElementProperty(atypes, i, "is_Dipole", thisProperty)
192         PropertyMap(i)%is_Dipole = thisProperty
193 +
194 +       call getElementProperty(atypes, i, "is_Quadrupole", thisProperty)
195 +       PropertyMap(i)%is_Quadrupole = thisProperty
196  
197         call getElementProperty(atypes, i, "is_Sticky", thisProperty)
198         PropertyMap(i)%is_Sticky = thisProperty
# Line 194 | Line 241 | contains
241      integer :: myStatus
242  
243      error = 0
244 <    
244 >
245      if (.not. havePropertyMap) then
246  
247         myStatus = 0
# Line 239 | Line 286 | contains
286   #endif
287      return
288    end subroutine doReadyCheck
242    
289  
290 +
291    subroutine init_FF(use_RF_c, thisStat)
292  
293      logical, intent(in) :: use_RF_c
# Line 255 | Line 302 | contains
302  
303      !! Fortran's version of a cast:
304      FF_uses_RF = use_RF_c
305 <    
305 >
306      !! init_FF is called *after* all of the atom types have been
307      !! defined in atype_module using the new_atype subroutine.
308      !!
309      !! this will scan through the known atypes and figure out what
310      !! interactions are used by the force field.    
311 <  
311 >
312      FF_uses_DirectionalAtoms = .false.
313      FF_uses_LennardJones = .false.
314 <    FF_uses_Electrostatic = .false.
314 >    FF_uses_Electrostatics = .false.
315      FF_uses_Charges = .false.    
316      FF_uses_Dipoles = .false.
317      FF_uses_Sticky = .false.
# Line 272 | Line 319 | contains
319      FF_uses_EAM = .false.
320      FF_uses_Shapes = .false.
321      FF_uses_FLARB = .false.
322 <    
322 >
323      call getMatchingElementList(atypes, "is_Directional", .true., &
324           nMatches, MatchList)
325      if (nMatches .gt. 0) FF_uses_DirectionalAtoms = .true.
# Line 280 | Line 327 | contains
327      call getMatchingElementList(atypes, "is_LennardJones", .true., &
328           nMatches, MatchList)
329      if (nMatches .gt. 0) FF_uses_LennardJones = .true.
330 <    
330 >
331      call getMatchingElementList(atypes, "is_Electrostatic", .true., &
332           nMatches, MatchList)
333      if (nMatches .gt. 0) then
334 <       FF_uses_Electrostatic = .true.
334 >       FF_uses_Electrostatics = .true.
335      endif
336  
337      call getMatchingElementList(atypes, "is_Charge", .true., &
338           nMatches, MatchList)
339      if (nMatches .gt. 0) then
340 <       FF_uses_charges = .true.  
341 <       FF_uses_electrostatic = .true.
340 >       FF_uses_Charges = .true.  
341 >       FF_uses_Electrostatics = .true.
342      endif
343 <    
343 >
344      call getMatchingElementList(atypes, "is_Dipole", .true., &
345           nMatches, MatchList)
346      if (nMatches .gt. 0) then
347 <       FF_uses_dipoles = .true.
348 <       FF_uses_electrostatic = .true.
347 >       FF_uses_Dipoles = .true.
348 >       FF_uses_Electrostatics = .true.
349         FF_uses_DirectionalAtoms = .true.
350      endif
351 <    
351 >
352 >    call getMatchingElementList(atypes, "is_Quadrupole", .true., &
353 >         nMatches, MatchList)
354 >    if (nMatches .gt. 0) then
355 >       FF_uses_Quadrupoles = .true.
356 >       FF_uses_Electrostatics = .true.
357 >       FF_uses_DirectionalAtoms = .true.
358 >    endif
359 >
360      call getMatchingElementList(atypes, "is_Sticky", .true., nMatches, &
361           MatchList)
362      if (nMatches .gt. 0) then
363         FF_uses_Sticky = .true.
364         FF_uses_DirectionalAtoms = .true.
365      endif
366 <    
366 >
367      call getMatchingElementList(atypes, "is_GayBerne", .true., &
368           nMatches, MatchList)
369      if (nMatches .gt. 0) then
370         FF_uses_GayBerne = .true.
371         FF_uses_DirectionalAtoms = .true.
372      endif
373 <    
373 >
374      call getMatchingElementList(atypes, "is_EAM", .true., nMatches, MatchList)
375      if (nMatches .gt. 0) FF_uses_EAM = .true.
376 <    
376 >
377      call getMatchingElementList(atypes, "is_Shape", .true., &
378           nMatches, MatchList)
379      if (nMatches .gt. 0) then
# Line 332 | Line 387 | contains
387  
388      !! Assume sanity (for the sake of argument)
389      haveSaneForceField = .true.
390 <    
390 >
391      !! check to make sure the FF_uses_RF setting makes sense
392 <    
392 >
393      if (FF_uses_dipoles) then
394         if (FF_uses_RF) then
395            dielect = getDielect()
# Line 347 | Line 402 | contains
402            haveSaneForceField = .false.
403            return
404         endif
350    endif
351
352    if (FF_uses_sticky) then
353       call check_sticky_FF(my_status)
354       if (my_status /= 0) then
355          thisStat = -1
356          haveSaneForceField = .false.
357          return
358       end if
405      endif
406  
407 +    !sticky module does not contain check_sticky_FF anymore
408 +    !if (FF_uses_sticky) then
409 +    !   call check_sticky_FF(my_status)
410 +    !   if (my_status /= 0) then
411 +    !      thisStat = -1
412 +    !      haveSaneForceField = .false.
413 +    !      return
414 +    !   end if
415 +    !endif
416 +
417      if (FF_uses_EAM) then
418 <         call init_EAM_FF(my_status)
418 >       call init_EAM_FF(my_status)
419         if (my_status /= 0) then
420            write(default_error, *) "init_EAM_FF returned a bad status"
421            thisStat = -1
# Line 379 | Line 435 | contains
435  
436      if (FF_uses_GayBerne .and. FF_uses_LennardJones) then
437      endif
438 <    
438 >
439      if (.not. haveNeighborList) then
440         !! Create neighbor lists
441         call expandNeighborList(nLocal, my_status)
# Line 389 | Line 445 | contains
445            return
446         endif
447         haveNeighborList = .true.
448 <    endif    
449 <    
448 >    endif
449 >
450    end subroutine init_FF
395  
451  
452 +
453    !! Does force loop over i,j pairs. Calls do_pair to calculates forces.
454    !------------------------------------------------------------->
455 <  subroutine do_force_loop(q, q_group, A, u_l, f, t, tau, pot, &
455 >  subroutine do_force_loop(q, q_group, A, eFrame, f, t, tau, pot, &
456         do_pot_c, do_stress_c, error)
457      !! Position array provided by C, dimensioned by getNlocal
458      real ( kind = dp ), dimension(3, nLocal) :: q
# Line 405 | Line 461 | contains
461      !! Rotation Matrix for each long range particle in simulation.
462      real( kind = dp), dimension(9, nLocal) :: A    
463      !! Unit vectors for dipoles (lab frame)
464 <    real( kind = dp ), dimension(3,nLocal) :: u_l
464 >    real( kind = dp ), dimension(9,nLocal) :: eFrame
465      !! Force array provided by C, dimensioned by getNlocal
466      real ( kind = dp ), dimension(3,nLocal) :: f
467      !! Torsion array provided by C, dimensioned by getNlocal
# Line 445 | Line 501 | contains
501      integer :: loopStart, loopEnd, loop
502  
503      real(kind=dp) :: listSkin = 1.0  
504 <    
504 >
505      !! initialize local variables  
506 <    
506 >
507   #ifdef IS_MPI
508      pot_local = 0.0_dp
509      nAtomsInRow   = getNatomsInRow(plan_atom_row)
# Line 457 | Line 513 | contains
513   #else
514      natoms = nlocal
515   #endif
516 <    
516 >
517      call doReadyCheck(localError)
518      if ( localError .ne. 0 ) then
519         call handleError("do_force_loop", "Not Initialized")
# Line 465 | Line 521 | contains
521         return
522      end if
523      call zero_work_arrays()
524 <        
524 >
525      do_pot = do_pot_c
526      do_stress = do_stress_c
527 <    
527 >
528      ! Gather all information needed by all force loops:
529 <    
529 >
530   #ifdef IS_MPI    
531 <    
531 >
532      call gather(q, q_Row, plan_atom_row_3d)
533      call gather(q, q_Col, plan_atom_col_3d)
534  
535      call gather(q_group, q_group_Row, plan_group_row_3d)
536      call gather(q_group, q_group_Col, plan_group_col_3d)
537 <        
537 >
538      if (FF_UsesDirectionalAtoms() .and. SIM_uses_DirectionalAtoms) then
539 <       call gather(u_l, u_l_Row, plan_atom_row_3d)
540 <       call gather(u_l, u_l_Col, plan_atom_col_3d)
541 <      
539 >       call gather(eFrame, eFrame_Row, plan_atom_row_rotation)
540 >       call gather(eFrame, eFrame_Col, plan_atom_col_rotation)
541 >
542         call gather(A, A_Row, plan_atom_row_rotation)
543         call gather(A, A_Col, plan_atom_col_rotation)
544      endif
545 <    
545 >
546   #endif
547 <    
547 >
548      !! Begin force loop timing:
549   #ifdef PROFILE
550      call cpu_time(forceTimeInitial)
551      nloops = nloops + 1
552   #endif
553 <    
553 >
554      loopEnd = PAIR_LOOP
555      if (FF_RequiresPrepairCalc() .and. SIM_requires_prepair_calc) then
556         loopStart = PREPAIR_LOOP
# Line 509 | Line 565 | contains
565         if (loop .eq. loopStart) then
566   #ifdef IS_MPI
567            call checkNeighborList(nGroupsInRow, q_group_row, listSkin, &
568 <             update_nlist)
568 >               update_nlist)
569   #else
570            call checkNeighborList(nGroups, q_group, listSkin, &
571 <             update_nlist)
571 >               update_nlist)
572   #endif
573         endif
574 <      
574 >
575         if (update_nlist) then
576            !! save current configuration and construct neighbor list
577   #ifdef IS_MPI
# Line 526 | Line 582 | contains
582            neighborListSize = size(list)
583            nlist = 0
584         endif
585 <      
585 >
586         istart = 1
587   #ifdef IS_MPI
588         iend = nGroupsInRow
# Line 536 | Line 592 | contains
592         outer: do i = istart, iend
593  
594            if (update_nlist) point(i) = nlist + 1
595 <          
595 >
596            n_in_i = groupStartRow(i+1) - groupStartRow(i)
597 <          
597 >
598            if (update_nlist) then
599   #ifdef IS_MPI
600               jstart = 1
# Line 553 | Line 609 | contains
609               ! make sure group i has neighbors
610               if (jstart .gt. jend) cycle outer
611            endif
612 <          
612 >
613            do jnab = jstart, jend
614               if (update_nlist) then
615                  j = jnab
# Line 572 | Line 628 | contains
628               if (rgrpsq < rlistsq) then
629                  if (update_nlist) then
630                     nlist = nlist + 1
631 <                  
631 >
632                     if (nlist > neighborListSize) then
633   #ifdef IS_MPI                
634                        call expandNeighborList(nGroupsInRow, listerror)
# Line 586 | Line 642 | contains
642                        end if
643                        neighborListSize = size(list)
644                     endif
645 <                  
645 >
646                     list(nlist) = j
647                  endif
648 <                
648 >
649                  if (loop .eq. PAIR_LOOP) then
650                     vij = 0.0d0
651                     fij(1:3) = 0.0d0
652                  endif
653 <                
653 >
654                  call get_switch(rgrpsq, sw, dswdr, rgrp, group_switch, &
655                       in_switching_region)
656 <                
656 >
657                  n_in_j = groupStartCol(j+1) - groupStartCol(j)
658 <                
658 >
659                  do ia = groupStartRow(i), groupStartRow(i+1)-1
660 <                  
660 >
661                     atom1 = groupListRow(ia)
662 <                  
662 >
663                     inner: do jb = groupStartCol(j), groupStartCol(j+1)-1
664 <                      
664 >
665                        atom2 = groupListCol(jb)
666 <                      
666 >
667                        if (skipThisPair(atom1, atom2)) cycle inner
668  
669                        if ((n_in_i .eq. 1).and.(n_in_j .eq. 1)) then
# Line 627 | Line 683 | contains
683   #ifdef IS_MPI                      
684                           call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
685                                rgrpsq, d_grp, do_pot, do_stress, &
686 <                              u_l, A, f, t, pot_local)
686 >                              eFrame, A, f, t, pot_local)
687   #else
688                           call do_prepair(atom1, atom2, ratmsq, d_atm, sw, &
689                                rgrpsq, d_grp, do_pot, do_stress, &
690 <                              u_l, A, f, t, pot)
690 >                              eFrame, A, f, t, pot)
691   #endif                                              
692                        else
693   #ifdef IS_MPI                      
694                           call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
695                                do_pot, &
696 <                              u_l, A, f, t, pot_local, vpair, fpair)
696 >                              eFrame, A, f, t, pot_local, vpair, fpair)
697   #else
698                           call do_pair(atom1, atom2, ratmsq, d_atm, sw, &
699                                do_pot,  &
700 <                              u_l, A, f, t, pot, vpair, fpair)
700 >                              eFrame, A, f, t, pot, vpair, fpair)
701   #endif
702  
703                           vij = vij + vpair
# Line 649 | Line 705 | contains
705                        endif
706                     enddo inner
707                  enddo
708 <                
708 >
709                  if (loop .eq. PAIR_LOOP) then
710                     if (in_switching_region) then
711                        swderiv = vij*dswdr/rgrp
712                        fij(1) = fij(1) + swderiv*d_grp(1)
713                        fij(2) = fij(2) + swderiv*d_grp(2)
714                        fij(3) = fij(3) + swderiv*d_grp(3)
715 <                      
715 >
716                        do ia=groupStartRow(i), groupStartRow(i+1)-1
717                           atom1=groupListRow(ia)
718                           mf = mfactRow(atom1)
# Line 670 | Line 726 | contains
726                           f(3,atom1) = f(3,atom1) + swderiv*d_grp(3)*mf
727   #endif
728                        enddo
729 <                      
729 >
730                        do jb=groupStartCol(j), groupStartCol(j+1)-1
731                           atom2=groupListCol(jb)
732                           mf = mfactCol(atom2)
# Line 685 | Line 741 | contains
741   #endif
742                        enddo
743                     endif
744 <                  
744 >
745                     if (do_stress) call add_stress_tensor(d_grp, fij)
746                  endif
747               end if
748            enddo
749         enddo outer
750 <      
750 >
751         if (update_nlist) then
752   #ifdef IS_MPI
753            point(nGroupsInRow + 1) = nlist + 1
# Line 705 | Line 761 | contains
761               update_nlist = .false.                              
762            endif
763         endif
764 <            
764 >
765         if (loop .eq. PREPAIR_LOOP) then
766            call do_preforce(nlocal, pot)
767         endif
768 <      
768 >
769      enddo
770 <    
770 >
771      !! Do timing
772   #ifdef PROFILE
773      call cpu_time(forceTimeFinal)
774      forceTime = forceTime + forceTimeFinal - forceTimeInitial
775   #endif    
776 <    
776 >
777   #ifdef IS_MPI
778      !!distribute forces
779 <    
779 >
780      f_temp = 0.0_dp
781      call scatter(f_Row,f_temp,plan_atom_row_3d)
782      do i = 1,nlocal
783         f(1:3,i) = f(1:3,i) + f_temp(1:3,i)
784      end do
785 <    
785 >
786      f_temp = 0.0_dp
787      call scatter(f_Col,f_temp,plan_atom_col_3d)
788      do i = 1,nlocal
789         f(1:3,i) = f(1:3,i) + f_temp(1:3,i)
790      end do
791 <    
791 >
792      if (FF_UsesDirectionalAtoms() .and. SIM_uses_DirectionalAtoms) then
793         t_temp = 0.0_dp
794         call scatter(t_Row,t_temp,plan_atom_row_3d)
# Line 741 | Line 797 | contains
797         end do
798         t_temp = 0.0_dp
799         call scatter(t_Col,t_temp,plan_atom_col_3d)
800 <      
800 >
801         do i = 1,nlocal
802            t(1:3,i) = t(1:3,i) + t_temp(1:3,i)
803         end do
804      endif
805 <    
805 >
806      if (do_pot) then
807         ! scatter/gather pot_row into the members of my column
808         call scatter(pot_Row, pot_Temp, plan_atom_row)
809 <      
809 >
810         ! scatter/gather pot_local into all other procs
811         ! add resultant to get total pot
812         do i = 1, nlocal
813            pot_local = pot_local + pot_Temp(i)
814         enddo
815 <      
815 >
816         pot_Temp = 0.0_DP
817 <      
817 >
818         call scatter(pot_Col, pot_Temp, plan_atom_col)
819         do i = 1, nlocal
820            pot_local = pot_local + pot_Temp(i)
821         enddo
822 <      
822 >
823      endif
824   #endif
825 <    
825 >
826      if (FF_RequiresPostpairCalc() .and. SIM_requires_postpair_calc) then
827 <      
827 >
828         if (FF_uses_RF .and. SIM_uses_RF) then
829 <          
829 >
830   #ifdef IS_MPI
831            call scatter(rf_Row,rf,plan_atom_row_3d)
832            call scatter(rf_Col,rf_Temp,plan_atom_col_3d)
# Line 778 | Line 834 | contains
834               rf(1:3,i) = rf(1:3,i) + rf_Temp(1:3,i)
835            end do
836   #endif
837 <          
837 >
838            do i = 1, nLocal
839 <            
839 >
840               rfpot = 0.0_DP
841   #ifdef IS_MPI
842               me_i = atid_row(i)
843   #else
844               me_i = atid(i)
845   #endif
846 <            
846 >
847               if (PropertyMap(me_i)%is_Dipole) then
848 <                
848 >
849                  mu_i = getDipoleMoment(me_i)
850 <                
850 >
851                  !! The reaction field needs to include a self contribution
852                  !! to the field:
853 <                call accumulate_self_rf(i, mu_i, u_l)
853 >                call accumulate_self_rf(i, mu_i, eFrame)
854                  !! Get the reaction field contribution to the
855                  !! potential and torques:
856 <                call reaction_field_final(i, mu_i, u_l, rfpot, t, do_pot)
856 >                call reaction_field_final(i, mu_i, eFrame, rfpot, t, do_pot)
857   #ifdef IS_MPI
858                  pot_local = pot_local + rfpot
859   #else
860                  pot = pot + rfpot
861 <      
861 >
862   #endif
863 <             endif            
863 >             endif
864            enddo
865         endif
866      endif
867 <    
868 <    
867 >
868 >
869   #ifdef IS_MPI
870 <    
870 >
871      if (do_pot) then
872         pot = pot + pot_local
873         !! we assume the c code will do the allreduce to get the total potential
874         !! we could do it right here if we needed to...
875      endif
876 <    
876 >
877      if (do_stress) then
878         call mpi_allreduce(tau_Temp, tau, 9,mpi_double_precision,mpi_sum, &
879              mpi_comm_world,mpi_err)
880         call mpi_allreduce(virial_Temp, virial,1,mpi_double_precision,mpi_sum, &
881              mpi_comm_world,mpi_err)
882      endif
883 <    
883 >
884   #else
885 <    
885 >
886      if (do_stress) then
887         tau = tau_Temp
888         virial = virial_Temp
889      endif
890 <    
890 >
891   #endif
892 <      
892 >
893    end subroutine do_force_loop
894 <  
894 >
895    subroutine do_pair(i, j, rijsq, d, sw, do_pot, &
896 <       u_l, A, f, t, pot, vpair, fpair)
896 >       eFrame, A, f, t, pot, vpair, fpair)
897  
898      real( kind = dp ) :: pot, vpair, sw
899      real( kind = dp ), dimension(3) :: fpair
900      real( kind = dp ), dimension(nLocal)   :: mfact
901 <    real( kind = dp ), dimension(3,nLocal) :: u_l
901 >    real( kind = dp ), dimension(9,nLocal) :: eFrame
902      real( kind = dp ), dimension(9,nLocal) :: A
903      real( kind = dp ), dimension(3,nLocal) :: f
904      real( kind = dp ), dimension(3,nLocal) :: t
# Line 865 | Line 921 | contains
921      me_i = atid(i)
922      me_j = atid(j)
923   #endif
924 <    
924 >
925 >    !    write(*,*) i, j, me_i, me_j
926 >
927      if (FF_uses_LennardJones .and. SIM_uses_LennardJones) then
928 <      
928 >
929         if ( PropertyMap(me_i)%is_LennardJones .and. &
930              PropertyMap(me_j)%is_LennardJones ) then
931            call do_lj_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, do_pot)
932         endif
933 <      
933 >
934      endif
935 <    
936 <    if (FF_uses_charges .and. SIM_uses_charges) then
937 <      
938 <       if (PropertyMap(me_i)%is_Charge .and. PropertyMap(me_j)%is_Charge) then
939 <          call do_charge_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
940 <               pot, f, do_pot)
935 >
936 >    if (FF_uses_Electrostatics .and. SIM_uses_Electrostatics) then
937 >
938 >       if (PropertyMap(me_i)%is_Electrostatic .and. &
939 >            PropertyMap(me_j)%is_Electrostatic) then
940 >          call doElectrostaticPair(i, j, d, r, rijsq, sw, vpair, fpair, &
941 >               pot, eFrame, f, t, do_pot)
942         endif
943 <      
944 <    endif
945 <    
946 <    if (FF_uses_dipoles .and. SIM_uses_dipoles) then
947 <      
948 <       if ( PropertyMap(me_i)%is_Dipole .and. PropertyMap(me_j)%is_Dipole) then
949 <          call do_dipole_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
950 <               pot, u_l, f, t, do_pot)
892 <          if (FF_uses_RF .and. SIM_uses_RF) then
893 <             call accumulate_rf(i, j, r, u_l, sw)
894 <             call rf_correct_forces(i, j, d, r, u_l, sw, f, fpair)
943 >
944 >       if (FF_uses_dipoles .and. SIM_uses_dipoles) then      
945 >          if ( PropertyMap(me_i)%is_Dipole .and. &
946 >               PropertyMap(me_j)%is_Dipole) then
947 >             if (FF_uses_RF .and. SIM_uses_RF) then
948 >                call accumulate_rf(i, j, r, eFrame, sw)
949 >                call rf_correct_forces(i, j, d, r, eFrame, sw, f, fpair)
950 >             endif
951            endif
952         endif
897
953      endif
954  
955 +
956      if (FF_uses_Sticky .and. SIM_uses_sticky) then
957  
958         if ( PropertyMap(me_i)%is_Sticky .and. PropertyMap(me_j)%is_Sticky) then
959            call do_sticky_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
960                 pot, A, f, t, do_pot)
961         endif
962 <      
962 >
963      endif
964  
965  
966      if (FF_uses_GayBerne .and. SIM_uses_GayBerne) then
967 <      
967 >
968         if ( PropertyMap(me_i)%is_GayBerne .and. &
969              PropertyMap(me_j)%is_GayBerne) then
970            call do_gb_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
971 <               pot, u_l, f, t, do_pot)
971 >               pot, A, f, t, do_pot)
972         endif
973 <      
973 >
974      endif
975 <    
975 >
976      if (FF_uses_EAM .and. SIM_uses_EAM) then
977 <      
977 >
978         if ( PropertyMap(me_i)%is_EAM .and. PropertyMap(me_j)%is_EAM) then
979            call do_eam_pair(i, j, d, r, rijsq, sw, vpair, fpair, pot, f, &
980                 do_pot)
981         endif
982 <      
982 >
983      endif
984  
985 +
986 +    !    write(*,*) PropertyMap(me_i)%is_Shape,PropertyMap(me_j)%is_Shape
987 +
988      if (FF_uses_Shapes .and. SIM_uses_Shapes) then
930      
989         if ( PropertyMap(me_i)%is_Shape .and. &
990              PropertyMap(me_j)%is_Shape ) then
991            call do_shape_pair(i, j, d, r, rijsq, sw, vpair, fpair, &
992                 pot, A, f, t, do_pot)
993         endif
994 <      
994 >
995      endif
996 <    
996 >
997    end subroutine do_pair
998  
999    subroutine do_prepair(i, j, rijsq, d, sw, rcijsq, dc, &
1000 <       do_pot, do_stress, u_l, A, f, t, pot)
1000 >       do_pot, do_stress, eFrame, A, f, t, pot)
1001  
1002 <   real( kind = dp ) :: pot, sw
1003 <   real( kind = dp ), dimension(3,nLocal) :: u_l
1004 <   real (kind=dp), dimension(9,nLocal) :: A
1005 <   real (kind=dp), dimension(3,nLocal) :: f
1006 <   real (kind=dp), dimension(3,nLocal) :: t
949 <  
950 <   logical, intent(inout) :: do_pot, do_stress
951 <   integer, intent(in) :: i, j
952 <   real ( kind = dp ), intent(inout)    :: rijsq, rcijsq
953 <   real ( kind = dp )                :: r, rc
954 <   real ( kind = dp ), intent(inout) :: d(3), dc(3)
955 <  
956 <   logical :: is_EAM_i, is_EAM_j
957 <  
958 <   integer :: me_i, me_j
959 <  
1002 >    real( kind = dp ) :: pot, sw
1003 >    real( kind = dp ), dimension(9,nLocal) :: eFrame
1004 >    real (kind=dp), dimension(9,nLocal) :: A
1005 >    real (kind=dp), dimension(3,nLocal) :: f
1006 >    real (kind=dp), dimension(3,nLocal) :: t
1007  
1008 +    logical, intent(inout) :: do_pot, do_stress
1009 +    integer, intent(in) :: i, j
1010 +    real ( kind = dp ), intent(inout)    :: rijsq, rcijsq
1011 +    real ( kind = dp )                :: r, rc
1012 +    real ( kind = dp ), intent(inout) :: d(3), dc(3)
1013 +
1014 +    logical :: is_EAM_i, is_EAM_j
1015 +
1016 +    integer :: me_i, me_j
1017 +
1018 +
1019      r = sqrt(rijsq)
1020      if (SIM_uses_molecular_cutoffs) then
1021         rc = sqrt(rcijsq)
1022      else
1023         rc = r
1024      endif
967  
1025  
1026 +
1027   #ifdef IS_MPI  
1028 <   me_i = atid_row(i)
1029 <   me_j = atid_col(j)  
1028 >    me_i = atid_row(i)
1029 >    me_j = atid_col(j)  
1030   #else  
1031 <   me_i = atid(i)
1032 <   me_j = atid(j)  
1031 >    me_i = atid(i)
1032 >    me_j = atid(j)  
1033   #endif
1034 <  
1035 <   if (FF_uses_EAM .and. SIM_uses_EAM) then
1036 <      
1037 <      if (PropertyMap(me_i)%is_EAM .and. PropertyMap(me_j)%is_EAM) &
1038 <           call calc_EAM_prepair_rho(i, j, d, r, rijsq )
1039 <      
1040 <   endif
1041 <  
1042 < end subroutine do_prepair
1043 <
1044 <
1045 < subroutine do_preforce(nlocal,pot)
1046 <   integer :: nlocal
1047 <   real( kind = dp ) :: pot
1048 <  
1049 <   if (FF_uses_EAM .and. SIM_uses_EAM) then
1050 <      call calc_EAM_preforce_Frho(nlocal,pot)
1051 <   endif
1052 <  
1053 <  
1054 < end subroutine do_preforce
1055 <
1056 <
1057 < subroutine get_interatomic_vector(q_i, q_j, d, r_sq)
1058 <  
1059 <   real (kind = dp), dimension(3) :: q_i
1060 <   real (kind = dp), dimension(3) :: q_j
1061 <   real ( kind = dp ), intent(out) :: r_sq
1062 <   real( kind = dp ) :: d(3), scaled(3)
1063 <   integer i
1064 <  
1065 <   d(1:3) = q_j(1:3) - q_i(1:3)
1066 <  
1067 <   ! Wrap back into periodic box if necessary
1068 <   if ( SIM_uses_PBC ) then
1069 <      
1070 <      if( .not.boxIsOrthorhombic ) then
1071 <         ! calc the scaled coordinates.
1072 <        
1073 <         scaled = matmul(HmatInv, d)
1074 <        
1075 <         ! wrap the scaled coordinates
1076 <        
1077 <         scaled = scaled  - anint(scaled)
1078 <        
1079 <        
1080 <         ! calc the wrapped real coordinates from the wrapped scaled
1081 <         ! coordinates
1082 <        
1083 <         d = matmul(Hmat,scaled)
1084 <        
1085 <      else
1086 <         ! calc the scaled coordinates.
1087 <        
1088 <         do i = 1, 3
1089 <            scaled(i) = d(i) * HmatInv(i,i)
1090 <            
1091 <            ! wrap the scaled coordinates
1092 <            
1093 <            scaled(i) = scaled(i) - anint(scaled(i))
1094 <            
1095 <            ! calc the wrapped real coordinates from the wrapped scaled
1096 <            ! coordinates
1097 <            
1098 <            d(i) = scaled(i)*Hmat(i,i)
1099 <         enddo
1100 <      endif
1101 <      
1102 <   endif
1103 <  
1104 <   r_sq = dot_product(d,d)
1105 <  
1106 < end subroutine get_interatomic_vector
1107 <
1108 < subroutine zero_work_arrays()
1109 <  
1034 >
1035 >    if (FF_uses_EAM .and. SIM_uses_EAM) then
1036 >
1037 >       if (PropertyMap(me_i)%is_EAM .and. PropertyMap(me_j)%is_EAM) &
1038 >            call calc_EAM_prepair_rho(i, j, d, r, rijsq )
1039 >
1040 >    endif
1041 >
1042 >  end subroutine do_prepair
1043 >
1044 >
1045 >  subroutine do_preforce(nlocal,pot)
1046 >    integer :: nlocal
1047 >    real( kind = dp ) :: pot
1048 >
1049 >    if (FF_uses_EAM .and. SIM_uses_EAM) then
1050 >       call calc_EAM_preforce_Frho(nlocal,pot)
1051 >    endif
1052 >
1053 >
1054 >  end subroutine do_preforce
1055 >
1056 >
1057 >  subroutine get_interatomic_vector(q_i, q_j, d, r_sq)
1058 >
1059 >    real (kind = dp), dimension(3) :: q_i
1060 >    real (kind = dp), dimension(3) :: q_j
1061 >    real ( kind = dp ), intent(out) :: r_sq
1062 >    real( kind = dp ) :: d(3), scaled(3)
1063 >    integer i
1064 >
1065 >    d(1:3) = q_j(1:3) - q_i(1:3)
1066 >
1067 >    ! Wrap back into periodic box if necessary
1068 >    if ( SIM_uses_PBC ) then
1069 >
1070 >       if( .not.boxIsOrthorhombic ) then
1071 >          ! calc the scaled coordinates.
1072 >
1073 >          scaled = matmul(HmatInv, d)
1074 >
1075 >          ! wrap the scaled coordinates
1076 >
1077 >          scaled = scaled  - anint(scaled)
1078 >
1079 >
1080 >          ! calc the wrapped real coordinates from the wrapped scaled
1081 >          ! coordinates
1082 >
1083 >          d = matmul(Hmat,scaled)
1084 >
1085 >       else
1086 >          ! calc the scaled coordinates.
1087 >
1088 >          do i = 1, 3
1089 >             scaled(i) = d(i) * HmatInv(i,i)
1090 >
1091 >             ! wrap the scaled coordinates
1092 >
1093 >             scaled(i) = scaled(i) - anint(scaled(i))
1094 >
1095 >             ! calc the wrapped real coordinates from the wrapped scaled
1096 >             ! coordinates
1097 >
1098 >             d(i) = scaled(i)*Hmat(i,i)
1099 >          enddo
1100 >       endif
1101 >
1102 >    endif
1103 >
1104 >    r_sq = dot_product(d,d)
1105 >
1106 >  end subroutine get_interatomic_vector
1107 >
1108 >  subroutine zero_work_arrays()
1109 >
1110   #ifdef IS_MPI
1053  
1054   q_Row = 0.0_dp
1055   q_Col = 0.0_dp
1111  
1112 <   q_group_Row = 0.0_dp
1113 <   q_group_Col = 0.0_dp  
1114 <  
1115 <   u_l_Row = 0.0_dp
1116 <   u_l_Col = 0.0_dp
1117 <  
1118 <   A_Row = 0.0_dp
1119 <   A_Col = 0.0_dp
1120 <  
1121 <   f_Row = 0.0_dp
1122 <   f_Col = 0.0_dp
1123 <   f_Temp = 0.0_dp
1124 <  
1125 <   t_Row = 0.0_dp
1126 <   t_Col = 0.0_dp
1127 <   t_Temp = 0.0_dp
1128 <  
1129 <   pot_Row = 0.0_dp
1130 <   pot_Col = 0.0_dp
1131 <   pot_Temp = 0.0_dp
1132 <  
1133 <   rf_Row = 0.0_dp
1134 <   rf_Col = 0.0_dp
1135 <   rf_Temp = 0.0_dp
1136 <  
1112 >    q_Row = 0.0_dp
1113 >    q_Col = 0.0_dp
1114 >
1115 >    q_group_Row = 0.0_dp
1116 >    q_group_Col = 0.0_dp  
1117 >
1118 >    eFrame_Row = 0.0_dp
1119 >    eFrame_Col = 0.0_dp
1120 >
1121 >    A_Row = 0.0_dp
1122 >    A_Col = 0.0_dp
1123 >
1124 >    f_Row = 0.0_dp
1125 >    f_Col = 0.0_dp
1126 >    f_Temp = 0.0_dp
1127 >
1128 >    t_Row = 0.0_dp
1129 >    t_Col = 0.0_dp
1130 >    t_Temp = 0.0_dp
1131 >
1132 >    pot_Row = 0.0_dp
1133 >    pot_Col = 0.0_dp
1134 >    pot_Temp = 0.0_dp
1135 >
1136 >    rf_Row = 0.0_dp
1137 >    rf_Col = 0.0_dp
1138 >    rf_Temp = 0.0_dp
1139 >
1140   #endif
1141 <
1142 <   if (FF_uses_EAM .and. SIM_uses_EAM) then
1143 <      call clean_EAM()
1144 <   endif
1145 <  
1146 <   rf = 0.0_dp
1147 <   tau_Temp = 0.0_dp
1148 <   virial_Temp = 0.0_dp
1149 < end subroutine zero_work_arrays
1150 <
1151 < function skipThisPair(atom1, atom2) result(skip_it)
1152 <   integer, intent(in) :: atom1
1153 <   integer, intent(in), optional :: atom2
1154 <   logical :: skip_it
1155 <   integer :: unique_id_1, unique_id_2
1156 <   integer :: me_i,me_j
1157 <   integer :: i
1158 <  
1159 <   skip_it = .false.
1160 <  
1161 <   !! there are a number of reasons to skip a pair or a particle
1162 <   !! mostly we do this to exclude atoms who are involved in short
1163 <   !! range interactions (bonds, bends, torsions), but we also need
1164 <   !! to exclude some overcounted interactions that result from
1165 <   !! the parallel decomposition
1166 <  
1141 >
1142 >    if (FF_uses_EAM .and. SIM_uses_EAM) then
1143 >       call clean_EAM()
1144 >    endif
1145 >
1146 >    rf = 0.0_dp
1147 >    tau_Temp = 0.0_dp
1148 >    virial_Temp = 0.0_dp
1149 >  end subroutine zero_work_arrays
1150 >
1151 >  function skipThisPair(atom1, atom2) result(skip_it)
1152 >    integer, intent(in) :: atom1
1153 >    integer, intent(in), optional :: atom2
1154 >    logical :: skip_it
1155 >    integer :: unique_id_1, unique_id_2
1156 >    integer :: me_i,me_j
1157 >    integer :: i
1158 >
1159 >    skip_it = .false.
1160 >
1161 >    !! there are a number of reasons to skip a pair or a particle
1162 >    !! mostly we do this to exclude atoms who are involved in short
1163 >    !! range interactions (bonds, bends, torsions), but we also need
1164 >    !! to exclude some overcounted interactions that result from
1165 >    !! the parallel decomposition
1166 >
1167   #ifdef IS_MPI
1168 <   !! in MPI, we have to look up the unique IDs for each atom
1169 <   unique_id_1 = AtomRowToGlobal(atom1)
1168 >    !! in MPI, we have to look up the unique IDs for each atom
1169 >    unique_id_1 = AtomRowToGlobal(atom1)
1170   #else
1171 <   !! in the normal loop, the atom numbers are unique
1172 <   unique_id_1 = atom1
1171 >    !! in the normal loop, the atom numbers are unique
1172 >    unique_id_1 = atom1
1173   #endif
1174 <  
1175 <   !! We were called with only one atom, so just check the global exclude
1176 <   !! list for this atom
1177 <   if (.not. present(atom2)) then
1178 <      do i = 1, nExcludes_global
1179 <         if (excludesGlobal(i) == unique_id_1) then
1180 <            skip_it = .true.
1181 <            return
1182 <         end if
1183 <      end do
1184 <      return
1185 <   end if
1186 <  
1174 >
1175 >    !! We were called with only one atom, so just check the global exclude
1176 >    !! list for this atom
1177 >    if (.not. present(atom2)) then
1178 >       do i = 1, nExcludes_global
1179 >          if (excludesGlobal(i) == unique_id_1) then
1180 >             skip_it = .true.
1181 >             return
1182 >          end if
1183 >       end do
1184 >       return
1185 >    end if
1186 >
1187   #ifdef IS_MPI
1188 <   unique_id_2 = AtomColToGlobal(atom2)
1188 >    unique_id_2 = AtomColToGlobal(atom2)
1189   #else
1190 <   unique_id_2 = atom2
1190 >    unique_id_2 = atom2
1191   #endif
1192 <  
1192 >
1193   #ifdef IS_MPI
1194 <   !! this situation should only arise in MPI simulations
1195 <   if (unique_id_1 == unique_id_2) then
1196 <      skip_it = .true.
1197 <      return
1198 <   end if
1199 <  
1200 <   !! this prevents us from doing the pair on multiple processors
1201 <   if (unique_id_1 < unique_id_2) then
1202 <      if (mod(unique_id_1 + unique_id_2,2) == 0) then
1203 <         skip_it = .true.
1204 <         return
1205 <      endif
1206 <   else                
1207 <      if (mod(unique_id_1 + unique_id_2,2) == 1) then
1208 <         skip_it = .true.
1209 <         return
1210 <      endif
1211 <   endif
1194 >    !! this situation should only arise in MPI simulations
1195 >    if (unique_id_1 == unique_id_2) then
1196 >       skip_it = .true.
1197 >       return
1198 >    end if
1199 >
1200 >    !! this prevents us from doing the pair on multiple processors
1201 >    if (unique_id_1 < unique_id_2) then
1202 >       if (mod(unique_id_1 + unique_id_2,2) == 0) then
1203 >          skip_it = .true.
1204 >          return
1205 >       endif
1206 >    else                
1207 >       if (mod(unique_id_1 + unique_id_2,2) == 1) then
1208 >          skip_it = .true.
1209 >          return
1210 >       endif
1211 >    endif
1212   #endif
1213 <  
1214 <   !! the rest of these situations can happen in all simulations:
1215 <   do i = 1, nExcludes_global      
1216 <      if ((excludesGlobal(i) == unique_id_1) .or. &
1217 <           (excludesGlobal(i) == unique_id_2)) then
1218 <         skip_it = .true.
1219 <         return
1220 <      endif
1221 <   enddo
1222 <  
1223 <   do i = 1, nSkipsForAtom(atom1)
1224 <      if (skipsForAtom(atom1, i) .eq. unique_id_2) then
1225 <         skip_it = .true.
1226 <         return
1227 <      endif
1228 <   end do
1229 <  
1230 <   return
1231 < end function skipThisPair
1232 <
1233 < function FF_UsesDirectionalAtoms() result(doesit)
1234 <   logical :: doesit
1235 <   doesit = FF_uses_DirectionalAtoms .or. FF_uses_Dipoles .or. &
1236 <        FF_uses_Sticky .or. FF_uses_GayBerne .or. FF_uses_Shapes
1237 < end function FF_UsesDirectionalAtoms
1238 <
1239 < function FF_RequiresPrepairCalc() result(doesit)
1240 <   logical :: doesit
1241 <   doesit = FF_uses_EAM
1242 < end function FF_RequiresPrepairCalc
1243 <
1244 < function FF_RequiresPostpairCalc() result(doesit)
1245 <   logical :: doesit
1246 <   doesit = FF_uses_RF
1247 < end function FF_RequiresPostpairCalc
1248 <
1213 >
1214 >    !! the rest of these situations can happen in all simulations:
1215 >    do i = 1, nExcludes_global      
1216 >       if ((excludesGlobal(i) == unique_id_1) .or. &
1217 >            (excludesGlobal(i) == unique_id_2)) then
1218 >          skip_it = .true.
1219 >          return
1220 >       endif
1221 >    enddo
1222 >
1223 >    do i = 1, nSkipsForAtom(atom1)
1224 >       if (skipsForAtom(atom1, i) .eq. unique_id_2) then
1225 >          skip_it = .true.
1226 >          return
1227 >       endif
1228 >    end do
1229 >
1230 >    return
1231 >  end function skipThisPair
1232 >
1233 >  function FF_UsesDirectionalAtoms() result(doesit)
1234 >    logical :: doesit
1235 >    doesit = FF_uses_DirectionalAtoms .or. FF_uses_Dipoles .or. &
1236 >         FF_uses_Quadrupoles .or. FF_uses_Sticky .or. &
1237 >         FF_uses_GayBerne .or. FF_uses_Shapes
1238 >  end function FF_UsesDirectionalAtoms
1239 >
1240 >  function FF_RequiresPrepairCalc() result(doesit)
1241 >    logical :: doesit
1242 >    doesit = FF_uses_EAM
1243 >  end function FF_RequiresPrepairCalc
1244 >
1245 >  function FF_RequiresPostpairCalc() result(doesit)
1246 >    logical :: doesit
1247 >    doesit = FF_uses_RF
1248 >  end function FF_RequiresPostpairCalc
1249 >
1250   #ifdef PROFILE
1251 < function getforcetime() result(totalforcetime)
1252 <   real(kind=dp) :: totalforcetime
1253 <   totalforcetime = forcetime
1254 < end function getforcetime
1251 >  function getforcetime() result(totalforcetime)
1252 >    real(kind=dp) :: totalforcetime
1253 >    totalforcetime = forcetime
1254 >  end function getforcetime
1255   #endif
1197
1198 !! This cleans componets of force arrays belonging only to fortran
1256  
1257 < subroutine add_stress_tensor(dpair, fpair)
1201 <  
1202 <   real( kind = dp ), dimension(3), intent(in) :: dpair, fpair
1203 <  
1204 <   ! because the d vector is the rj - ri vector, and
1205 <   ! because fx, fy, fz are the force on atom i, we need a
1206 <   ! negative sign here:  
1207 <  
1208 <   tau_Temp(1) = tau_Temp(1) - dpair(1) * fpair(1)
1209 <   tau_Temp(2) = tau_Temp(2) - dpair(1) * fpair(2)
1210 <   tau_Temp(3) = tau_Temp(3) - dpair(1) * fpair(3)
1211 <   tau_Temp(4) = tau_Temp(4) - dpair(2) * fpair(1)
1212 <   tau_Temp(5) = tau_Temp(5) - dpair(2) * fpair(2)
1213 <   tau_Temp(6) = tau_Temp(6) - dpair(2) * fpair(3)
1214 <   tau_Temp(7) = tau_Temp(7) - dpair(3) * fpair(1)
1215 <   tau_Temp(8) = tau_Temp(8) - dpair(3) * fpair(2)
1216 <   tau_Temp(9) = tau_Temp(9) - dpair(3) * fpair(3)
1217 <  
1218 <   virial_Temp = virial_Temp + &
1219 <        (tau_Temp(1) + tau_Temp(5) + tau_Temp(9))
1220 <  
1221 < end subroutine add_stress_tensor
1222 <
1223 < end module doForces
1257 >  !! This cleans componets of force arrays belonging only to fortran
1258  
1259 < !! Interfaces for C programs to module....
1259 >  subroutine add_stress_tensor(dpair, fpair)
1260  
1261 < subroutine initFortranFF(use_RF_c, thisStat)
1228 <    use doForces, ONLY: init_FF
1229 <    logical, intent(in) :: use_RF_c
1261 >    real( kind = dp ), dimension(3), intent(in) :: dpair, fpair
1262  
1263 <    integer, intent(out) :: thisStat  
1264 <    call init_FF(use_RF_c, thisStat)
1263 >    ! because the d vector is the rj - ri vector, and
1264 >    ! because fx, fy, fz are the force on atom i, we need a
1265 >    ! negative sign here:  
1266  
1267 < end subroutine initFortranFF
1267 >    tau_Temp(1) = tau_Temp(1) - dpair(1) * fpair(1)
1268 >    tau_Temp(2) = tau_Temp(2) - dpair(1) * fpair(2)
1269 >    tau_Temp(3) = tau_Temp(3) - dpair(1) * fpair(3)
1270 >    tau_Temp(4) = tau_Temp(4) - dpair(2) * fpair(1)
1271 >    tau_Temp(5) = tau_Temp(5) - dpair(2) * fpair(2)
1272 >    tau_Temp(6) = tau_Temp(6) - dpair(2) * fpair(3)
1273 >    tau_Temp(7) = tau_Temp(7) - dpair(3) * fpair(1)
1274 >    tau_Temp(8) = tau_Temp(8) - dpair(3) * fpair(2)
1275 >    tau_Temp(9) = tau_Temp(9) - dpair(3) * fpair(3)
1276  
1277 <  subroutine doForceloop(q, q_group, A, u_l, f, t, tau, pot, &
1278 <       do_pot_c, do_stress_c, error)
1238 <      
1239 <       use definitions, ONLY: dp
1240 <       use simulation
1241 <       use doForces, ONLY: do_force_loop
1242 <    !! Position array provided by C, dimensioned by getNlocal
1243 <    real ( kind = dp ), dimension(3, nLocal) :: q
1244 <    !! molecular center-of-mass position array
1245 <    real ( kind = dp ), dimension(3, nGroups) :: q_group
1246 <    !! Rotation Matrix for each long range particle in simulation.
1247 <    real( kind = dp), dimension(9, nLocal) :: A    
1248 <    !! Unit vectors for dipoles (lab frame)
1249 <    real( kind = dp ), dimension(3,nLocal) :: u_l
1250 <    !! Force array provided by C, dimensioned by getNlocal
1251 <    real ( kind = dp ), dimension(3,nLocal) :: f
1252 <    !! Torsion array provided by C, dimensioned by getNlocal
1253 <    real( kind = dp ), dimension(3,nLocal) :: t    
1277 >    virial_Temp = virial_Temp + &
1278 >         (tau_Temp(1) + tau_Temp(5) + tau_Temp(9))
1279  
1280 <    !! Stress Tensor
1281 <    real( kind = dp), dimension(9) :: tau  
1282 <    real ( kind = dp ) :: pot
1258 <    logical ( kind = 2) :: do_pot_c, do_stress_c
1259 <    integer :: error
1260 <    
1261 <    call do_force_loop(q, q_group, A, u_l, f, t, tau, pot, &
1262 <       do_pot_c, do_stress_c, error)
1263 <      
1264 < end subroutine doForceloop
1280 >  end subroutine add_stress_tensor
1281 >
1282 > end module doForces

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines