--- trunk/OOPSE/libmdtools/mpiSimulation_module.F90	2003/03/21 17:42:12	378
+++ trunk/OOPSE/libmdtools/mpiSimulation_module.F90	2003/11/07 21:46:56	858
@@ -1,5 +1,5 @@
-#ifdef IS_MPI
 
+
 !! MPI support for long range forces using force decomposition 
 !! on a square grid of processors.
 !! Corresponds to mpiSimunation.cpp for C++
@@ -7,11 +7,12 @@
 !!
 !! @author Charles F. Vardeman II
 !! @author Matthew Meineke
-!! @version $Id: mpiSimulation_module.F90,v 1.1.1.1 2003-03-21 17:42:12 mmeineke Exp $, $Date: 2003-03-21 17:42:12 $, $Name: not supported by cvs2svn $, $Revision: 1.1.1.1 $
+!! @version $Id: mpiSimulation_module.F90,v 1.9 2003-11-07 21:46:56 chuckv Exp $, $Date: 2003-11-07 21:46:56 $, $Name: not supported by cvs2svn $, $Revision: 1.9 $
 
 module mpiSimulation  
   use definitions
-  use mpi
+#ifdef IS_MPI
+  use oopseMPI
   implicit none
   PRIVATE
 
@@ -31,7 +32,7 @@ module mpiSimulation  
 !! PUBLIC  Subroutines contained in MPI module
   public :: mpi_bcast
   public :: mpi_allreduce
-  public :: mpi_reduce
+!  public :: mpi_reduce
   public :: mpi_send
   public :: mpi_recv
   public :: mpi_get_processor_name
@@ -47,16 +48,23 @@ module mpiSimulation  
   public :: mpi_status_size
   public :: mpi_any_source
 
+
+
 !! Safety logical to prevent access to ComponetPlan until
 !! set by C++.
-  logical :: ComponentPlanSet = .false.
+  logical, save :: ComponentPlanSet = .false.
 
 
 !! generic mpi error declaration.
-  integer,public  :: mpi_err
+  integer, public :: mpi_err
 
-  
+#ifdef PROFILE
+  public :: printCommTime
 
+  real(kind = dp ), save :: commTime = 0.0_dp
+  real(kind = dp ) :: commTimeInitial,commTimeFinal
+#endif
+
 !! Include mpiComponentPlan type. mpiComponentPlan is a 
 !! dual header file for both c and fortran.
 #define __FORTRAN90
@@ -70,10 +78,10 @@ module mpiSimulation  
   integer, public, allocatable, dimension(:) :: tagColumn
 
 !! Logical set true if mpiSimulation has been initialized
-  logical :: isSimSet = .false.
+  logical, save :: isSimSet = .false.
 
 
-  type (mpiComponentPlan) :: mpiSim
+  type (mpiComponentPlan), save :: mpiSim
 
 !! gs_plan contains plans for gather and scatter routines
   type, public :: gs_plan
@@ -89,12 +97,12 @@ module mpiSimulation  
   end type gs_plan
 
 ! plans for different decompositions
-  type (gs_plan), public :: plan_row
-  type (gs_plan), public :: plan_row3d
-  type (gs_plan), public :: plan_col
-  type (gs_plan), public :: plan_col3d
-  type(gs_plan),  public :: plan_row_Rotation
-  type(gs_plan),  public :: plan_col_Rotation
+  type (gs_plan), public, save :: plan_row
+  type (gs_plan), public, save :: plan_row3d
+  type (gs_plan), public, save :: plan_col
+  type (gs_plan), public, save :: plan_col3d
+  type (gs_plan),  public, save :: plan_row_Rotation
+  type (gs_plan),  public, save :: plan_col_Rotation
 
   type (mpiComponentPlan), pointer :: simComponentPlan
 
@@ -137,7 +145,10 @@ contains
 !! Global reference tag for local particles
     integer, dimension(ntags),intent(inout) :: tags 
 
+    write(*,*) 'mpiSim_mod thinks node', thisComponentPlan%myNode, ' has tags(1) = ', tags(1)
 
+
+
     status = 0
     if (componentPlanSet) then
        return
@@ -254,6 +265,7 @@ contains
     
     nComponentsLocal = thisComponentPlan%myNlocal
 
+    write(*,*) "UpdateGridComponents: myNlocal ", nComponentsLocal
     call mpi_allreduce(nComponentsLocal,nComponentsRow,1,mpi_integer,&
          mpi_sum,thisComponentPlan%rowComm,mpiErrors)
     if (mpiErrors /= 0) then
@@ -270,7 +282,10 @@ contains
 
     thisComponentPlan%nComponentsRow = nComponentsRow
     thisComponentPlan%nComponentsColumn = nComponentsColumn
-
+    write(*,*) "UpdateGridComponents: myNRow ",&
+         thisComponentPlan%nComponentsRow
+    write(*,*) "UpdateGridComponents: myNColumn ",&
+         thisComponentPlan%nComponentsColumn
 
   end subroutine updateGridComponents
 
@@ -456,9 +471,9 @@ contains
 
   subroutine gather_integer( sbuffer, rbuffer, this_plan, status)
 
-    type (gs_plan), intent(in) :: this_plan
-    integer, dimension(:), intent(in) :: sbuffer
-    integer, dimension(:), intent(in) :: rbuffer
+    type (gs_plan), intent(inout) :: this_plan
+    integer, dimension(:), intent(inout) :: sbuffer
+    integer, dimension(:), intent(inout) :: rbuffer
     integer :: noffset
     integer, intent(out), optional :: status
     integer :: i
@@ -488,18 +503,24 @@ contains
   subroutine gather_double( sbuffer, rbuffer, this_plan, status)
 
     type (gs_plan), intent(in) :: this_plan
-    real( kind = DP ), dimension(:), intent(in) :: sbuffer
-    real( kind = DP ), dimension(:), intent(in) :: rbuffer
+    real( kind = DP ), dimension(:), intent(inout) :: sbuffer
+    real( kind = DP ), dimension(:), intent(inout) :: rbuffer
     integer :: noffset
     integer, intent(out), optional :: status
 
 
     if (present(status)) status = 0
     noffset = this_plan%displs(this_plan%myPlanRank)
-
+#ifdef PROFILE
+    commTimeInitial = mpi_wtime()
+#endif
     call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, &
          rbuffer,this_plan%counts,this_plan%displs,mpi_double_precision, &
          this_plan%myPlanComm, mpi_err)
+#ifdef PROFILE
+    commTimeFinal = mpi_wtime()
+    commTime = commTime + commTimeFinal - commTimeInitial
+#endif
 
     if (mpi_err /= 0) then
       if (present(status)) status  = -1
@@ -510,8 +531,8 @@ contains
   subroutine gather_double_2d( sbuffer, rbuffer, this_plan, status)
 
     type (gs_plan), intent(in) :: this_plan
-    real( kind = DP ), dimension(:,:), intent(in) :: sbuffer
-    real( kind = DP ), dimension(:,:), intent(in) :: rbuffer
+    real( kind = DP ), dimension(:,:), intent(inout) :: sbuffer
+    real( kind = DP ), dimension(:,:), intent(inout) :: rbuffer
     integer :: noffset,i,ierror
     integer, intent(out), optional :: status
     
@@ -520,11 +541,19 @@ contains
    if (present(status)) status = 0
 
 !    noffset = this_plan%displs(this_plan%me)
-    
+#ifdef PROFILE
+   commTimeInitial = mpi_wtime()
+#endif
+
     call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, &
         rbuffer,this_plan%counts,this_plan%displs,mpi_double_precision, &
         this_plan%myPlanComm, mpi_err)
 
+#ifdef PROFILE
+    commTimeFinal = mpi_wtime()
+    commTime = commTime + commTimeFinal - commTimeInitial
+#endif
+
     if (mpi_err /= 0) then
       if (present(status)) status = -1
     endif
@@ -534,15 +563,22 @@ contains
   subroutine scatter_double( sbuffer, rbuffer, this_plan, status)
 
     type (gs_plan), intent(in) :: this_plan
-    real( kind = DP ), dimension(:), intent(in) :: sbuffer
-    real( kind = DP ), dimension(:), intent(in) :: rbuffer
+    real( kind = DP ), dimension(:), intent(inout) :: sbuffer
+    real( kind = DP ), dimension(:), intent(inout) :: rbuffer
     integer, intent(out), optional :: status
     external mpi_reduce_scatter
 
    if (present(status)) status = 0
 
+#ifdef PROFILE
+   commTimeInitial = mpi_wtime()
+#endif
     call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
          mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err)
+#ifdef PROFILE
+    commTimeFinal = mpi_wtime()
+    commTime = commTime + commTimeFinal - commTimeInitial
+#endif
 
     if (mpi_err /= 0) then
      if (present(status))  status = -1
@@ -553,14 +589,22 @@ contains
   subroutine scatter_double_2d( sbuffer, rbuffer, this_plan, status)
 
     type (gs_plan), intent(in) :: this_plan
-    real( kind = DP ), dimension(:,:), intent(in) :: sbuffer
-    real( kind = DP ), dimension(:,:), intent(in) :: rbuffer
+    real( kind = DP ), dimension(:,:), intent(inout) :: sbuffer
+    real( kind = DP ), dimension(:,:), intent(inout) :: rbuffer
     integer, intent(out), optional :: status
     external mpi_reduce_scatter
  
    if (present(status)) status = 0
+#ifdef PROFILE
+   commTimeInitial = mpi_wtime()
+#endif
+
     call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
          mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err)
+#ifdef PROFILE
+    commTimeFinal = mpi_wtime()
+    commTime = commTime + commTimeFinal - commTimeInitial
+#endif
 
     if (mpi_err /= 0) then
       if (present(status)) status = -1
@@ -619,16 +663,18 @@ contains
 
   end subroutine setTags
 
-  pure function getNcol(thisplan) result(ncol)
+!  pure function getNcol(thisplan) result(ncol)
+  function getNcol(thisplan) result(ncol)
     type (gs_plan), intent(in) :: thisplan
     integer :: ncol
     ncol = thisplan%gsComponentPlan%nComponentsColumn
   end function getNcol
 
-  pure function getNrow(thisplan) result(ncol)
+!  pure function getNrow(thisplan) result(nrow)
+  function getNrow(thisplan) result(nrow)
     type (gs_plan), intent(in) :: thisplan
-    integer :: ncol
-    ncol = thisplan%gsComponentPlan%nComponentsrow
+    integer :: nrow
+    nrow = thisplan%gsComponentPlan%nComponentsRow
   end function getNrow
 
   function isMPISimSet() result(isthisSimSet)
@@ -662,9 +708,6 @@ contains
        write(default_error,*) "nBondGlobal: ", mpiSim%nBondsGlobal
        write(default_error,*) "nTorsionsGlobal: ", mpiSim%nTorsionsGlobal
        write(default_error,*) "nSRIGlobal: ", mpiSim%nSRIGlobal
-       write(default_error,*) "myMolStart: ", mpiSim%myMolStart
-       write(default_error,*) "myMolEnd: ", mpiSim%myMolEnd
-       write(default_error,*) "myMol: ", mpiSim%myMol
        write(default_error,*) "myNlocal: ", mpiSim%myNlocal
        write(default_error,*) "myNode: ", mpiSim%myNode
        write(default_error,*) "numberProcessors: ", mpiSim%numberProcessors
@@ -684,7 +727,15 @@ contains
     myNode = mpiSim%myNode
   end function getMyNode
 
+#ifdef PROFILE
+  subroutine printCommTime()
 
-end module mpiSimulation
+    write(*,*) "MPI communication time is: ", commTime
 
+  end subroutine printCommTime
+#endif
+
 #endif // is_mpi
+end module mpiSimulation
+
+