c******************************************************************* c oned.f - a solution to the Poisson problem using Jacobi c interation on a 1-d decomposition c c The size of the domain is read by processor 0 and broadcast to c all other processors. The Jacobi iteration is run until the c change in successive elements is small or a maximum number of c iterations is reached. The difference is printed out at each c step. c******************************************************************* program main C include "mpif.h" integer maxn parameter (maxn = 128) double precision a(maxn,maxn), b(maxn,maxn), f(maxn,maxn) save a integer nx, ny integer myid, numprocs, ierr integer comm1d, nbrbottom, nbrtop, s, e, it integer sizedouble, win, winb integer *8 winsize double precision diff, diffnorm, dwork double precision t1, t2 external diff call MPI_INIT( ierr ) call MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr ) call MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ierr ) c if (myid .eq. 0) then c c Get the size of the problem c c print *, 'Enter nx' c read *, nx nx = 110 endif call MPI_BCAST(nx,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ny = nx c c Get a new communicator for a decomposition of the domain c call MPI_CART_CREATE( MPI_COMM_WORLD, 1, numprocs, .false., $ .true., comm1d, ierr ) c c Get my position in this communicator, and my neighbors c call MPI_COMM_RANK( comm1d, myid, ierr ) call MPI_Cart_shift( comm1d, 0, 1, nbrbottom, nbrtop, ierr ) c c Compute the actual decomposition c call MPE_DECOMP1D( ny, numprocs, myid, s, e ) c c Initialize the right-hand-side (f) and the initial solution guess (a) c call onedinit( a, b, f, nx, s, e ) c c Create the RMA window call mpi_type_size( MPI_DOUBLE_PRECISION, sizedouble, ierr) winsize = (nx+2)*(e-s+3)*sizedouble call mpi_win_create( a, winsize, sizedouble, * MPI_INFO_NULL, MPI_COMM_WORLD, win, ierr ) call mpi_win_create( b, winsize, sizedouble, * MPI_INFO_NULL, MPI_COMM_WORLD, winb, ierr ) c c c Actually do the computation. Note the use of a collective operation to c check for convergence, and a do-loop to bound the number of iterations. c call MPI_BARRIER( MPI_COMM_WORLD, ierr ) t1 = MPI_WTIME() do 10 it=1, 100 c do 10 it=1, 2 call exchng1( a, nx, s, e, win, nbrbottom, nbrtop ) call sweep1d( a, f, nx, s, e, b ) call exchng1( b, nx, s, e, winb, nbrbottom, nbrtop ) call sweep1d( b, f, nx, s, e, a ) dwork = diff( a, b, nx, s, e ) call MPI_Allreduce( dwork, diffnorm, 1, MPI_DOUBLE_PRECISION, $ MPI_SUM, comm1d, ierr ) if (diffnorm .lt. 1.0e-5) goto 20 if (myid .eq. 0) print *, 2*it, ' Difference is ', diffnorm 10 continue if (myid .eq. 0) print *, 'Failed to converge' 20 continue t2 = MPI_WTIME() if (myid .eq. 0) then print *, 'Converged after ', 2*it, ' Iterations in ', t2 - t1, $ ' secs ' endif c call MPI_WIN_FREE( win, ierr ) call MPI_WIN_FREE( winb, ierr ) call MPI_FINALIZE(ierr) end