# | Line 7 | Line 7 | |
---|---|---|
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.13 2004-05-27 00:48:12 tim Exp $, $Date: 2004-05-27 00:48:12 $, $Name: not supported by cvs2svn $, $Revision: 1.13 $ |
11 | ||
12 | module mpiSimulation | |
13 | use definitions | |
# | Line 23 | Line 23 | module mpiSimulation | |
23 | public :: gather, scatter | |
24 | public :: setupSimParallel | |
25 | public :: replanSimParallel | |
26 | < | public :: getNcol |
27 | < | public :: getNrow |
26 | > | public :: getNatomsInCol |
27 | > | public :: getNatomsInRow |
28 | > | public :: getNgroupsInCol |
29 | > | public :: getNgroupsInRow |
30 | public :: isMPISimSet | |
31 | public :: printComponentPlan | |
32 | public :: getMyNode | |
# | Line 60 | Line 62 | module mpiSimulation | |
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 | |
# | Line 71 | Line 73 | module mpiSimulation | |
73 | #include "mpiComponentPlan.h" | |
74 | ||
75 | ||
74 | – | |
76 | !! Tags used during force loop for parallel simulation | |
77 | < | integer, allocatable, dimension(:) :: tagLocal |
78 | < | integer, public, allocatable, dimension(:) :: tagRow |
79 | < | integer, public, allocatable, dimension(:) :: tagColumn |
77 | > | integer, public, allocatable, dimension(:) :: AtomLocalToGlobal |
78 | > | integer, public, allocatable, dimension(:) :: AtomRowToGlobal |
79 | > | integer, public, allocatable, dimension(:) :: AtomColToGlobal |
80 | > | integer, public, allocatable, dimension(:) :: GroupLocalToGlobal |
81 | > | integer, public, allocatable, dimension(:) :: GroupRowToGlobal |
82 | > | integer, public, allocatable, dimension(:) :: GroupColToGlobal |
83 | ||
84 | !! Logical set true if mpiSimulation has been initialized | |
85 | logical, save :: isSimSet = .false. | |
# | Line 97 | Line 101 | module mpiSimulation | |
101 | end type gs_plan | |
102 | ||
103 | ! plans for different decompositions | |
104 | < | type (gs_plan), public, save :: plan_row |
105 | < | type (gs_plan), public, save :: plan_row3d |
106 | < | type (gs_plan), public, save :: plan_col |
107 | < | type (gs_plan), public, save :: plan_col3d |
108 | < | type (gs_plan), public, save :: plan_row_Rotation |
109 | < | type (gs_plan), public, save :: plan_col_Rotation |
104 | > | type (gs_plan), public, save :: plan_atom_row |
105 | > | type (gs_plan), public, save :: plan_atom_row_3d |
106 | > | type (gs_plan), public, save :: plan_atom_col |
107 | > | type (gs_plan), public, save :: plan_atom_col_3d |
108 | > | type (gs_plan), public, save :: plan_atom_row_Rotation |
109 | > | type (gs_plan), public, save :: plan_atom_col_Rotation |
110 | > | type (gs_plan), public, save :: plan_group_row |
111 | > | type (gs_plan), public, save :: plan_group_col |
112 | > | type (gs_plan), public, save :: plan_group_row_3d |
113 | > | type (gs_plan), public, save :: plan_group_col_3d |
114 | ||
115 | type (mpiComponentPlan), pointer :: simComponentPlan | |
116 | ||
# | Line 132 | Line 140 | contains | |
140 | contains | |
141 | ||
142 | !! Sets up mpiComponentPlan with structure passed from C++. | |
143 | < | subroutine setupSimParallel(thisComponentPlan,ntags,tags,status) |
143 | > | subroutine setupSimParallel(thisComponentPlan,nAtomTags,atomTags,status) |
144 | ! Passed Arguments | |
137 | – | ! integer, intent(inout) :: nDim !! Number of dimensions |
145 | !! mpiComponentPlan struct from C | |
146 | type (mpiComponentPlan), intent(inout) :: thisComponentPlan | |
147 | !! Number of tags passed, nlocal | |
148 | < | integer, intent(in) :: ntags |
148 | > | integer, intent(in) :: nAtomTags |
149 | !! Result status, 0 = normal, -1 = error | |
150 | integer, intent(out) :: status | |
151 | integer :: localStatus | |
152 | !! Global reference tag for local particles | |
153 | < | integer, dimension(ntags),intent(inout) :: tags |
153 | > | integer, dimension(nAtomTags),intent(inout) :: atomTags |
154 | ||
155 | < | write(*,*) 'mpiSim_mod thinks node', thisComponentPlan%myNode, ' has tags(1) = ', tags(1) |
155 | > | write(*,*) 'mpiSim_mod thinks node', thisComponentPlan%myNode, & |
156 | > | ' has atomTags(1) = ', atomTags(1) |
157 | ||
150 | – | |
151 | – | |
158 | status = 0 | |
159 | if (componentPlanSet) then | |
160 | return | |
# | Line 159 | Line 165 | contains | |
165 | mpiSim = thisComponentPlan | |
166 | write(*,*) "Seting up simParallel" | |
167 | ||
168 | < | call make_Force_Grid(mpiSim,localStatus) |
168 | > | call make_Force_Grid(mpiSim, localStatus) |
169 | if (localStatus /= 0) then | |
170 | write(default_error,*) "Error creating force grid" | |
171 | status = -1 | |
172 | return | |
173 | endif | |
174 | ||
175 | < | call updateGridComponents(mpiSim,localStatus) |
175 | > | call updateGridComponents(mpiSim, localStatus) |
176 | if (localStatus /= 0) then | |
177 | write(default_error,*) "Error updating grid components" | |
178 | status = -1 | |
179 | return | |
180 | < | endif |
175 | < | |
180 | > | endif |
181 | ||
182 | !! initialize gather and scatter plans used in this simulation | |
183 | < | call plan_gather_scatter(1,mpiSim%myNlocal,& |
184 | < | mpiSim,mpiSim%rowComm,plan_row) |
185 | < | call plan_gather_scatter(nDim,mpiSim%myNlocal,& |
186 | < | mpiSim,mpiSim%rowComm,plan_row3d) |
187 | < | call plan_gather_scatter(9,mpiSim%myNlocal,& |
188 | < | mpiSim,mpiSim%rowComm,plan_row_Rotation) |
189 | < | call plan_gather_scatter(1,mpiSim%myNlocal,& |
190 | < | mpiSim,mpiSim%columnComm,plan_col) |
191 | < | call plan_gather_scatter(nDim,mpiSim%myNlocal,& |
192 | < | mpiSim,mpiSim%columnComm,plan_col3d) |
193 | < | call plan_gather_scatter(9,mpiSim%myNlocal,& |
194 | < | mpiSim,mpiSim%columnComm,plan_col_Rotation) |
195 | < | |
196 | < | |
197 | < | |
183 | > | call plan_gather_scatter(1, mpiSim%nAtomsLocal, & |
184 | > | mpiSim, mpiSim%rowComm, plan_atom_row) |
185 | > | call plan_gather_scatter(nDim, mpiSim%nAtomsLocal, & |
186 | > | mpiSim, mpiSim%rowComm, plan_atom_row_3d) |
187 | > | call plan_gather_scatter(9, mpiSim%nAtomsLocal, & |
188 | > | mpiSim, mpiSim%rowComm, plan_atom_row_Rotation) |
189 | > | call plan_gather_scatter(1, mpiSim%nGroupsLocal, & |
190 | > | mpiSim, mpiSim%rowComm, plan_group_row) |
191 | > | call plan_gather_scatter(nDim, mpiSim%nGroupsLocal, & |
192 | > | mpiSim, mpiSim%rowComm, plan_group_row_3d) |
193 | > | |
194 | > | call plan_gather_scatter(1, mpiSim%nAtomsLocal, & |
195 | > | mpiSim, mpiSim%columnComm, plan_atom_col) |
196 | > | call plan_gather_scatter(nDim, mpiSim%nAtomsLocal, & |
197 | > | mpiSim, mpiSim%columnComm, plan_atom_col_3d) |
198 | > | call plan_gather_scatter(9, mpiSim%nAtomsLocal, & |
199 | > | mpiSim, mpiSim%columnComm, plan_atom_col_Rotation) |
200 | > | call plan_gather_scatter(1, mpiSim%nGroupsLocal, & |
201 | > | mpiSim, mpiSim%columnComm, plan_group_col) |
202 | > | call plan_gather_scatter(nDim, mpiSim%nGroupsLocal, & |
203 | > | mpiSim, mpiSim%columnComm, plan_group_col_3d) |
204 | > | |
205 | ! Initialize tags | |
206 | < | call setTags(tags,localStatus) |
206 | > | |
207 | > | call setAtomTags(atomTags,localStatus) |
208 | if (localStatus /= 0) then | |
209 | status = -1 | |
210 | return | |
# | Line 217 | Line 230 | contains | |
230 | endif | |
231 | ||
232 | !! Unplan Gather Scatter plans | |
233 | < | call unplan_gather_scatter(plan_row) |
234 | < | call unplan_gather_scatter(plan_row3d) |
235 | < | call unplan_gather_scatter(plan_row_Rotation) |
236 | < | call unplan_gather_scatter(plan_col) |
237 | < | call unplan_gather_scatter(plan_col3d) |
225 | < | call unplan_gather_scatter(plan_col_Rotation) |
233 | > | call unplan_gather_scatter(plan_atom_row) |
234 | > | call unplan_gather_scatter(plan_atom_row_3d) |
235 | > | call unplan_gather_scatter(plan_atom_row_Rotation) |
236 | > | call unplan_gather_scatter(plan_group_row) |
237 | > | call unplan_gather_scatter(plan_group_row_3d) |
238 | ||
239 | < | !! initialize gather and scatter plans used in this simulation |
240 | < | call plan_gather_scatter(1,thisComponentPlan%myNlocal,& |
241 | < | thisComponentPlan,thisComponentPlan%rowComm,plan_row) |
242 | < | call plan_gather_scatter(nDim,thisComponentPlan%myNlocal,& |
243 | < | thisComponentPlan,thisComponentPlan%rowComm,plan_row3d) |
232 | < | call plan_gather_scatter(9,thisComponentPlan%myNlocal,& |
233 | < | thisComponentPlan,thisComponentPlan%rowComm,plan_row_Rotation) |
234 | < | call plan_gather_scatter(1,thisComponentPlan%myNlocal,& |
235 | < | thisComponentPlan,thisComponentPlan%columnComm,plan_col) |
236 | < | call plan_gather_scatter(nDim,thisComponentPlan%myNlocal,& |
237 | < | thisComponentPlan,thisComponentPlan%rowComm,plan_col3d) |
238 | < | call plan_gather_scatter(9,thisComponentPlan%myNlocal,& |
239 | < | thisComponentPlan,thisComponentPlan%rowComm,plan_col_Rotation) |
239 | > | call unplan_gather_scatter(plan_atom_col) |
240 | > | call unplan_gather_scatter(plan_atom_col_3d) |
241 | > | call unplan_gather_scatter(plan_atom_col_Rotation) |
242 | > | call unplan_gather_scatter(plan_group_col) |
243 | > | call unplan_gather_scatter(plan_group_col_3d) |
244 | ||
245 | < | |
246 | < | |
245 | > | !! initialize gather and scatter plans used in this simulation |
246 | > | call plan_gather_scatter(1, mpiSim%nAtomsLocal, & |
247 | > | mpiSim, mpiSim%rowComm, plan_atom_row) |
248 | > | call plan_gather_scatter(nDim, mpiSim%nAtomsLocal, & |
249 | > | mpiSim, mpiSim%rowComm, plan_atom_row_3d) |
250 | > | call plan_gather_scatter(9, mpiSim%nAtomsLocal, & |
251 | > | mpiSim, mpiSim%rowComm, plan_atom_row_Rotation) |
252 | > | call plan_gather_scatter(1, mpiSim%nGroupsLocal, & |
253 | > | mpiSim, mpiSim%rowComm, plan_group_row) |
254 | > | call plan_gather_scatter(nDim, mpiSim%nGroupsLocal, & |
255 | > | mpiSim, mpiSim%rowComm, plan_group_row_3d) |
256 | > | |
257 | > | call plan_gather_scatter(1, mpiSim%nAtomsLocal, & |
258 | > | mpiSim, mpiSim%columnComm, plan_atom_col) |
259 | > | call plan_gather_scatter(nDim, mpiSim%nAtomsLocal, & |
260 | > | mpiSim, mpiSim%columnComm, plan_atom_col_3d) |
261 | > | call plan_gather_scatter(9, mpiSim%nAtomsLocal, & |
262 | > | mpiSim, mpiSim%columnComm, plan_atom_col_Rotation) |
263 | > | call plan_gather_scatter(1, mpiSim%nGroupsLocal, & |
264 | > | mpiSim, mpiSim%columnComm, plan_group_col) |
265 | > | call plan_gather_scatter(nDim, mpiSim%nGroupsLocal, & |
266 | > | mpiSim, mpiSim%columnComm, plan_group_col_3d) |
267 | > | |
268 | end subroutine replanSimParallel | |
269 | ||
270 | !! Updates number of row and column components for long range forces. | |
# | Line 250 | Line 275 | contains | |
275 | !! - 0 Success | |
276 | !! - -1 Failure | |
277 | integer, intent(out) :: status | |
278 | < | integer :: nComponentsLocal |
279 | < | integer :: nComponentsRow = 0 |
280 | < | integer :: nComponentsColumn = 0 |
278 | > | integer :: nAtomsLocal |
279 | > | integer :: nAtomsInRow = 0 |
280 | > | integer :: nAtomsInColumn = 0 |
281 | > | integer :: nGroupsLocal |
282 | > | integer :: nGroupsInRow = 0 |
283 | > | integer :: nGroupsInColumn = 0 |
284 | integer :: mpiErrors | |
285 | ||
286 | status = 0 | |
287 | if (.not. componentPlanSet) return | |
288 | ||
289 | < | if (thisComponentPlan%myNlocal == 0 ) then |
289 | > | if (thisComponentPlan%nAtomsLocal == 0) then |
290 | status = -1 | |
291 | return | |
292 | + | endif |
293 | + | if (thisComponentPlan%nGroupsLocal == 0) then |
294 | + | status = -1 |
295 | + | return |
296 | endif | |
297 | ||
298 | < | nComponentsLocal = thisComponentPlan%myNlocal |
298 | > | nAtomsLocal = thisComponentPlan%nAtomsLocal |
299 | > | nGroupsLocal = thisComponentPlan%nGroupsLocal |
300 | ||
301 | < | write(*,*) "UpdateGridComponents: myNlocal ", nComponentsLocal |
302 | < | call mpi_allreduce(nComponentsLocal,nComponentsRow,1,mpi_integer,& |
270 | < | mpi_sum,thisComponentPlan%rowComm,mpiErrors) |
301 | > | call mpi_allreduce(nAtomsLocal, nAtomsInRow, 1, mpi_integer, & |
302 | > | mpi_sum, thisComponentPlan%rowComm, mpiErrors) |
303 | if (mpiErrors /= 0) then | |
304 | status = -1 | |
305 | return | |
306 | endif | |
307 | ||
308 | < | call mpi_allreduce(nComponentsLocal,nComponentsColumn,1,mpi_integer, & |
309 | < | mpi_sum,thisComponentPlan%columnComm,mpiErrors) |
308 | > | call mpi_allreduce(nAtomsLocal, nAtomsInColumn, 1, mpi_integer, & |
309 | > | mpi_sum, thisComponentPlan%columnComm, mpiErrors) |
310 | if (mpiErrors /= 0) then | |
311 | status = -1 | |
312 | return | |
313 | endif | |
314 | + | |
315 | + | call mpi_allreduce(nGroupsLocal, nGroupsInRow, 1, mpi_integer, & |
316 | + | mpi_sum, thisComponentPlan%rowComm, mpiErrors) |
317 | + | if (mpiErrors /= 0) then |
318 | + | status = -1 |
319 | + | return |
320 | + | endif |
321 | ||
322 | < | thisComponentPlan%nComponentsRow = nComponentsRow |
323 | < | thisComponentPlan%nComponentsColumn = nComponentsColumn |
324 | < | write(*,*) "UpdateGridComponents: myNRow ",& |
325 | < | thisComponentPlan%nComponentsRow |
326 | < | write(*,*) "UpdateGridComponents: myNColumn ",& |
327 | < | thisComponentPlan%nComponentsColumn |
322 | > | call mpi_allreduce(nGroupsLocal, nGroupsInColumn, 1, mpi_integer, & |
323 | > | mpi_sum, thisComponentPlan%columnComm, mpiErrors) |
324 | > | if (mpiErrors /= 0) then |
325 | > | status = -1 |
326 | > | return |
327 | > | endif |
328 | ||
329 | + | thisComponentPlan%nAtomsInRow = nAtomsInRow |
330 | + | thisComponentPlan%nAtomsInColumn = nAtomsInColumn |
331 | + | thisComponentPlan%nGroupsInRow = nGroupsInRow |
332 | + | thisComponentPlan%nGroupsInColumn = nGroupsInColumn |
333 | + | |
334 | end subroutine updateGridComponents | |
335 | ||
336 | ||
# | Line 313 | Line 357 | contains | |
357 | ||
358 | !! We make a dangerous assumption here that if numberProcessors is | |
359 | !! zero, then we need to get the information from MPI. | |
360 | < | if (thisComponentPlan%numberProcessors == 0 ) then |
360 | > | if (thisComponentPlan%nProcessors == 0 ) then |
361 | call mpi_comm_size( MPI_COMM_WORLD, nWorldProcessors,mpiErrors) | |
362 | if ( mpiErrors /= 0 ) then | |
363 | status = -1 | |
# | Line 326 | Line 370 | contains | |
370 | endif | |
371 | ||
372 | else | |
373 | < | nWorldProcessors = thisComponentPlan%numberProcessors |
373 | > | nWorldProcessors = thisComponentPlan%nProcessors |
374 | myWorldRank = thisComponentPlan%myNode | |
375 | endif | |
376 | ||
333 | – | |
334 | – | |
335 | – | |
377 | nColumnsMax = nint(sqrt(real(nWorldProcessors,kind=dp))) | |
378 | ||
379 | do i = 1, nColumnsMax | |
# | Line 343 | Line 384 | contains | |
384 | ||
385 | rowIndex = myWorldRank/nColumns | |
386 | ||
346 | – | |
347 | – | |
387 | call mpi_comm_split(mpi_comm_world,rowIndex,0,rowCommunicator,mpiErrors) | |
388 | if ( mpiErrors /= 0 ) then | |
389 | write(default_error,*) "MPI comm split failed at row communicator" | |
# | Line 365 | Line 404 | contains | |
404 | thisComponentPlan%columnComm = columnCommunicator | |
405 | thisComponentPlan%rowIndex = rowIndex | |
406 | thisComponentPlan%columnIndex = columnIndex | |
407 | < | thisComponentPlan%numberRows = nRows |
408 | < | thisComponentPlan%numberColumns = nColumns |
407 | > | thisComponentPlan%nRows = nRows |
408 | > | thisComponentPlan%nColumns = nColumns |
409 | ||
371 | – | |
410 | end subroutine make_Force_Grid | |
411 | ||
374 | – | |
412 | !! initalizes a gather scatter plan | |
413 | < | subroutine plan_gather_scatter( nDim,nComponents,thisComponentPlan, & |
414 | < | thisComm, this_plan,status) |
413 | > | subroutine plan_gather_scatter( nDim, nObjects, thisComponentPlan, & |
414 | > | thisComm, this_plan, status) |
415 | integer, intent(in) :: nDim !! Number of dimensions for gather scatter plan | |
416 | < | integer, intent(in) :: nComponents |
416 | > | integer, intent(in) :: nObjects |
417 | type (mpiComponentPlan), intent(in), target :: thisComponentPlan | |
418 | type (gs_plan), intent(out) :: this_plan !! MPI Component Plan | |
419 | integer, intent(in) :: thisComm !! MPI communicator for this plan | |
# | Line 387 | Line 424 | contains | |
424 | integer :: i,junk | |
425 | ||
426 | if (present(status)) status = 0 | |
390 | – | |
391 | – | |
427 | ||
428 | < | !! Set gsComponetPlan pointer |
428 | > | !! Set gsComponentPlan pointer |
429 | !! to the componet plan we want to use for this gather scatter plan. | |
430 | !! WARNING this could be dangerous since thisComponentPlan was origionally | |
431 | !! allocated in C++ and there is a significant difference between c and | |
# | Line 398 | Line 433 | contains | |
433 | this_plan%gsComponentPlan => thisComponentPlan | |
434 | ||
435 | ! Set this plan size for displs array. | |
436 | < | this_plan%gsPlanSize = nDim * nComponents |
436 | > | this_plan%gsPlanSize = nDim * nObjects |
437 | ||
438 | ! Duplicate communicator for this plan | |
439 | < | call mpi_comm_dup(thisComm,this_plan%myPlanComm,mpi_err) |
439 | > | call mpi_comm_dup(thisComm, this_plan%myPlanComm, mpi_err) |
440 | if (mpi_err /= 0) then | |
441 | if (present(status)) status = -1 | |
442 | return | |
443 | end if | |
444 | < | call mpi_comm_rank(this_plan%myPlanComm,this_plan%myPlanRank,mpi_err) |
444 | > | call mpi_comm_rank(this_plan%myPlanComm, this_plan%myPlanRank, mpi_err) |
445 | if (mpi_err /= 0) then | |
446 | if (present(status)) status = -1 | |
447 | return | |
448 | end if | |
449 | ||
450 | < | call mpi_comm_size(this_plan%myPlanComm,this_plan%planNprocs,mpi_err) |
450 | > | call mpi_comm_size(this_plan%myPlanComm, this_plan%planNprocs, mpi_err) |
451 | ||
452 | if (mpi_err /= 0) then | |
453 | if (present(status)) status = -1 | |
# | Line 442 | Line 477 | contains | |
477 | return | |
478 | end if | |
479 | ||
445 | – | |
480 | !! figure out the total number of particles in this plan | |
481 | this_plan%globalPlanSize = sum(this_plan%counts) | |
482 | ||
449 | – | |
483 | !! initialize plan displacements. | |
484 | this_plan%displs(0) = 0 | |
485 | do i = 1, this_plan%planNprocs - 1,1 | |
486 | this_plan%displs(i) = this_plan%displs(i-1) + this_plan%counts(i-1) | |
487 | end do | |
455 | – | |
456 | – | |
488 | end subroutine plan_gather_scatter | |
489 | ||
459 | – | |
490 | subroutine unplan_gather_scatter(this_plan) | |
491 | type (gs_plan), intent(inout) :: this_plan | |
492 | ||
463 | – | |
493 | this_plan%gsComponentPlan => null() | |
494 | call mpi_comm_free(this_plan%myPlanComm,mpi_err) | |
495 | ||
# | Line 478 | Line 507 | contains | |
507 | integer, intent(out), optional :: status | |
508 | integer :: i | |
509 | ||
481 | – | |
482 | – | |
510 | if (present(status)) status = 0 | |
511 | noffset = this_plan%displs(this_plan%myPlanRank) | |
512 | ||
# | Line 512 | Line 539 | contains | |
539 | if (present(status)) status = 0 | |
540 | noffset = this_plan%displs(this_plan%myPlanRank) | |
541 | #ifdef PROFILE | |
542 | < | commTimeInitial = mpi_wtime() |
542 | > | call cpu_time(commTimeInitial) |
543 | #endif | |
544 | call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, & | |
545 | rbuffer,this_plan%counts,this_plan%displs,mpi_double_precision, & | |
546 | this_plan%myPlanComm, mpi_err) | |
547 | #ifdef PROFILE | |
548 | < | commTimeFinal = mpi_wtime() |
548 | > | call cpu_time(commTimeFinal) |
549 | commTime = commTime + commTimeFinal - commTimeInitial | |
550 | #endif | |
551 | ||
# | Line 542 | Line 569 | contains | |
569 | ||
570 | ! noffset = this_plan%displs(this_plan%me) | |
571 | #ifdef PROFILE | |
572 | < | commTimeInitial = mpi_wtime() |
572 | > | call cpu_time(commTimeInitial) |
573 | #endif | |
574 | ||
575 | call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, & | |
# | Line 550 | Line 577 | contains | |
577 | this_plan%myPlanComm, mpi_err) | |
578 | ||
579 | #ifdef PROFILE | |
580 | < | commTimeFinal = mpi_wtime() |
580 | > | call cpu_time(commTimeFinal) |
581 | commTime = commTime + commTimeFinal - commTimeInitial | |
582 | #endif | |
583 | ||
# | Line 571 | Line 598 | contains | |
598 | if (present(status)) status = 0 | |
599 | ||
600 | #ifdef PROFILE | |
601 | < | commTimeInitial = mpi_wtime() |
601 | > | call cpu_time(commTimeInitial) |
602 | #endif | |
603 | call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, & | |
604 | mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err) | |
605 | #ifdef PROFILE | |
606 | < | commTimeFinal = mpi_wtime() |
606 | > | call cpu_time(commTimeFinal) |
607 | commTime = commTime + commTimeFinal - commTimeInitial | |
608 | #endif | |
609 | ||
# | Line 596 | Line 623 | contains | |
623 | ||
624 | if (present(status)) status = 0 | |
625 | #ifdef PROFILE | |
626 | < | commTimeInitial = mpi_wtime() |
626 | > | call cpu_time(commTimeInitial) |
627 | #endif | |
628 | ||
629 | call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, & | |
630 | mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err) | |
631 | #ifdef PROFILE | |
632 | < | commTimeFinal = mpi_wtime() |
632 | > | call cpu_time(commTimeFinal) |
633 | commTime = commTime + commTimeFinal - commTimeInitial | |
634 | #endif | |
635 | ||
# | Line 611 | Line 638 | contains | |
638 | endif | |
639 | ||
640 | end subroutine scatter_double_2d | |
641 | < | |
642 | < | |
616 | < | subroutine setTags(tags,status) |
641 | > | |
642 | > | subroutine setAtomTags(tags, status) |
643 | integer, dimension(:) :: tags | |
644 | integer :: status | |
645 | ||
646 | integer :: alloc_stat | |
647 | ||
648 | < | integer :: ncol |
649 | < | integer :: nrow |
648 | > | integer :: nAtomsInCol |
649 | > | integer :: nAtomsInRow |
650 | ||
651 | status = 0 | |
652 | ! allocate row arrays | |
653 | < | nrow = getNrow(plan_row) |
654 | < | ncol = getNcol(plan_col) |
653 | > | nAtomsInRow = getNatomsInRow(plan_atom_row) |
654 | > | nAtomsInCol = getNatomsInCol(plan_atom_col) |
655 | > | |
656 | > | if(.not. allocated(AtomLocalToGlobal)) then |
657 | > | allocate(AtomLocalToGlobal(size(tags)),STAT=alloc_stat) |
658 | > | if (alloc_stat /= 0 ) then |
659 | > | status = -1 |
660 | > | return |
661 | > | endif |
662 | > | else |
663 | > | deallocate(AtomLocalToGlobal) |
664 | > | allocate(AtomLocalToGlobal(size(tags)),STAT=alloc_stat) |
665 | > | if (alloc_stat /= 0 ) then |
666 | > | status = -1 |
667 | > | return |
668 | > | endif |
669 | ||
670 | < | if (.not. allocated(tagRow)) then |
671 | < | allocate(tagRow(nrow),STAT=alloc_stat) |
670 | > | endif |
671 | > | |
672 | > | AtomLocalToGlobal = tags |
673 | > | |
674 | > | if (.not. allocated(AtomRowToGlobal)) then |
675 | > | allocate(AtomRowToGlobal(nAtomsInRow),STAT=alloc_stat) |
676 | if (alloc_stat /= 0 ) then | |
677 | status = -1 | |
678 | return | |
679 | endif | |
680 | else | |
681 | < | deallocate(tagRow) |
682 | < | allocate(tagRow(nrow),STAT=alloc_stat) |
681 | > | deallocate(AtomRowToGlobal) |
682 | > | allocate(AtomRowToGlobal(nAtomsInRow),STAT=alloc_stat) |
683 | if (alloc_stat /= 0 ) then | |
684 | status = -1 | |
685 | return | |
# | Line 643 | Line 687 | contains | |
687 | ||
688 | endif | |
689 | ! allocate column arrays | |
690 | < | if (.not. allocated(tagColumn)) then |
691 | < | allocate(tagColumn(ncol),STAT=alloc_stat) |
690 | > | if (.not. allocated(AtomColToGlobal)) then |
691 | > | allocate(AtomColToGlobal(nAtomsInCol),STAT=alloc_stat) |
692 | if (alloc_stat /= 0 ) then | |
693 | status = -1 | |
694 | return | |
695 | endif | |
696 | else | |
697 | < | deallocate(tagColumn) |
698 | < | allocate(tagColumn(ncol),STAT=alloc_stat) |
697 | > | deallocate(AtomColToGlobal) |
698 | > | allocate(AtomColToGlobal(nAtomsInCol),STAT=alloc_stat) |
699 | if (alloc_stat /= 0 ) then | |
700 | status = -1 | |
701 | return | |
702 | endif | |
703 | endif | |
704 | ||
705 | < | call gather(tags,tagRow,plan_row) |
706 | < | call gather(tags,tagColumn,plan_col) |
707 | < | |
708 | < | end subroutine setTags |
709 | < | |
710 | < | ! pure function getNcol(thisplan) result(ncol) |
667 | < | function getNcol(thisplan) result(ncol) |
705 | > | call gather(tags, AtomRowToGlobal, plan_atom_row) |
706 | > | call gather(tags, AtomColToGlobal, plan_atom_col) |
707 | > | |
708 | > | end subroutine setAtomTags |
709 | > | |
710 | > | function getNatomsInCol(thisplan) result(nInCol) |
711 | type (gs_plan), intent(in) :: thisplan | |
712 | < | integer :: ncol |
713 | < | ncol = thisplan%gsComponentPlan%nComponentsColumn |
714 | < | end function getNcol |
712 | > | integer :: nInCol |
713 | > | nInCol = thisplan%gsComponentPlan%nAtomsInColumn |
714 | > | end function getNatomsInCol |
715 | ||
716 | < | ! pure function getNrow(thisplan) result(nrow) |
674 | < | function getNrow(thisplan) result(nrow) |
716 | > | function getNatomsInRow(thisplan) result(nInRow) |
717 | type (gs_plan), intent(in) :: thisplan | |
718 | < | integer :: nrow |
719 | < | nrow = thisplan%gsComponentPlan%nComponentsRow |
720 | < | end function getNrow |
718 | > | integer :: nInRow |
719 | > | nInRow = thisplan%gsComponentPlan%nAtomsInRow |
720 | > | end function getNatomsInRow |
721 | > | |
722 | > | function getNgroupsInCol(thisplan) result(nInCol) |
723 | > | type (gs_plan), intent(in) :: thisplan |
724 | > | integer :: nInCol |
725 | > | nInCol = thisplan%gsComponentPlan%nGroupsInColumn |
726 | > | end function getNgroupsInCol |
727 | ||
728 | + | function getNgroupsInRow(thisplan) result(nInRow) |
729 | + | type (gs_plan), intent(in) :: thisplan |
730 | + | integer :: nInRow |
731 | + | nInRow = thisplan%gsComponentPlan%nGroupsInRow |
732 | + | end function getNgroupsInRow |
733 | + | |
734 | function isMPISimSet() result(isthisSimSet) | |
735 | logical :: isthisSimSet | |
736 | if (isSimSet) then | |
# | Line 686 | Line 740 | contains | |
740 | endif | |
741 | end function isMPISimSet | |
742 | ||
689 | – | |
690 | – | |
743 | subroutine printComponentPlan(this_plan,printNode) | |
744 | ||
745 | type (mpiComponentPlan), intent(in) :: this_plan | |
# | Line 708 | Line 760 | contains | |
760 | write(default_error,*) "nBondGlobal: ", mpiSim%nBondsGlobal | |
761 | write(default_error,*) "nTorsionsGlobal: ", mpiSim%nTorsionsGlobal | |
762 | write(default_error,*) "nSRIGlobal: ", mpiSim%nSRIGlobal | |
763 | < | write(default_error,*) "myNlocal: ", mpiSim%myNlocal |
763 | > | write(default_error,*) "nAtomsLocal: ", mpiSim%nAtomsLocal |
764 | write(default_error,*) "myNode: ", mpiSim%myNode | |
765 | < | write(default_error,*) "numberProcessors: ", mpiSim%numberProcessors |
765 | > | write(default_error,*) "nProcessors: ", mpiSim%nProcessors |
766 | write(default_error,*) "rowComm: ", mpiSim%rowComm | |
767 | write(default_error,*) "columnComm: ", mpiSim%columnComm | |
768 | < | write(default_error,*) "numberRows: ", mpiSim%numberRows |
769 | < | write(default_error,*) "numberColumns: ", mpiSim%numberColumns |
770 | < | write(default_error,*) "nComponentsRow: ", mpiSim%nComponentsRow |
771 | < | write(default_error,*) "nComponentsColumn: ", mpiSim%nComponentsColumn |
768 | > | write(default_error,*) "nRows: ", mpiSim%nRows |
769 | > | write(default_error,*) "nColumns: ", mpiSim%nColumns |
770 | > | write(default_error,*) "nAtomsInRow: ", mpiSim%nAtomsInRow |
771 | > | write(default_error,*) "nAtomsInColumn: ", mpiSim%nAtomsInColumn |
772 | write(default_error,*) "rowIndex: ", mpiSim%rowIndex | |
773 | write(default_error,*) "columnIndex: ", mpiSim%columnIndex | |
774 | endif | |
# | Line 729 | Line 781 | contains | |
781 | ||
782 | #ifdef PROFILE | |
783 | subroutine printCommTime() | |
732 | – | |
784 | write(*,*) "MPI communication time is: ", commTime | |
734 | – | |
785 | end subroutine printCommTime | |
786 | + | |
787 | + | function getCommTime() result(comm_time) |
788 | + | real :: comm_time |
789 | + | comm_time = commTime |
790 | + | end function getCommTime |
791 | + | |
792 | #endif | |
793 | ||
794 | #endif // is_mpi |
– | Removed lines |
+ | Added lines |
< | Changed lines |
> | Changed lines |