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 416 by gezelter, Wed Mar 26 23:14:02 2003 UTC vs.
Revision 883 by chuckv, Thu Dec 18 20:46:45 2003 UTC

# Line 1 | Line 1
1 – #ifdef IS_MPI
1  
2 +
3   !! MPI support for long range forces using force decomposition
4   !! on a square grid of processors.
5   !! Corresponds to mpiSimunation.cpp for C++
# Line 7 | Line 7
7   !!
8   !! @author Charles F. Vardeman II
9   !! @author Matthew Meineke
10 < !! @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 $
10 > !! @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 $
11  
12   module mpiSimulation  
13    use definitions
14 <  use mpi
14 > #ifdef IS_MPI
15 >  use oopseMPI
16    implicit none
17    PRIVATE
18  
# Line 31 | Line 32 | module mpiSimulation  
32   !! PUBLIC  Subroutines contained in MPI module
33    public :: mpi_bcast
34    public :: mpi_allreduce
35 <  public :: mpi_reduce
35 > !  public :: mpi_reduce
36    public :: mpi_send
37    public :: mpi_recv
38    public :: mpi_get_processor_name
# Line 47 | Line 48 | module mpiSimulation  
48    public :: mpi_status_size
49    public :: mpi_any_source
50  
51 +
52 +
53   !! Safety logical to prevent access to ComponetPlan until
54   !! set by C++.
55 <  logical :: ComponentPlanSet = .false.
55 >  logical, save :: ComponentPlanSet = .false.
56  
57  
58   !! generic mpi error declaration.
59 <  integer,public  :: mpi_err
59 >  integer, public :: mpi_err
60  
61 <  
61 > #ifdef PROFILE
62 >  public :: printCommTime
63 >  public :: getCommTime
64 >  real,save   :: commTime = 0.0
65 >  real   :: commTimeInitial,commTimeFinal
66 > #endif
67  
68   !! Include mpiComponentPlan type. mpiComponentPlan is a
69   !! dual header file for both c and fortran.
# Line 65 | Line 73 | module mpiSimulation  
73  
74  
75   !! Tags used during force loop for parallel simulation
76 <  integer, allocatable, dimension(:) :: tagLocal
76 >  integer, public, allocatable, dimension(:) :: tagLocal
77    integer, public, allocatable, dimension(:) :: tagRow
78    integer, public, allocatable, dimension(:) :: tagColumn
79  
80   !! Logical set true if mpiSimulation has been initialized
81 <  logical :: isSimSet = .false.
81 >  logical, save :: isSimSet = .false.
82  
83  
84 <  type (mpiComponentPlan) :: mpiSim
84 >  type (mpiComponentPlan), save :: mpiSim
85  
86   !! gs_plan contains plans for gather and scatter routines
87    type, public :: gs_plan
# Line 89 | Line 97 | module mpiSimulation  
97    end type gs_plan
98  
99   ! plans for different decompositions
100 <  type (gs_plan), public :: plan_row
101 <  type (gs_plan), public :: plan_row3d
102 <  type (gs_plan), public :: plan_col
103 <  type (gs_plan), public :: plan_col3d
104 <  type(gs_plan),  public :: plan_row_Rotation
105 <  type(gs_plan),  public :: plan_col_Rotation
100 >  type (gs_plan), public, save :: plan_row
101 >  type (gs_plan), public, save :: plan_row3d
102 >  type (gs_plan), public, save :: plan_col
103 >  type (gs_plan), public, save :: plan_col3d
104 >  type (gs_plan),  public, save :: plan_row_Rotation
105 >  type (gs_plan),  public, save :: plan_col_Rotation
106  
107    type (mpiComponentPlan), pointer :: simComponentPlan
108  
# Line 137 | Line 145 | contains
145   !! Global reference tag for local particles
146      integer, dimension(ntags),intent(inout) :: tags
147  
148 +    write(*,*) 'mpiSim_mod thinks node', thisComponentPlan%myNode, ' has tags(1) = ', tags(1)
149  
150 +
151 +
152      status = 0
153      if (componentPlanSet) then
154         return
# Line 254 | Line 265 | contains
265      
266      nComponentsLocal = thisComponentPlan%myNlocal
267  
268 +    write(*,*) "UpdateGridComponents: myNlocal ", nComponentsLocal
269      call mpi_allreduce(nComponentsLocal,nComponentsRow,1,mpi_integer,&
270           mpi_sum,thisComponentPlan%rowComm,mpiErrors)
271      if (mpiErrors /= 0) then
# Line 270 | Line 282 | contains
282  
283      thisComponentPlan%nComponentsRow = nComponentsRow
284      thisComponentPlan%nComponentsColumn = nComponentsColumn
285 <
285 >    write(*,*) "UpdateGridComponents: myNRow ",&
286 >         thisComponentPlan%nComponentsRow
287 >    write(*,*) "UpdateGridComponents: myNColumn ",&
288 >         thisComponentPlan%nComponentsColumn
289  
290    end subroutine updateGridComponents
291  
# Line 456 | Line 471 | contains
471  
472    subroutine gather_integer( sbuffer, rbuffer, this_plan, status)
473  
474 <    type (gs_plan), intent(in) :: this_plan
475 <    integer, dimension(:), intent(in) :: sbuffer
476 <    integer, dimension(:), intent(in) :: rbuffer
474 >    type (gs_plan), intent(inout) :: this_plan
475 >    integer, dimension(:), intent(inout) :: sbuffer
476 >    integer, dimension(:), intent(inout) :: rbuffer
477      integer :: noffset
478      integer, intent(out), optional :: status
479      integer :: i
# Line 488 | Line 503 | contains
503    subroutine gather_double( sbuffer, rbuffer, this_plan, status)
504  
505      type (gs_plan), intent(in) :: this_plan
506 <    real( kind = DP ), dimension(:), intent(in) :: sbuffer
507 <    real( kind = DP ), dimension(:), intent(in) :: rbuffer
506 >    real( kind = DP ), dimension(:), intent(inout) :: sbuffer
507 >    real( kind = DP ), dimension(:), intent(inout) :: rbuffer
508      integer :: noffset
509      integer, intent(out), optional :: status
510  
511  
512      if (present(status)) status = 0
513      noffset = this_plan%displs(this_plan%myPlanRank)
514 <
514 > #ifdef PROFILE
515 >    call cpu_time(commTimeInitial)
516 > #endif
517      call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, &
518           rbuffer,this_plan%counts,this_plan%displs,mpi_double_precision, &
519           this_plan%myPlanComm, mpi_err)
520 + #ifdef PROFILE
521 +    call cpu_time(commTimeFinal)
522 +    commTime = commTime + commTimeFinal - commTimeInitial
523 + #endif
524  
525      if (mpi_err /= 0) then
526        if (present(status)) status  = -1
# Line 510 | Line 531 | contains
531    subroutine gather_double_2d( sbuffer, rbuffer, this_plan, status)
532  
533      type (gs_plan), intent(in) :: this_plan
534 <    real( kind = DP ), dimension(:,:), intent(in) :: sbuffer
535 <    real( kind = DP ), dimension(:,:), intent(in) :: rbuffer
534 >    real( kind = DP ), dimension(:,:), intent(inout) :: sbuffer
535 >    real( kind = DP ), dimension(:,:), intent(inout) :: rbuffer
536      integer :: noffset,i,ierror
537      integer, intent(out), optional :: status
538      
# Line 520 | Line 541 | contains
541     if (present(status)) status = 0
542  
543   !    noffset = this_plan%displs(this_plan%me)
544 <    
544 > #ifdef PROFILE
545 >   call cpu_time(commTimeInitial)
546 > #endif
547 >
548      call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, &
549          rbuffer,this_plan%counts,this_plan%displs,mpi_double_precision, &
550          this_plan%myPlanComm, mpi_err)
551  
552 + #ifdef PROFILE
553 +    call cpu_time(commTimeFinal)
554 +    commTime = commTime + commTimeFinal - commTimeInitial
555 + #endif
556 +
557      if (mpi_err /= 0) then
558        if (present(status)) status = -1
559      endif
# Line 534 | Line 563 | contains
563    subroutine scatter_double( sbuffer, rbuffer, this_plan, status)
564  
565      type (gs_plan), intent(in) :: this_plan
566 <    real( kind = DP ), dimension(:), intent(in) :: sbuffer
567 <    real( kind = DP ), dimension(:), intent(in) :: rbuffer
566 >    real( kind = DP ), dimension(:), intent(inout) :: sbuffer
567 >    real( kind = DP ), dimension(:), intent(inout) :: rbuffer
568      integer, intent(out), optional :: status
569      external mpi_reduce_scatter
570  
571     if (present(status)) status = 0
572  
573 + #ifdef PROFILE
574 +   call cpu_time(commTimeInitial)
575 + #endif
576      call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
577           mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err)
578 + #ifdef PROFILE
579 +    call cpu_time(commTimeFinal)
580 +    commTime = commTime + commTimeFinal - commTimeInitial
581 + #endif
582  
583      if (mpi_err /= 0) then
584       if (present(status))  status = -1
# Line 553 | Line 589 | contains
589    subroutine scatter_double_2d( sbuffer, rbuffer, this_plan, status)
590  
591      type (gs_plan), intent(in) :: this_plan
592 <    real( kind = DP ), dimension(:,:), intent(in) :: sbuffer
593 <    real( kind = DP ), dimension(:,:), intent(in) :: rbuffer
592 >    real( kind = DP ), dimension(:,:), intent(inout) :: sbuffer
593 >    real( kind = DP ), dimension(:,:), intent(inout) :: rbuffer
594      integer, intent(out), optional :: status
595      external mpi_reduce_scatter
596  
597     if (present(status)) status = 0
598 + #ifdef PROFILE
599 +   call cpu_time(commTimeInitial)
600 + #endif
601 +
602      call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
603           mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err)
604 + #ifdef PROFILE
605 +    call cpu_time(commTimeFinal)
606 +    commTime = commTime + commTimeFinal - commTimeInitial
607 + #endif
608  
609      if (mpi_err /= 0) then
610        if (present(status)) status = -1
# Line 582 | Line 626 | contains
626   ! allocate row arrays
627      nrow = getNrow(plan_row)
628      ncol = getNcol(plan_col)
629 +    
630 +    if(.not. allocated(tagLocal)) then
631 +       allocate(tagLocal(size(tags)),STAT=alloc_stat)
632 +        if (alloc_stat /= 0 ) then
633 +          status = -1
634 +          return
635 +       endif
636 +    else
637 +       deallocate(tagLocal)
638 +       allocate(tagLocal(size(tags)),STAT=alloc_stat)
639 +       if (alloc_stat /= 0 ) then
640 +          status = -1
641 +          return
642 +       endif
643  
644 +    endif
645 +
646 +    tagLocal = tags
647 +
648 +    
649      if (.not. allocated(tagRow)) then
650         allocate(tagRow(nrow),STAT=alloc_stat)
651         if (alloc_stat /= 0 ) then
# Line 617 | Line 680 | contains
680      call gather(tags,tagRow,plan_row)
681      call gather(tags,tagColumn,plan_col)
682  
683 +  
684    end subroutine setTags
685  
686 <  pure function getNcol(thisplan) result(ncol)
686 > !  pure function getNcol(thisplan) result(ncol)
687 >  function getNcol(thisplan) result(ncol)
688      type (gs_plan), intent(in) :: thisplan
689      integer :: ncol
690      ncol = thisplan%gsComponentPlan%nComponentsColumn
691    end function getNcol
692  
693 <  pure function getNrow(thisplan) result(ncol)
693 > !  pure function getNrow(thisplan) result(nrow)
694 >  function getNrow(thisplan) result(nrow)
695      type (gs_plan), intent(in) :: thisplan
696 <    integer :: ncol
697 <    ncol = thisplan%gsComponentPlan%nComponentsrow
696 >    integer :: nrow
697 >    nrow = thisplan%gsComponentPlan%nComponentsRow
698    end function getNrow
699  
700    function isMPISimSet() result(isthisSimSet)
# Line 681 | Line 747 | contains
747      myNode = mpiSim%myNode
748    end function getMyNode
749  
750 + #ifdef PROFILE
751 +  subroutine printCommTime()
752 +    write(*,*) "MPI communication time is: ", commTime
753 +  end subroutine printCommTime
754  
755 < end module mpiSimulation
755 >  function getCommTime() result(comm_time)
756 >    real :: comm_time
757 >    comm_time = commTime
758 >  end function getCommTime
759  
760 + #endif
761 +
762   #endif // is_mpi
763 + end module mpiSimulation
764 +
765 +

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines