--- trunk/OOPSE/libmdtools/mpiSimulation_module.F90 2003/03/26 23:14:02 416 +++ trunk/OOPSE/libmdtools/mpiSimulation_module.F90 2004/05/07 21:35:05 1150 @@ -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.2 2003-03-26 23:14:02 gezelter Exp $, $Date: 2003-03-26 23:14:02 $, $Name: not supported by cvs2svn $, $Revision: 1.2 $ +!! @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 - use mpi +#ifdef IS_MPI + use oopseMPI implicit none PRIVATE @@ -24,6 +25,8 @@ module mpiSimulation public :: replanSimParallel public :: getNcol public :: getNrow + public :: getNcolGroup + public :: getNrowGroup public :: isMPISimSet public :: printComponentPlan public :: getMyNode @@ -31,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 @@ -47,15 +50,22 @@ 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 + public :: getCommTime + real,save :: commTime = 0.0 + real :: commTimeInitial,commTimeFinal +#endif !! Include mpiComponentPlan type. mpiComponentPlan is a !! dual header file for both c and fortran. @@ -63,17 +73,16 @@ 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 !! 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 +98,16 @@ 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 (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 @@ -137,6 +150,7 @@ 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 @@ -170,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 @@ -209,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,& @@ -220,14 +246,21 @@ 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 @@ -254,6 +287,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,8 +304,11 @@ contains thisComponentPlan%nComponentsRow = nComponentsRow thisComponentPlan%nComponentsColumn = nComponentsColumn + write(*,*) "UpdateGridComponents: myNRow ",& + thisComponentPlan%nComponentsRow + write(*,*) "UpdateGridComponents: myNColumn ",& + thisComponentPlan%nComponentsColumn - end subroutine updateGridComponents @@ -456,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 @@ -488,18 +525,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 + 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 + call cpu_time(commTimeFinal) + commTime = commTime + commTimeFinal - commTimeInitial +#endif if (mpi_err /= 0) then if (present(status)) status = -1 @@ -510,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 @@ -520,11 +563,19 @@ contains if (present(status)) status = 0 ! noffset = this_plan%displs(this_plan%me) - +#ifdef PROFILE + 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 + call cpu_time(commTimeFinal) + commTime = commTime + commTimeFinal - commTimeInitial +#endif + if (mpi_err /= 0) then if (present(status)) status = -1 endif @@ -534,15 +585,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 + 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 + call cpu_time(commTimeFinal) + commTime = commTime + commTimeFinal - commTimeInitial +#endif if (mpi_err /= 0) then if (present(status)) status = -1 @@ -553,14 +611,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 + 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 + call cpu_time(commTimeFinal) + commTime = commTime + commTimeFinal - commTimeInitial +#endif if (mpi_err /= 0) then if (present(status)) status = -1 @@ -582,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 @@ -617,20 +702,35 @@ contains call gather(tags,tagRow,plan_row) call gather(tags,tagColumn,plan_col) + 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 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 @@ -681,7 +781,19 @@ contains myNode = mpiSim%myNode end function getMyNode +#ifdef PROFILE + subroutine printCommTime() + write(*,*) "MPI communication time is: ", commTime + end subroutine printCommTime -end module mpiSimulation + function getCommTime() result(comm_time) + real :: comm_time + comm_time = commTime + end function getCommTime +#endif + #endif // is_mpi +end module mpiSimulation + +