module wei_par
  use wei_external
  use wei_util
  use mpi_sep
  !---------------
  implicit none

  !----------------------------------------------------------------
  type weipar
     integer :: nmpi !! no of nodes
     integer :: nomp !! no of procs / node

     integer :: impi !! node rank

     character(len=MPI_MAX_PROCESSOR_NAME) :: name
     character(128) :: suffix !! tag suffix
     
     logical :: mpi
  end type weipar
  !----------------------------------------------------------------

  !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!
  type(weipar), public :: wpar
  !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !! total number of processors
  integer, private :: npro

  !! mpi transfer status
  integer :: status(MPI_STATUS_SIZE) 
contains
  !----------------------------------------------------------------
  subroutine weipar_init()
    integer :: mpierr
    integer :: version, subversion
    integer :: jmpi, jpro

    !! total # of nodes
    call MPI_COMM_SIZE(MPI_COMM_WORLD, wpar%nmpi, mpierr)
    !! rank of each node
    call MPI_COMM_RANK(MPI_COMM_WORLD, wpar%impi, mpierr)

    !! number of processors on each node
    !$OMP PARALLEL
    wpar%nomp = omp_get_num_threads()
    !$OMP END PARALLEL

    call weipar_nprocs() !! total number of procs
    call weipar_suffix() !! tmp files suffix

  end subroutine weipar_init
  !----------------------------------------------------------------  
  !! find the total number of processors
  subroutine weipar_nprocs()
    integer :: mpierr
    integer :: msglen ! message length
    integer :: msgtag ! message tag (arbitrary)
    integer :: msgsou ! message source
    integer :: msgrec ! message receiver
    integer :: jpro,jmpi

    msgtag = 1001
    msglen = 1   

    if(wpar%impi /= 0) then
       !! send nomp to master
       ;  msgrec = 0
       ;  CALL MPI_SEND(wpar%nomp,msglen,MPI_INTEGER,msgrec,msgtag,MPI_COMM_WORLD,       mpierr)
    else
       !! receive nomp from every node
       npro = wpar%nomp
       do jmpi = 1, wpar%nmpi-1
          msgsou = jmpi 
          CALL MPI_RECV(     jpro,msglen,MPI_INTEGER,msgsou,msgtag,MPI_COMM_WORLD,status,mpierr)
          npro = npro + jpro
       end do
    end if

    ! the barrier is not really needed here
    call MPI_BARRIER(MPI_COMM_WORLD,mpierr) 
  end subroutine weipar_nprocs
  !----------------------------------------------------------------
  subroutine weipar_report()
    integer :: mpierr
    integer :: version, subversion

    if(wpar%impi==0) call weiline()
    if(wpar%impi==0) write(0,'(a,a,i2)') weitab," WEIPAR REPORT",wpar%impi 
    if(wpar%impi==0) call weiline()
    call MPI_BARRIER(MPI_COMM_WORLD ,mpierr)
    if(wpar%impi==0) call weiline()
    if(wpar%impi==0) write(0,'(a,i2,a,i2,a)') weitab,wpar%nmpi," node(s) - "&
    ,                                                     npro," proc(s) "
    call MPI_BARRIER(MPI_COMM_WORLD ,mpierr)

    call MPI_GET_PROCESSOR_NAME(wpar%name,MPI_MAX_PROCESSOR_NAME,mpierr)
    write(0,'(a,i3,a,i3,a,a,a,a)') weitab, &
    wpar%nomp,"CPU on node",wpar%impi, " (",trim(wpar%suffix),") ",trim(wpar%name)
    call MPI_BARRIER(MPI_COMM_WORLD ,mpierr)    
    if(wpar%impi==0) call weiline()
  end subroutine weipar_report
  !----------------------------------------------------------------
  subroutine weipar_suffix()
    !! set the name suffix for all the nodes
    
    if     (wpar%impi>=100 .and. wpar%impi<=999) then
       write(wpar%suffix,"(a,i3)") "_mpiWEI",  wpar%impi
    else if(wpar%impi>=10  .and. wpar%impi<=99 ) then
       write(wpar%suffix,"(a,i2)") "_mpiWEI0", wpar%impi
    else
       write(wpar%suffix,"(a,i1)") "_mpiWEI00",wpar%impi
    end if
  end subroutine weipar_suffix
  !----------------------------------------------------------------
end module wei_par





