!================================================================================
!
! Modules:
!
! (1) peinfo_m      Originally by DAS 8/20/2010
!
!     Defines type and global instance of object for "processor equivalent" info.
!     Use mpi module to define interfaces for MPI calls.
!     [For F77, MPI header 'mpif.h' was included.]
!
!================================================================================

#include "f_defs.h"

module peinfo_m

! The MPICH1 version of mpi.mod has a limited set of interfaces which will cause
! errors of inability to match generic procedure on compilation for certain
! multidimensional-array calls to MPI_Bcast, MPI_Allreduce, etc.
! Perhaps related to: http://www.mcs.anl.gov/research/projects/mpi/mpich1-old/docs/mpichman-chshmem/node33.htm#Node37
! Solution: pass explicitly the first element, i.e. (1,1,1), of the array.
#ifdef MPI
  use mpi
! include "mpif.h" -- the old way, which will not provide interfaces
#endif
  use nrtype_m
  use intrinsics_m
  implicit none

  ! default must not be private, or else the types defined in mpi module will not be available.

  public ::      &
    peinfo,      &
    peinfo_init, &
    create_mpi_group

!-------------------------------

  type peinfo
    !> default values for serial
    integer :: npes = 1
    integer :: npes_freqgrp = 1
    integer :: nthreads = 1
    integer :: inode = 0
    !> initialize to zero, then keep track of memory
    real(DP) :: mymem = 0d0
    real(DP) :: mymaxmem = 0d0
    integer :: nckmem
    integer :: nkpe  !< number of k-points per processor, used in absorption only
    !> kernel: total number of block-transitions ( nk^2, (nk*nc)^2 or (nk*nc*nv)^2)
    !! Each block-transition has iholdperown 
    integer :: nck
    !> kernel: number of block-transitions that I own
    integer :: nckpe
    integer :: myown !< Kernel: number of unique (k,kp) pairs I own; BSE: number of blocks I own
    integer :: mypown !< in BSE, number of unprimed indices I own for all my blocks
    integer :: npown !< in BSE, max number of unprimed indices owned by any proc in my pool
    integer :: jobtypeeval
    integer :: nblocks
    integer :: nblockd
    !> kernel: (nv,nc,nk,nv,nc,nk) offset in the bse_matrix for the
    !! block-transition identified by (ivp,icp,ikp,iv,ic,ik)
    integer, pointer :: wown(:,:,:,:,:,:)
    integer, pointer :: ciown(:)
    integer, pointer :: ik(:,:) !< (inode,j) index of jth k owned by inode
    integer, pointer :: ic(:,:) !< (inode,j) index of jth cband owned by inode
    integer, pointer :: iv(:,:) !< (inode,j) index of jth vband owned by inode
    integer, pointer :: ikp(:,:) !< (inode,j) index of jth kp owned by inode
    integer, pointer :: icp(:,:) !< (inode,j) index of jth cpband owned by inode
    integer, pointer :: ivp(:,:) !< (inode,j) index of jth vpband owned by inode
    integer, pointer :: ib(:,:)
    integer, pointer :: ick(:,:)
    integer, pointer :: ipe(:)
    !> (inode,iv,ik) Maps the global index for valence band (iv) at kpt (ik) to
    !! the local list of valence band the proc owns. (ik) is define in the 
    !! reducible wedge. ipec is 0 if the proc doesn`t own that band/kpt
    integer, pointer :: ipec(:,:,:)
    integer, pointer :: ipev(:,:,:) !< See ipec
    integer, pointer :: ipek(:,:)   !< Same as ipec, but w/o band index
    integer, pointer :: ipecb(:,:)
    integer, pointer :: ivckpe(:)
    integer, pointer :: ikt(:)
    integer, pointer :: ibt(:)
    integer, pointer :: ikb(:,:)
    integer, pointer :: ivb(:,:)
    integer, pointer :: icb(:,:)
    integer, pointer :: neig(:)
    integer, pointer :: peig(:,:)
    integer :: npools !< number of pools for the valence bands in Epsilon or outer bands in sigma
    integer :: npes_pool !< number of processors per pool
    integer :: pool_group !< mpi_group for pools
    integer :: pool_comm !< mpi_comm for pools
    integer :: pool_rank !< rank within pool
    integer :: my_pool !< what pool this processor is in 
    integer :: nvownmax  !< max. number of valence bands that I can own
    integer :: ncownmax  !< max. number of conduction bands that I can own
    integer :: nvownactual !< (total) number of valence bands that I *really* own
    integer :: ncownactual !< (total) number of conduction bands that I *really* own
    !> Who owns a particular pair of bands (v,c)?
    integer, pointer :: global_pairowner(:,:)
    !> (total) number of valence bands that a particular MPI process owns
    integer, pointer :: global_nvown(:)
    !> (total) number of conduction bands that a particular MPI process owns
    integer, pointer :: global_ncown(:)
    !> indexv(i) is the local index (in terms of bands that I own) of the ith 
    !! (global) valence band. It is zero if I don`t own valence band #i.
    integer, pointer :: indexv(:)
    integer, pointer :: global_indexv(:,:) !< local indices for all processes
    integer, pointer :: indexc(:) !< see indexv
    !> Given a local band #i that I own, invindexv(i) is the global index of
    !! that band. If i>nvownt, the result is zero.
    integer, pointer :: invindexv(:)
    integer, pointer :: invindexc(:) !< see invindexv
    logical, pointer :: doiownv(:) !< do I own a particular valence band?
    logical, pointer :: doiownc(:) !< do I own a particular conduction band?
    logical, pointer :: does_it_ownc(:,:) !< (band,node) does a particular node own a cond. band?
    logical, pointer :: does_it_ownv(:,:) !< (band,node) does a particular node own a val. band?
    integer, pointer :: iownwfv(:) !< number of val. WFNs each proc. owns
    integer, pointer :: iownwfc(:) !< number of cond WFNs each proc. owns
    integer, pointer :: iownwfk(:) !< number of distinct k-points each proc. (partially) owns
    integer, pointer :: nxqown(:)
    integer, pointer :: nxqi(:)
    integer :: ndiag_max
    integer :: noffdiag_max
    integer :: ntband_max
    integer :: ntband_node
    integer :: nvband_node
    integer, pointer :: indext(:)
    integer, pointer :: ntband_dist(:)
    integer, pointer :: indext_dist(:,:)
    integer, pointer :: index_diag(:)
    logical, pointer :: flag_diag(:)
    integer, pointer :: index_offdiag(:)
    logical, pointer :: flag_offdiag(:)
    !> Parallel frequencies mpi group variables
    !! igroup = your group number
    !! rank = your processor number in your group
    !! _f = frequency evaluation group
    !! _mtxel = matrix element communication group
    integer :: igroup_f
    integer :: rank_f
    integer :: igroup_mtxel
    integer :: rank_mtxel
    integer :: mtxel_comm         !< mtxel group communicator
    integer :: freq_comm          !< frequency group communicator
    integer :: mtxel_group        !< mtxel group handle
    integer :: freq_group         !< frequency group handle
    integer, pointer :: ranks(:)  !< ranks of processors to include in mpi group
  end type peinfo
  
  type(peinfo), save, public :: peinf
#ifdef MPI
  integer, public :: mpistatus(MPI_STATUS_SIZE)
  integer, public :: mpierr
#endif

contains

  subroutine peinfo_init()
    ! cannot use push_pop because that module uses this one

#ifdef MPI
    call MPI_Init(mpierr)
    if(mpierr .ne. MPI_SUCCESS) then
      write(0,'(a)') 'ERROR: MPI initialization failed!'
      stop 999
    endif
    call MPI_Comm_rank(MPI_COMM_WORLD, peinf%inode, mpierr)
    call MPI_Comm_size(MPI_COMM_WORLD, peinf%npes, mpierr)
#endif

#ifdef OMP
!$OMP PARALLEL
    peinf%nthreads = OMP_GET_NUM_THREADS()
!$OMP END PARALLEL

! Why put OMP pragmas here?
! JRD: I want to make sure our code has a parallel region before that of any library. This affects
! performance when the libraries are using a different implementation of threads or OpenMP build.
#endif

! if serial, default values set in type peinfo above are left alone

    return
  end subroutine peinfo_init

  subroutine create_mpi_group(orig_group,group_size,ranks,group_handle,group_comm)
    integer, intent(in) :: orig_group    !< Handle for original MPI group, which you are breaking into smaller groups
    integer,intent(in)  :: group_size    !< number of processors in new mpi group
    integer,intent(in)  :: ranks(:)      !< (group_size) array specifying ranks of processors to include in MPI group 
    integer,intent(out) :: group_handle  !< handle for new MPI group 
    integer,intent(out) :: group_comm    !< communicator for new MPI group 

#ifdef MPI
! DVF : create new group from original group, using ranks specified in `ranks` array 
    call MPI_Group_incl(orig_group, group_size,ranks(1:group_size), group_handle, mpierr)
    if(mpierr .ne. MPI_SUCCESS) write(0,'(a)') "ERROR: mpi_group_incl failed!"
! DVF : create communicator for new group
    call MPI_Comm_create(MPI_COMM_WORLD,group_handle,group_comm,mpierr)
    if(mpierr .ne. MPI_SUCCESS) write(0,'(a)') "ERROR: mpi_comm_create failed!"
#else
    group_handle = -1
    group_comm = -1
#endif

    return
  end subroutine create_mpi_group
  
end module peinfo_m
