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 378 by mmeineke, Fri Mar 21 17:42:12 2003 UTC vs.
Revision 858 by chuckv, Fri Nov 7 21:46:56 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.1.1.1 2003-03-21 17:42:12 mmeineke Exp $, $Date: 2003-03-21 17:42:12 $, $Name: not supported by cvs2svn $, $Revision: 1.1.1.1 $
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 $
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  
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 70 | Line 78 | module mpiSimulation  
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 >    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 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 >   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 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 +   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 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 +   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 619 | Line 663 | contains
663  
664    end subroutine setTags
665  
666 <  pure function getNcol(thisplan) result(ncol)
666 > !  pure function getNcol(thisplan) result(ncol)
667 >  function getNcol(thisplan) result(ncol)
668      type (gs_plan), intent(in) :: thisplan
669      integer :: ncol
670      ncol = thisplan%gsComponentPlan%nComponentsColumn
671    end function getNcol
672  
673 <  pure function getNrow(thisplan) result(ncol)
673 > !  pure function getNrow(thisplan) result(nrow)
674 >  function getNrow(thisplan) result(nrow)
675      type (gs_plan), intent(in) :: thisplan
676 <    integer :: ncol
677 <    ncol = thisplan%gsComponentPlan%nComponentsrow
676 >    integer :: nrow
677 >    nrow = thisplan%gsComponentPlan%nComponentsRow
678    end function getNrow
679  
680    function isMPISimSet() result(isthisSimSet)
# Line 662 | Line 708 | contains
708         write(default_error,*) "nBondGlobal: ", mpiSim%nBondsGlobal
709         write(default_error,*) "nTorsionsGlobal: ", mpiSim%nTorsionsGlobal
710         write(default_error,*) "nSRIGlobal: ", mpiSim%nSRIGlobal
665 –       write(default_error,*) "myMolStart: ", mpiSim%myMolStart
666 –       write(default_error,*) "myMolEnd: ", mpiSim%myMolEnd
667 –       write(default_error,*) "myMol: ", mpiSim%myMol
711         write(default_error,*) "myNlocal: ", mpiSim%myNlocal
712         write(default_error,*) "myNode: ", mpiSim%myNode
713         write(default_error,*) "numberProcessors: ", mpiSim%numberProcessors
# Line 684 | Line 727 | contains
727      myNode = mpiSim%myNode
728    end function getMyNode
729  
730 + #ifdef PROFILE
731 +  subroutine printCommTime()
732  
733 < end module mpiSimulation
733 >    write(*,*) "MPI communication time is: ", commTime
734  
735 +  end subroutine printCommTime
736 + #endif
737 +
738   #endif // is_mpi
739 + end module mpiSimulation
740 +
741 +

Diff Legend

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