登录后查看更多精彩内容~
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
!---------子程序:计算相关系数-----
subroutine xiangguan(a,b,r,sa,sb,avea,aveb)
parameter (nx=180,ny=89,m=54,undef=32767)
real a(nx,ny,m),b(m),sa(nx,ny),sb,sab(nx,ny),r(nx,ny),avea(nx,ny),aveb,t(nx,ny)
do k=1,m
do j=1,ny
do i=1,nx
if(a(i,j,k)/=undef)then
avea(i,j)=avea(i,j)+a(i,j,k)/m
else
avea(i,j)=undef
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,k)/=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
else
sa(i,j)=undef
sab(i,j)=undef
endif
enddo
enddo
sb=sb+(b(k)-aveb)**2/m
enddo
do j=1,ny
do i=1,nx
if(sa(i,j)/=undef)then
r(i,j)=sab(i,j)/(sqrt(sa(i,j))*sqrt(sb))
else
r(i,j)=undef
endif
if((abs(r(i,j))>=1).and.(r(i,j)/=undef))then
write(*,*)r(i,j),i,j,sa(i,j),sb,sab(i,j)
endif
enddo
enddo
end
|