--- trunk/OOPSE/libmdtools/mpiSimulation_module.F90 2003/10/28 20:09:45 834 +++ trunk/OOPSE/libmdtools/mpiSimulation_module.F90 2004/05/07 21:35:05 1150 @@ -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.12 2004-05-07 21:35:04 gezelter Exp $, $Date: 2004-05-07 21:35:04 $, $Name: not supported by cvs2svn $, $Revision: 1.12 $ module mpiSimulation use definitions #ifdef IS_MPI - use mpi + use oopseMPI implicit none PRIVATE @@ -25,6 +25,8 @@ module mpiSimulation public :: replanSimParallel public :: getNcol public :: getNrow + public :: getNcolGroup + public :: getNrowGroup public :: isMPISimSet public :: printComponentPlan public :: getMyNode @@ -32,7 +34,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 +62,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 @@ -71,9 +73,8 @@ module mpiSimulation #include "mpiComponentPlan.h" - !! 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 @@ -103,6 +104,10 @@ module mpiSimulation type (gs_plan), public, save :: plan_col3d type (gs_plan), public, save :: plan_row_Rotation type (gs_plan), public, save :: plan_col_Rotation + type (gs_plan), public, save :: plan_row_Group + type (gs_plan), public, save :: plan_col_Group + type (gs_plan), public, save :: plan_row_Group_3d + type (gs_plan), public, save :: plan_col_Group_3d type (mpiComponentPlan), pointer :: simComponentPlan @@ -147,8 +152,6 @@ contains write(*,*) 'mpiSim_mod thinks node', thisComponentPlan%myNode, ' has tags(1) = ', tags(1) - - status = 0 if (componentPlanSet) then return @@ -181,15 +184,22 @@ contains mpiSim,mpiSim%rowComm,plan_row3d) call plan_gather_scatter(9,mpiSim%myNlocal,& mpiSim,mpiSim%rowComm,plan_row_Rotation) + call plan_gather_scatter(1,mpiSim%myNgroup,& + mpiSim,mpiSim%rowComm,plan_row_Group) + call plan_gather_scatter(nDim,mpiSim%myNgroup,& + mpiSim,mpiSim%rowComm,plan_row_Group_3d) + call plan_gather_scatter(1,mpiSim%myNlocal,& mpiSim,mpiSim%columnComm,plan_col) call plan_gather_scatter(nDim,mpiSim%myNlocal,& mpiSim,mpiSim%columnComm,plan_col3d) - call plan_gather_scatter(9,mpiSim%myNlocal,& + call plan_gather_scatter(9,mpiSim%myNlocal,& mpiSim,mpiSim%columnComm,plan_col_Rotation) - - - + call plan_gather_scatter(1,mpiSim%myNgroup,& + mpiSim,mpiSim%columnComm,plan_col_Group) + call plan_gather_scatter(nDim,mpiSim%myNgroup,& + mpiSim,mpiSim%columnComm,plan_col_Group_3d) + ! Initialize tags call setTags(tags,localStatus) if (localStatus /= 0) then @@ -220,9 +230,14 @@ contains call unplan_gather_scatter(plan_row) call unplan_gather_scatter(plan_row3d) call unplan_gather_scatter(plan_row_Rotation) + call unplan_gather_scatter(plan_row_Group) + call unplan_gather_scatter(plan_row_Group_3d) + call unplan_gather_scatter(plan_col) call unplan_gather_scatter(plan_col3d) call unplan_gather_scatter(plan_col_Rotation) + call unplan_gather_scatter(plan_col_Group) + call unplan_gather_scatter(plan_col_Group_3d) !! initialize gather and scatter plans used in this simulation call plan_gather_scatter(1,thisComponentPlan%myNlocal,& @@ -231,15 +246,22 @@ contains thisComponentPlan,thisComponentPlan%rowComm,plan_row3d) call plan_gather_scatter(9,thisComponentPlan%myNlocal,& thisComponentPlan,thisComponentPlan%rowComm,plan_row_Rotation) + call plan_gather_scatter(1,thisComponentPlan%myNgroup,& + thisComponentPlan,thisComponentPlan%rowComm,plan_row_Group) + call plan_gather_scatter(nDim,thisComponentPlan%myNgroup,& + thisComponentPlan,thisComponentPlan%rowComm,plan_row_Group_3d) + call plan_gather_scatter(1,thisComponentPlan%myNlocal,& thisComponentPlan,thisComponentPlan%columnComm,plan_col) call plan_gather_scatter(nDim,thisComponentPlan%myNlocal,& - thisComponentPlan,thisComponentPlan%rowComm,plan_col3d) + thisComponentPlan,thisComponentPlan%columnComm,plan_col3d) call plan_gather_scatter(9,thisComponentPlan%myNlocal,& - thisComponentPlan,thisComponentPlan%rowComm,plan_col_Rotation) - + thisComponentPlan,thisComponentPlan%columnComm,plan_col_Rotation) + call plan_gather_scatter(1,thisComponentPlan%myNgroup,& + thisComponentPlan,thisComponentPlan%columnComm,plan_col_Group) + call plan_gather_scatter(nDim,thisComponentPlan%myNgroup,& + thisComponentPlan,thisComponentPlan%columnComm,plan_col_Group_3d) - end subroutine replanSimParallel !! Updates number of row and column components for long range forces. @@ -471,9 +493,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 +525,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 +534,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 +553,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 +564,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 +572,7 @@ contains this_plan%myPlanComm, mpi_err) #ifdef PROFILE - commTimeFinal = mpi_wtime() + call cpu_time(commTimeFinal) commTime = commTime + commTimeFinal - commTimeInitial #endif @@ -563,20 +585,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 +611,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 +648,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 +702,7 @@ contains call gather(tags,tagRow,plan_row) call gather(tags,tagColumn,plan_col) + end subroutine setTags ! pure function getNcol(thisplan) result(ncol) @@ -677,6 +719,18 @@ contains nrow = thisplan%gsComponentPlan%nComponentsRow end function getNrow + function getNcolGroup(thisplan) result(ncol_group) + type (gs_plan), intent(in) :: thisplan + integer :: ncol_group + ncol_group = thisplan%gsComponentPlan%nGroupColumn + end function getNcolGroup + + function getNrowGroup(thisplan) result(nrow_group) + type (gs_plan), intent(in) :: thisplan + integer :: nrow_group + nrow_group = thisplan%gsComponentPlan%nGroupRow + end function getNrowGroup + function isMPISimSet() result(isthisSimSet) logical :: isthisSimSet if (isSimSet) then @@ -729,10 +783,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