mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-09-08 22:36:40 -04:00
143 lines
3.1 KiB
Fortran
143 lines
3.1 KiB
Fortran
|
subroutine spec9(c0,npts8,nsps,f0a,lagpk,fpk)
|
||
|
|
|
||
|
|
parameter (MAXFFT=31500)
|
||
|
|
complex c0(0:npts8-1)
|
||
|
|
real s(0:MAXFFT-1)
|
||
|
|
real ssym(0:9,184)
|
||
|
|
complex c(0:MAXFFT-1)
|
||
|
|
integer*1 softbit(207)
|
||
|
|
integer ibit(207)
|
||
|
|
|
||
|
|
integer*1 t1(13) !72 bits and zero tail as 8-bit bytes
|
||
|
|
integer*4 t4(69) !Symbols from t5, values 0-7
|
||
|
|
integer*4 mettab(0:255,0:1)
|
||
|
|
integer*1 tmp(72)
|
||
|
|
character*22 msg
|
||
|
|
|
||
|
|
integer isync(85)
|
||
|
|
integer ii(16) !Locations of sync symbols
|
||
|
|
data ii/1,6,11,16,21,26,31,39,45,51,57,63,69,75,81,85/
|
||
|
|
|
||
|
|
isync=0
|
||
|
|
do i=1,16
|
||
|
|
isync(ii(i))=1
|
||
|
|
enddo
|
||
|
|
|
||
|
|
idt=-400
|
||
|
|
idf=0.
|
||
|
|
fshift=fpk-f0a + 0.1*idf
|
||
|
|
twopi=8.0*atan(1.0)
|
||
|
|
dphi=twopi*fshift/1500.0
|
||
|
|
nsps8=nsps/8
|
||
|
|
nfft=nsps8
|
||
|
|
df=1500.0/nfft
|
||
|
|
s=0.
|
||
|
|
istart=lagpk*nsps8 + idt
|
||
|
|
nsym=min((npts8-istart)/nsps8,85)
|
||
|
|
print*,f0a,lagpk,fpk,fshift,nsym
|
||
|
|
|
||
|
|
do j=0,nsym-1
|
||
|
|
ia=j*nsps8 + istart
|
||
|
|
ib=ia+nsps8-1
|
||
|
|
c(0:nfft-1)=c0(ia:ib)
|
||
|
|
|
||
|
|
phi=0.
|
||
|
|
do i=0,nfft-1
|
||
|
|
phi=phi + dphi
|
||
|
|
c(i)=c(i) * cmplx(cos(phi),-sin(phi))
|
||
|
|
enddo
|
||
|
|
|
||
|
|
call four2a(c,nfft,1,-1,1)
|
||
|
|
do i=0,nfft-1
|
||
|
|
sx=real(c(i))**2 + aimag(c(i))**2
|
||
|
|
if(i.le.8) ssym(i,1+j)=sx
|
||
|
|
s(i)=s(i) + sx
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
|
||
|
|
! sync=0.
|
||
|
|
! do i=1,16
|
||
|
|
! sync=sync + ssym(0,ii(i))
|
||
|
|
! enddo
|
||
|
|
|
||
|
|
do i=0,nfft-1
|
||
|
|
freq = f0a + i*df
|
||
|
|
write(71,3001) i,i*df,freq,s(i)
|
||
|
|
3001 format(i8,3f12.3)
|
||
|
|
enddo
|
||
|
|
|
||
|
|
do j=1,nsym
|
||
|
|
write(72,3002) j,(ssym(i,j),i=0,8)
|
||
|
|
3002 format(i3,9f7.2)
|
||
|
|
enddo
|
||
|
|
|
||
|
|
m0=3
|
||
|
|
ntones=8
|
||
|
|
k=0
|
||
|
|
do j=1,nsym
|
||
|
|
! print*,j,k,nsym
|
||
|
|
if(isync(j).eq.1) cycle
|
||
|
|
do m=m0-1,0,-1 !Get bit-wise soft symbols
|
||
|
|
n=2**m
|
||
|
|
r1=0.
|
||
|
|
r2=0.
|
||
|
|
do ig=0,ntones-1
|
||
|
|
! i=igray(ig,-1)
|
||
|
|
i=ig
|
||
|
|
if(iand(i,n).ne.0) then
|
||
|
|
r1=max(r1,ssym(i+1,j))
|
||
|
|
else
|
||
|
|
r2=max(r2,ssym(i+1,j))
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
k=k+1
|
||
|
|
softbit(k)=min(127,max(-127,nint(10.0*(r1-r2)))) + 128
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
|
||
|
|
ibit=0
|
||
|
|
do i=1,207
|
||
|
|
if(softbit(i).lt.0) ibit(i)=1
|
||
|
|
enddo
|
||
|
|
print*,ibit
|
||
|
|
|
||
|
|
! Get the metric table
|
||
|
|
bias=0.37 !To be optimized, in decoder program
|
||
|
|
scale=10 ! ... ditto ...
|
||
|
|
open(19,file='met8.21',status='old')
|
||
|
|
|
||
|
|
do i=0,255
|
||
|
|
read(19,*) x00,x0,x1
|
||
|
|
mettab(i,0)=nint(scale*(x0-bias))
|
||
|
|
mettab(i,1)=nint(scale*(x1-bias)) !### Check range, etc. ###
|
||
|
|
enddo
|
||
|
|
close(19)
|
||
|
|
nbits=72
|
||
|
|
ndelta=17
|
||
|
|
limit=1000
|
||
|
|
|
||
|
|
print*,softbit
|
||
|
|
call fano232(softbit,nbits+31,mettab,ndelta,limit,t1,ncycles,metric,ierr, &
|
||
|
|
maxmetric,maxnp)
|
||
|
|
print*,ncycles
|
||
|
|
|
||
|
|
nbytes=(nbits+7)/8
|
||
|
|
do i=1,nbytes
|
||
|
|
n=t1(i)
|
||
|
|
t4(i)=iand(n,255)
|
||
|
|
enddo
|
||
|
|
call unpackbits(t4,nbytes,8,tmp)
|
||
|
|
call packbits(tmp,12,6,t4)
|
||
|
|
do i=1,12
|
||
|
|
if(t4(i).lt.128) t1(i)=t4(i)
|
||
|
|
if(t4(i).ge.128) t1(i)=t4(i)-256
|
||
|
|
enddo
|
||
|
|
do i=1,12
|
||
|
|
t4(i)=t1(i)
|
||
|
|
enddo
|
||
|
|
call unpackmsg(t4,msg) !Unpack decoded msg
|
||
|
|
print*,msg
|
||
|
|
|
||
|
|
return
|
||
|
|
end subroutine spec9
|