slice.f90

基于linux操作下的fortran快速付立变换的程序

	subroutine slice(nproc,iproc,m1,m2,m3,n1,n2,n3,md1,md2,md3,nd1,nd2,nd3,zf,zr)
! Write sliced Fourrier and Real space arrays for plotting purposes
	implicit real*8 (a-h,o-z)
        include 'mpif.h'
	dimension zf(2,md1,md3,md2/nproc),zr(2,nd1,nd2,nd3/nproc)

        REAL(KIND=8), ALLOCATABLE, DIMENSION(:,:,:,:) :: zrall
        REAL(KIND=8), ALLOCATABLE, DIMENSION(:,:,:,:) :: zfall

	allocate(zrall(2,nd1,nd2,nd3),zfall(2,md1,md3,md2))

	if (nproc.gt.1) then
        call MPI_GATHER(zr,2*nd1*nd2*nd3/nproc,MPI_double_precision, &
                     zrall,2*nd1*nd2*nd3/nproc,MPI_double_precision, &
                        0,MPI_COMM_WORLD,ierr)
        call MPI_GATHER(zf,2*md1*md2*md3/nproc,MPI_double_precision, & 
                     zfall,2*md1*md2*md3/nproc,MPI_double_precision, & 
                        0,MPI_COMM_WORLD,ierr)
	else
	call  dcopy(2*nd1*nd2*nd3,zr,1,zrall,1)
	call  dcopy(2*md1*md2*md3,zf,1,zfall,1)
	endif

	if (iproc.eq.0) then

! input zr:
	i3=1
	do i2=1,n2
	do i1=1,n1
	tt=-(-1)**(i1+i2+i3)
        write(120,'(2(i4),2(x,e12.5))') i1,i2,tt*zrall(1,i1,i2,i3), & 
                                              tt*zrall(2,i1,i2,i3)
	enddo
	write(120,*) '          '
	enddo

	i2=1
	do i3=1,n3
	do i1=1,n1
	tt=-(-1)**(i1+i2+i3)
        write(130,'(2(i4),2(x,e12.5))') i1,i3,tt*zrall(1,i1,i2,i3), &
                                              tt*zrall(2,i1,i2,i3)
	enddo
	write(130,*) '          '
	enddo

	i1=1
	do i3=1,n3
	do i2=1,n2
	tt=-(-1)**(i1+i2+i3)
        write(230,'(2(i4),2(x,e12.5))') i2,i3,tt*zrall(1,i1,i2,i3), & 
                                              tt*zrall(2,i1,i2,i3)
	enddo
	write(230,*) '          '
	enddo

! output zf:
	i3=m3/2+1
	do i2=1,m2
	do i1=1,m1
        write(12,'(2(i4),2(x,e12.5))')  &
                i1,i2,zfall(1,i1,i3,i2),zfall(2,i1,i3,i2)
	enddo
	write(12,*) '          '
	enddo

	i2=m2/2+1
	do i3=1,m3
	do i1=1,m1
        write(13,'(2(i4),2(x,e12.5))')  &
                i1,i3,zfall(1,i1,i3,i2),zfall(2,i1,i3,i2)
	enddo
	write(13,*) '          '
	enddo

	i1=m1/2+1
	do i3=1,m3
	do i2=1,m2
        write(23,'(2(i4),2(x,e12.5))')  &
                i2,i3,zfall(1,i1,i3,i2),zfall(2,i1,i3,i2)
	enddo
	write(23,*) '          '
	enddo

	endif

        deallocate(zrall,zfall)

	return
	end