37 lines
1.0 KiB
Fortran
37 lines
1.0 KiB
Fortran
SUBROUTINE spear(data1,data2,n,wksp1,wksp2,d,zd,probd,rs,probrs)
|
|
INTEGER n
|
|
REAL d,probd,probrs,rs,zd,data1(n),data2(n),wksp1(n),wksp2(n)
|
|
CU USES betai,crank,erfcc,sort2
|
|
INTEGER j
|
|
REAL aved,df,en,en3n,fac,sf,sg,t,vard,betai,erfcc
|
|
do 11 j=1,n
|
|
wksp1(j)=data1(j)
|
|
wksp2(j)=data2(j)
|
|
11 continue
|
|
call sort2(n,wksp1,wksp2)
|
|
call crank(n,wksp1,sf)
|
|
call sort2(n,wksp2,wksp1)
|
|
call crank(n,wksp2,sg)
|
|
d=0.
|
|
do 12 j=1,n
|
|
d=d+(wksp1(j)-wksp2(j))**2
|
|
12 continue
|
|
en=n
|
|
en3n=en**3-en
|
|
aved=en3n/6.-(sf+sg)/12.
|
|
fac=(1.-sf/en3n)*(1.-sg/en3n)
|
|
vard=((en-1.)*en**2*(en+1.)**2/36.)*fac
|
|
zd=(d-aved)/sqrt(vard)
|
|
probd=erfcc(abs(zd)/1.4142136)
|
|
rs=(1.-(6./en3n)*(d+(sf+sg)/12.))/sqrt(fac)
|
|
fac=(1.+rs)*(1.-rs)
|
|
if(fac.gt.0.)then
|
|
t=rs*sqrt((en-2.)/fac)
|
|
df=en-2.
|
|
probrs=betai(0.5*df,0.5,df/(df+t**2))
|
|
else
|
|
probrs=0.
|
|
endif
|
|
return
|
|
END
|