program pp_mpi_ex1 !Simple general MPI example use mpi implicit none integer :: numtasks,rank,ierr,rc,name_len,name_len_max integer :: i !Variables for MPI character(len=MPI_MAX_PROCESSOR_NAME) :: proc_name integer :: isendbuf,isendcount,root integer,allocatable :: irecvbuf(:) character(1),allocatable :: crecvbuf(:) !Variables to acumulate data integer,parameter :: length=100000 real(selected_real_kind(15,307)) :: atmp(length),btmp(length) !MPI initialization call mpi_init(ierr) if (ierr .ne. MPI_SUCCESS) then print *,'Error starting MPI program. Terminating.' call mpi_abort(MPI_COMM_WORLD,rc,ierr) end if !Initialize "global" variables root=0 !The process that will do the receiving and output isendcount=1 !How many integers will be gathered !Get the MPI "locals" call mpi_comm_rank(MPI_COMM_WORLD,rank,ierr) !The process rank call mpi_get_processor_name(proc_name,name_len,ierr) !The processor name !Do the initialization, only by the root process if (rank .eq. root) then call mpi_comm_size(MPI_COMM_WORLD,numtasks,ierr) allocate(irecvbuf(numtasks*isendcount)) !Make room for gathering the process ranks endif !Do "the work" (by all processes) isendbuf=rank !Find out the maximum length of the processor name, accross all processes call mpi_allreduce(name_len,name_len_max,isendcount,MPI_INTEGER,MPI_MAX,MPI_COMM_WORLD,ierr) !Waste some time, so that the program takes a noticeable time to finish forall(i=1:length) atmp(i)=(i-1)/((length-1)*1d0) do i=1,100 btmp=acos(cos(atmp*acos(-1d0))) enddo !End of "the work" !Make room to get the processor names if (rank .eq. root) then allocate(crecvbuf(name_len_max*numtasks)) endif !Get the results from everybody call mpi_gather(isendbuf,isendcount,MPI_INTEGER,irecvbuf,isendcount,MPI_INTEGER,root,MPI_COMM_WORLD,ierr) call mpi_gather(proc_name(1:name_len_max),name_len_max,MPI_CHARACTER,crecvbuf,name_len_max,MPI_CHARACTER,root,MPI_COMM_WORLD,ierr) !Show the results (only the root process does this) if (rank .eq. root) then print *,'I am process number ',rank print *,'Running on processor ',proc_name(1:name_len) print *,'Number of tasks is ',numtasks do i=0,numtasks-1 print *,'Process rank ',irecvbuf(i+1),' ran on processor ',crecvbuf(i*name_len_max+1:(i+1)*name_len_max) enddo endif call mpi_finalize(ierr) end program pp_mpi_ex1