From f974751e42482f6a5d0deecb27bb6c31273e5636 Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Fri, 30 Oct 2020 11:07:44 -0400 Subject: [PATCH] Q65 AP decoding is now (sort of?) working. Problem with i3 field, and maybe other problems... --- CMakeLists.txt | 1 + lib/q65_decode.f90 | 73 +++++++++++++---- lib/qra/q65/q65_ap.f90 | 164 ++++++++++++++++++++++++++++++++++++++ lib/qra/q65/q65_loops.f90 | 11 +-- 4 files changed, 227 insertions(+), 22 deletions(-) create mode 100644 lib/qra/q65/q65_ap.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index c001db3f4..4235643cd 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -497,6 +497,7 @@ set (wsjt_FSRCS lib/ps4.f90 lib/qra64a.f90 lib/qra_loops.f90 + lib/qra/q65/q65_ap.f90 lib/qra/q65/q65_loops.f90 lib/refspectrum.f90 lib/savec2.f90 diff --git a/lib/q65_decode.f90 b/lib/q65_decode.f90 index 1a973dd7c..583d50ebd 100644 --- a/lib/q65_decode.f90 +++ b/lib/q65_decode.f90 @@ -51,9 +51,13 @@ contains character(len=6) :: hisgrid character*37 decoded !Decoded message character*77 c77 + character*78 c78 integer*2 iwave(NMAX) !Raw data real, allocatable :: dd(:) !Raw data integer dat4(13) !Decoded message as 12 6-bit integers + integer apsym0(58),aph10(10) + integer apmask1(78),apsymbols1(78) + integer apmask(13),apsymbols(13) logical lapcqonly,unpk77_success complex, allocatable :: c00(:) !Analytic signal, 6000 Sa/s complex, allocatable :: c0(:) !Analytic signal, 6000 Sa/s @@ -101,40 +105,75 @@ contains call timer('sync_q65',1) irc=-1 - if(snr1.ge.2.5) then - jpk0=(xdt+1.0)*6000 !### - if(ntrperiod.le.30) jpk0=(xdt+0.5)*6000 !### - if(jpk0.lt.0) jpk0=0 - fac=1.0/32767.0 - dd=fac*iwave - nmode=65 - call ana64(dd,npts,c00) + if(snr1.lt.2.5) go to 100 + jpk0=(xdt+1.0)*6000 !### + if(ntrperiod.le.30) jpk0=(xdt+0.5)*6000 !### + if(jpk0.lt.0) jpk0=0 + fac=1.0/32767.0 + dd=fac*iwave + nmode=65 + call ana64(dd,npts,c00) + + call ft8apset(mycall,hiscall,ncontest,apsym0,aph10) + where(apsym0.eq.-1) apsym0=0 + + npasses=2 + if(nQSOprogress.eq.3 .or.nQSOprogress.eq.4) npasses=4 + if(nQSOprogress.eq.5) npasses=3 + if(lapcqonly) npasses=1 + do ipass=0,npasses +! print*,'A',nQSOprogress,ipass,npasses + apmask=0 + apsymbols=0 + if(ipass.ge.1) then + call q65_ap(nQSOprogress,ipass,ncontest,lapcqonly,apsym0,apmask1, & + apsymbols1) + write(c78,1050) apmask1 +1050 format(78i1) + c78(75:78)=' ' + read(c78,1060) apmask +1060 format(13b6.6) + write(c78,1050) apsymbols1 + read(c78,1060) apsymbols + +! write(72,3060) 'A',ipass,apmask,apmask +!3060 format(a1,i1,1x,13b6.6/3x,13i6) +! write(72,3060) 'B',ipass,apsymbols,apsymbols + endif + call timer('q65loops',0) call q65_loops(c00,npts/2,nsps/2,nmode,mode65,nsubmode,nFadingModel, & - ndepth,jpk0,xdt,f0,width,snr2,irc,dat4) + ndepth,jpk0,xdt,f0,width,ipass,apmask,apsymbols,snr2,irc,dat4) call timer('q65loops',1) snr2=snr2 + db(6912.0/nsps) - endif - decoded=' ' + if(irc.ge.0) exit + enddo + +100 decoded=' ' if(irc.ge.0) then - irc=(irc/100) * 100 !### TEMPORARY ??? ### +!### +! irc=(irc/100) * 100 !### TEMPORARY ??? ### + navg=irc/100 + irc=ipass +!### write(c77,1000) dat4 1000 format(12b6.6,b5.5) + +! write(72,3080) 'C',ipass,c77,'0' +!3080 format(a1,i1,1x,a77,a1) +! write(72,3060) 'C',ipass,dat4,dat4 + call unpack77(c77,0,decoded,unpk77_success) !Unpack to get msgsent nsnr=nint(snr2) call this%callback(nutc,sync,nsnr,xdt,f0,decoded, & irc,qual,ntrperiod,fmid,w50) else + ! Report sync, even if no decode. nsnr=db(snr1) - 35.0 -!### TEMPORARY? ### call this%callback(nutc,sync,nsnr,xdt,f0,decoded, & irc,qual,ntrperiod,fmid,w50) -!### endif -! write(61,3061) nutc,irc,xdt,f0,snr1,snr2,trim(decoded) -!3061 format(i6.6,i4,4f10.2,2x,a) - return end subroutine decode diff --git a/lib/qra/q65/q65_ap.f90 b/lib/qra/q65/q65_ap.f90 new file mode 100644 index 000000000..1c9fe1517 --- /dev/null +++ b/lib/qra/q65/q65_ap.f90 @@ -0,0 +1,164 @@ +subroutine q65_ap(nQSOprogress,ipass,ncontest,lapcqonly,apsym0,apmask,apsymbols) + + integer apsym0(58),aph10(10) + integer apmask(78),apsymbols(78) + integer naptypes(0:5,4) ! (nQSOProgress, ipass) maximum of 4 passes for now + integer mcqru(29),mcqfd(29),mcqtest(29),mcqww(29) + integer mcq(29),mrrr(19),m73(19),mrr73(19) + logical lapcqonly,first + data mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/ + data mcqru/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,0,0,1,1,0,0/ + data mcqfd/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,1,0,0,0,1,0/ + data mcqtest/0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,0,1,0,1,1,1,1,1,1,0,0,1,0/ + data mcqww/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,1,1,1,1,0/ + data mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/ + data m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/ + data mrr73/0,1,1,1,1,1,1,0,0,1,1,1,0,1,0,1,0,0,1/ + data ncontest0/99/ + data first/.true./ + save naptypes,ncontest0 + +! nQSOprogress +! 0 CALLING +! 1 REPLYING +! 2 REPORT +! 3 ROGER_REPORT +! 4 ROGERS +! 5 SIGNOFF + + if(first.or.(ncontest.ne.ncontest0)) then +! iaptype +!------------------------ +! 1 CQ ??? ??? (29+4=33 ap bits) +! 2 MyCall ??? ??? (29+4=33 ap bits) +! 3 MyCall DxCall ??? (58+4=62 ap bits) +! 4 MyCall DxCall RRR (78 ap bits) +! 5 MyCall DxCall 73 (78 ap bits) +! 6 MyCall DxCall RR73 (78 ap bits) + + naptypes(0,1:4)=(/1,2,0,0/) ! Tx6 selected (CQ) + naptypes(1,1:4)=(/2,3,0,0/) ! Tx1 + naptypes(2,1:4)=(/2,3,0,0/) ! Tx2 + naptypes(3,1:4)=(/3,4,5,6/) ! Tx3 + naptypes(4,1:4)=(/3,4,5,6/) ! Tx4 + naptypes(5,1:4)=(/3,1,2,0/) ! Tx5 + first=.false. + ncontest0=ncontest + endif + + apsymbols=0 + iaptype=naptypes(nQSOProgress,ipass) + if(lapcqonly) iaptype=1 + +! ncontest=0 : NONE +! 1 : NA_VHF +! 2 : EU_VHF +! 3 : FIELD DAY +! 4 : RTTY +! 5 : WW_DIGI +! 6 : FOX +! 7 : HOUND + +! Conditions that cause us to bail out of AP decoding +! if(ncontest.le.5 .and. iaptype.ge.3 .and. (abs(f1-nfqso).gt.napwid .and. abs(f1-nftx).gt.napwid) ) goto 900 +! if(ncontest.eq.6) goto 900 !No AP for Foxes +! if(ncontest.eq.7.and.f1.gt.950.0) goto 900 !Hounds use AP only below 950 Hz + if(ncontest.ge.6) goto 900 + if(iaptype.ge.2 .and. apsym0(1).gt.1) goto 900 !No, or nonstandard, mycall + if(ncontest.eq.7 .and. iaptype.ge.2 .and. aph10(1).gt.1) goto 900 + if(iaptype.ge.3 .and. apsym0(30).gt.1) goto 900 !No, or nonstandard, dxcall + + if(iaptype.eq.1) then ! CQ or CQ RU or CQ TEST or CQ FD + apmask=0 + apmask(1:29)=1 + if(ncontest.eq.0) apsymbols(1:29)=mcq + if(ncontest.eq.1) apsymbols(1:29)=mcqtest + if(ncontest.eq.2) apsymbols(1:29)=mcqtest + if(ncontest.eq.3) apsymbols(1:29)=mcqfd + if(ncontest.eq.4) apsymbols(1:29)=mcqru + if(ncontest.eq.5) apsymbols(1:29)=mcqww + if(ncontest.eq.7) apsymbols(1:29)=mcq + apmask(75:78)=1 + apsymbols(75:78)=(/0,0,1,0/) + endif + + if(iaptype.eq.2) then ! MyCall,???,??? + apmask=0 + if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.5) then + apmask(1:29)=1 + apsymbols(1:29)=apsym0(1:29) + apmask(75:78)=1 + apsymbols(75:78)=(/0,0,1,0/) + else if(ncontest.eq.2) then + apmask(1:28)=1 + apsymbols(1:28)=apsym0(1:28) + apmask(72:74)=1 + apsymbols(72)=0 + apsymbols(73)=(+1) + apsymbols(74)=0 + apmask(75:78)=1 + apsymbols(75:78)=0 + else if(ncontest.eq.3) then + apmask(1:28)=1 + apsymbols(1:28)=apsym0(1:28) + apmask(75:78)=1 + apsymbols(75:78)=0 + else if(ncontest.eq.4) then + apmask(2:29)=1 + apsymbols(2:29)=apsym0(1:28) + apmask(75:78)=1 + apsymbols(75:78)=(/0,0,1,0/) + else if(ncontest.eq.7) then ! ??? RR73; MyCall ??? + apmask(29:56)=1 + apsymbols(29:56)=apsym0(1:28) + apmask(57:66)=1 + apsymbols(57:66)=aph10(1:10) + apmask(72:78)=1 + apsymbols(72:74)=(/0,0,1/) + apsymbols(75:78)=0 + endif + endif + + if(iaptype.eq.3) then ! MyCall,DxCall,??? + apmask=0 + if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.2.or.ncontest.eq.5.or.ncontest.eq.7) then + apmask(1:58)=1 + apsymbols(1:58)=apsym0 + apmask(75:78)=1 + apsymbols(75:78)=(/0,0,1,0/) + else if(ncontest.eq.3) then ! Field Day + apmask(1:56)=1 + apsymbols(1:28)=apsym0(1:28) + apsymbols(29:56)=apsym0(30:57) + apmask(72:78)=1 + apsymbols(75:78)=0 + else if(ncontest.eq.4) then + apmask(2:57)=1 + apsymbols(2:29)=apsym0(1:28) + apsymbols(30:57)=apsym0(30:57) + apmask(75:78)=1 + apsymbols(75:78)=(/0,0,1,0/) + endif + endif + + if(iaptype.eq.5.and.ncontest.eq.7) goto 900 !Hound + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then + apmask=0 + if(ncontest.le.5 .or. (ncontest.eq.7.and.iaptype.eq.6)) then + apmask(1:78)=1 ! mycall, hiscall, RRR|73|RR73 + apsymbols(1:58)=apsym0 + if(iaptype.eq.4) apsymbols(59:77)=mrrr + if(iaptype.eq.5) apsymbols(59:77)=m73 + if(iaptype.eq.6) apsymbols(59:77)=mrr73 + else if(ncontest.eq.7.and.iaptype.eq.4) then ! Hound listens for MyCall RR73;... + apmask(1:28)=1 + apsymbols(1:28)=apsym0(1:28) + apmask(57:66)=1 + apsymbols(57:66)=aph10(1:10) + apmask(72:78)=1 + apsymbols(72:78)=(/0,0,1,0,0,0,0/) + endif + endif + +900 return +end subroutine q65_ap diff --git a/lib/qra/q65/q65_loops.f90 b/lib/qra/q65/q65_loops.f90 index 0bb0b27d4..b468b00ce 100644 --- a/lib/qra/q65/q65_loops.f90 +++ b/lib/qra/q65/q65_loops.f90 @@ -1,5 +1,5 @@ subroutine q65_loops(c00,npts2,nsps,mode,mode64,nsubmode,nFadingModel, & - ndepth,jpk0,xdt,f0,width,snr2,irc,dat4) + ndepth,jpk0,xdt,f0,width,ipass,APmask,APsymbols,snr2,irc,dat4) use packjt77 use timer_module, only: timer @@ -69,8 +69,8 @@ subroutine q65_loops(c00,npts2,nsps,mode,mode64,nsubmode,nFadingModel, & ncall=ncall+1 call timer('qra64_de',0) call q65_intrinsics_ff(s3,nsubmode,b90,nFadingModel,s3prob) - APmask=0 - APsymbols=0 +! APmask=0 +! APsymbols=0 call q65_dec(s3,s3prob,APmask,APsymbols,snr2,dat4,irc) ! irc > 0 ==> number of iterations required to decode ! -1 = invalid params @@ -108,8 +108,9 @@ subroutine q65_loops(c00,npts2,nsps,mode,mode64,nsubmode,nFadingModel, & write(c77,1100) dat4 1100 format(12b6.6,b5.5) call unpack77(c77,0,decoded,unpk77_success) !Unpack to get msgsent - write(53,3053) idf,idt,ibw,b90,xdt,f0,snr2,ndist,irc,navg,decoded(1:22) -3053 format(3i5,f7.1,f7.2,2f7.1,3i4,2x,a22) + write(53,3053) idf,idt,ibw,b90,xdt,f0,snr2,ndist,irc,ipass,navg, & + trim(decoded) +3053 format(3i5,f7.1,f7.2,2f7.1,4i4,2x,a) close(53) !### nsave=0