ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/OOPSE-4/src/UseTheForce/DarkSide/simParallel.F90
(Generate patch)

Comparing trunk/OOPSE-4/src/UseTheForce/DarkSide/simParallel.F90 (file contents):
Revision 2287 by chuckv, Wed Sep 7 22:23:20 2005 UTC vs.
Revision 3135 by chuckv, Sat May 26 17:53:04 2007 UTC

# Line 47 | Line 47
47   !!
48   !! @author Charles F. Vardeman II
49   !! @author Matthew Meineke
50 < !! @version $Id: simParallel.F90,v 1.5 2005-09-07 22:23:20 chuckv Exp $, $Date: 2005-09-07 22:23:20 $, $Name: not supported by cvs2svn $, $Revision: 1.5 $
50 > !! @version $Id: simParallel.F90,v 1.10 2007-05-26 17:53:04 chuckv Exp $, $Date: 2007-05-26 17:53:04 $, $Name: not supported by cvs2svn $, $Revision: 1.10 $
51  
52   module mpiSimulation  
53    use definitions
54 +  use status
55   #ifdef IS_MPI
56    use oopseMPI
57    implicit none
# Line 86 | Line 87 | module mpiSimulation  
87    public :: mpi_integer
88    public :: mpi_lor
89    public :: mpi_logical
90 +  public :: mpi_real
91    public :: mpi_double_precision
92    public :: mpi_sum
93    public :: mpi_max
# Line 101 | Line 103 | module mpiSimulation  
103  
104    !! generic mpi error declaration.
105    integer, public :: mpi_err
106 +  character(len = statusMsgSize) :: errMsg
107  
108   #ifdef PROFILE
109    public :: printCommTime
# Line 207 | Line 210 | contains
210  
211      !! copy c component plan to fortran  
212      mpiSim = thisComponentPlan
210 –    !write(*,*) "Seting up simParallel"
213  
214      call make_Force_Grid(mpiSim, localStatus)
215      if (localStatus /= 0) then
216 <       write(default_error,*) "Error creating force grid"
216 >       write(errMsg, *) 'An error in making the force grid has occurred'
217 >       call handleError("setupSimParallel", errMsg)
218         status = -1
219         return
220      endif
221  
222      call updateGridComponents(mpiSim, localStatus)
223      if (localStatus /= 0) then
224 <       write(default_error,*) "Error updating grid components"
224 >       write(errMsg,*) "Error updating grid components"
225 >       call handleError("setupSimParallel", errMsg)
226         status = -1
227         return
228      endif
# Line 250 | Line 254 | contains
254  
255      call setAtomTags(atomTags,localStatus)
256      if (localStatus /= 0) then
257 +       write(errMsg, *) 'An error in setting Atom Tags has occured'
258 +       call handleError("setupSimParallel", errMsg)
259         status = -1
260         return
261      endif
# Line 257 | Line 263 | contains
263  
264      call setGroupTags(groupTags,localStatus)
265      if (localStatus /= 0) then
266 +       write(errMsg, *) 'An error in setting Group Tags has occured'
267 +       call handleError("setupSimParallel", errMsg)
268         status = -1
269         return
270      endif
# Line 439 | Line 447 | contains
447  
448      call mpi_comm_split(mpi_comm_world,rowIndex,0,rowCommunicator,mpiErrors)
449      if ( mpiErrors /= 0 ) then
450 <       write(default_error,*) "MPI comm split failed at row communicator"
450 >       write(errMsg, *) 'An error ',mpiErrors ,'occurred in splitting communicators'
451 >       call handleError("makeForceGrid", errMsg)
452         status = -1
453         return
454      endif
# Line 447 | Line 456 | contains
456      columnIndex = mod(myWorldRank,nColumns)
457      call mpi_comm_split(mpi_comm_world,columnIndex,0,columnCommunicator,mpiErrors)
458      if ( mpiErrors /= 0 ) then
459 <       write(default_error,*) "MPI comm split faild at columnCommunicator"
459 >       write(errMsg, *) "MPI comm split faild at columnCommunicator by error ",mpiErrors
460 >       call handleError("makeForceGrid", errMsg)
461         status = -1
462         return
463      endif
# Line 575 | Line 585 | contains
585           this_plan%myPlanComm, mpi_err)
586  
587      if (mpi_err /= 0) then
588 +       write(errMsg, *) "mpi_allgatherv failed by error message ",mpi_err
589 +       call handleError("gather_integer", errMsg)
590         if (present(status)) status  = -1
591      endif
592  
# Line 594 | Line 606 | contains
606   #ifdef PROFILE
607      call cpu_time(commTimeInitial)
608   #endif
609 + #ifdef SINGLE_PRECISION
610 +    call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_real, &
611 +         rbuffer,this_plan%counts,this_plan%displs,mpi_real, &
612 +         this_plan%myPlanComm, mpi_err)
613 + #else
614      call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, &
615           rbuffer,this_plan%counts,this_plan%displs,mpi_double_precision, &
616           this_plan%myPlanComm, mpi_err)
617 + #endif
618   #ifdef PROFILE
619      call cpu_time(commTimeFinal)
620      commTime = commTime + commTimeFinal - commTimeInitial
621   #endif
622  
623      if (mpi_err /= 0) then
624 +       write(errMsg, *) "mpi_allgatherv failed by error message ",mpi_err
625 +       call handleError("gather_double", errMsg)
626         if (present(status)) status  = -1
627      endif
628  
# Line 625 | Line 645 | contains
645      call cpu_time(commTimeInitial)
646   #endif
647  
648 + #ifdef SINGLE_PRECISION
649 +    call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_real, &
650 +         rbuffer,this_plan%counts,this_plan%displs,mpi_real, &
651 +         this_plan%myPlanComm, mpi_err)
652 + #else
653      call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, &
654           rbuffer,this_plan%counts,this_plan%displs,mpi_double_precision, &
655           this_plan%myPlanComm, mpi_err)
656 + #endif
657  
658   #ifdef PROFILE
659      call cpu_time(commTimeFinal)
# Line 635 | Line 661 | contains
661   #endif
662  
663      if (mpi_err /= 0) then
664 +       write(errMsg, *) "mpi_allgatherv failed by error message ",mpi_err
665 +       call handleError("gather_double_2d", errMsg)
666         if (present(status)) status = -1
667      endif
668  
# Line 653 | Line 681 | contains
681   #ifdef PROFILE
682      call cpu_time(commTimeInitial)
683   #endif
684 + #ifdef SINGLE_PRECISION
685      call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
686 +         mpi_real, MPI_SUM, this_plan%myPlanComm, mpi_err)
687 + #else
688 +    call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
689           mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err)
690 + #endif
691   #ifdef PROFILE
692      call cpu_time(commTimeFinal)
693      commTime = commTime + commTimeFinal - commTimeInitial
694   #endif
695  
696      if (mpi_err /= 0) then
697 +       write(errMsg, *) "mpi_reduce_scatter failed by error message ",mpi_err
698 +       call handleError("scatter_double", errMsg)
699         if (present(status))  status = -1
700      endif
701  
# Line 678 | Line 713 | contains
713   #ifdef PROFILE
714      call cpu_time(commTimeInitial)
715   #endif
716 <
716 > #ifdef SINGLE_PRECISION
717      call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
718 +         mpi_real, MPI_SUM, this_plan%myPlanComm, mpi_err)
719 + #else
720 +    call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
721           mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err)
722 + #endif
723   #ifdef PROFILE
724      call cpu_time(commTimeFinal)
725      commTime = commTime + commTimeFinal - commTimeInitial
726   #endif
727  
728      if (mpi_err /= 0) then
729 +       write(errMsg, *) "mpi_reduce_scatter failed by error message ",mpi_err
730 +       call handleError("scatter_double_2d", errMsg)
731         if (present(status)) status = -1
732      endif
733  

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines