w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2024-11-01 08:07:10 -04:00
Code Issues Packages Projects Releases Wiki Activity
d9d5ccf4cd
WSJT-X/lib/syncmsk.f90

316 lines
8.4 KiB
Fortran
Raw Normal View History

Reintegrate merge from wsjtx_exp branch. git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6122 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2015-11-17 20:28:12 -05:00
subroutine syncmsk(cdat,npts,jpk,ipk,idf,rmax,snr,metric,decoded)
! Attempt synchronization, and if successful decode using Viterbi algorithm.
use iso_c_binding, only: c_loc,c_size_t
use packjt
use hashing
Make Fortran profiling timer function a callback with a default null implementation Groundwork for calling the decoders directly from C/C++ threads. To access the timer module timer_module must now be used. Instrumented code need only use the module function 'timer' which is now a procedure pointer that is guaranteed to be associated (unless null() is assigned to it, which should not be done). The default behaviour of 'timer' is to do nothing. If a Fortran program wishes to profile code it should now use the timer_impl module which contains a default timer implementation. The main program should call 'init_timer([filename])' before using 'timer' or calling routines that are instrumented. If 'init_timer([filename])'. If it is called then an optional file name may be provided with 'timer.out' being used as a default. The procedure 'fini_timer()' may be called to close the file. The default timer implementation is thread safe if used with OpenMP multi-threaded code so long as the OpenMP thread team is given the copyin(/timer_private/) attribute for correct operation. The common block /timer_private/ should be included for OpenMP use by including the file 'timer_common.inc'. The module 'lib/timer_C_wrapper.f90' provides a Fortran wrapper along with 'init' and 'fini' subroutines which allow a C/C++ application to call timer instrumented Fortran code and for it to receive callbacks of 'timer()' subroutine invocations. No C/C++ timer implementation is provided at this stage. git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6320 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2015-12-27 10:40:57 -05:00
use timer_module, only: timer
Reintegrate merge from wsjtx_exp branch. git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6122 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2015-11-17 20:28:12 -05:00
parameter (NSPM=1404,NSAVE=2000)
complex cdat(npts) !Analytic signal
complex cb(66) !Complex waveform for Barker-11 code
complex cd(0:11,0:3)
complex c(0:NSPM-1) !Complex data for one message length
complex c2(0:NSPM-1)
complex cb3(1:NSPM,3)
real r(12000)
real rdat(12000)
real ss1(12000)
real symbol(234)
real rdata(198)
real rd2(198)
real rsave(NSAVE)
real xp(29)
complex z,z0,z1,z2,z3,cfac
integer*1 e1(198)
integer*1, target :: d8(13)
integer*1 i1hash(4)
integer*1 i1
integer*4 i4Msg6BitWords(12) !72-bit message as 6-bit words
integer mettab(0:255,0:1) !Metric table for BPSK modulation
integer ipksave(NSAVE)
integer jpksave(NSAVE)
integer indx(NSAVE)
integer b11(11) !Barker-11 code
character*22 decoded
character*72 c72
logical first
equivalence (i1,i4)
equivalence (ihash,i1hash)
data xp/0.500000, 0.401241, 0.309897, 0.231832, 0.168095, &
0.119704, 0.083523, 0.057387, 0.039215, 0.026890, &
0.018084, 0.012184, 0.008196, 0.005475, 0.003808, &
0.002481, 0.001710, 0.001052, 0.000789, 0.000469, &
0.000329, 0.000225, 0.000187, 0.000086, 0.000063, &
0.000017, 0.000091, 0.000032, 0.000045/
data first/.true./
data b11/1,1,1,0,0,0,1,0,0,1,0/
save first,cb,cd,twopi,dt,f0,f1,mettab
phi=0.
if(first) then
! Get the metric table
bias=0.0
scale=20.0
xln2=log(2.0)
do i=128,156
x0=log(max(0.0001,2.0*xp(i-127)))/xln2
x1=log(max(0.001,2.0*(1.0-xp(i-127))))/xln2
mettab(i,0)=nint(scale*(x0-bias))
mettab(i,1)=nint(scale*(x1-bias))
mettab(256-i,0)=mettab(i,1)
mettab(256-i,1)=mettab(i,0)
enddo
do i=157,255
mettab(i,0)=mettab(156,0)
mettab(i,1)=mettab(156,1)
mettab(256-i,0)=mettab(i,1)
mettab(256-i,1)=mettab(i,0)
enddo
j=0
twopi=8.0*atan(1.0)
dt=1.0/12000.0
f0=1000.0
f1=2000.0
Squash some compiler warnings git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6145 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2015-11-21 15:23:39 -05:00
dphi=0 !quel compiler gripe
Reintegrate merge from wsjtx_exp branch. git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6122 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2015-11-17 20:28:12 -05:00
do i=1,11
if(b11(i).eq.0) dphi=twopi*f0*dt
if(b11(i).eq.1) dphi=twopi*f1*dt
do n=1,6
j=j+1
phi=phi+dphi
cb(j)=cmplx(cos(phi),sin(phi))
enddo
enddo
cb3=0.
cb3(1:66,1)=cb
cb3(283:348,1)=cb
cb3(769:834,1)=cb
cb3(1:66,2)=cb
cb3(487:552,2)=cb
cb3(1123:1188,2)=cb
cb3(1:66,3)=cb
cb3(637:702,3)=cb
cb3(919:984,3)=cb
phi=0.
do n=0,3
k=-1
dphi=twopi*f0*dt
if(n.ge.2) dphi=twopi*f1*dt
do i=0,5
k=k+1
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
cd(k,n)=cmplx(cos(phi),sin(phi))
enddo
dphi=twopi*f0*dt
if(mod(n,2).eq.1) dphi=twopi*f1*dt
do i=6,11
k=k+1
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
cd(k,n)=cmplx(cos(phi),sin(phi))
enddo
enddo
first=.false.
endif
nfft=NSPM
jz=npts-nfft
decoded=" "
ipk=0
jpk=0
metric=-9999
r=0.
call timer('sync1 ',0)
do j=1,jz !Find the Barker-11 sync vectors
z=0.
ss=0.
do i=1,66
ss=ss + real(cdat(j+i-1))**2 + aimag(cdat(j+i-1))**2
z=z + cdat(j+i-1)*conjg(cb(i)) !Signal matching Barker 11
enddo
ss=sqrt(ss/66.0)*66.0
r(j)=abs(z)/(0.908*ss) !Goodness-of-fit to Barker 11
ss1(j)=ss
enddo
call timer('sync1 ',1)
call timer('sync2 ',0)
jz=npts-nfft
rmax=0.
! n1=35, n2=69, n3=94
k=0
do j=1,jz !Find best full-message sync
if(ss1(j).lt.85.0) cycle
r1=r(j) + r(j+282) + r(j+768) ! 6*(12+n1) 6*(24+n1+n2)
r2=r(j) + r(j+486) + r(j+1122) ! 6*(12+n2) 6*(24+n2+n3)
r3=r(j) + r(j+636) + r(j+918) ! 6*(12+n3) 6*(24+n3+n1)
if(r1.gt.rmax) then
rmax=r1
jpk=j
ipk=1
endif
if(r2.gt.rmax) then
rmax=r2
jpk=j
ipk=2
endif
if(r3.gt.rmax) then
rmax=r3
jpk=j
ipk=3
endif
rrmax=max(r1,r2,r3)
if(rrmax.gt.1.9) then
k=min(k+1,NSAVE)
if(r1.eq.rrmax) ipksave(k)=1
if(r2.eq.rrmax) ipksave(k)=2
if(r3.eq.rrmax) ipksave(k)=3
jpksave(k)=j
rsave(k)=rrmax
endif
enddo
call timer('sync2 ',1)
kmax=k
call timer('indexx ',0)
call indexx(rsave,kmax,indx)
call timer('indexx ',1)
call timer('sync3 ',0)
do kk=1,kmax
k=indx(kmax+1-kk)
ipk=ipksave(k)
jpk=jpksave(k)
rmax=rsave(k)
c=conjg(cb3(1:NSPM,ipk))*cdat(jpk:jpk+nfft-1)
smax=0.
dfx=0.
idfbest=0
call timer('idf ',0)
do itry=1,25
idf=itry/2
if(mod(itry,2).eq.0) idf=-idf
idf=4*idf
twk=idf
call tweak1(c,NSPM,-twk,c2)
z=sum(c2)
if(abs(z).gt.smax) then
dfx=twk
smax=abs(z)
phi=atan2(aimag(z),real(z)) !Carrier phase offset
idfbest=idf
endif
enddo
idf=idfbest
call tweak1(cdat,npts,-dfx,cdat)
cfac=cmplx(cos(phi),-sin(phi))
cdat=cfac*cdat
call timer('idf ',1)
call timer('softsym ',0)
sig=0.
ref=0.
rdat(1:npts)=cdat
iz=11
do k=1,234 !Compute soft symbols
j=jpk+6*(k-1)
z0=2.0*dot_product(cdat(j:j+iz),cd(0:iz,0))
z1=2.0*dot_product(cdat(j:j+iz),cd(0:iz,1))
z2=2.0*dot_product(cdat(j:j+iz),cd(0:iz,2))
z3=2.0*dot_product(cdat(j:j+iz),cd(0:iz,3))
!### Maybe these should be weighted by yellow() ?
if(j+1404+iz.lt.npts) then
z0=z0 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,0))
z1=z1 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,1))
z2=z2 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,2))
z3=z3 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,3))
endif
if(j-1404.ge.1) then
z0=z0 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,0))
z1=z1 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,1))
z2=z2 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,2))
z3=z3 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,3))
endif
sym=max(abs(real(z2)),abs(real(z3))) - max(abs(real(z0)),abs(real(z1)))
if(sym.lt.0.0) then
phi=atan2(aimag(z0),real(z0))
sig=sig + real(z0)**2
ref=ref + aimag(z0)**2
else
phi=atan2(aimag(z1),real(z1))
sig=sig + real(z1)**2
ref=ref + aimag(z1)**2
endif
n=k
if(ipk.eq.2) n=k+47
if(ipk.eq.3) n=k+128
if(n.gt.234) n=n-234
ibit=0
if(sym.ge.0) ibit=1
symbol(n)=sym
enddo
snr=db(sig/ref-1.0)
call timer('softsym ',1)
rdata(1:35)=symbol(12:46)
rdata(36:104)=symbol(59:127)
rdata(105:198)=symbol(140:233)
! Re-order the symbols and make them i*1
j=0
do i=1,99
i4=128+rdata(i) !### Should be nint() ??? ###
if(i4.gt.255) i4=255
if(i4.lt.0) i4=0
j=j+1
e1(j)=i1
rd2(j)=rdata(i)
i4=128+rdata(i+99)
if(i4.gt.255) i4=255
if(i4.lt.0) i4=0
j=j+1
e1(j)=i1
rd2(j)=rdata(i+99)
enddo
! call system_clock(count0,clkfreq)
! tsoft=tsoft + (count0-count1)/float(clkfreq)
! Decode the message
nb1=87
call timer('vit213 ',0)
call vit213(e1,nb1,mettab,d8,metric)
call timer('vit213 ',1)
! call system_clock(count1,clkfreq)
! tvit=tvit + (count1-count0)/float(clkfreq)
ihash=nhash(c_loc(d8),int(9,c_size_t),146)
ihash=2*iand(ihash,32767)
decoded=' '
if(d8(10).eq.i1hash(2) .and. d8(11).eq.i1hash(1)) then
write(c72,1012) d8(1:9)
1012 format(9b8.8)
read(c72,1014) i4Msg6BitWords
1014 format(12b6.6)
call unpackmsg(i4Msg6BitWords,decoded) !Unpack to get msgsent
endif
if(decoded.ne.' ') exit
enddo
call timer('sync3 ',1)
return
end subroutine syncmsk
Reference in New Issue Copy Permalink