7 |
|
!! |
8 |
|
!! @author Charles F. Vardeman II |
9 |
|
!! @author Matthew Meineke |
10 |
< |
!! @version $Id: mpiSimulation_module.F90,v 1.7 2003-09-05 21:28:19 gezelter Exp $, $Date: 2003-09-05 21:28:19 $, $Name: not supported by cvs2svn $, $Revision: 1.7 $ |
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 |
|
#ifdef IS_MPI |
15 |
< |
use mpi |
15 |
> |
use oopseMPI |
16 |
|
implicit none |
17 |
|
PRIVATE |
18 |
|
|
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 |
60 |
|
|
61 |
|
#ifdef PROFILE |
62 |
|
public :: printCommTime |
63 |
< |
|
64 |
< |
real(kind = dp ), save :: commTime = 0.0_dp |
65 |
< |
real(kind = dp ) :: commTimeInitial,commTimeFinal |
63 |
> |
public :: getCommTime |
64 |
> |
real,save :: commTime = 0.0 |
65 |
> |
real :: commTimeInitial,commTimeFinal |
66 |
|
#endif |
67 |
|
|
68 |
|
!! Include mpiComponentPlan type. mpiComponentPlan is a |
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 |
|
|
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 |
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 |
|
|
512 |
|
if (present(status)) status = 0 |
513 |
|
noffset = this_plan%displs(this_plan%myPlanRank) |
514 |
|
#ifdef PROFILE |
515 |
< |
commTimeInitial = mpi_wtime() |
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 |
< |
commTimeFinal = mpi_wtime() |
521 |
> |
call cpu_time(commTimeFinal) |
522 |
|
commTime = commTime + commTimeFinal - commTimeInitial |
523 |
|
#endif |
524 |
|
|
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 |
|
|
542 |
|
|
543 |
|
! noffset = this_plan%displs(this_plan%me) |
544 |
|
#ifdef PROFILE |
545 |
< |
commTimeInitial = mpi_wtime() |
545 |
> |
call cpu_time(commTimeInitial) |
546 |
|
#endif |
547 |
|
|
548 |
|
call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, & |
550 |
|
this_plan%myPlanComm, mpi_err) |
551 |
|
|
552 |
|
#ifdef PROFILE |
553 |
< |
commTimeFinal = mpi_wtime() |
553 |
> |
call cpu_time(commTimeFinal) |
554 |
|
commTime = commTime + commTimeFinal - commTimeInitial |
555 |
|
#endif |
556 |
|
|
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() |
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 |
< |
commTimeFinal = mpi_wtime() |
579 |
> |
call cpu_time(commTimeFinal) |
580 |
|
commTime = commTime + commTimeFinal - commTimeInitial |
581 |
|
#endif |
582 |
|
|
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() |
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 |
< |
commTimeFinal = mpi_wtime() |
605 |
> |
call cpu_time(commTimeFinal) |
606 |
|
commTime = commTime + commTimeFinal - commTimeInitial |
607 |
|
#endif |
608 |
|
|
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 |
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 |
749 |
|
|
750 |
|
#ifdef PROFILE |
751 |
|
subroutine printCommTime() |
730 |
– |
|
752 |
|
write(*,*) "MPI communication time is: ", commTime |
732 |
– |
|
753 |
|
end subroutine printCommTime |
754 |
+ |
|
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 |