ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE/libmdtools/mpiSimulation_module.F90
(Generate patch)

Comparing trunk/OOPSE/libmdtools/mpiSimulation_module.F90 (file contents):
Revision 858 by chuckv, Fri Nov 7 21:46:56 2003 UTC vs.
Revision 1150 by gezelter, Fri May 7 21:35:05 2004 UTC

# Line 7 | Line 7
7   !!
8   !! @author Charles F. Vardeman II
9   !! @author Matthew Meineke
10 < !! @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 $
10 > !! @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 $
11  
12   module mpiSimulation  
13    use definitions
# Line 25 | Line 25 | module mpiSimulation  
25    public :: replanSimParallel
26    public :: getNcol
27    public :: getNrow
28 +  public :: getNcolGroup
29 +  public :: getNrowGroup
30    public :: isMPISimSet
31    public :: printComponentPlan
32    public :: getMyNode
# Line 60 | Line 62 | module mpiSimulation  
62  
63   #ifdef PROFILE
64    public :: printCommTime
65 <
66 <  real(kind = dp ), save :: commTime = 0.0_dp
67 <  real(kind = dp ) :: commTimeInitial,commTimeFinal
65 >  public :: getCommTime
66 >  real,save   :: commTime = 0.0
67 >  real   :: commTimeInitial,commTimeFinal
68   #endif
69  
70   !! Include mpiComponentPlan type. mpiComponentPlan is a
# Line 71 | Line 73 | module mpiSimulation  
73   #include "mpiComponentPlan.h"
74  
75  
74
76   !! Tags used during force loop for parallel simulation
77 <  integer, allocatable, dimension(:) :: tagLocal
77 >  integer, public, allocatable, dimension(:) :: tagLocal
78    integer, public, allocatable, dimension(:) :: tagRow
79    integer, public, allocatable, dimension(:) :: tagColumn
80  
# Line 103 | Line 104 | module mpiSimulation  
104    type (gs_plan), public, save :: plan_col3d
105    type (gs_plan),  public, save :: plan_row_Rotation
106    type (gs_plan),  public, save :: plan_col_Rotation
107 +  type (gs_plan),  public, save :: plan_row_Group
108 +  type (gs_plan),  public, save :: plan_col_Group
109 +  type (gs_plan),  public, save :: plan_row_Group_3d
110 +  type (gs_plan),  public, save :: plan_col_Group_3d
111  
112    type (mpiComponentPlan), pointer :: simComponentPlan
113  
# Line 147 | Line 152 | contains
152  
153      write(*,*) 'mpiSim_mod thinks node', thisComponentPlan%myNode, ' has tags(1) = ', tags(1)
154  
150
151
155      status = 0
156      if (componentPlanSet) then
157         return
# Line 181 | Line 184 | contains
184           mpiSim,mpiSim%rowComm,plan_row3d)
185      call plan_gather_scatter(9,mpiSim%myNlocal,&
186           mpiSim,mpiSim%rowComm,plan_row_Rotation)
187 +    call plan_gather_scatter(1,mpiSim%myNgroup,&
188 +         mpiSim,mpiSim%rowComm,plan_row_Group)
189 +    call plan_gather_scatter(nDim,mpiSim%myNgroup,&
190 +         mpiSim,mpiSim%rowComm,plan_row_Group_3d)
191 +        
192      call plan_gather_scatter(1,mpiSim%myNlocal,&
193           mpiSim,mpiSim%columnComm,plan_col)
194      call plan_gather_scatter(nDim,mpiSim%myNlocal,&
195           mpiSim,mpiSim%columnComm,plan_col3d)
196 <   call plan_gather_scatter(9,mpiSim%myNlocal,&
196 >    call plan_gather_scatter(9,mpiSim%myNlocal,&
197           mpiSim,mpiSim%columnComm,plan_col_Rotation)
198 <
199 <
200 <
198 >    call plan_gather_scatter(1,mpiSim%myNgroup,&
199 >         mpiSim,mpiSim%columnComm,plan_col_Group)
200 >    call plan_gather_scatter(nDim,mpiSim%myNgroup,&
201 >         mpiSim,mpiSim%columnComm,plan_col_Group_3d)
202 >    
203   !  Initialize tags    
204      call setTags(tags,localStatus)
205      if (localStatus /= 0) then
# Line 220 | Line 230 | contains
230      call unplan_gather_scatter(plan_row)
231      call unplan_gather_scatter(plan_row3d)
232      call unplan_gather_scatter(plan_row_Rotation)
233 +    call unplan_gather_scatter(plan_row_Group)
234 +    call unplan_gather_scatter(plan_row_Group_3d)
235 +
236      call unplan_gather_scatter(plan_col)
237      call unplan_gather_scatter(plan_col3d)
238      call unplan_gather_scatter(plan_col_Rotation)
239 +    call unplan_gather_scatter(plan_col_Group)
240 +    call unplan_gather_scatter(plan_col_Group_3d)
241  
242      !! initialize gather and scatter plans used in this simulation
243      call plan_gather_scatter(1,thisComponentPlan%myNlocal,&
# Line 231 | Line 246 | contains
246           thisComponentPlan,thisComponentPlan%rowComm,plan_row3d)
247      call plan_gather_scatter(9,thisComponentPlan%myNlocal,&
248           thisComponentPlan,thisComponentPlan%rowComm,plan_row_Rotation)
249 +    call plan_gather_scatter(1,thisComponentPlan%myNgroup,&
250 +         thisComponentPlan,thisComponentPlan%rowComm,plan_row_Group)
251 +    call plan_gather_scatter(nDim,thisComponentPlan%myNgroup,&
252 +         thisComponentPlan,thisComponentPlan%rowComm,plan_row_Group_3d)
253 +
254      call plan_gather_scatter(1,thisComponentPlan%myNlocal,&
255           thisComponentPlan,thisComponentPlan%columnComm,plan_col)
256      call plan_gather_scatter(nDim,thisComponentPlan%myNlocal,&
257 <         thisComponentPlan,thisComponentPlan%rowComm,plan_col3d)
257 >         thisComponentPlan,thisComponentPlan%columnComm,plan_col3d)
258      call plan_gather_scatter(9,thisComponentPlan%myNlocal,&
259 <         thisComponentPlan,thisComponentPlan%rowComm,plan_col_Rotation)
260 <
261 <
259 >         thisComponentPlan,thisComponentPlan%columnComm,plan_col_Rotation)
260 >    call plan_gather_scatter(1,thisComponentPlan%myNgroup,&
261 >         thisComponentPlan,thisComponentPlan%columnComm,plan_col_Group)
262 >    call plan_gather_scatter(nDim,thisComponentPlan%myNgroup,&
263 >         thisComponentPlan,thisComponentPlan%columnComm,plan_col_Group_3d)
264  
265    end subroutine replanSimParallel
266  
# Line 512 | Line 534 | contains
534      if (present(status)) status = 0
535      noffset = this_plan%displs(this_plan%myPlanRank)
536   #ifdef PROFILE
537 <    commTimeInitial = mpi_wtime()
537 >    call cpu_time(commTimeInitial)
538   #endif
539      call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, &
540           rbuffer,this_plan%counts,this_plan%displs,mpi_double_precision, &
541           this_plan%myPlanComm, mpi_err)
542   #ifdef PROFILE
543 <    commTimeFinal = mpi_wtime()
543 >    call cpu_time(commTimeFinal)
544      commTime = commTime + commTimeFinal - commTimeInitial
545   #endif
546  
# Line 542 | Line 564 | contains
564  
565   !    noffset = this_plan%displs(this_plan%me)
566   #ifdef PROFILE
567 <   commTimeInitial = mpi_wtime()
567 >   call cpu_time(commTimeInitial)
568   #endif
569  
570      call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, &
# Line 550 | Line 572 | contains
572          this_plan%myPlanComm, mpi_err)
573  
574   #ifdef PROFILE
575 <    commTimeFinal = mpi_wtime()
575 >    call cpu_time(commTimeFinal)
576      commTime = commTime + commTimeFinal - commTimeInitial
577   #endif
578  
# Line 571 | Line 593 | contains
593     if (present(status)) status = 0
594  
595   #ifdef PROFILE
596 <   commTimeInitial = mpi_wtime()
596 >   call cpu_time(commTimeInitial)
597   #endif
598      call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
599           mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err)
600   #ifdef PROFILE
601 <    commTimeFinal = mpi_wtime()
601 >    call cpu_time(commTimeFinal)
602      commTime = commTime + commTimeFinal - commTimeInitial
603   #endif
604  
# Line 596 | Line 618 | contains
618  
619     if (present(status)) status = 0
620   #ifdef PROFILE
621 <   commTimeInitial = mpi_wtime()
621 >   call cpu_time(commTimeInitial)
622   #endif
623  
624      call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
625           mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err)
626   #ifdef PROFILE
627 <    commTimeFinal = mpi_wtime()
627 >    call cpu_time(commTimeFinal)
628      commTime = commTime + commTimeFinal - commTimeInitial
629   #endif
630  
# Line 626 | Line 648 | contains
648   ! allocate row arrays
649      nrow = getNrow(plan_row)
650      ncol = getNcol(plan_col)
651 +    
652 +    if(.not. allocated(tagLocal)) then
653 +       allocate(tagLocal(size(tags)),STAT=alloc_stat)
654 +        if (alloc_stat /= 0 ) then
655 +          status = -1
656 +          return
657 +       endif
658 +    else
659 +       deallocate(tagLocal)
660 +       allocate(tagLocal(size(tags)),STAT=alloc_stat)
661 +       if (alloc_stat /= 0 ) then
662 +          status = -1
663 +          return
664 +       endif
665  
666 +    endif
667 +
668 +    tagLocal = tags
669 +
670 +    
671      if (.not. allocated(tagRow)) then
672         allocate(tagRow(nrow),STAT=alloc_stat)
673         if (alloc_stat /= 0 ) then
# Line 661 | Line 702 | contains
702      call gather(tags,tagRow,plan_row)
703      call gather(tags,tagColumn,plan_col)
704  
705 +  
706    end subroutine setTags
707  
708   !  pure function getNcol(thisplan) result(ncol)
# Line 677 | Line 719 | contains
719      nrow = thisplan%gsComponentPlan%nComponentsRow
720    end function getNrow
721  
722 +  function getNcolGroup(thisplan) result(ncol_group)
723 +    type (gs_plan), intent(in) :: thisplan
724 +    integer :: ncol_group
725 +    ncol_group = thisplan%gsComponentPlan%nGroupColumn
726 +  end function getNcolGroup
727 +
728 +  function getNrowGroup(thisplan) result(nrow_group)
729 +    type (gs_plan), intent(in) :: thisplan
730 +    integer :: nrow_group
731 +    nrow_group = thisplan%gsComponentPlan%nGroupRow
732 +  end function getNrowGroup
733 +
734    function isMPISimSet() result(isthisSimSet)
735      logical :: isthisSimSet
736      if (isSimSet) then
# Line 729 | Line 783 | contains
783  
784   #ifdef PROFILE
785    subroutine printCommTime()
732
786      write(*,*) "MPI communication time is: ", commTime
734
787    end subroutine printCommTime
788 +
789 +  function getCommTime() result(comm_time)
790 +    real :: comm_time
791 +    comm_time = commTime
792 +  end function getCommTime
793 +
794   #endif
795  
796   #endif // is_mpi

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines