登录后查看更多精彩内容~
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
parameter (nx=180,ny=89,m=55,undef=32767)
real sst(nx,ny,m),in(m),rxy(nx,ny),sx(nx,ny),sy,avex(nx,ny),avey,b(nx,ny),f(nx,ny)
real a(nx,ny,m),rr(nx,ny),t(nx,ny),sxa(nx,ny),sya,avexa(nx,ny),aveya
! real sst1(nx,ny,n1),in1(n1)
!-----input------
open(1,file='ssts.grd',form='binary')
do k=1,m
read(1)((sst(i,j,k),i=1,nx),j=1,ny)
enddo
open(2,file='index.grd',form='binary')
read(2)(in(i),i=1,m)
!------计算系数和F检验-----
call xiangguan(sst,in,rxy,sx,sy,avex,avey)
do j=1,ny
do i=1,nx
if(sst(i,j,1)/=undef)then
b(i,j)=rxy(i,j)*sqrt(sx(i,j))/sqrt(sy)
f(i,j)=rxy(i,j)**2/(1-rxy(i,j)**2)*(m-2)
else
b(i,j)=undef
f(i,j)=undef
endif
enddo
enddo
do k=1,m
do j=1,ny
do i=1,nx
if(sst(i,j,k)/=undef)then
a(i,j,k)=sst(i,j,k)-b(i,j)*avey
else
a(i,j,k)=undef
endif
enddo
enddo
enddo
open(6,file='d:\paper\160\asummer.txt')
write(6,*)((f(i,j),i=1,nx),j=i,ny)
!call xiangguan(a,in,rr,sxa,sya,avexa,aveya)
!-------------t检验---------------------------
!------output-------------------
open(3,file='d:\paper\160\bsummer.grd',form='binary')
open(4,file='d:\paper\160\fsummer.grd',form='binary')
open(5,file='d:\paper\160\atsummer.grd',form='binary')
!open(6,file='d:\paper\160\asummer.grd',form='binary')
write(3)((b(i,j),i=1,nx),j=1,ny)
write(4)((f(i,j),i=1,nx),j=1,ny)
write(5)((b(i,j),i=1,nx),j=i,ny)
!write(5)((t(i,j),i=1,nx),j=i,ny)本来想写输出a,发现是0kb后来改成b或者f还是0kb好神奇啊~~~~~~~~~~~
!do k=1,m
!write(6)((a(i,j,k),i=1,nx),j=i,ny)
!enddo
end
!---------子程序:计算相关系数-----
subroutine xiangguan(a,b,r,sa,sb,avea,aveb)
parameter (nx=180,ny=89,m=55,undef=32767)
real a(nx,ny,m),b(m),sa(nx,ny),sb,sab(nx,ny),r(nx,ny),avea(nx,ny),aveb
do k=1,m
do j=1,ny
do i=1,nx
if(a(i,j,1)/=undef)then
avea(i,j)=avea(i,j)+a(i,j,k)/m
endif
enddo
enddo
aveb=aveb+b(k)/m
enddo
do k=1,m
do j=1,ny
do i=1,nx
if(a(i,j,1)/=undef)then
sa(i,j)=sa(i,j)+(a(i,j,k)-avea(i,j))**2/m
sab(i,j)=sab(i,j)+(a(i,j,k)-avea(i,j))*(b(k)-aveb)/m
endif
enddo
enddo
sb=sb+(b(k)-aveb)**2/m
enddo
do j=1,ny
do i=1,nx
if(a(i,j,1)/=undef)then
r(i,j)=sab(i,j)/sqrt(sa(i,j))/sqrt(sb)
endif
!if(abs(r(i,j))>=1)then
!write(*,*)r(i,j)
!endif
enddo
enddo
end
|