setup_g2gf_redistribute Subroutine

  subroutine setup_g2gf_redistribute(g_lo, gf_lo, g2gf)
    use mp, only: nproc
    use layouts_type, only: g_layout_type, gf_layout_type
    use gs2_layouts, only: idx_local, proc_id
    use gs2_layouts, only: ig_idx, isign_idx
    use gs2_layouts, only: ik_idx, it_idx, ie_idx, is_idx, il_idx, idx
    use redistribute, only: index_list_type, init_redist, delete_list
    use sorting, only: quicksort
    implicit none
    type(g_layout_type), intent(in) :: g_lo
    type(gf_layout_type), intent(in) :: gf_lo
    type(redist_type), intent(in out) :: g2gf
    type (index_list_type), dimension(0:nproc-1) :: to_list, from_list, sort_list, bak_sort_list
    integer, dimension (0:nproc-1) :: nn_to, nn_from
    integer, dimension (3) :: from_low, from_high
    integer, dimension (6) :: to_low, to_high
    integer :: iglo, il, igf
    integer :: ie, is
    integer :: n, ip
    !Initialise the data counters
    nn_to = 0
    nn_from = 0

    !First count the data to be sent | g_lo-->gf_lo
    !Protect against procs with no data
    if(g_lo%ulim_proc>=g_lo%llim_proc)then
       do iglo = g_lo%llim_proc,g_lo%ulim_alloc

          igf = idx(gf_lo, ik_idx(g_lo, iglo), it_idx(g_lo, iglo))
          nn_from(proc_id(gf_lo,igf))=nn_from(proc_id(gf_lo,igf))+1
       enddo
    endif

    !Now count how much data to receive | gf_lo<--g_lo
    !Protect against procs with no data
    if(gf_lo%ulim_proc>=gf_lo%llim_proc)then
       do igf=gf_lo%llim_proc,gf_lo%ulim_alloc
          do is=1,g_lo%nspec
             do ie=1,g_lo%negrid
                do il=1,g_lo%nlambda
                   iglo = idx(g_lo, ik_idx(gf_lo, igf), it_idx(gf_lo, igf), il, ie, is)
                   !Increment the data to receive counter
                   nn_to(proc_id(g_lo,iglo))=nn_to(proc_id(g_lo,iglo))+1
                enddo
             enddo
          enddo
       enddo
    endif


    !Now allocate storage for index arrays
    do ip = 0, nproc-1
       if (nn_from(ip) > 0) then
          allocate (from_list(ip)%first (nn_from(ip)))
          allocate (from_list(ip)%second(nn_from(ip)))
          allocate (from_list(ip)%third (nn_from(ip)))
       end if
       if (nn_to(ip) > 0) then
          allocate (to_list(ip)%first (nn_to(ip)))
          allocate (to_list(ip)%second(nn_to(ip)))
          allocate (to_list(ip)%third (nn_to(ip)))
          allocate (to_list(ip)%fourth (nn_to(ip)))
          allocate (to_list(ip)%fifth (nn_to(ip)))
          allocate (to_list(ip)%sixth (nn_to(ip)))
          allocate (sort_list(ip)%first (nn_to(ip)))
          allocate (bak_sort_list(ip)%first (nn_to(ip)))
       end if
    end do

    !Reinitialise counters
    nn_to = 0
    nn_from = 0

    !First fill in sending indices, these define the message order
    !Protect against procs with no data
    if(g_lo%ulim_proc>=g_lo%llim_proc)then
       do iglo=g_lo%llim_proc,g_lo%ulim_alloc
          igf=idx(gf_lo,ik_idx(g_lo,iglo),it_idx(g_lo,iglo))

          !Get proc id
          ip=proc_id(gf_lo,igf)

          n=nn_from(ip)+1
          nn_from(ip)=n

          !Store indices (we are sending ntgridtotal*isign sized messages each time at a time)
          from_list(ip)%first(n)=-g_lo%ntgrid
          from_list(ip)%second(n)=1
          from_list(ip)%third(n)=iglo

       enddo
    endif

    !Now fill in the receiving indices, these must match message data order
    !Protect against procs with no data
    if(gf_lo%ulim_proc>=gf_lo%llim_proc)then
       do igf=gf_lo%llim_proc,gf_lo%ulim_alloc
          do il=1,gf_lo%nlambda
             do ie=1,gf_lo%negrid
                do is=1,gf_lo%nspec
                   !Get iglo value
                   iglo = idx(g_lo,ik_idx(gf_lo,igf),it_idx(gf_lo,igf),il,ie,is)
                   !Get proc_id
                   ip=proc_id(g_lo,iglo)

                   !Increment counter
                   n=nn_to(ip)+1
                   nn_to(ip)=n

                   !Store indices
                   !We are sending messages of size ntgridtotal*isign
                   to_list(ip)%first(n)=-gf_lo%ntgrid
                   to_list(ip)%second(n)=1
                   to_list(ip)%third(n)=is
                   to_list(ip)%fourth(n)=ie
                   to_list(ip)%fifth(n)=il
                   to_list(ip)%sixth(n)=igf

                   sort_list(ip)%first(n) = iglo-g_lo%llim_world
                enddo
             enddo
          enddo
       enddo
    endif

    do ip=0,nproc-1
       if(allocated(sort_list(ip)%first)) then
          bak_sort_list(ip)%first(:) = sort_list(ip)%first(:)
       end if
    end do

    !Now sort receive indices into message order
    do ip=0,nproc-1
       if(nn_to(ip)>0) then
          !Apply quicksort
          !AJ I'm calling quicksort twice to save me writing a six array version of quicksort and insertsort.
          !AJ This is just lazyness and probably should be corrected at some point.
          call quicksort(nn_to(ip),sort_list(ip)%first,to_list(ip)%first,to_list(ip)%second,to_list(ip)%third)
          call quicksort(nn_to(ip),bak_sort_list(ip)%first,to_list(ip)%fourth,to_list(ip)%fifth,to_list(ip)%sixth)
       endif
    enddo


    !Now setup array range values
    from_low (1) = -g_lo%ntgrid
    from_low (2) = 1
    from_low (3) = g_lo%llim_proc

    from_high(1) = g_lo%ntgrid
    from_high(2) = 2
    from_high(3) = g_lo%ulim_alloc

    to_low(1) = -gf_lo%ntgrid
    to_low(2) = 1
    to_low(3) = 1
    to_low(4) = 1
    to_low(5) = 1
    to_low(6) = gf_lo%llim_proc

    to_high(1) = gf_lo%ntgrid
    to_high(2) = 2
    to_high(3) = gf_lo%nspec
    to_high(4) = gf_lo%negrid
    to_high(5) = gf_lo%nlambda
    to_high(6) = gf_lo%ulim_alloc

    !Create g2gf redist object
    call init_redist (g2gf, 'c', to_low, to_high, to_list, from_low, from_high, from_list)

    !Deallocate lists
    call delete_list (to_list)
    call delete_list (from_list)
    call delete_list (sort_list)
    call delete_list (bak_sort_list)
  end subroutine setup_g2gf_redistribute