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 230 by chuckv, Thu Jan 9 19:40:38 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.2 2003-01-09 19:40:38 chuckv Exp $, $Date: 2003-01-09 19:40:38 $, $Name: not supported by cvs2svn $, $Revision: 1.2 $
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 25 | Line 25 | module mpiSimulation  
25    public :: replanSimParallel
26    public :: getNcol
27    public :: getNrow
28 +  public :: isMPISimSet
29 +  public :: printComponentPlan
30 +  public :: getMyNode
31  
29
32   !! PUBLIC  Subroutines contained in MPI module
33    public :: mpi_bcast
34    public :: mpi_allreduce
# Line 54 | Line 56 | module mpiSimulation  
56   !! generic mpi error declaration.
57    integer,public  :: mpi_err
58  
59 +  
60 +
61   !! Include mpiComponentPlan type. mpiComponentPlan is a
62   !! dual header file for both c and fortran.
63   #define __FORTRAN90
64   #include "mpiComponentPlan.h"
65  
66 +
67 +
68 + !! Tags used during force loop for parallel simulation
69 +  integer, allocatable, dimension(:) :: tagLocal
70 +  integer, public, allocatable, dimension(:) :: tagRow
71 +  integer ,public, allocatable, dimension(:) :: tagColumn
72 +
73 + !! Logical set true if mpiSimulation has been initialized
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 77 | 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 101 | Line 120 | module mpiSimulation  
120    end interface
121  
122  
123 +
124   contains
125  
126   !! Sets up mpiComponentPlan with structure passed from C++.
127 <  subroutine setupSimParallel(thisComponentPlan,status)
127 >  subroutine setupSimParallel(thisComponentPlan,ntags,tags,status)
128   !  Passed Arguments
129   !    integer, intent(inout) :: nDim !! Number of dimensions
130      !! mpiComponentPlan struct from C
131 <    type (mpiComponentPlan), intent(inout) :: thisComponentPlan  
131 >    type (mpiComponentPlan), intent(inout) :: thisComponentPlan
132 > !! Number of tags passed, nlocal  
133 >    integer, intent(in) :: ntags
134 > !! Result status, 0 = normal, -1 = error
135      integer, intent(out) :: status
136 <    integer, intnet(out) :: localStatus
136 >    integer :: localStatus
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
119
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
185 +       status = -1
186 +       return
187 +    endif
188 +    isSimSet = .true.
189 +
190 + !    call printComponentPlan(mpiSim,0)
191    end subroutine setupSimParallel
192  
193    subroutine replanSimParallel(thisComponentPlan,status)
# Line 150 | 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 163 | 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  
169
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 191 | 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 205 | 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 245 | 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 262 | Line 312 | contains
312  
313      else
314         nWorldProcessors = thisComponentPlan%numberProcessors
315 <       myWorldRank = thisComponentPlan%myRank
315 >       myWorldRank = thisComponentPlan%myNode
316      endif
317  
318  
# Line 277 | 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 317 | Line 372 | contains
372      integer :: i,junk
373  
374      if (present(status)) status = 0
375 +    
376    
377  
378   !! Set gsComponetPlan pointer
# Line 324 | 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 363 | 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 382 | 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 390 | 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 404 | 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 426 | 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 501 | Line 569 | contains
569    end subroutine scatter_double_2d
570  
571  
572 <  function getNcol(thisplan) result(ncol)
573 <    type (gsPlan) :: thisplan
572 >  subroutine setTags(tags,status)
573 >    integer, dimension(:) :: tags
574 >    integer :: status
575 >
576 >    integer :: alloc_stat
577 >    
578      integer :: ncol
579 <    ncol = thisplan%gsComponentPlan%nComponentsCol
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(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(nrow),STAT=alloc_stat)
595 >       if (alloc_stat /= 0 ) then
596 >          status = -1
597 >          return
598 >       endif
599 >
600 >    endif
601 > ! allocate column arrays
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(tagColumn)
610 >       allocate(tagColumn(ncol),STAT=alloc_stat)
611 >       if (alloc_stat /= 0 ) then
612 >          status = -1
613 >          return
614 >       endif
615 >    endif
616 >    
617 >    call gather(tags,tagRow,plan_row)
618 >    call gather(tags,tagColumn,plan_col)
619 >
620 >
621 >  end subroutine setTags
622 >
623 >  pure function getNcol(thisplan) result(ncol)
624 >    type (gs_plan), intent(in) :: thisplan
625 >    integer :: ncol
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 +  function isMPISimSet() result(isthisSimSet)
636 +    logical :: isthisSimSet
637 +    if (isSimSet) then
638 +       isthisSimSet = .true.
639 +    else
640 +       isthisSimSet = .false.
641 +    endif
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