251 lines
9 KiB
Fortran
251 lines
9 KiB
Fortran
!================================================================================
|
|
! 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.
|
|
!--------------------------------------------------------------------------------
|
|
if (.not. task_split) then
|
|
!!$ print *,'not splitting into task groups, all procs are "hydro"'
|
|
task = 'hydro'
|
|
color = 0
|
|
myid = myid_world
|
|
goto 1000
|
|
end if
|
|
|
|
!--------------------------------------------------------------------------------
|
|
! Definition of processor groups: hydro, stats, parts etc. for task splitting.
|
|
!--------------------------------------------------------------------------------
|
|
|
|
! first finding out if there are any particles involved.
|
|
! if there are no particles, then we split the processors in two parts:
|
|
! hydro and stats. If there are some particles, we split the processors
|
|
! in three parts: "hydro", "stats" and "parts". The variables that
|
|
! determines which part the process belongs to is "task".
|
|
|
|
! first see, how many particles are there
|
|
if (myid_world.eq.0) then
|
|
! opening the inupt file
|
|
open(99,file=run_name_local//'.in')
|
|
! skipping the first 35 lines
|
|
do i = 1,35
|
|
read(99,*)
|
|
end do
|
|
! reading the number of particles
|
|
read(99,*) np_local
|
|
close(99)
|
|
end if
|
|
|
|
! broadcasting the number of particles to all processors
|
|
count = 1
|
|
call MPI_BCAST(np_local,count,MPI_INTEGER4,0,MPI_COMM_WORLD,mpi_err)
|
|
|
|
! now splitting the processors in tasks: hydro, stats and parts
|
|
! the curren logic is this:
|
|
! - In case if there are no particles, the split between the hydro and
|
|
! the stats part is 2/3 and 1/3. This way the total number of processors
|
|
! needs to be 3*2^n
|
|
! - In case with the particles in the flow, the split is 1/2, 1/4 and 1/4
|
|
|
|
! first the case when we do not have particles
|
|
if (np_local.eq.0) then
|
|
|
|
! if the numprocs_total is divisible by 3, assign 2/3 of it to hydro
|
|
! and the rest to stats
|
|
if (int(numprocs_world/3)*3 .eq. numprocs_world) then
|
|
numprocs_hydro = numprocs_world * 2/3
|
|
numprocs_stats = numprocs_world - numprocs_hydro
|
|
numprocs_parts = 0
|
|
else if (2**floor(log(real(numprocs_world))/log(2.d0)) .eq. numprocs_world) then
|
|
print*, 'numprocs_world is 2^n, allocating half for hydro: ',numprocs_world
|
|
numprocs_hydro = numprocs_world / 2
|
|
numprocs_stats = numprocs_world - numprocs_hydro
|
|
numprocs_parts = 0
|
|
else
|
|
! if the # of processors N is not 2^n and not divisible by 3, then just take
|
|
! the biggest 2^k < N and make these hydro, the rest - stat.
|
|
numprocs_hydro = 2**floor(log(real(numprocs_world))/log(2.d0))
|
|
numprocs_stats = numprocs_world - numprocs_hydro
|
|
numprocs_parts = 0
|
|
end if
|
|
|
|
id_root_hydro = 0
|
|
id_root_stats = numprocs_hydro
|
|
id_root_parts = 0
|
|
|
|
else
|
|
numprocs_hydro = numprocs_world / 2
|
|
numprocs_stats = numprocs_world / 4
|
|
numprocs_parts = numprocs_world / 4
|
|
|
|
id_root_hydro = 0
|
|
id_root_stats = numprocs_hydro
|
|
id_root_parts = numprocs_hydro + numprocs_stats
|
|
|
|
end if
|
|
|
|
! splitting the communicator into several parts
|
|
! 1. hydro
|
|
! 2. stats
|
|
! 3. parts
|
|
|
|
if (myid_world.lt.numprocs_hydro) then
|
|
task = 'hydro'
|
|
color = 0
|
|
myid = myid_world
|
|
elseif (myid_world.ge.numprocs_hydro .and. myid_world .lt. numprocs_hydro+numprocs_stats) then
|
|
task = 'stats'
|
|
color = 1
|
|
myid = myid_world - numprocs_hydro
|
|
else
|
|
task = 'parts'
|
|
color = 2
|
|
myid = myid_world - numprocs_hydro - numprocs_stats
|
|
end if
|
|
|
|
!--------------------------------------------------------------------------------
|
|
! The actual task splitting happens here
|
|
!--------------------------------------------------------------------------------
|
|
1000 continue
|
|
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*80 :: tmp_str
|
|
integer :: iargc
|
|
|
|
! reading the run_name from the command line
|
|
if(iargc().eq.0) then
|
|
call getarg(0,tmp_str)
|
|
print*, 'Format: ',trim(tmp_str),' (run name) ["split"/"never"]'
|
|
stop
|
|
end if
|
|
call getarg(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(iargc().eq.2) call getarg(2,split)
|
|
|
|
|
|
end subroutine openmpi_get_command_line
|
|
|
|
!================================================================================
|
|
|
|
end module m_openmpi
|