5 |
|
!! |
6 |
|
!! @author Charles F. Vardeman II |
7 |
|
!! @author Matthew Meineke |
8 |
< |
!! @version $Id: mpiSimulation_module.F90,v 1.2 2003-01-09 19:40:38 chuckv Exp $, $Date: 2003-01-09 19:40:38 $, $Name: not supported by cvs2svn $, $Revision: 1.2 $ |
8 |
> |
!! @version $Id: mpiSimulation_module.F90,v 1.3 2003-01-20 22:36:12 chuckv Exp $, $Date: 2003-01-20 22:36:12 $, $Name: not supported by cvs2svn $, $Revision: 1.3 $ |
9 |
|
|
10 |
|
|
11 |
|
|
25 |
|
public :: replanSimParallel |
26 |
|
public :: getNcol |
27 |
|
public :: getNrow |
28 |
+ |
public :: isMPISimSet |
29 |
|
|
30 |
|
|
31 |
|
!! PUBLIC Subroutines contained in MPI module |
55 |
|
!! generic mpi error declaration. |
56 |
|
integer,public :: mpi_err |
57 |
|
|
58 |
+ |
|
59 |
+ |
|
60 |
|
!! Include mpiComponentPlan type. mpiComponentPlan is a |
61 |
|
!! dual header file for both c and fortran. |
62 |
|
#define __FORTRAN90 |
63 |
|
#include "mpiComponentPlan.h" |
64 |
|
|
65 |
+ |
|
66 |
+ |
|
67 |
+ |
!! Tags used during force loop for parallel simulation |
68 |
+ |
integer, allocatable, dimension(:) :: tagLocal |
69 |
+ |
integer, public, allocatable, dimension(:) :: tagRow |
70 |
+ |
integer ,public, allocatable, dimension(:) :: tagColumn |
71 |
+ |
|
72 |
+ |
!! Logical set true if mpiSimulation has been initialized |
73 |
+ |
logical isSimSet = .false. |
74 |
+ |
|
75 |
|
!! gs_plan contains plans for gather and scatter routines |
76 |
|
type, public :: gs_plan |
77 |
|
private |
114 |
|
end interface |
115 |
|
|
116 |
|
|
117 |
+ |
|
118 |
|
contains |
119 |
|
|
120 |
|
!! Sets up mpiComponentPlan with structure passed from C++. |
121 |
< |
subroutine setupSimParallel(thisComponentPlan,status) |
121 |
> |
subroutine setupSimParallel(thisComponentPlan,ntags,tags,status) |
122 |
|
! Passed Arguments |
123 |
|
! integer, intent(inout) :: nDim !! Number of dimensions |
124 |
|
!! mpiComponentPlan struct from C |
125 |
< |
type (mpiComponentPlan), intent(inout) :: thisComponentPlan |
125 |
> |
type (mpiComponentPlan), intent(inout) :: thisComponentPlan |
126 |
> |
!! Number of tags passed, nlocal |
127 |
> |
integer, intent(in) :: ntags |
128 |
> |
!! Result status, 0 = normal, -1 = error |
129 |
|
integer, intent(out) :: status |
130 |
< |
integer, intnet(out) :: localStatus |
130 |
> |
integer :: localStatus |
131 |
> |
!! Global reference tag for local particles |
132 |
> |
integer, dimension(ntags),intent(inout) :: tags |
133 |
|
|
134 |
|
status = 0 |
135 |
|
if (componentPlanSet) then |
160 |
|
call plan_gather_scatter(nDim,thisComponentPlan%nComponentsColumn,& |
161 |
|
thisComponentPlan,col_comm,plan_col3d) |
162 |
|
|
163 |
< |
|
164 |
< |
|
163 |
> |
! Initialize tags |
164 |
> |
call setTags(tags,localStatus) |
165 |
> |
if (localStatus /= 0) then |
166 |
> |
status = -1 |
167 |
> |
return |
168 |
> |
endif |
169 |
> |
isSimSet = .true. |
170 |
|
end subroutine setupSimParallel |
171 |
|
|
172 |
|
subroutine replanSimParallel(thisComponentPlan,status) |
524 |
|
|
525 |
|
end subroutine scatter_double_2d |
526 |
|
|
527 |
+ |
|
528 |
+ |
subroutine setTags(tags,status) |
529 |
+ |
integer, dimension(:) tags |
530 |
+ |
integer :: status |
531 |
|
|
532 |
+ |
integer :: alloc_stat |
533 |
+ |
|
534 |
+ |
status = 0 |
535 |
+ |
! allocate row arrays |
536 |
+ |
if (.not. allocated(tagRow)) then |
537 |
+ |
allocate(tagRow(getNrow(plan_row)),STAT=alloc_stat) |
538 |
+ |
if (alloc_stat /= 0 ) then |
539 |
+ |
status = -1 |
540 |
+ |
return |
541 |
+ |
endif |
542 |
+ |
else |
543 |
+ |
deallocate(tagRow) |
544 |
+ |
allocate(tagRow(getNrow(plan_row)),STAT=alloc_stat) |
545 |
+ |
if (alloc_stat /= 0 ) then |
546 |
+ |
status = -1 |
547 |
+ |
return |
548 |
+ |
endif |
549 |
+ |
|
550 |
+ |
endif |
551 |
+ |
! allocate column arrays |
552 |
+ |
if (.not. allocated(tagCol)) then |
553 |
+ |
allocate(tagCol(getNcol(plan_col)),STAT=alloc_stat) |
554 |
+ |
if (alloc_stat /= 0 ) then |
555 |
+ |
status = -1 |
556 |
+ |
return |
557 |
+ |
endif |
558 |
+ |
else |
559 |
+ |
deallocate(tagCol) |
560 |
+ |
allocate(tagCol(getNcol(plan_col)),STAT=alloc_stat) |
561 |
+ |
if (alloc_stat /= 0 ) then |
562 |
+ |
status = -1 |
563 |
+ |
return |
564 |
+ |
endif |
565 |
+ |
endif |
566 |
+ |
|
567 |
+ |
call gather(tags,tagRow,plan_row) |
568 |
+ |
call gather(tags,tagCol,plan_col) |
569 |
+ |
|
570 |
+ |
|
571 |
+ |
end subroutine setTags |
572 |
+ |
|
573 |
|
function getNcol(thisplan) result(ncol) |
574 |
|
type (gsPlan) :: thisplan |
575 |
|
integer :: ncol |
582 |
|
ncol = thisplan%gsComponentPlan%nComponentsrow |
583 |
|
end function getNrow |
584 |
|
|
585 |
+ |
logical function isMPISimSet() result(isthisSimSet) |
586 |
+ |
logical :: isthisSimSet |
587 |
+ |
if (isSimSet) then |
588 |
+ |
isthisSimSet = .true. |
589 |
+ |
else |
590 |
+ |
isthisSimSet = .false. |
591 |
+ |
endif |
592 |
+ |
end function isMPISimSet |
593 |
|
|
594 |
|
|
595 |
|
|