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 3111 by chuckv, Mon Jan 8 21:29:50 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.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
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
213 <    !write(*,*) "Seting up simParallel"
213 >    write(*,*) "Setting up simParallel"
214  
215      call make_Force_Grid(mpiSim, localStatus)
216      if (localStatus /= 0) then
217 <       write(default_error,*) "Error creating force grid"
217 >       write(errMsg, *) 'An error in making the force grid has occurred'
218 >       call handleError("setupSimParallel", errMsg)
219         status = -1
220         return
221      endif
222  
223      call updateGridComponents(mpiSim, localStatus)
224      if (localStatus /= 0) then
225 <       write(default_error,*) "Error updating grid components"
225 >       write(errMsg,*) "Error updating grid components"
226 >       call handleError("setupSimParallel", errMsg)
227         status = -1
228         return
229      endif
# Line 250 | Line 255 | contains
255  
256      call setAtomTags(atomTags,localStatus)
257      if (localStatus /= 0) then
258 +       write(errMsg, *) 'An error in setting Atom Tags has occured'
259 +       call handleError("setupSimParallel", errMsg)
260         status = -1
261         return
262      endif
# Line 257 | Line 264 | contains
264  
265      call setGroupTags(groupTags,localStatus)
266      if (localStatus /= 0) then
267 +       write(errMsg, *) 'An error in setting Group Tags has occured'
268 +       call handleError("setupSimParallel", errMsg)
269         status = -1
270         return
271      endif
# Line 439 | Line 448 | contains
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
# Line 447 | Line 457 | contains
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
# Line 575 | Line 586 | contains
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  
# Line 594 | Line 607 | contains
607   #ifdef PROFILE
608      call cpu_time(commTimeInitial)
609   #endif
610 + #ifdef SINGLE_PRECISION
611 +    call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_real, &
612 +         rbuffer,this_plan%counts,this_plan%displs,mpi_real, &
613 +         this_plan%myPlanComm, mpi_err)
614 + #else
615      call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, &
616           rbuffer,this_plan%counts,this_plan%displs,mpi_double_precision, &
617           this_plan%myPlanComm, mpi_err)
618 + #endif
619   #ifdef PROFILE
620      call cpu_time(commTimeFinal)
621      commTime = commTime + commTimeFinal - commTimeInitial
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  
# Line 625 | Line 646 | contains
646      call cpu_time(commTimeInitial)
647   #endif
648  
649 + #ifdef SINGLE_PRECISION
650 +    call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_real, &
651 +         rbuffer,this_plan%counts,this_plan%displs,mpi_real, &
652 +         this_plan%myPlanComm, mpi_err)
653 + #else
654      call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, &
655           rbuffer,this_plan%counts,this_plan%displs,mpi_double_precision, &
656           this_plan%myPlanComm, mpi_err)
657 + #endif
658  
659   #ifdef PROFILE
660      call cpu_time(commTimeFinal)
# Line 635 | Line 662 | contains
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  
# Line 653 | Line 682 | contains
682   #ifdef PROFILE
683      call cpu_time(commTimeInitial)
684   #endif
685 + #ifdef SINGLE_PRECISION
686      call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
687 +         mpi_real, MPI_SUM, this_plan%myPlanComm, mpi_err)
688 + #else
689 +    call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
690           mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err)
691 + #endif
692   #ifdef PROFILE
693      call cpu_time(commTimeFinal)
694      commTime = commTime + commTimeFinal - commTimeInitial
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  
# Line 678 | Line 714 | contains
714   #ifdef PROFILE
715      call cpu_time(commTimeInitial)
716   #endif
717 <
717 > #ifdef SINGLE_PRECISION
718      call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
719 +         mpi_real, MPI_SUM, this_plan%myPlanComm, mpi_err)
720 + #else
721 +    call mpi_reduce_scatter(sbuffer,rbuffer, this_plan%counts, &
722           mpi_double_precision, MPI_SUM, this_plan%myPlanComm, mpi_err)
723 + #endif
724   #ifdef PROFILE
725      call cpu_time(commTimeFinal)
726      commTime = commTime + commTimeFinal - commTimeInitial
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  

Diff Legend

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