WSJT-X/lib/ft8/compress.f90
Joe Taylor 70adc049ee Put a DXpedition "5 signal" mode into ft8sim.
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@8234 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2017-11-14 18:14:50 +00:00

56 lines
1.1 KiB
Fortran

subroutine compress(c)
parameter (NMAX=15*12000) !Samples in iwave (180,000)
complex c(0:NMAX-1)
real xr(0:NMAX-1),xi(0:NMAX-1)
xr=real(c)
call wavestats(xr,NMAX,rms,pk,pwr_pk,pwr_ave)
xr=xr/rms
xi=aimag(c)/rms
do i=0,NMAX-1
c(i)=rms*cmplx(h1(xr(i)),h1(xi(i)))
enddo
! par=pwr_pk/pwr_ave
! write(*,1010) 5,rms,pk,pwr_pk,pwr_ave,par
!1010 format(i3,2f10.3,3f10.2)
! call wavestats(xi,NMAX,rms,pk,pwr_pk,pwr_ave)
! par=pwr_pk/pwr_ave
! write(*,1010) 5,rms,pk,pwr_pk,pwr_ave,par
return
end subroutine compress
real function h1(x)
! sigma=1.0/sqrt(2.0)
sigma=1.0
xlim=sigma/sqrt(6.0)
ax=abs(x)
sgnx=1.0
if(x.lt.0) sgnx=-1.0
if(ax.le.xlim) then
h1=x
else
z=exp(1.0/6.0 - (ax/sigma)**2)
h1=sgnx*sqrt(6.0)*sigma*(2.0/3.0 - 0.5*z)
endif
return
end function h1
subroutine wavestats(x,kz,rms,pk,pwr_pk,pwr_ave)
real x(kz)
sumsq=dot_product(x,x)
rms=sqrt(sumsq/kz)
pk=max(maxval(x),-minval(x))
pwr_pk=pk*pk
pwr_ave=sumsq/kz
return
end subroutine wavestats