| 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 | 
| 25 | 
  | 
  public :: replanSimParallel | 
| 26 | 
  | 
  public :: getNcol | 
| 27 | 
  | 
  public :: getNrow | 
| 28 | 
+ | 
  public :: getNcolGroup | 
| 29 | 
+ | 
  public :: getNrowGroup | 
| 30 | 
  | 
  public :: isMPISimSet | 
| 31 | 
  | 
  public :: printComponentPlan | 
| 32 | 
  | 
  public :: getMyNode | 
| 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  | 
| 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 | 
  | 
 | 
| 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 | 
  | 
 | 
| 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 | 
| 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 | 
| 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,& | 
| 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 | 
  | 
 | 
| 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 | 
  | 
 | 
| 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, & | 
| 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 | 
  | 
 | 
| 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 | 
  | 
 | 
| 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 | 
  | 
 | 
| 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 | 
| 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) | 
| 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  | 
| 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 |