2020-07-23 10:58:10 -04:00
|
|
|
subroutine blanker(iwave,nz,ndropmax,npct,c_bigfft)
|
2020-07-14 11:27:41 -04:00
|
|
|
|
|
|
|
|
integer*2 iwave(nz)
|
2020-07-23 10:58:10 -04:00
|
|
|
complex c_bigfft(0:nz/2)
|
2020-07-14 11:27:41 -04:00
|
|
|
integer hist(0:32768)
|
|
|
|
|
real fblank !Fraction of points to be blanked
|
|
|
|
|
|
2020-07-23 10:58:10 -04:00
|
|
|
fblank=0.01*npct
|
2020-07-14 11:27:41 -04:00
|
|
|
hist=0
|
|
|
|
|
do i=1,nz
|
2020-09-12 09:00:39 -04:00
|
|
|
! ### NB: if iwave(i)=-32768, abs(iwave(i))=-32768 ###
|
|
|
|
|
if(iwave(i).eq.-32768) iwave(i)=-32767
|
2020-07-14 11:27:41 -04:00
|
|
|
n=abs(iwave(i))
|
|
|
|
|
hist(n)=hist(n)+1
|
|
|
|
|
enddo
|
|
|
|
|
n=0
|
|
|
|
|
do i=32768,0,-1
|
|
|
|
|
n=n+hist(i)
|
|
|
|
|
if(n.ge.nint(nz*fblank/ndropmax)) exit
|
|
|
|
|
enddo
|
2020-07-23 10:58:10 -04:00
|
|
|
nthresh=i
|
2020-07-14 11:27:41 -04:00
|
|
|
ndrop=0
|
|
|
|
|
ndropped=0
|
2020-07-23 10:58:10 -04:00
|
|
|
|
|
|
|
|
xx=0.
|
2020-07-14 11:27:41 -04:00
|
|
|
do i=1,nz
|
|
|
|
|
i0=iwave(i)
|
|
|
|
|
if(ndrop.gt.0) then
|
2020-07-23 10:58:10 -04:00
|
|
|
i0=0
|
2020-07-14 11:27:41 -04:00
|
|
|
ndropped=ndropped+1
|
|
|
|
|
ndrop=ndrop-1
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
! Start to apply blanking
|
2020-07-23 10:58:10 -04:00
|
|
|
if(abs(i0).gt.nthresh) then
|
|
|
|
|
i0=0
|
2020-07-14 11:27:41 -04:00
|
|
|
ndropped=ndropped+1
|
|
|
|
|
ndrop=ndropmax
|
|
|
|
|
endif
|
2020-07-23 10:58:10 -04:00
|
|
|
|
|
|
|
|
! Now copy the data into c_bigfft
|
|
|
|
|
if(iand(i,1).eq.1) then
|
|
|
|
|
xx=i0
|
|
|
|
|
else
|
|
|
|
|
yy=i0
|
|
|
|
|
j=i/2 - 1
|
|
|
|
|
c_bigfft(j)=cmplx(xx,yy)
|
|
|
|
|
endif
|
2020-07-14 11:27:41 -04:00
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
fblanked=fblanked + 0.1*(float(ndropped)/nz - fblanked)
|
2020-07-23 10:58:10 -04:00
|
|
|
fblanked=float(ndropped)/nz
|
|
|
|
|
! write(*,3001) npct,nthresh,fblanked
|
|
|
|
|
!3001 format(2i5,f7.3)
|
2020-07-14 11:27:41 -04:00
|
|
|
|
|
|
|
|
return
|
|
|
|
|
end subroutine blanker
|
