- 积分
- 5605
- 贡献
-
- 精华
- 在线时间
- 小时
- 注册时间
- 2016-10-7
- 最后登录
- 1970-1-1
|
楼主 |
发表于 2018-12-11 12:05:02
|
显示全部楼层
! THIS IS A PROGRAM FOR DETECTING ABRUPT CLIMATIC CHANGE
! BY USING MANN-KENDALL TECHNIQUE
PROGRAM MK
DIMENSION Y(1000,1000),YY(1000,1000),U(1000,1000),UF(1000),UB(1000),&
& M(1000,1000),MD(1000,1000)
WRITE(*,10)
10 FORMAT(2X,'N=37,n=70,NYEAR=1980')
READ(*,*)N,NYEAR
! ***************************************************
! * N: SAMPLE SIZE *
! * NYEAR: FIRST YEAR OF THE TIME SERIES *
! * Y(N): ORIGINAL TIME SERIES *
! * UF(N): ORIGINAL SERIES OF U(LN) *
! * UB(N): COUNTER SERIES OF U(LN) *
! * A,B: CRITICAL VALUE 1.96 AND -1.96 *
! *************************************************** V/data/37/v37-mam.txt')
OPEN(2,FILE='E:/1/mk/data/37-70/ts70-37-son.txt')
READ(2,*)((Y(j,i),j=1,n),I=1,N)
write(*,*)((Y(j,i),j=1,n),I=1,N)
!stop
CALL SMK(Y,M,MD,UF,N)
do 20 j=1,n
DO 20 I=1,N
20 YY(j,I)=Y(j,N+1-I)
CALL SMK(YY,M,MD,U,N)
do 30 j=1,n
DO 30 I=1,N
30 UB(I)=-U(j,N+1-I)
OPEN(3,FILE='E:/1/mk/data/37-70/ts70-37-son-mk.txt')
A=1.96
B=-1.96
do 40 j=1,n
DO 40 I=1,N
WRITE(3,50)NYEAR+I-1,UF(I),UB(I),A,B
50 FORMAT(1X,I4,4F8.2)
40 CONTINUE
CLOSE(3)
STOP
END
!***********************************************************
SUBROUTINE SMK(Y,M,MD,U,N)
DIMENSION Y(N),M(N),MD(N),U(N)
M(1)=0
DO 10 I=2,N
M(I)=0
MD(I)=0
DO 20 J=1,I-1
IF(Y(I).GT.Y(J))then
M(I)=M(I)+1
end if
20 CONTINUE
MD(I)=MD(I-1)+M(I)
10 CONTINUE
U(1)=0.0
DO 30 I=2,N
E=I*(I-1)/4.00
VAR=I*(I-1)*(2*I+5)/72.00
U(I)=(MD(I)-E)/SQRT(VAR)
30 CONTINUE
RETURN
END
这是自己尝试的程序 |
|