m_openmpi.f90 Source File

!================================================================================
! Module contains interface to OpenMPI
!
! Time-stamp: <2009-08-20 14:22:13 (chumakov)>
!================================================================================


module m_openmpi
!================================================================================
  implicit none
  include 'mpif.h'

  ! Uncomment this for the systems that do not have OpenMPI
  ! In OpenMPI, the parameter MPI_INTEGER_KIND is defined in 'mpif.h'
  ! With other MPI implementations, this parameter has to be defined manually.
  ! integer MPI_INTEGER_KIND
  ! parameter (MPI_INTEGER_KIND = 4)

  ! --- MPI variables
  logical :: iammaster
  integer(kind=MPI_INTEGER_KIND) :: myid_world, numprocs_world
  integer(kind=MPI_INTEGER_KIND) :: numprocs_hydro, numprocs_stats, numprocs_parts
  integer(kind=MPI_INTEGER_KIND) :: myid, numprocs, master, mpi_err, mpi_info, mpi_provide
  integer(kind=MPI_INTEGER_KIND) :: id_to, id_from, tag, count
  integer(kind=MPI_INTEGER_KIND) :: id_root_hydro, id_root_stats, id_root_parts

  ! communicator for separate tasks
  integer(kind=MPI_INTEGER_KIND) :: MPI_COMM_TASK
  ! exclusive communicator for root processes of tasks
  integer(kind=MPI_INTEGER_KIND) :: MPI_COMM_ROOTS

  integer (kind=MPI_INTEGER_KIND) :: sendtag, recvtag
  integer (kind=MPI_INTEGER_KIND) :: request, request1, request2, request3, mpi_request
  integer (kind=MPI_INTEGER_KIND) :: id_l, id_r
  integer (kind=mpi_INTEGER_KIND) :: mpi_status(MPI_STATUS_SIZE)

  integer(kind=MPI_INTEGER_KIND) :: color, key

  character*5 :: task, split="nevah"
  character*10 :: run_name_local

  logical :: task_split=.false.

!================================================================================
contains
!================================================================================

  subroutine m_openmpi_init

    implicit none

    integer (kind=mpi_INTEGER_KIND) :: n
    integer*4 :: np_local
    integer :: i

    ! first getting the run name form the command line 
    ! (it's local, not  global run_name)
    ! also getting the parameter "split" which governs the process splitting:
    ! split="split" means that hydro, statistics and particles are assigned three 
    ! separate process groups (they differ by the char*5 parameter "task").
    ! split="never" (default if the parameter is missing) means that all
    ! processes do all tasks. (does not work for the particles at this point)
    ! call openmpi_get_command_line


    ! initializing MPI environment
    !call MPI_INIT_THREAD(MPI_THREAD_SERIALIZED, mpi_provide, mpi_err)
    call MPI_INIT(mpi_err)
    call MPI_Comm_size(MPI_COMM_WORLD,numprocs_world,mpi_err)
    call MPI_Comm_rank(MPI_COMM_WORLD,myid_world,mpi_err)

!--------------------------------------------------------------------------------
!  Looking at the command line parameter called "split".  If it equals "split"
!  then we define task_split=.true.  If not, task_split remains .false. (default)
!--------------------------------------------------------------------------------
    if (split == "split") task_split = .true.

!--------------------------------------------------------------------------------
!  First check if we need to do any task splitting.  If we don't (split="never")
!  then we define task="hydro" and do a ficticious split with uniform color of
!  all processors.
!--------------------------------------------------------------------------------
    task = 'hydro'
    color = 0
    myid = myid_world

    call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,myid,MPI_COMM_TASK,mpi_err)
    call MPI_COMM_SIZE(MPI_COMM_TASK,numprocs,mpi_err)
    call MPI_COMM_RANK(MPI_COMM_TASK,myid,mpi_err)


    ! each task will have its master process 
    master = 0
    iammaster = .false.
    if (myid.eq.master) iammaster=.true.


!!$    ! The following is put on hold because it looks like a crazy idea

!!$    ! now creating separate exclusive communicator for the master nodes only 
!!$    ! the name of the new communicator is MPI_COMM_ROOTS
!!$    ! if we want quickly broadcast something, then we can use two BCAST calls
!!$    color = 1
!!$    if (iammaster) color = 0
!!$    call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,myid_world,MPI_COMM_ROOTS,mpi_err)



    return
  end subroutine m_openmpi_init

!================================================================================

  subroutine m_openmpi_exit

    call MPI_COMM_FREE(MPI_COMM_TASK,mpi_err)
    call MPI_FINALIZE(mpi_err)

    return
  end subroutine m_openmpi_exit


!================================================================================

  subroutine openmpi_get_command_line
    implicit none

    character(len=80) :: tmp_str

    ! reading the run_name from the command line
    if(command_argument_count().eq.0) then
       call get_command_argument(0,tmp_str)
       print*, 'Format: ',trim(tmp_str),' (run name) ["split"/"never"]'
       stop
    end if
    call get_command_argument(1,run_name_local)
    if(len_trim(run_name_local).ne.10) then
       print *, 'Run name: "',run_name_local,'"'
       print *, '          "1234567890"'
       print *, 'Length of run name is less than 10, sorry.'
       stop
    end if

    ! getting the split parameter, if it's there
    if(command_argument_count().eq.2) call get_command_argument(2,split)
       

  end subroutine openmpi_get_command_line

!================================================================================

end module m_openmpi