function mand(z0,n) complex (kind=kind(1d0)) :: z,z0 integer i,n,mand z=z0 do i=1,n z=z*z+z0 if (abs(z).gt.4d0) exit enddo mand=512-512*(log(real(i))/log(real(n))) end function program mandel use mpi_f08 implicit none real (kind=kind(1d0)) :: x,y integer :: res,i,j integer :: pallette(3,0:512), set(3) character, allocatable :: line(:) integer :: nproc,irank,mand,hdr integer(kind=MPI_OFFSET_KIND) :: disp integer(kind=MPI_ADDRESS_KIND) :: lb,extent character(len=100)::str character(len=1)::nl type(mpi_status) :: stat type(mpi_file) :: mpi_img type(mpi_datatype) :: row_type,tmp_type call mpi_init() call mpi_comm_rank(mpi_comm_world, irank) call mpi_comm_size(mpi_comm_world, nproc) if (irank.eq.0) then write(*,*)'Please input resolution' read(*,*) res end if call mpi_bcast(res,1,MPI_INTEGER,0,MPI_COMM_WORLD) call mpi_file_open(MPI_COMM_WORLD,"mandelf.pam", & MPI_MODE_WRONLY+MPI_MODE_CREATE,MPI_INFO_NULL,mpi_img) ! Ensure any existing file is truncated call mpi_file_set_size(mpi_img,int(0,MPI_OFFSET_KIND)) call mpi_barrier(MPI_COMM_WORLD) if (irank.eq.0) then nl=new_line('x') write(str,'(''P6'',a,i5,i5,a,''255'',a)')nl,res,res,nl,nl hdr=len(trim(str)) call mpi_file_write(mpi_img,str,hdr,MPI_BYTE,stat) endif call mpi_bcast(hdr,1,MPI_INTEGER,0,MPI_COMM_WORLD) call mpi_type_vector(1,3,3,MPI_CHARACTER,tmp_type) call mpi_type_create_resized(tmp_type,0_MPI_ADDRESS_KIND, & int(3*nproc,MPI_ADDRESS_KIND),row_type) call mpi_type_commit(row_type) disp=hdr+irank*3 write(*,*)'rank',irank,'disp',disp call MPI_File_set_view(mpi_img,disp,MPI_CHARACTER,row_type, & "native",MPI_INFO_NULL) allocate(line(0:3*res-1)) pallette(:,0)=0 do i=1,256 pallette(1,i)=256-i pallette(2,i)=256-i pallette(3,i)=i enddo do i=1,256 pallette(1,256+i)=i pallette(2,256+i)=0 pallette(3,256+i)=256-i enddo do i=0,res-1 y=-1.5d0+i*3d0/(res-1) do j=0,(res-1)/nproc x=-2d0+(irank+j*nproc)*3d0/(res-1) set(:)=pallette(:,mand(cmplx(x,y,kind(1d0)),1024)) line(3*j)=char(set(1)) line(3*j+1)=char(set(2)) line(3*j+2)=char(set(3)) enddo call mpi_file_write(mpi_img,line,3*res/nproc,MPI_CHARACTER,stat) enddo call mpi_file_close(mpi_img) call mpi_finalize() end