CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C Don Morton, June 1998 C Department of Computer Science C The University of Montana C Missoula, Montana 59812, USA C Email: morton@cs.umt.edu C C This is a sample code which illustrates the basic C mechanism used to couple two previously existing C parallel codes. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC program couple implicit none include 'mpif.h' integer n, myid, numprocs, i, rc, ierr integer & hydro_num procs, ! Number processes for hydro code & therm_numprocs, ! Number processes for thermal code & ranks_in_old_group(0:127) ! list of ranks in old group integer !MPI_Comm & world_comm_handle, & hydro_comm_handle, & therm_comm_handle, & inter_comm_handle integer !MPI_Group & world_group_handle, & hydro_group_handle, & therm_group_handle ccc Initialization of each process into MPI_COMM_WORLD call MPI_INIT(ierr) ccc Find out what my processor number is call MPI_COMM_RANK(MPI_COMM_WORLD, myid, ierr) ccc Find out how many total processors are running call MPI_COMM_SIZE(MPI_COMM_WORLD, numprocs, ierr) print *, 'PE ', myid, ': Hello, World' ccc Wait here until everyone has reached this point call MPI_Barrier(MPI_COMM_WORLD, ierr) ccc Assign roughly half of total processors to each of the two models hydro_numprocs = numprocs/2 therm_numprocs = numprocs - hydro_numprocs ccc Obtain my "group" handle for use in creating new groups call MPI_Comm_group(MPI_COMM_WORLD, world_group_handle, ierr) ccc Create hydro group and communicator cccccccccccccccccccccc ccc First, get a list of the ranks I held in the "global" group do i=0,hydro_numprocs-1 ranks_in_old_group(i) = i enddo ccc Setup up hydro processes and create a handle for the new hydro group call MPI_Group_incl(world_group_handle, hydro_numprocs, & ranks_in_old_group, hydro_group_handle, ierr) call MPI_Comm_create(MPI_COMM_WORLD, hydro_group_handle, & hydro_comm_handle, ierr) ccc Obtain my "group" handle for use in creating new groups call MPI_Comm_group(MPI_COMM_WORLD, world_group_handle, ierr) ccc Setup up thermal processes and create a handle for the new thermal group do i=0,therm_numprocs-1 ranks_in_old_group(i) = i+hydro_numprocs enddo call MPI_Group_incl(world_group_handle, therm_numprocs, & ranks_in_old_group, therm_group_handle, ierr) call MPI_Comm_create(MPI_COMM_WORLD, therm_group_handle, & therm_comm_handle, ierr) ccc create intercommunicator and then proceed with hydro and thermal codes if (myid .lt. hydro_numprocs) then ! I am a hydro process call MPI_Intercomm_create(hydro_comm_handle, 0, MPI_COMM_WORLD, & hydro_numprocs, 0, inter_comm_handle, ierr) call hydro(hydro_comm_handle, inter_comm_handle) else ! I am a thermal process call MPI_Intercomm_create(therm_comm_handle, 0, MPI_COMM_WORLD, & 0, 0, inter_comm_handle, ierr) call thermal(therm_comm_handle, inter_comm_handle) endif call MPI_Barrier(MPI_COMM_WORLD, ierr) call MPI_FINALIZE(rc) end ccc============================================================== subroutine hydro(hydro_comm_handle, inter_comm_handle) implicit none integer hydro_comm_handle, ! "handles" used for communication & inter_comm_handle include 'mpif.h' integer hydro_myrank, & hydro_numprocs, & sum_of_ranks, & thermal_number, & status(MPI_STATUS_SIZE), & ierr ccc Find my rank and number of processes in the hydro group call MPI_COMM_RANK(hydro_comm_handle, hydro_myrank, ierr) print *, 'Rank number in hydro group: ', hydro_myrank call MPI_COMM_SIZE(hydro_comm_handle, hydro_numprocs, ierr) print *, 'Number of processes in hydro group: ', hydro_numprocs call MPI_Barrier(hydro_comm_handle, ierr) ccc Gather some numbers from all the hydro processes, and "do ccc something" with them to form a single number. In this ccc trivial example, each process simply sends its processor ccc number to the master hydro process, which in turn adds them ccc all together to produce a single value call MPI_Reduce(hydro_myrank, sum_of_ranks, 1, MPI_INTEGER, & MPI_SUM, 0, hydro_comm_handle, ierr) ccc The hydro master process, having obtained and summed all the ccc numbers from the other hydro processes, prints the value if (hydro_myrank .eq. 0) then print *, 'Hydro0: Reduced value is: ', sum_of_ranks endif ccc Send number from hydro master process to thermal master process if (hydro_myrank .eq. 0) then call MPI_Send(sum_of_ranks, 1, MPI_INTEGER, 0, & 0, inter_comm_handle, ierr) endif ccc OK, we've sent out our value to the thermal processes. Now ccc we're going to receive something from the thermal processes. ccc Receive number from thermal master process, and print if (hydro_myrank .eq. 0) then call MPI_Recv(thermal_number, 1, MPI_INTEGER, 0, & 0, inter_comm_handle, status, ierr) print *, 'Hydro0: Thermal value is: ', thermal_number endif ccc Distribute the thermal number to all the other hydro processes call MPI_Bcast(thermal_number, 1, MPI_INTEGER, 0, & hydro_comm_handle, ierr) print *, 'Hydro', hydro_myrank, ': Thermal value is - ', & thermal_number call MPI_Barrier(hydro_comm_handle, ierr) return end ccc============================================================== subroutine thermal(therm_comm_handle, inter_comm_handle) implicit none integer therm_comm_handle, & inter_comm_handle include 'mpif.h' integer therm_myrank, & therm_numprocs, & thermal_number, & sum_of_ranks, & status(MPI_STATUS_SIZE), & ierr ccc Find my rank and number of processes in the thermal group call MPI_COMM_RANK(therm_comm_handle, therm_myrank, ierr) print *, 'Rank number in thermal group:', therm_myrank call MPI_COMM_SIZE(therm_comm_handle, therm_numprocs, ierr) print *, 'Number of processes in therm group:', therm_numprocs call MPI_Barrier(therm_comm_handle, ierr) ccc Receive some value from the hydro master process, then print it. if (therm_myrank .eq. 0) then call MPI_Recv(sum_of_ranks, 1, MPI_INTEGER, 0, & 0, inter_comm_handle, status, ierr) print *, 'Therm0: Received value is: ', sum_of_ranks endif ccc Send some arbitrary value to the hydro master process if (therm_myrank .eq. 0) then thermal_number = 1000 call MPI_Send(thermal_number, 1, MPI_INTEGER, 0, & 0, inter_comm_handle, ierr) endif call MPI_Barrier(therm_comm_handle, ierr) return end