diff --git a/CMakeLists.txt b/CMakeLists.txt index 505876daf..7b4c2a0b7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -374,7 +374,7 @@ set (wsjt_FSRCS lib/fsk4hf/bpdecode120.f90 lib/fsk4hf/bpdecode168.f90 lib/ft8/bpdecode174.f90 - lib/fsk4hf/bpdecode174_91.f90 + lib/ft8/bpdecode174_91.f90 lib/fsk4hf/bpdecode300.f90 lib/fsk4hf/bpdecode204.f90 lib/baddata.f90 @@ -384,6 +384,7 @@ set (wsjt_FSRCS lib/fsk4hf/chkcrc10.f90 lib/fsk4hf/chkcrc12.f90 lib/ft8/chkcrc12a.f90 + lib/ft8/chkcrc14a.f90 lib/chkcall.f90 lib/chkhist.f90 lib/chkmsg.f90 @@ -411,7 +412,7 @@ set (wsjt_FSRCS lib/fsk4hf/encode120.f90 lib/fsk4hf/encode168.f90 lib/ft8/encode174.f90 - lib/fsk4hf/encode174_91.f90 + lib/ft8/encode174_91.f90 lib/fsk4hf/encode300.f90 lib/fsk4hf/encode204.f90 lib/entail.f90 @@ -421,7 +422,7 @@ set (wsjt_FSRCS lib/extractmessage144.f90 lib/fsk4hf/extractmessage168.f90 lib/ft8/extractmessage174.f90 - lib/fsk4hf/extractmessage174_91.f90 + lib/ft8/extractmessage174_91.f90 lib/fano232.f90 lib/fast9.f90 lib/fast_decode.f90 @@ -452,7 +453,8 @@ set (wsjt_FSRCS lib/freqcal.f90 lib/fsk4hf/fsk4hf.f90 lib/ft8/ft8apset.f90 - lib/ft8/ft8b.f90 + lib/ft8/ft8b_1.f90 + lib/ft8/ft8b_2.f90 lib/ft8/ft8code.f90 lib/ft8/ft8_downsample.f90 lib/ft8/ft8sim.f90 @@ -502,7 +504,7 @@ set (wsjt_FSRCS lib/fsk4hf/ldpcsim120.f90 lib/fsk4hf/ldpcsim168.f90 lib/ft8/ldpcsim174.f90 - lib/fsk4hf/ldpcsim174_91.f90 + lib/ft8/ldpcsim174_91.f90 lib/fsk4hf/ldpcsim300.f90 lib/fsk4hf/ldpcsim204.f90 lib/ldpcsim40.f90 @@ -532,7 +534,7 @@ set (wsjt_FSRCS lib/fsk4hf/msksoftsym.f90 lib/fsk4hf/msksoftsymw.f90 lib/ft8/osd174.f90 - lib/fsk4hf/osd174_91.f90 + lib/ft8/osd174_91.f90 lib/fsk4hf/osd300.f90 lib/fsk4hf/osd204.f90 lib/pctile.f90 @@ -1239,7 +1241,7 @@ target_link_libraries (ldpcsim120 wsjt_fort wsjt_cxx) add_executable (ldpcsim174 lib/ft8/ldpcsim174.f90 wsjtx.rc) target_link_libraries (ldpcsim174 wsjt_fort wsjt_cxx) -add_executable (ldpcsim174_91 lib/fsk4hf/ldpcsim174_91.f90 wsjtx.rc) +add_executable (ldpcsim174_91 lib/ft8/ldpcsim174_91.f90 wsjtx.rc) target_link_libraries (ldpcsim174_91 wsjt_fort wsjt_cxx) add_executable (ldpcsim144 lib/ldpcsim144.f90 wsjtx.rc) diff --git a/lib/ft8/.sync8.f90.swp b/lib/ft8/.sync8.f90.swp new file mode 100644 index 000000000..97d11ad15 Binary files /dev/null and b/lib/ft8/.sync8.f90.swp differ diff --git a/lib/fsk4hf/bpdecode174_91.f90 b/lib/ft8/bpdecode174_91.f90 similarity index 100% rename from lib/fsk4hf/bpdecode174_91.f90 rename to lib/ft8/bpdecode174_91.f90 diff --git a/lib/ft8/chkcrc14a.f90 b/lib/ft8/chkcrc14a.f90 new file mode 100644 index 000000000..d9d3d7a4d --- /dev/null +++ b/lib/ft8/chkcrc14a.f90 @@ -0,0 +1,24 @@ +subroutine chkcrc14a(decoded,nbadcrc) + + use crc + integer*1 decoded(91) + integer*1, target:: i1Dec8BitBytes(12) + character*91 cbits + +! Write decoded bits into cbits: 77-bit message plus 14-bit CRC + write(cbits,1000) decoded +1000 format(91i1) + read(cbits,1001) i1Dec8BitBytes +1001 format(12b8) + read(cbits,1002) ncrc14 !Received CRC14 +1002 format(77x,b14) + + i1Dec8BitBytes(10)=iand(i1Dec8BitBytes(10),128+64+32+16+8) + i1Dec8BitBytes(11:12)=0 + icrc14=crc14(c_loc(i1Dec8BitBytes),12) !CRC14 computed from 77 msg bits + + nbadcrc=1 + if(ncrc14.eq.icrc14) nbadcrc=0 + + return +end subroutine chkcrc14a diff --git a/lib/fsk4hf/encode174_91.f90 b/lib/ft8/encode174_91.f90 similarity index 100% rename from lib/fsk4hf/encode174_91.f90 rename to lib/ft8/encode174_91.f90 diff --git a/lib/fsk4hf/extractmessage174_91.f90 b/lib/ft8/extractmessage174_91.f90 similarity index 100% rename from lib/fsk4hf/extractmessage174_91.f90 rename to lib/ft8/extractmessage174_91.f90 diff --git a/lib/ft8/ft8b.f90 b/lib/ft8/ft8b_1.f90 similarity index 98% rename from lib/ft8/ft8b.f90 rename to lib/ft8/ft8b_1.f90 index 7d3453160..954354bc2 100644 --- a/lib/ft8/ft8b.f90 +++ b/lib/ft8/ft8b_1.f90 @@ -1,4 +1,4 @@ -subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & +subroutine ft8b_1(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & napwid,lsubtract,nagain,iaptype,mycall12,mygrid6,hiscall12,bcontest, & sync0,f1,xdt,xbase,apsym,nharderrors,dmin,nbadcrc,ipass,iera,msg37,xsnr) @@ -89,7 +89,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & i0=nint((xdt+0.5)*fs2) !Initial guess for start of signal smax=0.0 do idt=i0-8,i0+8 !Search over +/- one quarter symbol - call sync8d(cd0,idt,ctwk,0,sync) + call sync8d(cd0,idt,ctwk,0,1,sync) if(sync.gt.smax) then smax=sync ibest=idt @@ -108,7 +108,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & ctwk(i)=cmplx(cos(phi),sin(phi)) phi=mod(phi+dphi,twopi) enddo - call sync8d(cd0,i0,ctwk,1,sync) + call sync8d(cd0,i0,ctwk,1,1,sync) if( sync .gt. smax ) then smax=sync delfbest=delf @@ -120,7 +120,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & xdt=xdt2 f1=f1+delfbest !Improved estimate of DF - call sync8d(cd0,i0,ctwk,2,sync) + call sync8d(cd0,i0,ctwk,2,1,sync) j=0 do k=1,NN @@ -437,7 +437,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & enddo return -end subroutine ft8b +end subroutine ft8b_1 subroutine normalizebmet(bmet,n) real bmet(n) diff --git a/lib/ft8/ft8b_2.f90 b/lib/ft8/ft8b_2.f90 new file mode 100644 index 000000000..07e3ae3b6 --- /dev/null +++ b/lib/ft8/ft8b_2.f90 @@ -0,0 +1,457 @@ +subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & + napwid,lsubtract,nagain,iaptype,mycall12,mygrid6,hiscall12,bcontest, & + sync0,f1,xdt,xbase,apsym,nharderrors,dmin,nbadcrc,ipass,iera,msg37,xsnr) + + use crc + use timer_module, only: timer + include 'ft8_params.f90' + parameter(NP2=2812) + character*37 msg37 + character message*22,msgsent*22 + character*12 mycall12,hiscall12 + character*6 mycall6,mygrid6,hiscall6,c1,c2 + character*87 cbits + logical bcontest + real a(5) + real s1(0:7,ND),s2(0:7,NN),s1sort(8*ND) + real ps(0:7),psl(0:7) + real bmeta(3*ND),bmetb(3*ND),bmetap(3*ND) + real llr(3*ND),llra(3*ND),llr0(3*ND),llr1(3*ND),llrap(3*ND) !Soft symbols + real dd0(15*12000) + integer*1 decoded(91),decoded0(91),apmask(3*ND),cw(3*ND) + integer*1 msgbits(91) + integer apsym(91) + integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16) + integer itone(NN) + integer indxs1(8*ND) + integer icos7(0:6),ip(1) + integer nappasses(0:5) !Number of decoding passes to use for each QSO state + integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now + integer*1, target:: i1hiscall(12) + complex cd0(3200) + complex ctwk(32) + complex csymb(32) + logical first,newdat,lsubtract,lapon,lapcqonly,nagain + equivalence (s1,s1sort) + data icos7/3,1,4,0,6,5,2/ ! Flipped w.r.t. original FT8 sync array + data mcq/1,1,1,1,1,0,1,0,0,0,0,0,1,0,0,0,0,0,1,1,0,0,0,1,1,0,0,1/ + data mrrr/0,1,1,1,1,1,1,0,1,1,0,0,1,1,1,1/ + data m73/0,1,1,1,1,1,1,0,1,1,0,1,0,0,0,0/ + data mde/1,1,1,1,1,1,1,1,0,1,1,0,0,1,0,0,0,0,0,1,1,1,0,1,0,0,0,1/ + data mrr73/0,0,0,0,0,0,1,0,0,0,0,1,0,1,0,1/ + data first/.true./ + save nappasses,naptypes + + if(first) then + mcq=2*mcq-1 + mde=2*mde-1 + mrrr=2*mrrr-1 + m73=2*m73-1 + mrr73=2*mrr73-1 + nappasses(0)=2 + nappasses(1)=2 + nappasses(2)=2 + nappasses(3)=4 + nappasses(4)=4 + nappasses(5)=3 + +! iaptype +!------------------------ +! 1 CQ ??? ??? +! 2 MyCall ??? ??? +! 3 MyCall DxCall ??? +! 4 MyCall DxCall RRR +! 5 MyCall DxCall 73 +! 6 MyCall DxCall RR73 +! 7 ??? DxCall ??? + + naptypes(0,1:4)=(/1,2,0,0/) + naptypes(1,1:4)=(/2,3,0,0/) + naptypes(2,1:4)=(/2,3,0,0/) + naptypes(3,1:4)=(/3,4,5,6/) + naptypes(4,1:4)=(/3,4,5,6/) + naptypes(5,1:4)=(/3,1,2,0/) + first=.false. + endif + + max_iterations=30 + nharderrors=-1 + fs2=12000.0/NDOWN + dt2=1.0/fs2 + twopi=8.0*atan(1.0) + delfbest=0. + ibest=0 + + call timer('ft8_down',0) + call ft8_downsample(dd0,newdat,f1,cd0) !Mix f1 to baseband and downsample + call timer('ft8_down',1) + + i0=nint((xdt+0.5)*fs2) !Initial guess for start of signal + smax=0.0 + do idt=i0-8,i0+8 !Search over +/- one quarter symbol + call sync8d(cd0,idt,ctwk,0,2,sync) + if(sync.gt.smax) then + smax=sync + ibest=idt + endif + enddo + xdt2=ibest*dt2 !Improved estimate for DT + +! Now peak up in frequency + i0=nint(xdt2*fs2) + smax=0.0 + do ifr=-5,5 !Search over +/- 2.5 Hz + delf=ifr*0.5 + dphi=twopi*delf*dt2 + phi=0.0 + do i=1,32 + ctwk(i)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dphi,twopi) + enddo + call sync8d(cd0,i0,ctwk,1,2,sync) + if( sync .gt. smax ) then + smax=sync + delfbest=delf + endif + enddo + a=0.0 + a(1)=-delfbest + call twkfreq1(cd0,NP2,fs2,a,cd0) + xdt=xdt2 + f1=f1+delfbest !Improved estimate of DF + + call sync8d(cd0,i0,ctwk,2,2,sync) + + j=0 + do k=1,NN + i1=ibest+(k-1)*32 + csymb=cmplx(0.0,0.0) + if( i1.ge.1 .and. i1+31 .le. NP2 ) csymb=cd0(i1:i1+31) + call four2a(csymb,32,1,-1,1) + s2(0:7,k)=abs(csymb(1:8))/1e3 + enddo + +! sync quality check + is1=0 + is2=0 + is3=0 + do k=1,7 + ip=maxloc(s2(:,k)) + if(icos7(k-1).eq.(ip(1)-1)) is1=is1+1 + ip=maxloc(s2(:,k+36)) + if(icos7(k-1).eq.(ip(1)-1)) is2=is2+1 + ip=maxloc(s2(:,k+72)) + if(icos7(k-1).eq.(ip(1)-1)) is3=is3+1 + enddo +! hard sync sum - max is 21 + nsync=is1+is2+is3 + if(nsync .le. 6) then ! bail out + nbadcrc=1 + return + endif + + j=0 + do k=1,NN + if(k.le.7) cycle + if(k.ge.37 .and. k.le.43) cycle + if(k.gt.72) cycle + j=j+1 + s1(0:7,j)=s2(0:7,k) + enddo + + call indexx(s1sort,8*ND,indxs1) + xmeds1=s1sort(indxs1(nint(0.5*8*ND))) + s1=s1/xmeds1 + + do j=1,ND + i4=3*j-2 + i2=3*j-1 + i1=3*j +! Max amplitude + ps=s1(0:7,j) + r1=max(ps(1),ps(3),ps(5),ps(7))-max(ps(0),ps(2),ps(4),ps(6)) + r2=max(ps(2),ps(3),ps(6),ps(7))-max(ps(0),ps(1),ps(4),ps(5)) + r4=max(ps(4),ps(5),ps(6),ps(7))-max(ps(0),ps(1),ps(2),ps(3)) + bmeta(i4)=r4 + bmeta(i2)=r2 + bmeta(i1)=r1 + bmetap(i4)=r4 + bmetap(i2)=r2 + bmetap(i1)=r1 +! Max log metric + psl=log(ps) + r1=max(psl(1),psl(3),psl(5),psl(7))-max(psl(0),psl(2),psl(4),psl(6)) + r2=max(psl(2),psl(3),psl(6),psl(7))-max(psl(0),psl(1),psl(4),psl(5)) + r4=max(psl(4),psl(5),psl(6),psl(7))-max(psl(0),psl(1),psl(2),psl(3)) + bmetb(i4)=r4 + bmetb(i2)=r2 + bmetb(i1)=r1 + +! Metric for Cauchy noise +! r1=log(ps(1)**3+ps(3)**3+ps(5)**3+ps(7)**3)- & +! log(ps(0)**3+ps(2)**3+ps(4)**3+ps(6)**3) +! r2=log(ps(2)**3+ps(3)**3+ps(6)**3+ps(7)**3)- & +! log(ps(0)**3+ps(1)**3+ps(4)**3+ps(5)**3) +! r4=log(ps(4)**3+ps(5)**3+ps(6)**3+ps(7)**3)- & +! log(ps(0)**3+ps(1)**3+ps(2)**3+ps(3)**3) +! Metric for AWGN, no fading +! bscale=2.5 +! b0=bessi0(bscale*ps(0)) +! b1=bessi0(bscale*ps(1)) +! b2=bessi0(bscale*ps(2)) +! b3=bessi0(bscale*ps(3)) +! b4=bessi0(bscale*ps(4)) +! b5=bessi0(bscale*ps(5)) +! b6=bessi0(bscale*ps(6)) +! b7=bessi0(bscale*ps(7)) +! r1=log(b1+b3+b5+b7)-log(b0+b2+b4+b6) +! r2=log(b2+b3+b6+b7)-log(b0+b1+b4+b5) +! r4=log(b4+b5+b6+b7)-log(b0+b1+b2+b3) + + if(nQSOProgress .eq. 0 .or. nQSOProgress .eq. 5) then +! When bits 88:115 are set as ap bits, bit 115 lives in symbol 39 along +! with no-ap bits 116 and 117. Take care of metrics for bits 116 and 117. + if(j.eq.39) then ! take care of bits that live in symbol 39 + if(apsym(28).lt.0) then + bmetap(i2)=max(ps(2),ps(3))-max(ps(0),ps(1)) + bmetap(i1)=max(ps(1),ps(3))-max(ps(0),ps(2)) + else + bmetap(i2)=max(ps(6),ps(7))-max(ps(4),ps(5)) + bmetap(i1)=max(ps(5),ps(7))-max(ps(4),ps(6)) + endif + endif + endif + +! When bits 116:143 are set as ap bits, bit 115 lives in symbol 39 along +! with ap bits 116 and 117. Take care of metric for bit 115. +! if(j.eq.39) then ! take care of bit 115 +! iii=2*(apsym(29)+1)/2 + (apsym(30)+1)/2 ! known values of bits 116 & 117 +! if(iii.eq.0) bmetap(i4)=ps(4)-ps(0) +! if(iii.eq.1) bmetap(i4)=ps(5)-ps(1) +! if(iii.eq.2) bmetap(i4)=ps(6)-ps(2) +! if(iii.eq.3) bmetap(i4)=ps(7)-ps(3) +! endif + +! bit 144 lives in symbol 48 and will be 1 if it is set as an ap bit. +! take care of metrics for bits 142 and 143 + if(j.eq.48) then ! bit 144 is always 1 + bmetap(i4)=max(ps(5),ps(7))-max(ps(1),ps(3)) + bmetap(i2)=max(ps(3),ps(7))-max(ps(1),ps(5)) + endif + +! bit 154 lives in symbol 52 and will be 0 if it is set as an ap bit +! take care of metrics for bits 155 and 156 + if(j.eq.52) then ! bit 154 will be 0 if it is set as an ap bit. + bmetap(i2)=max(ps(2),ps(3))-max(ps(0),ps(1)) + bmetap(i1)=max(ps(1),ps(3))-max(ps(0),ps(2)) + endif + + enddo + + call normalizebmet(bmeta,3*ND) + call normalizebmet(bmetb,3*ND) + call normalizebmet(bmetap,3*ND) + + scalefac=2.83 + llr0=scalefac*bmeta + llr1=scalefac*bmetb + llra=scalefac*bmetap ! llr's for use with ap + apmag=scalefac*(maxval(abs(bmetap))*1.01) + +! pass # +!------------------------------ +! 1 regular decoding +! 2 erase 24 +! 3 erase 48 +! 4 ap pass 1 +! 5 ap pass 2 +! 6 ap pass 3 +! 7 ap pass 4, etc. + + if(lapon) then + if(.not.lapcqonly) then + npasses=4+nappasses(nQSOProgress) + else + npasses=5 + endif + else + npasses=4 + endif + + do ipass=1,npasses + + llr=llr0 + if(ipass.eq.2) llr=llr1 + if(ipass.eq.3) llr(1:24)=0. + if(ipass.eq.4) llr(1:48)=0. + if(ipass.le.4) then + apmask=0 + llrap=llr + iaptype=0 + endif + + if(ipass .gt. 4) then + if(.not.lapcqonly) then + iaptype=naptypes(nQSOProgress,ipass-4) + else + iaptype=1 + endif + if(iaptype.ge.3 .and. (abs(f1-nfqso).gt.napwid .and. abs(f1-nftx).gt.napwid) ) cycle + if(iaptype.eq.1 .or. iaptype.eq.2 ) then ! AP,???,??? + apmask=0 + apmask(88:115)=1 ! first 28 bits are AP + apmask(144)=1 ! not free text + llrap=llr + if(iaptype.eq.1) llrap(88:115)=apmag*mcq + if(iaptype.eq.2) llrap(88:115)=apmag*apsym(1:28) + llrap(116:117)=llra(116:117) + llrap(142:143)=llra(142:143) + llrap(144)=-apmag + endif + if(iaptype.eq.3) then ! mycall, dxcall, ??? + apmask=0 + apmask(88:115)=1 ! mycall + apmask(116:143)=1 ! hiscall + apmask(144)=1 ! not free text + llrap=llr + llrap(88:143)=apmag*apsym(1:56) + llrap(144)=-apmag + endif + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then + apmask=0 + apmask(88:115)=1 ! mycall + apmask(116:143)=1 ! hiscall + apmask(144:159)=1 ! RRR or 73 or RR73 + llrap=llr + llrap(88:143)=apmag*apsym(1:56) + if(iaptype.eq.4) llrap(144:159)=apmag*mrrr + if(iaptype.eq.5) llrap(144:159)=apmag*m73 + if(iaptype.eq.6) llrap(144:159)=apmag*mrr73 + endif + if(iaptype.eq.7) then ! ???, dxcall, ??? + apmask=0 + apmask(116:143)=1 ! hiscall + apmask(144)=1 ! not free text + llrap=llr + llrap(115)=llra(115) + llrap(116:143)=apmag*apsym(29:56) + llrap(144)=-apmag + endif + endif + + cw=0 + call timer('bpd174_91 ',0) + call bpdecode174_91(llrap,apmask,max_iterations,decoded,cw,nharderrors, & + niterations) + call timer('bpd174_91 ',1) + dmin=0.0 + if(ndepth.eq.3 .and. nharderrors.lt.0) then + ndeep=3 + if(abs(nfqso-f1).le.napwid .or. abs(nftx-f1).le.napwid) then + if((ipass.eq.3 .or. ipass.eq.4) .and. .not.nagain) then + ndeep=3 + else + ndeep=4 + endif + endif + if(nagain) ndeep=5 + call timer('osd174_91 ',0) + call osd174_91(llrap,apmask,ndeep,decoded,cw,nharderrors,dmin) + call timer('osd174_91 ',1) + endif + nbadcrc=1 + message=' ' + xsnr=-99.0 + if(count(cw.eq.0).eq.174) cycle !Reject the all-zero codeword + if(nharderrors.ge.0 .and. nharderrors+dmin.lt.60.0 .and. & + .not.(sync.lt.2.0 .and. nharderrors.gt.35) .and. & + .not.(ipass.gt.2 .and. nharderrors.gt.39) .and. & + .not.(ipass.eq.4 .and. nharderrors.gt.30) & + ) then + call chkcrc14a(decoded,nbadcrc) + else + nharderrors=-1 + cycle + endif + i3bit=4*decoded(73) + 2*decoded(74) + decoded(75) + iFreeText=decoded(57) + if(nbadcrc.eq.0) then + decoded0=decoded + if(i3bit.eq.1) decoded(57:)=0 + call extractmessage174_91(decoded,message,ncrcflag) + decoded=decoded0 +! This needs fixing for messages with i3bit=1: + call genft8(message,mygrid6,bcontest,i3bit,msgsent,msgbits,itone) + if(lsubtract) call subtractft8(dd0,itone,f1,xdt2) + xsig=0.0 + xnoi=0.0 + do i=1,79 + xsig=xsig+s2(itone(i),i)**2 + ios=mod(itone(i)+4,7) + xnoi=xnoi+s2(ios,i)**2 + enddo + xsnr=0.001 + if(xnoi.gt.0 .and. xnoi.lt.xsig) xsnr=xsig/xnoi-1.0 + xsnr=10.0*log10(xsnr)-27.0 + xsnr2=db(xsig/xbase - 1.0) - 32.0 + if(.not.nagain) xsnr=xsnr2 + if(xsnr .lt. -24.0) xsnr=-24.0 + + if(i3bit.eq.1) then + do i=1,12 + i1hiscall(i)=ichar(hiscall12(i:i)) + enddo + icrc10=crc10(c_loc(i1hiscall),12) + write(cbits,1001) decoded +1001 format(87i1) + read(cbits,1002) ncrc10,nrpt +1002 format(56x,b10,b6) + irpt=nrpt-30 + i1=index(message,' ') + i2=index(message(i1+1:),' ') + i1 + c1=message(1:i1)//' ' + c2=message(i1+1:i2)//' ' + + if(ncrc10.eq.icrc10) msg37=c1//' RR73; '//c2//' <'// & + trim(hiscall12)//'> ' + if(ncrc10.ne.icrc10) msg37=c1//' RR73; '//c2//' <...> ' + +! msg37=c1//' RR73; '//c2//' <...> ' + write(msg37(35:37),1010) irpt +1010 format(i3.2) + if(msg37(35:35).ne.'-') msg37(35:35)='+' + + iz=len(trim(msg37)) + do iter=1,10 !Collapse multiple blanks + ib2=index(msg37(1:iz),' ') + if(ib2.lt.1) exit + msg37=msg37(1:ib2)//msg37(ib2+2:) + iz=iz-1 + enddo + else + msg37=message//' ' + endif + + return + endif + enddo + + return +end subroutine ft8b_2 + +!subroutine normalizebmet(bmet,n) +! real bmet(n) +! +! bmetav=sum(bmet)/real(n) +! bmet2av=sum(bmet*bmet)/real(n) +! var=bmet2av-bmetav*bmetav +! if( var .gt. 0.0 ) then +! bmetsig=sqrt(var) +! else +! bmetsig=sqrt(bmet2av) +! endif +! bmet=bmet/bmetsig +! return +!end subroutine normalizebmet + + diff --git a/lib/fsk4hf/ldpc_174_91_c_colorder.f90 b/lib/ft8/ldpc_174_91_c_colorder.f90 similarity index 100% rename from lib/fsk4hf/ldpc_174_91_c_colorder.f90 rename to lib/ft8/ldpc_174_91_c_colorder.f90 diff --git a/lib/fsk4hf/ldpc_174_91_c_generator.f90 b/lib/ft8/ldpc_174_91_c_generator.f90 similarity index 100% rename from lib/fsk4hf/ldpc_174_91_c_generator.f90 rename to lib/ft8/ldpc_174_91_c_generator.f90 diff --git a/lib/fsk4hf/ldpc_174_91_c_parity.f90 b/lib/ft8/ldpc_174_91_c_parity.f90 similarity index 100% rename from lib/fsk4hf/ldpc_174_91_c_parity.f90 rename to lib/ft8/ldpc_174_91_c_parity.f90 diff --git a/lib/fsk4hf/ldpcsim174_91.f90 b/lib/ft8/ldpcsim174_91.f90 similarity index 100% rename from lib/fsk4hf/ldpcsim174_91.f90 rename to lib/ft8/ldpcsim174_91.f90 diff --git a/lib/fsk4hf/osd174_91.f90 b/lib/ft8/osd174_91.f90 similarity index 92% rename from lib/fsk4hf/osd174_91.f90 rename to lib/ft8/osd174_91.f90 index 38b5e69ba..34419f98f 100644 --- a/lib/fsk4hf/osd174_91.f90 +++ b/lib/ft8/osd174_91.f90 @@ -98,7 +98,7 @@ absrx=absrx(indices) rx=rx(indices) apmaskr=apmaskr(indices) -call mrbencode(m0,c0,g2,N,K) +call mrbencode91(m0,c0,g2,N,K) nxor=ieor(c0,hdec) nhardmin=sum(nxor) dmin=sum(nxor*absrx) @@ -161,7 +161,7 @@ do iorder=1,nord ntotal=ntotal+1 me=ieor(m0,mi) if(n1.eq.iflag) then - call mrbencode(me,ce,g2,N,K) + call mrbencode91(me,ce,g2,N,K) e2sub=ieor(ce(K+1:N),hdec(K+1:N)) e2=e2sub nd1Kpt=sum(e2sub(1:nt))+1 @@ -171,7 +171,7 @@ do iorder=1,nord nd1Kpt=sum(e2(1:nt))+2 endif if(nd1Kpt .le. ntheta) then - call mrbencode(me,ce,g2,N,K) + call mrbencode91(me,ce,g2,N,K) nxor=ieor(ce,hdec) if(n1.eq.iflag) then dd=d1+sum(e2sub*absrx(K+1:N)) @@ -190,7 +190,7 @@ do iorder=1,nord enddo ! Get the next test error pattern, iflag will go negative ! when the last pattern with weight iorder has been generated. - call nextpat(misub,k,iorder,iflag) + call nextpat91(misub,k,iorder,iflag) enddo enddo @@ -201,7 +201,7 @@ if(npre2.eq.1) then do i2=i1-1,1,-1 ntotal=ntotal+1 mi(1:ntau)=ieor(g2(K+1:K+ntau,i1),g2(K+1:K+ntau,i2)) - call boxit(reset,mi(1:ntau),ntau,ntotal,i1,i2) + call boxit91(reset,mi(1:ntau),ntau,ntotal,i1,i2) enddo enddo @@ -214,7 +214,7 @@ if(npre2.eq.1) then iflag=K-nord+1 do while(iflag .ge.0) me=ieor(m0,misub) - call mrbencode(me,ce,g2,N,K) + call mrbencode91(me,ce,g2,N,K) e2sub=ieor(ce(K+1:N),hdec(K+1:N)) do i2=0,ntau ntotal2=ntotal2+1 @@ -222,7 +222,7 @@ if(npre2.eq.1) then if(i2.gt.0) ui(i2)=1 r2pat=ieor(e2sub,ui) 778 continue - call fetchit(reset,r2pat(1:ntau),ntau,in1,in2) + call fetchit91(reset,r2pat(1:ntau),ntau,in1,in2) if(in1.gt.0.and.in2.gt.0) then ncount2=ncount2+1 mi=misub @@ -230,7 +230,7 @@ if(npre2.eq.1) then mi(in2)=1 if(sum(mi).lt.nord+npre1+npre2.or.any(iand(apmaskr(1:K),mi).eq.1)) cycle me=ieor(m0,mi) - call mrbencode(me,ce,g2,N,K) + call mrbencode91(me,ce,g2,N,K) nxor=ieor(ce,hdec) dd=sum(nxor*absrx) if( dd .lt. dmin ) then @@ -241,7 +241,7 @@ if(npre2.eq.1) then goto 778 endif enddo - call nextpat(misub,K,nord,iflag) + call nextpat91(misub,K,nord,iflag) enddo endif @@ -254,7 +254,7 @@ cw(colorder+1)=cw ! put the codeword back into received-word order return end subroutine osd174_91 -subroutine mrbencode(me,codeword,g2,N,K) +subroutine mrbencode91(me,codeword,g2,N,K) integer*1 me(K),codeword(N),g2(N,K) ! fast encoding for low-weight test patterns codeword=0 @@ -264,9 +264,9 @@ integer*1 me(K),codeword(N),g2(N,K) endif enddo return -end subroutine mrbencode +end subroutine mrbencode91 -subroutine nextpat(mi,k,iorder,iflag) +subroutine nextpat91(mi,k,iorder,iflag) integer*1 mi(k),ms(k) ! generate the next test error pattern ind=-1 @@ -293,9 +293,9 @@ subroutine nextpat(mi,k,iorder,iflag) endif enddo return -end subroutine nextpat +end subroutine nextpat91 -subroutine boxit(reset,e2,ntau,npindex,i1,i2) +subroutine boxit91(reset,e2,ntau,npindex,i1,i2) integer*1 e2(1:ntau) integer indexes(5000,2),fp(0:525000),np(5000) logical reset @@ -329,9 +329,9 @@ subroutine boxit(reset,e2,ntau,npindex,i1,i2) np(ip)=npindex endif return -end subroutine boxit +end subroutine boxit91 -subroutine fetchit(reset,e2,ntau,i1,i2) +subroutine fetchit91(reset,e2,ntau,i1,i2) integer indexes(5000,2),fp(0:525000),np(5000) integer lastpat integer*1 e2(ntau) @@ -367,5 +367,5 @@ subroutine fetchit(reset,e2,ntau,i1,i2) endif lastpat=ipat return -end subroutine fetchit +end subroutine fetchit91 diff --git a/lib/ft8/sync8.f90 b/lib/ft8/sync8.f90 index 30f6de172..b6e11ed1f 100644 --- a/lib/ft8/sync8.f90 +++ b/lib/ft8/sync8.f90 @@ -10,14 +10,15 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase) real x(NFFT1) real sync2d(NH1,-JZ:JZ) real red(NH1) - real candidate0(3,200) - real candidate(3,200) + real candidate0(4,200) + real candidate(4,200) real dd(NMAX) integer jpeak(NH1) integer indx(NH1) integer ii(1) - integer icos7(0:6) - data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern + integer icos7_1(0:6),icos7_2(0:6),icos7(0:6) + data icos7_1/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern + data icos7_2/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern equivalence (x,cx) ! Compute symbol spectra, stepping by NSTEP steps. @@ -49,6 +50,11 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase) nfos=NFFT1/NSPS ! # frequency bin oversampling factor jstrt=0.5/tstep + candidate0=0. + k=0 +do itype=1,2 + if(itype.eq.1) icos7=icos7_1 + if(itype.eq.2) icos7=icos7_2 do i=ia,ib do j=-JZ,+JZ ta=0. @@ -58,16 +64,16 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase) t0b=0. t0c=0. do n=0,6 - k=j+jstrt+nssy*n - if(k.ge.1.and.k.le.NHSYM) then - ta=ta + s(i+nfos*icos7(n),k) - t0a=t0a + sum(s(i:i+nfos*6:nfos,k)) + m=j+jstrt+nssy*n + if(m.ge.1.and.m.le.NHSYM) then + ta=ta + s(i+nfos*icos7(n),m) + t0a=t0a + sum(s(i:i+nfos*6:nfos,m)) endif - tb=tb + s(i+nfos*icos7(n),k+nssy*36) - t0b=t0b + sum(s(i:i+nfos*6:nfos,k+nssy*36)) - if(k+nssy*72.le.NHSYM) then - tc=tc + s(i+nfos*icos7(n),k+nssy*72) - t0c=t0c + sum(s(i:i+nfos*6:nfos,k+nssy*72)) + tb=tb + s(i+nfos*icos7(n),m+nssy*36) + t0b=t0b + sum(s(i:i+nfos*6:nfos,m+nssy*36)) + if(m+nssy*72.le.NHSYM) then + tc=tc + s(i+nfos*icos7(n),m+nssy*72) + t0c=t0c + sum(s(i:i+nfos*6:nfos,m+nssy*72)) endif enddo t=ta+tb+tc @@ -98,8 +104,6 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase) base=red(ibase) red=red/base - candidate0=0. - k=0 do i=1,200 n=ia + indx(iz+1-i) - 1 if(red(n).lt.syncmin) exit @@ -107,7 +111,9 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase) candidate0(1,k)=n*df candidate0(2,k)=(jpeak(n)-1)*tstep candidate0(3,k)=red(n) + candidate0(4,k)=itype enddo +enddo ncand=k ! Put nfqso at top of list, and save only the best of near-dupe freqs. @@ -121,9 +127,6 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase) if(candidate0(3,i).lt.candidate0(3,j)) candidate0(3,i)=0. endif enddo -! write(*,3001) i,candidate0(1,i-1),candidate0(1,i),candidate0(3,i-1), & -! candidate0(3,i) -!3001 format(i2,4f8.1) endif enddo @@ -143,6 +146,8 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase) candidate(1,k)=abs(candidate0(1,j)) candidate(2,k)=candidate0(2,j) candidate(3,k)=candidate0(3,j) + candidate(4,k)=candidate0(4,j) +!write(*,*) i,candidate(1:4,k) k=k+1 endif enddo diff --git a/lib/ft8/sync8d.f90 b/lib/ft8/sync8d.f90 index d0d1c63b8..6fd86a50f 100644 --- a/lib/ft8/sync8d.f90 +++ b/lib/ft8/sync8d.f90 @@ -1,4 +1,4 @@ -subroutine sync8d(cd0,i0,ctwk,itwk,sync) +subroutine sync8d(cd0,i0,ctwk,itwk,itype,sync) ! Compute sync power for a complex, downsampled FT8 signal. @@ -9,8 +9,9 @@ subroutine sync8d(cd0,i0,ctwk,itwk,sync) complex ctwk(32) complex z1,z2,z3 logical first - integer icos7(0:6) - data icos7/2,5,6,0,4,1,3/ + integer icos7_1(0:6),icos7_2(0:6),icos7(0:6) + data icos7_1/2,5,6,0,4,1,3/ + data icos7_2/3,1,4,0,6,5,2/ data first/.true./ save first,twopi,fs2,dt2,taus,baud,csync @@ -34,6 +35,12 @@ subroutine sync8d(cd0,i0,ctwk,itwk,sync) first=.false. endif + if(itype.eq.1) then + icos7=icos7_1 + else + icos7=icos7_2 + endif + sync=0 do i=0,6 !Sum over 7 Costas frequencies and i1=i0+i*32 !three Costas arrays diff --git a/lib/ft8_decode.f90 b/lib/ft8_decode.f90 index 3f6291fd3..aeade9e55 100644 --- a/lib/ft8_decode.f90 +++ b/lib/ft8_decode.f90 @@ -44,7 +44,7 @@ contains procedure(ft8_decode_callback) :: callback real s(NH1,NHSYM) real sbase(NH1) - real candidate(3,200) + real candidate(4,200) real dd(15*12000) logical, intent(in) :: lft8apon,lapcqonly,nagain logical newdat,lsubtract,ldupe,bcontest @@ -102,13 +102,21 @@ contains sync=candidate(3,icand) f1=candidate(1,icand) xdt=candidate(2,icand) + iftype=candidate(4,icand) xbase=10.0**(0.1*(sbase(nint(f1/3.125))-40.0)) nsnr0=min(99,nint(10.0*log10(sync) - 25.5)) !### empirical ### call timer('ft8b ',0) - call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, & - lapcqonly,napwid,lsubtract,nagain,iaptype,mycall12,mygrid6, & - hiscall12,bcontest,sync,f1,xdt,xbase,apsym,nharderrors,dmin, & - nbadcrc,iappass,iera,msg37,xsnr) + if(iftype.eq.1) then + call ft8b_1(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, & + lapcqonly,napwid,lsubtract,nagain,iaptype,mycall12,mygrid6, & + hiscall12,bcontest,sync,f1,xdt,xbase,apsym,nharderrors,dmin, & + nbadcrc,iappass,iera,msg37,xsnr) + else + call ft8b_2(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, & + lapcqonly,napwid,lsubtract,nagain,iaptype,mycall12,mygrid6, & + hiscall12,bcontest,sync,f1,xdt,xbase,apsym,nharderrors,dmin, & + nbadcrc,iappass,iera,msg37,xsnr) + endif message=msg37(1:22) !### nsnr=nint(xsnr) xdt=xdt-0.5