| 47 |
|
!! |
| 48 |
|
!! @author Charles F. Vardeman II |
| 49 |
|
!! @author Matthew Meineke |
| 50 |
< |
!! @version $Id: simParallel.F90,v 1.8 2006-06-07 18:05:19 chrisfen Exp $, $Date: 2006-06-07 18:05:19 $, $Name: not supported by cvs2svn $, $Revision: 1.8 $ |
| 50 |
> |
!! @version $Id: simParallel.F90,v 1.9 2007-01-08 21:29:50 chuckv Exp $, $Date: 2007-01-08 21:29:50 $, $Name: not supported by cvs2svn $, $Revision: 1.9 $ |
| 51 |
|
|
| 52 |
|
module mpiSimulation |
| 53 |
|
use definitions |
| 448 |
|
|
| 449 |
|
call mpi_comm_split(mpi_comm_world,rowIndex,0,rowCommunicator,mpiErrors) |
| 450 |
|
if ( mpiErrors /= 0 ) then |
| 451 |
< |
write(default_error,*) "MPI comm split failed at row communicator" |
| 451 |
> |
write(errMsg, *) 'An error ',mpiErrors ,'occurred in splitting communicators' |
| 452 |
> |
call handleError("makeForceGrid", errMsg) |
| 453 |
|
status = -1 |
| 454 |
|
return |
| 455 |
|
endif |
| 457 |
|
columnIndex = mod(myWorldRank,nColumns) |
| 458 |
|
call mpi_comm_split(mpi_comm_world,columnIndex,0,columnCommunicator,mpiErrors) |
| 459 |
|
if ( mpiErrors /= 0 ) then |
| 460 |
< |
write(default_error,*) "MPI comm split faild at columnCommunicator" |
| 460 |
> |
write(errMsg, *) "MPI comm split faild at columnCommunicator by error ",mpiErrors |
| 461 |
> |
call handleError("makeForceGrid", errMsg) |
| 462 |
|
status = -1 |
| 463 |
|
return |
| 464 |
|
endif |
| 586 |
|
this_plan%myPlanComm, mpi_err) |
| 587 |
|
|
| 588 |
|
if (mpi_err /= 0) then |
| 589 |
+ |
write(errMsg, *) "mpi_allgatherv failed by error message ",mpi_err |
| 590 |
+ |
call handleError("gather_integer", errMsg) |
| 591 |
|
if (present(status)) status = -1 |
| 592 |
|
endif |
| 593 |
|
|
| 622 |
|
#endif |
| 623 |
|
|
| 624 |
|
if (mpi_err /= 0) then |
| 625 |
+ |
write(errMsg, *) "mpi_allgatherv failed by error message ",mpi_err |
| 626 |
+ |
call handleError("gather_double", errMsg) |
| 627 |
|
if (present(status)) status = -1 |
| 628 |
|
endif |
| 629 |
|
|
| 662 |
|
#endif |
| 663 |
|
|
| 664 |
|
if (mpi_err /= 0) then |
| 665 |
+ |
write(errMsg, *) "mpi_allgatherv failed by error message ",mpi_err |
| 666 |
+ |
call handleError("gather_double_2d", errMsg) |
| 667 |
|
if (present(status)) status = -1 |
| 668 |
|
endif |
| 669 |
|
|
| 695 |
|
#endif |
| 696 |
|
|
| 697 |
|
if (mpi_err /= 0) then |
| 698 |
+ |
write(errMsg, *) "mpi_reduce_scatter failed by error message ",mpi_err |
| 699 |
+ |
call handleError("scatter_double", errMsg) |
| 700 |
|
if (present(status)) status = -1 |
| 701 |
|
endif |
| 702 |
|
|
| 727 |
|
#endif |
| 728 |
|
|
| 729 |
|
if (mpi_err /= 0) then |
| 730 |
+ |
write(errMsg, *) "mpi_reduce_scatter failed by error message ",mpi_err |
| 731 |
+ |
call handleError("scatter_double_2d", errMsg) |
| 732 |
|
if (present(status)) status = -1 |
| 733 |
|
endif |
| 734 |
|
|
