| 
 
	积分996贡献 精华在线时间 小时注册时间2014-11-19最后登录1970-1-1 
 | 
 
 
 楼主|
发表于 2016-7-18 10:02:45
|
显示全部楼层 
| 这是我的代码,应该看读取文件和写入文件两句就可以了,其他没提示错误
 
 implicit none
 integer,parameter               :: nx=50,ny=30,nz=1,nt=20,m1=4,m2=8,l=7
 real,parameter                  :: pi=3.1415926
 real,dimension(:,:),allocatable :: yy,ui
 real,dimension(:),allocatable   :: y,x
 integer                         :: mm,it,ix,iy,iz,irec,ll,i
 real                            :: s
 mm=nx*ny*nz
 ll=2*l+1
 allocate(yy(nt,mm))
 open(100,file='D:\bb\500hgt\500.grd',form='unformatted',access='direct',recl=nx*ny)
 irec=1
 do it=1,nt
 do iz=1,nz
 read(100,rec=irec)((yy(it,ix+(iy-1)*nx+(iz-1)*nx*ny),ix=1,nx),iy=1,ny)
 irec=irec+1
 end do
 end do
 close(100)
 do i=1,mm
 s=0.0
 do it=1,nt
 s=s+yy(it,i)
 end do
 s=s/real(nt)
 do it=1,nt
 yy(it,i)=yy(it,i)-s
 end do
 s=0.0
 do it=1,nt
 s=s+yy(it,i)*yy(it,i)
 end do
 s=sqrt(s/real(nt))
 do it=1,nt
 yy(it,i)=yy(it,i)/s
 end do
 end do
 do i=1,mm
 allocate(y(nt))
 do it=1,nt
 y(it)=yy(it,i)
 end do
 allocate(x(nt))
 call filter(y,nt,m1,m2,x,pi)
 deallocate(y)
 do it=1,nt
 yy(it,i)=x(it)
 end do
 deallocate(x)
 end do
 allocate(ui(nt,mm))
 call hilbert(yy,ui,mm,nt,l,ll,pi)
 do it=1,nt
 do i=1,mm
 s=yy(it,i)**2+ui(it,i)**2
 yy(it,i)=sqrt(s)
 enddo
 enddo
 deallocate(ui)
 open(400,file='D:\bb\500hgt\bobao.dat',form='unformatted',access='direct',recl=nx*ny)
 irec=1
 do it=1,nt
 do iz=1,nz
 write(400,rec=irec)((yy(it,ix+(iy-1)*nx+(iz-1)*nx*ny),ix=1,nx),iy=1,ny)
 irec=irec+1
 enddo
 enddo
 close(400)
 deallocate(yy)
 end
 subroutine filter(x,n,mw1,mw2,bx,pi)
 real,dimension(n)::x,bx,cx,xy
 w1=2.*pi/real(mw1)
 w2=2.*pi/real(mw2)
 w0=sqrt(w1*w2)
 dt=1.0
 ww=2*abs(sin(w1*dt)/(1+cos(w1*dt))-sin(w2*dt)/(1+cos(w2*dt)))
 ww0=4*sin(w1*dt)*sin(w2*dt)/((1+cos(w1*dt))*(1+cos(w2*dt)))
 a0=2*ww/(4+2*ww+ww0)
 b1=2*(ww0-4)/(4+2*ww+ww0)
 b2=(4-2*ww+ww0)/(4+2*ww+ww0)
 do 89 i0=1,n-2
 i=i0+2
 bx(1)=0.0
 bx(2)=0.0
 cx(i)=a0*(x(i)-x(i-2))-b1*bx(i-1)-b2*bx(i-2)
 89  bx(i)=cx(i)
 do 91 i=1,n
 91  x(i)=bx(n+1-i)
 do 92 i0=1,n-2
 i=i0+2
 xy(1)=x(1)
 xy(2)=x(2)
 cx(i)=a0*(x(i)-x(i-2))-b1*xy(i-1)-b2*xy(i-2)
 92  xy(i)=cx(i)
 do 93 i=1,n
 93  bx(i)=xy(n+1-i)
 return
 end
 subroutine hilbert(ur,ui,mm,nt,l,ll,pi)
 implicit none
 real::pi,ss,x
 integer::nt,mm,l,ll
 real::h(ll),ur(nt,mm),ui(nt,mm)
 integer::i,j,j1,j2,j3,jj
 do j=1,nt
 do i=1,mm
 ui(j,i)=0.0
 enddo
 enddo
 h(l+1)=0.0
 do i=1,l
 ss=sin(pi*real(i)/2.0)**2
 h(l+1+i)=ss*2.0/(real(i)*pi)
 h(l+1-i)=-h(l+1+i)
 enddo
 j1=l+1
 j3=nt-l
 do i=1,mm
 do j=j1,j3
 x=0.0
 do jj=1,ll
 j2=j-jj+l+1
 x=x+ur(j2,i)*h(jj)
 enddo
 ui(j,i)=x
 enddo
 enddo
 return
 end
 
 | 
 |