--- trunk/OOPSE/libmdtools/mpiSimulation_module.F90 2003/10/28 20:09:45 834 +++ trunk/OOPSE/libmdtools/mpiSimulation_module.F90 2003/12/18 20:46:45 883 @@ -7,12 +7,12 @@ !! !! @author Charles F. Vardeman II !! @author Matthew Meineke -!! @version $Id: mpiSimulation_module.F90,v 1.8 2003-10-28 20:09:38 gezelter Exp $, $Date: 2003-10-28 20:09:38 $, $Name: not supported by cvs2svn $, $Revision: 1.8 $ +!! @version $Id: mpiSimulation_module.F90,v 1.11 2003-12-18 20:46:45 chuckv Exp $, $Date: 2003-12-18 20:46:45 $, $Name: not supported by cvs2svn $, $Revision: 1.11 $ module mpiSimulation use definitions #ifdef IS_MPI - use mpi + use oopseMPI implicit none PRIVATE @@ -32,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 @@ -60,9 +60,9 @@ module mpiSimulation #ifdef PROFILE public :: printCommTime - - real(kind = dp ), save :: commTime = 0.0_dp - real(kind = dp ) :: commTimeInitial,commTimeFinal + public :: getCommTime + real,save :: commTime = 0.0 + real :: commTimeInitial,commTimeFinal #endif !! Include mpiComponentPlan type. mpiComponentPlan is a @@ -73,7 +73,7 @@ module mpiSimulation !! Tags used during force loop for parallel simulation - integer, allocatable, dimension(:) :: tagLocal + integer, public, allocatable, dimension(:) :: tagLocal integer, public, allocatable, dimension(:) :: tagRow integer, public, allocatable, dimension(:) :: tagColumn @@ -471,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 @@ -503,8 +503,8 @@ 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 @@ -512,13 +512,13 @@ contains if (present(status)) status = 0 noffset = this_plan%displs(this_plan%myPlanRank) #ifdef PROFILE - commTimeInitial = mpi_wtime() + call cpu_time(commTimeInitial) #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() + call cpu_time(commTimeFinal) commTime = commTime + commTimeFinal - commTimeInitial #endif @@ -531,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 @@ -542,7 +542,7 @@ contains ! noffset = this_plan%displs(this_plan%me) #ifdef PROFILE - commTimeInitial = mpi_wtime() + call cpu_time(commTimeInitial) #endif call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, & @@ -550,7 +550,7 @@ contains this_plan%myPlanComm, mpi_err) #ifdef PROFILE - commTimeFinal = mpi_wtime() + call cpu_time(commTimeFinal) commTime = commTime + commTimeFinal - commTimeInitial #endif @@ -563,20 +563,20 @@ 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() + call cpu_time(commTimeInitial) #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() + call cpu_time(commTimeFinal) commTime = commTime + commTimeFinal - commTimeInitial #endif @@ -589,20 +589,20 @@ 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() + call cpu_time(commTimeInitial) #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() + call cpu_time(commTimeFinal) commTime = commTime + commTimeFinal - commTimeInitial #endif @@ -626,7 +626,26 @@ contains ! allocate row arrays nrow = getNrow(plan_row) ncol = getNcol(plan_col) + + if(.not. allocated(tagLocal)) then + allocate(tagLocal(size(tags)),STAT=alloc_stat) + if (alloc_stat /= 0 ) then + status = -1 + return + endif + else + deallocate(tagLocal) + allocate(tagLocal(size(tags)),STAT=alloc_stat) + if (alloc_stat /= 0 ) then + status = -1 + return + endif + endif + + tagLocal = tags + + if (.not. allocated(tagRow)) then allocate(tagRow(nrow),STAT=alloc_stat) if (alloc_stat /= 0 ) then @@ -661,6 +680,7 @@ contains call gather(tags,tagRow,plan_row) call gather(tags,tagColumn,plan_col) + end subroutine setTags ! pure function getNcol(thisplan) result(ncol) @@ -729,10 +749,14 @@ contains #ifdef PROFILE subroutine printCommTime() - write(*,*) "MPI communication time is: ", commTime - end subroutine printCommTime + + function getCommTime() result(comm_time) + real :: comm_time + comm_time = commTime + end function getCommTime + #endif #endif // is_mpi