!================================================================================ ! 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*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