From e205bf0ca66259960b50470c7be3e77f7a177792 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Mon, 22 Jan 2024 12:07:52 -0600 Subject: [PATCH 1/4] Changes to enable simulating (240,74) FST4W code with noncoherent 4FSK on AWGN or Rayleigh fading channels --- lib/fst4/ldpcsim240_74.f90 | 227 ++++++++++++++++++++++++++++++------- 1 file changed, 186 insertions(+), 41 deletions(-) diff --git a/lib/fst4/ldpcsim240_74.f90 b/lib/fst4/ldpcsim240_74.f90 index de3ffa8b6..d6838607d 100644 --- a/lib/fst4/ldpcsim240_74.f90 +++ b/lib/fst4/ldpcsim240_74.f90 @@ -4,33 +4,47 @@ program ldpcsim240_74 use packjt77 - parameter(N=240, K=74, M=N-K) + parameter(N=240, NN=120) character*8 arg - character*37 msg0 + character*37 msg0,msgsent,msg character*77 c77 character*24 c24 - integer*1 msgbits(74) + integer*1 msgbits(101) integer*1 apmask(240) integer*1 cw(240) integer*1 codeword(N),message74(74) integer ncrc24 - real rxdata(N),llr(N) + integer modtype, graymap(0:3) + integer*4 itone(120) + integer channeltype + integer lmax(1) + real rxdata(N) + real llr(240) + real bitmetrics(2*NN,4) + complex c1(4,8),c2(16,4),c4(256,2),cs(0:3,NN) + real s2(0:65535) + logical one(0:65535,0:15) ! 65536 8-symbol sequences, 16 bits logical first data first/.true./ + data graymap/0,1,3,2/ nargs=iargc() - if(nargs.ne.5 .and. nargs.ne.6) then - print*,'Usage: ldpcsim niter ndeep #trials s K [msg]' - print*,'e.g. ldpcsim240_74 20 5 1000 0.85 64 "K9AN K1JT FN20"' + if(nargs.ne.7 .and. nargs.ne.8) then + print*,'Usage: ldpcsim maxosd norder #trials s Keff modtype channel ' + print*,'e.g. ldpcsim240_74 2 4 1000 0.85 50 1 0' print*,'s : if negative, then value is ignored and sigma is calculated from SNR.' - print*,'niter: is the number of BP iterations.' - print*,'ndeep: -1 is BP only, ndeep>=0 is OSD order' - print*,'K :is the number of message+CRC bits and must be in the range [50,74]' + print*,'maxosd<0: do bp only' + print*,'maxosd=0: do bp and then call osd once with channel llrs.' + print*,'maxosd>0: do bp and then call osc maxosd times with saved bp outputs.' + print*,'norder : osd decoding depth' + print*,'Keff : # of message bits, Keff must be in the range 50:74' + print*,'modtype : 0 coherent BPSK, 1 4FSK' + print*,'channel : 0 AWGN, 1 Rayleigh (4FSK only)' print*,'WSPR-format message is optional' return endif call getarg(1,arg) - read(arg,*) max_iterations + read(arg,*) maxosd call getarg(2,arg) read(arg,*) norder call getarg(3,arg) @@ -39,17 +53,26 @@ program ldpcsim240_74 read(arg,*) s call getarg(5,arg) read(arg,*) Keff - msg0='K9AN K1JT FN20 ' - if(nargs.eq.6) call getarg(6,msg0) + call getarg(6,arg) + read(arg,*) modtype + call getarg(7,arg) + read(arg,*) channeltype + call getarg(8,arg) + + msg0='K9AN EN50 20 ' call pack77(msg0,i3,n3,c77) rate=real(Keff)/real(N) write(*,*) "code rate: ",rate - write(*,*) "niter : ",max_iterations + write(*,*) "maxosd : ",maxosd write(*,*) "norder : ",norder write(*,*) "s : ",s write(*,*) "K : ",Keff + if(modtype.eq.0) write(*,*) "modtype : coherent BPSK" + if(modtype.eq.1) write(*,*) "modtype : noncoherent 4FSK" + if(channeltype.eq.0) write(*,*) "channel : AWGN" + if(channeltype.eq.1) write(*,*) "channel : Rayleigh" msgbits=0 read(c77,'(50i1)') msgbits(1:50) @@ -59,49 +82,170 @@ program ldpcsim240_74 call get_crc24(msgbits,74,ncrc24) write(c24,'(b24.24)') ncrc24 read(c24,'(24i1)') msgbits(51:74) -write(*,'(24i1)') msgbits(51:74) + write(*,'(24i1)') msgbits(51:74) write(*,*) 'message with crc24' write(*,'(74i1)') msgbits(1:74) - call encode240_74(msgbits,codeword) - call init_random_seed() - call sgran() + + call encode240_74(msgbits(1:74),codeword) + do i=1,120 + is=codeword(2*i)+2*codeword(2*i-1) + itone(i)=graymap(is) + enddo write(*,*) 'codeword' write(*,'(77i1,1x,24i1,1x,73i1)') codeword - write(*,*) "Eb/N0 Es/N0 ngood nundetected sigma symbol error rate" - do idb = 8,-3,-1 +! call init_random_seed() +! call sgran() + + one=.false. + do i=0,65535 + do j=0,15 + if(iand(i,2**j).ne.0) one(i,j)=.true. + enddo + enddo + + write(*,*) "Eb/N0 Es/N0 ngood nundetected symbol error rate" + do idb = 24,-8,-1 db=idb/2.0-1.0 - sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) ! to make db represent Eb/No + sigma=1/sqrt( 2*rate*iq*(10**(db/10.0)) ) ! to make db represent Eb/No ! sigma=1/sqrt( 2*(10**(db/10.0)) ) ! db represents Es/No ngood=0 nue=0 nberr=0 + nsymerr=0 + do itrial=1, ntrials ! Create a realization of a noisy received word - do i=1,N - rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran() - enddo - nerr=0 - do i=1,N - if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1 - enddo - nberr=nberr+nerr + if(modtype.eq.0) then + iq = 1 ! bits per symbol + sigma=1/sqrt( 2*rate*iq*(10**(db/10.0)) ) ! to make db represent Eb/No + do i=1,N + rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran() + enddo + nerr=0 + do i=1,N + if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1 + enddo + nberr=nberr+nerr - rxav=sum(rxdata)/N - rx2av=sum(rxdata*rxdata)/N - rxsig=sqrt(rx2av-rxav*rxav) - rxdata=rxdata/rxsig - if( s .lt. 0 ) then - ss=sigma + rxav=sum(rxdata)/N + rx2av=sum(rxdata*rxdata)/N + rxsig=sqrt(rx2av-rxav*rxav) + rxdata=rxdata/rxsig + if( s .lt. 0 ) then + ss=sigma + else + ss=s + endif + + llr=2.0*rxdata/(ss*ss) else - ss=s +! noncoherent MFSK + iq = 2 ! bits per symbol + sigma=1/sqrt( 2*rate*iq*(10**(db/10.0)) ) ! to make db represent Eb/No + A=1 + do i=1,120 + do j=0,3 + if(j.eq.itone(i)) then + if(channeltype.eq.0) then + A=1.0 + elseif(channeltype.eq.1) then + xI=gran()**2+gran()**2 + A=sqrt(xI/2) + endif + cs(j,i)= A + sigma*gran() + cmplx(0,1)*sigma*gran() + elseif(j.ne.itone(i)) then + cs(j,i)= sigma*gran() + cmplx(0,1)*sigma*gran() + endif + enddo + lmax=maxloc(abs(cs(:,i))) + if(lmax(1)-1.ne.itone(i) ) nsymerr=nsymerr+1 + enddo + + do k=1,NN,8 + + do m=1,8 ! do 4 1-symbol correlations for each of 8 symbs + s2=0 + do is=1,4 + c1(is,m)=cs(graymap(is-1),k+m-1) + s2(is-1)=abs(c1(is,m)) + enddo + ipt=(k-1)*2+2*(m-1)+1 + do ib=0,1 + bm=maxval(s2(0:3),one(0:3,1-ib)) - & + maxval(s2(0:3),.not.one(0:3,1-ib)) + if(ipt+ib.gt.2*NN) cycle + bitmetrics(ipt+ib,1)=bm + enddo + enddo + + do m=1,4 ! do 16 2-symbol correlations for each of 4 2-symbol groups + s2=0 + do i=1,4 + do j=1,4 + is=(i-1)*4+j + c2(is,m)=c1(i,2*m-1)+c1(j,2*m) + s2(is-1)=abs(c2(is,m))**2 + enddo + enddo + ipt=(k-1)*2+4*(m-1)+1 + do ib=0,3 + bm=maxval(s2(0:15),one(0:15,3-ib)) - & + maxval(s2(0:15),.not.one(0:15,3-ib)) + if(ipt+ib.gt.2*NN) cycle + bitmetrics(ipt+ib,2)=bm + enddo + enddo + + do m=1,2 ! do 256 4-symbol corrs for each of 2 4-symbol groups + s2=0 + do i=1,16 + do j=1,16 + is=(i-1)*16+j + c4(is,m)=c2(i,2*m-1)+c2(j,2*m) + s2(is-1)=abs(c4(is,m)) + enddo + enddo + ipt=(k-1)*2+8*(m-1)+1 + do ib=0,7 + bm=maxval(s2(0:255),one(0:255,7-ib)) - & + maxval(s2(0:255),.not.one(0:255,7-ib)) + if(ipt+ib.gt.2*NN) cycle + bitmetrics(ipt+ib,3)=bm + enddo + enddo + + s2=0 ! do 65536 8-symbol correlations for the entire group + do i=1,256 + do j=1,256 + is=(i-1)*256+j + s2(is-1)=abs(c4(i,1)+c4(j,2)) + enddo + enddo + ipt=(k-1)*2+1 + do ib=0,15 + bm=maxval(s2(0:65535),one(0:65535,15-ib)) - & + maxval(s2(0:65535),.not.one(0:65535,15-ib)) + if(ipt+ib.gt.2*NN) cycle + bitmetrics(ipt+ib,4)=bm + enddo + + enddo + + call normalizebmet(bitmetrics(:,1),2*NN) + call normalizebmet(bitmetrics(:,2),2*NN) + call normalizebmet(bitmetrics(:,3),2*NN) + call normalizebmet(bitmetrics(:,4),2*NN) + + scalefac=2.83 + bitmetrics=scalefac*bitmetrics + + llr=bitmetrics(:,1) endif - llr=2.0*rxdata/(ss*ss) apmask=0 dmin=0.0 - maxosd=2 call decode240_74(llr, Keff, maxosd, norder, apmask, message74, cw, ntype, nharderror, dmin) if(nharderror.ge.0) then n2err=0 @@ -116,9 +260,10 @@ write(*,'(24i1)') msgbits(51:74) endif enddo ! snr2500=db+10*log10(200.0/116.0/2500.0) - esn0=db+10*log10(rate) - pberr=real(nberr)/(real(ntrials*N)) - write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,8x,e10.3)") db,esn0,ngood,nue,pberr + esn0=db+10*log10(rate*iq) + pberr=real(nberr)/real(ntrials*N) + pserr=real(nsymerr)/real(ntrials*120) + write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,8x,e10.3)") db,esn0,ngood,nue,pserr enddo From aac9de3e4c5a322a1279d9b72365c637d3dd7fc0 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 23 Jan 2024 09:47:19 -0600 Subject: [PATCH 2/4] fastosd240_74.f90: Fix a couple of typos. No impact on WSJT-X decoding performance. --- lib/fst4/fastosd240_74.f90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/lib/fst4/fastosd240_74.f90 b/lib/fst4/fastosd240_74.f90 index aa14506a7..3e812e0f8 100644 --- a/lib/fst4/fastosd240_74.f90 +++ b/lib/fst4/fastosd240_74.f90 @@ -171,15 +171,15 @@ subroutine fastosd240_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) if( ndeep.eq. 1) then nord=1 xlambda=0.0 - nsyncmax=np + nsyndmax=np elseif(ndeep.eq.2) then nord=2 xlambda=0.0 - nsyncmax=np + nsyndmax=np elseif(ndeep.eq.3) then nord=3 xlambda=4.0 - nsyncmax=11 + nsyndmax=11 elseif(ndeep.eq.4) then nord=4 xlambda=3.4 @@ -190,7 +190,6 @@ subroutine fastosd240_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) s2=sum(absrx(k+1:N)) rho=s1/(s1+xlambda*s2) rhodmin=rho*dmin - nerr64=-1 do iorder=1,nord !beta=0.0 !if(iorder.ge.3) beta=0.4 @@ -216,7 +215,6 @@ subroutine fastosd240_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) cw=ce nhardmin=sum(nxor) nwhspmin=nwhsp - nerr64=sum(nxor(1:K)) endif endif ! Get the next test error pattern, iflag will go negative @@ -224,7 +222,6 @@ subroutine fastosd240_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) call nextpat74(mi,k,iorder,iflag) enddo enddo - 998 continue ! Re-order the codeword to [message bits][parity bits] format. cw(indices)=cw From 90b7ff7da9294a0056d05e520815addf9d3f1c03 Mon Sep 17 00:00:00 2001 From: Uwe Risse Date: Wed, 24 Jan 2024 18:02:06 +0100 Subject: [PATCH 3/4] Deactivate Lookup for certain special operating activities, as 6-digit grids from CALL3.TXT may not be accepted. --- widgets/mainwindow.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/widgets/mainwindow.cpp b/widgets/mainwindow.cpp index 9343077d6..98b979bb8 100644 --- a/widgets/mainwindow.cpp +++ b/widgets/mainwindow.cpp @@ -6383,7 +6383,7 @@ void MainWindow::lookup() { QString hisCall {ui->dxCallEntry->text()}; QString hisgrid0 {ui->dxGridEntry->text()}; - if (!hisCall.size ()) return; + if (!hisCall.size () or (!(m_specOp==SpecOp::NONE or m_specOp==SpecOp::HOUND or m_specOp==SpecOp::Q65_PILEUP))) return; QFile f {m_config.writeable_data_dir ().absoluteFilePath ("CALL3.TXT")}; if (f.open (QIODevice::ReadOnly | QIODevice::Text)) { From 41407dad9fec561fd88d8e8b370f7a9302d330dc Mon Sep 17 00:00:00 2001 From: Uwe Risse Date: Fri, 26 Jan 2024 10:34:30 +0100 Subject: [PATCH 4/4] Always display Q65 messages with own callsign in the right-hand window. --- widgets/mainwindow.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/widgets/mainwindow.cpp b/widgets/mainwindow.cpp index 98b979bb8..d71bda429 100644 --- a/widgets/mainwindow.cpp +++ b/widgets/mainwindow.cpp @@ -4243,7 +4243,7 @@ void MainWindow::readFromStdout() //readFromStdout if((abs(audioFreq - m_wideGraph->rxFreq()) <= 10) and !m_config.enable_VHF_features()) bDisplayRight=true; } - if(m_mode=="Q65" and !bAvgMsg) bDisplayRight=false; + if(m_mode=="Q65" and !bAvgMsg and !decodedtext.string().contains(m_baseCall)) bDisplayRight=false; if((m_mode=="JT4" or m_mode=="Q65" or m_mode=="JT65") and decodedtext.string().contains(m_baseCall) && ui->actionInclude_averaging->isVisible() && !ui->actionInclude_averaging->isChecked()) bDisplayRight=true; if (bDisplayRight) {