program mpimulti
use mpi
use omp_lib
implicit none
integer :: iprovided, irank, istat(MPI_STATUS_SIZE), ierr
integer :: nt, ithread, cpu, j
integer :: findmycpu
external findmycpu

call mpi_init_thread(MPI_THREAD_MULTIPLE, iprovided, ierr)
call mpi_comm_rank(MPI_COMM_WORLD, irank, ierr)

if (iprovided >= MPI_THREAD_MULTIPLE) then
! All threads can call MPI
!$OMP parallel private(ithread, nt, ierr, j, istat, cpu)
   ithread = omp_get_thread_num()
   nt = omp_get_num_threads()
   if (irank == 0) then
      call mpi_send(ithread, 1, MPI_INTEGER, 1, ithread, &
         MPI_COMM_WORLD, ierr)
      cpu = findmycpu()
      print '("Rank 0: on cpu ",i3", thread ",i3,' &
         // ' " sent to ",i3)', cpu, ithread, ithread
   elseif (irank == 1) then
      call mpi_recv(j, 1, MPI_INTEGER, 0, ithread, &
         MPI_COMM_WORLD, istat, ierr)
      cpu = findmycpu()
      print '("Rank 1: on cpu ",i3,", thread ",i3,' &
         // '" received from ",i3)', cpu, ithread, j
   endif
!$OMP end parallel
elseif (iprovided == MPI_THREAD_SINGLE) then
   if (irank == 0) print *, "iprovided is MPI_THREAD_SINGLE"
elseif (iprovided == MPI_THREAD_FUNNELED) then
   if (irank == 0) print *, "iprovided is MPI_THREAD_FUNNELED"
elseif (iprovided == MPI_THREAD_SERIALIZED) then
   if (irank == 0) print *, "iprovided is MPI_THREAD_SERIALIZED"
else
   if (irank == 0) print *, "iprovided is not recognized"
endif

call mpi_finalize(ierr)

end program mpimulti