prg_graph_mod.F90

Go to the documentation of this file.

 
!
!
 
module prg_graph_mod
 
  use bml
  use prg_parallel_mod
  use omp_lib
 
  implicit none
 
  private  !Everything is private by default
 
  integer, parameter :: dp = kind(1.0d0)
 
  public :: subgraph_t
  public :: graph_partitioning_t
  public :: prg_initsubgraph
  public :: prg_destroysubgraph
  public :: prg_initgraphpartitioning
  public :: prg_destroygraphpartitioning
  public :: prg_printgraphpartitioning
  public :: prg_equalpartition
  public :: prg_equalgrouppartition
  public :: prg_filepartition
  public :: prg_fnormgraph
 
  type subgraph_t
 
    integer :: part
 
    integer :: hsize
 
    integer :: lsize
 
    integer :: llsize
 
    integer, allocatable :: core_halo_index(:)
 
    integer, allocatable :: nodeinpart(:)
 
    !    real(dp) :: vvx(100)
 
  end type subgraph_t
 
  type graph_partitioning_t
 
    character(len=100) :: pname
 
    integer :: myrank
 
    integer :: totalprocs
 
    integer :: totalparts
 
    integer :: totalnodes
 
    integer :: totalnodes2
 
    integer :: globalpartmin
 
    integer :: globalpartmax
 
    integer :: globalpartextent
 
    integer, allocatable :: localpartmin(:)
 
    integer, allocatable :: localpartmax(:)
 
    integer, allocatable :: localpartextent(:)
 
    integer, allocatable :: order(:)
 
    integer, allocatable :: reorder(:)
 
    integer :: nparts
 
    integer, allocatable :: nnodesinpart(:)
 
    integer, allocatable :: nnodesinpartall(:)
 
    integer :: pp(100)
 
    integer :: maxiter
 
    real(dp) :: ehomo
 
    real(dp) :: elumo
 
    real(dp) :: mineval
 
    real(dp) :: maxeval
 
    real(dp) :: vv(100)
 
    type (subgraph_t), allocatable :: sgraph(:)
 
  end type graph_partitioning_t
 
contains
 
  subroutine prg_initsubgraph(sg, pnum, hsize)
 
    type (subgraph_t), intent(inout) :: sg
    integer, intent(in) :: pnum, hsize
 
    sg%part = pnum
    sg%hsize = hsize
    sg%lsize = 0
    sg%llsize = 0
 
    allocate(sg%core_halo_index(hsize))
 
  end subroutine prg_initsubgraph
 
  subroutine prg_destroysubgraph(sg)
 
    type (subgraph_t), intent(inout) :: sg
 
    if (allocated(sg%core_halo_index) .eqv. .true.) &
         deallocate(sg%core_halo_index)
    if (allocated(sg%nodeInPart) .eqv. .true.) deallocate(sg%nodeInPart)
 
  end subroutine prg_destroysubgraph
 
  subroutine prg_initgraphpartitioning(gp, pname, np, nnodes, nnodes2)
 
    type (graph_partitioning_t), intent(inout) :: gp
    character(len=*), intent(in) :: pname
    integer, intent(in) :: np, nnodes, nnodes2
 
    integer :: nprocs, avgparts
    integer :: i, it, last, nleft
 
    nprocs = getnranks()
    gp%myRank = getmyrank()
 
    !! Global
    gp%pname = pname
    gp%totalProcs = nprocs
    gp%totalParts = np
    gp%totalNodes = nnodes
    gp%totalNodes2 = nnodes2
 
    !! Global bounds
    gp%globalPartMin = 1
    gp%globalPartMax = np
    gp%globalPartExtent = gp%globalPartMax - gp%globalPartMin + 1
 
    allocate(gp%localPartMin(nprocs))
    allocate(gp%localPartMax(nprocs))
    allocate(gp%localPartExtent(nprocs))
 
    ! Distribute parts evenly among ranks
    avgparts = gp%totalParts / nprocs
    do i = 1, nprocs
      gp%localPartExtent(i) = avgparts
    enddo
 
    nleft = gp%totalParts - nprocs * avgparts
    if (nleft .gt. 0) then
      do i = 1, nleft
        gp%localPartExtent(i) = gp%localPartExtent(i) + 1
      enddo
    endif
 
    gp%localPartMin(1) = 1
    gp%localPartMax(1) = gp%localPartExtent(1)
    do i = 2, nprocs
      gp%localPartMin(i) = gp%localPartMax(i-1) + 1
      gp%localPartMax(i) = gp%localPartMin(i) + gp%localPartExtent(i) - 1
    enddo
 
    gp%nparts = gp%localPartExtent(gp%myRank+1)
 
    allocate(gp%nnodesInPart(np))
    allocate(gp%nnodesInPartAll(np))
    allocate(gp%sgraph(np))
 
    !! For reordering
    allocate(gp%order(nnodes))
    allocate(gp%reorder(nnodes))
 
    gp%maxIter = 0
    gp%mineval = 0.0_dp
    gp%maxeval = 0.0_dp
 
    if (printrank() .eq. 1) then
      write(*,*)
      write(*,*) "total procs = ", gp%totalProcs
      write(*,*) "total nodes = ", gp%totalNodes
      write(*,*) "total nodes2 = ", gp%totalNodes2
      write(*,*) "total parts = ", gp%totalParts
      write(*,*) "local parts = ", gp%nparts
      write(*,*)
      write(*,*) "globalPartMin = ", gp%globalPartMin, &
           " globalPartMax = ", gp%globalPartMax, &
           " globalPartExtent = ", gp%globalPartExtent
 
      do i = 1, nprocs
        write(*,*) "rank = ", i-1, &
             " localPartMin = ", gp%localPartMin(i), &
             " localPartMax = ", gp%localPartMax(i), &
             " localPartExtent = ", gp%localPartExtent(i)
      enddo
 
      write(*,*)
    endif
 
  end subroutine prg_initgraphpartitioning
 
  subroutine prg_destroygraphpartitioning(gp)
 
    type (graph_partitioning_t), intent(inout) :: gp
 
    integer :: i
 
    if (allocated(gp%localPartMin))deallocate(gp%localPartMin)
    if (allocated(gp%localPartMax))deallocate(gp%localPartMax)
    if (allocated(gp%localPartExtent))deallocate(gp%localPartExtent)
 
    if (allocated(gp%order))deallocate(gp%order)
    if (allocated(gp%reorder))deallocate(gp%reorder)
 
    if(allocated(gp%nnodesInPart)) deallocate(gp%nnodesInPart)
    if(allocated(gp%nnodesInPartAll))deallocate(gp%nnodesInPartAll)
 
    if (allocated(gp%sgraph)) then
      do i = 1, gp%totalParts
        call prg_destroysubgraph(gp%sgraph(i))
      enddo
      deallocate(gp%sgraph)
    endif
 
  end subroutine prg_destroygraphpartitioning
 
  subroutine prg_printgraphpartitioning(gp)
 
    type (graph_partitioning_t), intent(in) :: gp
 
    integer :: i, j
 
    if (gp%myRank .ne. 0) return
 
    ! Global data
    write(*,*) ""
    write(*,*) ""
    write(*,*) "Graph partitioning:"
    write(*,*) ""
 
    write(*,*) "name = ", gp%pname
    write(*,*) "totalProcs = ", gp%totalProcs
    write(*,*) "totalParts = ", gp%totalParts
    write(*,*) "totalNodes = ", gp%totalNodes
    write(*,*) "totalNodes2 = ", gp%totalNodes2
    write(*,*) ""
    write(*,*) "globalPartMin = ", gp%globalPartMin, &
         " globalPartMax = ", gp%globalPartMax, &
         " globalPartExtent = ", gp%globalPartExtent
    write(*,*) ""
 
    ! Local data
    write(*,*) "local parts = ", gp%nparts
    do i = 1, gp%totalProcs
      write(*,*) "rank = ", i-1, " localPartMin = ", gp%localPartMin(i), &
           " localPartMax = ", gp%localPartMax(i), &
           " localPartExtent = ", gp%localPartExtent(i)
    enddo
    write(*,*) ""
 
    ! SP2 data
    write(*,*) "Number of iterations = ", gp%maxIter
    write(*,*) "SP2 sequence = ", (gp%pp(i),i=1,gp%maxIter)
    write(*,*) "mineval = ", gp%mineval , "maxeval = ", gp%maxeval
    write(*,*) ""
 
    ! For each subgraph
    do i = 1, gp%nparts
      write(*,*) "part = ", i, " hsize = ", gp%sgraph(i)%hsize, &
           " lsize = ", gp%sgraph(i)%lsize, &
           " llsize = ", gp%sgraph(i)%llsize
      write(*,*) ""
      write(*,*) "Number of core nodes in part = ", gp%nnodesInPart(i)
      write(*,*) "nodeInPart = ", &
           (gp%sgraph(i)%nodeInPart(j), j=1,gp%nnodesInPart(i))
      write(*,*) ""
 
      write(*,*) "core_halo_index = ", &
           (gp%sgraph(i)%core_halo_index(j), j=1,gp%sgraph(i)%lsize)
      write(*,*) ""
 
    enddo
 
  end subroutine prg_printgraphpartitioning
 
  subroutine prg_equalpartition(gp, nodesPerPart, nnodes)
 
    type (graph_partitioning_t), intent(inout) :: gp
    integer, intent(in) :: nodesperpart, nnodes
 
    integer :: i, j, it, np, psize
    character(len=100) :: pname
 
    !! Init graph partitioning
    np = ceiling(real(nnodes) / real(nodesperpart))
    write(pname, '("equalParts")')
    call prg_destroygraphpartitioning(gp)
    call prg_initgraphpartitioning(gp, pname, np, nnodes, nnodes)
 
    !! Assign node ids (mapped to orbitals as rows) to each node in each
    !! partition
    !$omp parallel do default(none) private(i) &
    !$omp private(it,j,psize) &
    !$omp shared(gp,nnodes,nodesPerPart)
    do i = 1, gp%totalParts
      call prg_initsubgraph(gp%sgraph(i), i, nnodes)
      if ((i * nodesperpart) .le. nnodes) then
        psize = nodesperpart
      else
        psize = nnodes - (nodesperpart * (i-1))
      endif
      allocate(gp%sgraph(i)%nodeInPart(psize))
      do j = 1, psize
        it = (i-1) * nodesperpart + j-1;
        gp%sgraph(i)%nodeInPart(j) = it
      enddo
      gp%nnodesInPart(i) = psize
      gp%nnodesInPartAll(i) = psize
    enddo
    !$omp end parallel do
 
  end subroutine prg_equalpartition
 
  subroutine prg_equalgrouppartition(gp, hindex, ngroup, nodesPerPart, nnodes)
 
    type (graph_partitioning_t), intent(inout) :: gp
    integer, intent(in) :: nodesperpart, nnodes, ngroup
    integer, intent(in) :: hindex(2,ngroup)
 
    integer :: i, j, k, ll, np, psize, ind, ptotal
    character(len=100) :: pname
 
    !! Init graph partitioning
    np = ceiling(real(ngroup) / real(nodesperpart))
    write(pname, '("equalGroupParts")')
    call prg_destroygraphpartitioning(gp)
    call prg_initgraphpartitioning(gp, pname, np, ngroup, nnodes)
 
    !! Assign node ids (mapped to orbitals as rows) to each node in each
    !! partition
    !$omp parallel do default(none) &
    !$omp private(i, j, k, ll, ind, psize, ptotal) &
    !$omp shared(gp, hindex, nnodes, ngroup, nodesPerPart)
    do i = 1, gp%totalParts
      call prg_initsubgraph(gp%sgraph(i), i, nnodes)
 
      !! Figure out number of groups in part
      if ((i * nodesperpart) .le. ngroup) then
        psize = nodesperpart
      else
        psize = ngroup - (nodesperpart * (i-1))
      endif
 
      !! Figure out total nodes/rows in part
      ind = (i-1)*nodesperpart
      ptotal = 0
      do j = 1, psize
        ptotal = ptotal + hindex(2, ind+j) - hindex(1, ind+j) + 1
      enddo
      gp%nnodesInPart(i) = ptotal
      gp%nnodesInPartAll(i) = ptotal
 
      !! Enumerate all nodes in part
      allocate(gp%sgraph(i)%nodeInPart(ptotal))
      ll = 1
      do j = 1, psize
        do k = hindex(1, ind+j), hindex(2, ind+j)
          gp%sgraph(i)%nodeInPart(ll) = k-1
          ll = ll + 1
        enddo
      enddo
    enddo
    !$omp end parallel do
 
    !    do i = 1, gp%totalParts
    !      write(*,*) "part ", i, ": ", gp%nnodesInPart(i), " nodes"
    !      write(*,*) "     ", &
    !        (gp%sgraph(i)%nodeInPart(ll),ll = 1, gp%nnodesInPart(i))
    !    enddo
 
  end subroutine prg_equalgrouppartition
 
  subroutine prg_filepartition(gp, partFile)
 
    type (graph_partitioning_t), intent(inout) :: gp
    character(len=*), intent(in) :: partfile
 
    call prg_readpart(gp, partfile)
 
  end subroutine prg_filepartition
 
  subroutine prg_readpart(gp, partFile)
 
    character(len=*), intent(in) :: partFile
    type (graph_partitioning_t), intent(inout) :: gp
 
    integer :: pfile
    integer :: totalNodes, totalParts
    integer :: i, j, ip, pnode
    character(len=100) :: pname
 
    pfile = 10
    open(unit=pfile, status='old', file=partfile)
 
    read(pfile, *) pname
    read(pfile, *) totalnodes, totalparts
 
    call prg_initgraphpartitioning(gp, pname, totalparts, totalnodes, totalnodes)
 
    !! Read in part sizes
    read(pfile, *) (gp%nnodesInPartAll(i), i=1,gp%totalParts)
    do i = 1, gp%totalParts
      gp%nnodesInPart(i) = gp%nnodesInPartAll(i)
    enddo
 
    !! Read in nodes for each part
    do i = 1, gp%totalParts
      read(pfile, *) ip
      call prg_initsubgraph(gp%sgraph(i), i, totalnodes)
      allocate(gp%sgraph(i)%nodeInPart(gp%nnodesInPart(i)))
      read(pfile, *) (gp%sgraph(i)%nodeInPart(j),j=1,gp%nnodesInPart(i))
      do j = 1, gp%nnodesInPart(i)
        gp%sgraph(i)%nodeInPart(j) = gp%sgraph(i)%nodeInPart(j) + 1
      enddo
    enddo
 
    close(pfile)
 
  end subroutine prg_readpart
 
  subroutine prg_fnormgraph(gp)
 
    type(graph_partitioning_t), intent(inout) :: gp
 
    integer :: i, j
#ifdef DO_MPI
    real(dp), allocatable :: slocal(:), sglobal(:)
#endif
 
#ifdef DO_MPI
    ! Sum traces from all parts on all ranks
    if (getnranks() .gt. 1) then
      allocate(slocal(gp%maxIter))
      allocate(sglobal(gp%maxIter))
      do i = 1, gp%maxIter
        slocal(i) = gp%vv(i)
      enddo
      call sumrealparallel(slocal, sglobal, gp%maxIter);
      do i = 1, gp%maxIter
        gp%vv(i) = sglobal(i)
      enddo
      deallocate(slocal, sglobal)
    endif
#endif
 
    !! Take sqrt for fnorm per iter
    do i = 1, gp%maxIter
      gp%vv(i) = sqrt(gp%vv(i))
    enddo
 
    if (printrank() .eq. 1) then
      write(*,*)
      write(*,*) "prg_fnormGraph:"
      do i = 1, gp%maxIter
        write(*,*) "iter = ", i, " fnorm = ", gp%vv(i)
      enddo
    endif
 
  end subroutine prg_fnormgraph
 
end module prg_graph_mod