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 631 by chuckv, Thu Jul 17 19:25:51 2003 UTC vs.
Revision 882 by chuckv, Wed Dec 17 20:13:33 2003 UTC

# Line 7 | Line 7
7   !!
8   !! @author Charles F. Vardeman II
9   !! @author Matthew Meineke
10 < !! @version $Id: mpiSimulation_module.F90,v 1.5 2003-07-17 19:25:51 chuckv Exp $, $Date: 2003-07-17 19:25:51 $, $Name: not supported by cvs2svn $, $Revision: 1.5 $
10 > !! @version $Id: mpiSimulation_module.F90,v 1.10 2003-12-17 20:13:33 chuckv Exp $, $Date: 2003-12-17 20:13:33 $, $Name: not supported by cvs2svn $, $Revision: 1.10 $
11  
12   module mpiSimulation  
13    use definitions
14   #ifdef IS_MPI
15 <  use mpi
15 >  use oopseMPI
16    implicit none
17    PRIVATE
18  
# Line 32 | 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 48 | 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  
64 +  real(kind = dp ), save :: commTime = 0.0_dp
65 +  real(kind = dp ) :: commTimeInitial,commTimeFinal
66 + #endif
67 +
68   !! Include mpiComponentPlan type. mpiComponentPlan is a
69   !! dual header file for both c and fortran.
70   #define __FORTRAN90
# Line 66 | 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 90 | 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 464 | 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 496 | 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 >    commTimeInitial = mpi_wtime()
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 +    commTimeFinal = mpi_wtime()
522 +    commTime = commTime + commTimeFinal - commTimeInitial
523 + #endif
524  
525      if (mpi_err /= 0) then
526        if (present(status)) status  = -1
# Line 518 | 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 528 | Line 541 | contains
541     if (present(status)) status = 0
542  
543   !    noffset = this_plan%displs(this_plan%me)
544 <    
544 > #ifdef PROFILE
545 >   commTimeInitial = mpi_wtime()
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 +    commTimeFinal = mpi_wtime()
554 +    commTime = commTime + commTimeFinal - commTimeInitial
555 + #endif
556 +
557      if (mpi_err /= 0) then
558        if (present(status)) status = -1
559      endif
# Line 542 | 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 +   commTimeInitial = mpi_wtime()
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 +    commTimeFinal = mpi_wtime()
580 +    commTime = commTime + commTimeFinal - commTimeInitial
581 + #endif
582  
583      if (mpi_err /= 0) then
584       if (present(status))  status = -1
# Line 561 | 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 +   commTimeInitial = mpi_wtime()
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 +    commTimeFinal = mpi_wtime()
606 +    commTime = commTime + commTimeFinal - commTimeInitial
607 + #endif
608  
609      if (mpi_err /= 0) then
610        if (present(status)) status = -1
# Line 590 | 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 625 | 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(nrow)
693 > !  pure function getNrow(thisplan) result(nrow)
694 >  function getNrow(thisplan) result(nrow)
695      type (gs_plan), intent(in) :: thisplan
696      integer :: nrow
697      nrow = thisplan%gsComponentPlan%nComponentsRow
# Line 689 | Line 747 | contains
747      myNode = mpiSim%myNode
748    end function getMyNode
749  
750 + #ifdef PROFILE
751 +  subroutine printCommTime()
752 +
753 +    write(*,*) "MPI communication time is: ", commTime
754 +
755 +  end subroutine printCommTime
756 + #endif
757 +
758   #endif // is_mpi
759   end module mpiSimulation
760  

Diff Legend

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