ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/mdtools/mpi_implementation/mpiSimulation_module.F90
(Generate patch)

Comparing trunk/mdtools/mpi_implementation/mpiSimulation_module.F90 (file contents):
Revision 239 by chuckv, Mon Jan 20 22:36:12 2003 UTC vs.
Revision 282 by chuckv, Mon Feb 24 21:26:54 2003 UTC

# Line 5 | Line 5
5   !!
6   !! @author Charles F. Vardeman II
7   !! @author Matthew Meineke
8 < !! @version $Id: mpiSimulation_module.F90,v 1.3 2003-01-20 22:36:12 chuckv Exp $, $Date: 2003-01-20 22:36:12 $, $Name: not supported by cvs2svn $, $Revision: 1.3 $
8 > !! @version $Id: mpiSimulation_module.F90,v 1.8 2003-02-24 21:26:54 chuckv Exp $, $Date: 2003-02-24 21:26:54 $, $Name: not supported by cvs2svn $, $Revision: 1.8 $
9  
10  
11  
12  
13   module mpiSimulation  
14 < #ifdef MPI
14 >  use definitions
15    use mpi
16    implicit none
17    PRIVATE
# Line 26 | Line 26 | module mpiSimulation  
26    public :: getNcol
27    public :: getNrow
28    public :: isMPISimSet
29 +  public :: printComponentPlan
30 +  public :: getMyNode
31  
30
32   !! PUBLIC  Subroutines contained in MPI module
33    public :: mpi_bcast
34    public :: mpi_allreduce
# Line 55 | Line 56 | module mpiSimulation  
56   !! generic mpi error declaration.
57    integer,public  :: mpi_err
58  
59 +  
60  
59
61   !! Include mpiComponentPlan type. mpiComponentPlan is a
62   !! dual header file for both c and fortran.
63   #define __FORTRAN90
# Line 70 | Line 71 | module mpiSimulation  
71    integer ,public, allocatable, dimension(:) :: tagColumn
72  
73   !! Logical set true if mpiSimulation has been initialized
74 <  logical isSimSet = .false.
74 >  logical :: isSimSet = .false.
75  
76 +
77 +  type (mpiComponentPlan) :: mpiSim
78 +
79   !! gs_plan contains plans for gather and scatter routines
80    type, public :: gs_plan
81       private
# Line 90 | Line 94 | module mpiSimulation  
94    type (gs_plan), public :: plan_row3d
95    type (gs_plan), public :: plan_col
96    type (gs_plan), public :: plan_col3d
97 +  type(gs_plan),  public :: plan_row_Rotation
98 +  type(gs_plan),  public :: plan_col_Rotation
99  
100    type (mpiComponentPlan), pointer :: simComponentPlan
101  
# Line 131 | Line 137 | contains
137   !! Global reference tag for local particles
138      integer, dimension(ntags),intent(inout) :: tags
139  
140 +
141      status = 0
142      if (componentPlanSet) then
143         return
144      endif
138
145      componentPlanSet = .true.
146 +    
147 + !! copy c component plan to fortran  
148 +    mpiSim = thisComponentPlan
149 +    write(*,*) "Seting up simParallel"
150  
151 <    call make_Force_Grid(thisComponentPlan,localStatus)
151 >    call make_Force_Grid(mpiSim,localStatus)
152      if (localStatus /= 0) then
153 +       write(default_error,*) "Error creating force grid"
154         status = -1
155         return
156      endif
157  
158 <    call updateGridComponents(thisComponentPlan,localStatus)
158 >    call updateGridComponents(mpiSim,localStatus)
159      if (localStatus /= 0) then
160 +       write(default_error,*) "Error updating grid components"
161         status = -1
162         return
163      endif
164      
165 +
166      !! initialize gather and scatter plans used in this simulation
167 <    call plan_gather_scatter(1,thisComponentPlan%nComponentsRow,&
168 <         thisComponentPlan,row_comm,plan_row)
169 <    call plan_gather_scatter(nDim,thisComponentPlan%nComponentsRow,&
170 <         thisComponentPlan,row_comm,plan_row3d)
171 <    call plan_gather_scatter(1,thisComponentPlan%nComponentsColumn,&
172 <         thisComponentPlan,col_comm,plan_col)
173 <    call plan_gather_scatter(nDim,thisComponentPlan%nComponentsColumn,&
174 <         thisComponentPlan,col_comm,plan_col3d)
167 >    call plan_gather_scatter(1,mpiSim%myNlocal,&
168 >         mpiSim,mpiSim%rowComm,plan_row)
169 >    call plan_gather_scatter(nDim,mpiSim%myNlocal,&
170 >         mpiSim,mpiSim%rowComm,plan_row3d)
171 >    call plan_gather_scatter(9,mpiSim%myNlocal,&
172 >         mpiSim,mpiSim%rowComm,plan_row_Rotation)
173 >    call plan_gather_scatter(1,mpiSim%myNlocal,&
174 >         mpiSim,mpiSim%columnComm,plan_col)
175 >    call plan_gather_scatter(nDim,mpiSim%myNlocal,&
176 >         mpiSim,mpiSim%columnComm,plan_col3d)
177 >   call plan_gather_scatter(9,mpiSim%myNlocal,&
178 >         mpiSim,mpiSim%columnComm,plan_col_Rotation)
179  
180 +
181 +
182   !  Initialize tags    
183      call setTags(tags,localStatus)
184      if (localStatus /= 0) then
# Line 167 | Line 186 | contains
186         return
187      endif
188      isSimSet = .true.
189 +
190 + !    call printComponentPlan(mpiSim,0)
191    end subroutine setupSimParallel
192  
193    subroutine replanSimParallel(thisComponentPlan,status)
# Line 174 | Line 195 | contains
195      !! mpiComponentPlan struct from C
196      type (mpiComponentPlan), intent(inout) :: thisComponentPlan  
197      integer, intent(out) :: status
198 <    integer, intnet(out) :: localStatus
199 <
198 >    integer :: localStatus
199 >    integer :: mpierror
200      status = 0
201  
202      call updateGridComponents(thisComponentPlan,localStatus)
# Line 187 | Line 208 | contains
208      !! Unplan Gather Scatter plans
209      call unplan_gather_scatter(plan_row)
210      call unplan_gather_scatter(plan_row3d)
211 +    call unplan_gather_scatter(plan_row_Rotation)
212      call unplan_gather_scatter(plan_col)
213      call unplan_gather_scatter(plan_col3d)
214 +    call unplan_gather_scatter(plan_col_Rotation)
215  
193
216      !! initialize gather and scatter plans used in this simulation
217 <    call plan_gather_scatter(1,thisComponentPlan%nComponentsRow,&
218 <         thisComponentPlan,row_comm,plan_row)
219 <    call plan_gather_scatter(nDim,thisComponentPlan%nComponentsRow,&
220 <         thisComponentPlan,row_comm,plan_row3d)
221 <    call plan_gather_scatter(1,thisComponentPlan%nComponentsColumn,&
222 <         thisComponentPlan,col_comm,plan_col)
223 <    call plan_gather_scatter(nDim,thisComponentPlan%nComponentsColumn,&
224 <         thisComponentPlan,col_comm,plan_col3d)
217 >    call plan_gather_scatter(1,thisComponentPlan%myNlocal,&
218 >         thisComponentPlan,thisComponentPlan%rowComm,plan_row)
219 >    call plan_gather_scatter(nDim,thisComponentPlan%myNlocal,&
220 >         thisComponentPlan,thisComponentPlan%rowComm,plan_row3d)
221 >    call plan_gather_scatter(9,thisComponentPlan%myNlocal,&
222 >         thisComponentPlan,thisComponentPlan%rowComm,plan_row_Rotation)
223 >    call plan_gather_scatter(1,thisComponentPlan%myNlocal,&
224 >         thisComponentPlan,thisComponentPlan%columnComm,plan_col)
225 >    call plan_gather_scatter(nDim,thisComponentPlan%myNlocal,&
226 >         thisComponentPlan,thisComponentPlan%rowComm,plan_col3d)
227 >    call plan_gather_scatter(9,thisComponentPlan%myNlocal,&
228 >         thisComponentPlan,thisComponentPlan%rowComm,plan_col_Rotation)
229  
230  
231  
# Line 215 | Line 241 | contains
241      integer, intent(out) :: status
242      integer :: nComponentsLocal
243      integer :: nComponentsRow = 0
244 <    integer :: nComponensColumn = 0
244 >    integer :: nComponentsColumn = 0
245      integer :: mpiErrors
246  
247      status = 0
# Line 229 | Line 255 | contains
255      nComponentsLocal = thisComponentPlan%myNlocal
256  
257      call mpi_allreduce(nComponentsLocal,nComponentsRow,1,mpi_integer,&
258 <         mpi_sum,thisComponentPlan%rowComm,mpiError)
258 >         mpi_sum,thisComponentPlan%rowComm,mpiErrors)
259      if (mpiErrors /= 0) then
260         status = -1
261         return
262      endif
263  
264      call mpi_allreduce(nComponentsLocal,nComponentsColumn,1,mpi_integer, &
265 <         mpi_sum,thisComponentPlan%columnComm,mpiError)    
265 >         mpi_sum,thisComponentPlan%columnComm,mpiErrors)    
266      if (mpiErrors /= 0) then
267         status = -1
268         return
# Line 269 | Line 295 | contains
295  
296      if (.not. ComponentPlanSet) return
297      status = 0
298 <
298 >  
299   !! We make a dangerous assumption here that if numberProcessors is
300   !! zero, then we need to get the information from MPI.
301      if (thisComponentPlan%numberProcessors == 0 ) then
# Line 286 | Line 312 | contains
312  
313      else
314         nWorldProcessors = thisComponentPlan%numberProcessors
315 <       myWorldRank = thisComponentPlan%myRank
315 >       myWorldRank = thisComponentPlan%myNode
316      endif
317  
318  
# Line 301 | Line 327 | contains
327      nRows = nWorldProcessors/nColumns
328  
329      rowIndex = myWorldRank/nColumns
330 <    call mpi_comm_split(mpi_comm_world,rowIndex,0,rowCommunicator,mpiError)
330 >
331 >
332 >
333 >    call mpi_comm_split(mpi_comm_world,rowIndex,0,rowCommunicator,mpiErrors)
334      if ( mpiErrors /= 0 ) then
335 +       write(default_error,*) "MPI comm split failed at row communicator"
336         status = -1
337         return
338      endif
339  
340      columnIndex = mod(myWorldRank,nColumns)
341 <    call mpi_comm_split(mpi_comm_world,columnIndex,0,columnCommunicator,mpiError)
341 >    call mpi_comm_split(mpi_comm_world,columnIndex,0,columnCommunicator,mpiErrors)
342      if ( mpiErrors /= 0 ) then
343 +       write(default_error,*) "MPI comm split faild at columnCommunicator"
344         status = -1
345         return
346      endif
# Line 341 | Line 372 | contains
372      integer :: i,junk
373  
374      if (present(status)) status = 0
375 +    
376    
377  
378   !! Set gsComponetPlan pointer
# Line 348 | Line 380 | contains
380   !! WARNING this could be dangerous since thisComponentPlan was origionally
381   !! allocated in C++ and there is a significant difference between c and
382   !! f95 pointers....  
383 <    gsComponentPlan => thisComponetPlan
383 >    this_plan%gsComponentPlan => thisComponentPlan
384  
385   ! Set this plan size for displs array.
386      this_plan%gsPlanSize = nDim * nComponents
# Line 387 | Line 419 | contains
419      end if
420  
421     !! gather all the local sizes into a size # processors array.
422 <    call mpi_allgather(gs_plan%gsPlanSize,1,mpi_integer,this_plan%counts, &
423 <         1,mpi_integer,comm,mpi_err)
422 >    call mpi_allgather(this_plan%gsPlanSize,1,mpi_integer,this_plan%counts, &
423 >         1,mpi_integer,thisComm,mpi_err)
424  
425      if (mpi_err /= 0) then
426         if (present(status)) status = -1
# Line 406 | Line 438 | contains
438         this_plan%displs(i) = this_plan%displs(i-1) + this_plan%counts(i-1)
439      end do
440  
441 +
442    end subroutine plan_gather_scatter
443  
444  
# Line 414 | Line 447 | contains
447      
448      
449      this_plan%gsComponentPlan => null()
450 <    call mpi_comm_free(this_plan%comm,mpi_err)
450 >    call mpi_comm_free(this_plan%myPlanComm,mpi_err)
451  
452      deallocate(this_plan%counts)
453      deallocate(this_plan%displs)
# Line 428 | Line 461 | contains
461      integer, dimension(:), intent(in) :: rbuffer
462      integer :: noffset
463      integer, intent(out), optional :: status
464 +    integer :: i
465  
466 +
467 +    
468      if (present(status)) status = 0
469      noffset = this_plan%displs(this_plan%myPlanRank)
470  
471 + !    if (getmyNode() == 1) then
472 + !       write(*,*) "Node 0 printing allgatherv vars"
473 + !       write(*,*) "Noffset: ", noffset
474 + !       write(*,*) "PlanSize: ", this_plan%gsPlanSize
475 + !       write(*,*) "PlanComm: ", this_plan%myPlanComm
476 + !    end if
477 +
478      call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_integer, &
479           rbuffer,this_plan%counts,this_plan%displs,mpi_integer, &
480           this_plan%myPlanComm, mpi_err)
# Line 450 | Line 493 | contains
493      integer :: noffset
494      integer, intent(out), optional :: status
495  
496 +
497      if (present(status)) status = 0
498 <    noffset = this_plan%displs(this_plan%me)
498 >    noffset = this_plan%displs(this_plan%myPlanRank)
499  
500      call mpi_allgatherv(sbuffer,this_plan%gsPlanSize, mpi_double_precision, &
501           rbuffer,this_plan%counts,this_plan%displs,mpi_double_precision, &
# Line 526 | Line 570 | contains
570  
571  
572    subroutine setTags(tags,status)
573 <    integer, dimension(:) tags
573 >    integer, dimension(:) :: tags
574      integer :: status
575  
576      integer :: alloc_stat
577      
578 +    integer :: ncol
579 +    integer :: nrow
580 +
581      status = 0
582   ! allocate row arrays
583 +    nrow = getNrow(plan_row)
584 +    ncol = getNcol(plan_col)
585 +
586      if (.not. allocated(tagRow)) then
587 <       allocate(tagRow(getNrow(plan_row)),STAT=alloc_stat)
587 >       allocate(tagRow(nrow),STAT=alloc_stat)
588         if (alloc_stat /= 0 ) then
589            status = -1
590            return
591         endif
592      else
593         deallocate(tagRow)
594 <       allocate(tagRow(getNrow(plan_row)),STAT=alloc_stat)
594 >       allocate(tagRow(nrow),STAT=alloc_stat)
595         if (alloc_stat /= 0 ) then
596            status = -1
597            return
# Line 549 | Line 599 | contains
599  
600      endif
601   ! allocate column arrays
602 <    if (.not. allocated(tagCol)) then
603 <       allocate(tagCol(getNcol(plan_col)),STAT=alloc_stat)
602 >    if (.not. allocated(tagColumn)) then
603 >       allocate(tagColumn(ncol),STAT=alloc_stat)
604         if (alloc_stat /= 0 ) then
605            status = -1
606            return
607         endif
608      else
609 <       deallocate(tagCol)
610 <       allocate(tagCol(getNcol(plan_col)),STAT=alloc_stat)
609 >       deallocate(tagColumn)
610 >       allocate(tagColumn(ncol),STAT=alloc_stat)
611         if (alloc_stat /= 0 ) then
612            status = -1
613            return
# Line 565 | Line 615 | contains
615      endif
616      
617      call gather(tags,tagRow,plan_row)
618 <    call gather(tags,tagCol,plan_col)
618 >    call gather(tags,tagColumn,plan_col)
619  
620  
621    end subroutine setTags
622  
623 <  function getNcol(thisplan) result(ncol)
624 <    type (gsPlan) :: thisplan
623 >  pure function getNcol(thisplan) result(ncol)
624 >    type (gs_plan), intent(in) :: thisplan
625      integer :: ncol
626 <    ncol = thisplan%gsComponentPlan%nComponentsCol
626 >    ncol = thisplan%gsComponentPlan%nComponentsColumn
627    end function getNcol
628  
629 <  function getNrow(thisplan) result(ncol)
630 <    type (gsPlan) :: thisplan
629 >  pure function getNrow(thisplan) result(ncol)
630 >    type (gs_plan), intent(in) :: thisplan
631      integer :: ncol
632      ncol = thisplan%gsComponentPlan%nComponentsrow
633    end function getNrow
634  
635 <  logical function isMPISimSet() result(isthisSimSet)
635 >  function isMPISimSet() result(isthisSimSet)
636      logical :: isthisSimSet
637      if (isSimSet) then
638         isthisSimSet = .true.
# Line 592 | Line 642 | contains
642    end function isMPISimSet
643    
644  
645 <  
646 < #endif
645 >
646 >  subroutine printComponentPlan(this_plan,printNode)
647 >
648 >    type (mpiComponentPlan), intent(in) :: this_plan
649 >    integer, optional :: printNode
650 >    logical :: print_me = .false.
651 >
652 >    if (present(printNode)) then
653 >       if (printNode == mpiSim%myNode) print_me = .true.
654 >    else
655 >       print_me = .true.
656 >    endif
657 >
658 >    if (print_me) then
659 >       write(default_error,*) "SetupSimParallel: writing component plan"
660 >      
661 >       write(default_error,*) "nMolGlobal: ", mpiSim%nMolGlobal
662 >       write(default_error,*) "nAtomsGlobal: ", mpiSim%nAtomsGlobal
663 >       write(default_error,*) "nBondGlobal: ", mpiSim%nBondsGlobal
664 >       write(default_error,*) "nTorsionsGlobal: ", mpiSim%nTorsionsGlobal
665 >       write(default_error,*) "nSRIGlobal: ", mpiSim%nSRIGlobal
666 >       write(default_error,*) "myMolStart: ", mpiSim%myMolStart
667 >       write(default_error,*) "myMolEnd: ", mpiSim%myMolEnd
668 >       write(default_error,*) "myMol: ", mpiSim%myMol
669 >       write(default_error,*) "myNlocal: ", mpiSim%myNlocal
670 >       write(default_error,*) "myNode: ", mpiSim%myNode
671 >       write(default_error,*) "numberProcessors: ", mpiSim%numberProcessors
672 >       write(default_error,*) "rowComm: ", mpiSim%rowComm
673 >       write(default_error,*) "columnComm: ", mpiSim%columnComm
674 >       write(default_error,*) "numberRows: ", mpiSim%numberRows
675 >       write(default_error,*) "numberColumns: ", mpiSim%numberColumns
676 >       write(default_error,*) "nComponentsRow: ", mpiSim%nComponentsRow
677 >       write(default_error,*) "nComponentsColumn: ", mpiSim%nComponentsColumn
678 >       write(default_error,*) "rowIndex: ", mpiSim%rowIndex
679 >       write(default_error,*) "columnIndex: ", mpiSim%columnIndex
680 >    endif
681 >  end subroutine printComponentPlan
682 >
683 >  function getMyNode() result(myNode)
684 >    integer :: myNode
685 >    myNode = mpiSim%myNode
686 >  end function getMyNode
687 >
688 >
689   end module mpiSimulation
690  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines