Q65 AP decoding is now (sort of?) working. Problem with i3 field, and maybe other problems...

This commit is contained in:
Joe Taylor 2020-10-30 11:07:44 -04:00
parent 1c30b97228
commit f974751e42
4 changed files with 227 additions and 22 deletions

View File

@ -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

View File

@ -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

164
lib/qra/q65/q65_ap.f90 Normal file
View File

@ -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 <Fox Call hash10> ???
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

View File

@ -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