! EPCC coarray example problem ! reconstruction of an image from ! the edges with a 2D grid of images. ! Using the larger image. ! Using allocatable coarrays. ! Run this test only after ex3a has ! run successfully! ! ! Important: ! the first argument to the executable ! is the number of images along direction 1. ! Make sure that nx and ny are divisible ! by nimgs1 and nimgs2 respectively! program ex3b use pgmio implicit none integer, parameter :: nx=672, ny=1024, maxiter=100000 integer :: myimage, imgpos(2),i,j,iter,errstat=0, nimgs, & nimgs1[*], nimgs2[*], n1local[*], n2local[*] double precision,allocatable :: bigpic(:,:)[:,:], & oldpic(:,:)[:,:], newpic(:,:)[:,:], edge(:,:)[:,:] character(len=20) :: outpgm character(len=255) :: value ! first executable statement myimage = this_image() if (myimage .eq. 1) then call get_command_argument (1,value) read (value,'(i)') nimgs1 nimgs=num_images() nimgs2=nimgs/nimgs1 if ((nimgs1 .le. 0) .or. & (nimgs1*nimgs2 .ne. nimgs) .or. & (nimgs2 .gt.1 .and. mod(nimgs2,2).ne.0)) & stop "invalid value given for the number of images along 1!" n1local= nx/nimgs1 n2local= ny/nimgs2 write (*,*) "image layout:", nimgs1, "x", nimgs2 write (outpgm,'(i0,"x",i0,"=",i0,".pgm")')nimgs1,nimgs2,nimgs write (*,*) "Will write output to ",outpgm end if sync all nimgs1 =nimgs1[1] nimgs2 =nimgs2[1] n1local=n1local[1] n2local=n2local[1] allocate (bigpic(nx, ny)[nimgs1,*],stat=errstat) if (errstat.ne.0) stop "cannot allocate bigpic" allocate (oldpic(0:n1local+1, 0:n2local+1)[nimgs1,*],stat=errstat) if (errstat.ne.0) stop "cannot allocate oldpic" allocate (newpic(0:n1local+1, 0:n2local+1)[nimgs1,*],stat=errstat) if (errstat.ne.0) stop "cannot allocate newpic" allocate (edge (0:n1local+1, 0:n2local+1)[nimgs1,*],stat=errstat) if (errstat.ne.0) stop "cannot allocate edge" ! check the image layout ! and save some image variables for the rest ! of the similation imgpos=this_image(oldpic) write (*,*) 'image',this_image(),'is',imgpos if (myimage .eq. 1) call pgmread('edge672x1024.pgm', bigpic) sync all ! distribute pieces of array to images oldpic=0.0 newpic=0.0 oldpic(1:n1local, 1:n2local) = & bigpic(1+(imgpos(1)-1)*n1local:imgpos(1)*n1local, & 1+(imgpos(2)-1)*n2local:imgpos(2)*n2local)[1,1] edge=oldpic sync all ! integrate to get the image back do iter=1,maxiter ! get the halos if (imgpos(1).ne.1) oldpic(0,:)=oldpic(n1local,:)[imgpos(1)-1,imgpos(2)] if (imgpos(1).ne.nimgs1) oldpic(n1local+1,:)=oldpic(1,:)[imgpos(1)+1,imgpos(2)] if (imgpos(2).ne.1) oldpic(:,0)=oldpic(:,n2local)[imgpos(1),imgpos(2)-1] if (imgpos(2).ne.nimgs2) oldpic(:,n2local+1)=oldpic(:,1)[imgpos(1),imgpos(2)+1] sync all do j=1,n2local do i=1,n1local newpic(i,j)=0.25*( & oldpic(i-1,j)+oldpic(i+1,j)+oldpic(i,j-1)+oldpic(i,j+1)-edge(i,j) ) end do end do ! update oldpic after every integration oldpic=newpic sync all end do sync all ! Now write the output on image 1. if (myimage .eq. 1) then bigpic=-1.0 do j=1,nimgs2 do i=1,nimgs1 bigpic(1+(i-1)*n1local:i*n1local, 1+(j-1)*n2local:j*n2local)=& oldpic(1:n1local, 1:n2local)[i,j] end do end do call pgmwrite(trim(outpgm), bigpic) end if deallocate (bigpic,stat=errstat) if (errstat.ne.0) stop "cannot deallocate bigpic" deallocate (oldpic,stat=errstat) if (errstat.ne.0) stop "cannot deallocate oldpic" deallocate (newpic,stat=errstat) if (errstat.ne.0) stop "cannot deallocate newpic" deallocate (edge,stat=errstat) if (errstat.ne.0) stop "cannot deallocate edge" end program ex3b