diff --git a/CMakeLists.txt b/CMakeLists.txt index f8986e5c8..20eb32034 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -369,7 +369,7 @@ set (wsjt_FSRCS lib/jt65_mod.f90 lib/ft8_decode.f90 lib/ft4_decode.f90 - lib/fst280_decode.f90 + lib/fst240_decode.f90 lib/jt9_decode.f90 lib/options.f90 lib/packjt.f90 @@ -596,22 +596,16 @@ set (wsjt_FSRCS lib/wqencode.f90 lib/wspr_downsample.f90 lib/zplot9.f90 - lib/fst280/bpdecode280_101.f90 - lib/fst280/bpdecode280_74.f90 - lib/fst280/decode280_101.f90 - lib/fst280/decode280_74.f90 - lib/fst280/encode280_101.f90 - lib/fst280/encode280_74.f90 - lib/fst280/fst280d.f90 - lib/fst280/fst280sim.f90 - lib/fst280/gen_fst280wave.f90 - lib/fst280/genfst280.f90 - lib/fst280/get_fst280_bitmetrics.f90 - lib/fst280/ldpcsim280_101.f90 - lib/fst280/ldpcsim280_74.f90 - lib/fst280/osd280_101.f90 - lib/fst280/osd280_74.f90 - lib/fst280/get_crc24.f90 + lib/fst240/bpdecode240_101.f90 + lib/fst240/decode240_101.f90 + lib/fst240/encode240_101.f90 + lib/fst240/fst240sim.f90 + lib/fst240/gen_fst240wave.f90 + lib/fst240/genfst240.f90 + lib/fst240/get_fst240_bitmetrics.f90 + lib/fst240/ldpcsim240_101.f90 + lib/fst240/osd240_101.f90 + lib/fst240/get_crc24.f90 ) # temporary workaround for a gfortran v7.3 ICE on Fedora 27 64-bit @@ -1368,17 +1362,11 @@ target_link_libraries (ft4sim_mult wsjt_fort wsjt_cxx) add_executable (record_time_signal Audio/tools/record_time_signal.cpp) target_link_libraries (record_time_signal wsjt_cxx wsjt_qtmm wsjt_qt) -add_executable (fst280d lib/fst280/fst280d.f90 wsjtx.rc) -target_link_libraries (fst280d wsjt_fort wsjt_cxx) +add_executable (fst240sim lib/fst240/fst240sim.f90 wsjtx.rc) +target_link_libraries (fst240sim wsjt_fort wsjt_cxx) -add_executable (fst280sim lib/fst280/fst280sim.f90 wsjtx.rc) -target_link_libraries (fst280sim wsjt_fort wsjt_cxx) - -add_executable (ldpcsim280_101 lib/fst280/ldpcsim280_101.f90 wsjtx.rc) -target_link_libraries (ldpcsim280_101 wsjt_fort wsjt_cxx) - -add_executable (ldpcsim280_74 lib/fst280/ldpcsim280_74.f90 wsjtx.rc) -target_link_libraries (ldpcsim280_74 wsjt_fort wsjt_cxx) +add_executable (ldpcsim240_101 lib/fst240/ldpcsim240_101.f90 wsjtx.rc) +target_link_libraries (ldpcsim240_101 wsjt_fort wsjt_cxx) endif(WSJT_BUILD_UTILS) diff --git a/lib/decoder.f90 b/lib/decoder.f90 index b51a3f906..dee9044de 100644 --- a/lib/decoder.f90 +++ b/lib/decoder.f90 @@ -8,7 +8,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample) use jt9_decode use ft8_decode use ft4_decode - use fst280_decode + use fst240_decode include 'jt9com.f90' include 'timer_common.inc' @@ -33,9 +33,9 @@ subroutine multimode_decoder(ss,id2,params,nfsample) integer :: decoded end type counting_ft4_decoder - type, extends(fst280_decoder) :: counting_fst280_decoder + type, extends(fst240_decoder) :: counting_fst240_decoder integer :: decoded - end type counting_fst280_decoder + end type counting_fst240_decoder real ss(184,NSMAX) logical baddata,newdat65,newdat9,single_decode,bVHF,bad0,newdat,ex @@ -53,7 +53,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample) type(counting_jt9_decoder) :: my_jt9 type(counting_ft8_decoder) :: my_ft8 type(counting_ft4_decoder) :: my_ft4 - type(counting_fst280_decoder) :: my_fst280 + type(counting_fst240_decoder) :: my_fst240 !cast C character arrays to Fortran character strings datetime=transfer(params%datetime, datetime) @@ -68,7 +68,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample) my_jt9%decoded = 0 my_ft8%decoded = 0 my_ft4%decoded = 0 - my_fst280%decoded = 0 + my_fst240%decoded = 0 ! For testing only: return Rx messages stored in a file as decodes inquire(file='rx_messages.txt',exist=ex) @@ -187,14 +187,14 @@ subroutine multimode_decoder(ss,id2,params,nfsample) go to 800 endif - if(params%nmode.eq.280) then -! We're in FST280/FST280W mode - call timer('dec280 ',0) - call my_fst280%decode(fst280_decoded,id2,params%nutc, & + if(params%nmode.eq.240) then +! We're in FST240/FST240W mode + call timer('dec240 ',0) + call my_fst240%decode(fst240_decoded,id2,params%nutc, & params%nQSOProgress,params%nfqso,params%nfa,params%nfb, & params%nsubmode,params%ndepth,params%ntr,params%nexp_decode, & params%ntol) - call timer('dec280 ',1) + call timer('dec240 ',1) go to 800 endif @@ -317,7 +317,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample) ! JT65 is not yet producing info for nsynced, ndecoded. 800 ndecoded = my_jt4%decoded + my_jt65%decoded + my_jt9%decoded + & - my_ft8%decoded + my_ft4%decoded + my_fst280%decoded + my_ft8%decoded + my_ft4%decoded + my_fst240%decoded if(params%nmode.eq.8 .and. params%nzhsym.eq.41) ndec41=ndecoded if(params%nmode.eq.8 .and. params%nzhsym.eq.47) ndec47=ndecoded if(params%nmode.eq.8 .and. params%nzhsym.eq.50) then @@ -679,13 +679,13 @@ contains return end subroutine ft4_decoded - subroutine fst280_decoded (this,nutc,sync,nsnr,dt,freq,decoded,nap, & + subroutine fst240_decoded (this,nutc,sync,nsnr,dt,freq,decoded,nap, & qual,ntrperiod) - use fst280_decode + use fst240_decode implicit none - class(fst280_decoder), intent(inout) :: this + class(fst240_decoder), intent(inout) :: this integer, intent(in) :: nutc real, intent(in) :: sync integer, intent(in) :: nsnr @@ -709,23 +709,23 @@ contains write(*,1001) nutc,nsnr,dt,nint(freq),decoded0,annot 1001 format(i6.6,i4,f5.1,i5,' ` ',1x,a37,1x,a2) write(13,1002) nutc,nint(sync),nsnr,dt,freq,0,decoded0 -1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FST280') +1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FST240') else write(*,1003) nutc,nsnr,dt,nint(freq),decoded0,annot 1003 format(i4.4,i4,f5.1,i5,' ` ',1x,a37,1x,a2) write(13,1004) nutc,nint(sync),nsnr,dt,freq,0,decoded0 -1004 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a37,' FST280') +1004 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a37,' FST240') endif call flush(6) call flush(13) select type(this) - type is (counting_fst280_decoder) + type is (counting_fst240_decoder) this%decoded = this%decoded + 1 end select return - end subroutine fst280_decoded + end subroutine fst240_decoded end subroutine multimode_decoder diff --git a/lib/fsk4hf/.DS_Store b/lib/fsk4hf/.DS_Store new file mode 100644 index 000000000..5008ddfcf Binary files /dev/null and b/lib/fsk4hf/.DS_Store differ diff --git a/lib/fst240/bpdecode240_101.f90 b/lib/fst240/bpdecode240_101.f90 new file mode 100644 index 000000000..1e2adbb68 --- /dev/null +++ b/lib/fst240/bpdecode240_101.f90 @@ -0,0 +1,111 @@ +subroutine bpdecode240_101(llr,apmask,maxiterations,message101,cw,nharderror,iter,ncheck) +! +! A log-domain belief propagation decoder for the (240,101) code. +! + integer, parameter:: N=240, K=101, M=N-K + integer*1 cw(N),apmask(N) + integer*1 decoded(K) + integer*1 message101(101) + integer nrw(M),ncw + integer Nm(6,M) + integer Mn(3,N) ! 3 checks per bit + integer synd(M) + real tov(3,N) + real toc(6,M) + real tanhtoc(6,M) + real zn(N) + real llr(N) + real Tmn + + include "ldpc_240_101_parity.f90" + + decoded=0 + toc=0 + tov=0 + tanhtoc=0 +! initialize messages to checks + do j=1,M + do i=1,nrw(j) + toc(i,j)=llr((Nm(i,j))) + enddo + enddo + + ncnt=0 + nclast=0 + do iter=0,maxiterations +! Update bit log likelihood ratios (tov=0 in iteration 0). + do i=1,N + if( apmask(i) .ne. 1 ) then + zn(i)=llr(i)+sum(tov(1:ncw,i)) + else + zn(i)=llr(i) + endif + enddo + +! Check to see if we have a codeword (check before we do any iteration). + cw=0 + where( zn .gt. 0. ) cw=1 + ncheck=0 + do i=1,M + synd(i)=sum(cw(Nm(1:nrw(i),i))) + if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1 +! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied' + enddo + if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it + decoded=cw(1:101) + call get_crc24(decoded,101,nbadcrc) + nharderror=count( (2*cw-1)*llr .lt. 0.0 ) + if(nbadcrc.eq.0) then + message101=decoded(1:101) + return + endif + endif + + if( iter.gt.0 ) then ! this code block implements an early stopping criterion +! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion + nd=ncheck-nclast + if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased + ncnt=0 ! reset counter + else + ncnt=ncnt+1 + endif +! write(*,*) iter,ncheck,nd,ncnt + if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then + nharderror=-1 + return + endif + endif + nclast=ncheck + +! Send messages from bits to check nodes + do j=1,M + do i=1,nrw(j) + ibj=Nm(i,j) + toc(i,j)=zn(ibj) + do kk=1,ncw ! subtract off what the bit had received from the check + if( Mn(kk,ibj) .eq. j ) then + toc(i,j)=toc(i,j)-tov(kk,ibj) + endif + enddo + enddo + enddo + +! send messages from check nodes to variable nodes + do i=1,M + tanhtoc(1:6,i)=tanh(-toc(1:6,i)/2) + enddo + + do j=1,N + do i=1,ncw + ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j + Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j) + call platanh(-Tmn,y) +! y=atanh(-Tmn) + tov(i,j)=2*y + enddo + enddo + + enddo + nharderror=-1 + return +end subroutine bpdecode240_101 diff --git a/lib/fst280/bpdecode280_101.f90 b/lib/fst240/bpdecode280_101.f90 similarity index 100% rename from lib/fst280/bpdecode280_101.f90 rename to lib/fst240/bpdecode280_101.f90 diff --git a/lib/fst280/bpdecode280_74.f90 b/lib/fst240/bpdecode280_74.f90 similarity index 100% rename from lib/fst280/bpdecode280_74.f90 rename to lib/fst240/bpdecode280_74.f90 diff --git a/lib/fst240/decode240_101.f90 b/lib/fst240/decode240_101.f90 new file mode 100644 index 000000000..80e42eeb0 --- /dev/null +++ b/lib/fst240/decode240_101.f90 @@ -0,0 +1,154 @@ +subroutine decode240_101(llr,Keff,maxosd,norder,apmask,message101,cw,ntype,nharderror,dmin) +! +! A hybrid bp/osd decoder for the (240,101) code. +! +! maxosd<0: do bp only +! maxosd=0: do bp and then call osd once with channel llrs +! maxosd>1: do bp and then call osd maxosd times with saved bp outputs +! norder : osd decoding depth +! + integer, parameter:: N=240, K=101, M=N-K + integer*1 cw(N),apmask(N) + integer*1 nxor(N),hdec(N) + integer*1 message101(101),m101(101) + integer nrw(M),ncw + integer Nm(6,M) + integer Mn(3,N) ! 3 checks per bit + integer synd(M) + real tov(3,N) + real toc(6,M) + real tanhtoc(6,M) + real zn(N),zsum(N),zsave(N,3) + real llr(N) + real Tmn + + include "ldpc_240_101_parity.f90" + + maxiterations=30 + nosd=0 + if(maxosd.gt.3) maxosd=3 + if(maxosd.eq.0) then ! osd with channel llrs + nosd=1 + zsave(:,1)=llr + elseif(maxosd.gt.0) then ! + nosd=maxosd + elseif(maxosd.lt.0) then ! just bp + nosd=0 + endif + + toc=0 + tov=0 + tanhtoc=0 +! initialize messages to checks + do j=1,M + do i=1,nrw(j) + toc(i,j)=llr((Nm(i,j))) + enddo + enddo + + ncnt=0 + nclast=0 + zsum=0.0 + do iter=0,maxiterations +! Update bit log likelihood ratios (tov=0 in iteration 0). + do i=1,N + if( apmask(i) .ne. 1 ) then + zn(i)=llr(i)+sum(tov(1:ncw,i)) + else + zn(i)=llr(i) + endif + enddo + zsum=zsum+zn + if(iter.gt.0 .and. iter.le.maxosd) then + zsave(:,iter)=zsum + endif + +! Check to see if we have a codeword (check before we do any iteration). + cw=0 + where( zn .gt. 0. ) cw=1 + ncheck=0 + do i=1,M + synd(i)=sum(cw(Nm(1:nrw(i),i))) + if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1 + enddo + if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it + m101=0 + m101(1:101)=cw(1:101) + call get_crc24(m101,101,nbadcrc) + if(nbadcrc.eq.0) then + message101=cw(1:101) + hdec=0 + where(llr .ge. 0) hdec=1 + nxor=ieor(hdec,cw) + nharderror=sum(nxor) + dmin=sum(nxor*abs(llr)) + ntype=1 + return + endif + endif + + if( iter.gt.0 ) then ! this code block implements an early stopping criterion +! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion + nd=ncheck-nclast + if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased + ncnt=0 ! reset counter + else + ncnt=ncnt+1 + endif +! write(*,*) iter,ncheck,nd,ncnt + if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then + nharderror=-1 + exit + endif + endif + nclast=ncheck + +! Send messages from bits to check nodes + do j=1,M + do i=1,nrw(j) + ibj=Nm(i,j) + toc(i,j)=zn(ibj) + do kk=1,ncw ! subtract off what the bit had received from the check + if( Mn(kk,ibj) .eq. j ) then + toc(i,j)=toc(i,j)-tov(kk,ibj) + endif + enddo + enddo + enddo + +! send messages from check nodes to variable nodes + do i=1,M + tanhtoc(1:6,i)=tanh(-toc(1:6,i)/2) + enddo + + do j=1,N + do i=1,ncw + ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j + Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j) + call platanh(-Tmn,y) +! y=atanh(-Tmn) + tov(i,j)=2*y + enddo + enddo + + enddo ! bp iterations + + do i=1,nosd + zn=zsave(:,i) + call osd240_101(zn,Keff,apmask,norder,message101,cw,nharderror,dminosd) + if(nharderror.gt.0) then + hdec=0 + where(llr .ge. 0) hdec=1 + nxor=ieor(hdec,cw) + dmin=sum(nxor*abs(llr)) + ntype=2 + return + endif + enddo + + ntype=0 + nharderror=-1 + dminosd=0.0 + + return +end subroutine decode240_101 diff --git a/lib/fst280/decode280_101.f90 b/lib/fst240/decode280_101.f90 similarity index 100% rename from lib/fst280/decode280_101.f90 rename to lib/fst240/decode280_101.f90 diff --git a/lib/fst280/decode280_74.f90 b/lib/fst240/decode280_74.f90 similarity index 100% rename from lib/fst280/decode280_74.f90 rename to lib/fst240/decode280_74.f90 diff --git a/lib/fst240/encode240_101.f90 b/lib/fst240/encode240_101.f90 new file mode 100644 index 000000000..da0021df3 --- /dev/null +++ b/lib/fst240/encode240_101.f90 @@ -0,0 +1,46 @@ +subroutine encode240_101(message,codeword) + use, intrinsic :: iso_c_binding + use iso_c_binding, only: c_loc,c_size_t + use crc + + integer, parameter:: N=240, K=101, M=N-K + character*24 c24 + integer*1 codeword(N) + integer*1 gen(M,K) + integer*1 message(K) + integer*1 pchecks(M) + integer*4 ncrc24 + include "ldpc_240_101_generator.f90" + logical first + data first/.true./ + save first,gen + + if( first ) then ! fill the generator matrix + gen=0 + do i=1,M + do j=1,26 + read(g(i)(j:j),"(Z1)") istr + ibmax=4 + if(j.eq.26) ibmax=1 + do jj=1, ibmax + icol=(j-1)*4+jj + if( btest(istr,4-jj) ) gen(i,icol)=1 + enddo + enddo + enddo + first=.false. + endif + + do i=1,M + nsum=0 + do j=1,K + nsum=nsum+message(j)*gen(i,j) + enddo + pchecks(i)=mod(nsum,2) + enddo + + codeword(1:K)=message + codeword(K+1:N)=pchecks + + return +end subroutine encode240_101 diff --git a/lib/fst280/encode280_101.f90 b/lib/fst240/encode280_101.f90 similarity index 100% rename from lib/fst280/encode280_101.f90 rename to lib/fst240/encode280_101.f90 diff --git a/lib/fst280/encode280_74.f90 b/lib/fst240/encode280_74.f90 similarity index 100% rename from lib/fst280/encode280_74.f90 rename to lib/fst240/encode280_74.f90 diff --git a/lib/fst240/fst240_params.f90 b/lib/fst240/fst240_params.f90 new file mode 100644 index 000000000..f6204915d --- /dev/null +++ b/lib/fst240/fst240_params.f90 @@ -0,0 +1,7 @@ +! FST240 +! LDPC(240,101)/CRC24 code, five 8x4 sync + +parameter (KK=77) !Information bits (77 + CRC24) +parameter (ND=120) !Data symbols +parameter (NS=40) !Sync symbols +parameter (NN=NS+ND) !Sync and data symbols (160) diff --git a/lib/fst240/fst240sim.f90 b/lib/fst240/fst240sim.f90 new file mode 100644 index 000000000..842e32876 --- /dev/null +++ b/lib/fst240/fst240sim.f90 @@ -0,0 +1,143 @@ +program fst240sim + +! Generate simulated signals for experimental slow FT4 mode + + use wavhdr + use packjt77 + include 'fst240_params.f90' !Set various constants + type(hdr) h !Header for .wav file + character arg*12,fname*17 + character msg37*37,msgsent37*37,c77*77 + complex, allocatable :: c0(:) + complex, allocatable :: c(:) + real, allocatable :: wave(:) + integer hmod + integer itone(NN) + integer*1 msgbits(101) + integer*2, allocatable :: iwave(:) !Generated full-length waveform + +! Get command-line argument(s) + nargs=iargc() + if(nargs.ne.9) then + print*,'Need 9 arguments, got ',nargs + print*,'Usage: fst240sim "message" TRsec f0 DT h fdop del nfiles snr' + print*,'Examples: fst240sim "K1JT K9AN EN50" 60 1500 0.0 1 0.1 1.0 10 -15' + go to 999 + endif + call getarg(1,msg37) !Message to be transmitted + call getarg(2,arg) + read(arg,*) nsec !TR sequence length, seconds + call getarg(3,arg) + read(arg,*) f00 !Frequency (only used for single-signal) + call getarg(4,arg) + read(arg,*) xdt !Time offset from nominal (s) + call getarg(5,arg) + read(arg,*) hmod !Modulation index, h + call getarg(6,arg) + read(arg,*) fspread !Watterson frequency spread (Hz) + call getarg(7,arg) + read(arg,*) delay !Watterson delay (ms) + call getarg(8,arg) + read(arg,*) nfiles !Number of files + call getarg(9,arg) + read(arg,*) snrdb !SNR_2500 + + nfiles=abs(nfiles) + twopi=8.0*atan(1.0) + fs=12000.0 !Sample rate (Hz) + dt=1.0/fs !Sample interval (s) + nsps=0 + if(nsec.eq.15) nsps=800 + if(nsec.eq.30) nsps=1680 + if(nsec.eq.60) nsps=3888 + if(nsec.eq.120) nsps=8200 + if(nsec.eq.300) nsps=21168 + if(nsps.eq.0) then + print*,'Invalid TR sequence length.' + go to 999 + endif + baud=12000.0/nsps !Keying rate (baud) + nmax=nsec*12000 + nz=nsps*NN + nz2=nsps*NN2 + txt=nz2*dt !Transmission length (s) + tt=nsps*dt !Duration of symbols (s) + allocate( c0(0:nmax-1) ) + allocate( c(0:nmax-1) ) + allocate( wave(nmax) ) + allocate( iwave(nmax) ) + + bandwidth_ratio=2500.0/(fs/2.0) + sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb) + if(snrdb.gt.90.0) sig=1.0 + + i3=-1 + n3=-1 + call pack77(msg37,i3,n3,c77) + call genfst240(msg37,0,msgsent37,msgbits,itone,iwspr) + + write(*,*) + write(*,'(a9,a37)') 'Message: ',msgsent37 + write(*,1000) f00,xdt,hmod,txt,snrdb +1000 format('f0:',f9.3,' DT:',f6.2,' hmod:',i6,' TxT:',f6.1,' SNR:',f6.1) + write(*,*) + if(i3.eq.1) then + write(*,*) ' mycall hiscall hisgrid' + write(*,'(28i1,1x,i1,1x,28i1,1x,i1,1x,i1,1x,15i1,1x,3i1)') msgbits(1:77) + else + write(*,'(a14)') 'Message bits: ' + write(*,'(50i1,1x,24i1)') msgbits + endif + write(*,*) + write(*,'(a17)') 'Channel symbols: ' + write(*,'(10i1)') itone + write(*,*) + +! call sgran() + + fsample=12000.0 + icmplx=1 + f0=f00+1.5*hmod*baud + call gen_fst240wave(itone,NN,nsps,nmax,fsample,hmod,f0,icmplx,c0,wave) + k=nint(xdt/dt) + c0=cshift(c0,-k) + if(k.gt.0) c0(0:k-1)=0.0 + if(k.lt.0) c0(nmax+k:nmax-1)=0.0 + + do ifile=1,nfiles + c=c0 + if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c,nmax,NZ,fs,delay,fspread) + c=sig*c + wave=real(c) + if(snrdb.lt.90) then + do i=1,nmax !Add gaussian noise at specified SNR + xnoise=gran() + wave(i)=wave(i) + xnoise + enddo + endif + gain=100.0 + if(snrdb.lt.90.0) then + wave=gain*wave + else + datpk=maxval(abs(wave)) + fac=32766.9/datpk + wave=fac*wave + endif + if(any(abs(wave).gt.32767.0)) print*,"Warning - data will be clipped." + iwave=nint(wave) + h=default_header(12000,nmax) + if(nmax/12000.le.30) then + write(fname,1102) ifile +1102 format('000000_',i6.6,'.wav') + else + write(fname,1104) ifile +1104 format('000000_',i4.4,'.wav') + endif + open(10,file=trim(fname),status='unknown',access='stream') + write(10) h,iwave !Save to *.wav file + close(10) + write(*,1110) ifile,xdt,f00,snrdb,fname +1110 format(i4,f7.2,f8.2,f7.1,2x,a17) + enddo + +999 end program fst240sim diff --git a/lib/fst280/fst280.txt b/lib/fst240/fst280.txt similarity index 100% rename from lib/fst280/fst280.txt rename to lib/fst240/fst280.txt diff --git a/lib/fst280/fst280_params.f90 b/lib/fst240/fst280_params.f90 similarity index 100% rename from lib/fst280/fst280_params.f90 rename to lib/fst240/fst280_params.f90 diff --git a/lib/fst280/fst280d.f90 b/lib/fst240/fst280d.f90 similarity index 100% rename from lib/fst280/fst280d.f90 rename to lib/fst240/fst280d.f90 diff --git a/lib/fst280/fst280sim.f90 b/lib/fst240/fst280sim.f90 similarity index 100% rename from lib/fst280/fst280sim.f90 rename to lib/fst240/fst280sim.f90 diff --git a/lib/fst240/gen_fst240wave.f90 b/lib/fst240/gen_fst240wave.f90 new file mode 100644 index 000000000..3005968b2 --- /dev/null +++ b/lib/fst240/gen_fst240wave.f90 @@ -0,0 +1,98 @@ +subroutine gen_fst240wave(itone,nsym,nsps,nwave,fsample,hmod,f0, & + icmplx,cwave,wave) + + parameter(NTAB=65536) + real wave(nwave) + complex cwave(nwave),ctab(0:NTAB-1) + real, allocatable, save :: pulse(:) + real, allocatable :: dphi(:) + integer hmod + integer itone(nsym) +! integer*8 count0,count1,clkfreq + logical first + data first/.true./ + data nsps0/-99/ + save first,twopi,dt,tsym,nsps0,ctab + +! call system_clock(count0,clkfreq) + if(first) then + twopi=8.0*atan(1.0) + do i=0,NTAB-1 + phi=i*twopi/NTAB + ctab(i)=cmplx(cos(phi),sin(phi)) + enddo + endif + + if(first.or.nsps.ne.nsps0) then + if(allocated(pulse)) deallocate(pulse) + allocate(pulse(1:3*nsps)) + dt=1.0/fsample + tsym=nsps/fsample +! Compute the smoothed frequency-deviation pulse + do i=1,3*nsps + tt=(i-1.5*nsps)/real(nsps) + pulse(i)=gfsk_pulse(2.0,tt) + enddo + first=.false. + nsps0=nsps + endif + +! Compute the smoothed frequency waveform. +! Length = (nsym+2)*nsps samples, zero-padded + allocate( dphi(0:(nsym+2)*nsps-1) ) + dphi_peak=twopi*hmod/real(nsps) + dphi=0.0 + do j=1,nsym + ib=(j-1)*nsps + ie=ib+3*nsps-1 + dphi(ib:ie) = dphi(ib:ie) + dphi_peak*pulse(1:3*nsps)*itone(j) + enddo + +! Calculate and insert the audio waveform + phi=0.0 + dphi = dphi + twopi*(f0-1.5*hmod/tsym)*dt !Shift frequency up by f0 + if(icmplx.eq.0) wave=0. + if(icmplx.eq.1) cwave=0. + k=0 + do j=0,(nsym+2)*nsps-1 + k=k+1 + i=phi*float(NTAB)/twopi + i=iand(i,NTAB-1) + if(icmplx.eq.0) then + wave(k)=real(ctab(i)) + else + cwave(k)=ctab(i) + endif + phi=phi+dphi(j) + if(phi.gt.twopi) phi=phi-twopi + enddo + +! Compute the ramp-up and ramp-down symbols + kshift=nsps-nint(fsample) + if(icmplx.eq.0) then + wave(1:nsps)=0.0 + wave(nsps+1:nsps+nsps/4)=wave(nsps+1:nsps+nsps/4) * & + (1.0-cos(twopi*(/(i,i=0,nsps/4-1)/)/real(nsps/2)))/2.0 + k1=nsym*nsps+3*nsps/4 + wave((nsym+1)*nsps+1:)=0.0 + wave(k1:k1+nsps/4-1)=wave(k1:k1+nsps/4-1) * & + (1.0+cos(twopi*(/(i,i=0,nsps/4-1)/)/real(nsps/2)))/2.0 + wave=cshift(wave,kshift) + else + cwave(1:nsps)=0.0 + cwave(nsps+1:nsps+nsps/4)=cwave(nsps+1:nsps+nsps/4) * & + (1.0-cos(twopi*(/(i,i=0,nsps/4-1)/)/real(nsps/2)))/2.0 + k1=nsym*nsps+3*nsps/4 + cwave((nsym+1)*nsps+1:)=0.0 + cwave(k1:k1+nsps/4-1)=cwave(k1:k1+nsps/4-1) * & + (1.0+cos(twopi*(/(i,i=0,nsps/4-1)/)/real(nsps/2)))/2.0 + cwave=cshift(cwave,kshift) + endif + +! call system_clock(count1,clkfreq) +! tt=float(count1-count0)/float(clkfreq) +! write(*,3001) tt +!3001 format('Tgen:',f8.3) + + return +end subroutine gen_fst240wave diff --git a/lib/fst280/gen_fst280wave.f90 b/lib/fst240/gen_fst280wave.f90 similarity index 100% rename from lib/fst280/gen_fst280wave.f90 rename to lib/fst240/gen_fst280wave.f90 diff --git a/lib/fst240/genfst240.f90 b/lib/fst240/genfst240.f90 new file mode 100644 index 000000000..4cf688308 --- /dev/null +++ b/lib/fst240/genfst240.f90 @@ -0,0 +1,101 @@ +subroutine genfst240(msg0,ichk,msgsent,msgbits,i4tone,iwspr) + +! Input: +! - msg0 requested message to be transmitted +! - ichk if ichk=1, return only msgsent +! - msgsent message as it will be decoded +! - i4tone array of audio tone values, {0,1,2,3} +! - iwspr 0: (240,101)/crc24, 1: (240,74)/crc24 +! +! Frame structure: +! s8 d30 s8 d30 s8 d30 s8 d30 s8 + + use packjt77 + include 'fst240_params.f90' + character*37 msg0 + character*37 message !Message to be generated + character*37 msgsent !Message as it will be received + character*77 c77 + character*24 c24 + integer*4 i4tone(NN),itmp(ND) + integer*1 codeword(2*ND) + integer*1 msgbits(101),rvec(77) + integer isyncword(8) + integer ncrc24 + logical unpk77_success + data isyncword/0,1,3,2,1,0,2,3/ + data rvec/0,1,0,0,1,0,1,0,0,1,0,1,1,1,1,0,1,0,0,0,1,0,0,1,1,0,1,1,0, & + 1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,1,0,1,0,0,1,1,1,1,0,0,1,0,1, & + 0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/ + message=msg0 + + do i=1, 37 + if(ichar(message(i:i)).eq.0) then + message(i:37)=' ' + exit + endif + enddo + do i=1,37 !Strip leading blanks + if(message(1:1).ne.' ') exit + message=message(i+1:) + enddo + + i3=-1 + n3=-1 + call pack77(message,i3,n3,c77) + call unpack77(c77,0,msgsent,unpk77_success) !Unpack to get msgsent + msgbits=0 + iwspr=0 + if(i3.eq.0.and.n3.eq.6) then + iwspr=1 + read(c77,'(50i1)') msgbits(1:50) + call get_crc24(msgbits,74,ncrc24) + write(c24,'(b24.24)') ncrc24 + read(c24,'(24i1)') msgbits(51:74) + else + read(c77,'(77i1)') msgbits(1:77) + call get_crc24(msgbits,101,ncrc24) + write(c24,'(b24.24)') ncrc24 + read(c24,'(24i1)') msgbits(78:101) + endif + + if(ichk.eq.1) go to 999 + if(unpk77_success) go to 2 +1 msgbits=0 + itone=0 + msgsent='*** bad message *** ' + go to 999 + + entry get_fst240_tones_from_bits(msgbits,i4tone,iwspr) + +2 continue + + call encode240_101(msgbits,codeword) + +! Grayscale mapping: +! bits tone +! 00 0 +! 01 1 +! 11 2 +! 10 3 + + do i=1,ND + is=codeword(2*i)+2*codeword(2*i-1) + if(is.le.1) itmp(i)=is + if(is.eq.2) itmp(i)=3 + if(is.eq.3) itmp(i)=2 + enddo + + i4tone( 1: 8)=isyncword + i4tone( 9: 38)=itmp( 1: 30) + i4tone( 39: 46)=isyncword + i4tone( 47: 76)=itmp( 31: 60) + i4tone( 77: 84)=isyncword + i4tone( 85:114)=itmp( 61: 90) + i4tone(115:122)=isyncword + i4tone(123:152)=itmp( 91:120) + i4tone(153:160)=isyncword + +999 return + +end subroutine genfst240 diff --git a/lib/fst280/genfst280.f90 b/lib/fst240/genfst280.f90 similarity index 100% rename from lib/fst280/genfst280.f90 rename to lib/fst240/genfst280.f90 diff --git a/lib/fst280/get_crc24.f90 b/lib/fst240/get_crc24.f90 similarity index 100% rename from lib/fst280/get_crc24.f90 rename to lib/fst240/get_crc24.f90 diff --git a/lib/fst240/get_fst240_bitmetrics.f90 b/lib/fst240/get_fst240_bitmetrics.f90 new file mode 100644 index 000000000..ddefbad68 --- /dev/null +++ b/lib/fst240/get_fst240_bitmetrics.f90 @@ -0,0 +1,123 @@ +subroutine get_fst240_bitmetrics(cd,nss,hmod,nmax,bitmetrics,s4,badsync) + + include 'fst240_params.f90' + complex cd(0:NN*nss-1) + complex cs(0:3,NN) + complex csymb(nss) + complex, allocatable, save :: c1(:,:) ! ideal waveforms, 20 samples per symbol, 4 tones + complex cp(0:3) ! accumulated phase shift over symbol types 0:3 + complex csum,cterm + integer icos8(0:7) + integer graymap(0:3) + integer ip(1) + integer hmod + logical one(0:65535,0:15) ! 65536 8-symbol sequences, 16 bits + logical first + logical badsync + real bitmetrics(2*NN,4) + real s2(0:65535) + real s4(0:3,NN) + data icos8/0,1,3,2,1,0,2,3/ + data graymap/0,1,3,2/ + data first/.true./,nss0/-1/ + save first,one,cp,nss0 + + if(nss.ne.nss0 .and. allocated(c1)) deallocate(c1) + if(first .or. nss.ne.nss0) then + allocate(c1(nss,0:3)) + one=.false. + do i=0,65535 + do j=0,15 + if(iand(i,2**j).ne.0) one(i,j)=.true. + enddo + enddo + twopi=8.0*atan(1.0) + dphi=twopi*hmod/nss + do itone=0,3 + dp=(itone-1.5)*dphi + phi=0.0 + do j=1,nss + c1(j,itone)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dp,twopi) + enddo + cp(itone)=cmplx(cos(phi),sin(phi)) + enddo + first=.false. + endif + + do k=1,NN + i1=(k-1)*NSS + csymb=cd(i1:i1+NSS-1) + do itone=0,3 + cs(itone,k)=sum(csymb*conjg(c1(:,itone))) + enddo + s4(0:3,k)=abs(cs(0:3,k)) + enddo + +! Sync quality check + is1=0 + is2=0 + is3=0 + badsync=.false. + ibmax=0 + + do k=1,8 + ip=maxloc(s4(:,k)) + if(icos8(k-1).eq.(ip(1)-1)) is1=is1+1 + ip=maxloc(s4(:,k+38)) + if(icos8(k-1).eq.(ip(1)-1)) is2=is2+1 + ip=maxloc(s4(:,k+76)) + if(icos8(k-1).eq.(ip(1)-1)) is3=is3+1 + ip=maxloc(s4(:,k+114)) + if(icos8(k-1).eq.(ip(1)-1)) is4=is4+1 + ip=maxloc(s4(:,k+152)) + if(icos8(k-1).eq.(ip(1)-1)) is5=is5+1 + enddo + nsync=is1+is2+is3+is4+is5 !Number of correct hard sync symbols, 0-40 + + badsync=.false. + if(nsync .lt. 8) then + badsync=.true. + return + endif + + bitmetrics=0.0 + do nseq=1,nmax !Try coherent sequences of 1, 2, and 4 symbols + if(nseq.eq.1) nsym=1 + if(nseq.eq.2) nsym=2 + if(nseq.eq.3) nsym=4 + if(nseq.eq.4) nsym=8 + nt=4**nsym + do ks=1,NN-nsym+1,nsym + s2=0 + do i=0,nt-1 + csum=0 + cterm=1 + do j=0,nsym-1 + ntone=mod(i/4**(nsym-1-j),4) + csum=csum+cs(graymap(ntone),ks+j)*cterm + cterm=cterm*conjg(cp(graymap(ntone))) + enddo + s2(i)=abs(csum) + enddo + ipt=1+(ks-1)*2 + if(nsym.eq.1) ibmax=1 + if(nsym.eq.2) ibmax=3 + if(nsym.eq.4) ibmax=7 + if(nsym.eq.8) ibmax=15 + do ib=0,ibmax + bm=maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)) - & + maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib)) + if(ipt+ib.gt.2*NN) cycle + bitmetrics(ipt+ib,nseq)=bm + enddo + 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) + return + +end subroutine get_fst240_bitmetrics diff --git a/lib/fst280/get_fst280_bitmetrics.f90 b/lib/fst240/get_fst280_bitmetrics.f90 similarity index 100% rename from lib/fst280/get_fst280_bitmetrics.f90 rename to lib/fst240/get_fst280_bitmetrics.f90 diff --git a/lib/fst240/ldpc_240_101_generator.f90 b/lib/fst240/ldpc_240_101_generator.f90 new file mode 100644 index 000000000..782e0a211 --- /dev/null +++ b/lib/fst240/ldpc_240_101_generator.f90 @@ -0,0 +1,142 @@ +character*26 g(139) + +data g/ & + "e28df133efbc554bcd30eb1828", & + "b1adf97787f81b4ac02e0caff8", & + "e70c43adce5036f847af367560", & + "c26663f7f7acafdf5abacb6f30", & + "eba93204ddfa3bcf994aea8998", & + "126b51e33c6a740afa0d5ce990", & + "b41a1569e6fede1f2f5395cb68", & + "1d3af0bb43fddbc670a291cc70", & + "e0aebd9921e2c9e1d453ffccb0", & + "897d1370f0df94b8b27a5e4fb8", & + "5e97539338003b13fa8198ad38", & + "7276b87da4a4d777e2752fdd48", & + "989888bd3a85835e2bc6a560f8", & + "7ec4f4a56199ab0a8d6e102478", & + "207007665090258782d1b38a98", & + "1ea1f61cd7f0b7eed7dd346ab8", & + "08f150b27c7f18a027783de0e8", & + "d42324a4e21b62d548d7865858", & + "2e029656269d4fe46e167d21d0", & + "7d84acb7737b0ca6b6f2ef5eb0", & + "6674ca04528ad4782bf5e15248", & + "118ce9825f563ae4963af7a0b0", & + "fb06248cc985e314b1b36ccd38", & + "1c478b7a5aec7e1cfc9c24eb70", & + "185a0f06a84f7f4f484c455020", & + "98b840a3a70688cd58588e3e30", & + "cfb7719de83a3baf582e5b2aa0", & + "9d8cc6b5a01fdbfa307a769048", & + "ed776a728ca162d6fcc8996760", & + "8d2b068128dfb2f8d22c79db50", & + "bd2ba50007789ffb7324aa9190", & + "fd95008fe88812025e78065610", & + "3027849be8e99f9ef68eac1020", & + "88574e1ea39d87414b15e803a8", & + "89365b330e76e6dde740dced08", & + "c83f37b913ed0f6b802aaf21d8", & + "bdca7c1959caa7488b7eb13030", & + "794e0b4888e1ef42992287dd98", & + "526ac87fbaa790c6cd58864e08", & + "940518ba1a51c1da55bc8b2d70", & + "59c5e51ebfbd02ab30ff822378", & + "c81fff87866e04f8f3948c7f10", & + "7913513f3e2a3c0f76b69f6d68", & + "e43cc04da189c44803c4f740a0", & + "fdca7c1959ca85488b7eb13030", & + "95b07fce9b7b1bf4f057ca61b8", & + "d7db48a86691a0c0c9305aac90", & + "0d50bf79a59464597c43ba8058", & + "4a9c34b23fd5eaff8c9dc215e0", & + "3d5305a6f0427938eeb9d1c118", & + "55d8b6b58039f7a3a2d592a900", & + "784f349ecb74c4abbdbb073b90", & + "5973bbb2205f9d6a5c9a55c238", & + "5d2ee61006fec94f69f6b0f460", & + "9e1f52ef1e6589990dd0ce0cc8", & + "85b7b48f4b45775c9f8a36cc90", & + "ae1d6a0171168f6d70804b79f8", & + "a467aa9aa6cdc7094677c730d8", & + "dcf2f56c9ae20fb57e89b916d0", & + "3ae98d26ae96ea714c1a5146d0", & + "103c89581446805b8c71b2e638", & + "6783f3dfec835dd4e92131cc20", & + "52f88428c50f12c55876f7d8a8", & + "51fcb0e56a22fa3b7140aeaa80", & + "07c54871155603e65325f66cd8", & + "a8dd4fac47a113ee5706eef180", & + "f6cdc6f4cc1fa7e4db15bf86f8", & + "2e1c6a0171168f6d70c04a79f8", & + "2a90ab82bef6424db981752dc8", & + "845a1db59c193249d937e889d0", & + "a929d379f1769cb4baa4e41e90", & + "0c2a5829548d82223d6f566d48", & + "420087bc5c4e2f5bc139ad0220", & + "6df8d880ae7209fe52c69ede00", & + "dfbdcef29a985fd40d052d1a88", & + "8567fc332342b1ed8408f5fa00", & + "c908feb4e1866a24ca0c702a08", & + "645f5ee59f9f64fd43a5f2ec30", & + "bee56991e877baf3e9cf11b770", & + "649ea2e4194ca51be28abf3430", & + "90e7394c551bd58d00686d5420", & + "4e3cf731f8f89e8414214afaf0", & + "dcbf16aa8180a7712571e94f98", & + "9b456c015999c52b7fbd1ab390", & + "397ab76924659c4b8b3be4ac58", & + "4f5038c4f9da4b02bdfa178278", & + "4892fada978c98dd4fd363c450", & + "6c8af64b426bc474431c110c98", & + "84a553be5ef0e57390a5af05b0", & + "bed4a9347c9a2064f6d63ac0f8", & + "d973bbb2605f9d6a5c9a57c238", & + "1e3bee9a99fe10d3864ee669d8", & + "a590771ff185d807cb32f46000", & + "9a498fc4b549d81c625f80fc90", & + "28b3e72878aadee7e0e2617950", & + "96ce025d621a91396aa8f3ec20", & + "4f5a77becf838a590d6d406ea8", & + "52d3856dfb9fe78012f10e25c0", & + "b45323c2b28b4752ca0675d2e0", & + "3bae5a8452a785beb35851ad18", & + "65098832d20d915e75bea336e8", & + "5eb6f3c331098e8c0fbfa3aee0", & + "ef19d974a25540c8998fbf1df0", & + "403ea58feff08cf92d5cacc780", & + "6ba93204ddfa7bcb994aea8998", & + "653909166aa7bead4bd9c90020", & + "089cb20e639bc5a44da66f17c0", & + "10f803949961359e994f5ade88", & + "15b7ec1e6106cd55ef7d996590", & + "c99e99de9d85d2b999a17a95d8", & + "ca3e161b97148bac6dd28a6178", & + "e1ab199c992cb4c22aee115358", & + "ea8a4d0e96d3d9f827899b6d88", & + "8af4992d60223f021569a8ab60", & + "5087771abceb87a6d872291fe8", & + "d045e0812e217bb7bbdac92f30", & + "ccccd78ae5fa6e191f21c06908", & + "54545f37df6fed4734ef6509b0", & + "b0780327d899cbc03d95a81a48", & + "a4229c31f2b85e44a322273d50", & + "d182ab001c2085ea7be26a20d0", & + "1a82c30b4fba7dfaafb8d287a8", & + "d974fba598e7fb0630c1587db0", & + "b5c078a8cbab3e73728659ea20", & + "626bbf9eed1a8715c3a7d38f60", & + "c1efe9aa67130865fda93d8be8", & + "d39796dbce155df6306e7b77c0", & + "c7e7c1f032d7209b4549e84aa8", & + "d5799b30a1605baf6b9cd04960", & + "0baf2d21051a926dfd87046d70", & + "da8bf7d1e305c499b573c02cc8", & + "0ccaa7fffb9ae3e42dd0688328", & + "b951b62e18f5290ac13c195130", & + "79b006f001961fb233be80d0e8", & + "56637b6dedfd6e050f06404a48", & + "e0c4bf71a15597523bbd57bde0", & + "1312231ffa04426a34a8fab038", & + "db5f6f0455d24b8358d1cbc3d8", & + "d559e31b34d21f48e1f501af30"/ diff --git a/lib/fst240/ldpc_240_101_parity.f90 b/lib/fst240/ldpc_240_101_parity.f90 new file mode 100644 index 000000000..d3c1280c6 --- /dev/null +++ b/lib/fst240/ldpc_240_101_parity.f90 @@ -0,0 +1,393 @@ +data Mn/ & + 57, 100, 134, & + 56, 99, 136, & + 1, 12, 15, & + 2, 23, 72, & + 3, 133, 137, & + 4, 93, 125, & + 5, 68, 139, & + 6, 38, 55, & + 7, 40, 78, & + 8, 30, 84, & + 9, 17, 122, & + 10, 34, 95, & + 11, 36, 138, & + 13, 90, 132, & + 14, 50, 117, & + 16, 57, 83, & + 18, 22, 121, & + 19, 60, 89, & + 20, 98, 107, & + 21, 37, 61, & + 24, 26, 75, & + 25, 88, 115, & + 27, 49, 127, & + 28, 74, 119, & + 29, 111, 114, & + 31, 91, 129, & + 32, 96, 104, & + 30, 33, 130, & + 35, 65, 135, & + 41, 42, 87, & + 44, 108, 131, & + 45, 94, 101, & + 45, 46, 97, & + 47, 102, 134, & + 48, 64, 104, & + 19, 51, 116, & + 20, 52, 67, & + 53, 104, 113, & + 12, 54, 103, & + 58, 66, 88, & + 62, 80, 124, & + 63, 70, 71, & + 73, 114, 123, & + 76, 85, 128, & + 77, 106, 109, & + 46, 79, 126, & + 61, 81, 110, & + 82, 92, 120, & + 86, 105, 112, & + 66, 100, 118, & + 23, 51, 136, & + 1, 40, 53, & + 2, 73, 81, & + 3, 63, 130, & + 4, 68, 136, & + 5, 60, 78, & + 6, 72, 131, & + 7, 115, 124, & + 8, 89, 120, & + 9, 15, 44, & + 10, 22, 93, & + 11, 49, 100, & + 13, 55, 80, & + 14, 76, 95, & + 16, 54, 111, & + 17, 41, 110, & + 18, 69, 139, & + 21, 24, 116, & + 25, 39, 71, & + 26, 69, 90, & + 27, 101, 133, & + 28, 64, 126, & + 29, 94, 103, & + 31, 56, 57, & + 32, 91, 102, & + 33, 35, 129, & + 34, 47, 128, & + 36, 86, 117, & + 37, 74, 75, & + 38, 79, 106, & + 42, 82, 123, & + 43, 77, 99, & + 48, 70, 92, & + 50, 109, 118, & + 52, 112, 119, & + 58, 62, 108, & + 59, 84, 134, & + 57, 65, 122, & + 67, 97, 113, & + 83, 127, 135, & + 85, 121, 125, & + 87, 132, 137, & + 96, 98, 105, & + 73, 107, 138, & + 1, 83, 89, & + 2, 41, 70, & + 3, 35, 131, & + 4, 111, 128, & + 5, 29, 99, & + 6, 25, 31, & + 7, 19, 96, & + 1, 39, 110, & + 2, 7, 117, & + 3, 49, 109, & + 4, 81, 96, & + 5, 100, 108, & + 6, 51, 124, & + 2, 20, 132, & + 8, 80, 137, & + 9, 56, 67, & + 10, 63, 102, & + 11, 16, 101, & + 12, 115, 122, & + 13, 32, 128, & + 14, 15, 130, & + 14, 70, 99, & + 11, 51, 69, & + 17, 89, 105, & + 18, 83, 99, & + 19, 44, 79, & + 20, 106, 133, & + 10, 21, 123, & + 22, 23, 61, & + 16, 22, 60, & + 24, 38, 114, & + 25, 37, 42, & + 26, 43, 52, & + 27, 68, 71, & + 28, 65, 139, & + 29, 62, 69, & + 30, 92, 126, & + 31, 78, 123, & + 13, 44, 78, & + 33, 40, 120, & + 7, 34, 119, & + 4, 35, 77, & + 12, 36, 52, & + 25, 98, 136, & + 5, 24, 133, & + 1, 80, 91, & + 33, 96, 97, & + 34, 41, 91, & + 32, 37, 117, & + 26, 72, 125, & + 19, 65, 75, & + 45, 131, 136, & + 46, 55, 70, & + 47, 48, 50, & + 6, 48, 94, & + 3, 74, 79, & + 39, 50, 126, & + 23, 118, 127, & + 21, 36, 113, & + 53, 77, 134, & + 30, 54, 55, & + 17, 46, 135, & + 9, 92, 102, & + 57, 85, 87, & + 58, 125, 138, & + 59, 76, 93, & + 60, 66, 107, & + 47, 132, 138, & + 29, 85, 131, & + 43, 73, 108, & + 64, 75, 129, & + 28, 38, 53, & + 61, 106, 122, & + 56, 71, 114, & + 27, 57, 120, & + 62, 67, 130, & + 54, 104, 118, & + 8, 68, 115, & + 72, 86, 111, & + 73, 74, 94, & + 49, 105, 113, & + 42, 86, 121, & + 40, 59, 109, & + 35, 88, 95, & + 31, 107, 112, & + 58, 64, 87, & + 68, 79, 104, & + 1, 5, 121, & + 15, 82, 93, & + 18, 88, 116, & + 82, 84, 119, & + 7, 71, 103, & + 4, 80, 94, & + 63, 81, 84, & + 66, 76, 137, & + 83, 124, 129, & + 90, 112, 116, & + 89, 111, 134, & + 6, 21, 120, & + 3, 16, 25, & + 12, 28, 131, & + 45, 95, 110, & + 17, 93, 124, & + 97, 121, 127, & + 98, 103, 135, & + 8, 99, 138, & + 41, 101, 139, & + 13, 24, 105, & + 14, 53, 107, & + 10, 64, 98, & + 11, 35, 78, & + 90, 100, 103, & + 9, 72, 101, & + 18, 74, 92, & + 15, 73, 87, & + 2, 88, 113, & + 20, 55, 85, & + 19, 67, 110, & + 26, 27, 95, & + 22, 50, 114, & + 29, 49, 81, & + 32, 52, 83, & + 30, 37, 77, & + 39, 128, 135, & + 23, 128, 130, & + 36, 76, 126, & + 33, 132, 139, & + 34, 89, 118, & + 38, 58, 127, & + 31, 54, 125, & + 40, 70, 75, & + 41, 109, 116, & + 43, 60, 63, & + 44, 84, 86, & + 42, 47, 62, & + 45, 82, 90, & + 43, 46, 91, & + 48, 112, 122, & + 51, 102, 133, & + 59, 61, 108, & + 65, 117, 137, & + 56, 66, 96, & + 59, 69, 104, & + 39, 69, 119, & + 97, 115, 123, & + 106, 111, 129/ + +data Nm/ & + 3, 52, 95, 102, 140, 182, & + 4, 53, 96, 103, 108, 210, & + 5, 54, 97, 104, 150, 194, & + 6, 55, 98, 105, 136, 187, & + 7, 56, 99, 106, 139, 182, & + 8, 57, 100, 107, 149, 193, & + 9, 58, 101, 103, 135, 186, & + 10, 59, 109, 172, 200, 0, & + 11, 60, 110, 157, 207, 0, & + 12, 61, 111, 122, 204, 0, & + 13, 62, 112, 117, 205, 0, & + 3, 39, 113, 137, 195, 0, & + 14, 63, 114, 133, 202, 0, & + 15, 64, 115, 116, 203, 0, & + 3, 60, 115, 183, 209, 0, & + 16, 65, 112, 124, 194, 0, & + 11, 66, 118, 156, 197, 0, & + 17, 67, 119, 184, 208, 0, & + 18, 36, 101, 120, 145, 212, & + 19, 37, 108, 121, 211, 0, & + 20, 68, 122, 153, 193, 0, & + 17, 61, 123, 124, 214, 0, & + 4, 51, 123, 152, 219, 0, & + 21, 68, 125, 139, 202, 0, & + 22, 69, 100, 126, 138, 194, & + 21, 70, 127, 144, 213, 0, & + 23, 71, 128, 169, 213, 0, & + 24, 72, 129, 166, 195, 0, & + 25, 73, 99, 130, 163, 215, & + 10, 28, 131, 155, 217, 0, & + 26, 74, 100, 132, 179, 224, & + 27, 75, 114, 143, 216, 0, & + 28, 76, 134, 141, 221, 0, & + 12, 77, 135, 142, 222, 0, & + 29, 76, 97, 136, 178, 205, & + 13, 78, 137, 153, 220, 0, & + 20, 79, 126, 143, 217, 0, & + 8, 80, 125, 166, 223, 0, & + 69, 102, 151, 218, 238, 0, & + 9, 52, 134, 177, 225, 0, & + 30, 66, 96, 142, 201, 226, & + 30, 81, 126, 176, 229, 0, & + 82, 127, 164, 227, 231, 0, & + 31, 60, 120, 133, 228, 0, & + 32, 33, 146, 196, 230, 0, & + 33, 46, 147, 156, 231, 0, & + 34, 77, 148, 162, 229, 0, & + 35, 83, 148, 149, 232, 0, & + 23, 62, 104, 175, 215, 0, & + 15, 84, 148, 151, 214, 0, & + 36, 51, 107, 117, 233, 0, & + 37, 85, 127, 137, 216, 0, & + 38, 52, 154, 166, 203, 0, & + 39, 65, 155, 171, 224, 0, & + 8, 63, 147, 155, 211, 0, & + 2, 74, 110, 168, 236, 0, & + 1, 16, 74, 88, 158, 169, & + 40, 86, 159, 180, 223, 0, & + 87, 160, 177, 234, 237, 0, & + 18, 56, 124, 161, 227, 0, & + 20, 47, 123, 167, 234, 0, & + 41, 86, 130, 170, 229, 0, & + 42, 54, 111, 188, 227, 0, & + 35, 72, 165, 180, 204, 0, & + 29, 88, 129, 145, 235, 0, & + 40, 50, 161, 189, 236, 0, & + 37, 89, 110, 170, 212, 0, & + 7, 55, 128, 172, 181, 0, & + 67, 70, 117, 130, 237, 238, & + 42, 83, 96, 116, 147, 225, & + 42, 69, 128, 168, 186, 0, & + 4, 57, 144, 173, 207, 0, & + 43, 53, 94, 164, 174, 209, & + 24, 79, 150, 174, 208, 0, & + 21, 79, 145, 165, 225, 0, & + 44, 64, 160, 189, 220, 0, & + 45, 82, 136, 154, 217, 0, & + 9, 56, 132, 133, 205, 0, & + 46, 80, 120, 150, 181, 0, & + 41, 63, 109, 140, 187, 0, & + 47, 53, 105, 188, 215, 0, & + 48, 81, 183, 185, 230, 0, & + 16, 90, 95, 119, 190, 216, & + 10, 87, 185, 188, 228, 0, & + 44, 91, 158, 163, 211, 0, & + 49, 78, 173, 176, 228, 0, & + 30, 92, 158, 180, 209, 0, & + 22, 40, 178, 184, 210, 0, & + 18, 59, 95, 118, 192, 222, & + 14, 70, 191, 206, 230, 0, & + 26, 75, 140, 142, 231, 0, & + 48, 83, 131, 157, 208, 0, & + 6, 61, 160, 183, 197, 0, & + 32, 73, 149, 174, 187, 0, & + 12, 64, 178, 196, 213, 0, & + 27, 93, 101, 105, 141, 236, & + 33, 89, 141, 198, 239, 0, & + 19, 93, 138, 199, 204, 0, & + 2, 82, 99, 116, 119, 200, & + 1, 50, 62, 106, 206, 0, & + 32, 71, 112, 201, 207, 0, & + 34, 75, 111, 157, 233, 0, & + 39, 73, 186, 199, 206, 0, & + 27, 35, 38, 171, 181, 237, & + 49, 93, 118, 175, 202, 0, & + 45, 80, 121, 167, 240, 0, & + 19, 94, 161, 179, 203, 0, & + 31, 86, 106, 164, 234, 0, & + 45, 84, 104, 177, 226, 0, & + 47, 66, 102, 196, 212, 0, & + 25, 65, 98, 173, 192, 240, & + 49, 85, 179, 191, 232, 0, & + 38, 89, 153, 175, 210, 0, & + 25, 43, 125, 168, 214, 0, & + 22, 58, 113, 172, 239, 0, & + 36, 68, 184, 191, 226, 0, & + 15, 78, 103, 143, 235, 0, & + 50, 84, 152, 171, 222, 0, & + 24, 85, 135, 185, 238, 0, & + 48, 59, 134, 169, 193, 0, & + 17, 91, 176, 182, 198, 0, & + 11, 88, 113, 167, 232, 0, & + 43, 81, 122, 132, 239, 0, & + 41, 58, 107, 190, 197, 0, & + 6, 91, 144, 159, 224, 0, & + 46, 72, 131, 151, 220, 0, & + 23, 90, 152, 198, 223, 0, & + 44, 77, 98, 114, 218, 219, & + 26, 76, 165, 190, 240, 0, & + 28, 54, 115, 170, 219, 0, & + 31, 57, 97, 146, 163, 195, & + 14, 92, 108, 162, 221, 0, & + 5, 71, 121, 139, 233, 0, & + 1, 34, 87, 154, 192, 0, & + 29, 90, 156, 199, 218, 0, & + 2, 51, 55, 138, 146, 0, & + 5, 92, 109, 189, 235, 0, & + 13, 94, 159, 162, 200, 0, & + 7, 67, 129, 201, 221, 0/ + +data nrw/ & +6,6,6,6,6,6,6,5,5,5,5,5,5,5,5,5,5,5,6,5, & +5,5,5,5,6,5,5,5,6,5,6,5,5,5,6,5,5,5,5,5, & +6,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,6,5,5,5, & +5,5,5,5,5,5,5,5,6,6,5,5,6,5,5,5,5,5,5,5, & +5,5,6,5,5,5,5,5,6,5,5,5,5,5,5,6,5,5,6,5, & +5,5,5,6,5,5,5,5,5,5,6,5,5,5,5,5,5,5,5,5, & +5,5,5,5,5,5,5,6,5,5,6,5,5,5,5,5,5,5,5/ + +ncw=3 diff --git a/lib/fst280/ldpc_280_101_generator.f90 b/lib/fst240/ldpc_280_101_generator.f90 similarity index 100% rename from lib/fst280/ldpc_280_101_generator.f90 rename to lib/fst240/ldpc_280_101_generator.f90 diff --git a/lib/fst280/ldpc_280_101_parity.f90 b/lib/fst240/ldpc_280_101_parity.f90 similarity index 100% rename from lib/fst280/ldpc_280_101_parity.f90 rename to lib/fst240/ldpc_280_101_parity.f90 diff --git a/lib/fst280/ldpc_280_74_generator.f90 b/lib/fst240/ldpc_280_74_generator.f90 similarity index 100% rename from lib/fst280/ldpc_280_74_generator.f90 rename to lib/fst240/ldpc_280_74_generator.f90 diff --git a/lib/fst280/ldpc_280_74_parity.f90 b/lib/fst240/ldpc_280_74_parity.f90 similarity index 100% rename from lib/fst280/ldpc_280_74_parity.f90 rename to lib/fst240/ldpc_280_74_parity.f90 diff --git a/lib/fst240/ldpcsim240_101.f90 b/lib/fst240/ldpcsim240_101.f90 new file mode 100644 index 000000000..55121b5c3 --- /dev/null +++ b/lib/fst240/ldpcsim240_101.f90 @@ -0,0 +1,143 @@ +program ldpcsim240_101 + +! End-to-end test of the (240,101)/crc24 encoder and decoders. + + use packjt77 + + parameter(N=240, K=101, M=N-K) + character*8 arg + character*37 msg0,msg + character*77 c77 + character*24 c24 + integer*1 msgbits(101) + integer*1 apmask(240) + integer*1 cw(240) + integer*1 codeword(N),message101(101) + integer ncrc24 + real rxdata(N),llr(N) + logical first,unpk77_success + data first/.true./ + + nargs=iargc() + if(nargs.ne.5 .and. nargs.ne.6) then + print*,'Usage: ldpcsim niter ndeep #trials s K [msg]' + print*,'e.g. ldpcsim240_101 20 5 1000 0.85 91 "K9AN K1JT FN20"' + 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 [77,101]' + print*,'WSPR-format message is optional' + return + endif + call getarg(1,arg) + read(arg,*) max_iterations + call getarg(2,arg) + read(arg,*) ndeep + call getarg(3,arg) + read(arg,*) ntrials + call getarg(4,arg) + read(arg,*) s + call getarg(5,arg) + read(arg,*) Keff + msg0='K9AN K1JT FN20 ' + if(nargs.eq.6) call getarg(6,msg0) + call pack77(msg0,i3,n3,c77) + + rate=real(Keff)/real(N) + + write(*,*) "code rate: ",rate + write(*,*) "niter : ",max_iterations + write(*,*) "ndeep : ",ndeep + write(*,*) "s : ",s + write(*,*) "K : ",Keff + + msgbits=0 + read(c77,'(77i1)') msgbits(1:77) + write(*,*) 'message' + write(*,'(77i1)') msgbits(1:77) + + call get_crc24(msgbits,101,ncrc24) + write(c24,'(b24.24)') ncrc24 + read(c24,'(24i1)') msgbits(78:101) +write(*,'(24i1)') msgbits(78:101) + write(*,*) 'message with crc24' + write(*,'(101i1)') msgbits(1:101) + call encode240_101(msgbits,codeword) + call init_random_seed() + call sgran() + + 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 + 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*(10**(db/10.0)) ) ! db represents Es/No + ngood=0 + nue=0 + nberr=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 + + 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) + apmask=0 +! max_iterations is max number of belief propagation iterations + call bpdecode240_101(llr,apmask,max_iterations,message101,cw,nharderror,niterations,nchecks) + dmin=0.0 + if( (nharderror .lt. 0) .and. (ndeep .ge. 0) ) then +! call osd240_101(llr, Keff, apmask, ndeep, message101, cw, nharderror, dmin) + maxsuper=2 + call decode240_101(llr, Keff, ndeep, apmask, maxsuper, message101, cw, nharderror, iterations, ncheck, dmin, isuper) + endif + + if(nharderror.ge.0) then + n2err=0 + do i=1,N + if( cw(i)*(2*codeword(i)-1.0) .lt. 0 ) n2err=n2err+1 + enddo + if(n2err.eq.0) then + ngood=ngood+1 + else + nue=nue+1 + endif + 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,f5.2,8x,e10.3)") db,esn0,ngood,nue,ss,pberr + + if(first) then + write(c77,'(77i1)') message101(1:77) +write(*,'(101i1)') message101 + call unpack77(c77,0,msg,unpk77_success) + if(unpk77_success) then + write(*,1100) msg(1:37) +1100 format('Decoded message: ',a37) + else + print*,'Error unpacking message' + endif + first=.false. + endif + enddo + +end program ldpcsim240_101 diff --git a/lib/fst280/ldpcsim280_101.f90 b/lib/fst240/ldpcsim280_101.f90 similarity index 100% rename from lib/fst280/ldpcsim280_101.f90 rename to lib/fst240/ldpcsim280_101.f90 diff --git a/lib/fst280/ldpcsim280_74.f90 b/lib/fst240/ldpcsim280_74.f90 similarity index 100% rename from lib/fst280/ldpcsim280_74.f90 rename to lib/fst240/ldpcsim280_74.f90 diff --git a/lib/fst240/osd240_101.f90 b/lib/fst240/osd240_101.f90 new file mode 100644 index 000000000..5e9f5d195 --- /dev/null +++ b/lib/fst240/osd240_101.f90 @@ -0,0 +1,403 @@ +subroutine osd240_101(llr,k,apmask,ndeep,message101,cw,nhardmin,dmin) +! +! An ordered-statistics decoder for the (240,101) code. +! Message payload is 77 bits. Any or all of a 24-bit CRC can be +! used for detecting incorrect codewords. The remaining CRC bits are +! cascaded with the LDPC code for the purpose of improving the +! distance spectrum of the code. +! +! If p1 (0.le.p1.le.24) is the number of CRC24 bits that are +! to be used for bad codeword detection, then the argument k should +! be set to 77+p1. +! +! Valid values for k are in the range [77,101]. +! + character*24 c24 + integer, parameter:: N=240 + integer*1 apmask(N),apmaskr(N) + integer*1, allocatable, save :: gen(:,:) + integer*1, allocatable :: genmrb(:,:),g2(:,:) + integer*1, allocatable :: temp(:),m0(:),me(:),mi(:),misub(:),e2sub(:),e2(:),ui(:) + integer*1, allocatable :: r2pat(:) + integer indices(N),nxor(N) + integer*1 cw(N),ce(N),c0(N),hdec(N) + integer*1, allocatable :: decoded(:) + integer*1 message101(101) + integer indx(N) + real llr(N),rx(N),absrx(N) + + logical first,reset + data first/.true./ + save first + + allocate( genmrb(k,N), g2(N,k) ) + allocate( temp(k), m0(k), me(k), mi(k), misub(k), e2sub(N-k), e2(N-k), ui(N-k) ) + allocate( r2pat(N-k), decoded(k) ) + + if( first ) then ! fill the generator matrix +! +! Create generator matrix for partial CRC cascaded with LDPC code. +! +! Let p2=101-k and p1+p2=24. +! +! The last p2 bits of the CRC24 are cascaded with the LDPC code. +! +! The first p1=k-77 CRC24 bits will be used for error detection. +! + allocate( gen(k,N) ) + gen=0 + do i=1,k + message101=0 + message101(i)=1 + if(i.le.77) then + call get_crc24(message101,101,ncrc24) + write(c24,'(b24.24)') ncrc24 + read(c24,'(24i1)') message101(78:101) + message101(78:k)=0 + endif + call encode240_101(message101,cw) + gen(i,:)=cw + enddo + + first=.false. + endif + + rx=llr + apmaskr=apmask + +! Hard decisions on the received word. + hdec=0 + where(rx .ge. 0) hdec=1 + +! Use magnitude of received symbols as a measure of reliability. + absrx=abs(rx) + call indexx(absrx,N,indx) + +! Re-order the columns of the generator matrix in order of decreasing reliability. + do i=1,N + genmrb(1:k,i)=gen(1:k,indx(N+1-i)) + indices(i)=indx(N+1-i) + enddo + +! Do gaussian elimination to create a generator matrix with the most reliable +! received bits in positions 1:k in order of decreasing reliability (more or less). + do id=1,k ! diagonal element indices + do icol=id,k+20 ! The 20 is ad hoc - beware + iflag=0 + if( genmrb(id,icol) .eq. 1 ) then + iflag=1 + if( icol .ne. id ) then ! reorder column + temp(1:k)=genmrb(1:k,id) + genmrb(1:k,id)=genmrb(1:k,icol) + genmrb(1:k,icol)=temp(1:k) + itmp=indices(id) + indices(id)=indices(icol) + indices(icol)=itmp + endif + do ii=1,k + if( ii .ne. id .and. genmrb(ii,id) .eq. 1 ) then + genmrb(ii,1:N)=ieor(genmrb(ii,1:N),genmrb(id,1:N)) + endif + enddo + exit + endif + enddo + enddo + + g2=transpose(genmrb) + +! The hard decisions for the k MRB bits define the order 0 message, m0. +! Encode m0 using the modified generator matrix to find the "order 0" codeword. +! Flip various combinations of bits in m0 and re-encode to generate a list of +! codewords. Return the member of the list that has the smallest Euclidean +! distance to the received word. + + hdec=hdec(indices) ! hard decisions from received symbols + m0=hdec(1:k) ! zero'th order message + absrx=absrx(indices) + rx=rx(indices) + apmaskr=apmaskr(indices) + + call mrbencode101(m0,c0,g2,N,k) + nxor=ieor(c0,hdec) + nhardmin=sum(nxor) + dmin=sum(nxor*absrx) + + cw=c0 + ntotal=0 + nrejected=0 + npre1=0 + npre2=0 + + if(ndeep.eq.0) goto 998 ! norder=0 + if(ndeep.gt.6) ndeep=6 + if( ndeep.eq. 1) then + nord=1 + npre1=0 + npre2=0 + nt=40 + ntheta=12 + elseif(ndeep.eq.2) then + nord=1 + npre1=1 + npre2=0 + nt=40 + ntheta=12 + elseif(ndeep.eq.3) then + nord=1 + npre1=1 + npre2=1 + nt=40 + ntheta=12 + ntau=14 + elseif(ndeep.eq.4) then + nord=2 + npre1=1 + npre2=1 + nt=40 + ntheta=12 + ntau=17 + elseif(ndeep.eq.5) then + nord=3 + npre1=1 + npre2=1 + nt=40 + ntheta=12 + ntau=15 + elseif(ndeep.eq.6) then + nord=4 + npre1=1 + npre2=1 + nt=95 + ntheta=12 + ntau=15 + endif + + do iorder=1,nord + misub(1:k-iorder)=0 + misub(k-iorder+1:k)=1 + iflag=k-iorder+1 + do while(iflag .ge.0) + if(iorder.eq.nord .and. npre1.eq.0) then + iend=iflag + else + iend=1 + endif + d1=0. + do n1=iflag,iend,-1 + mi=misub + mi(n1)=1 + if(any(iand(apmaskr(1:k),mi).eq.1)) cycle + ntotal=ntotal+1 + me=ieor(m0,mi) + if(n1.eq.iflag) then + call mrbencode101(me,ce,g2,N,k) + e2sub=ieor(ce(k+1:N),hdec(k+1:N)) + e2=e2sub + nd1kpt=sum(e2sub(1:nt))+1 + d1=sum(ieor(me(1:k),hdec(1:k))*absrx(1:k)) + else + e2=ieor(e2sub,g2(k+1:N,n1)) + nd1kpt=sum(e2(1:nt))+2 + endif + if(nd1kpt .le. ntheta) then + call mrbencode101(me,ce,g2,N,k) + nxor=ieor(ce,hdec) + if(n1.eq.iflag) then + dd=d1+sum(e2sub*absrx(k+1:N)) + else + dd=d1+ieor(ce(n1),hdec(n1))*absrx(n1)+sum(e2*absrx(k+1:N)) + endif + if( dd .lt. dmin ) then + dmin=dd + cw=ce + nhardmin=sum(nxor) + nd1kptbest=nd1kpt + endif + else + nrejected=nrejected+1 + endif + enddo +! Get the next test error pattern, iflag will go negative +! when the last pattern with weight iorder has been generated. + call nextpat101(misub,k,iorder,iflag) + enddo + enddo + + if(npre2.eq.1) then + reset=.true. + ntotal=0 + do i1=k,1,-1 + 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 boxit101(reset,mi(1:ntau),ntau,ntotal,i1,i2) + enddo + enddo + + ncount2=0 + ntotal2=0 + reset=.true. +! Now run through again and do the second pre-processing rule + misub(1:k-nord)=0 + misub(k-nord+1:k)=1 + iflag=k-nord+1 + do while(iflag .ge.0) + me=ieor(m0,misub) + call mrbencode101(me,ce,g2,N,k) + e2sub=ieor(ce(k+1:N),hdec(k+1:N)) + do i2=0,ntau + ntotal2=ntotal2+1 + ui=0 + if(i2.gt.0) ui(i2)=1 + r2pat=ieor(e2sub,ui) +778 continue + call fetchit101(reset,r2pat(1:ntau),ntau,in1,in2) + if(in1.gt.0.and.in2.gt.0) then + ncount2=ncount2+1 + mi=misub + mi(in1)=1 + 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 mrbencode101(me,ce,g2,N,k) + nxor=ieor(ce,hdec) + dd=sum(nxor*absrx) + if( dd .lt. dmin ) then + dmin=dd + cw=ce + nhardmin=sum(nxor) + endif + goto 778 + endif + enddo + call nextpat101(misub,k,nord,iflag) + enddo + endif + +998 continue +! Re-order the codeword to [message bits][parity bits] format. + cw(indices)=cw + hdec(indices)=hdec + message101=cw(1:101) + call get_crc24(message101,101,nbadcrc) + if(nbadcrc.ne.0) nhardmin=-nhardmin + + return +end subroutine osd240_101 + +subroutine mrbencode101(me,codeword,g2,N,K) + integer*1 me(K),codeword(N),g2(N,K) +! fast encoding for low-weight test patterns + codeword=0 + do i=1,K + if( me(i) .eq. 1 ) then + codeword=ieor(codeword,g2(1:N,i)) + endif + enddo + return +end subroutine mrbencode101 + +subroutine nextpat101(mi,k,iorder,iflag) + integer*1 mi(k),ms(k) +! generate the next test error pattern + ind=-1 + do i=1,k-1 + if( mi(i).eq.0 .and. mi(i+1).eq.1) ind=i + enddo + if( ind .lt. 0 ) then ! no more patterns of this order + iflag=ind + return + endif + ms=0 + ms(1:ind-1)=mi(1:ind-1) + ms(ind)=1 + ms(ind+1)=0 + if( ind+1 .lt. k ) then + nz=iorder-sum(ms) + ms(k-nz+1:k)=1 + endif + mi=ms + do i=1,k ! iflag will point to the lowest-index 1 in mi + if(mi(i).eq.1) then + iflag=i + exit + endif + enddo + return +end subroutine nextpat101 + +subroutine boxit101(reset,e2,ntau,npindex,i1,i2) + integer*1 e2(1:ntau) + integer indexes(5000,2),fp(0:525000),np(5000) + logical reset + common/boxes/indexes,fp,np + + if(reset) then + patterns=-1 + fp=-1 + np=-1 + sc=-1 + indexes=-1 + reset=.false. + endif + + indexes(npindex,1)=i1 + indexes(npindex,2)=i2 + ipat=0 + do i=1,ntau + if(e2(i).eq.1) then + ipat=ipat+ishft(1,ntau-i) + endif + enddo + + ip=fp(ipat) ! see what's currently stored in fp(ipat) + if(ip.eq.-1) then + fp(ipat)=npindex + else + do while (np(ip).ne.-1) + ip=np(ip) + enddo + np(ip)=npindex + endif + return +end subroutine boxit101 + +subroutine fetchit101(reset,e2,ntau,i1,i2) + integer indexes(5000,2),fp(0:525000),np(5000) + integer lastpat + integer*1 e2(ntau) + logical reset + common/boxes/indexes,fp,np + save lastpat,inext + + if(reset) then + lastpat=-1 + reset=.false. + endif + + ipat=0 + do i=1,ntau + if(e2(i).eq.1) then + ipat=ipat+ishft(1,ntau-i) + endif + enddo + index=fp(ipat) + + if(lastpat.ne.ipat .and. index.gt.0) then ! return first set of indices + i1=indexes(index,1) + i2=indexes(index,2) + inext=np(index) + elseif(lastpat.eq.ipat .and. inext.gt.0) then + i1=indexes(inext,1) + i2=indexes(inext,2) + inext=np(inext) + else + i1=-1 + i2=-1 + inext=-1 + endif + lastpat=ipat + return +end subroutine fetchit101 + diff --git a/lib/fst280/osd280_101.f90 b/lib/fst240/osd280_101.f90 similarity index 100% rename from lib/fst280/osd280_101.f90 rename to lib/fst240/osd280_101.f90 diff --git a/lib/fst280/osd280_74.f90 b/lib/fst240/osd280_74.f90 similarity index 100% rename from lib/fst280/osd280_74.f90 rename to lib/fst240/osd280_74.f90 diff --git a/lib/fst240_decode.f90 b/lib/fst240_decode.f90 new file mode 100644 index 000000000..231e00e84 --- /dev/null +++ b/lib/fst240_decode.f90 @@ -0,0 +1,554 @@ +module fst240_decode + + type :: fst240_decoder + procedure(fst240_decode_callback), pointer :: callback + contains + procedure :: decode + end type fst240_decoder + + abstract interface + subroutine fst240_decode_callback (this,nutc,sync,nsnr,dt,freq, & + decoded,nap,qual,ntrperiod) + import fst240_decoder + implicit none + class(fst240_decoder), intent(inout) :: this + integer, intent(in) :: nutc + real, intent(in) :: sync + integer, intent(in) :: nsnr + real, intent(in) :: dt + real, intent(in) :: freq + character(len=37), intent(in) :: decoded + integer, intent(in) :: nap + real, intent(in) :: qual + integer, intent(in) :: ntrperiod + end subroutine fst240_decode_callback + end interface + +contains + + subroutine decode(this,callback,iwave,nutc,nQSOProgress,nfqso, & + nfa,nfb,nsubmode,ndeep,ntrperiod,nexp_decode,ntol) + + use timer_module, only: timer + use packjt77 + include 'fst240/fst240_params.f90' + parameter (MAXCAND=100) + class(fst240_decoder), intent(inout) :: this + procedure(fst240_decode_callback) :: callback + character*37 decodes(100) + character*37 msg + character*77 c77 + complex, allocatable :: c2(:) + complex, allocatable :: cframe(:) + complex, allocatable :: c_bigfft(:) !Complex waveform + real, allocatable :: r_data(:) + real llr(240),llra(240),llrb(240),llrc(240),llrd(240) + real candidates(100,4) + real bitmetrics(320,4) + real s4(0:3,NN) + integer itone(NN) + integer hmod + integer*1 apmask(240),cw(240) + integer*1 hbits(320) + integer*1 message101(101),message74(74) + logical badsync,unpk77_success,single_decode + integer*2 iwave(300*12000) + + this%callback => callback + hmod=2**nsubmode + if(nfqso+nqsoprogress.eq.-999) return + Keff=91 + iwspr=0 + nmax=15*12000 + single_decode=iand(nexp_decode,32).eq.32 + if(ntrperiod.eq.15) then + nsps=800 + nmax=15*12000 + ndown=20/hmod !nss=40,80,160,400 + if(hmod.eq.8) ndown=2 + else if(ntrperiod.eq.30) then + nsps=1680 + nmax=30*12000 + ndown=42/hmod !nss=40,80,168,336 + if(hmod.eq.4) ndown=10 + if(hmod.eq.8) ndown=5 + else if(ntrperiod.eq.60) then + nsps=3888 + nmax=60*12000 + ndown=96/hmod !nss=36,81,162,324 + if(hmod.eq.1) ndown=108 + else if(ntrperiod.eq.120) then + nsps=8200 + nmax=120*12000 + ndown=200/hmod !nss=40,82,164,328 + if(hmod.eq.1) ndown=205 + else if(ntrperiod.eq.300) then + nsps=21504 + nmax=300*12000 + ndown=512/hmod !nss=42,84,168,336 + end if + nss=nsps/ndown + fs=12000.0 !Sample rate + fs2=fs/ndown + nspsec=nint(fs2) + dt=1.0/fs !Sample interval (s) + dt2=1.0/fs2 + tt=nsps*dt !Duration of "itone" symbols (s) + baud=1.0/tt + nfft1=2*int(nmax/2) + nh1=nfft1/2 + allocate( r_data(1:nfft1+2) ) + allocate( c_bigfft(0:nfft1/2) ) + + nfft2=nfft1/ndown + allocate( c2(0:nfft2-1) ) + allocate( cframe(0:164*nss-1) ) + + npts=nmax + if(single_decode) then + fa=max(100,nint(nfqso+1.5*hmod*baud-ntol)) + fb=min(4800,nint(nfqso+1.5*hmod*baud+ntol)) + else + fa=max(100,nfa) + fb=min(4800,nfb) + endif + + if(ndeep.eq.3) then + ntmax=4 ! number of block sizes to try + jittermax=2 + norder=3 + elseif(ndeep.eq.2) then + ntmax=3 + jittermax=2 + norder=3 + elseif(ndeep.eq.1) then + ntmax=1 + jittermax=2 + norder=2 + endif + + ! The big fft is done once and is used for calculating the smoothed spectrum +! and also for downconverting/downsampling each candidate. + r_data(1:nfft1)=iwave(1:nfft1) + r_data(nfft1+1:nfft1+2)=0.0 + call four2a(r_data,nfft1,1,-1,0) + c_bigfft=cmplx(r_data(1:nfft1+2:2),r_data(2:nfft1+2:2)) + +! Get first approximation of candidate frequencies + call get_candidates_fst240(c_bigfft,nfft1,nsps,hmod,fs,fa,fb, & + ncand,candidates,base) + + ndecodes=0 + decodes=' ' + + isbest1=0 + isbest8=0 + fc21=0. + fc28=0. + do icand=1,ncand + fc0=candidates(icand,1) + detmet=candidates(icand,2) + +! Downconvert and downsample a slice of the spectrum centered on the +! rough estimate of the candidates frequency. +! Output array c2 is complex baseband sampled at 12000/ndown Sa/sec. +! The size of the downsampled c2 array is nfft2=nfft1/ndown + + call fst240_downsample(c_bigfft,nfft1,ndown,fc0,c2) + + call timer('sync240 ',0) + do isync=0,1 + if(isync.eq.0) then + fc1=0.0 + is0=1.5*nint(fs2) + ishw=1.5*is0 + isst=4*hmod + ifhw=12 + df=.1*baud + else if(isync.eq.1) then + fc1=fc21 + if(hmod.eq.1) fc1=fc28 + is0=isbest1 + if(hmod.eq.1) is0=isbest8 + ishw=4*hmod + isst=1*hmod + ifhw=7 + df=.02*baud + endif + + smax1=0.0 + smax8=0.0 + do if=-ifhw,ifhw + fc=fc1+df*if + do istart=max(1,is0-ishw),is0+ishw,isst + call sync_fst240(c2,istart,fc,hmod,1,nfft2,nss,fs2,sync1) + call sync_fst240(c2,istart,fc,hmod,8,nfft2,nss,fs2,sync8) + if(sync8.gt.smax8) then + fc28=fc + isbest8=istart + smax8=sync8 + endif + if(sync1.gt.smax1) then + fc21=fc + isbest1=istart + smax1=sync1 + endif + enddo + enddo + enddo + call timer('sync240 ',1) + + if(smax8/smax1 .lt. 0.65 ) then + fc2=fc21 + isbest=isbest1 + if(hmod.gt.1) ntmax=1 + njitter=2 + else + fc2=fc28 + isbest=isbest8 + if(hmod.gt.1) ntmax=1 + njitter=2 + endif + fc_synced = fc0 + fc2 + dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2 + candidates(icand,3)=fc_synced + candidates(icand,4)=isbest + enddo +! remove duplicate candidates + do icand=1,ncand + fc=candidates(icand,3) + isbest=nint(candidates(icand,4)) + do ic2=1,ncand + fc2=candidates(ic2,3) + isbest2=nint(candidates(ic2,4)) + if(ic2.ne.icand .and. fc2.gt.0.0) then + if(abs(fc2-fc).lt.0.05*baud) then ! same frequency + if(abs(isbest2-isbest).le.2) then + candidates(ic2,3)=-1 + endif + endif + endif + enddo + enddo + + ic=0 + do icand=1,ncand + if(candidates(icand,3).gt.0) then + ic=ic+1 + candidates(ic,:)=candidates(icand,:) + endif + enddo + ncand=ic + do icand=1,ncand + sync=candidates(icand,2) + fc_synced=candidates(icand,3) + isbest=nint(candidates(icand,4)) + xdt=(isbest-nspsec)/fs2 + call fst240_downsample(c_bigfft,nfft1,ndown,fc_synced,c2) + + do ijitter=0,jittermax + if(ijitter.eq.0) ioffset=0 + if(ijitter.eq.1) ioffset=1 + if(ijitter.eq.2) ioffset=-1 + is0=isbest+ioffset + if(is0.lt.0) cycle + cframe=c2(is0:is0+164*nss-1) + bitmetrics=0 + call get_fst240_bitmetrics(cframe,nss,hmod,ntmax,bitmetrics,s4,badsync) + if(badsync) cycle + + hbits=0 + where(bitmetrics(:,1).ge.0) hbits=1 + ns1=count(hbits( 1: 16).eq.(/0,0,0,1,1,0,1,1,0,1,0,0,1,1,1,0/)) + ns2=count(hbits( 77: 92).eq.(/0,0,0,1,1,0,1,1,0,1,0,0,1,1,1,0/)) + ns3=count(hbits(153:168).eq.(/0,0,0,1,1,0,1,1,0,1,0,0,1,1,1,0/)) + ns4=count(hbits(229:244).eq.(/0,0,0,1,1,0,1,1,0,1,0,0,1,1,1,0/)) + ns5=count(hbits(305:320).eq.(/0,0,0,1,1,0,1,1,0,1,0,0,1,1,1,0/)) + nsync_qual=ns1+ns2+ns3+ns4+ns5 + if(nsync_qual.lt. 26) cycle !### Value ?? ### + + scalefac=2.83 + llra( 1: 60)=bitmetrics( 17: 76, 1) + llra( 61:120)=bitmetrics( 93:152, 1) + llra(121:180)=bitmetrics(169:228, 1) + llra(181:240)=bitmetrics(245:304, 1) + llra=scalefac*llra + llrb( 1: 60)=bitmetrics( 17: 76, 2) + llrb( 61:120)=bitmetrics( 93:152, 2) + llrb(121:180)=bitmetrics(169:228, 2) + llrb(181:240)=bitmetrics(245:304, 2) + llrb=scalefac*llrb + llrc( 1: 60)=bitmetrics( 17: 76, 3) + llrc( 61:120)=bitmetrics( 93:152, 3) + llrc(121:180)=bitmetrics(169:228, 3) + llrc(181:240)=bitmetrics(245:304, 3) + llrc=scalefac*llrc + llrd( 1: 60)=bitmetrics( 17: 76, 4) + llrd( 61:120)=bitmetrics( 93:152, 4) + llrd(121:180)=bitmetrics(169:228, 4) + llrd(181:240)=bitmetrics(245:304, 4) + llrd=scalefac*llrd + apmask=0 + + do itry=1,ntmax + if(itry.eq.1) llr=llra + if(itry.eq.2) llr=llrb + if(itry.eq.3) llr=llrc + if(itry.eq.4) llr=llrd + dmin=0.0 + nharderrors=-1 + unpk77_success=.false. + if(iwspr.eq.0) then + maxosd=2 + call timer('d240_101',0) + call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & + cw,ntype,nharderrors,dmin) + call timer('d240_101',1) + else + maxosd=2 + call timer('d240_74 ',0) +! call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & +! ntype,nharderrors,dmin) + call timer('d240_74 ',1) + endif + if(nharderrors .ge.0) then + if(iwspr.eq.0) then + write(c77,'(77i1)') message101(1:77) + call unpack77(c77,0,msg,unpk77_success) + else + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,0,msg,unpk77_success) + endif + if(unpk77_success) then + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.msg) idupe=1 + enddo + if(idupe.eq.1) exit + ndecodes=ndecodes+1 + decodes(ndecodes)=msg + if(iwspr.eq.0) then + call get_fst240_tones_from_bits(message101,itone,iwspr) + xsig=0 + do i=1,NN + xsig=xsig+s4(itone(i),i)**2 + enddo + arg=400.0*(xsig/base)-1.0 + if(arg.gt.0.0) then + xsnr=10*log10(arg)-21.0-11.7*log10(nsps/800.0) + else + xsnr=-99.9 + endif + endif + nsnr=nint(xsnr) + iaptype=0 + qual=0. + fsig=fc_synced - 1.5*hmod*baud +write(21,'(8i4,f7.1,f7.2,3f7.1,1x,a37)') & + nutc,icand,itry,iaptype,ijitter,ntype,nsync_qual,nharderrors,dmin,sync,xsnr,xdt,fsig,msg + call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & + iaptype,qual,ntrperiod) + goto 2002 + else + cycle + endif + endif + enddo ! metrics + enddo ! istart jitter +2002 continue + enddo !candidate list!ws + + return + end subroutine decode + + subroutine sync_fst240(cd0,i0,f0,hmod,ncoh,np,nss,fs,sync) + +! Compute sync power for a complex, downsampled FST240 signal. + + include 'fst240/fst240_params.f90' + complex cd0(0:np-1) + complex, allocatable, save :: csync(:) + complex, allocatable, save :: csynct(:) + complex ctwk(8*nss) + complex z1,z2,z3,z4,z5 + logical first + integer hmod,isyncword(0:7) + real f0save + data isyncword/0,1,3,2,1,0,2,3/ + data first/.true./,f0save/0.0/,nss0/-1/ + save first,twopi,dt,fac,f0save,nss0 + p(z1)=(real(z1*fac)**2 + aimag(z1*fac)**2)**0.5 !Compute power + + if(nss.ne.nss0 .and. allocated(csync)) deallocate(csync,csynct) + if(first .or. nss.ne.nss0) then + allocate( csync(8*nss) ) + allocate( csynct(8*nss) ) + twopi=8.0*atan(1.0) + dt=1/fs + k=1 + phi=0.0 + do i=0,7 + dphi=twopi*hmod*(isyncword(i)-1.5)/real(nss) + do j=1,nss + csync(k)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dphi,twopi) + k=k+1 + enddo + enddo + first=.false. + nss0=nss + fac=1.0/(8.0*nss) + endif + + if(f0.ne.f0save) then + dphi=twopi*f0*dt + phi=0.0 + do i=1,8*nss + ctwk(i)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dphi,twopi) + enddo + csynct=ctwk*csync + f0save=f0 + endif + + i1=i0 !Costas arrays + i2=i0+38*nss + i3=i0+76*nss + i4=i0+114*nss + i5=i0+152*nss + + s1=0.0 + s2=0.0 + s3=0.0 + s4=0.0 + s5=0.0 + + nsec=8/ncoh + do i=1,nsec + is=(i-1)*ncoh*nss + z1=0 + if(i1+is.ge.1) then + z1=sum(cd0(i1+is:i1+is+ncoh*nss-1)*conjg(csynct(is+1:is+ncoh*nss))) + endif + z2=sum(cd0(i2+is:i2+is+ncoh*nss-1)*conjg(csynct(is+1:is+ncoh*nss))) + z3=sum(cd0(i3+is:i3+is+ncoh*nss-1)*conjg(csynct(is+1:is+ncoh*nss))) + z4=sum(cd0(i4+is:i4+is+ncoh*nss-1)*conjg(csynct(is+1:is+ncoh*nss))) + z5=0 + if(i5+is+ncoh*nss-1.le.np) then + z5=sum(cd0(i5+is:i5+is+ncoh*nss-1)*conjg(csynct(is+1:is+ncoh*nss))) + endif + s1=s1+abs(z1)/(8*nss) + s2=s2+abs(z2)/(8*nss) + s3=s3+abs(z3)/(8*nss) + s4=s4+abs(z4)/(8*nss) + s5=s5+abs(z5)/(8*nss) + enddo + + sync = s1+s2+s3+s4+s5 + + return + end subroutine sync_fst240 + + subroutine fst240_downsample(c_bigfft,nfft1,ndown,f0,c1) + +! Output: Complex data in c(), sampled at 12000/ndown Hz + + complex c_bigfft(0:nfft1/2) + complex c1(0:nfft1/ndown-1) + + df=12000.0/nfft1 + i0=nint(f0/df) + c1(0)=c_bigfft(i0) + nfft2=nfft1/ndown + do i=1,nfft2/2 + if(i0+i.le.nfft1/2) c1(i)=c_bigfft(i0+i) + if(i0-i.ge.0) c1(nfft2-i)=c_bigfft(i0-i) + enddo + c1=c1/nfft2 + call four2a(c1,nfft2,1,1,1) !c2c FFT back to time domain + return + + end subroutine fst240_downsample + + subroutine get_candidates_fst240(c_bigfft,nfft1,nsps,hmod,fs,fa,fb, & + ncand,candidates,base) + + complex c_bigfft(0:nfft1/2) + integer hmod + integer indx(100) + real candidates(100,4) + real candidates0(100,4) + real snr_cand(100) + real s(18000) + real s2(18000) + data nfft1z/-1/ + save nfft1z + + nh1=nfft1/2 + df1=fs/nfft1 + baud=fs/nsps + df2=baud/2.0 + nd=df2/df1 + ndh=nd/2 + ia=nint(max(100.0,fa)/df2) + ib=nint(min(4800.0,fb)/df2) + signal_bw=4*(12000.0/nsps)*hmod + analysis_bw=min(4800.0,fb)-max(100.0,fa) + noise_bw=10.0*signal_bw + if(analysis_bw.gt.noise_bw) then + ina=ia + inb=ib + else + fcenter=(fa+fb)/2.0 + fl = max(100.0,fcenter-noise_bw/2.)/df2 + fh = min(4800.0,fcenter+noise_bw/2.)/df2 + ina=nint(fl) + inb=nint(fh) + endif + s=0. + do i=ina,inb ! noise analysis window includes signal analysis window + j0=nint(i*df2/df1) + do j=j0-ndh,j0+ndh + s(i)=s(i) + real(c_bigfft(j))**2 + aimag(c_bigfft(j))**2 + enddo + enddo + ina=max(ina,1+3*hmod) + inb=min(inb,18000-3*hmod) + s2=0. + do i=ina,inb + s2(i)=s(i-hmod*3) + s(i-hmod) +s(i+hmod) +s(i+hmod*3) + enddo + call pctile(s2(ina+hmod*3:inb-hmod*3),inb-ina+1-hmod*6,30,base) + s2=s2/base + thresh=1.25 + + ncand=0 + candidates=0 + if(ia.lt.3) ia=3 + if(ib.gt.18000-2) ib=18000-2 + do i=ia,ib + if((s2(i).gt.s2(i-2)).and. & + (s2(i).gt.s2(i+2)).and. & + (s2(i).gt.thresh).and.ncand.lt.100) then + ncand=ncand+1 + candidates(ncand,1)=df2*i + candidates(ncand,2)=s2(i) + endif + enddo + + snr_cand=0. + snr_cand(1:ncand)=candidates(1:ncand,2) + call indexx(snr_cand,ncand,indx) + nmax=min(ncand,20) + do i=1,nmax + j=indx(ncand+1-i) + candidates0(i,1:4)=candidates(j,1:4) + enddo + ncand=nmax + candidates(1:ncand,1:4)=candidates0(1:ncand,1:4) + candidates(ncand+1:,1:4)=0. + return + end subroutine get_candidates_fst240 + +end module fst240_decode diff --git a/lib/jt9.f90 b/lib/jt9.f90 index afd5c374e..23f330c9f 100644 --- a/lib/jt9.f90 +++ b/lib/jt9.f90 @@ -54,7 +54,7 @@ program jt9 option ('jt4', .false., '4', 'JT4 mode', ''), & option ('ft4', .false., '5', 'FT4 mode', ''), & option ('jt65', .false.,'6', 'JT65 mode', ''), & - option ('fst280', .false., '7', 'FT8 mode', ''), & + option ('fst240', .false., '7', 'FT8 mode', ''), & option ('ft8', .false., '8', 'FT8 mode', ''), & option ('jt9', .false., '9', 'JT9 mode', ''), & option ('qra64', .false., 'q', 'QRA64 mode', ''), & @@ -124,7 +124,7 @@ program jt9 case ('6') if (mode.lt.65) mode = mode + 65 case ('7') - mode = 280 + mode = 240 case ('8') mode = 8 case ('9') @@ -235,7 +235,7 @@ program jt9 call timer('symspec ',1) endif nhsym0=nhsym - if(nhsym.ge.181 .and. mode.ne.280) exit + if(nhsym.ge.181 .and. mode.ne.240) exit endif enddo close(unit=wav%lun) @@ -250,7 +250,7 @@ program jt9 shared_data%params%nfb=fhigh shared_data%params%ntol=20 shared_data%params%kin=64800 - if(mode.eq.280) shared_data%params%kin=720000 !### 60 s periods ### + if(mode.eq.240) shared_data%params%kin=720000 !### 60 s periods ### shared_data%params%nzhsym=nhsym shared_data%params%ndepth=ndepth shared_data%params%lft8apon=.true. diff --git a/models/FrequencyList.cpp b/models/FrequencyList.cpp index def2e6ec4..056950611 100644 --- a/models/FrequencyList.cpp +++ b/models/FrequencyList.cpp @@ -46,21 +46,21 @@ namespace {20000000, Modes::FreqCal, IARURegions::ALL}, {136000, Modes::WSPR, IARURegions::ALL}, - {136000, Modes::FST280W, IARURegions::ALL}, + {136000, Modes::FST240W, IARURegions::ALL}, {136130, Modes::JT65, IARURegions::ALL}, {136130, Modes::JT9, IARURegions::ALL}, - {136130, Modes::FST280, IARURegions::ALL}, + {136130, Modes::FST240, IARURegions::ALL}, {474200, Modes::JT65, IARURegions::ALL}, {474200, Modes::JT9, IARURegions::ALL}, - {474200, Modes::FST280, IARURegions::ALL}, + {474200, Modes::FST240, IARURegions::ALL}, {474200, Modes::WSPR, IARURegions::ALL}, - {474200, Modes::FST280W, IARURegions::ALL}, + {474200, Modes::FST240W, IARURegions::ALL}, {1836600, Modes::WSPR, IARURegions::ALL}, {1838000, Modes::JT65, IARURegions::ALL}, // squeezed allocations {1839000, Modes::JT9, IARURegions::ALL}, - {1839000, Modes::FST280, IARURegions::ALL}, + {1839000, Modes::FST240, IARURegions::ALL}, {1840000, Modes::FT8, IARURegions::ALL}, // Band plans (all USB dial unless stated otherwise) @@ -92,7 +92,7 @@ namespace // {3570000, Modes::JT65, IARURegions::ALL}, // JA compatible {3572000, Modes::JT9, IARURegions::ALL}, - {3572000, Modes::FST280, IARURegions::ALL}, + {3572000, Modes::FST240, IARURegions::ALL}, {3573000, Modes::FT8, IARURegions::ALL}, // above as below JT65 is out of DM allocation {3568600, Modes::WSPR, IARURegions::ALL}, // needs guard marker and lock out {3575000, Modes::FT4, IARURegions::ALL}, // provisional @@ -133,7 +133,7 @@ namespace {7074000, Modes::FT8, IARURegions::ALL}, {7076000, Modes::JT65, IARURegions::ALL}, {7078000, Modes::JT9, IARURegions::ALL}, - {7078000, Modes::FST280, IARURegions::ALL}, + {7078000, Modes::FST240, IARURegions::ALL}, {7047500, Modes::FT4, IARURegions::ALL}, // provisional - moved // up 500Hz to clear // W1AW code practice QRG @@ -168,7 +168,7 @@ namespace {10138000, Modes::JT65, IARURegions::ALL}, {10138700, Modes::WSPR, IARURegions::ALL}, {10140000, Modes::JT9, IARURegions::ALL}, - {10140000, Modes::FST280, IARURegions::ALL}, + {10140000, Modes::FST240, IARURegions::ALL}, {10140000, Modes::FT4, IARURegions::ALL}, // provisional // Band plans (all USB dial unless stated otherwise) @@ -212,7 +212,7 @@ namespace {14074000, Modes::FT8, IARURegions::ALL}, {14076000, Modes::JT65, IARURegions::ALL}, {14078000, Modes::JT9, IARURegions::ALL}, - {14078000, Modes::FST280, IARURegions::ALL}, + {14078000, Modes::FST240, IARURegions::ALL}, {14080000, Modes::FT4, IARURegions::ALL}, // provisional // Band plans (all USB dial unless stated otherwise) @@ -245,28 +245,28 @@ namespace {18100000, Modes::FT8, IARURegions::ALL}, {18102000, Modes::JT65, IARURegions::ALL}, {18104000, Modes::JT9, IARURegions::ALL}, - {18104000, Modes::FST280, IARURegions::ALL}, + {18104000, Modes::FST240, IARURegions::ALL}, {18104000, Modes::FT4, IARURegions::ALL}, // provisional {18104600, Modes::WSPR, IARURegions::ALL}, {21074000, Modes::FT8, IARURegions::ALL}, {21076000, Modes::JT65, IARURegions::ALL}, {21078000, Modes::JT9, IARURegions::ALL}, - {21078000, Modes::FST280, IARURegions::ALL}, + {21078000, Modes::FST240, IARURegions::ALL}, {21094600, Modes::WSPR, IARURegions::ALL}, {21140000, Modes::FT4, IARURegions::ALL}, {24915000, Modes::FT8, IARURegions::ALL}, {24917000, Modes::JT65, IARURegions::ALL}, {24919000, Modes::JT9, IARURegions::ALL}, - {24919000, Modes::FST280, IARURegions::ALL}, + {24919000, Modes::FST240, IARURegions::ALL}, {24919000, Modes::FT4, IARURegions::ALL}, // provisional {24924600, Modes::WSPR, IARURegions::ALL}, {28074000, Modes::FT8, IARURegions::ALL}, {28076000, Modes::JT65, IARURegions::ALL}, {28078000, Modes::JT9, IARURegions::ALL}, - {28078000, Modes::FST280, IARURegions::ALL}, + {28078000, Modes::FST240, IARURegions::ALL}, {28124600, Modes::WSPR, IARURegions::ALL}, {28180000, Modes::FT4, IARURegions::ALL}, @@ -280,7 +280,7 @@ namespace {50293000, Modes::WSPR, IARURegions::R3}, {50310000, Modes::JT65, IARURegions::ALL}, {50312000, Modes::JT9, IARURegions::ALL}, - {50312000, Modes::FST280, IARURegions::ALL}, + {50312000, Modes::FST240, IARURegions::ALL}, {50313000, Modes::FT8, IARURegions::ALL}, {50318000, Modes::FT4, IARURegions::ALL}, // provisional {50323000, Modes::FT8, IARURegions::ALL}, diff --git a/models/Modes.hpp b/models/Modes.hpp index c98b1c6fb..deb22865f 100644 --- a/models/Modes.hpp +++ b/models/Modes.hpp @@ -50,8 +50,8 @@ public: FreqCal, FT8, FT4, - FST280, - FST280W, + FST240, + FST240W, MODES_END_SENTINAL_AND_COUNT // this must be last }; Q_ENUM (Mode) diff --git a/widgets/displaytext.cpp b/widgets/displaytext.cpp index 47478e346..5d8136a01 100644 --- a/widgets/displaytext.cpp +++ b/widgets/displaytext.cpp @@ -460,7 +460,7 @@ void DisplayText::displayTransmittedText(QString text, QString modeTx, qint32 tx if(modeTx=="JT4") t1=" $ "; if(modeTx=="JT65") t1=" # "; if(modeTx=="MSK144") t1=" & "; - if(modeTx=="FST280") t1=" ` "; + if(modeTx=="FST240") t1=" ` "; QString t2; t2 = t2.asprintf("%4d",txFreq); QString t; diff --git a/widgets/mainwindow.cpp b/widgets/mainwindow.cpp index 4ac9f485c..40c94143d 100644 --- a/widgets/mainwindow.cpp +++ b/widgets/mainwindow.cpp @@ -105,7 +105,7 @@ extern "C" { void genft4_(char* msg, int* ichk, char* msgsent, char ft4msgbits[], int itone[], fortran_charlen_t, fortran_charlen_t); - void genfst280_(char* msg, int* ichk, char* msgsent, char fst280msgbits[], + void genfst240_(char* msg, int* ichk, char* msgsent, char fst240msgbits[], int itone[], int* iwspr, fortran_charlen_t, fortran_charlen_t); void gen_ft8wave_(int itone[], int* nsym, int* nsps, float* bt, float* fsample, float* f0, @@ -114,7 +114,7 @@ extern "C" { void gen_ft4wave_(int itone[], int* nsym, int* nsps, float* fsample, float* f0, float xjunk[], float wave[], int* icmplx, int* nwave); - void gen_fst280wave_(int itone[], int* nsym, int* nsps, int* nwave, float* fsample, + void gen_fst240wave_(int itone[], int* nsym, int* nsps, int* nwave, float* fsample, int* hmod, float* f0, int* icmplx, float xjunk[], float wave[]); void gen4_(char* msg, int* ichk, char* msgsent, int itone[], @@ -429,7 +429,7 @@ MainWindow::MainWindow(QDir const& temp_directory, bool multiple, ui->dxGridEntry->setValidator (new MaidenheadLocatorValidator {this}); ui->dxCallEntry->setValidator (new CallsignValidator {this}); ui->sbTR->values ({5, 10, 15, 30, 60, 120, 300}); - ui->sbTR_FST280W->values ({120, 300}); + ui->sbTR_FST240W->values ({120, 300}); ui->decodedTextBrowser->set_configuration (&m_config, true); ui->decodedTextBrowser2->set_configuration (&m_config); @@ -580,8 +580,8 @@ MainWindow::MainWindow(QDir const& temp_directory, bool multiple, on_EraseButton_clicked (); QActionGroup* modeGroup = new QActionGroup(this); - ui->actionFST280->setActionGroup(modeGroup); - ui->actionFST280W->setActionGroup(modeGroup); + ui->actionFST240->setActionGroup(modeGroup); + ui->actionFST240W->setActionGroup(modeGroup); ui->actionFT4->setActionGroup(modeGroup); ui->actionFT8->setActionGroup(modeGroup); ui->actionJT9->setActionGroup(modeGroup); @@ -1341,7 +1341,7 @@ void MainWindow::fixStop() m_hsymStop=50; } else if (m_mode=="FT4") { m_hsymStop=21; - } else if(m_mode=="FST280" or m_mode=="FST280W") { + } else if(m_mode=="FST240" or m_mode=="FST240W") { int stop[] = {45,87,192,397,1012}; int stop_EME[] = {51,96,201,406,1021}; int i=0; @@ -2313,9 +2313,9 @@ void MainWindow::setup_status_bar (bool vhf) mode_label.setStyleSheet ("QLabel{background-color: #ff0099}"); } else if ("FT8" == m_mode) { mode_label.setStyleSheet ("QLabel{background-color: #ff6699}"); - } else if ("FST280" == m_mode) { + } else if ("FST240" == m_mode) { mode_label.setStyleSheet ("QLabel{background-color: #99ff66}"); - } else if ("FST280W" == m_mode) { + } else if ("FST240W" == m_mode) { mode_label.setStyleSheet ("QLabel{background-color: #6699ff}"); } else if ("FreqCal" == m_mode) { mode_label.setStyleSheet ("QLabel{background-color: #ff9933}"); @@ -2898,7 +2898,7 @@ void MainWindow::decode() //decode() dec_data.params.nutc=100*ihr + imin; if(m_TRperiod < 60) { qint64 ms=1000.0*(2.0-m_TRperiod); - if(m_mode=="FST280") ms=1000.0*(6.0-m_TRperiod); + if(m_mode=="FST240") ms=1000.0*(6.0-m_TRperiod); //Adjust for FT8 early decode: if(m_mode=="FT8" and m_ihsym==m_earlyDecode and !m_diskData) ms+=(m_hsymStop-m_earlyDecode)*288; if(m_mode=="FT8" and m_ihsym==m_earlyDecode2 and !m_diskData) ms+=(m_hsymStop-m_earlyDecode2)*288; @@ -2968,7 +2968,7 @@ void MainWindow::decode() //decode() dec_data.params.nmode=5; m_BestCQpriority=""; } - if(m_mode=="FST280") dec_data.params.nmode=280; + if(m_mode=="FST240") dec_data.params.nmode=240; dec_data.params.ntrperiod=m_TRperiod; dec_data.params.nsubmode=m_nSubMode; if(m_mode=="QRA64") dec_data.params.nsubmode=100 + m_nSubMode; @@ -3250,7 +3250,7 @@ void MainWindow::readFromStdout() //readFromStdout //Right (Rx Frequency) window bool bDisplayRight=bAvgMsg; int audioFreq=decodedtext.frequencyOffset(); - if(m_mode=="FT8" or m_mode=="FT4" or m_mode=="FST280") { + if(m_mode=="FT8" or m_mode=="FT4" or m_mode=="FST240") { auto const& parts = decodedtext.string().remove("<").remove(">") .split (' ', SkipEmptyParts); if (parts.size() > 6) { @@ -3334,7 +3334,7 @@ void MainWindow::readFromStdout() //readFromStdout //### I think this is where we are preventing Hounds from spotting Fox ### if(m_mode!="FT8" or (SpecOp::HOUND != m_config.special_op_id())) { if(m_mode=="FT8" or m_mode=="FT4" or m_mode=="QRA64" or m_mode=="JT4" - or m_mode=="JT65" or m_mode=="JT9" or m_mode=="FST280") { + or m_mode=="JT65" or m_mode=="JT9" or m_mode=="FST240") { auto_sequence (decodedtext, 25, 50); } @@ -3537,7 +3537,7 @@ void MainWindow::guiUpdate() if(m_modeTx=="JT65") txDuration=1.0 + 126*4096/11025.0; // JT65 if(m_modeTx=="QRA64") txDuration=1.0 + 84*6912/12000.0; // QRA64 if(m_modeTx=="WSPR") txDuration=2.0 + 162*8192/12000.0; // WSPR - if(m_modeTx=="FST280" or m_mode=="FST280W") { //FST280, FST280W + if(m_modeTx=="FST240" or m_mode=="FST240W") { //FST240, FST240W if(m_TRperiod==15) txDuration=1.0 + 166*800/12000.0; if(m_TRperiod==30) txDuration=1.0 + 166*1680/12000.0; if(m_TRperiod==60) txDuration=1.0 + 166*3888/12000.0; @@ -3815,7 +3815,7 @@ void MainWindow::guiUpdate() if(m_modeTx=="WSPR") genwspr_(message, msgsent, const_cast (itone), 22, 22); if(m_modeTx=="MSK144" or m_modeTx=="FT8" or m_modeTx=="FT4" - or m_modeTx=="FST280" or m_modeTx=="FST280W") { + or m_modeTx=="FST240" or m_modeTx=="FST240W") { char MyCall[6]; char MyGrid[6]; ::memcpy(MyCall, (m_config.my_callsign()+" ").toLatin1(), sizeof MyCall); @@ -3875,11 +3875,11 @@ void MainWindow::guiUpdate() gen_ft4wave_(const_cast(itone),&nsym,&nsps,&fsample,&f0,foxcom_.wave, foxcom_.wave,&icmplx,&nwave); } - if(m_modeTx=="FST280" or m_modeTx=="FST280W") { + if(m_modeTx=="FST240" or m_modeTx=="FST240W") { int ichk=0; int iwspr=0; - char fst280msgbits[101]; - genfst280_(message,&ichk,msgsent,const_cast (fst280msgbits), + char fst240msgbits[101]; + genfst240_(message,&ichk,msgsent,const_cast (fst240msgbits), const_cast(itone), &iwspr, 37, 37); int hmod=int(pow(2.0,double(m_nSubMode))); int nsps=800; @@ -3895,7 +3895,7 @@ void MainWindow::guiUpdate() // int nwave=(nsym+2)*nsps; int nwave=48000 + 166*nsps; int icmplx=0; - gen_fst280wave_(const_cast(itone),&nsym,&nsps,&nwave, + gen_fst240wave_(const_cast(itone),&nsym,&nsps,&nwave, &fsample,&hmod,&f0,&icmplx,foxcom_.wave,foxcom_.wave); } @@ -5813,16 +5813,16 @@ void MainWindow::displayWidgets(qint64 n) genStdMsgs (m_rpt, true); } -void MainWindow::on_actionFST280_triggered() +void MainWindow::on_actionFST240_triggered() { int nsub=m_nSubMode; on_actionJT65_triggered(); ui->sbSubmode->setMaximum(3); m_nSubMode=nsub; ui->sbSubmode->setValue(m_nSubMode); - m_mode="FST280"; - m_modeTx="FST280"; - ui->actionFST280->setChecked(true); + m_mode="FST240"; + m_modeTx="FST240"; + ui->actionFST240->setChecked(true); WSPR_config(false); bool bVHF=m_config.enable_VHF_features(); // 012345678901234567890123456789012 @@ -5835,16 +5835,16 @@ void MainWindow::on_actionFST280_triggered() ui->cbAutoSeq->setChecked(true); m_wideGraph->setMode(m_mode); m_wideGraph->setModeTx(m_modeTx); - switch_mode (Modes::FST280); + switch_mode (Modes::FST240); statusChanged(); } -void MainWindow::on_actionFST280W_triggered() +void MainWindow::on_actionFST240W_triggered() { - m_mode="FST280W"; - m_modeTx="FST280W"; + m_mode="FST240W"; + m_modeTx="FST240W"; WSPR_config(true); - ui->actionFST280W->setChecked(true); + ui->actionFST240W->setChecked(true); // 012345678901234567890123456789012 displayWidgets(nWidgets("000001000000000001010000000000000")); bool bVHF=m_config.enable_VHF_features(); @@ -5856,7 +5856,7 @@ void MainWindow::on_actionFST280W_triggered() ui->sbSubmode->setMaximum(3); m_wideGraph->setMode(m_mode); m_wideGraph->setModeTx(m_modeTx); - switch_mode (Modes::FST280W); + switch_mode (Modes::FST240W); statusChanged(); } @@ -7163,7 +7163,7 @@ void MainWindow::transmit (double snr) true, false, snr, m_TRperiod); } - if (m_modeTx == "FST280" or m_modeTx == "FST280W") { + if (m_modeTx == "FST240" or m_modeTx == "FST240W") { m_dateTimeSentTx3=QDateTime::currentDateTimeUtc(); toneSpacing=-2.0; //Transmit a pre-computed, filtered waveform. int nsps=800; @@ -7174,7 +7174,7 @@ void MainWindow::transmit (double snr) int hmod=int(pow(2.0,double(m_nSubMode))); double dfreq=hmod*12000.0/nsps; double f0=ui->TxFreqSpinBox->value() - m_XIT + 1.5*dfreq; - Q_EMIT sendMessage (NUM_FST280_SYMBOLS,double(nsps),f0,toneSpacing, + Q_EMIT sendMessage (NUM_FST240_SYMBOLS,double(nsps),f0,toneSpacing, m_soundOutput,m_config.audio_output_channel(), true, false, snr, m_TRperiod); } @@ -7430,7 +7430,7 @@ void::MainWindow::VHF_features_enabled(bool b) void MainWindow::on_sbTR_valueChanged(int value) { // if(!m_bFastMode and n>m_nSubMode) m_MinW=m_nSubMode; - if(m_bFastMode or m_mode=="FreqCal" or m_mode=="FST280" or m_mode=="FST280W") { + if(m_bFastMode or m_mode=="FreqCal" or m_mode=="FST240" or m_mode=="FST240W") { m_TRperiod = value; m_fastGraph->setTRPeriod (value); m_modulator->setTRPeriod (value); // TODO - not thread safe @@ -8254,7 +8254,7 @@ void MainWindow::on_cbFirst_toggled(bool b) void MainWindow::on_cbAutoSeq_toggled(bool b) { if(!b) ui->cbFirst->setChecked(false); - ui->cbFirst->setVisible((m_mode=="FT8" or m_mode=="FT4" or m_mode=="FST280") and b); + ui->cbFirst->setVisible((m_mode=="FT8" or m_mode=="FT4" or m_mode=="FST240") and b); } void MainWindow::on_measure_check_box_stateChanged (int state) @@ -9031,8 +9031,8 @@ void MainWindow::on_pbBestSP_clicked() void MainWindow::set_mode (QString const& mode) { if ("FT4" == mode) on_actionFT4_triggered (); - else if ("FST280" == mode) on_actionFST280_triggered (); - else if ("FST280W" == mode) on_actionFST280W_triggered (); + else if ("FST240" == mode) on_actionFST240_triggered (); + else if ("FST240W" == mode) on_actionFST240W_triggered (); else if ("FT8" == mode) on_actionFT8_triggered (); else if ("JT4" == mode) on_actionJT4_triggered (); else if ("JT9" == mode) on_actionJT9_triggered (); diff --git a/widgets/mainwindow.h b/widgets/mainwindow.h index b342850bd..157141cdd 100644 --- a/widgets/mainwindow.h +++ b/widgets/mainwindow.h @@ -49,7 +49,7 @@ #define NUM_QRA64_SYMBOLS 84 //63 data + 21 sync #define NUM_FT8_SYMBOLS 79 #define NUM_FT4_SYMBOLS 105 -#define NUM_FST280_SYMBOLS 166 //280/2 data + 6*4 sync + 2 ramp +#define NUM_FST240_SYMBOLS 160 //240/2 data + 5*8 sync #define NUM_CW_SYMBOLS 250 #define TX_SAMPLE_RATE 48000 #define N_WIDGETS 33 @@ -205,8 +205,8 @@ private slots: void on_actionJT4_triggered(); void on_actionFT4_triggered(); void on_actionFT8_triggered(); - void on_actionFST280_triggered(); - void on_actionFST280W_triggered(); + void on_actionFST240_triggered(); + void on_actionFST240W_triggered(); void on_TxFreqSpinBox_valueChanged(int arg1); void on_actionSave_decoded_triggered(); void on_actionQuickDecode_toggled (bool); diff --git a/widgets/mainwindow.ui b/widgets/mainwindow.ui index 9b07c7714..b635ee21a 100644 --- a/widgets/mainwindow.ui +++ b/widgets/mainwindow.ui @@ -2591,7 +2591,7 @@ list. The list can be maintained in Settings (F2). - + Qt::AlignCenter @@ -2861,8 +2861,8 @@ list. The list can be maintained in Settings (F2). Mode - - + + @@ -3497,30 +3497,30 @@ list. The list can be maintained in Settings (F2). FT4 - + true - FST280 + FST240 - + - FST280-W + FST240-W - + - FT280W + FT240W - + true - FST280W + FST240W diff --git a/widgets/plotter.cpp b/widgets/plotter.cpp index 947f6a0e5..5ac16038c 100644 --- a/widgets/plotter.cpp +++ b/widgets/plotter.cpp @@ -414,7 +414,7 @@ void CPlotter::DrawOverlay() //DrawOverlay() float bw=9.0*12000.0/m_nsps; //JT9 if(m_mode=="FT4") bw=3*12000.0/576.0; //FT4 ### (3x, or 4x???) ### if(m_mode=="FT8") bw=7*12000.0/1920.0; //FT8 - if(m_mode=="FST280") { + if(m_mode=="FST240") { int h=int(pow(2.0,m_nSubMode)); int nsps=800; if(m_TRperiod==30) nsps=1680; @@ -500,7 +500,7 @@ void CPlotter::DrawOverlay() //DrawOverlay() int yTxTop=12; int yRxBottom=yTxTop + 2*yh + 4; if(m_mode=="JT9" or m_mode=="JT65" or m_mode=="JT9+JT65" - or m_mode=="QRA64" or m_mode=="FT8" or m_mode=="FT4" or m_mode=="FST280") { + or m_mode=="QRA64" or m_mode=="FT8" or m_mode=="FT4" or m_mode=="FST240") { if(m_mode=="QRA64" or (m_mode=="JT65" and m_bVHF)) { painter0.setPen(penGreen); @@ -531,7 +531,7 @@ void CPlotter::DrawOverlay() //DrawOverlay() painter0.drawLine(x1,yRxBottom-yh,x1,yRxBottom); painter0.drawLine(x1,yRxBottom,x2,yRxBottom); painter0.drawLine(x2,yRxBottom-yh,x2,yRxBottom); - if(m_mode=="FST280") { + if(m_mode=="FST240") { x1=XfromFreq(m_rxFreq-m_tol); x2=XfromFreq(m_rxFreq+m_tol); painter0.drawLine(x1,26,x2,26); // Mark the Tol range @@ -542,7 +542,7 @@ void CPlotter::DrawOverlay() //DrawOverlay() if(m_mode=="JT9" or m_mode=="JT65" or m_mode=="JT9+JT65" or m_mode.mid(0,4)=="WSPR" or m_mode=="QRA64" or m_mode=="FT8" - or m_mode=="FT4" or m_mode=="FST280") { + or m_mode=="FT4" or m_mode=="FST240") { painter0.setPen(penRed); x1=XfromFreq(m_txFreq); x2=XfromFreq(m_txFreq+bw);