--- trunk/OOPSE/libmdtools/do_Forces.F90 2003/03/24 21:55:34 394 +++ trunk/OOPSE/libmdtools/do_Forces.F90 2003/04/01 16:50:14 441 @@ -4,7 +4,7 @@ !! @author Charles F. Vardeman II !! @author Matthew Meineke -!! @version $Id: do_Forces.F90,v 1.4 2003-03-24 21:55:34 gezelter Exp $, $Date: 2003-03-24 21:55:34 $, $Name: not supported by cvs2svn $, $Revision: 1.4 $ +!! @version $Id: do_Forces.F90,v 1.7 2003-04-01 16:50:14 chuckv Exp $, $Date: 2003-04-01 16:50:14 $, $Name: not supported by cvs2svn $, $Revision: 1.7 $ module do_Forces use force_globals @@ -167,7 +167,7 @@ contains logical ( kind = 2) :: do_pot_c, do_stress_c logical :: do_pot logical :: do_stress -#ifdef IS_MPI +#ifdef IS_MPI real( kind = DP ) :: pot_local integer :: nrow integer :: ncol @@ -189,6 +189,7 @@ contains !! initialize local variables #ifdef IS_MPI + pot_local = 0.0_dp nlocal = getNlocal() nrow = getNrow(plan_row) ncol = getNcol(plan_col) @@ -196,7 +197,7 @@ contains nlocal = getNlocal() natoms = nlocal #endif - + call getRcut(rcut,rc2=rcutsq) call getRlist(rlist,rlistsq) @@ -277,7 +278,7 @@ contains if (rijsq < rcutsq) then call do_pair(i, j, rijsq, d, do_pot, do_stress, & - u_l, A, f, t,pot) + u_l, A, f, t, pot_local) endif endif enddo inner @@ -299,7 +300,7 @@ contains call get_interatomic_vector(q_Row(:,i), q_Col(:,j), d, rijsq) call do_pair(i, j, rijsq, d, do_pot, do_stress, & - u_l, A, f, t,pot) + u_l, A, f, t, pot_local) enddo endif @@ -346,7 +347,7 @@ contains if (rijsq < rcutsq) then call do_pair(i, j, rijsq, d, do_pot, do_stress, & - u_l, A, f, t,pot) + u_l, A, f, t, pot) endif endif enddo inner @@ -368,7 +369,7 @@ contains call get_interatomic_vector(q(:,i), q(:,j), d, rijsq) call do_pair(i, j, rijsq, d, do_pot, do_stress, & - u_l, A, f, t,pot) + u_l, A, f, t, pot) enddo endif @@ -381,15 +382,26 @@ contains #ifdef IS_MPI !!distribute forces - - call scatter(f_Row,f,plan_row3d) + + f_temp = 0.0_dp + call scatter(f_Row,f_temp,plan_row3d) + do i = 1,nlocal + f(1:3,i) = f(1:3,i) + f_temp(1:3,i) + end do + + f_temp = 0.0_dp call scatter(f_Col,f_temp,plan_col3d) do i = 1,nlocal f(1:3,i) = f(1:3,i) + f_temp(1:3,i) end do if (FF_UsesDirectionalAtoms() .and. SimUsesDirectionalAtoms()) then - call scatter(t_Row,t,plan_row3d) + t_temp = 0.0_dp + call scatter(t_Row,t_temp,plan_row3d) + do i = 1,nlocal + t(1:3,i) = t(1:3,i) + t_temp(1:3,i) + end do + t_temp = 0.0_dp call scatter(t_Col,t_temp,plan_col3d) do i = 1,nlocal @@ -400,20 +412,20 @@ contains if (do_pot) then ! scatter/gather pot_row into the members of my column call scatter(pot_Row, pot_Temp, plan_row) - + ! scatter/gather pot_local into all other procs ! add resultant to get total pot do i = 1, nlocal pot_local = pot_local + pot_Temp(i) enddo + + pot_Temp = 0.0_DP - pot_Temp = 0.0_DP - call scatter(pot_Col, pot_Temp, plan_col) do i = 1, nlocal pot_local = pot_local + pot_Temp(i) enddo - + endif #endif @@ -461,7 +473,7 @@ contains #ifdef IS_MPI if (do_pot) then - pot = pot_local + pot = pot + pot_local !! we assume the c code will do the allreduce to get the total potential !! we could do it right here if we needed to... endif @@ -484,7 +496,7 @@ contains end subroutine do_force_loop - subroutine do_pair(i, j, rijsq, d, do_pot, do_stress, u_l, A, f, t,pot) + subroutine do_pair(i, j, rijsq, d, do_pot, do_stress, u_l, A, f, t, pot) real( kind = dp ) :: pot real( kind = dp ), dimension(:,:) :: u_l @@ -687,7 +699,7 @@ contains #else unique_id_2 = atom2 #endif - + #ifdef IS_MPI !! this situation should only arise in MPI simulations if (unique_id_1 == unique_id_2) then @@ -697,14 +709,18 @@ contains !! this prevents us from doing the pair on multiple processors if (unique_id_1 < unique_id_2) then - if (mod(unique_id_1 + unique_id_2,2) == 0) skip_it = .true. - return + if (mod(unique_id_1 + unique_id_2,2) == 0) then + skip_it = .true. + return + endif else - if (mod(unique_id_1 + unique_id_2,2) == 1) skip_it = .true. - return + if (mod(unique_id_1 + unique_id_2,2) == 1) then + skip_it = .true. + return + endif endif #endif - + !! the rest of these situations can happen in all simulations: do i = 1, nExcludes_global if ((excludesGlobal(i) == unique_id_1) .or. & @@ -713,7 +729,7 @@ contains return endif enddo - + do i = 1, nExcludes_local if (excludesLocal(1,i) == unique_id_1) then if (excludesLocal(2,i) == unique_id_2) then