Files
piscal/dataassim/math/numrec/f77_sources/quadct.for
T
2016-02-03 18:52:05 +00:00

32 lines
612 B
Fortran

SUBROUTINE quadct(x,y,xx,yy,nn,fa,fb,fc,fd)
INTEGER nn
REAL fa,fb,fc,fd,x,y,xx(nn),yy(nn)
INTEGER k,na,nb,nc,nd
REAL ff
na=0
nb=0
nc=0
nd=0
do 11 k=1,nn
if(yy(k).gt.y)then
if(xx(k).gt.x)then
na=na+1
else
nb=nb+1
endif
else
if(xx(k).gt.x)then
nd=nd+1
else
nc=nc+1
endif
endif
11 continue
ff=1.0/nn
fa=ff*na
fb=ff*nb
fc=ff*nc
fd=ff*nd
return
END