7 |
|
!! |
8 |
|
!! @author Charles F. Vardeman II |
9 |
|
!! @author Matthew Meineke |
10 |
< |
!! @version $Id: mpiSimulation_module.F90,v 1.13 2004-05-27 00:48:12 tim Exp $, $Date: 2004-05-27 00:48:12 $, $Name: not supported by cvs2svn $, $Revision: 1.13 $ |
10 |
> |
!! @version $Id: mpiSimulation_module.F90,v 1.14 2004-05-27 18:59:15 gezelter Exp $, $Date: 2004-05-27 18:59:15 $, $Name: not supported by cvs2svn $, $Revision: 1.14 $ |
11 |
|
|
12 |
|
module mpiSimulation |
13 |
|
use definitions |
139 |
|
|
140 |
|
contains |
141 |
|
|
142 |
< |
!! Sets up mpiComponentPlan with structure passed from C++. |
143 |
< |
subroutine setupSimParallel(thisComponentPlan,nAtomTags,atomTags,status) |
144 |
< |
! Passed Arguments |
142 |
> |
!! Sets up mpiComponentPlan with structure passed from C++. |
143 |
> |
subroutine setupSimParallel(thisComponentPlan, nAtomTags, atomTags, & |
144 |
> |
status) |
145 |
> |
!! Passed Arguments |
146 |
|
!! mpiComponentPlan struct from C |
147 |
|
type (mpiComponentPlan), intent(inout) :: thisComponentPlan |
148 |
< |
!! Number of tags passed, nlocal |
148 |
> |
!! Number of tags passed |
149 |
|
integer, intent(in) :: nAtomTags |
150 |
< |
!! Result status, 0 = normal, -1 = error |
150 |
> |
!! Result status, 0 = normal, -1 = error |
151 |
|
integer, intent(out) :: status |
152 |
|
integer :: localStatus |
153 |
< |
!! Global reference tag for local particles |
154 |
< |
integer, dimension(nAtomTags),intent(inout) :: atomTags |
153 |
> |
!! Global reference tag for local particles |
154 |
> |
integer, dimension(nAtomTags), intent(inout) :: atomTags |
155 |
|
|
156 |
< |
write(*,*) 'mpiSim_mod thinks node', thisComponentPlan%myNode, & |
157 |
< |
' has atomTags(1) = ', atomTags(1) |
158 |
< |
|
156 |
> |
!write(*,*) 'mpiSim_mod thinks node', thisComponentPlan%myNode, & |
157 |
> |
! ' has atomTags(1) = ', atomTags(1) |
158 |
> |
|
159 |
|
status = 0 |
160 |
|
if (componentPlanSet) then |
161 |
|
return |
162 |
|
endif |
163 |
|
componentPlanSet = .true. |
164 |
|
|
165 |
< |
!! copy c component plan to fortran |
165 |
> |
!! copy c component plan to fortran |
166 |
|
mpiSim = thisComponentPlan |
167 |
< |
write(*,*) "Seting up simParallel" |
168 |
< |
|
167 |
> |
!write(*,*) "Seting up simParallel" |
168 |
> |
|
169 |
|
call make_Force_Grid(mpiSim, localStatus) |
170 |
|
if (localStatus /= 0) then |
171 |
|
write(default_error,*) "Error creating force grid" |
172 |
|
status = -1 |
173 |
|
return |
174 |
|
endif |
175 |
< |
|
175 |
> |
|
176 |
|
call updateGridComponents(mpiSim, localStatus) |
177 |
|
if (localStatus /= 0) then |
178 |
|
write(default_error,*) "Error updating grid components" |
179 |
|
status = -1 |
180 |
|
return |
181 |
< |
endif |
181 |
> |
endif |
182 |
|
|
183 |
|
!! initialize gather and scatter plans used in this simulation |
184 |
|
call plan_gather_scatter(1, mpiSim%nAtomsLocal, & |
268 |
|
|
269 |
|
end subroutine replanSimParallel |
270 |
|
|
271 |
< |
!! Updates number of row and column components for long range forces. |
272 |
< |
subroutine updateGridComponents(thisComponentPlan,status) |
271 |
> |
!! Updates number of row and column components for long range forces. |
272 |
> |
subroutine updateGridComponents(thisComponentPlan, status) |
273 |
|
type (mpiComponentPlan) :: thisComponentPlan !! mpiComponentPlan |
274 |
< |
|
275 |
< |
!! Status return |
276 |
< |
!! - 0 Success |
277 |
< |
!! - -1 Failure |
274 |
> |
|
275 |
> |
!! Status return |
276 |
> |
!! - 0 Success |
277 |
> |
!! - -1 Failure |
278 |
|
integer, intent(out) :: status |
279 |
|
integer :: nAtomsLocal |
280 |
|
integer :: nAtomsInRow = 0 |
292 |
|
return |
293 |
|
endif |
294 |
|
if (thisComponentPlan%nGroupsLocal == 0) then |
295 |
+ |
write(*,*) 'tcp%ngl = ', thisComponentPlan%nGroupsLocal |
296 |
|
status = -1 |
297 |
|
return |
298 |
|
endif |
336 |
|
end subroutine updateGridComponents |
337 |
|
|
338 |
|
|
339 |
< |
!! Creates a square force decomposition of processors into row and column |
340 |
< |
!! communicators. |
339 |
> |
!! Creates a square force decomposition of processors into row and column |
340 |
> |
!! communicators. |
341 |
|
subroutine make_Force_Grid(thisComponentPlan,status) |
342 |
|
type (mpiComponentPlan) :: thisComponentPlan |
343 |
|
integer, intent(out) :: status !! status returns -1 if error |
344 |
< |
integer :: nColumnsMax !! Maximum number of columns |
345 |
< |
integer :: nWorldProcessors !! Total number of processors in World comm. |
344 |
> |
integer :: nColumnsMax !! Maximum number of columns |
345 |
> |
integer :: nWorldProcessors !! Total number of processors in World comm. |
346 |
|
integer :: rowIndex !! Row for this processor. |
347 |
|
integer :: columnIndex !! Column for this processor. |
348 |
|
integer :: nRows !! Total number of rows. |
357 |
|
if (.not. ComponentPlanSet) return |
358 |
|
status = 0 |
359 |
|
|
360 |
< |
!! We make a dangerous assumption here that if numberProcessors is |
361 |
< |
!! zero, then we need to get the information from MPI. |
360 |
> |
!! We make a dangerous assumption here that if numberProcessors is |
361 |
> |
!! zero, then we need to get the information from MPI. |
362 |
|
if (thisComponentPlan%nProcessors == 0 ) then |
363 |
|
call mpi_comm_size( MPI_COMM_WORLD, nWorldProcessors,mpiErrors) |
364 |
|
if ( mpiErrors /= 0 ) then |
370 |
|
status = -1 |
371 |
|
return |
372 |
|
endif |
373 |
< |
|
373 |
> |
|
374 |
|
else |
375 |
|
nWorldProcessors = thisComponentPlan%nProcessors |
376 |
|
myWorldRank = thisComponentPlan%myNode |
377 |
|
endif |
378 |
< |
|
378 |
> |
|
379 |
|
nColumnsMax = nint(sqrt(real(nWorldProcessors,kind=dp))) |
380 |
< |
|
380 |
> |
|
381 |
|
do i = 1, nColumnsMax |
382 |
|
if (mod(nWorldProcessors,i) == 0) nColumns = i |
383 |
|
end do |
384 |
< |
|
384 |
> |
|
385 |
|
nRows = nWorldProcessors/nColumns |
386 |
< |
|
386 |
> |
|
387 |
|
rowIndex = myWorldRank/nColumns |
388 |
< |
|
388 |
> |
|
389 |
|
call mpi_comm_split(mpi_comm_world,rowIndex,0,rowCommunicator,mpiErrors) |
390 |
|
if ( mpiErrors /= 0 ) then |
391 |
|
write(default_error,*) "MPI comm split failed at row communicator" |
392 |
|
status = -1 |
393 |
|
return |
394 |
|
endif |
395 |
< |
|
395 |
> |
|
396 |
|
columnIndex = mod(myWorldRank,nColumns) |
397 |
|
call mpi_comm_split(mpi_comm_world,columnIndex,0,columnCommunicator,mpiErrors) |
398 |
|
if ( mpiErrors /= 0 ) then |
400 |
|
status = -1 |
401 |
|
return |
402 |
|
endif |
403 |
< |
|
404 |
< |
! Set appropriate components of thisComponentPlan |
403 |
> |
|
404 |
> |
! Set appropriate components of thisComponentPlan |
405 |
|
thisComponentPlan%rowComm = rowCommunicator |
406 |
|
thisComponentPlan%columnComm = columnCommunicator |
407 |
|
thisComponentPlan%rowIndex = rowIndex |
410 |
|
thisComponentPlan%nColumns = nColumns |
411 |
|
|
412 |
|
end subroutine make_Force_Grid |
413 |
< |
|
413 |
> |
|
414 |
|
!! initalizes a gather scatter plan |
415 |
|
subroutine plan_gather_scatter( nDim, nObjects, thisComponentPlan, & |
416 |
|
thisComm, this_plan, status) |