C ******************************************************************* c Global description and assumptions: c ---------------------------------- c 1. The processes form a 2D nx \times ny logical grid c 2. Each processor handles arrays of size lx \times ly c - lx, ly might be different for the different processes (option) C ******************************************************************* program main implicit none include 'mpif.h' c ---------------------------------- MPI stuff ---------------------- c dimension of the array of processors (nodes): integer nnodes,me,ierr c ---------------------------------- my stuff ---------------------- integer nx,ny,nall,lnall,lx,ly,mem_flag,mem_reqR integer bufsize,Buffer(6) integer O,PVA,POA,PVR,POR,PVB,POB,MEM, > totalV,totalO,Pm,pn,Ps,Pe,Pw, > Pu,Prhs,Pd,Pg,Ph,Pwrk,Pbuf1,Pbuf2 double precision V c structure /Buffer/ c integer nx c integer ny c integer lx c integer ly c integer nall c integer lnall c end structure c parameter (totalV=5625000,totalO=1) ! up to 700 x700 parameter (totalV=11540500,totalO=1) ! up to 1024 x 1024 DIMENSION V(totalV),O(totalO) COMMON/CRNTADD/ PVA,POA,PVR,POR,PVB,POB call MPI_INIT(ierr) c write(*,*) '>>>>>>',ierr call MPI_COMM_RANK( MPI_COMM_WORLD, me, ierr) call MPI_COMM_SIZE( MPI_COMM_WORLD, nnodes,ierr) if (me.EQ.0) then write(*,*) 'The number of processors (nodes) is: ',nnodes endif if (me.eq.0) then c nx = 4 c ny = 2 write(*,*) 'Enter number of procs in x-direction:' read(*,*) nx ! number of processes in 'x'-direction write(*,*) 'Enter number of procs in y-direction:' read(*,*) ny ! number of processes in 'y'-direction if (nnodes.ne.nx*ny) then print*,'MPI started with wrong number of nodes. Needed:',nx*ny goto 99999 endif c lx = 64 c ly = 64 write(*,*) 'Enter number of points in x-direction (per subgrid):' read(*,*) lx ! number of 'x'-points per subgrid write(*,*) 'Enter number of points in y-direction (per subgrid):' read(*,*) ly ! number of 'y'-points per subgrid lnall = lx*ly ! subgridsize nall = nx*ny*lnall ! total number of unknowns bufsize = max(lx,ly) ! c ---------- memory requirements test: mem_reqR = 10*lnall + (lx+2)*(ly+2) + 2*bufsize mem_flag = 0 write(*,*) 'Real*8 memory required: ', > mem_reqR,'/',totalV if (mem_reqR .gt. totalV) then write(*,*) 'Real memory not enough.' mem_flag = 1 endif if (mem_flag .eq. 1) goto 99999 c ---------- broadcast the initial parameters Buffer(1) = nx Buffer(2) = ny Buffer(3) = lx Buffer(4) = ly Buffer(5) = nall Buffer(6) = lnall endif call MPI_BCAST(Buffer,6,MPI_INTEGER, > 0 ,MPI_COMM_WORLD, ierr) call MPI_BARRIER(MPI_COMM_WORLD,ierr) c write(*,*) 'Bcasted:','(',me,')',Buffer if (me.ne.0) then nx = Buffer(1) ny = Buffer(2) lx = Buffer(3) ly = Buffer(4) nall = Buffer(5) lnall = Buffer(6) endif c ---------- memory allocation CALL RESET(1, 'VA') CALL RESET(1, 'OA') CALL RESET(totalV,'VB') CALL RESET(totalO,'OB') c ---------- for the matrix Pm = MEM(lnall,'VA') Pn = MEM(lnall,'VA') Ps = MEM(lnall,'VA') Pe = MEM(lnall,'VA') Pw = MEM(lnall,'VA') c ---------- for the vectors Pu = MEM(lnall, 'VA') Prhs = MEM(lnall, 'VA') Pd = MEM(lnall, 'VA') Pg = MEM(lnall, 'VA') Ph = MEM(lnall, 'VA') Pwrk = MEM((lx+2)*(ly+2),'VA') Pbuf1= MEM(bufsize, 'VA') Pbuf2= MEM(bufsize, 'VA') call main_main(V(Pm),V(Pn),V(Ps),V(Pe),V(Pw), > V(Pu),V(Prhs),V(Pd),V(Pg),V(ph), > V(Pwrk),V(Pbuf1),V(Pbuf2), > me, nnodes,nx,ny,lx,ly,nall,lnall,bufsize) 99999 call MPI_FINALIZE( ierr ) stop end c ------------------------------------------------------------------- subroutine main_main(m,n,s,e,w, > u,rhs,D,G,H,wrk,buf1,buf2, > me, nnodes,nx,ny,lx,ly,nall,lnall,bufsize) implicit none include 'mpif.h' c ---------------------------------- MPI stuff ---------------------- c dimension of the array of processors (nodes): integer nnodes,me,iter,res,floor,ierr integer north,south,east,west double precision start_time,end_time c ---------------------------------- my stuff ----------------------- integer nx,ny,nall,lnall,lx,ly,bufsize double precision eps,Ceps,arfac double precision m(lx,ly), > n(lx,ly),s(lx,ly), > e(lx,ly),w(lx,ly), > u(lx,ly),rhs(lx,ly), > D(lx,ly),G(lx,ly), > H(lx,ly),wrk(0:lx+1,0:ly+1), > buf1(bufsize),buf2(bufsize) c ---------- find the neighbours res = MOD(me,ny) floor = me/ny north = me+1 south = me-1 east = me+ny west = me-ny c - - - - - - - - - - if (res.eq.ny-1) north = -1 if (res.eq.0) south = -1 if (floor.eq.nx-1) east = -1 if (floor.eq.0) west = -1 c - - - - - - - - - - call matgen(m,n,s,e,w,lx,ly,me,north,south,east,west) call MPI_BARRIER(MPI_COMM_WORLD,ierr) call rhsgen(rhs,u, m,n,s,e,w, > wrk, buf1, buf2, > me,north,south,east,west, > lx, ly, bufsize) eps = 1.0d-12 start_time = MPI_WTIME() call mpi_cg(u, rhs, m,n,s,e,w, > D, G, H, wrk, buf1, buf2, > me,north,south,east,west, > eps, Ceps, iter, arfac, lx, ly, bufsize) end_time = MPI_WTIME() write(*,*) 'Wall clock time for: ',me,': ',end_time-start_time 999 return end