chris/js8call
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Updated to r8541

Browse Source
This commit is contained in:
Jordan Sherer
2018-03-05 14:49:51 -05:00
parent a4fa5b9988
commit a32fe6a4dc
200 changed files with 20394 additions and 4957 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lib/DXped_Operations.txt
+4 -4
View File
@@ -38,15 +38,15 @@ his locator AJ10:
2. KH1DX K1ABC FN42, KH1DX W9XYZ EN37, ...
3. K1ABC KH1DX -13
4. KH1DX K1ABC R-11
5. K1ABC R 73; W9XYZ <KH1DX> -17
5. K1ABC RR73; W9XYZ <KH1DX> -17
6. ... no copy from W9XYZ ...
7. W9XYZ KH1DX -17
8. ... no copy from W9XYZ ...
9. G4AAA KH1DX -11
10. KH1DX G4AAA R-03
11. G4AAA R 73; DL3BBB <KH1DX> -12
11. G4AAA RR73; DL3BBB <KH1DX> -12
12. KH1DX DL3BBB R-09
13. DL3BBB R 73; DE <KH1DX>
13. DL3BBB RR73; DE <KH1DX>
14. ...
------------------------------------------------------------------------
@@ -144,7 +144,7 @@ hoping to find a clear slot, by using Shift+F11 and Shift+F12.
sent automatically.
- After you send the "R+rpt" message, AutoSeq will watch for a
message that starts with "MyCall R 73; ...". When that is
message that starts with "MyCall RR73; ...". When that is
received, you're in his log, and you'll be prompted to log the QSO.
Random thoughts
lib/azdist.f90
+4 -4
View File
@@ -12,10 +12,10 @@ subroutine azdist(grid1,grid2,utch,nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter)
data mygrid0/" "/,hisgrid0/" "/,utch0/-999.d0/
save
MyGrid=grid1
HisGrid=grid2
if(ichar(grid1(5:5)).eq.0) MyGrid(5:6)=' '
if(ichar(grid2(5:5)).eq.0) HisGrid(5:6)=' '
MyGrid=grid1//' '
HisGrid=grid2//' '
if(ichar(MyGrid(5:5)).eq.0) MyGrid(5:6)=' '
if(ichar(HisGrid(5:5)).eq.0) HisGrid(5:6)=' '
if(MyGrid.eq.HisGrid) then
naz=0
lib/ccf2.f90
+2 -1
View File
@@ -1,6 +1,7 @@
subroutine ccf2(ss,nz,nflip,ccfbest,xlagpk)
parameter (LAGMIN=-86,LAGMAX=258)
! parameter (LAGMIN=-86,LAGMAX=258)
parameter (LAGMIN=-112,LAGMAX=258) ! Look for DT from -3.6s to +5.0s
real ss(nz)
real ccf(-LAGMAX:LAGMAX)
integer npr(126)
lib/decode65a.f90
+6 -4
View File
@@ -1,5 +1,6 @@
subroutine decode65a(dd,npts,newdat,nqd,f0,nflip,mode65,ntrials, &
naggressive,ndepth,ntol,mycall,hiscall,hisgrid,nexp_decode, &
naggressive,ndepth,ntol,mycall,hiscall,hisgrid,nQSOProgress, &
ljt65apon, nexp_decode, &
bVHF,sync2,a,dt,nft,nspecial,qual,nhist,nsmo,decoded)
! Apply AFC corrections to a candidate JT65 signal, then decode it.
@@ -15,7 +16,7 @@ subroutine decode65a(dd,npts,newdat,nqd,f0,nflip,mode65,ntrials, &
complex c5a(512)
real s2(66,126)
real a(5)
logical bVHF,first
logical bVHF,first,ljt65apon
character decoded*22,decoded_best*22
character mycall*12,hiscall*12,hisgrid*6
character*27 cr
@@ -122,10 +123,11 @@ subroutine decode65a(dd,npts,newdat,nqd,f0,nflip,mode65,ntrials, &
endif
s2(i,1:126)=s1(jj,1:126)
enddo
nadd=ismo !### ??? ###
call decode65b(s2,nflip,nadd,mode65,ntrials,naggressive,ndepth, &
mycall,hiscall,hisgrid,nexp_decode,nqd,nft,qual,nhist,decoded)
mycall,hiscall,hisgrid,nQSOProgress,ljt65apon,nexp_decode, &
nqd,nft,qual, &
nhist,decoded)
if(nft.eq.1) then
nsmo=ismo
lib/decode65b.f90
+6 -3
View File
@@ -1,10 +1,12 @@
subroutine decode65b(s2,nflip,nadd,mode65,ntrials,naggressive,ndepth, &
mycall,hiscall,hisgrid,nexp_decode,nqd,nft,qual,nhist,decoded)
mycall,hiscall,hisgrid,nQSOProgress,ljt65apon,nexp_decode,nqd, &
nft,qual, &
nhist,decoded)
use jt65_mod
real s2(66,126)
real s3(64,63)
logical ltext
logical ltext,ljt65apon
character decoded*22
character mycall*12,hiscall*12,hisgrid*6
save
@@ -19,7 +21,8 @@ subroutine decode65b(s2,nflip,nadd,mode65,ntrials,naggressive,ndepth, &
enddo
call extract(s3,nadd,mode65,ntrials,naggressive,ndepth,nflip,mycall, &
hiscall,hisgrid,nexp_decode,ncount,nhist,decoded,ltext,nft,qual)
hiscall,hisgrid,nQSOProgress,ljt65apon,nexp_decode,ncount, &
nhist,decoded,ltext,nft,qual)
! Suppress "birdie messages" and other garbage decodes:
if(decoded(1:7).eq.'000AAA ') ncount=-1
lib/decoder.f90
+114 -17
View File
@@ -54,10 +54,13 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
10 if (params%nagain) then
open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown', &
position='append',iostat=ios)
if(params%nmode.eq.8) open(19,file=trim(temp_dir)//'/houndcallers.txt', &
status='unknown',position='append',iostat=ios)
else
open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown', &
iostat=ios)
end if
open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown',iostat=ios)
if(params%nmode.eq.8) open(19,file=trim(temp_dir)//'/houndcallers.txt', &
status='unknown',iostat=ios)
endif
if(ios.ne.0) then
nfail=nfail+1
if(nfail.le.3) then
@@ -73,9 +76,38 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
call my_ft8%decode(ft8_decoded,id2,params%nQSOProgress,params%nfqso, &
params%nftx,newdat,params%nutc,params%nfa,params%nfb, &
params%nexp_decode,params%ndepth,logical(params%nagain), &
logical(params%lapon),params%napwid,params%mycall, &
params%mygrid,params%hiscall,params%hisgrid)
logical(params%lft8apon),logical(params%lapcqonly),params%napwid, &
params%mycall,params%mygrid,params%hiscall,params%hisgrid)
call timer('decft8 ',1)
if(nfox.gt.0) then
n30min=minval(n30fox(1:nfox))
n30max=maxval(n30fox(1:nfox))
endif
j=0
rewind 19
if(nfox.eq.0) then
endfile 19
rewind 19
else
do i=1,nfox
n=n30fox(i)
if(n30max-n30fox(i).le.4) then
j=j+1
c2fox(j)=c2fox(i)
g2fox(j)=g2fox(i)
nsnrfox(j)=nsnrfox(i)
nfreqfox(j)=nfreqfox(i)
n30fox(j)=n
m=n30max-n
call azdist(params%mygrid,g2fox(j),0.d0,nAz,nEl,nDmiles,nDkm, &
nHotAz,nHotABetter)
write(19,1004) c2fox(j),g2fox(j),nsnrfox(j),nfreqfox(j),nDkm,m
1004 format(a12,1x,a4,i5,i6,i7,i3)
endif
enddo
nfox=j
flush(19)
endif
go to 800
endif
@@ -153,7 +185,8 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
logical(params%nagain),params%n2pass,logical(params%nrobust), &
ntrials,params%naggressive,params%ndepth,params%emedelay, &
logical(params%nclearave),params%mycall,params%hiscall, &
params%hisgrid,params%nexp_decode)
params%hisgrid,params%nexp_decode,params%nQSOProgress, &
logical(params%ljt65apon))
call timer('jt65a ',1)
else if(params%nmode.eq.9 .or. (params%nmode.eq.(65+9) .and. params%ntxmode.eq.9)) then
@@ -178,7 +211,8 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
logical(params%nagain),params%n2pass,logical(params%nrobust), &
ntrials,params%naggressive,params%ndepth,params%emedelay, &
logical(params%nclearave),params%mycall,params%hiscall, &
params%hisgrid,params%nexp_decode)
params%hisgrid,params%nexp_decode,params%nQSOProgress, &
logical(params%ljt65apon))
call timer('jt65a ',1)
else
call timer('decjt9 ',0)
@@ -197,7 +231,8 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
write(*,1010) nsynced,ndecoded
1010 format('<DecodeFinished>',2i4)
call flush(6)
close(13)
close(13)
close(19)
if(params%nmode.eq.4 .or. params%nmode.eq.65) close(14)
return
@@ -290,7 +325,7 @@ contains
integer, intent(in) :: nsum
integer, intent(in) :: minsync
integer i,nft
integer i,nap,nft
logical is_deep,is_average
character decoded*22,csync*2,cflags*3
@@ -332,6 +367,10 @@ contains
write(cflags(2:2),'(i1)') min(nsum,9)
if(nsum.ge.10) cflags(2:2)='*'
endif
nap=ishft(ft,-2)
if(nap.ne.0) then
write(cflags(1:3),'(a1,i1)') 'a',nap
endif
endif
csync='# '
i=0
@@ -399,22 +438,80 @@ contains
integer, intent(in) :: snr
real, intent(in) :: dt
real, intent(in) :: freq
character(len=22), intent(in) :: decoded
character(len=37), intent(in) :: decoded
character c1*12,c2*6,g2*4,w*4
integer i0,i1,i2,i3,i4,i5,n30,nwrap
integer, intent(in) :: nap
real, intent(in) :: qual
character*2 annot
character*22 decoded0
decoded0=decoded
character*37 decoded0
logical isgrid4,first,b0,b1,b2
data first/.true./
save
isgrid4(w)=(len_trim(w).eq.4 .and. &
ichar(w(1:1)).ge.ichar('A') .and. ichar(w(1:1)).le.ichar('R') .and. &
ichar(w(2:2)).ge.ichar('A') .and. ichar(w(2:2)).le.ichar('R') .and. &
ichar(w(3:3)).ge.ichar('0') .and. ichar(w(3:3)).le.ichar('9') .and. &
ichar(w(4:4)).ge.ichar('0') .and. ichar(w(4:4)).le.ichar('9'))
if(first) then
c2fox=' '
g2fox=' '
nsnrfox=-99
nfreqfox=-99
n30z=0
nwrap=0
nfox=0
first=.false.
endif
decoded0=decoded
annot=' '
if(nap.ne.0) then
write(annot,'(a1,i1)') 'a',nap
if(qual.lt.0.17) decoded0(22:22)='?'
write(annot,'(a1,i1)') 'a',nap
if(qual.lt.0.17) decoded0(22:22)='?'
endif
write(*,1000) params%nutc,snr,dt,nint(freq),decoded0,annot
i0=index(decoded0,';')
if(i0.le.0) write(*,1000) params%nutc,snr,dt,nint(freq),decoded0(1:22),annot
1000 format(i6.6,i4,f5.1,i5,' ~ ',1x,a22,1x,a2)
if(i0.gt.0) write(*,1001) params%nutc,snr,dt,nint(freq),decoded0
1001 format(i6.6,i4,f5.1,i5,' ~ ',1x,a37)
write(13,1002) params%nutc,nint(sync),snr,dt,freq,0,decoded0
1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a22,' FT8')
1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FT8')
i1=index(decoded0,' ')
i2=i1 + index(decoded0(i1+1:),' ')
i3=i2 + index(decoded0(i2+1:),' ')
if(i1.ge.3 .and. i2.ge.7 .and. i3.ge.10) then
c1=decoded0(1:i1-1)//' '
c2=decoded0(i1+1:i2-1)
g2=decoded0(i2+1:i3-1)
b0=c1.eq.params%mycall
if(len(trim(c1)).ne.len(trim(params%mycall))) then
i4=index(trim(c1),trim(params%mycall))
i5=index(trim(params%mycall),trim(c1))
if(i4.ge.1 .or. i5.ge.1) b0=.true.
endif
b1=i3-i2.eq.5 .and. isgrid4(g2)
b2=i3-i2.eq.1
if(b0 .and. (b1.or.b2) .and. nint(freq).ge.1000) then
n=params%nutc
n30=(3600*(n/10000) + 60*mod((n/100),100) + mod(n,100))/30
if(n30.lt.n30z) nwrap=nwrap+5760 !New UTC day, handle the wrap
n30z=n30
n30=n30+nwrap
nfox=nfox+1
c2fox(nfox)=c2
g2fox(nfox)=g2
nsnrfox(nfox)=snr
nfreqfox(nfox)=nint(freq)
n30fox(nfox)=n30
endif
endif
call flush(6)
call flush(13)
lib/dxped_fifo.f90
+23
View File
@@ -0,0 +1,23 @@
subroutine dxped_fifo(cx,gx,isnrx)
parameter (NCALLS=268)
character*6 xcall(NCALLS)
character*4 xgrid(NCALLS)
integer isnr(NCALLS)
character cx*6,gx*4
common/dxpfifo/nc,isnr,xcall,xgrid
if(nc.lt.NCALLS) then
nc=nc+1
cx=xcall(nc)
gx=xgrid(nc)
isnrx=isnr(nc)
else
cx=' '
gx=' '
isnrx=0
endif
return
end subroutine dxped_fifo
lib/extract.f90
+112 -23
View File
@@ -1,6 +1,7 @@
subroutine extract(s3,nadd,mode65,ntrials,naggressive,ndepth,nflip, &
mycall_12,hiscall_12,hisgrid,nexp_decode,ncount,nhist,decoded, &
ltext,nft,qual)
mycall_12,hiscall_12,hisgrid,nQSOProgress,ljt65apon, &
nexp_decode,ncount, &
nhist,decoded,ltext,nft,qual)
! Input:
! s3 64-point spectra for each of 63 data symbols
@@ -20,19 +21,86 @@ subroutine extract(s3,nadd,mode65,ntrials,naggressive,ndepth,nflip, &
use timer_module, only: timer
real s3(64,63)
character decoded*22
character decoded*22, apmessage*22
character*12 mycall_12,hiscall_12
character*6 mycall,hiscall,hisgrid
character*6 mycall0,hiscall0,hisgrid0
integer apsymbols(7,12),ap(12)
integer nappasses(0:5) ! the number of decoding passes to use for each QSO state
integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now
integer dat4(12)
integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
integer correct(63),tmp(63)
logical ltext
logical first,ltext,ljt65apon
common/chansyms65/correct
data first/.true./
save
if(mode65.eq.-99) stop !Silence compiler warning
if(first) then
! aptype
!------------------------
! 1 CQ ??? ???
! 2 MyCall ??? ???
! 3 MyCall DxCall ???
! 4 MyCall DxCall RRR
! 5 MyCall DxCall 73
! 6 MyCall DxCall DxGrid
! 7 CQ DxCall DxGrid
apsymbols=-1
nappasses=(/3,4,2,3,3,4/)
naptypes(0,1:4)=(/1,2,6,0/) ! Tx6
naptypes(1,1:4)=(/2,3,6,7/) ! Tx1
naptypes(2,1:4)=(/2,3,0,0/) ! Tx2
naptypes(3,1:4)=(/3,4,5,0/) ! Tx3
naptypes(4,1:4)=(/3,4,5,0/) ! Tx4
naptypes(5,1:4)=(/2,3,4,5/) ! Tx5
first=.false.
endif
mycall=mycall_12(1:6)
hiscall=hiscall_12(1:6)
! Fill apsymbols array
if(ljt65apon .and. &
(mycall.ne.mycall0 .or. hiscall.ne.hiscall0 .or. hisgrid.ne.hisgrid0)) then
!write(*,*) 'initializing apsymbols '
apsymbols=-1
mycall0=mycall
hiscall0=hiscall
ap=-1
apsymbols(1,1:4)=(/62,32,32,49/) ! CQ
if(len_trim(mycall).gt.0) then
apmessage=mycall//" "//mycall//" RRR"
call packmsg(apmessage,ap,itype,.false.)
if(itype.ne.1) ap=-1
apsymbols(2,1:4)=ap(1:4)
!write(*,*) 'mycall symbols ',ap(1:4)
if(len_trim(hiscall).gt.0) then
apmessage=mycall//" "//hiscall//" RRR"
call packmsg(apmessage,ap,itype,.false.)
if(itype.ne.1) ap=-1
apsymbols(3,1:9)=ap(1:9)
apsymbols(4,:)=ap
apmessage=mycall//" "//hiscall//" 73"
call packmsg(apmessage,ap,itype,.false.)
if(itype.ne.1) ap=-1
apsymbols(5,:)=ap
if(len_trim(hisgrid(1:4)).gt.0) then
apmessage=mycall//' '//hiscall//' '//hisgrid(1:4)
call packmsg(apmessage,ap,itype,.false.)
if(itype.ne.1) ap=-1
apsymbols(6,:)=ap
apmessage='CQ'//' '//hiscall//' '//hisgrid(1:4)
call packmsg(apmessage,ap,itype,.false.)
if(itype.ne.1) ap=-1
apsymbols(7,:)=ap
endif
endif
endif
endif
qual=0.
nbirdie=20
npct=50
@@ -71,27 +139,48 @@ subroutine extract(s3,nadd,mode65,ntrials,naggressive,ndepth,nflip, &
call graycode65(mr2sym,63,-1) !Remove gray code and interleaving
call interleave63(mr2sym,-1) !from second-most-reliable symbols
call interleave63(mr2prob,-1)
ntry=0
call timer('ftrsd ',0)
param=0
call ftrsd2(mrsym,mrprob,mr2sym,mr2prob,ntrials,correct,param,ntry)
call timer('ftrsd ',1)
ncandidates=param(0)
nhard=param(1)
nsoft=param(2)
nerased=param(3)
rtt=0.001*param(4)
ntotal=param(5)
qual=0.001*param(7)
nd0=81
r0=0.87
if(naggressive.eq.10) then
nd0=83
r0=0.90
npass=1 ! if ap decoding is disabled
if(ljt65apon .and. len_trim(mycall).gt.0) then
npass=1+nappasses(nQSOProgress)
!write(*,*) 'ap is on: ',npass-1,'ap passes of types ',naptypes(nQSOProgress,:)
endif
if(ntotal.le.nd0 .and. rtt.le.r0) nft=1
do ipass=1,npass
ap=-1
ntype=0
if(ipass.gt.1) then
ntype=naptypes(nQSOProgress,ipass-1)
!write(*,*) 'ap pass, type ',ntype
ap=apsymbols(ntype,:)
if(count(ap.ge.0).eq.0) cycle ! don't bother if all ap symbols are -1
!write(*,'(12i3)') ap
endif
ntry=0
call timer('ftrsd ',0)
param=0
call ftrsdap(mrsym,mrprob,mr2sym,mr2prob,ap,ntrials,correct,param,ntry)
call timer('ftrsd ',1)
ncandidates=param(0)
nhard=param(1)
nsoft=param(2)
nerased=param(3)
rtt=0.001*param(4)
ntotal=param(5)
qual=0.001*param(7)
nd0=81
r0=0.87
if(naggressive.eq.10) then
nd0=83
r0=0.90
endif
if(ntotal.le.nd0 .and. rtt.le.r0) then
nft=1+ishft(ntype,2)
endif
if(nft.gt.0) exit
enddo
!write(*,*) nft
if(nft.eq.0 .and. iand(ndepth,32).eq.32) then
qmin=2.0 - 0.1*naggressive
call timer('hint65 ',0)
lib/fox_rx.f90
+66
View File
@@ -0,0 +1,66 @@
subroutine fox_rx(fail,called,fm,hm)
! Given fm, recently transmitted by Fox, determine hm -- the next
! message for Hound to transmit
parameter (MAXSIG=5,NCALLS=268)
character*6 xcall(NCALLS)
! character*8 mycall_plus
character*4 xgrid(NCALLS)
integer isnr(NCALLS)
character*32 fm
character*22 hm
character*6 cx,called,MyCall
character*4 gx
common/dxpfifo/nc,isnr,xcall,xgrid
data MyCall/'KH1DX'/
save
call random_number(r)
if(r.lt.fail) fm='' !Hound fails to copy
i1=index(fm,MyCall)
if(fm(1:3).eq.'CQ ' .and. i1.ge.4) then
call dxped_fifo(cx,gx,isnrx)
ntimes=1
write(hm,1000) MyCall,cx,gx
1000 format(a6,1x,a6,1x,a4)
endif
! Check for a "RR73" message
ia=index(fm,trim(cx))
ib=index(fm,';')
ic=index(fm,trim(called))
id=index(fm,'RR73;')
if((ia.eq.1 .or. ic.eq.ib+2) .and. id.ge.4) then
i1=index(fm,';')+2
i2=index(fm,'<')-2
cx=fm(i1:i2) !Callsign for next QSO
call random_number(r)
ireport=nint(-20+40*r)
! Send report to next caller
write(hm,1004) MyCall,cx,ireport
1004 format(a6,1x,a6,' R',i3.2)
if(hm(16:16).eq.' ') hm(16:16)='+'
endif
! Check for a message with a report to Hound
i1=index(fm,trim(called))
i2=index(fm,MyCall)
if(i1.eq.1 .and. i2.ge.5 .and. &
(index(fm,'+').ge.8 .or. index(fm,'-').ge.8)) then
! Send "R+rpt" to Fox
write(hm,1004) MyCall,called,isnrx
if(hm(16:16).eq.' ') hm(16:16)='+'
endif
! Collapse multiple blanks in message
iz=len(trim(hm))
do iter=1,5
ib2=index(hm(1:iz),' ')
if(ib2.lt.1) exit
hm=hm(1:ib2)//hm(ib2+2:)
iz=iz-1
enddo
return
end subroutine fox_rx
lib/fox_sim.f90
+165
View File
@@ -0,0 +1,165 @@
program fox_sim
! Simulates QSO exchanges using the proposed FT8 "DXpedition" mode.
parameter (MAXSIG=5,NCALLS=268)
character*6 xcall(NCALLS)
character*4 xgrid(NCALLS)
integer isnr(NCALLS)
character*32 fmsg(MAXSIG),fm
character*22 hmsg(MAXSIG),hm
character*16 log
character*6 called(MAXSIG)
character*4 gcalled(MAXSIG)
character*6 MyCall
character*4 MyGrid
character*8 arg
character*1 c1,c2,c3,c4
integer ntot(MAXSIG),irate(MAXSIG),ntimes(MAXSIG)
logical logit
common/dxpfifo/nc,isnr,xcall,xgrid
nargs=iargc()
if(nargs.ne.2 .and. nargs.ne.4) then
print*,'Usage: fox_sim nseq maxtimes'
print*,' fox_sim nseq maxtimes nsig fail'
print*,' '
print*,' nseq: number of T/R sequences to execute'
print*,' maxtimes: number of repeats of same Tx message'
print*,' nsig: number of simultaneous Tx sigals'
print*,' fail: receiving error rate'
go to 999
endif
ii1=1
ii2=5
jj1=0
jj2=5
nseq=80
if(nargs.ge.2) then
call getarg(1,arg)
read(arg,*) nseq
call getarg(2,arg)
read(arg,*) maxtimes
endif
if(nargs.eq.4) then
call getarg(3,arg)
read(arg,*) nsig
call getarg(4,arg)
read(arg,*) fail
ii1=nsig
ii2=nsig
jj1=nint(10*fail)
jj2=nint(10*fail)
endif
! Read a file with calls and grids; insert random S/N values.
! This is used in place of an operator-selected FIFO
open(10,file='xcall.txt',status='old')
do i=1,NCALLS
read(10,1000) xcall(i),xgrid(i)
1000 format(a6,7x,a4)
if(i.ne.-99) cycle
j=mod(i-1,26)
c1=char(ichar('A')+j)
k=mod((i-1)/26,26)
c2=char(ichar('A')+k)
n=mod((i-1)/260,10)
c3=char(ichar('0')+n)
xcall(i)='K'//c2//c3//c1//c1//c1
j=mod(i-1,18)
c1=char(ichar('A')+j)
k=mod((i-1)/18,18)
c2=char(ichar('A')+k)
n=mod((i-1)/10,10)
c4=char(ichar('0')+n)
n=mod((i-1)/100,10)
c3=char(ichar('0')+n)
xgrid(i)=c1//c2//c3//c4
call random_number(x)
isnr(i)=-20+int(40*x)
enddo
! close(10)
! Write headings for the summary file
minutes=nseq/4
write(13,1002) nseq,minutes,maxtimes
1002 format(/'Nseq:',i4,' Minutes:',i3,' Maxtimes:',i2// &
18x,'Logged QSOs',22x,'Rate (QSOs/hour)'/ &
'fail Nsig: 1 2 3 4 5 1 2 3 4 5'/ &
71('-'))
write(*,1003)
1003 format('Seq s n Fox messages Hound messages Logged info i Rate'/87('-'))
ntot=0
irate=0
MyCall='KH1DX'
MyGrid='AJ10'
do jj=jj1,jj2 !Loop over Rx failure rates
fail=0.1*jj
do ii=ii1,ii2 !Loop over range of nsig
nc=0 !Set FIFO pointer to top
ntimes=1
nsig=ii
nlogged=0
fmsg="CQ KH1DX AJ10"
hmsg=""
called=" "
do iseq=0,nseq !Loop over specified number of sequences
if(iand(iseq,1).eq.0) then
do j=1,nsig !Loop over Fox's Tx slots
fm=fmsg(j)
hm=hmsg(j)
! Call fox_tx to determine the next Tx message for this slot
call fox_tx(maxtimes,fail,called(j),gcalled(j),hm,fm, &
ntimes(j),log,logit)
fmsg(j)=fm
if(logit) then
! Log this QSO
nlogged=nlogged+1
nrate=0
if(iseq.gt.0) nrate=nint(nlogged*240.0/iseq)
write(*,1010) iseq,j,ntimes(j),fmsg(j),log,nlogged,nrate
1010 format(i4.4,2i2,1x,a32,20x,a16,2i4)
! call log_routine()
else
write(*,1010) iseq,j,ntimes(j),fmsg(j)
endif
enddo
! call transmit()
endif
if(iand(iseq,1).eq.1) then
do j=1,nsig !Listen for expected responses
fm=fmsg(j)
call fox_rx(fail,called(j),fm,hm)
if(j.ge.2) then
if(hm.eq.hmsg(j-1)) hm=""
endif
hmsg(j)=hm
write(*,1020) iseq,j,hmsg(j)
1020 format(i4.4,i2,37x,a22)
enddo
endif
write(*,1021)
1021 format(87('-'))
enddo
ntot(ii)=nlogged
irate(ii)=0
if(iseq.gt.0) irate(ii)=nint(nlogged*3600.0/(15*iseq))
write(*,1030) nsig,fail,nlogged,nc
1030 format(/'Nsig:',i3,' Fail:',f4.1,' Logged QSOs:',i4, &
' Final nc:',i4)
enddo
! Write the summary file
write(13,1100) fail,ntot,irate
1100 format(f4.1,2x,5i6,5x,5i6)
enddo
999 end program fox_sim
lib/fox_tx.f90
+92
View File
@@ -0,0 +1,92 @@
subroutine fox_tx(maxtimes,fail,called,gcalled,hm,fm,ntimes,log,logit)
! Determine fm, the next message for Fox to transmit in this slot
character*32 fm
character*22 hm
character*4 g4,MyGrid,gcalled,gx,gy
character*6 MyCall,called,cx,cy
character*16 log
logical isgrid,logit
data MyCall/'KH1DX'/,MyGrid/'AJ10'/
save
isgrid(g4)=g4(1:1).ge.'A' .and. g4(1:1).le.'R' .and. g4(2:2).ge.'A' .and. &
g4(2:2).le.'R' .and. g4(3:3).ge.'0' .and. g4(3:3).le.'9' .and. &
g4(4:4).ge.'0' .and. g4(4:4).le.'9' .and. g4(1:4).ne.'RR73'
logit=.false.
n=len(trim(hm))
g4=""
if(n.gt.8) g4=hm(n-3:n)
call random_number(r)
if(r.lt.fail .and. .not.isgrid(g4)) hm="" !Fox failed to copy
i2=len(trim(hm))
if(i2.gt.10) then
i1=index(hm,' ')
i3=index(hm(i1+1:),' ') + i1
cx=hm(i1+1:i3)
gx=hm(i2-3:i2)
i4=index(hm,MyCall)
! Check for a new caller
if(i4.eq.1 .and. isgrid(gx)) then
call random_number(r)
isent=nint(-20+40*r)
write(fm,1002) cx,MyCall,isent
1002 format(a6,1x,a6,i4.2)
if(fm(15:15).eq.' ') fm(15:15)='+'
called=cx
gcalled=gx
endif
log=''
! Check for message with R+rpt
if(i4.eq.1 .and. cx.eq.called .and. &
(index(hm,'R+').ge.8 .or. index(hm,'R-').ge.8)) then
write(log,1006) called,gcalled,isent !Format a log entry
1006 format(a6,2x,a4,i4.2)
if(log(14:14).eq.' ') log(14:14)='+'
logit=.true.
call dxped_fifo(cy,gy,isnry)
! If FIFO is empty we should call CQ in this slot
ntimes=1
write(fm,1008) cx,cy,isnry
1008 format(a6,' RR73; ',a6,1x,'<KH1DX>',i4.2)
if(fm(29:29).eq.' ') fm(29:29)='+'
called=cy
gcalled=gy
endif
endif
if(hm.eq.'') then
if(fm(1:3).ne.'CQ ') then
! if(ntimes.lt.maxtimes) then
ntimes=ntimes+1
! else
! ntimes=1
! If FIFO is empty we should call CQ in this slot
! call dxped_fifo(cy,gy,isnry)
! call random_number(r)
! isnr=nint(-20+40*r)
! write(fm,1010) cy,gy,isnr
write(fm,1010) called,MyCall,isent
1010 format(a6,1x,a6,i4.2)
if(fm(15:15).eq.' ') fm(15:15)='+'
! endif
endif
endif
! Collapse multiple blanks in message
iz=len(trim(fm))
do iter=1,5
ib2=index(fm(1:iz),' ')
if(ib2.lt.1) exit
fm=fm(1:ib2)//fm(ib2+2:)
iz=iz-1
enddo
! Generate waveform for fm
return
end subroutine fox_tx
lib/fsk4hf/ft8sim.f90
-126
View File
@@ -1,126 +0,0 @@
program ft8sim
! Generate simulated data for a 15-second HF/6m mode using 8-FSK.
! Output is saved to a *.wav file.
use wavhdr
include 'ft8_params.f90' !Set various constants
type(hdr) h !Header for .wav file
character arg*12,fname*17,sorm*1
character msg*22,msgsent*22
character*6 mygrid6
logical bcontest
complex c0(0:NMAX-1)
complex c(0:NMAX-1)
integer itone(NN)
integer*1 msgbits(KK)
integer*2 iwave(NMAX) !Generated full-length waveform
data mygrid6/'EM48 '/
! Get command-line argument(s)
nargs=iargc()
if(nargs.ne.8) then
print*,'Usage: ft8sim "message" s|m f0 DT fdop del nfiles snr'
print*,'Example: ft8sim "K1ABC W9XYZ EN37" m 1500.0 0.0 0.1 1.0 10 -18'
print*,'s|m: "s" for single signal at 1500 Hz, "m" for 25 signals'
print*,'f0 is ignored when sorm = m'
print*,'Make nfiles negative to invoke 72-bit contest mode.'
go to 999
endif
call getarg(1,msg) !Message to be transmitted
call getarg(2,sorm) !s for single signal, m for multiple sigs
if(sorm.eq."s") then
print*,"Generating single signal at 1500 Hz."
nsig=1
elseif( sorm.eq."m") then
print*,"Generating 25 signals per file."
nsig=25
else
print*,"sorm parameter must be s (single) or m (multiple)."
goto 999
endif
call getarg(3,arg)
read(arg,*) f0 !Frequency (only used for single-signal)
call getarg(4,arg)
read(arg,*) xdt !Time offset from nominal (s)
call getarg(5,arg)
read(arg,*) fspread !Watterson frequency spread (Hz)
call getarg(6,arg)
read(arg,*) delay !Watterson delay (ms)
call getarg(7,arg)
read(arg,*) nfiles !Number of files
call getarg(8,arg)
read(arg,*) snrdb !SNR_2500
bcontest=nfiles.lt.0
nfiles=abs(nfiles)
twopi=8.0*atan(1.0)
fs=12000.0 !Sample rate (Hz)
dt=1.0/fs !Sample interval (s)
tt=NSPS*dt !Duration of symbols (s)
baud=1.0/tt !Keying rate (baud)
bw=8*baud !Occupied bandwidth (Hz)
txt=NZ*dt !Transmission length (s)
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
txt=NN*NSPS/12000.0
i3bit=0 ! ### TEMPORARY ??? ###
! Source-encode, then get itone()
call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
write(*,1000) f0,xdt,txt,snrdb,bw,msgsent
1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, &
' BW:',f4.1,2x,a22)
write(*,'(28i1,1x,28i1)') msgbits(1:56)
write(*,'(16i1)') msgbits(57:72)
write(*,'(3i1)') msgbits(73:75)
write(*,'(12i1)') msgbits(76:87)
! call sgran()
do ifile=1,nfiles
c=0.
do isig=1,nsig
c0=0.
if(nsig.eq.25) then
f0=(isig+2)*100.0
endif
k=-1 + nint((xdt+0.5+0.01*gran())/dt)
! k=-1 + nint((xdt+0.5)/dt)
phi=0.0
do j=1,NN !Generate complex waveform
dphi=twopi*(f0+itone(j)*baud)*dt
do i=1,NSPS
k=k+1
phi=mod(phi+dphi,twopi)
if(k.ge.0 .and. k.lt.NMAX) c0(k)=cmplx(cos(phi),sin(phi))
enddo
enddo
if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c0,NMAX,fs,delay,fspread)
c=c+sig*c0
enddo
if(snrdb.lt.90) then
do i=0,NMAX-1 !Add gaussian noise at specified SNR
xnoise=gran()
ynoise=gran()
c(i)=c(i) + cmplx(xnoise,ynoise)
enddo
endif
fac=32767.0
rms=100.0
if(snrdb.ge.90.0) iwave(1:NMAX)=nint(fac*real(c))
if(snrdb.lt.90.0) iwave(1:NMAX)=nint(rms*real(c))
h=default_header(12000,NMAX)
write(fname,1102) ifile
1102 format('000000_',i6.6,'.wav')
open(10,file=fname,status='unknown',access='stream')
write(10) h,iwave !Save to *.wav file
close(10)
write(*,1110) ifile,xdt,f0,snrdb,fname
1110 format(i4,f7.2,f8.2,f7.1,2x,a17)
enddo
999 end program ft8sim
lib/fsk4hf/ldpcsim300.f90
+16 -14
View File
@@ -47,17 +47,19 @@ nerrdec=0
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
nargs=iargc()
if(nargs.ne.3) then
print*,'Usage: ldpcsim niter #trials s '
print*,'eg: ldpcsim 100 1000 0.84'
if(nargs.ne.4) then
print*,'Usage: ldpcsim niter ndeep #trials s '
print*,'eg: ldpcsim 100 4 1000 0.84'
print*,'If s is negative, then value is ignored and sigma is calculated from SNR.'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ntrials
read(arg,*) ndeep
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
fsk=.false.
@@ -147,14 +149,14 @@ do idb = 20,-16,-1
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
nerrtot(nerr)=nerrtot(nerr)+1
if(nerr.ge.1) nerrtot(nerr)=nerrtot(nerr)+1
nberr=nberr+nerr
! Correct signal normalization is important for this decoder.
! rxav=sum(rxdata)/N
! rx2av=sum(rxdata*rxdata)/N
! rxsig=sqrt(rx2av-rxav*rxav)
! rxdata=rxdata/rxsig
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
! To match the metric to the channel, s should be set to the noise standard deviation.
! For now, set s to the value that optimizes decode probability near threshold.
! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of
@@ -169,9 +171,9 @@ do idb = 20,-16,-1
apmask=0
! max_iterations is max number of belief propagation iterations
call bpdecode300(llr, apmask, max_iterations, decoded, niterations, cw)
if( niterations .lt. 0 ) then
norder=3
call osd300(llr, norder, decoded, niterations, cw)
if( (niterations .lt. 0) .and. (ndeep .ge. 0) ) then
call osd300(llr, apmask, ndeep, decoded, cw, nhardmin, dmin)
niterations=nhardmin
endif
n2err=0
do i=1,N
@@ -221,10 +223,10 @@ do idb = 20,-16,-1
nerrmpc=nerrmpc+1
endif
enddo
nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1 ! This histogram should inform our selection of CRC poly
if(nerrmpc.ge.1) nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1 ! This histogram should inform our selection of CRC poly
if( ncrcflag .eq. 1 .and. nueflag .eq. 0 ) then
ngood=ngood+1
nerrdec(nerr)=nerrdec(nerr)+1
if(nerr.ge.1) nerrdec(nerr)=nerrdec(nerr)+1
else if( ncrcflag .eq. 1 .and. nueflag .eq. 1 ) then
nue=nue+1;
endif
lib/fsk4hf/osd300.f90
+239 -58
View File
@@ -1,30 +1,31 @@
subroutine osd300(llr,norder,decoded,niterations,cw)
subroutine osd300(llr,apmask,ndeep,decoded,cw,nhardmin,dmin)
!
! An ordered-statistics decoder for the (300,60) code.
!
!
include "ldpc_300_60_params.f90"
integer*1 apmask(N),apmaskr(N)
integer*1 gen(K,N)
integer*1 genmrb(K,N),g2(N,K)
integer*1 temp(K),m0(K),me(K),mi(K)
integer*1 temp(K),m0(K),me(K),mi(K),misub(K),e2sub(N-K),e2(N-K),ui(N-K)
integer*1 r2pat(N-K)
integer indices(N),nxor(N)
integer*1 cw(N),ce(N),c0(N),hdec(N)
integer*1 decoded(K)
integer indx(N)
real llr(N),rx(N),absrx(N)
logical first
logical first,reset
data first/.true./
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,M
do j=1,15
do j=1, 15
read(g(i)(j:j),"(Z1)") istr
do jj=1, 4
irow=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(irow,i)=1
if( btest(istr,4-jj) ) gen(irow,i)=1
enddo
enddo
enddo
@@ -34,28 +35,26 @@ if( first ) then ! fill the generator matrix
first=.false.
endif
! re-order received vector to place systematic msg bits at the end
! Re-order received vector to place systematic msg bits at the end.
rx=llr(colorder+1)
apmaskr=apmask(colorder+1)
! hard decode the received word
! Hard decisions on the received word.
hdec=0
where(rx .ge. 0) hdec=1
! use magnitude of received symbols as a measure of reliability.
! 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.
! 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
! 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).
! reliability will not be strictly decreasing because column re-ordering is needed
! to put the generator matrix in systematic form. the "indices" array tracks
! column permutations caused by reliability sorting and gaussian elimination.
do id=1,K ! diagonal element indices
do icol=id,K+20 ! The 20 is ad hoc - beware
iflag=0
@@ -71,7 +70,7 @@ do id=1,K ! diagonal element indices
endif
do ii=1,K
if( ii .ne. id .and. genmrb(ii,id) .eq. 1 ) then
genmrb(ii,1:N)=mod(genmrb(ii,1:N)+genmrb(id,1:N),2)
genmrb(ii,1:N)=ieor(genmrb(ii,1:N),genmrb(id,1:N))
endif
enddo
exit
@@ -84,66 +83,168 @@ 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. Test all such codewords against the received word to decide which
! codeword is most likely to be correct.
! 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)
s1=sum(absrx(1:K))
s2=sum(absrx(K+1:N))
xlam=5.0
rho=s1/(s1+xlam*s2)
call mrbencode(m0,c0,g2,N,K)
nxor=ieor(c0,hdec)
nhardmin=sum(nxor)
dmin=sum(nxor*absrx)
thresh=rho*dmin
cw=c0
nt=0
ntotal=0
nrejected=0
do iorder=1,norder
mi(1:K-iorder)=0
mi(K-iorder+1:K)=1
iflag=0
do while(iflag .ge. 0 )
dpat=sum(mi*absrx(1:K))
nt=nt+1
if( dpat .lt. thresh ) then ! reject unlikely error patterns
me=ieor(m0,mi)
call mrbencode(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)
thresh=rho*dmin
if(ndeep.eq.0) goto 998 ! norder=0
if(ndeep.gt.5) ndeep=5
if( ndeep.eq. 1) then
nord=1
npre1=0
npre2=0
nt=120
ntheta=12
elseif(ndeep.eq.2) then
nord=1
npre1=1
npre2=0
nt=120
ntheta=12
elseif(ndeep.eq.3) then
nord=1
npre1=1
npre2=1
nt=120
ntheta=12
ntau=15
elseif(ndeep.eq.4) then
nord=2
npre1=1
npre2=0
nt=120
ntheta=12
ntau=15
elseif(ndeep.eq.5) then
nord=4
npre1=1
npre2=1
nt=120
ntheta=20
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
else
nrejected=nrejected+1
endif
! get the next test error pattern, iflag will go negative
! when the last pattern with weight iorder has been generated
call nextpat(mi,k,iorder,iflag)
enddo
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 mrbencode(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 mrbencode(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 nextpat(misub,k,iorder,iflag)
enddo
enddo
!write(*,*) 'nhardmin ',nhardmin
!write(*,*) 'total patterns ',nt,' number rejected ',nrejected
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 boxit(reset,mi(1:ntau),ntau,ntotal,i1,i2)
enddo
enddo
! re-order the codeword to place message bits at the end
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 mrbencode(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 fetchit(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 mrbencode(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 nextpat(misub,K,nord,iflag)
enddo
endif
998 continue
! Re-order the codeword to place message bits at the end.
cw(indices)=cw
hdec(indices)=hdec
decoded=cw(M+1:N)
nerr=0
do i=1,N
if( hdec(i) .ne. cw(i) ) nerr=nerr+1
enddo
niterations=nerr
decoded=cw(M+1:N)
cw(colorder+1)=cw ! put the codeword back into received-word order
return
end subroutine osd300
@@ -179,6 +280,86 @@ subroutine nextpat(mi,k,iorder,iflag)
ms(k-nz+1:k)=1
endif
mi=ms
iflag=ind
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 nextpat
subroutine boxit(reset,e2,ntau,npindex,i1,i2)
integer*1 e2(1:ntau)
integer indexes(4000,2),fp(0:525000),np(4000)
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 boxit
subroutine fetchit(reset,e2,ntau,i1,i2)
integer indexes(4000,2),fp(0:525000),np(4000)
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 fetchit
lib/fsk4hf/spb.m
+89
View File
@@ -0,0 +1,89 @@
clear all;
global N
global R
global A
#-------------------------------------------------------------------------------
function retval = f1(theta)
global N;
global R;
retval=0.0;
gterm = gammaln(N/2) - gammaln((N+1)/2) - log(2*sqrt(pi));
rhs = -N*R*log(2);
lhs=gterm + (N-1)*log(sin(theta)) + log(1-(tan(theta).^2)/N) - log(cos(theta));
retval = rhs-real(lhs);
endfunction
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
function retval = d(N,i,x)
t1=(x.^2)/2;
t2=gammaln(N/2);
t3=-gammaln(i/2+1);
t4=-gammaln(N-i);
t5=(N-1-i)*log(sqrt(2)*x);
t6=-log(2)/2;
t7arg=1+(-1)^i * gammainc((x.^2)/2.0,(i+1)/2);
t7=log(t7arg);
retval=t1+t2+t3+t4+t5+t6+t7;
endfunction
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
function retval = maxstar(x1,x2)
retval = max(x1,x2)+log(1+exp(-abs(x1-x2)));
endfunction
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
function retval = spb_integrand(x)
global N;
global A;
t1=log(N-1);
t2=-N*(A^2)/2;
t3=-0.5*log(2*pi);
t4=(N-2)*log(sin(x));
arg=sqrt(N)*A*cos(x);
t5=maxstar(d(N,0,arg),d(N,1,arg));
for i=2:N-1
t5=maxstar(t5,d(N,i,arg));
endfor
retval=exp(t1+t2+t3+t4+t5);
endfunction
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
function retval = qfunc(x)
retval = 0.5 * erfc(x/sqrt(2));
endfunction
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
# Calculate sphere packing lower bound on the probability of word error
# given block length (N), code rate (R), and Eb/No.
#
# Ref:
# "Log-Domain Calculation of the 1959 Sphere-Packing Bound with Application to
# M-ary PSK Block Coded Modulation," Igal Sason and Gil Weichman,
# doi: 10.1109/EEEI.2006.321097
#-------------------------------------------------------------------------------
N=174
K=75
R=K/N
delta=0.01;
[ths,fval,info,output]=fzero(@f1,[delta,pi/2-delta], optimset ("jacobian", "off"));
for ebnodb=-6:0.5:4
ebno=10^(ebnodb/10.0);
esno=ebno*R;
A=sqrt(2*esno);
term1=quadcc(@spb_integrand,ths,pi/2);
term2=qfunc(sqrt(N)*A);
pe=term1+term2;
ps=1-pe;
printf("%f %f\n",ebnodb,ps);
endfor
lib/fsk4hf/wspr5d.f90
+6 -3
View File
@@ -63,7 +63,8 @@ program wspr5d
open(13,file=trim(data_dir)//'/ALL_WSPR.TXT',status='unknown', &
position='append')
maxn=8 !Default value
! maxn=8 !Default value
maxn=20
twopi=8.0*atan(1.0)
fs=NSPS*12000.0/NSPS0 !Sample rate
dt=1.0/fs !Sample interval (s)
@@ -203,12 +204,14 @@ jpk=fs*xdt
call wqdecode(idat,message,itype)
nsnr=nint(xsnr)
! freq=fMHz + 1.d-6*(fc1+fc2)
freq=fMHz + 1.d-6*(fc1+fpks(itry))
! freq=fMHz + 1.d-6*(fc1+fpks(itry))
freq=fc1+fpks(itry)
nfdot=0
write(13,1110) datetime,0,nsnr,xdt,freq,message,nfdot
1110 format(a11,2i4,f6.2,f12.7,2x,a22,i3)
write(*,1112) datetime(8:11),nsnr,xdt,freq,nfdot,message,itry
1112 format(a4,i4,f5.1,f11.6,i3,2x,a22,i4)
!1112 format(a4,i4,f5.1,f11.6,i3,2x,a22,i4)
1112 format(a4,i4,f8.3,f8.3,i3,2x,a22,i4)
endif
enddo ! ifile loop
write(*,1120)
lib/fsk4hf/wspr5d_exp.f90
+4 -2
View File
@@ -208,12 +208,14 @@ program wspr5d
idat(7)=ishft(idat(7),6)
call wqdecode(idat,message,itype)
nsnr=nint(xsnr)
freq=fMHz + 1.d-6*(fc1+fc2)
! freq=fMHz + 1.d-6*(fc1+fc2)
freq=fc1+fc2
nfdot=0
write(13,1210) datetime,0,nsnr,xdt,freq,message,nfdot
1210 format(a11,2i4,f6.2,f12.7,2x,a22,i3)
write(*,1212) datetime(8:11),nsnr,xdt,freq,nfdot,message,'*',idf,nseq,is,niterations
1212 format(a4,i4,f5.1,f11.6,i3,2x,a22,a1,i3,i3,i3,i4)
!1212 format(a4,i4,f5.1,f11.6,i3,2x,a22,a1,i3,i3,i3,i4)
1212 format(a4,i4,f8.3,f8.3,i3,2x,a22,a1,i3,i3,i3,i4)
goto 888
endif
enddo !iseq
lib/fsk4hf/wspr_fsk8d.f90
+3 -3
View File
@@ -147,8 +147,8 @@ program wspr_fsk8d
do j=1,ND
k=j+7
ps=s(0:7,k)
! ps=sqrt(ps) !### ??? ###
ps=log(ps)
ps=sqrt(ps) !### ??? ###
! ps=log(ps)
r1=max(ps(1),ps(3),ps(5),ps(7))-max(ps(0),ps(2),ps(4),ps(6))
r2=max(ps(2),ps(3),ps(6),ps(7))-max(ps(0),ps(1),ps(4),ps(5))
r4=max(ps(4),ps(5),ps(6),ps(7))-max(ps(0),ps(1),ps(2),ps(3))
@@ -161,7 +161,7 @@ program wspr_fsk8d
rx2av=sum(rxdata*rxdata)/ND
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
s0=0.84
s0=1.1
llr=2.0*rxdata/(s0*s0)
apmask=0
max_iterations=40
lib/fsk4hf/wspr_params.f90
+23
View File
@@ -0,0 +1,23 @@
parameter (NN=162)
parameter (NSPS0=8192) !Samples per symbol at 12000 S/s
parameter (NDOWN=32)
parameter (NSPS=NSPS0/NDOWN)
parameter (NZ=NSPS*NN) !Samples in waveform at 12000 S/s
parameter (NZ0=NSPS0*NN) !Samples in waveform at 375 S/s
parameter (NMAX=120*12000) !Samples in waveform at 375 S/s
! Define the sync vector:
integer*1 sync(162)
data sync/ &
1,1,0,0,0,0,0,0,1,0,0,0,1,1,1,0,0,0,1,0, &
0,1,0,1,1,1,1,0,0,0,0,0,0,0,1,0,0,1,0,1, &
0,0,0,0,0,0,1,0,1,1,0,0,1,1,0,1,0,0,0,1, &
1,0,1,0,0,0,0,1,1,0,1,0,1,0,1,0,1,0,0,1, &
0,0,1,0,1,1,0,0,0,1,1,0,1,0,1,0,0,0,1,0, &
0,0,0,0,1,0,0,1,0,0,1,1,1,0,1,1,0,0,1,1, &
0,1,0,0,0,1,1,1,0,0,0,0,0,1,0,1,0,0,1,1, &
0,0,0,0,0,0,0,1,1,0,1,0,1,1,0,0,0,1,1,0, &
0,0/
lib/fsk4hf/wspr_wav.f90
+49
View File
@@ -0,0 +1,49 @@
subroutine wspr_wav(baud,xdt,h,f0,itone,snrdb,iwave)
! Generate iwave() from itone().
include 'wspr_params.f90'
integer itone(NN)
integer*2 iwave(NMAX)
real*8 twopi,dt,dphi0,dphi1,dphi,phi
real dat(NMAX)
twopi=8.d0*atan(1.d0)
dt=1.d0/12000.d0
baud=375.0/256.0
dat=0.
if(snrdb.lt.90) then
do i=1,NMAX
dat(i)=gran() !Generate gaussian noise
enddo
bandwidth_ratio=2500.0/6000.0
sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*snrdb)
else
sig=1.0
endif
phi=0.d0
k=nint(xdt/dt)
do j=1,NN
dphi=twopi*(f0+h*(itone(j)-1.5)*baud)*dt
do i=1,NSPS0
k=k+1
phi=mod(phi+dphi,twopi)
if(k.gt.0 .and. k.le.NMAX) dat(k)=dat(k) + sig*sin(phi)
enddo
enddo
rms=100.0
if(snrdb.lt.90.0) then
dat=rms*dat;
if(maxval(abs(dat)).gt.32767.0) print*,"Warning - data will be clipped."
else
datpk=maxval(abs(dat))
fac=32767.9/datpk
dat=fac*dat
endif
iwave=nint(dat)
return
end subroutine wspr_wav
lib/fsk4hf/wsprlfsim.f90
+3 -2
View File
@@ -124,7 +124,7 @@ program wsprlfsim
call system_clock(count2,clkfreq)
do iter=1,iters !Loop over requested iterations
c=c0
write(*,*) 'iter ',iter
call system_clock(count0,clkfreq)
if(delay.ne.0.0 .or. fspread.ne.0.0) then
call watterson(c,NZ,fs,delay,fspread)
@@ -151,9 +151,10 @@ program wsprlfsim
call system_clock(count1,clkfreq)
t(5)=t(5)+float(count1-count0)/float(clkfreq)
nc(5)=nc(5)+1
write(*,*) 'fc1 ',fc1
call system_clock(count0,clkfreq)
call getfc2w(c,csync,fs,fc1,fc2,fc3) !Refined freq
write(*,*) 'fc1,fc2,fc3 ',fc1,fc2,fc3
call system_clock(count1,clkfreq)
t(6)=t(6)+float(count1-count0)/float(clkfreq)
nc(6)=nc(6)+1
lib/fsk4hf/wsprsimf.f90
+113
View File
@@ -0,0 +1,113 @@
!-------------------------------------------------------------------------------
!
! This file is part of the WSPR application, Weak Signal Propagation Reporter
!
!-------------------------------------------------------------------------------
program wsprsim
use wavhdr
include 'wspr_params.f90'
type(hdr) hwav
character arg*12,fname14*14,fname15*15
character*22 msg,msgsent
complex c0(0:NMAX/NDOWN-1)
complex c(0:NMAX/NDOWN-1)
integer itone(NN)
integer*2 iwave(NMAX)
real*8 fMHz
! Get command-line argument(s)
nargs=iargc()
if(nargs.ne.8) then
print*,'Usage: wsprsim "message" f0 DT fsp del nwav nfiles snr'
print*,'Example: wsprsim "K1ABC FN42 30" 50 0.0 0.1 1.0 1 10 -33'
go to 999
endif
call getarg(1,msg) !Message to be transmitted
call getarg(2,arg)
read(arg,*) f0 !Freq relative to WSPR-band center (Hz)
call getarg(3,arg)
read(arg,*) xdt !Time offset from nominal (s)
call getarg(4,arg)
read(arg,*) fspread !Watterson frequency spread (Hz)
call getarg(5,arg)
read(arg,*) delay !Watterson delay (ms)
call getarg(6,arg)
read(arg,*) nwav !1 for *.wav file, 0 for *.c2 file
call getarg(7,arg)
read(arg,*) nfiles !Number of files
call getarg(8,arg)
read(arg,*) snrdb !SNR_2500
twopi=8.0*atan(1.0)
fs=12000.0/NDOWN
dt=1.0/fs
tt=NSPS*dt
baud=12000.0/8192.0
txt=NZ*dt !Transmission length (s)
bandwidth_ratio=2500.0/(fs/2.0)
sig=sqrt(bandwidth_ratio) * 10.0**(0.05*snrdb)
if(snrdb.gt.90.0) sig=1.0
txt=NN*NSPS0/12000.0
call genwspr(msg,msgsent,itone) !Encode the message, get itone
write(*,1000) f0,xdt,txt,snrdb,fspread,delay,nfiles,msgsent
1000 format('f0:',f9.3,' DT:',f6.2,' txt:',f6.1,' SNR:',f6.1, &
' fspread:',f6.1,' delay:',f6.1,' nfiles:',i3,2x,a22)
! write(*,*) "Channel symbols: "
! write(*,'(162i2)') itone
h=1.0
phi=0.0
c0=0.
k=-1 + nint(xdt/dt)
do j=1,NN
dphi=-twopi*(f0+h*(itone(j)-1.5)*baud)*dt
do i=1,NSPS
k=k+1
phi=mod(phi+dphi,twopi)
if(k.ge.0 .and. k.lt.NMAX/NDOWN) c0(k)=cmplx(cos(phi),sin(phi))
enddo
enddo
call sgran()
do ifile=1,nfiles
c=c0
if(nwav.eq.0) then
if( fspread .ne. 0.0 .or. delay .ne. 0.0 ) then
call watterson(c,NMAX/NDOWN,fs,delay,fspread)
endif
c=c*sig
if(snrdb.lt.90) then
do i=0,NMAX/NDOWN-1 !Add gaussian noise at specified SNR
xnoise=gran()
ynoise=gran()
c(i)=c(i) + cmplx(xnoise,ynoise)
enddo
endif
write(fname14,1100) ifile
1100 format('000000_',i4.4,'.c2')
open(10,file=fname14,status='unknown',access='stream')
fMHz=10.1387d0
nmin=2
write(10) fname14,nmin,fMHz,c !Save to *.c2 file
close(10)
write(*,1108) ifile,xdt,f0,snrdb,fname14
1108 format(i4,f7.2,f8.2,f7.1,2x,a14)
else
freq=1500.0+f0
call wspr_wav(baud,xdt,h,freq,itone,snrdb,iwave)
hwav=default_header(12000,NMAX)
write(fname15,1102) ifile
1102 format('000000_',i4.4,'.wav')
open(10,file=fname15,status='unknown',access='stream')
write(10) hwav,iwave !Save to *.wav file
close(10)
write(*,1110) ifile,xdt,f0,snrdb,fname15
1110 format(i4,f7.2,f8.2,f7.1,2x,a15)
endif
enddo
999 end program wsprsim
lib/ft8/DXpedQuickStart.txt
+126
View File
@@ -0,0 +1,126 @@
Quick Start for DXpedition Mode
-------------------------------
These notes are intended for operators already familiar with WSJT-X
and FT8 mode. QSOs between the Dxpedition ("Fox") and other stations
("Hounds") are completed with as little as one transmission per Hound,
as in the following examples:
----------------------------------------------------------------------------
Fox (300-600 Hz) Hounds
----------------------------------------------------------------------------
1. CQ KH1DX AJ10
2. KH1DX K1ABC FN42, KH1DX W9XYZ EN37, ...
3. K1ABC KH1DX -13
4. KH1DX K1ABC R-11
5. K1ABC RR73; W9XYZ <KH1DX> -17
6. KH1DX W9XYZ R-16
7. W9XYZ RR73; G4AAA <KH1DX> -09
8. ...
----------------------------------------------------------------------------
Everybody sets dial frequency to an agreed number and uses CAT control
with Split Operation (either *Rig* or *Fake It*). Fox transmits up to
5 signals simultaneously, at audio frequencies 300, 360, ... 540
Hz. Hounds make initial calls (e.g., line 2 above) anywhere in the
range 1000 - 4000 Hz. They send "R+rpt" 350 Hz above the frequency
where Fox called them.
INSTRUCTIONS FOR FOX
--------------------
1. Start WSJT-X in FT8 mode. Select *Fox* on the *Settings ->
Advanced tab*. On the main window, check *Tx even/1st*, *Auto Seq*,
and *Hold Tx Freq*; uncheck *Call 1st*. Set *Tx 300 Hz* and select
Tab 3.
2. In Fox mode the left window (called "Band Activity" in normal FT8
mode) is labeled "Stations calling DXpedition <MyCall>". It will be
filled with a sorted list of calling Hounds. You can sort by Call,
Grid, S/N, Distance, or Random order by using the comboBox at top
right of Tab 3. You can limit the displayed Hound callsigns to those
no stronger than *Max dB*. Fox might use this feature to discourage
Hounds from engaging in a QRO arms race.
3. *N Slots* sets the number of simultaneous Fox signals to be used.
Fox carries out as many as *N Slots* QSOs simultaneously.
4. *Repeats* sets the maximum number of repeat transmissions of the
same message. A QSO is aborted when this number would be exceeded.
5. The *CQ* comboBox on Tab 3 offers a selection of directed CQ
messages. *Reset* clears the QSO queue.
6. The Fox operator's main task is to select Hounds to be called and
worked. The text box on Tab 3 holds the "QSO queue": a list of Hound
calls to be worked. Hit Enter to select the top callsign from the
sorted list of callers (left window), or double-click on any
particular call. Either actiion moves that Hound into the "QSO
queue".
7. The right window displays decodes of signals below 1000 Hz.
Normally these should include only Hound messages containing "R+rpt"
and Fox's own transmissions.
8. To get things started, toggle *Enable Tx* to red. If a Hound call
is available in the QSO queue, that station will be called. If the
QSO queue is empty, Fox calls CQ.
9. If you're using Nslots = 2 or higher, your signal no longer has
a constant envelope. To avoid producing intermod sidebands you need
to ensure linearity in your Tx system. One way to get things about right
is to use the WSJT-X *Tune* button to generate a pure tone. Reduce the
Tx audio level until your power output decreases by 10% or so. Use this
level for your Fox transmissions.
NOTE: If you are generating Nslots signals, the average power in each one
will be 1/Nslots^2 of its normal value for single-signal transmissions.
Nslots Relative dB
-------------------
1 0
2 -6
3 -9.5
4 -12
5 -14
The following features are not yet implemented for Fox:
1. Enforce all required settings
2. Tx message timeout
3. Manual abort of selected QSO
4. All Tx and Rx messages to all.txt
5. Additional sort criteria for Hound calls
6. Selectable timeout for keeping Hounds in the sorted list
7. Display number of active callers
8. Display QSO rate
INSTRUCTIONS FOR HOUND
----------------------
1. Start WSJT-X in FT8 mode. Select *Hound* On the *Settings ->
Advanced* tab. On the main window check *Auto Seq* and uncheck *Tx
even/1st*, *Call 1st*, and *Hold Tx Freq*. Set *Tx nnnn Hz* to some
frequency between 1000 and 4000 Hz, and select *Tab 1*. Enter Fox's
callsign and locator in DX Call and DX Grid, select Tx1, and start
*Monitor*.
2. When you have copied Fox, hit *Enable Tx* to call him. You may
keep calling until he answers. You may wish to move your TxFreq
around, hoping to find a clear calling frequency.
3. When you are called by Fox with a signal report, your next
transmission will automatically be sent as Tx3 ("R+rpt"). When Fox
receives that message he responds with "RR73", and your QSO is
complete!
The following features are not yet implemented for Hound:
1. Force all required settings
2. React properly to directed CQs from Fox
3. Disable Tx2, 4, 5, 6
4. For Tx1, enforce TxFreq >= 1000 Hz
lib/fsk4hf/baseline.f90 → lib/ft8/baseline.f90
View File
lib/fsk4hf/bpdecode174.f90 → lib/ft8/bpdecode174.f90
View File
lib/fsk4hf/chkcrc12a.f90 → lib/ft8/chkcrc12a.f90
View File
lib/ft8/compress.f90
+37
View File
@@ -0,0 +1,37 @@
subroutine compress(c)
parameter (NMAX=15*12000) !Samples in iwave (180,000)
complex c(0:NMAX-1)
real xr(0:NMAX-1),xi(0:NMAX-1)
xr=real(c)
call wavestats(xr,NMAX,rms,pk,pwr_pk,pwr_ave)
xr=xr/rms
xi=aimag(c)/rms
do i=0,NMAX-1
c(i)=rms*cmplx(h1(xr(i)),h1(xi(i)))
enddo
! par=pwr_pk/pwr_ave
! write(*,1010) 5,rms,pk,pwr_pk,pwr_ave,par
!1010 format(i3,2f10.3,3f10.2)
! call wavestats(xi,NMAX,rms,pk,pwr_pk,pwr_ave)
! par=pwr_pk/pwr_ave
! write(*,1010) 5,rms,pk,pwr_pk,pwr_ave,par
return
end subroutine compress
subroutine wavestats(x,kz,rms,pk,pwr_pk,pwr_ave)
real x(kz)
sumsq=dot_product(x,x)
rms=sqrt(sumsq/kz)
pk=max(maxval(x),-minval(x))
pwr_pk=pk*pk
pwr_ave=sumsq/kz
return
end subroutine wavestats
lib/fsk4hf/encode174.f90 → lib/ft8/encode174.f90
+3 -3
View File
@@ -1,7 +1,7 @@
subroutine encode174(message,codeword)
! Encode an 101-bit message and return a 174-bit codeword.
! The generator matrix has dimensions (73,101).
! The code is a (174,101) regular ldpc code with column weight 3.
! Encode an 87-bit message and return a 174-bit codeword.
! The generator matrix has dimensions (87,87).
! The code is a (174,87) regular ldpc code with column weight 3.
! The code was generated using the PEG algorithm.
! After creating the codeword, the columns are re-ordered according to
! "colorder" to make the codeword compatible with the parity-check matrix
lib/fsk4hf/extractmessage174.f90 → lib/ft8/extractmessage174.f90
+3 -11
View File
@@ -1,11 +1,9 @@
subroutine extractmessage174(decoded,msgreceived,ncrcflag,recent_calls,nrecent)
subroutine extractmessage174(decoded,msgreceived,ncrcflag)
use iso_c_binding, only: c_loc,c_size_t
use crc
use packjt
character*22 msgreceived
character*12 call1,call2
character*12 recent_calls(nrecent)
character*87 cbits
integer*1 decoded(87)
integer*1, target:: i1Dec8BitBytes(11)
@@ -23,7 +21,7 @@ subroutine extractmessage174(decoded,msgreceived,ncrcflag,recent_calls,nrecent)
i1Dec8BitBytes(11)=0
icrc12=crc12(c_loc(i1Dec8BitBytes),11) !CRC12 computed from 75 msg bits
if(ncrc12.eq.icrc12) then
if(ncrc12.eq.icrc12 .or. sum(decoded(57:87)).eq.0) then !### Kludge ###
! CRC12 checks out --- unpack 72-bit message
do ibyte=1,12
itmp=0
@@ -32,14 +30,8 @@ subroutine extractmessage174(decoded,msgreceived,ncrcflag,recent_calls,nrecent)
enddo
i4Dec6BitWords(ibyte)=itmp
enddo
call unpackmsg144(i4Dec6BitWords,msgreceived,call1,call2)
call unpackmsg(i4Dec6BitWords,msgreceived,.false.,' ')
ncrcflag=1
if( call1(1:2) .ne. 'CQ' .and. call1(1:2) .ne. ' ' ) then
call update_recent_calls(call1,recent_calls,nrecent)
endif
if( call2(1:2) .ne. ' ' ) then
call update_recent_calls(call2,recent_calls,nrecent)
endif
else
msgreceived=' '
ncrcflag=-1
lib/ft8/filt8.f90
+52
View File
@@ -0,0 +1,52 @@
subroutine filt8(f0,nslots,width,wave)
parameter (NFFT=180000,NH=NFFT/2)
real wave(NFFT)
real x(NFFT)
real s1(0:NH)
real s2(0:NH)
complex cx(0:NH)
equivalence (x,cx)
x=wave
call four2a(x,NFFT,1,-1,0) !r2c
df=12000.0/NFFT
fa=f0 - 0.5*6.25
fb=f0 + 7.5*6.25 + (nslots-1)*60.0
ia2=nint(fa/df)
ib1=nint(fb/df)
ia1=nint(ia2-width/df)
ib2=nint(ib1+width/df)
pi=4.0*atan(1.0)
do i=ia1,ia2
fil=(1.0 + cos(pi*df*(i-ia2)/width))/2.0
cx(i)=fil*cx(i)
enddo
do i=ib1,ib2
fil=(1.0 + cos(pi*df*(i-ib1)/width))/2.0
cx(i)=fil*cx(i)
enddo
cx(0:ia1-1)=0.
cx(ib2+1:)=0.
call four2a(cx,nfft,1,1,-1) !c2r
wave=x/nfft
!###
if(nslots.ne.99) return
x=wave
call four2a(x,NFFT,1,-1,0) !r2c
do i=0,NH
s1(i)=real(cx(i))**2 + aimag(cx(i))**2
enddo
nadd=20
call smo(s1,NH+1,s2,nadd)
do i=0,NH
freq=i*df
write(29,3101) freq,db(s2(i)) - 72.0
3101 format(2f12.3)
enddo
!###
return
end subroutine filt8
lib/ft8/foxfilt.f90
+36
View File
@@ -0,0 +1,36 @@
subroutine foxfilt(nslots,nfreq,width,wave)
parameter (NN=79,ND=58,KK=87,NSPS=4*1920)
parameter (NWAVE=NN*NSPS,NFFT=614400,NH=NFFT/2)
real wave(NWAVE)
real x(NFFT)
complex cx(0:NH)
equivalence (x,cx)
x(1:NWAVE)=wave
x(NWAVE+1:)=0.
call four2a(x,NFFT,1,-1,0) !r2c
df=48000.0/NFFT
fa=nfreq - 0.5*6.25
fb=nfreq + 7.5*6.25 + (nslots-1)*60.0
ia2=nint(fa/df)
ib1=nint(fb/df)
ia1=nint(ia2-width/df)
ib2=nint(ib1+width/df)
pi=4.0*atan(1.0)
do i=ia1,ia2
fil=(1.0 + cos(pi*df*(i-ia2)/width))/2.0
cx(i)=fil*cx(i)
enddo
do i=ib1,ib2
fil=(1.0 + cos(pi*df*(i-ib1)/width))/2.0
cx(i)=fil*cx(i)
enddo
cx(0:ia1-1)=0.
cx(ib2+1:)=0.
call four2a(cx,nfft,1,1,-1) !c2r
wave=x(1:NWAVE)/nfft
return
end subroutine foxfilt
lib/ft8/foxgen.f90
+148
View File
@@ -0,0 +1,148 @@
subroutine foxgen()
! Called from MainWindow::foxTxSequencer() to generate the Tx waveform in
! FT8 Fox mode. The Tx message can contain up to 5 "slots", each carrying
! its own FT8 signal.
! Encoded messages can be of the form "HoundCall FoxCall rpt" (a standard FT8
! message with i3bit=0) or "HoundCall_1 RR73; HoundCall_2 <FoxCall> rpt",
! a new message type with i3bit=1. The waveform is generated with
! fsample=48000 Hz; it is compressed to reduce the PEP-to-average power ratio,
! with (currently disabled) filtering afterware to reduce spectral growth.
! Input message information is provided in character array cmsg(5), in
! common/foxcom/. The generated wave(NWAVE) is passed back in the same
! common block.
use crc
parameter (NN=79,ND=58,KK=87,NSPS=4*1920)
parameter (NWAVE=NN*NSPS,NFFT=614400,NH=NFFT/2)
character*40 cmsg
character*22 msg,msgsent
character*6 mygrid
character*87 cbits
character*88 cb88
logical bcontest
integer itone(NN)
integer icos7(0:6)
integer*1 msgbits(KK),codeword(3*ND),msgbits2
integer*1, target:: i1Msg8BitBytes(11)
integer*1, target:: mycall
real x(NFFT)
real*8 dt,twopi,f0,fstep,dfreq,phi,dphi
complex cx(0:NH)
common/foxcom/wave(NWAVE),nslots,nfreq,i3bit(5),cmsg(5),mycall(12)
common/foxcom2/itone2(NN),msgbits2(KK)
equivalence (x,cx),(y,cy)
data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern
bcontest=.false.
fstep=60.d0
dfreq=6.25d0
dt=1.d0/48000.d0
twopi=8.d0*atan(1.d0)
mygrid=' '
irpt=0
nplot=0
wave=0.
do n=1,nslots
i3b=i3bit(n)
if(i3b.eq.0) then
msg=cmsg(n)(1:22) !Stansard FT8 message
else
i1=index(cmsg(n),' ') !Special Fox message
i2=index(cmsg(n),';')
i3=index(cmsg(n),'<')
i4=index(cmsg(n),'>')
msg=cmsg(n)(1:i1)//cmsg(n)(i2+1:i3-2)//' '
read(cmsg(n)(i4+2:i4+4),*) irpt
endif
call genft8(msg,mygrid,bcontest,0,msgsent,msgbits,itone)
! print*,'Foxgen:',n,cmsg(n),msgsent
if(i3b.eq.1) then
icrc10=crc10(c_loc(mycall),12)
nrpt=irpt+30
write(cbits,1001) msgbits(1:56),icrc10,nrpt,i3b,0
1001 format(56b1.1,b10.10,b6.6,b3.3,b12.12)
read(cbits,1002) msgbits
1002 format(87i1)
cb88=cbits//'0'
read(cb88,1003) i1Msg8BitBytes(1:11)
1003 format(11b8)
icrc12=crc12(c_loc(i1Msg8BitBytes),11)
write(cbits,1001) msgbits(1:56),icrc10,nrpt,i3b,icrc12
read(cbits,1002) msgbits
call encode174(msgbits,codeword) !Encode the test message
! Message structure: S7 D29 S7 D29 S7
itone(1:7)=icos7
itone(36+1:36+7)=icos7
itone(NN-6:NN)=icos7
k=7
do j=1,ND
i=3*j -2
k=k+1
if(j.eq.30) k=k+7
itone(k)=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2)
enddo
endif
! Make copies of itone() and msgbits() for ft8sim
itone2=itone
msgbits2=msgbits
f0=nfreq + fstep*(n-1)
phi=0.d0
k=0
do j=1,NN
f=f0 + dfreq*itone(j)
dphi=twopi*f*dt
do ii=1,NSPS
k=k+1
phi=phi+dphi
xphi=phi
wave(k)=wave(k)+sin(xphi)
enddo
enddo
enddo
kz=k
peak1=maxval(abs(wave))
wave=wave/peak1
! call plotspec(1,wave) !Plot the spectrum
! Apply compression
! rms=sqrt(dot_product(wave,wave)/kz)
! wave=wave/rms
! do i=1,NWAVE
! wave(i)=h1(wave(i))
! enddo
! peak2=maxval(abs(wave))
! wave=wave/peak2
! call plotspec(2,wave) !Plot the spectrum
width=50.0
call foxfilt(nslots,nfreq,width,wave)
peak3=maxval(abs(wave))
wave=wave/peak3
! nadd=1000
! j=0
! do i=1,NWAVE,nadd
! sx=dot_product(wave(i:i+nadd-1),wave(i:i+nadd-1))
! j=j+1
! write(30,3001) j,sx/nadd
!3001 format(i8,f12.6)
! enddo
! call plotspec(3,wave) !Plot the spectrum
return
end subroutine foxgen
! include 'plotspec.f90'
lib/ft8/foxgen_wrap.f90
+25
View File
@@ -0,0 +1,25 @@
subroutine foxgen_wrap(msg40,msgbits,itone)
parameter (NN=79,ND=58,KK=87,NSPS=4*1920)
parameter (NWAVE=NN*NSPS)
character*40 msg40,cmsg
character*12 mycall12
integer*1 msgbits(KK),msgbits2
integer itone(NN)
common/foxcom/wave(NWAVE),nslots,nfreq,i3bit(5),cmsg(5),mycall12
common/foxcom2/itone2(NN),msgbits2(KK)
nslots=1
nfreq=300
i1=index(msg40,'<')
i2=index(msg40,'>')
mycall12=msg40(i1+1:i2-1)//' '
cmsg(1)=msg40
i3bit(1)=1
call foxgen()
msgbits=msgbits2
itone=itone2
return
end subroutine foxgen_wrap
lib/fsk4hf/ft8_downsample.f90 → lib/ft8/ft8_downsample.f90
View File
lib/fsk4hf/ft8_params.f90 → lib/ft8/ft8_params.f90
View File
lib/ft8/ft8_testmsg.f90
+145
View File
@@ -0,0 +1,145 @@
parameter (MAXTEST=75,NTEST=68)
character*40 testmsg(MAXTEST)
character*40 testmsgchk(MAXTEST)
! Test msgs should include the extremes for the different types
! See pfx.f90
! Type 1 P & A
! Type 1 1A & E5
data testmsg(1:NTEST)/ &
"CQ WB9XYZ EN34", &
"CQ DX WB9XYZ EN34", &
"QRZ WB9XYZ EN34", &
"KA1ABC WB9XYZ EN34", &
"KA1ABC WB9XYZ RO", &
"KA1ABC WB9XYZ -21", &
"KA1ABC WB9XYZ R-19", &
"KA1ABC WB9XYZ RRR", &
"KA1ABC WB9XYZ 73", &
"KA1ABC WB9XYZ", &
"CQ 000 WB9XYZ EN34", &
"CQ 999 WB9XYZ EN34", &
"CQ EU WB9XYZ EN34", &
"CQ WY WB9XYZ EN34", &
"1A/KA1ABC WB9XYZ", &
"E5/KA1ABC WB9XYZ", &
"KA1ABC 1A/WB9XYZ", &
"KA1ABC E5/WB9XYZ", &
"KA1ABC/P WB9XYZ", &
"KA1ABC/A WB9XYZ", &
"KA1ABC WB9XYZ/P", &
"KA1ABC WB9XYZ/A", &
"CQ KA1ABC/P", &
"CQ WB9XYZ/A", &
"QRZ KA1ABC/P", &
"QRZ WB9XYZ/A", &
"DE KA1ABC/P", &
"DE WB9XYZ/A", &
"CQ 1A/KA1ABC", &
"CQ E5/KA1ABC", &
"DE 1A/KA1ABC", &
"DE E5/KA1ABC", &
"QRZ 1A/KA1ABC", &
"QRZ E5/KA1ABC", &
"CQ WB9XYZ/1A", &
"CQ WB9XYZ/E5", &
"QRZ WB9XYZ/1A", &
"QRZ WB9XYZ/E5", &
"DE WB9XYZ/1A", &
"DE WB9XYZ/E5", &
"CQ A000/KA1ABC FM07", &
"CQ ZZZZ/KA1ABC FM07", &
"QRZ W4/KA1ABC FM07", &
"DE W4/KA1ABC FM07", &
"CQ W4/KA1ABC -22", &
"DE W4/KA1ABC -22", &
"QRZ W4/KA1ABC -22", &
"CQ W4/KA1ABC R-22", &
"DE W4/KA1ABC R-22", &
"QRZ W4/KA1ABC R-22", &
"DE W4/KA1ABC 73", &
"CQ KA1ABC FM07", &
"QRZ KA1ABC FM07", &
"DE KA1ABC/VE6 FM07", &
"CQ KA1ABC/VE6 -22", &
"DE KA1ABC/VE6 -22", &
"QRZ KA1ABC/VE6 -22", &
"CQ KA1ABC/VE6 R-22", &
"DE KA1ABC/VE6 R-22", &
"QRZ KA1ABC/VE6 R-22", &
"DE KA1ABC 73", &
"HELLO WORLD", &
"ZL4/KA1ABC 73", &
"KA1ABC XL/WB9XYZ", &
"KA1ABC WB9XYZ/W4", &
"DE KA1ABC/QRP 2W", &
"KA1ABC/1 WB9XYZ/1", &
"123456789ABCDEFGH"/
data testmsgchk(1:NTEST)/ &
"CQ WB9XYZ EN34", &
"CQ DX WB9XYZ EN34", &
"QRZ WB9XYZ EN34", &
"KA1ABC WB9XYZ EN34", &
"KA1ABC WB9XYZ RO", &
"KA1ABC WB9XYZ -21", &
"KA1ABC WB9XYZ R-19", &
"KA1ABC WB9XYZ RRR", &
"KA1ABC WB9XYZ 73", &
"KA1ABC WB9XYZ", &
"CQ 000 WB9XYZ EN34", &
"CQ 999 WB9XYZ EN34", &
"CQ EU WB9XYZ EN34", &
"CQ WY WB9XYZ EN34", &
"1A/KA1ABC WB9XYZ", &
"E5/KA1ABC WB9XYZ", &
"KA1ABC 1A/WB9XYZ", &
"KA1ABC E5/WB9XYZ", &
"KA1ABC/P WB9XYZ", &
"KA1ABC/A WB9XYZ", &
"KA1ABC WB9XYZ/P", &
"KA1ABC WB9XYZ/A", &
"CQ KA1ABC/P", &
"CQ WB9XYZ/A", &
"QRZ KA1ABC/P", &
"QRZ WB9XYZ/A", &
"DE KA1ABC/P", &
"DE WB9XYZ/A", &
"CQ 1A/KA1ABC", &
"CQ E5/KA1ABC", &
"DE 1A/KA1ABC", &
"DE E5/KA1ABC", &
"QRZ 1A/KA1ABC", &
"QRZ E5/KA1ABC", &
"CQ WB9XYZ/1A", &
"CQ WB9XYZ/E5", &
"QRZ WB9XYZ/1A", &
"QRZ WB9XYZ/E5", &
"DE WB9XYZ/1A", &
"DE WB9XYZ/E5", &
"CQ A000/KA1ABC FM07", &
"CQ ZZZZ/KA1ABC FM07", &
"QRZ W4/KA1ABC FM07", &
"DE W4/KA1ABC FM07", &
"CQ W4/KA1ABC -22", &
"DE W4/KA1ABC -22", &
"QRZ W4/KA1ABC -22", &
"CQ W4/KA1ABC R-22", &
"DE W4/KA1ABC R-22", &
"QRZ W4/KA1ABC R-22", &
"DE W4/KA1ABC 73", &
"CQ KA1ABC FM07", &
"QRZ KA1ABC FM07", &
"DE KA1ABC/VE6 FM07", &
"CQ KA1ABC/VE6 -22", &
"DE KA1ABC/VE6 -22", &
"QRZ KA1ABC/VE6 -22", &
"CQ KA1ABC/VE6 R-22", &
"DE KA1ABC/VE6 R-22", &
"QRZ KA1ABC/VE6 R-22", &
"DE KA1ABC 73", &
"HELLO WORLD", &
"ZL4/KA1ABC 73", &
"KA1ABC XL/WB9", &
"KA1ABC WB9XYZ", &
"DE KA1ABC/QRP", &
"KA1ABC/1 WB9X", &
"123456789ABCD"/
lib/fsk4hf/ft8apset.f90 → lib/ft8/ft8apset.f90
View File
lib/fsk4hf/ft8b.f90 → lib/ft8/ft8b.f90
+66 -23
View File
@@ -1,13 +1,16 @@
subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,napwid, &
lsubtract,nagain,iaptype,mygrid6,bcontest,sync0,f1,xdt,xbase,apsym, &
nharderrors,dmin,nbadcrc,ipass,iera,message,xsnr)
subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
napwid,lsubtract,nagain,iaptype,mycall12,mygrid6,hiscall12,bcontest, &
sync0,f1,xdt,xbase,apsym,nharderrors,dmin,nbadcrc,ipass,iera,msg37,xsnr)
use crc
use timer_module, only: timer
include 'ft8_params.f90'
parameter(NRECENT=10,NP2=2812)
parameter(NP2=2812)
character*37 msg37
character message*22,msgsent*22
character*12 recent_calls(NRECENT)
character*6 mygrid6
character*12 mycall12,hiscall12
character*6 mycall6,mygrid6,hiscall6,c1,c2
character*87 cbits
logical bcontest
real a(5)
real s1(0:7,ND),s2(0:7,NN),s1sort(8*ND)
@@ -15,19 +18,20 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,napwid, &
real bmeta(3*ND),bmetb(3*ND),bmetap(3*ND)
real llr(3*ND),llra(3*ND),llr0(3*ND),llr1(3*ND),llrap(3*ND) !Soft symbols
real dd0(15*12000)
integer*1 decoded(KK),apmask(3*ND),cw(3*ND)
integer*1 decoded(KK),decoded0(KK),apmask(3*ND),cw(3*ND)
integer*1 msgbits(KK)
integer apsym(KK)
integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16)
integer itone(NN)
integer indxs1(8*ND)
integer icos7(0:6),ip(1)
integer nappasses(0:5) ! the number of decoding passes to use for each QSO state
integer nappasses(0:5) !Number of decoding passes to use for each QSO state
integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now
integer*1, target:: i1hiscall(12)
complex cd0(3200)
complex ctwk(32)
complex csymb(32)
logical first,newdat,lsubtract,lapon,nagain
logical first,newdat,lsubtract,lapon,lapcqonly,nagain
equivalence (s1,s1sort)
data icos7/2,5,6,0,4,1,3/
data mcq/1,1,1,1,1,0,1,0,0,0,0,0,1,0,0,0,0,0,1,1,0,0,0,1,1,0,0,1/
@@ -66,7 +70,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,napwid, &
naptypes(2,1:4)=(/2,3,0,0/)
naptypes(3,1:4)=(/3,4,5,6/)
naptypes(4,1:4)=(/3,4,5,6/)
naptypes(5,1:4)=(/3,1,2,0/) !?
naptypes(5,1:4)=(/3,1,2,0/)
first=.false.
endif
@@ -265,7 +269,11 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,napwid, &
! 7 ap pass 4, etc.
if(lapon) then
npasses=4+nappasses(nQSOProgress)
if(.not.lapcqonly) then
npasses=4+nappasses(nQSOProgress)
else
npasses=5
endif
else
npasses=4
endif
@@ -283,7 +291,11 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,napwid, &
endif
if(ipass .gt. 4) then
iaptype=naptypes(nQSOProgress,ipass-4)
if(.not.lapcqonly) then
iaptype=naptypes(nQSOProgress,ipass-4)
else
iaptype=1
endif
if(iaptype.ge.3 .and. (abs(f1-nfqso).gt.napwid .and. abs(f1-nftx).gt.napwid) ) cycle
if(iaptype.eq.1 .or. iaptype.eq.2 ) then ! AP,???,???
apmask=0
@@ -351,7 +363,6 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,napwid, &
message=' '
xsnr=-99.0
if(count(cw.eq.0).eq.174) cycle !Reject the all-zero codeword
!### if(any(decoded(73:75).ne.0)) cycle !Reject if any of the 3 extra bits is nonzero
if(nharderrors.ge.0 .and. nharderrors+dmin.lt.60.0 .and. &
.not.(sync.lt.2.0 .and. nharderrors.gt.35) .and. &
.not.(ipass.gt.2 .and. nharderrors.gt.39) .and. &
@@ -362,17 +373,15 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,napwid, &
nharderrors=-1
cycle
endif
!###
i3bit=4*decoded(73) + 2*decoded(74) + decoded(75)
iFreeText=decoded(57)
! if(nbadcrc.eq.0) write(*,3001) nharderrors,nbadcrc,i3bit
!3001 format('A',3i5)
!###
if(nbadcrc.eq.0) then
call extractmessage174(decoded,message,ncrcflag,recent_calls,nrecent)
decoded0=decoded
if(i3bit.eq.1) decoded(57:)=0
call extractmessage174(decoded,message,ncrcflag)
decoded=decoded0
! This needs fixing for messages with i3bit=1:
call genft8(message,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
if(i3bit.eq.1 .and. iFreeText.eq.0) message(21:21)='1'
if(i3bit.eq.2 .and. iFreeText.eq.0) message(21:21)='2'
if(lsubtract) call subtractft8(dd0,itone,f1,xdt2)
xsig=0.0
xnoi=0.0
@@ -385,14 +394,48 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,napwid, &
if(xnoi.gt.0 .and. xnoi.lt.xsig) xsnr=xsig/xnoi-1.0
xsnr=10.0*log10(xsnr)-27.0
xsnr2=db(xsig/xbase - 1.0) - 32.0
! write(52,3052) f1,xdt,xsig,xnoi,xbase,xsnr,xsnr2
!3052 format(7f10.2)
if(.not.nagain) xsnr=xsnr2
if(xsnr .lt. -24.0) xsnr=-24.0
if(i3bit.eq.1) then
do i=1,12
i1hiscall(i)=ichar(hiscall12(i:i))
enddo
icrc10=crc10(c_loc(i1hiscall),12)
write(cbits,1001) decoded
1001 format(87i1)
read(cbits,1002) ncrc10,nrpt
1002 format(56x,b10,b6)
irpt=nrpt-30
i1=index(message,' ')
i2=index(message(i1+1:),' ') + i1
c1=message(1:i1)//' '
c2=message(i1+1:i2)//' '
if(ncrc10.eq.icrc10) msg37=c1//' RR73; '//c2//' <'// &
trim(hiscall12)//'> '
if(ncrc10.ne.icrc10) msg37=c1//' RR73; '//c2//' <...> '
! msg37=c1//' RR73; '//c2//' <...> '
write(msg37(35:37),1010) irpt
1010 format(i3.2)
if(msg37(35:35).ne.'-') msg37(35:35)='+'
iz=len(trim(msg37))
do iter=1,10 !Collapse multiple blanks
ib2=index(msg37(1:iz),' ')
if(ib2.lt.1) exit
msg37=msg37(1:ib2)//msg37(ib2+2:)
iz=iz-1
enddo
else
msg37=message//' '
endif
return
endif
enddo
return
end subroutine ft8b
lib/ft8/ft8code.f90
+134
View File
@@ -0,0 +1,134 @@
program ft8code
! Provides examples of message packing, LDPC(144,87) encoding, bit and
! symbol ordering, and other details of the FT8 protocol.
use packjt
use crc
include 'ft8_params.f90' !Set various constants
include 'ft8_testmsg.f90'
parameter (NWAVE=NN*NSPS)
character*40 msg,msgchk
character*37 msg37
character*6 c1,c2
character*9 comment
character*22 msgsent,message
character*6 mygrid6
character bad*1,msgtype*10
character*87 cbits
logical bcontest
integer itone(NN)
integer dgen(12)
integer*1 msgbits(KK),decoded(KK),decoded0(KK)
data mygrid6/'EM48 '/
! Get command-line argument(s)
nargs=iargc()
if(nargs.ne.1 .and. nargs.ne.3) then
print*
print*,'Program ft8code: Provides examples of message packing, ', &
'LDPC(174,87) encoding,'
print*,'bit and symbol ordering, and other details of the FT8 protocol.'
print*
print*,'Usage: ft8code [-c grid] "message" # Results for specified message'
print*,' ft8code -t # Examples of all message types'
go to 999
endif
bcontest=.false.
call getarg(1,msg) !Message to be transmitted
if(len(trim(msg)).eq.2 .and. msg(1:2).eq.'-t') then
testmsg(NTEST+1)='KA1ABC RR73; WB9XYZ <KH1/KH7Z> -11'
nmsg=NTEST+1
else if(len(trim(msg)).eq.2 .and. msg(1:2).eq.'-c') then
bcontest=.true.
call getarg(2,mygrid6)
call getarg(3,msg)
msgchk=msg
nmsg=1
else
msgchk=msg
call fmtmsg(msgchk,iz) !To upper case; collapse multiple blanks
nmsg=1
endif
write(*,1010)
1010 format(" Message Decoded Err? Type"/76("-"))
do imsg=1,nmsg
if(nmsg.gt.1) msg=testmsg(imsg)
call fmtmsg(msg,iz) !To upper case, collapse multiple blanks
msgchk=msg
! Generate msgsent, msgbits, and itone
if(index(msg,';').le.0) then
call packmsg(msg(1:22),dgen,itype,bcontest)
msgtype=""
if(itype.eq.1) msgtype="Std Msg"
if(itype.eq.2) msgtype="Type 1 pfx"
if(itype.eq.3) msgtype="Type 1 sfx"
if(itype.eq.4) msgtype="Type 2 pfx"
if(itype.eq.5) msgtype="Type 2 sfx"
if(itype.eq.6) msgtype="Free text"
i3bit=0
call genft8(msg(1:22),mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
else
call foxgen_wrap(msg,msgbits,itone)
i3bit=1
endif
decoded=msgbits
i3bit=4*decoded(73) + 2*decoded(74) + decoded(75)
iFreeText=decoded(57)
decoded0=decoded
if(i3bit.eq.1) decoded(57:)=0
call extractmessage174(decoded,message,ncrcflag)
decoded=decoded0
if(i3bit.eq.0) then
if(bcontest) call fix_contest_msg(mygrid6,message)
bad=" "
comment=' '
if(itype.ne.6 .and. message.ne.msgchk) bad="*"
if(itype.eq.6 .and. message(1:13).ne.msgchk(1:13)) bad="*"
if(itype.eq.6 .and. len(trim(msgchk)).gt.13) comment='truncated'
write(*,1020) imsg,msgchk,message,bad,i3bit,itype,msgtype,comment
1020 format(i2,'.',1x,a22,1x,a22,1x,a1,2i2,1x,a10,1x,a9)
else
write(cbits,1001) decoded
1001 format(87i1)
read(cbits,1002) nrpt
1002 format(66x,b6)
irpt=nrpt-30
i1=index(message,' ')
i2=index(message(i1+1:),' ') + i1
c1=message(1:i1)//' '
c2=message(i1+1:i2)//' '
msg37=c1//' RR73; '//c2//' <...> '
write(msg37(35:37),1003) irpt
1003 format(i3.2)
if(msg37(35:35).ne.'-') msg37(35:35)='+'
iz=len(trim(msg37))
do iter=1,10 !Collapse multiple blanks into one
ib2=index(msg37(1:iz),' ')
if(ib2.lt.1) exit
msg37=msg37(1:ib2)//msg37(ib2+2:)
iz=iz-1
enddo
write(*,1021) imsg,msgchk,msg37
1021 format(i2,'.',1x,a40,1x,a37)
endif
enddo
if(nmsg.eq.1) then
write(*,1030) msgbits(1:56)
1030 format(/'Call1: ',28i1,' Call2: ',28i1)
write(*,1032) msgbits(57:72),msgbits(73:75),msgbits(76:87)
1032 format('Grid: ',16i1,' 3Bit: ',3i1,' CRC12: ',12i1)
write(*,1034) itone
1034 format(/'Channel symbols:'/79i1)
endif
999 end program ft8code
lib/fsk4hf/ft8d.f90 → lib/ft8/ft8d.f90
View File
lib/ft8/ft8sim.f90
+172
View File
@@ -0,0 +1,172 @@
program ft8sim
! Generate simulated data for a 15-second HF/6m mode using 8-FSK.
! Output is saved to a *.wav file.
use wavhdr
include 'ft8_params.f90' !Set various constants
parameter (NWAVE=NN*NSPS)
type(hdr) h !Header for .wav file
character arg*12,fname*17
character msg40*40,msg*22,msgsent*22,msg0*22
character*6 mygrid6
logical bcontest
complex c0(0:NMAX-1)
complex c(0:NMAX-1)
real wave(NMAX)
integer itone(NN)
integer*1 msgbits(KK)
integer*2 iwave(NMAX) !Generated full-length waveform
data mygrid6/'EM48 '/
! Get command-line argument(s)
nargs=iargc()
if(nargs.ne.8) then
print*,'Usage: ft8sim "message" nsig|f0 DT fdop del width nfiles snr'
print*,'Examples: ft8sim "K1ABC W9XYZ EN37" 1500.0 0.0 0.1 1.0 0 10 -18'
print*,' ft8sim "K1ABC W9XYZ EN37" 10 0.0 0.1 1.0 25 10 -18'
print*,' ft8sim "K1ABC W9XYZ EN37" 25 0.0 0.1 1.0 25 10 -18'
print*,' ft8sim "K1ABC RR73; W9XYZ <KH1/KH7Z> -11" 300 0 0 0 25 1 -10'
print*,'Make nfiles negative to invoke 72-bit contest mode.'
go to 999
endif
call getarg(1,msg40) !Message to be transmitted
call getarg(2,arg)
read(arg,*) f0 !Frequency (only used for single-signal)
call getarg(3,arg)
read(arg,*) xdt !Time offset from nominal (s)
call getarg(4,arg)
read(arg,*) fspread !Watterson frequency spread (Hz)
call getarg(5,arg)
read(arg,*) delay !Watterson delay (ms)
call getarg(6,arg)
read(arg,*) width !Filter transition width (Hz)
call getarg(7,arg)
read(arg,*) nfiles !Number of files
call getarg(8,arg)
read(arg,*) snrdb !SNR_2500
nsig=1
if(f0.lt.100.0) then
nsig=f0
f0=1500
endif
bcontest=nfiles.lt.0
nfiles=abs(nfiles)
twopi=8.0*atan(1.0)
fs=12000.0 !Sample rate (Hz)
dt=1.0/fs !Sample interval (s)
tt=NSPS*dt !Duration of symbols (s)
baud=1.0/tt !Keying rate (baud)
bw=8*baud !Occupied bandwidth (Hz)
txt=NZ*dt !Transmission length (s)
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
txt=NN*NSPS/12000.0
! Source-encode, then get itone()
if(index(msg40,';').le.0) then
i3bit=0
msg=msg40(1:22)
call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
write(*,1000) f0,xdt,txt,snrdb,bw,msgsent
1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, &
' BW:',f4.1,2x,a22)
else
call foxgen_wrap(msg40,msgbits,itone)
write(*,1001) f0,xdt,txt,snrdb,bw,msg40
1001 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, &
' BW:',f4.1,2x,a40)
endif
write(*,1030) msgbits(1:56)
1030 format(/'Call1: ',28i1,' Call2: ',28i1)
write(*,1032) msgbits(57:72),msgbits(73:75),msgbits(76:87)
1032 format('Grid: ',16i1,' 3Bit: ',3i1,' CRC12: ',12i1)
write(*,1034) itone
1034 format(/'Channel symbols:'/79i1/)
msg0=msg
do ifile=1,nfiles
c=0.
do isig=1,nsig
c0=0.
if(nsig.eq.2) then
if(index(msg,'R-').gt.0) f0=500
i1=index(msg,' ')
msg(i1+4:i1+4)=char(ichar('A')+isig-1)
if(isig.eq.2) then
f0=f0+100
endif
call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
endif
if(nsig.eq.25) then
f0=(isig+2)*100.0
else if(nsig.eq.50) then
msg=msg0
f0=1000.0 + (isig-1)*60.0
i1=index(msg,' ')
i2=index(msg(i1+1:),' ') + i1
msg(i1+2:i1+2)=char(ichar('0')+mod(isig-1,10))
msg(i1+3:i1+3)=char(ichar('A')+mod(isig-1,26))
msg(i1+4:i1+4)=char(ichar('A')+mod(isig-1,26))
msg(i1+5:i1+5)=char(ichar('A')+mod(isig-1,26))
write(msg(i2+3:i2+4),'(i2.2)') isig-1
if(ifile.ge.2 .and. isig.eq.ifile-1) then
write(msg(i2+1:i2+4),1002) -isig
1002 format('R',i3.2)
f0=600.0 + mod(isig-1,5)*60.0
endif
call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
endif
k=-1 + nint((xdt+0.5+0.01*gran())/dt)
! k=-1 + nint((xdt+0.5)/dt)
ia=k+1
phi=0.0
do j=1,NN !Generate complex waveform
dphi=twopi*(f0+itone(j)*baud)*dt
do i=1,NSPS
k=k+1
phi=mod(phi+dphi,twopi)
if(k.ge.0 .and. k.lt.NMAX) c0(k)=cmplx(cos(phi),sin(phi))
enddo
enddo
if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c0,NMAX,fs,delay,fspread)
c=c+sig*c0
enddo
ib=k
wave=real(c)
peak=maxval(abs(wave(ia:ib)))
rms=sqrt(dot_product(wave(ia:ib),wave(ia:ib))/NWAVE)
nslots=1
if(width.gt.0.0) call filt8(f0,nslots,width,wave)
if(snrdb.lt.90) then
do i=1,NMAX !Add gaussian noise at specified SNR
xnoise=gran()
! wave(i)=wave(i) + xnoise
! if(i.ge.ia .and. i.le.ib) write(30,3001) i,wave(i)/peak
!3001 format(i8,f12.6)
wave(i)=wave(i) + xnoise
enddo
endif
fac=32767.0
rms=100.0
if(snrdb.ge.90.0) iwave(1:NMAX)=nint(fac*wave)
if(snrdb.lt.90.0) iwave(1:NMAX)=nint(rms*wave)
h=default_header(12000,NMAX)
write(fname,1102) ifile
1102 format('000000_',i6.6,'.wav')
open(10,file=fname,status='unknown',access='stream')
write(10) h,iwave !Save to *.wav file
close(10)
write(*,1110) ifile,xdt,f0,snrdb,fname
1110 format(i4,f7.2,f8.2,f7.1,2x,a17)
enddo
999 end program ft8sim
lib/fsk4hf/genft8.f90 → lib/ft8/genft8.f90
+1 -1
View File
@@ -8,7 +8,7 @@ subroutine genft8(msg,mygrid,bcontest,i3bit,msgsent,msgbits,itone)
character*22 msg,msgsent
character*6 mygrid
character*87 cbits
logical bcontest
logical bcontest,checksumok
integer*4 i4Msg6BitWords(12) !72-bit message as 6-bit words
integer*1 msgbits(KK),codeword(3*ND)
integer*1, target:: i1Msg8BitBytes(11)
lib/fsk4hf/genft8refsig.f90 → lib/ft8/genft8refsig.f90
View File
lib/ft8/h1.f90
+17
View File
@@ -0,0 +1,17 @@
real function h1(x)
! sigma=1.0/sqrt(2.0)
sigma=1.0
xlim=sigma/sqrt(6.0)
ax=abs(x)
sgnx=1.0
if(x.lt.0) sgnx=-1.0
if(ax.le.xlim) then
h1=x
else
z=exp(1.0/6.0 - (ax/sigma)**2)
h1=sgnx*sqrt(6.0)*sigma*(2.0/3.0 - 0.5*z)
endif
return
end function h1
lib/fsk4hf/ldpc_174_87_params.f90 → lib/ft8/ldpc_174_87_params.f90
View File
lib/fsk4hf/ldpcsim174.f90 → lib/ft8/ldpcsim174.f90
+6 -10
View File
@@ -3,10 +3,9 @@ program ldpcsim174
use crc
use packjt
parameter(NRECENT=10)
character*12 recent_calls(NRECENT)
character*22 msg,msgsent,msgreceived
character*8 arg
character*6 grid
integer*1, allocatable :: codeword(:), decoded(:), message(:)
integer*1, target:: i1Msg8BitBytes(11)
integer*1 msgbits(87)
@@ -30,9 +29,6 @@ data colorder/ &
140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,&
160,161,162,163,164,165,166,167,168,169,170,171,172,173/
do i=1,NRECENT
recent_calls(i)=' '
enddo
nerrtot=0
nerrdec=0
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
@@ -72,7 +68,7 @@ allocate ( rxdata(N), llr(N) )
msg="K1JT K9AN EN50"
! msg="G4WJS K9AN EN50"
call packmsg(msg,i4Msg6BitWords,itype,.false.) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent,.false.,'') !Unpack to get msgsent
call unpackmsg(i4Msg6BitWords,msgsent,.false.,grid) !Unpack to get msgsent
write(*,*) "message sent ",msgsent
i4=0
@@ -164,7 +160,7 @@ do idb = 20,-10,-1
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
nerrtot(nerr)=nerrtot(nerr)+1
if(nerr.ge.1) nerrtot(nerr)=nerrtot(nerr)+1
nberr=nberr+nerr
! Correct signal normalization is important for this decoder.
@@ -193,7 +189,7 @@ do idb = 20,-10,-1
if( ndepth .ge. 0 .and. nharderrors .lt. 0 ) call osd174(llr, apmask, ndepth, decoded, cw, nharderrors, dmin)
! If the decoder finds a valid codeword, nharderrors will be .ge. 0.
if( nharderrors .ge. 0 ) then
call extractmessage174(decoded,msgreceived,ncrcflag,recent_calls,nrecent)
call extractmessage174(decoded,msgreceived,ncrcflag)
if( ncrcflag .ne. 1 ) then
nbadcrc=nbadcrc+1
endif
@@ -206,11 +202,11 @@ do idb = 20,-10,-1
nerrmpc=nerrmpc+1
endif
enddo
nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1
if(nerrmpc.ge.1) nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1
if( ncrcflag .eq. 1 ) then
if( nueflag .eq. 0 ) then
ngood=ngood+1
nerrdec(nerr)=nerrdec(nerr)+1
if(nerr.ge.1) nerrdec(nerr)=nerrdec(nerr)+1
else if( nueflag .eq. 1 ) then
nue=nue+1;
endif
lib/fsk4hf/osd174.f90 → lib/ft8/osd174.f90
+8 -20
View File
@@ -25,7 +25,7 @@ if( first ) then ! fill the generator matrix
read(g(i)(j:j),"(Z1)") istr
do jj=1, 4
irow=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(irow,i)=1
if( btest(istr,4-jj) ) gen(irow,i)=1
enddo
enddo
enddo
@@ -139,15 +139,9 @@ elseif(ndeep.eq.5) then
endif
do iorder=1,nord
if( iorder.eq. 1 ) then
misub(1:K-1)=0
misub(K)=1
iflag=K
elseif( iorder.eq. 2 ) then
misub(1:K-2)=0
misub(K-1:K)=1
iflag=K-1
endif
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
@@ -209,15 +203,9 @@ if(npre2.eq.1) then
ntotal2=0
reset=.true.
! Now run through again and do the second pre-processing rule
if(nord.eq.1) then
misub(1:K-1)=0
misub(K)=1
iflag=K
elseif(nord.eq.2) then
misub(1:K-1)=0
misub(K-1:K)=1
iflag=K-1
endif
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 mrbencode(me,ce,g2,N,K)
@@ -255,7 +243,7 @@ endif
! Re-order the codeword to place message bits at the end.
cw(indices)=cw
hdec(indices)=hdec
decoded=cw(K+1:N)
decoded=cw(M+1:N)
cw(colorder+1)=cw ! put the codeword back into received-word order
return
end subroutine osd174
lib/fsk4hf/subtractft8.f90 → lib/ft8/subtractft8.f90
View File
lib/fsk4hf/sync8.f90 → lib/ft8/sync8.f90
View File
lib/fsk4hf/sync8d.f90 → lib/ft8/sync8d.f90
View File
lib/fsk4hf/twkfreq1.f90 → lib/ft8/twkfreq1.f90
View File
lib/fsk4hf/watterson.f90 → lib/ft8/watterson.f90
View File
lib/ft8_decode.f90
+26 -17
View File
@@ -1,5 +1,14 @@
module ft8_decode
parameter (MAXFOX=1000)
character*12 c2fox(MAXFOX)
character*4 g2fox(MAXFOX)
integer nsnrfox(MAXFOX)
integer nfreqfox(MAXFOX)
integer n30fox(MAXFOX)
integer n30z
integer nfox
type :: ft8_decoder
procedure(ft8_decode_callback), pointer :: callback
contains
@@ -15,7 +24,7 @@ module ft8_decode
integer, intent(in) :: snr
real, intent(in) :: dt
real, intent(in) :: freq
character(len=22), intent(in) :: decoded
character(len=37), intent(in) :: decoded
integer, intent(in) :: nap
real, intent(in) :: qual
end subroutine ft8_decode_callback
@@ -23,12 +32,12 @@ module ft8_decode
contains
subroutine decode(this,callback,iwave,nQSOProgress,nfqso,nftx,newdat, &
nutc,nfa,nfb,nexp_decode,ndepth,nagain,lapon,napwid,mycall12, &
mygrid6,hiscall12,hisgrid6)
subroutine decode(this,callback,iwave,nQSOProgress,nfqso,nftx,newdat, &
nutc,nfa,nfb,nexp_decode,ndepth,nagain,lft8apon,lapcqonly,napwid, &
mycall12,mygrid6,hiscall12,hisgrid6)
! use wavhdr
use timer_module, only: timer
include 'fsk4hf/ft8_params.f90'
include 'ft8/ft8_params.f90'
! type(hdr) h
class(ft8_decoder), intent(inout) :: this
@@ -37,13 +46,13 @@ contains
real sbase(NH1)
real candidate(3,200)
real dd(15*12000)
logical, intent(in) :: lapon,nagain
logical, intent(in) :: lft8apon,lapcqonly,nagain
logical newdat,lsubtract,ldupe,bcontest
character*12 mycall12, hiscall12
character*6 mygrid6,hisgrid6
integer*2 iwave(15*12000)
integer apsym(KK)
character datetime*13,message*22
character datetime*13,message*22,msg37*37
character*22 allmessages(100)
integer allsnrs(100)
save s,dd
@@ -96,16 +105,21 @@ contains
xbase=10.0**(0.1*(sbase(nint(f1/3.125))-40.0))
nsnr0=min(99,nint(10.0*log10(sync) - 25.5)) !### empirical ###
call timer('ft8b ',0)
call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,napwid, &
lsubtract,nagain,iaptype,mygrid6,bcontest,sync,f1,xdt,xbase, &
apsym,nharderrors,dmin,nbadcrc,iappass,iera,message,xsnr)
call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, &
lapcqonly,napwid,lsubtract,nagain,iaptype,mycall12,mygrid6, &
hiscall12,bcontest,sync,f1,xdt,xbase,apsym,nharderrors,dmin, &
nbadcrc,iappass,iera,msg37,xsnr)
message=msg37(1:22) !###
nsnr=nint(xsnr)
xdt=xdt-0.5
hd=nharderrors+dmin
call timer('ft8b ',1)
if(nbadcrc.eq.0) then
! call jtmsg(message,iflag)
if(bcontest) call fix_contest_msg(mygrid6,message)
if(bcontest) then
call fix_contest_msg(mygrid6,message)
msg37(1:22)=message
endif
! if(iand(iflag,31).ne.0) message(22:22)='?'
ldupe=.false.
do id=1,ndecodes
@@ -123,15 +137,10 @@ contains
! flush(81)
if(.not.ldupe .and. associated(this%callback)) then
qual=1.0-(nharderrors+dmin)/60.0 ! scale qual to [0.0,1.0]
call this%callback(sync,nsnr,xdt,f1,message,iaptype,qual)
call this%callback(sync,nsnr,xdt,f1,msg37,iaptype,qual)
endif
endif
enddo
! h=default_header(12000,NMAX)
! open(10,file='subtract.wav',status='unknown',access='stream')
! iwave=nint(dd)
! write(10) h,iwave
! close(10)
enddo
return
end subroutine decode
lib/ftrsd/ftrsdap.c
+227
View File
@@ -0,0 +1,227 @@
/*
ftrsdap.c
A soft-decision decoder for the JT65 (63,12) Reed-Solomon code.
This decoding scheme is built around Phil Karn's Berlekamp-Massey
errors and erasures decoder. The approach is inspired by a number of
publications, including the stochastic Chase decoder described
in "Stochastic Chase Decoding of Reed-Solomon Codes", by Leroux et al.,
IEEE Communications Letters, Vol. 14, No. 9, September 2010 and
"Soft-Decision Decoding of Reed-Solomon Codes Using Successive Error-
and-Erasure Decoding," by Soo-Woong Lee and B. V. K. Vijaya Kumar.
Steve Franke K9AN and Joe Taylor K1JT
*/
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <time.h>
#include <string.h>
#include "../ftrsd/rs2.h"
static void *rs;
void getpp_(int workdat[], float *pp);
void ftrsdap_(int mrsym[], int mrprob[], int mr2sym[], int mr2prob[],
int ap[], int* ntrials0, int correct[], int param[], int ntry[])
{
int rxdat[63], rxprob[63], rxdat2[63], rxprob2[63];
int workdat[63];
int indexes[63];
int era_pos[51];
int i, j, numera, nerr, nn=63;
int ntrials = *ntrials0;
int nhard=0,nhard_min=32768,nsoft=0,nsoft_min=32768;
int ntotal=0,ntotal_min=32768,ncandidates;
int nera_best=0;
float pp,pp1,pp2;
static unsigned int nseed;
// Power-percentage symbol metrics - composite gnnf/hf
int perr[8][8] = {
{ 4, 9, 11, 13, 14, 14, 15, 15},
{ 2, 20, 20, 30, 40, 50, 50, 50},
{ 7, 24, 27, 40, 50, 50, 50, 50},
{13, 25, 35, 46, 52, 70, 50, 50},
{17, 30, 42, 54, 55, 64, 71, 70},
{25, 39, 48, 57, 64, 66, 77, 77},
{32, 45, 54, 63, 66, 75, 78, 83},
{51, 58, 57, 66, 72, 77, 82, 86}};
// Initialize the KA9Q Reed-Solomon encoder/decoder
unsigned int symsize=6, gfpoly=0x43, fcr=3, prim=1, nroots=51;
rs=init_rs_int(symsize, gfpoly, fcr, prim, nroots, 0);
// Reverse the received symbol vectors for BM decoder
for (i=0; i<63; i++) {
rxdat[i]=mrsym[62-i];
rxprob[i]=mrprob[62-i];
rxdat2[i]=mr2sym[62-i];
rxprob2[i]=mr2prob[62-i];
}
// Set ap symbols and ap mask
for (i=0; i<12; i++) {
if(ap[i]>=0) {
rxdat[11-i]=ap[i];
rxprob2[11-i]=-1;
}
}
// Sort rxprob to find indexes of the least reliable symbols
int k, pass, tmp, nsym=63;
int probs[63];
for (i=0; i<63; i++) {
indexes[i]=i;
probs[i]=rxprob[i];
}
for (pass = 1; pass <= nsym-1; pass++) {
for (k = 0; k < nsym - pass; k++) {
if( probs[k] < probs[k+1] ) {
tmp = probs[k];
probs[k] = probs[k+1];
probs[k+1] = tmp;
tmp = indexes[k];
indexes[k] = indexes[k+1];
indexes[k+1] = tmp;
}
}
}
// See if we can decode using BM HDD, and calculate the syndrome vector.
memset(era_pos,0,51*sizeof(int));
numera=0;
memcpy(workdat,rxdat,sizeof(rxdat));
nerr=decode_rs_int(rs,workdat,era_pos,numera,1);
if( nerr >= 0 ) {
// Hard-decision decoding succeeded. Save codeword and some parameters.
nhard=0;
for (i=0; i<63; i++) {
if( workdat[i] != rxdat[i] ) nhard=nhard+1;
}
memcpy(correct,workdat,63*sizeof(int));
param[0]=0;
param[1]=nhard;
param[2]=0;
param[3]=0;
param[4]=0;
param[5]=0;
param[7]=1000*1000;
ntry[0]=0;
return;
}
/*
Hard-decision decoding failed. Try the FT soft-decision method.
Generate random erasure-locator vectors and see if any of them
decode. This will generate a list of "candidate" codewords. The
soft distance between each candidate codeword and the received
word is estimated by finding the largest (pp1) and second-largest
(pp2) outputs from a synchronized filter-bank operating on the
symbol spectra, and using these to decide which candidate
codeword is "best".
*/
nseed=1; //Seed for random numbers
float ratio;
int thresh, nsum;
int thresh0[63];
ncandidates=0;
nsum=0;
int ii,jj;
for (i=0; i<nn; i++) {
nsum=nsum+rxprob[i];
j = indexes[62-i];
if( rxprob2[j]>=0 ) {
ratio = (float)rxprob2[j]/((float)rxprob[j]+0.01);
ii = 7.999*ratio;
jj = (62-i)/8;
thresh0[i] = 1.3*perr[ii][jj];
} else {
thresh0[i] = 0.0;
}
//printf("%d %d %d\n",i,j,rxdat[i]);
}
if(nsum<=0) return;
pp1=0.0;
pp2=0.0;
for (k=1; k<=ntrials; k++) {
memset(era_pos,0,51*sizeof(int));
memcpy(workdat,rxdat,sizeof(rxdat));
/*
Mark a subset of the symbols as erasures.
Run through the ranked symbols, starting with the worst, i=0.
NB: j is the symbol-vector index of the symbol with rank i.
*/
numera=0;
for (i=0; i<nn; i++) {
j = indexes[62-i];
thresh=thresh0[i];
long int ir;
// Generate a random number ir, 0 <= ir < 100 (see POSIX.1-2001 example).
nseed = nseed * 1103515245 + 12345;
ir = (unsigned)(nseed/65536) % 32768;
ir = (100*ir)/32768;
if((ir < thresh ) && numera < 51) {
era_pos[numera]=j;
numera=numera+1;
}
}
nerr=decode_rs_int(rs,workdat,era_pos,numera,0);
if( nerr >= 0 ) {
// We have a candidate codeword. Find its hard and soft distance from
// the received word. Also find pp1 and pp2 from the full array
// s3(64,63) of synchronized symbol spectra.
ncandidates=ncandidates+1;
nhard=0;
nsoft=0;
for (i=0; i<63; i++) {
if(workdat[i] != rxdat[i]) {
nhard=nhard+1;
if(workdat[i] != rxdat2[i]) {
nsoft=nsoft+rxprob[i];
}
}
}
nsoft=63*nsoft/nsum;
ntotal=nsoft+nhard;
getpp_(workdat,&pp);
if(pp>pp1) {
pp2=pp1;
pp1=pp;
nsoft_min=nsoft;
nhard_min=nhard;
ntotal_min=ntotal;
memcpy(correct,workdat,63*sizeof(int));
nera_best=numera;
ntry[0]=k;
} else {
if(pp>pp2 && pp!=pp1) pp2=pp;
}
if(nhard_min <= 41 && ntotal_min <= 71) break;
}
if(k == ntrials) ntry[0]=k;
}
param[0]=ncandidates;
param[1]=nhard_min;
param[2]=nsoft_min;
param[3]=nera_best;
param[4]=1000.0*pp2/pp1;
param[5]=ntotal_min;
param[6]=ntry[0];
param[7]=1000.0*pp2;
param[8]=1000.0*pp1;
if(param[0]==0) param[2]=-1;
return;
}
lib/genmsk144.f90
+1 -1
View File
@@ -100,7 +100,7 @@ subroutine genmsk144(msg0,mygrid,ichk,bcontest,msgsent,i4tone,itype)
ihash=nhash(c_loc(i1Msg8BitBytes),int(9,c_size_t),146)
ihash=2*iand(ihash,32767) !Generate the 8-bit hash
i1Msg8BitBytes(10)=i1hash(1) !CRC to byte 10
i1Msg8BitBytes(10)=i1hash(1) !Hash code to byte 10
mbit=0
do i=1, 10
lib/jt65.f90
+9 -8
View File
@@ -9,7 +9,7 @@ program jt65
use readwav
character c,mode
logical :: display_help=.false.,nrobust=.false.,single_decode=.false.
logical :: display_help=.false.,nrobust=.false.,single_decode=.false., ljt65apon=.false.
type(wav_header) :: wav
integer*2 id2(NZMAX)
real*4 dd(NZMAX)
@@ -33,16 +33,17 @@ program jt65
,'experience decoding options (1..n), default FLAGS=0','FLAGS'), &
option ('single-signal-mode',.false.,'s','decode at signal frequency only','') ]
naggressive=0
naggressive=10
nfqso=1500
ntrials=10000
ntrials=100000
nexp_decode=0
ntol=1000
ntol=20
nsubmode=0
nlow=200
nhigh=4000
n2pass=2
ndepth=3
n2pass=1
ndepth=1
nQSOProgress=6
do
call getopt('a:d:f:hm:n:rc:x:g:X:s',long_options,c,optarg,narglen,nstat,noffset,nremain,.true.)
@@ -125,8 +126,8 @@ program jt65
dd(npts+1:)=0.
call test(dd,nutc,nfa,nfb,nfqso,ntol,nsubmode, &
n2pass,nrobust,ntrials,naggressive,ndepth, &
mycall,hiscall,hisgrid,nexp_decode)
if(nft.gt.0) exit
mycall,hiscall,hisgrid,nexp_decode,nQSOProgress,ljt65apon)
! if(nft.gt.0) exit
enddo
call timer('jt65 ',1)
lib/jt65_decode.f90
+37 -20
View File
@@ -37,7 +37,8 @@ contains
subroutine decode(this,callback,dd0,npts,newdat,nutc,nf1,nf2,nfqso, &
ntol,nsubmode,minsync,nagain,n2pass,nrobust,ntrials,naggressive, &
ndepth,emedelay,clearave,mycall,hiscall,hisgrid,nexp_decode)
ndepth,emedelay,clearave,mycall,hiscall,hisgrid,nexp_decode, &
nQSOProgress,ljt65apon)
! Process dd0() data to find and decode JT65 signals.
@@ -51,8 +52,8 @@ contains
real, intent(in) :: dd0(NZMAX),emedelay
integer, intent(in) :: npts, nutc, nf1, nf2, nfqso, ntol &
, nsubmode, minsync, n2pass, ntrials, naggressive, ndepth &
, nexp_decode
logical, intent(in) :: newdat, nagain, nrobust, clearave
, nexp_decode, nQSOProgress
logical, intent(in) :: newdat, nagain, nrobust, clearave, ljt65apon
character(len=12), intent(in) :: mycall, hiscall
character(len=6), intent(in) :: hisgrid
@@ -120,9 +121,26 @@ contains
go to 900
endif
! do ipass=1,n2pass !Two-pass decoding loop
npass=1
if(n2pass .gt. 1) npass=ndepth+1 !**** TEMPORARY ****
single_decode=iand(nexp_decode,32).ne.0 .or. nagain
bVHF=iand(nexp_decode,64).ne.0
if( bVHF ) then
nvec=ntrials
npass=1
if(n2pass.gt.1) npass=2
else
nvec=1000
if(ndepth.eq.1) then
npass=2
nvec=100
elseif(ndepth.eq.2) then
npass=2
nvec=1000
else
npass=4
nvec=1000
endif
endif
do ipass=1,npass
first_time=.true.
if(ipass.eq.1) then !First-pass parameters
@@ -149,13 +167,10 @@ contains
call timer('symsp65 ',0)
ss=0.
! call symspec65(dd,npts,ss,nqsym,savg) !Get normalized symbol spectra
call symspec65(dd,npts,nqsym,savg) !Get normalized symbol spectra
call timer('symsp65 ',1)
nfa=nf1
nfb=nf2
single_decode=iand(nexp_decode,32).ne.0 .or. nagain
bVHF=iand(nexp_decode,64).ne.0
!### Q: should either of the next two uses of "single_decode" be "bVHF" instead?
if(single_decode .or. (bVHF .and. ntol.lt.1000)) then
@@ -177,7 +192,6 @@ contains
ncand=0
call timer('sync65 ',0)
! call sync65(ss,nfa,nfb,naggressive,ntol,nqsym,ca,ncand,0,bVHF)
call sync65(nfa,nfb,naggressive,ntol,nqsym,ca,ncand,nrob,bVHF)
call timer('sync65 ',1)
@@ -187,7 +201,6 @@ contains
if(ncand.eq.0) ncand=1
if(abs(ca(1)%freq - f0).gt.width) width=2*df !### ??? ###
endif
nvec=ntrials
mode65=2**nsubmode
nflip=1
@@ -213,7 +226,6 @@ contains
sync1=ca(icand)%sync
dtx=ca(icand)%dt
freq=ca(icand)%freq
!write(*,*) icand,sync1,dtx,freq,ndepth,bVHF,mode65
if(bVHF) then
flip=ca(icand)%flip
nflip=flip
@@ -225,8 +237,8 @@ contains
nft=0
nspecial=0
call decode65a(dd,npts,first_time,nqd,freq,nflip,mode65,nvec, &
naggressive,ndepth,ntol,mycall,hiscall,hisgrid, &
nexp_decode,bVHF,sync2,a,dtx,nft,nspecial,qual, &
naggressive,ndepth,ntol,mycall,hiscall,hisgrid,nQSOProgress, &
ljt65apon,nexp_decode,bVHF,sync2,a,dtx,nft,nspecial,qual, &
nhist,nsmo,decoded)
if(nspecial.eq.2) decoded='RO'
if(nspecial.eq.3) decoded='RRR'
@@ -244,7 +256,9 @@ contains
nfreq=nint(freq+a(1))
ndrift=nint(2.0*a(2))
if(bVHF) then
s2db=sync1 - 30.0 + db(width/3.3) !### VHF/UHF/microwave
xtmp=10**((sync1+16.0)/10.0) ! sync comes to us in dB
s2db=1.1*db(xtmp)+1.4*(dB(width)-4.3)-52.0
! s2db=sync1 - 30.0 + db(width/3.3) !### VHF/UHF/microwave
if(nspecial.gt.0) s2db=sync2
else
s2db=10.0*log10(sync2) - 35 !### Empirical (HF)
@@ -254,6 +268,7 @@ contains
if(nsnr.gt.-1) nsnr=-1
nftt=0
!********* DOES THIS STILL WORK WHEN NFT INCLUDES # OF AP SYMBOLS USED??
if(nft.ne.1 .and. iand(ndepth,16).eq.16 .and. (.not.prtavg)) then
! Single-sequence FT decode failed, so try for an average FT decode.
if(nutc.ne.nutc0 .or. abs(nfreq-nfreq0).gt.ntol) then
@@ -264,7 +279,8 @@ contains
nsave=mod(nsave-1,64)+1
call avg65(nutc,nsave,sync1,dtx,nflip,nfreq,mode65,ntol, &
ndepth,nagain,ntrials,naggressive,clearave,neme,mycall, &
hiscall,hisgrid,nftt,avemsg,qave,deepave,nsum,ndeepave)
hiscall,hisgrid,nftt,avemsg,qave,deepave,nsum,ndeepave, &
nQSOProgress,ljt65apon)
nsmo=param(9)
nqave=qave
@@ -329,13 +345,13 @@ contains
endif
enddo !Candidate loop
if(ipass.eq.2 .and. ndecoded.lt.1) exit
enddo !Two-pass loop
enddo !Multiple-pass loop
900 return
end subroutine decode
subroutine avg65(nutc,nsave,snrsync,dtxx,nflip,nfreq,mode65,ntol,ndepth, &
nagain, ntrials,naggressive,clearave,neme,mycall,hiscall,hisgrid,nftt, &
avemsg,qave,deepave,nsum,ndeepave)
avemsg,qave,deepave,nsum,ndeepave,nQSOProgress,ljt65apon)
! Decodes averaged JT65 data
@@ -358,7 +374,7 @@ contains
real s3c(64,63)
real dtsave(MAXAVE)
real syncsave(MAXAVE)
logical first,clearave
logical first,clearave,ljt65apon
data first/.true./
save
@@ -475,7 +491,8 @@ contains
nadd=nsum*ismo
call extract(s3c,nadd,mode65,ntrials,naggressive,ndepth,nflip,mycall, &
hiscall,hisgrid,nexp_decode,ncount,nhist,avemsg,ltext,nftt,qual)
hiscall,hisgrid,nQSOProgress,ljt65apon,nexp_decode,ncount,nhist, &
avemsg,ltext,nftt,qual)
if(nftt.eq.1) then
nsmo=ismo
param(9)=nsmo
lib/jt65_test.f90
+7 -10
View File
@@ -11,7 +11,8 @@ module jt65_test
contains
subroutine test (dd,nutc,nflow,nfhigh,nfqso,ntol,nsubmode,n2pass,nrobust &
,ntrials,naggressive,ndepth,mycall,hiscall,hisgrid,nexp_decode)
,ntrials,naggressive,ndepth,mycall,hiscall,hisgrid,nexp_decode, &
nQSOProgress,ljt65apon)
use timer_module, only: timer
use jt65_decode
implicit none
@@ -19,8 +20,8 @@ contains
include 'constants.f90'
real, intent(in) :: dd(NZMAX)
integer, intent(in) :: nutc, nflow, nfhigh, nfqso, ntol, nsubmode, n2pass &
, ntrials, naggressive, ndepth, nexp_decode
logical, intent(in) :: nrobust
, ntrials, naggressive, ndepth, nexp_decode, nQSOProgress
logical, intent(in) :: nrobust,ljt65apon
character(len=12), intent(in) :: mycall, hiscall
character(len=6), intent(in) :: hisgrid
type(jt65_decoder) :: my_decoder
@@ -33,7 +34,8 @@ contains
nsubmode=nsubmode, minsync=-1,nagain=.false.,n2pass=n2pass, &
nrobust=nrobust,ntrials=ntrials,naggressive=naggressive, &
ndepth=ndepth,emedelay=0.0,clearave=nclearave,mycall=mycall, &
hiscall=hiscall,hisgrid=hisgrid,nexp_decode=nexp_decode)
hiscall=hiscall,hisgrid=hisgrid,nexp_decode=nexp_decode, &
nQSOProgress=nQSOProgress,ljt65apon=ljt65apon)
call timer('jt65a ',1)
end subroutine test
@@ -65,16 +67,11 @@ contains
nwidth=max(nint(sqrt(t)),2)
!### deal with nflip here! ###
!### also single_decode, csync, etc... ###
write(*,1010) snr,dt,freq,decoded
1010 format(i4,f5.1,i5,1x,'#',1x,a22)
write(13,1012) nint(sync),snr,dt,freq,drift,nwidth, &
write(*,1012) nint(sync),snr,dt,freq,drift,nwidth, &
decoded,ft,sum,smo
1012 format(i4,i5,f6.2,i5,i4,i3,1x,a22,' JT65',3i3)
nft=ft
call flush(6)
! write(79,3001) sync,snr,dt,freq,candidates, &
! hard_min,total_min,rtt,tries,ft,qual,decoded
!3001 format(f5.1,i4,f5.1,i5,i6,i3,i4,f6.3,i8,i2,i3,1x,a22)
end subroutine my_callback
lib/jt65sim.f90
+299 -271
View File
@@ -1,271 +1,299 @@
program jt65sim
! Generate simulated JT65 data for testing WSJT-X
use wavhdr
use packjt
use options
parameter (NMAX=54*12000) ! = 648,000
parameter (NFFT=10*65536,NH=NFFT/2)
type(hdr) h !Header for .wav file
integer*2 iwave(NMAX) !Generated waveform
integer*4 itone(126) !Channel symbols (values 0-65)
integer dgen(12) !Twelve 6-bit data symbols
integer sent(63) !RS(63,12) codeword
real*4 xnoise(NMAX) !Generated random noise
real*4 dat(NMAX) !Generated real data
complex cdat(NMAX) !Generated complex waveform
complex cspread(0:NFFT-1) !Complex amplitude for Rayleigh fading
complex z
real*8 f0,dt,twopi,phi,dphi,baud,fsample,freq,sps
character msg*22,fname*11,csubmode*1,c,optarg*500,numbuf*32
! character call1*5,call2*5
logical :: display_help=.false.,seed_prngs=.true.
type (option) :: long_options(8) = [ &
option ('help',.false.,'h','Display this help message',''), &
option ('sub-mode',.true.,'m','sub mode, default MODE=A','MODE'), &
option ('num-sigs',.true.,'n','number of signals per file, default SIGNALS=10','SIGNALS'), &
option ('doppler-spread',.true.,'d','Doppler spread, default SPREAD=0.0','SPREAD'), &
option ('time-offset',.true.,'t','Time delta, default SECONDS=0.0','SECONDS'), &
option ('num-files',.true.,'f','Number of files to generate, default FILES=1','FILES'), &
option ('no-prng-seed',.false.,'p','Do not seed PRNGs (use for reproducible tests)',''), &
option ('strength',.true.,'s','S/N in dB (2500Hz reference b/w), default SNR=0','SNR') ]
integer nprc(126) !Sync pattern
data nprc/1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, &
0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, &
0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, &
0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, &
1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, &
0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, &
1,1,1,1,1,1/
! Default parameters:
csubmode='A'
mode65=1
nsigs=10
fspread=0.
xdt=0.
snrdb=0.
nfiles=1
do
call getopt('hm:n:d:t:f:ps:',long_options,c,optarg,narglen,nstat,noffset,nremain,.true.)
if( nstat .ne. 0 ) then
exit
end if
select case (c)
case ('h')
display_help = .true.
case ('m')
read (optarg(:narglen), *) csubmode
if(csubmode.eq.'A') mode65=1
if(csubmode.eq.'B') mode65=2
if(csubmode.eq.'C') mode65=4
case ('n')
read (optarg(:narglen), *,err=10) nsigs
case ('d')
read (optarg(:narglen), *,err=10) fspread
case ('t')
read (optarg(:narglen), *) numbuf
if (numbuf(1:1) == '\') then
read (numbuf(2:), *,err=10) xdt
else
read (numbuf, *,err=10) xdt
end if
case ('f')
read (optarg(:narglen), *,err=10) nfiles
case ('p')
seed_prngs=.false.
case ('s')
read (optarg(:narglen), *) numbuf
if (numbuf(1:1) == '\') then
read (numbuf(2:), *,err=10) snrdb
else
read (numbuf, *,err=10) snrdb
end if
end select
cycle
10 display_help=.true.
print *, 'Optional argument format error for option -', c
end do
if(display_help .or. nstat.lt.0 .or. nremain.ge.1) then
print *, ''
print *, 'Usage: jt65sim [OPTIONS]'
print *, ''
print *, ' Generate one or more simulated JT65 signals in .WAV file(s)'
print *, ''
print *, 'Example: jt65sim -m B -n 10 -d 0.2 -s \\-24.5 -t 0.0 -f 4'
print *, ''
print *, 'OPTIONS: NB Use \ (\\ on *nix shells) to escape -ve arguments'
print *, ''
do i = 1, size (long_options)
call long_options(i) % print (6)
end do
go to 999
endif
if (seed_prngs) then
call init_random_seed() ! seed Fortran RANDOM_NUMBER generator
call sgran() ! see C rand generator (used in gran)
end if
rms=100.
fsample=12000.d0 !Sample rate (Hz)
dt=1.d0/fsample !Sample interval (s)
twopi=8.d0*atan(1.d0)
npts=54*12000 !Total samples in .wav file
baud=11025.d0/4096.d0 !Keying rate
sps=12000.d0/baud !Samples per symbol, at fsample=12000 Hz
nsym=126 !Number of channel symbols
h=default_header(12000,npts)
dfsig=2000.0/nsigs !Freq spacing between sigs in file (Hz)
do ifile=1,nfiles !Loop over requested number of files
write(fname,1002) ifile !Output filename
1002 format('000000_',i4.4)
open(10,file=fname//'.wav',access='stream',status='unknown')
xnoise=0.
cdat=0.
if(snrdb.lt.90) then
do i=1,npts
xnoise(i)=gran() !Generate gaussian noise
enddo
endif
do isig=1,nsigs !Generate requested number of sigs
if(mod(nsigs,2).eq.0) f0=1500.0 + dfsig*(isig-0.5-nsigs/2)
if(mod(nsigs,2).eq.1) f0=1500.0 + dfsig*(isig-(nsigs+1)/2)
xsnr=snrdb
if(snrdb.eq.0.0) xsnr=-19 - isig
if(csubmode.eq.'B' .and. snrdb.eq.0.0) xsnr=-21 - isig
if(csubmode.eq.'C' .and. snrdb.eq.0.0) xsnr=-21 - isig
!###
! call1="K1ABC"
! ic3=65+mod(isig-1,26)
! ic2=65+mod((isig-1)/26,26)
! ic1=65
! call2="W9"//char(ic1)//char(ic2)//char(ic3)
! write(msg,1010) call1,call2,nint(xsnr)
!1010 format(a5,1x,a5,1x,i3.2)
msg="K1ABC W9XYZ EN37"
!###
call packmsg(msg,dgen,itype,.false.) !Pack message into 12 six-bit bytes
call rs_encode(dgen,sent) !Encode using RS(63,12)
call interleave63(sent,1) !Interleave channel symbols
call graycode65(sent,63,1) !Apply Gray code
k=0
do j=1,nsym !Insert sync and data into itone()
if(nprc(j).eq.0) then
k=k+1
itone(j)=sent(k)+2
else
itone(j)=0
endif
enddo
bandwidth_ratio=2500.0/6000.0
sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*xsnr)
if(xsnr.gt.90.0) sig=1.0
write(*,1020) ifile,isig,f0,csubmode,xsnr,xdt,fspread,msg
1020 format(i4,i4,f10.3,2x,a1,2x,f5.1,f6.2,f5.1,1x,a22)
phi=0.d0
dphi=0.d0
k=12000 + xdt*12000 !Start audio at t = xdt + 1.0 s
isym0=-99
do i=1,npts !Add this signal into cdat()
isym=floor(i/sps)+1
if(isym.gt.nsym) exit
if(isym.ne.isym0) then
freq=f0 + itone(isym)*baud*mode65
dphi=twopi*freq*dt
isym0=isym
endif
phi=phi + dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
z=cmplx(cos(xphi),sin(xphi))
k=k+1
if(k.ge.1) cdat(k)=cdat(k) + sig*z
enddo
enddo
if(fspread.ne.0) then !Apply specified Doppler spread
df=12000.0/nfft
twopi=8*atan(1.0)
cspread(0)=1.0
cspread(NH)=0.
! The following options were added 3/15/2016 to make the half-power tone
! widths equal to the requested Doppler spread. (Previously we effectively
! used b=1.0 and Gaussian shape, which made the tones 1.665 times wider.)
! b=2.0*sqrt(log(2.0)) !Gaussian (before 3/15/2016)
! b=2.0 !Lorenzian 3/15 - 3/27
b=6.0 !Lorenzian 3/28 onward
do i=1,NH
f=i*df
x=b*f/fspread
z=0.
a=0.
if(x.lt.3.0) then !Cutoff beyond x=3
! a=sqrt(exp(-x*x)) !Gaussian
a=sqrt(1.111/(1.0+x*x)-0.1) !Lorentzian
call random_number(r1)
phi1=twopi*r1
z=a*cmplx(cos(phi1),sin(phi1))
endif
cspread(i)=z
z=0.
if(x.lt.50.0) then
call random_number(r2)
phi2=twopi*r2
z=a*cmplx(cos(phi2),sin(phi2))
endif
cspread(NFFT-i)=z
enddo
do i=0,NFFT-1
f=i*df
if(i.gt.NH) f=(i-nfft)*df
s=real(cspread(i))**2 + aimag(cspread(i))**2
! write(13,3000) i,f,s,cspread(i)
!3000 format(i5,f10.3,3f12.6)
enddo
! s=real(cspread(0))**2 + aimag(cspread(0))**2
! write(13,3000) 1024,0.0,s,cspread(0)
call four2a(cspread,NFFT,1,1,1) !Transform to time domain
sum=0.
do i=0,NFFT-1
p=real(cspread(i))**2 + aimag(cspread(i))**2
sum=sum+p
enddo
avep=sum/NFFT
fac=sqrt(1.0/avep)
cspread=fac*cspread !Normalize to constant avg power
cdat=cspread(1:npts)*cdat !Apply Rayleigh fading
! do i=0,NFFT-1
! p=real(cspread(i))**2 + aimag(cspread(i))**2
! write(14,3010) i,p,cspread(i)
!3010 format(i8,3f12.6)
! enddo
endif
dat=aimag(cdat) + xnoise !Add the generated noise
fac=32767.0/nsigs
if(snrdb.ge.90.0) iwave(1:npts)=nint(fac*dat(1:npts))
if(snrdb.lt.90.0) iwave(1:npts)=nint(rms*dat(1:npts))
write(10) h,iwave(1:npts) !Save the .wav file
close(10)
enddo
999 end program jt65sim
program jt65sim
! Generate simulated JT65 data for testing WSJT-X
use wavhdr
use packjt
use options
parameter (NMAX=54*12000) ! = 648,000 @12kHz
parameter (NFFT=10*65536,NH=NFFT/2)
type(hdr) h !Header for .wav file
integer*2 iwave(NMAX) !Generated waveform
integer*4 itone(126) !Channel symbols (values 0-65)
integer dgen(12) !Twelve 6-bit data symbols
integer sent(63) !RS(63,12) codeword
real*4 xnoise(NMAX) !Generated random noise
real*4 dat(NMAX) !Generated real data
complex cdat(NMAX) !Generated complex waveform
complex cspread(0:NFFT-1) !Complex amplitude for Rayleigh fading
complex z
real*8 f0,dt,twopi,phi,dphi,baud,fsample,freq,sps
character msg*22,fname*11,csubmode*1,c,optarg*500,numbuf*32
! character call1*5,call2*5
logical :: display_help=.false.,seed_prngs=.true.
type (option) :: long_options(12) = [ &
option ('help',.false.,'h','Display this help message',''), &
option ('sub-mode',.true.,'m','sub mode, default MODE=A','MODE'), &
option ('num-sigs',.true.,'n','number of signals per file, default SIGNALS=10','SIGNALS'), &
option ('f0',.true.,'F','base frequency offset, default F0=1500.0','F0'), &
option ('doppler-spread',.true.,'d','Doppler spread, default SPREAD=0.0','SPREAD'), &
option ('time-offset',.true.,'t','Time delta, default SECONDS=0.0','SECONDS'), &
option ('num-files',.true.,'f','Number of files to generate, default FILES=1','FILES'), &
option ('no-prng-seed',.false.,'p','Do not seed PRNGs (use for reproducible tests)',''), &
option ('strength',.true.,'s','S/N in dB (2500Hz reference b/w), default SNR=0','SNR'), &
option ('11025',.false.,'S','Generate at 11025Hz sample rate, default 12000Hz',''), &
option ('gain-offset',.true.,'G','Gain offset in dB, default GAIN=0dB','GAIN'), &
option ('message',.true.,'M','Message text','Message') ]
integer nprc(126) !Sync pattern
data nprc/1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, &
0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, &
0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, &
0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, &
1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, &
0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, &
1,1,1,1,1,1/
! Default parameters:
csubmode='A'
mode65=1
nsigs=10
bf0=1500.
fspread=0.
xdt=0.
snrdb=0.
nfiles=1
nsample_rate=12000
gain_offset=0.
msg="K1ABC W9XYZ EN37"
do
call getopt('hm:n:F:d:t:f:ps:SG:M:',long_options,c,optarg,narglen,nstat,noffset,nremain,.true.)
if( nstat .ne. 0 ) then
exit
end if
select case (c)
case ('h')
display_help = .true.
case ('m')
read (optarg(:narglen), *) csubmode
if(csubmode.eq.'A') mode65=1
if(csubmode.eq.'B') mode65=2
if(csubmode.eq.'C') mode65=4
case ('n')
read (optarg(:narglen), *,err=10) nsigs
case ('F')
read (optarg(:narglen), *,err=10) bf0
case ('d')
read (optarg(:narglen), *,err=10) fspread
case ('t')
read (optarg(:narglen), *) numbuf
if (numbuf(1:1) == '\') then !'\'
read (numbuf(2:), *,err=10) xdt
else
read (numbuf, *,err=10) xdt
end if
case ('f')
read (optarg(:narglen), *,err=10) nfiles
case ('p')
seed_prngs=.false.
case ('s')
read (optarg(:narglen), *) numbuf
if (numbuf(1:1) == '\') then !'\'
read (numbuf(2:), *,err=10) snrdb
else
read (numbuf, *,err=10) snrdb
end if
case ('S')
nsample_rate=11025
case ('G')
read (optarg(:narglen), *) numbuf
if (numbuf(1:1) == '\') then !'\'
read (numbuf(2:), *, err=10) gain_offset
else
read (numbuf, *, err=10) gain_offset
end if
case ('M')
read (optarg(:narglen), '(A)',err=10) msg
write(*,*) msg
end select
cycle
10 display_help=.true.
print *, 'Optional argument format error for option -', c
end do
if(display_help .or. nstat.lt.0 .or. nremain.ge.1) then
print *, ''
print *, 'Usage: jt65sim [OPTIONS]'
print *, ''
print *, ' Generate one or more simulated JT65 signals in .WAV file(s)'
print *, ''
print *, 'Example: jt65sim -m B -n 10 -d 0.2 -s \\-24.5 -t 0.0 -f 4'
print *, ''
print *, 'OPTIONS: NB Use \ (\\ on *nix shells) to escape -ve arguments'
print *, ''
do i = 1, size (long_options)
call long_options(i) % print (6)
end do
go to 999
endif
if (seed_prngs) then
call init_random_seed() ! seed Fortran RANDOM_NUMBER generator
call sgran() ! see C rand generator (used in gran)
end if
rms=100. * 10. ** (gain_offset / 20.)
fsample=nsample_rate !Sample rate (Hz)
dt=1.d0/fsample !Sample interval (s)
twopi=8.d0*atan(1.d0)
npts=54*nsample_rate !Total samples in .wav file
baud=11025.d0/4096.d0 !Keying rate
sps=real(nsample_rate)/baud !Samples per symbol, at fsample=NSAMPLE_RATE Hz
nsym=126 !Number of channel symbols
h=default_header(nsample_rate,npts)
dfsig=2000.0/nsigs !Freq spacing between sigs in file (Hz)
do ifile=1,nfiles !Loop over requested number of files
write(fname,1002) ifile !Output filename
1002 format('000000_',i4.4)
open(10,file=fname//'.wav',access='stream',status='unknown')
xnoise=0.
cdat=0.
if(snrdb.lt.90) then
do i=1,npts
xnoise(i)=gran() !Generate gaussian noise
enddo
endif
do isig=1,nsigs !Generate requested number of sigs
if(mod(nsigs,2).eq.0) f0=bf0 + dfsig*(isig-0.5-nsigs/2)
if(mod(nsigs,2).eq.1) f0=bf0 + dfsig*(isig-(nsigs+1)/2)
xsnr=snrdb
if(snrdb.eq.0.0) xsnr=-19 - isig
if(csubmode.eq.'B' .and. snrdb.eq.0.0) xsnr=-21 - isig
if(csubmode.eq.'C' .and. snrdb.eq.0.0) xsnr=-21 - isig
!###
! call1="K1ABC"
! ic3=65+mod(isig-1,26)
! ic2=65+mod((isig-1)/26,26)
! ic1=65
! call2="W9"//char(ic1)//char(ic2)//char(ic3)
! write(msg,1010) call1,call2,nint(xsnr)
!1010 format(a5,1x,a5,1x,i3.2)
!###
call packmsg(msg,dgen,itype,.false.) !Pack message into 12 six-bit bytes
call rs_encode(dgen,sent) !Encode using RS(63,12)
call interleave63(sent,1) !Interleave channel symbols
call graycode65(sent,63,1) !Apply Gray code
k=0
do j=1,nsym !Insert sync and data into itone()
if(nprc(j).eq.0) then
k=k+1
itone(j)=sent(k)+2
else
itone(j)=0
endif
enddo
bandwidth_ratio=2500.0/(fsample/2.0)
sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*xsnr)
if(xsnr.gt.90.0) sig=1.0
write(*,1020) ifile,isig,f0,csubmode,xsnr,xdt,fspread,msg
1020 format(i4,i4,f10.3,2x,a1,2x,f5.1,f6.2,f5.1,1x,a22)
phi=0.d0
dphi=0.d0
k=nsample_rate + xdt*nsample_rate !Start audio at t = xdt + 1.0 s
isym0=-99
do i=1,npts !Add this signal into cdat()
isym=floor(i/sps)+1
if(isym.gt.nsym) exit
if(isym.ne.isym0) then
freq=f0 + itone(isym)*baud*mode65
dphi=twopi*freq*dt
isym0=isym
endif
phi=phi + dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
z=cmplx(cos(xphi),sin(xphi))
k=k+1
if(k.ge.1) cdat(k)=cdat(k) + sig*z
enddo
enddo
if(fspread.ne.0) then !Apply specified Doppler spread
df=real(nsample_rate)/nfft
twopi=8*atan(1.0)
cspread(0)=1.0
cspread(NH)=0.
! The following options were added 3/15/2016 to make the half-power tone
! widths equal to the requested Doppler spread. (Previously we effectively
! used b=1.0 and Gaussian shape, which made the tones 1.665 times wider.)
! b=2.0*sqrt(log(2.0)) !Gaussian (before 3/15/2016)
! b=2.0 !Lorenzian 3/15 - 3/27
b=6.0 !Lorenzian 3/28 onward
do i=1,NH
f=i*df
x=b*f/fspread
z=0.
a=0.
if(x.lt.3.0) then !Cutoff beyond x=3
! a=sqrt(exp(-x*x)) !Gaussian
a=sqrt(1.111/(1.0+x*x)-0.1) !Lorentzian
call random_number(r1)
phi1=twopi*r1
z=a*cmplx(cos(phi1),sin(phi1))
endif
cspread(i)=z
z=0.
if(x.lt.50.0) then
call random_number(r2)
phi2=twopi*r2
z=a*cmplx(cos(phi2),sin(phi2))
endif
cspread(NFFT-i)=z
enddo
do i=0,NFFT-1
f=i*df
if(i.gt.NH) f=(i-nfft)*df
s=real(cspread(i))**2 + aimag(cspread(i))**2
! write(13,3000) i,f,s,cspread(i)
!3000 format(i5,f10.3,3f12.6)
enddo
! s=real(cspread(0))**2 + aimag(cspread(0))**2
! write(13,3000) 1024,0.0,s,cspread(0)
call four2a(cspread,NFFT,1,1,1) !Transform to time domain
sum=0.
do i=0,NFFT-1
p=real(cspread(i))**2 + aimag(cspread(i))**2
sum=sum+p
enddo
avep=sum/NFFT
fac=sqrt(1.0/avep)
cspread=fac*cspread !Normalize to constant avg power
cdat(1:npts)=cspread(1:npts)*cdat(1:npts) !Apply Rayleigh fading
! do i=0,NFFT-1
! p=real(cspread(i))**2 + aimag(cspread(i))**2
! write(14,3010) i,p,cspread(i)
!3010 format(i8,3f12.6)
! enddo
endif
dat=aimag(cdat) + xnoise !Add the generated noise
if(snrdb.lt.90.0) then
dat=rms*dat(1:npts)
else
datpk=maxval(abs(dat(1:npts)))
fac=32766.9/datpk
dat(1:npts)=fac*dat(1:npts)
endif
if(any(abs(dat(1:npts)).gt.32767.0)) print*,"Warning - data will be clipped."
iwave(1:npts)=nint(dat(1:npts))
write(10) h,iwave(1:npts) !Save the .wav file
close(10)
enddo
999 end program jt65sim
lib/jt9.f90
+2 -1
View File
@@ -260,7 +260,8 @@ program jt9
shared_data%params%kin=64800
shared_data%params%nzhsym=181
shared_data%params%ndepth=ndepth
shared_data%params%lapon=.true.
shared_data%params%lft8apon=.true.
shared_data%params%ljt65apon=.true.
shared_data%params%napwid=75
shared_data%params%dttol=3.
lib/jt9com.f90
+3 -1
View File
@@ -23,7 +23,9 @@
integer(c_int) :: nsubmode
logical(c_bool) :: nagain
integer(c_int) :: ndepth
logical(c_bool) :: lapon
logical(c_bool) :: lft8apon
logical(c_bool) :: lapcqonly
logical(c_bool) :: ljt65apon
integer(c_int) :: napwid
integer(c_int) :: ntxmode
integer(c_int) :: nmode
lib/ldpcsim144.f90
+1 -1
View File
@@ -77,7 +77,7 @@ msg="K9AN K1JT EN50"
ihash=nhash(c_loc(i1Msg8BitBytes),int(9,c_size_t),146)
ihash=2*iand(ihash,32767) !Generate the 8-bit hash
i1Msg8BitBytes(10)=i1hash(1) !CRC to byte 10
i1Msg8BitBytes(10)=i1hash(1) !Hash code to byte 10
mbit=0
do i=1, 10
i1=i1Msg8BitBytes(i)
lib/msk144decodeframe.f90
+1 -1
View File
@@ -98,7 +98,7 @@ subroutine msk144decodeframe(c,softbits,msgreceived,nsuccess,recent_calls,nrecen
! call timer('bpdec144 ',1)
if( niterations .ge. 0.0 ) then
call extractmessage144(decoded,msgreceived,nhashflag,recent_calls,nrecent)
if( nhashflag .gt. 0 ) then ! CRCs match, so print it
if( nhashflag .gt. 0 ) then !Hash codes match, so print it
nsuccess=1
endif
endif
lib/mskrtd.f90
+1 -2
View File
@@ -208,8 +208,7 @@ subroutine mskrtd(id2,nutc0,tsec,ntol,nrxfreq,ndepth,mycall,mygrid,hiscall, &
nsnrlast=nsnr
if(.not. bshdecode) then
call update_hasharray(recent_calls,nrecent,nhasharray)
! Should we call fix_contest_msg() only if bcontest is true?
call fix_contest_msg(mygrid,msgreceived)
if(bcontest) call fix_contest_msg(mygrid,msgreceived)
endif
write(line,1020) nutc0,nsnr,tdec,nint(fest),decsym,msgreceived, &
navg,ncorrected,eyeopening,char(0)
lib/packjt.f90
+12 -1
View File
@@ -64,6 +64,10 @@ subroutine packbits(dbits,nsymd,m0,sym)
! Work-around for Swaziland prefix:
if(callsign(1:4).eq.'3DA0') callsign='3D0'//callsign(5:6)
! Work-around for Guinea prefixes:
if(callsign(1:2).eq.'3X' .and. callsign(3:3).ge.'A' .and. &
callsign(3:3).le.'Z') callsign='Q'//callsign(3:6)
if(callsign(1:3).eq.'CQ ') then
ncall=NBASE + 1
if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and. &
@@ -265,7 +269,9 @@ subroutine packbits(dbits,nsymd,m0,sym)
psfx = ' '
endif
999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:)
999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:)
if(word(1:1).eq.'Q' .and. word(2:2).ge.'A' .and. &
word(2:2).le.'Z') word='3X'//word(2:)
return
end subroutine unpackcall
@@ -423,6 +429,8 @@ subroutine packbits(dbits,nsymd,m0,sym)
end if
call fmtmsg(msg,iz)
if(msg(1:3).eq.'CQ ' .and. msg(4:4).ge.'0' .and. msg(4:4).le.'9' &
.and. msg(5:5).eq.' ') msg='CQ 00'//msg(4:)
if(msg(1:6).eq.'CQ DX ') msg(3:3)='9'
if(msg(1:3).eq.'CQ ' .and. &
@@ -652,6 +660,9 @@ subroutine packbits(dbits,nsymd,m0,sym)
if(bcontest) call fix_contest_msg(mygrid,msg)
if(msg(1:5).eq.'CQ 00' .and. msg(6:6).ge.'0' .and. &
msg(6:6).le.'9') msg='CQ '//msg(6:)
return
end subroutine unpackmsg
lib/plotsave.f90
+34
View File
@@ -0,0 +1,34 @@
subroutine plotsave(swide,nw,nh,irow)
real, dimension(:,:), allocatable :: sw
real swide(0:nw-1)
data nw0/-1/,nh0/-1/
save nw0,nh0,sw
if(irow.eq.-99) then
if(allocated(sw)) deallocate(sw)
go to 900
endif
if(nw.ne.nw0 .or. nh.ne.nh0 .or. (.not.allocated(sw))) then
if(allocated(sw)) deallocate(sw)
! if(nw0.ne.-1) deallocate(sw)
allocate(sw(0:nw-1,0:nh-1))
sw=0.
nw0=nw
nh0=nh
endif
df=12000.0/16384
if(irow.lt.0) then
! Push a new row of data into sw
do j=nh-1,1,-1
sw(0:nw-1,j)=sw(0:nw-1,j-1)
enddo
sw(0:nw-1,0)=swide
else
! Return the saved "irow" as swide(), for a waterfall replot.
swide=sw(0:nw-1,irow)
endif
900 return
end subroutine plotsave
lib/qso50/g0
+8
View File
@@ -0,0 +1,8 @@
gfortran -o twq -Wall -Wno-conversion -fbounds-check twq.f90 \
../packjt.f90 wqenc.f90 wqdec.f90 packprop.f90 \
packname.f90 packtext2.f90 unpackprop.f90 unpackname.f90 \
unpacktext2.f90 unpackpfx.f90 pack50.f90 unpack50.f90 \
../hash.f90 ../deg2grid.f90 ../grid2deg.f90 \
../fix_contest_msg.f90 ../to_contest_msg.f90 \
../fmtmsg.f90 ../azdist.f90 ../geodist.f90 ../wsprd/nhash.c
lib/qso50/pack50.f90
+26
View File
@@ -0,0 +1,26 @@
subroutine pack50(n1,n2,dat)
integer*1 dat(11),i1
i1=iand(ishft(n1,-20),255) !8 bits
dat(1)=i1
i1=iand(ishft(n1,-12),255) !8 bits
dat(2)=i1
i1=iand(ishft(n1, -4),255) !8 bits
dat(3)=i1
i1=16*iand(n1,15)+iand(ishft(n2,-18),15) !4+4 bits
dat(4)=i1
i1=iand(ishft(n2,-10),255) !8 bits
dat(5)=i1
i1=iand(ishft(n2, -2),255) !8 bits
dat(6)=i1
i1=64*iand(n2,3) !2 bits
dat(7)=i1
dat(8)=0
dat(9)=0
dat(10)=0
dat(11)=0
return
end subroutine pack50
lib/qso50/packname.f90
+23
View File
@@ -0,0 +1,23 @@
subroutine packname(name,len,n1,n2)
character*9 name
real*8 dn
dn=0
do i=1,len
n=ichar(name(i:i))
if(n.ge.97 .and. n.le.122) n=n-32
dn=27*dn + n-64
enddo
if(len.lt.9) then
do i=len+1,9
dn=27*dn
enddo
endif
n2=mod(dn,32768.d0)
dn=dn/32768.d0
n1=dn
return
end subroutine packname
lib/qso50/packprop.f90
+36
View File
@@ -0,0 +1,36 @@
subroutine packprop(k,muf,ccur,cxp,n1)
! Pack propagation indicators into a 21-bit number.
! k k-index, 0-9; 10="N/A"
! muf muf, 2-60 MHz; 0=N/A, 1="none", 61=">60 MHz"
! ccur up to two current events, each indicated by single
! or double letter.
! cxp zero or one expected event, indicated by single or
! double letter
character ccur*4,cxp*2
j=ichar(ccur(1:1))-64
if(j.lt.0) j=0
n1=j
do i=2,4
if(ccur(i:i).eq.' ') go to 10
if(ccur(i:i).eq.ccur(i-1:i-1)) then
n1=n1+26
else
j=ichar(ccur(i:i))-64
if(j.lt.0) j=0
n1=53*n1 + j
endif
enddo
10 j=ichar(cxp(1:1))-64
if(j.lt.0) j=0
if(cxp(2:2).eq.cxp(1:1)) j=j+26
n1=53*n1 + j
n1=11*n1 + k
n1=62*n1 + muf
return
end subroutine packprop
lib/qso50/packtext2.f90
+22
View File
@@ -0,0 +1,22 @@
subroutine packtext2(msg,n1,ng)
character*8 msg
real*8 dn
character*41 c
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +./?'/
dn=0.
do i=1,8
do j=1,41
if(msg(i:i).eq.c(j:j)) go to 10
enddo
j=37
10 j=j-1 !Codes should start at zero
dn=41.d0*dn + j
enddo
ng=mod(dn,32768.d0)
n1=(dn-ng)/32768.d0
return
end subroutine packtext2
lib/qso50/twq.f90
+18
View File
@@ -0,0 +1,18 @@
program twq
character*22 msg0,msg
integer*1 data0(11)
open(10,file='wqmsg.txt',status='old')
write(*,1000)
1000 format(4x,'Encoded message',9x,'Decoded as',12x,'itype'/55('-'))
do line=1,9999
read(10,*,end=999) msg0
call wqenc(msg0,itype,data0)
call wqdec(data0,msg,ntype)
write(*,1100) line,msg0,msg,ntype
1100 format(i2,'.',1x,a22,2x,a22,i3)
enddo
999 end program twq
lib/qso50/unpack50.f90
+30
View File
@@ -0,0 +1,30 @@
subroutine unpack50(dat,n1,n2)
integer*1 dat(11)
i=dat(1)
i4=iand(i,255)
n1=ishft(i4,20)
i=dat(2)
i4=iand(i,255)
n1=n1 + ishft(i4,12)
i=dat(3)
i4=iand(i,255)
n1=n1 + ishft(i4,4)
i=dat(4)
i4=iand(i,255)
n1=n1 + iand(ishft(i4,-4),15)
n2=ishft(iand(i4,15),18)
i=dat(5)
i4=iand(i,255)
n2=n2 + ishft(i4,10)
i=dat(6)
i4=iand(i,255)
n2=n2 + ishft(i4,2)
i=dat(7)
i4=iand(i,255)
n2=n2 + iand(ishft(i4,-6),3)
return
end subroutine unpack50
lib/qso50/unpackname.f90
+20
View File
@@ -0,0 +1,20 @@
subroutine unpackname(n1,n2,name,len)
character*9 name
real*8 dn
dn=32768.d0*n1 + n2
len=0
do i=9,1,-1
j=mod(dn,27.d0)
if(j.ge.1) then
name(i:i)=char(64+j)
len=len+1
else
name(i:i)=' '
endif
dn=dn/27.d0
enddo
return
end subroutine unpackname
lib/qso50/unpackpfx.f90
+35
View File
@@ -0,0 +1,35 @@
subroutine unpackpfx(ng,call1)
character*12 call1
character*3 pfx
if(ng.lt.60000) then
! Add-on prefix of 1 to 3 characters
n=ng
do i=3,1,-1
nc=mod(n,37)
if(nc.ge.0 .and. nc.le.9) then
pfx(i:i)=char(nc+48)
else if(nc.ge.10 .and. nc.le.35) then
pfx(i:i)=char(nc+55)
else
pfx(i:i)=' '
endif
n=n/37
enddo
call1=pfx//'/'//call1
if(call1(1:1).eq.' ') call1=call1(2:)
if(call1(1:1).eq.' ') call1=call1(2:)
else
! Add-on suffix, one character
i1=index(call1,' ')
nc=ng-60000
if(nc.ge.0 .and. nc.le.9) then
call1=call1(:i1-1)//'/'//char(nc+48)
else if(nc.ge.10 .and. nc.le.35) then
call1=call1(:i1-1)//'/'//char(nc+55)
endif
endif
return
end subroutine unpackpfx
lib/qso50/unpackprop.f90
+28
View File
@@ -0,0 +1,28 @@
subroutine unpackprop(n1,k,muf,ccur,cxp)
character ccur*4,cxp*2
muf=mod(n1,62)
n1=n1/62
k=mod(n1,11)
n1=n1/11
j=mod(n1,53)
n1=n1/53
if(j.eq.0) cxp='*'
if(j.ge.1 .and. j.le.26) cxp=char(64+j)
if(j.gt.26) cxp=char(64+j-26)//char(64+j-26)
j=mod(n1,53)
n1=n1/53
if(j.eq.0) ccur(2:2)='*'
if(j.ge.1 .and. j.le.26) ccur(2:2)=char(64+j)
if(j.gt.26) ccur(2:3)=char(64+j-26)//char(64+j-26)
j=n1
if(j.eq.0) ccur(1:1)='*'
if(j.ge.1 .and. j.le.26) ccur(1:1)=char(64+j)
if(j.gt.26) ccur=char(64+j-26)//char(64+j-26)//ccur(2:3)
return
end subroutine unpackprop
lib/qso50/unpacktext2.f90
+17
View File
@@ -0,0 +1,17 @@
subroutine unpacktext2(n1,ng,msg)
character*22 msg
real*8 dn
character*41 c
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +./?'/
msg=' '
dn=32768.d0*n1 + ng
do i=8,1,-1
j=mod(dn,41.d0)
msg(i:i)=c(j+1:j+1)
dn=dn/41.d0
enddo
return
end subroutine unpacktext2
lib/qso50/wqdec.f90
+316
View File
@@ -0,0 +1,316 @@
subroutine wqdec(data0,message,ntype)
use packjt
parameter (N15=32758)
integer*1 data0(11)
character*22 message
character*12 callsign
character*3 cdbm,cf
character*2 crpt
character*4 grid,psfx
character*9 name
character*36 fmt
character*6 cwx(4)
character*7 cwind(5)
character ccur*4,cxp*2
logical first
character*12 dcall(0:N15-1)
data first/.true./
data cwx/'CLEAR','CLOUDY','RAIN','SNOW'/
data cwind/'CALM','BREEZES','WINDY','DRY','HUMID'/
save first,dcall
if(first) then
dcall=' '
first=.false.
endif
message=' '
call unpack50(data0,n1,n2)
call unpackcall(n1,callsign,iv2,psfx)
i1=index(callsign,' ')
call unpackgrid(n2/128,grid)
ntype=iand(n2,127) -64
! Standard WSPR message (types 0 3 7 10 13 17 ... 60)
nu=mod(ntype,10)
if(ntype.ge.0 .and. ntype.le.60 .and. (nu.eq.0 .or. nu.eq.3 .or. &
nu.eq.7)) then
write(cdbm,'(i3)'),ntype
if(cdbm(1:1).eq.' ') cdbm=cdbm(2:)
if(cdbm(1:1).eq.' ') cdbm=cdbm(2:)
message=callsign(1:i1)//grid//' '//cdbm
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1)
! "Best DX" WSPR response (type 1)
else if(ntype.eq.1) then
message=grid//' DE '//callsign
! CQ (msg 3; types 2,4,5)
else if(ntype.eq.2) then
message='CQ '//callsign(:i1)//grid
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1)
else if(ntype.eq.4 .or. ntype.eq.5) then
ng=n2/128 + 32768*(ntype-4)
call unpackpfx(ng,callsign)
message='CQ '//callsign
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1)
! Reply to CQ (msg #2; type 6)
else if(ntype.eq.6) then
ih=(n2-64-ntype)/128
if(dcall(ih)(1:1).ne.' ') then
i2=index(dcall(ih),' ')
message='<'//dcall(ih)(:i2-1)//'> '//callsign(:i1-1)
else
message='<...> '//callsign
endif
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! Reply to CQ (msg #2; type 8)
else if(ntype.eq.8) then
message='DE '//callsign(:i1)//grid
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! Reply to CQ, DE pfx/call (msg #2; types 9, 11)
else if(ntype.eq.9 .or. ntype.eq.11) then
ng=n2/128 + 32768*(ntype-9)/2
call unpackpfx(ng,callsign)
message='DE '//callsign
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! Calls and report (msg #3; types -1 to -9)
else if(ntype.le.-1 .and. ntype.ge.-9) then
write(crpt,1010) -ntype
1010 format('S',i1)
ih=(n2-62-ntype)/128
if(dcall(ih)(1:1).ne.' ') then
i2=index(dcall(ih),' ')
message=callsign(:i1)//'<'//dcall(ih)(:i2-1)//'> '//crpt
else
message=callsign(:i1)//'<...> '//crpt
endif
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! pfx/call and report (msg #3; types -10 to -27)
else if(ntype.le.-10 .and. ntype.ge.-27) then
ng=n2/128
nrpt=-ntype-9
if(ntype.le.-19) then
ng=ng + 32768
nrpt=-ntype-18
endif
write(crpt,1010) nrpt
call unpackpfx(ng,callsign)
message=callsign//' '//crpt
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! Calls and R and report (msg #4; types -28 to -36)
else if(ntype.le.-28 .and. ntype.ge.-36) then
write(crpt,1010) -(ntype+27)
ih=(n2-64+28-ntype)/128
if(dcall(ih)(1:1).ne.' ') then
i2=index(dcall(ih),' ')
message=callsign(:i1)//'<'//dcall(ih)(:i2-1)//'> '//'R '//crpt
else
message=callsign(:i1)//'<...> '//'R '//crpt
endif
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! pfx/call R and report (msg #4; types -37 to -54)
else if(ntype.le.-37 .and. ntype.ge.-54) then
ng=n2/128
nrpt=-ntype-36
if(ntype.le.-46) then
ng=ng + 32768
nrpt=-ntype-45
endif
write(crpt,1010) nrpt
call unpackpfx(ng,callsign)
message=callsign//' R '//crpt
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! Calls and RRR (msg#5; type 12)
else if(ntype.eq.12) then
ih=(n2-64+28-ntype)/128
if(dcall(ih)(1:1).ne.' ') then
i2=index(dcall(ih),' ')
message=callsign(:i1)//'<'//dcall(ih)(:i2-1)//'> RRR'
else
message=callsign(:i1)//'<...> RRR'
endif
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! Calls and RRR (msg#5; type 14)
else if(ntype.eq.14) then
ih=(n2-64+28-ntype)/128
if(dcall(ih)(1:1).ne.' ') then
i2=index(dcall(ih),' ')
message='<'//dcall(ih)(:i2-1)//'> '//callsign(:i1)//'RRR'
else
message='<...> '//callsign(:i1)//' RRR'
endif
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! DE pfx/call and RRR (msg#5; types 15, 16)
else if(ntype.eq.15 .or. ntype.eq.16) then
ng=n2/128 + 32768*(ntype-15)
call unpackpfx(ng,callsign)
message='DE '//callsign//' RRR'
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! TNX [name] 73 GL (msg #6; type 18)
else if(ntype.eq.18) then
ng=(n2-18-64)/128
call unpackname(n1,ng,name,len)
message='TNX '//name(:len)//' 73 GL'
! OP [name] 73 GL (msg #6; type 18)
else if(ntype.eq.-56) then
ng=(n2+56-64)/128
call unpackname(n1,ng,name,len)
message='OP '//name(:len)//' 73 GL'
! 73 DE [call] [grid] (msg #6; type 19)
else if(ntype.eq.19) then
ng=(n2-19-64)/128
message='73 DE '//callsign(:i1)//grid
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! 73 DE pfx/call (msg #6; type 21, 22)
else if(ntype.eq.21 .or. ntype.eq.22) then
ng=n2/128 + (ntype-21)*32768
call unpackpfx(ng,callsign)
i1=index(callsign,' ')
message='73 DE '//callsign
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1-1)
! [power] W [gain] DBD 73 GL (msg#6; type 24, 25)
else if(ntype.eq.24 .or. ntype.eq.25) then
ng=(n2-24-64)/128 - 32
i1=1
if(n1.gt.0) i1=log10(float(n1)) + 1
i2=1
if(ng.ge.10) i2=2
if(ng.lt.0) i2=i2+1
if(n1.le.3000) then
if(ntype.eq.24) fmt="(i4,' W ',i2,' DBD 73 GL')"
if(ntype.eq.25) fmt="(i4,' W ',i2,' DBD ')"
fmt(3:3)=char(48+i1)
fmt(12:12)=char(48+i2)
if(ng.le.100) then
write(message,fmt) n1,ng
else
if(ng.eq.30000) fmt=fmt(1:8)//"DIPOLE')"
if(ng.eq.30001) fmt=fmt(1:8)//"VERTICAL')"
write(message,fmt) n1
endif
else
mw=n1-3000
if(ntype.eq.24) fmt="('0.',i3.3,' W ',i2,' DBD 73 GL')"
if(ntype.eq.25) fmt="('0.',i3.3,' W ',i2,' DBD ')"
fmt(19:19)=char(48+i2)
if(ng.le.100) then
write(message,fmt) mw,ng
else
if(ng.eq.30000) fmt=fmt(1:15)//"DIPOLE')"
if(ng.eq.30001) fmt=fmt(1:15)//"VERTICAL')"
write(message,fmt) n1
endif
if(index(message,'***').gt.0) go to 700
endif
! QRZ call (msg #3; type 26)
else if(ntype.eq.26) then
ng=(n2-24-64)/128 - 32
message='QRZ '//callsign
! PSE QSY [nnn] KHZ (msg #6; type 28)
else if(ntype.eq.28) then
if(n1.gt.0) i1=log10(float(n1)) + 1
fmt="('PSE QSY ',i2,' KHZ')"
fmt(14:14)=char(48+i1)
write(message,fmt) n1
! WX wx temp C/F wind (msg #6; type 29)
else if(ntype.eq.29) then
nwx=n1/10000
ntemp=mod(n1,10000) - 100
cf=' F '
if(ntemp.gt.800) then
ntemp=ntemp-1000
cf=' C '
endif
n2a=n2/128
if(nwx.ge.1 .and. nwx.le.4 .and. n2a.ge.1 .and. n2a.le.5) then
write(message,1020) cwx(nwx),ntemp,cf,cwind(n2/128)
1020 format('WX ',a6,i3,a3,a7)
else
message='WX'//' (BadMsg)'
endif
! Hexadecimal data (type 62)
else if(ntype.eq.62) then
ng=n2/128
write(message,'(z4.4,z7.7)') ng,n1
! Solar/geomagnetic/ionospheric data (type 63)
else if(ntype.eq.63) then
ih=(n2-64-ntype)/128
if(dcall(ih)(1:1).ne.' ') then
i2=index(dcall(ih),' ')
message='<'//dcall(ih)(:i2-1)//'> '
else
message='<...> '
endif
call unpackprop(n1,k,muf,ccur,cxp)
i2=index(message,'>')
write(message(i2+1:),'(i3,i3)') k,muf
message=message(:i2+7)//ccur//' '//cxp
! [plain text] (msg #6; type -57)
else if(ntype.eq.-57) then
ng=n2/128
call unpacktext2(n1,ng,message)
else
go to 700
endif
go to 750
! message='<Unknown message type>'
700 i1=index(callsign,' ')
if(i1.lt.1) i1=12
message=callsign(:i1)//' (BadMsg)'
750 do i=1,22
if(ichar(message(i:i)).eq.0) message(i:i)=' '
enddo
do i=22,1,-1
if(message(i:i).ne.' ') go to 800
enddo
800 i2=i
do n=1,20
i1=index(message(:i2),' ')
if(i1.le.0) go to 900
message=message(1:i1)//message(i1+2:)
i2=i2-1
enddo
900 return
end subroutine wqdec
lib/qso50/wqenc.f90
+346
View File
@@ -0,0 +1,346 @@
subroutine wqenc(msg,ntype,data0)
! Parse and encode a WSPR message.
use packjt
parameter (MASK15=32767)
character*22 msg
character*12 call1,call2
character*4 grid
character*9 name
character ccur*4,cxp*2
logical lbad1,lbad2
integer*1 data0(11)
integer nu(0:9)
data nu/0,-1,1,0,-1,2,1,0,-1,1/
read(msg,1001,end=1,err=1) ng,n1
1001 format(z4,z7)
ntype=62
n2=128*ng + (ntype+64)
call pack50(n1,n2,data0) !Pack 8 bits per byte, add tail
go to 900
1 if(msg(1:6).eq.'73 DE ') go to 80
if(index(msg,' W ').gt.0 .and. index(msg,' DBD ').gt.0) go to 90
if(msg(1:4).eq.'QRZ ') go to 100
if(msg(1:8).eq.'PSE QSY ') go to 110
if(msg(1:3).eq.'WX ') go to 120
! Standard WSPR message (types 0 3 7 10 13 17 ... 60)
i1=index(msg,' ')
if(i1.lt.4 .or. i1.gt.7) go to 10
call1=msg(:i1-1)
grid=msg(i1+1:i1+4)
call packcall(call1,n1,lbad1)
call packgrid(grid,ng,lbad2)
if(lbad1 .or. lbad2) go to 10
ndbm=0
read(msg(i1+5:),*,err=10,end=800) ndbm
if(ndbm.lt.0 .or. ndbm.gt.60) go to 800
ndbm=ndbm+nu(mod(ndbm,10))
n2=128*ng + (ndbm+64)
call pack50(n1,n2,data0)
ntype=ndbm
go to 900
! "BestDX" automated WSPR reply (type 1)
10 if(i1.ne.5 .or. msg(5:8).ne.' DE ') go to 20
grid=msg(1:4)
call packgrid(grid,ng,lbad2)
if(lbad2) go to 800
call1=msg(9:)
call packcall(call1,n1,lbad1)
if(lbad1) go to 800
ntype=1
n2=128*ng + (ntype+64)
call pack50(n1,n2,data0) !Pack 8 bits per byte, add tail
go to 900
! CQ (msg #1; types 2, 4, 5)
20 if(msg(1:3).ne.'CQ ') go to 30
if(index(msg,'/').le.0) then
i2=index(msg(4:),' ')
call1=msg(4:i2+3)
grid=msg(i2+4:)
call packcall(call1,n1,lbad1)
if(lbad1) go to 30
call packgrid(grid,ng,lbad2)
if(lbad2) go to 30
ntype=2
n2=128*ng + (ntype+64)
call pack50(n1,n2,data0)
else
ntype=4 ! or 5
call1=msg(4:)
call packpfx(call1,n1,ng,nadd)
ntype=ntype+nadd
n2=128*ng + ntype + 64
call pack50(n1,n2,data0)
endif
go to 900
! Reply to CQ (msg #2; types 6,8,9,11)
30 if(msg(1:1).ne.'<' .and. msg(1:3).ne.'DE ') go to 40
if(index(msg,' RRR ').gt.0) go to 50
if(msg(1:1).eq.'<') then
ntype=6
i1=index(msg,'>')
call1=msg(2:i1-1)
read(msg(i1+1:),*,err=31,end=31) k,muf,ccur,cxp
go to 130
31 call2=msg(i1+2:)
call hash(call1,i1-2,ih)
call packcall(call2,n1,lbad1)
n2=128*ih + (ntype+64)
call pack50(n1,n2,data0)
else
i1=index(msg(4:),' ')
call1=msg(4:i1+2)
if(index(msg,'/').le.0) then
ntype=8
ih=0
call packcall(call1,n1,lbad1)
grid=msg(i1+4:i1+7)
call packgrid(grid,ng,lbad2)
n2=128*ng + (ntype+64)
call pack50(n1,n2,data0)
else
ntype=9 ! or 11
call1=msg(4:)
call packpfx(call1,n1,ng,nadd)
ntype=ntype + 2*nadd
n2=128*ng + ntype + 64
call pack50(n1,n2,data0)
endif
endif
go to 900
! Call(s) + report (msg #3; types -1 to -27)
! Call(s) + R + report (msg #4; types -28 to -54)
40 if(index(msg,' RRR').gt.0) go to 50
i1=index(msg,'<')
if(i1.gt.0 .and. (i1.lt.5 .or. i1.gt.8)) go to 50
i2=index(msg,'/')
if(i2.gt.0 .and.i2.le.4) then
ntype=-10 ! -10 to -27
i0=index(msg,' ')
call1=msg(:i0-1)
call packpfx(call1,n1,ng,nadd)
ntype=ntype - 9*nadd
i2=index(msg,' ')
i3=index(msg,' R ')
if(i3.gt.0) i2=i2+2 !-28 to -36
read(msg(i2+2:i2+2),*,end=800,err=800) nrpt
ntype=ntype - (nrpt-1)
if(i3.gt.0) ntype=ntype-27
n2=128*ng + ntype + 64
call pack50(n1,n2,data0)
go to 900
else if(i1.eq.0) then
go to 50
endif
call1=msg(:i1-2) !-1 to -9
i2=index(msg,'>')
call2=msg(i1+1:i2-1)
call hash(call2,i2-i1-1,ih)
i3=index(msg,' R ')
if(i3.gt.0) i2=i2+2 !-28 to -36
read(msg(i2+3:i2+3),*,end=42,err=42) nrpt
go to 43
42 nrpt=1
43 ntype=-nrpt
if(i3.gt.0) ntype=-(nrpt+27)
call packcall(call1,n1,lbad1)
n2=128*ih + (ntype+64)
call pack50(n1,n2,data0)
go to 900
50 i0=index(msg,'<')
if(i0.le.0 .and. msg(1:3).ne.'DE ') go to 60
i3=index(msg,' RRR')
if(i3.le.0) go to 60
! Call or calls and RRR (msg#5; type2 12,14,15,16)
i0=index(msg,'<')
if(i0.eq.1) then
if(index(msg,'/').le.0) then
ntype=14
i1=index(msg,'>')
call1=msg(2:i1-1)
call2=msg(i1+2:)
i2=index(call2,' ')
call2=call2(:i2-1)
call packcall(call2,n1,lbad1)
call hash(call1,i1-2,ih)
n2=128*ih + (ntype+64)
call pack50(n1,n2,data0)
else
stop '0002'
endif
else if(i0.ge.5 .and. i0.le.8) then
if(index(msg,'/').le.0) then
ntype=12
i1=index(msg,'>')
call1=msg(:i0-2)
call2=msg(i0+1:i1-1)
call packcall(call1,n1,lbad1)
call hash(call2,i1-i0-1,ih)
n2=128*ih + (ntype+64)
call pack50(n1,n2,data0)
else
stop '0002'
endif
else
i1=index(msg(4:),' ')
call1=msg(4:i1+2)
if(index(msg,'/').le.0) then
ntype=9
grid=msg(i1+4:i1+7)
else
ntype=15 ! or 16
call1=msg(4:)
i0=index(call1,' ')
call1=call1(:i0-1)
call packpfx(call1,n1,ng,nadd)
ntype=ntype+nadd
n2=128*ng + ntype + 64
call pack50(n1,n2,data0)
endif
endif
go to 900
! TNX <name> 73 GL (msg #6; type 18 ...)
60 if(msg(1:4).ne.'TNX ') go to 70
ntype=18
n1=0
i2=index(msg(5:),' ')
name=msg(5:i2+4)
call packname(name,i2-1,n1,ng)
n2=128*ng + (ntype+64)
call pack50(n1,n2,data0)
go to 900
! TNX name 73 GL (msg #6; type -56 ...)
70 if(msg(1:3).ne.'OP ') go to 80
ntype=-56
n1=0
i2=index(msg(4:),' ')
name=msg(4:i2+3)
call packname(name,i2-1,n1,ng)
n2=128*ng + (ntype+64)
call pack50(n1,n2,data0)
go to 900
! 73 DE call grid (msg #6; type 19)
80 if(msg(1:6).ne.'73 DE ') go to 90
ntype=19
i1=index(msg(7:),' ')
call1=msg(7:)
if(index(call1,'/').le.0) then
i1=index(call1,' ')
grid=call1(i1+1:)
call1=call1(:i1-1)
call packcall(call1,n1,lbad1)
call packgrid(grid,ng,lbad2)
if(lbad1 .or. lbad2) go to 800
n2=128*ng + (ntype+64)
call pack50(n1,n2,data0)
go to 900
else
ntype=21 ! or 22
call packpfx(call1,n1,ng,nadd)
ntype=ntype + nadd
n2=128*ng + ntype + 64
call pack50(n1,n2,data0)
go to 900
endif
! [pwr] W [gain] DBD [73 GL] (msg #6; types 24, 25)
90 if(index(msg,' W ').le.0) go to 140
ntype=25
if(index(msg,' DBD 73 GL').gt.0) ntype=24
i1=index(msg,' ')
read(msg(:i1-1),*,end=800,err=800) watts
if(watts.ge.1.0) nwatts=watts
if(watts.lt.1.0) nwatts=3000 + nint(1000.*watts)
if(index(msg,'DIPOLE').gt.0) then
ndbd=30000
else if(index(msg,'VERTICAL').gt.0) then
ndbd=30001
else
i2=index(msg(i1+3:),' ')
read(msg(i1+3:i1+i2+1),*,end=800,err=800) ndbd
endif
n1=nwatts
ng=ndbd + 32
n2=128*ng + (ntype+64)
call pack50(n1,n2,data0)
go to 900
! QRZ call (msg #3; type 26)
100 call1=msg(5:)
call packcall(call1,n1,lbad1)
if(lbad1) go to 800
ntype=26
n2=ntype+64
call pack50(n1,n2,data0)
go to 900
! PSE QSY [nnn] KHZ (msg #6; type 28)
110 ntype=28
read(msg(9:),*,end=800,err=800) n1
n2=ntype+64
call pack50(n1,n2,data0)
go to 900
! WX wx temp C|F wind (msg #6; type 29)
120 ntype=29
if(index(msg,' CLEAR ').gt.0) then
i1=10
n1=10000
else if(index(msg,' CLOUDY ').gt.0) then
i1=11
n1=20000
else if(index(msg,' RAIN ').gt.0) then
i1=9
n1=30000
else if(index(msg,' SNOW ').gt.0) then
i1=9
n1=40000
endif
read(msg(i1:),*,err=800,end=800) ntemp
ntemp=ntemp+100
i1=index(msg,' C ')
if(i1.gt.0) ntemp=ntemp+1000
n1=n1+ntemp
if(index(msg,' CALM').gt.0) ng=1
if(index(msg,' BREEZES').gt.0) ng=2
if(index(msg,' WINDY').gt.0) ng=3
if(index(msg,' DRY').gt.0) ng=4
if(index(msg,' HUMID').gt.0) ng=5
n2=128*ng + (ntype+64)
call pack50(n1,n2,data0)
go to 900
! Solar/geomagnetic/ionospheric data
130 ntype=63
call packprop(k,muf,ccur,cxp,n1)
call hash(call1,i1-2,ih)
n2=128*ih + ntype + 64
call pack50(n1,n2,data0)
go to 900
140 continue
! Plain text
800 ntype=-57
call packtext2(msg(:8),n1,ng)
n2=128*ng + ntype + 64
call pack50(n1,n2,data0)
go to 900
900 continue
return
end subroutine wqenc
lib/qso50/wqmsg.txt
+31
View File
@@ -0,0 +1,31 @@
"CQ K1JT FN20"
"CQ PJ4/K1JT"
"<K1JT> W6CQZ"
"DE W6CQZ CM87"
"DE PJ4/K1JT"
"W6CQZ <K1JT> S4"
"QRZ K1JT"
"PJ4/W6CQZ S4"
"K1JT <W6CQZ> R S3"
"PJ4/K1JT R S3"
"<W6CQZ> K1JT RRR"
"W6CQZ <K1JT> RRR"
"DE PJ4/K1JT RRR"
"73 DE W6CQZ CM87"
"73 DE PJ4/K1JT"
"TNX VICTORIA 73 GL"
"OP HARRY 73 GL"
"5 W DIPOLE"
"10 W VERTICAL"
"1 W 0 DBD"
"1500 W 21 DBD 73 GL"
"PSE QSY 1811 KHZ"
"WX SNOW -5 C CALM"
"CUL JACK"
"."
"CQ K1JT FN20"
"<K1JT> W6CQZ"
"W6CQZ <K1JT> S4"
"K1JT <W6CQZ> R S3"
"<W6CQZ> K1JT RRR"
"TNX JOE 73 GL"
lib/slope.f90
+3 -3
View File
@@ -1,7 +1,7 @@
subroutine slope(y,npts,xpk)
! Remove best-fit slope from data in y(i). When fitting the straight line,
! ignore the peak around xpk +/- 2 bins
! ignore the peak around xpk +/- 4 bins
real y(npts)
@@ -30,9 +30,9 @@ subroutine slope(y,npts,xpk)
sq=0.
do i=1,npts
y(i)=y(i)-(a + b*i)
if(abs(i-xpk).gt.2.0) sq=sq + y(i)**2
if(abs(i-xpk).gt.4.0) sq=sq + y(i)**2
enddo
rms=sqrt(sq/(sumw-2.0))
rms=sqrt(sq/(sumw-4.0))
y=y/rms
return
lib/symspec.f90
+1 -1
View File
@@ -86,7 +86,7 @@ subroutine symspec(shared_data,k,ntrperiod,nsps,ingain,nminw,pxdb,s, &
enddo
ihsym=ihsym+1
xc(0:nfft3-1)=w3(1:nfft3)*xc(0:nfft3-1) !Apply window w3
! xc(0:nfft3-1)=w3(1:nfft3)*xc(0:nfft3-1) !Apply window w3
call four2a(xc,nfft3,1,-1,0) !Real-to-complex FFT
df3=12000.0/nfft3 !JT9-1: 0.732 Hz = 0.42 * tone spacing
lib/symspec65.f90
-2
View File
@@ -43,9 +43,7 @@ subroutine symspec65(dd,npts,nqsym,savg)
first=.false.
endif
! do j=1,nhsym
do j=1,nqsym
! i0=(j-1)*hstep
i0=(j-1)*qstep
x=fac1*w*dd(i0+1:i0+NFFT)
call four2a(c,NFFT,1,-1,0) !r2c forward FFT
lib/sync65.f90
-7
View File
@@ -1,10 +1,7 @@
!subroutine sync65(ss,nfa,nfb,naggressive,ntol,nqsym,ca,ncand,nrobust, &
! bVHF)
subroutine sync65(nfa,nfb,naggressive,ntol,nqsym,ca,ncand,nrobust, &
bVHF)
parameter (NSZ=3413,NFFT=8192,MAXCAND=300)
! real ss(322,NSZ)
real ss(552,NSZ)
real ccfblue(-32:82) !CCF with pseudorandom sequence
real ccfred(NSZ) !Peak of ccfblue, as function of freq
@@ -41,7 +38,6 @@ subroutine sync65(nfa,nfb,naggressive,ntol,nqsym,ca,ncand,nrobust, &
ccfmax=0.
ipk=0
do i=ia,ib
! call xcor(ss,i,nqsym,nsym,lag1,lag2,ccfblue,ccf0,lagpk0,flip,fdot,nrobust)
call xcor(i,nqsym,nsym,lag1,lag2,ccfblue,ccf0,lagpk0,flip,fdot,nrobust)
! Remove best-fit slope from ccfblue and normalize so baseline rms=1.0
if(.not.bVHF) call slope(ccfblue(lag1),lag2-lag1+1, &
@@ -73,8 +69,6 @@ subroutine sync65(nfa,nfb,naggressive,ntol,nqsym,ca,ncand,nrobust, &
endif
endif
if(itry.ne.0) then
! call xcor(ss,i,nqsym,nsym,lag1,lag2,ccfblue,ccf0,lagpk,flip,fdot, &
! nrobust)
call xcor(i,nqsym,nsym,lag1,lag2,ccfblue,ccf0,lagpk,flip,fdot,nrobust)
if(.not.bVHF) call slope(ccfblue(lag1),lag2-lag1+1, &
lagpk-lag1+1.0)
@@ -83,7 +77,6 @@ subroutine sync65(nfa,nfb,naggressive,ntol,nqsym,ca,ncand,nrobust, &
call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2)
xlag=lagpk+dx2
endif
! dtx=xlag*2048.0/11025.0
dtx=xlag*1024.0/11025.0
ccfblue(lag1)=0.
ccfblue(lag2)=0.
lib/wsprd/wsprd.c
+263 -100
View File
@@ -73,8 +73,7 @@ unsigned long readc2file(char *ptr_to_infile, float *idat, float *qdat,
char *c2file[15];
FILE* fp;
buffer=malloc(sizeof(float)*2*65536);
memset(buffer,0,sizeof(float)*2*65536);
buffer=calloc(2*65536,sizeof(float));
fp = fopen(ptr_to_infile,"rb");
if (fp == NULL) {
@@ -133,7 +132,7 @@ unsigned long readwavfile(char *ptr_to_infile, int ntrmin, float *idat, float *q
FILE *fp;
short int *buf2;
buf2 = malloc(npoints*sizeof(short int));
buf2 = calloc(npoints,sizeof(short int));
fp = fopen(ptr_to_infile,"rb");
if (fp == NULL) {
@@ -145,7 +144,7 @@ unsigned long readwavfile(char *ptr_to_infile, int ntrmin, float *idat, float *q
fclose(fp);
realin=(float*) fftwf_malloc(sizeof(float)*nfft1);
fftout=(fftwf_complex*) fftwf_malloc(sizeof(fftwf_complex)*nfft1);
fftout=(fftwf_complex*) fftwf_malloc(sizeof(fftwf_complex)*(nfft1/2+1));
PLAN1 = fftwf_plan_dft_r2c_1d(nfft1, realin, fftout, PATIENCE);
for (i=0; i<npoints; i++) {
@@ -331,6 +330,146 @@ void sync_and_demodulate(float *id, float *qd, long np,
}
return;
}
void noncoherent_sequence_detection(float *id, float *qd, long np,
unsigned char *symbols, float *f1, int *shift1,
float *drift1, int symfac, int *nblocksize)
{
/************************************************************************
* Noncoherent sequence detection for wspr. *
* Allowed block lengths are nblock=1,2,3,6, or 9 symbols. *
* Longer block lengths require longer channel coherence time. *
* The whole block is estimated at once. *
* nblock=1 corresponds to noncoherent detection of individual symbols *
* like the original wsprd symbol demodulator. *
************************************************************************/
static float fplast=-10000.0;
static float dt=1.0/375.0, df=375.0/256.0;
static float pi=3.14159265358979323846;
float twopidt, df15=df*1.5, df05=df*0.5;
int i, j, k, lag, itone, ib, b, nblock, nseq, imask;
float xi[512],xq[512];
float is[4][162],qs[4][162],cf[4][162],sf[4][162],cm,sm,cmp,smp;
float p[512],fac,xm1,xm0;
float c0[257],s0[257],c1[257],s1[257],c2[257],s2[257],c3[257],s3[257];
float dphi0, cdphi0, sdphi0, dphi1, cdphi1, sdphi1, dphi2, cdphi2, sdphi2,
dphi3, cdphi3, sdphi3;
float f0, fp, fsum=0.0, f2sum=0.0, fsymb[162];
twopidt=2*pi*dt;
f0=*f1;
lag=*shift1;
nblock=*nblocksize;
nseq=1<<nblock;
for (i=0; i<162; i++) {
fp = f0 + (*drift1/2.0)*((float)i-81.0)/81.0;
if( i==0 || (fp != fplast) ) { // only calculate sin/cos if necessary
dphi0=twopidt*(fp-df15);
cdphi0=cos(dphi0);
sdphi0=sin(dphi0);
dphi1=twopidt*(fp-df05);
cdphi1=cos(dphi1);
sdphi1=sin(dphi1);
dphi2=twopidt*(fp+df05);
cdphi2=cos(dphi2);
sdphi2=sin(dphi2);
dphi3=twopidt*(fp+df15);
cdphi3=cos(dphi3);
sdphi3=sin(dphi3);
c0[0]=1; s0[0]=0;
c1[0]=1; s1[0]=0;
c2[0]=1; s2[0]=0;
c3[0]=1; s3[0]=0;
for (j=1; j<257; j++) {
c0[j]=c0[j-1]*cdphi0 - s0[j-1]*sdphi0;
s0[j]=c0[j-1]*sdphi0 + s0[j-1]*cdphi0;
c1[j]=c1[j-1]*cdphi1 - s1[j-1]*sdphi1;
s1[j]=c1[j-1]*sdphi1 + s1[j-1]*cdphi1;
c2[j]=c2[j-1]*cdphi2 - s2[j-1]*sdphi2;
s2[j]=c2[j-1]*sdphi2 + s2[j-1]*cdphi2;
c3[j]=c3[j-1]*cdphi3 - s3[j-1]*sdphi3;
s3[j]=c3[j-1]*sdphi3 + s3[j-1]*cdphi3;
}
fplast = fp;
}
cf[0][i]=c0[256]; sf[0][i]=s0[256];
cf[1][i]=c1[256]; sf[1][i]=s1[256];
cf[2][i]=c2[256]; sf[2][i]=s2[256];
cf[3][i]=c3[256]; sf[3][i]=s3[256];
is[0][i]=0.0; qs[0][i]=0.0;
is[1][i]=0.0; qs[1][i]=0.0;
is[2][i]=0.0; qs[2][i]=0.0;
is[3][i]=0.0; qs[3][i]=0.0;
for (j=0; j<256; j++) {
k=lag+i*256+j;
if( (k>0) && (k<np) ) {
is[0][i]=is[0][i] + id[k]*c0[j] + qd[k]*s0[j];
qs[0][i]=qs[0][i] - id[k]*s0[j] + qd[k]*c0[j];
is[1][i]=is[1][i] + id[k]*c1[j] + qd[k]*s1[j];
qs[1][i]=qs[1][i] - id[k]*s1[j] + qd[k]*c1[j];
is[2][i]=is[2][i] + id[k]*c2[j] + qd[k]*s2[j];
qs[2][i]=qs[2][i] - id[k]*s2[j] + qd[k]*c2[j];
is[3][i]=is[3][i] + id[k]*c3[j] + qd[k]*s3[j];
qs[3][i]=qs[3][i] - id[k]*s3[j] + qd[k]*c3[j];
}
}
}
for (i=0; i<162; i=i+nblock) {
for (j=0;j<nseq;j++) {
xi[j]=0.0; xq[j]=0.0;
cm=1; sm=0;
for (ib=0; ib<nblock; ib++) {
b=(j&(1<<(nblock-1-ib)))>>(nblock-1-ib);
itone=pr3[i+ib]+2*b;
xi[j]=xi[j]+is[itone][i+ib]*cm + qs[itone][i+ib]*sm;
xq[j]=xq[j]+qs[itone][i+ib]*cm - is[itone][i+ib]*sm;
cmp=cf[itone][i+ib]*cm - sf[itone][i+ib]*sm;
smp=sf[itone][i+ib]*cm + cf[itone][i+ib]*sm;
cm=cmp; sm=smp;
}
p[j]=xi[j]*xi[j]+xq[j]*xq[j];
p[j]=sqrt(p[j]);
}
for (ib=0; ib<nblock; ib++) {
imask=1<<(nblock-1-ib);
xm1=0.0; xm0=0.0;
for (j=0; j<nseq; j++) {
if((j & imask)!=0) {
if(p[j] > xm1) xm1=p[j];
}
if((j & imask)==0) {
if(p[j]>xm0) xm0=p[j];
}
}
fsymb[i+ib]=xm1-xm0;
}
}
for (i=0; i<162; i++) { //Normalize the soft symbols
fsum=fsum+fsymb[i]/162.0;
f2sum=f2sum+fsymb[i]*fsymb[i]/162.0;
}
fac=sqrt(f2sum-fsum*fsum);
for (i=0; i<162; i++) {
fsymb[i]=symfac*fsymb[i]/fac;
if( fsymb[i] > 127) fsymb[i]=127.0;
if( fsymb[i] < -128 ) fsymb[i]=-128.0;
symbols[i]=fsymb[i] + 128;
}
return;
}
/***************************************************************************
symbol-by-symbol signal subtraction
****************************************************************************/
@@ -401,20 +540,13 @@ void subtract_signal2(float *id, float *qd, long np,
float *refi, *refq, *ci, *cq, *cfi, *cfq;
refi=malloc(sizeof(float)*nc2);
refq=malloc(sizeof(float)*nc2);
ci=malloc(sizeof(float)*nc2);
cq=malloc(sizeof(float)*nc2);
cfi=malloc(sizeof(float)*nc2);
cfq=malloc(sizeof(float)*nc2);
memset(refi,0,sizeof(float)*nc2);
memset(refq,0,sizeof(float)*nc2);
memset(ci,0,sizeof(float)*nc2);
memset(cq,0,sizeof(float)*nc2);
memset(cfi,0,sizeof(float)*nc2);
memset(cfq,0,sizeof(float)*nc2);
refi=calloc(nc2,sizeof(float));
refq=calloc(nc2,sizeof(float));
ci=calloc(nc2,sizeof(float));
cq=calloc(nc2,sizeof(float));
cfi=calloc(nc2,sizeof(float));
cfq=calloc(nc2,sizeof(float));
twopidt=2.0*pi*dt;
/******************************************************************************
@@ -460,7 +592,7 @@ void subtract_signal2(float *id, float *qd, long np,
//lowpass filter and remove startup transient
float w[nfilt], norm=0, partialsum[nfilt];
memset(partialsum,0,sizeof(float)*nfilt);
for (i=0; i<nfilt; i++) partialsum[i]=0.0;
for (i=0; i<nfilt; i++) {
w[i]=sin(pi*(float)i/(float)(nfilt-1));
norm=norm+w[i];
@@ -516,8 +648,7 @@ unsigned long writec2file(char *c2filename, int trmin, double freq
{
int i;
float *buffer;
buffer=malloc(sizeof(float)*2*45000);
memset(buffer,0,sizeof(float)*2*45000);
buffer=calloc(2*45000,sizeof(float));
FILE *fp;
@@ -553,6 +684,7 @@ void usage(void)
printf("\n");
printf("Options:\n");
printf(" -a <path> path to writeable data files, default=\".\"\n");
printf(" -B disable block demodulation - use single-symbol noncoherent demod\n");
printf(" -c write .c2 file at the end of the first pass\n");
printf(" -C maximum number of decoder cycles per bit, default 10000\n");
printf(" -d deeper search. Slower, a few more decodes\n");
@@ -571,7 +703,7 @@ void usage(void)
//***************************************************************************
int main(int argc, char *argv[])
{
char cr[] = "(C) 2016, Steven Franke - K9AN";
char cr[] = "(C) 2018, Steven Franke - K9AN";
(void)cr;
extern char *optarg;
extern int optind;
@@ -585,8 +717,8 @@ int main(int argc, char *argv[])
char timer_fname[200],hash_fname[200];
char uttime[5],date[7];
int c,delta,maxpts=65536,verbose=0,quickmode=0,more_candidates=0, stackdecoder=0;
int writenoise=0,usehashtable=1,wspr_type=2, ipass;
int writec2=0, npasses=2, subtraction=1;
int writenoise=0,usehashtable=1,wspr_type=2, ipass, nblocksize;
int writec2=0,maxdrift;
int shift1, lagmin, lagmax, lagstep, ifmin, ifmax, worth_a_try, not_decoded;
unsigned int nbits=81, stacksize=200000;
unsigned int npoints, metric, cycles, maxnp;
@@ -606,22 +738,20 @@ int main(int argc, char *argv[])
struct result { char date[7]; char time[5]; float sync; float snr;
float dt; double freq; char message[23]; float drift;
unsigned int cycles; int jitter; };
unsigned int cycles; int jitter; int blocksize; unsigned int metric; };
struct result decodes[50];
char *hashtab;
hashtab=malloc(sizeof(char)*32768*13);
memset(hashtab,0,sizeof(char)*32768*13);
hashtab=calloc(32768*13,sizeof(char));
int nh;
symbols=malloc(sizeof(char)*nbits*2);
decdata=malloc(sizeof(char)*11);
channel_symbols=malloc(sizeof(char)*nbits*2);
callsign=malloc(sizeof(char)*13);
call_loc_pow=malloc(sizeof(char)*23);
symbols=calloc(nbits*2,sizeof(char));
decdata=calloc(11,sizeof(char));
channel_symbols=calloc(nbits*2,sizeof(char));
callsign=calloc(13,sizeof(char));
call_loc_pow=calloc(23,sizeof(char));
float allfreqs[100];
char allcalls[100][13];
memset(allfreqs,0,sizeof(float)*100);
for (i=0; i<100; i++) allfreqs[i]=0.0;
memset(allcalls,0,sizeof(char)*100*13);
int uniques=0, noprint=0, ndecodes_pass=0;
@@ -632,7 +762,10 @@ int main(int argc, char *argv[])
float minsync2=0.12; //Second sync limit
int iifac=8; //Step size in final DT peakup
int symfac=50; //Soft-symbol normalizing factor
int maxdrift=4; //Maximum (+/-) drift
int block_demod=1; //Default is to use block demod on pass 2
int subtraction=1;
int npasses=2;
float minrms=52.0 * (symfac/64.0); //Final test for plausible decoding
delta=60; //Fano threshold step
float bias=0.45; //Fano metric bias (used for both Fano and stack algorithms)
@@ -643,14 +776,17 @@ int main(int argc, char *argv[])
int mettab[2][256];
idat=malloc(sizeof(float)*maxpts);
qdat=malloc(sizeof(float)*maxpts);
idat=calloc(maxpts,sizeof(float));
qdat=calloc(maxpts,sizeof(float));
while ( (c = getopt(argc, argv, "a:cC:de:f:HJmqstwvz:")) !=-1 ) {
while ( (c = getopt(argc, argv, "a:BcC:de:f:HJmqstwvz:")) !=-1 ) {
switch (c) {
case 'a':
data_dir = optarg;
break;
case 'B':
block_demod=0;
break;
case 'c':
writec2=1;
break;
@@ -679,7 +815,7 @@ int main(int argc, char *argv[])
case 'q': //no shift jittering
quickmode = 1;
break;
case 's': //single pass mode (same as original wsprd)
case 's': //single pass mode
subtraction = 0;
npasses = 1;
break;
@@ -700,7 +836,7 @@ int main(int argc, char *argv[])
}
if( stackdecoder ) {
stack=malloc(stacksize*sizeof(struct snode));
stack=calloc(stacksize,sizeof(struct snode));
}
if( optind+1 > argc) {
@@ -809,11 +945,24 @@ int main(int argc, char *argv[])
//*************** main loop starts here *****************
for (ipass=0; ipass<npasses; ipass++) {
if( ipass > 0 && ndecodes_pass == 0 ) break;
ndecodes_pass=0;
if(ipass == 0) {
nblocksize=1;
maxdrift=4;
minsync2=0.12;
}
if(ipass == 1 ) {
if(block_demod == 1) {
nblocksize=3; // try all blocksizes up to 3
maxdrift=0; // no drift for smaller frequency estimator variance
minsync2=0.10;
} else { // if called with -B, revert to "classic" wspr params
nblocksize=1;
maxdrift=4;
minsync2=0.12;
}
}
ndecodes_pass=0; // still needed?
memset(ps,0.0, sizeof(float)*512*nffts);
for (i=0; i<nffts; i++) {
for(j=0; j<512; j++ ) {
k=i*128+j;
@@ -830,7 +979,7 @@ int main(int argc, char *argv[])
}
// Compute average spectrum
memset(psavg,0.0, sizeof(float)*512);
for (i=0; i<512; i++) psavg[i]=0.0;
for (i=0; i<nffts; i++) {
for (j=0; j<512; j++) {
psavg[j]=psavg[j]+ps[j][i];
@@ -864,7 +1013,8 @@ int main(int argc, char *argv[])
* The corresponding threshold is -42.3 dB in 2500 Hz bandwidth for WSPR-15. */
float min_snr, snr_scaling_factor;
min_snr = pow(10.0,-7.0/10.0); //this is min snr in wspr bw
// min_snr = pow(10.0,-7.0/10.0); //this is min snr in wspr bw
min_snr = pow(10.0,-8.0/10.0); //this is min snr in wspr bw
if( wspr_type == 2 ) {
snr_scaling_factor=26.3;
} else {
@@ -1031,7 +1181,6 @@ int main(int argc, char *argv[])
shift1=shift0[j];
sync1=sync0[j];
// coarse-grid lag and freq search, then if sync>minsync1 continue
fstep=0.0; ifmin=0; ifmax=0;
lagmin=shift1-128;
@@ -1047,25 +1196,26 @@ int main(int argc, char *argv[])
sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep, &shift1,
lagmin, lagmax, lagstep, &drift1, symfac, &sync1, 1);
// refine drift estimate
fstep=0.0; ifmin=0; ifmax=0;
float driftp,driftm,syncp,syncm;
driftp=drift1+0.5;
sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep, &shift1,
if(ipass == 0) {
// refine drift estimate
fstep=0.0; ifmin=0; ifmax=0;
float driftp,driftm,syncp,syncm;
driftp=drift1+0.5;
sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep, &shift1,
lagmin, lagmax, lagstep, &driftp, symfac, &syncp, 1);
driftm=drift1-0.5;
sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep, &shift1,
driftm=drift1-0.5;
sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep, &shift1,
lagmin, lagmax, lagstep, &driftm, symfac, &syncm, 1);
if(syncp>sync1) {
drift1=driftp;
sync1=syncp;
} else if (syncm>sync1) {
drift1=driftm;
sync1=syncm;
if(syncp>sync1) {
drift1=driftp;
sync1=syncp;
} else if (syncm>sync1) {
drift1=driftm;
sync1=syncm;
}
}
tsync1 += (float)(clock()-t0)/CLOCKS_PER_SEC;
// fine-grid lag and freq search
@@ -1089,49 +1239,53 @@ int main(int argc, char *argv[])
worth_a_try = 0;
}
int idt=0, ii=0, jiggered_shift;
int idt, ii, jittered_shift;
float y,sq,rms;
not_decoded=1;
while ( worth_a_try && not_decoded && idt<=(128/iifac)) {
ii=(idt+1)/2;
if( idt%2 == 1 ) ii=-ii;
ii=iifac*ii;
jiggered_shift=shift1+ii;
int ib=1, blocksize;
while( ib <= nblocksize && not_decoded ) {
blocksize=ib;
idt=0; ii=0;
while ( worth_a_try && not_decoded && idt<=(128/iifac)) {
ii=(idt+1)/2;
if( idt%2 == 1 ) ii=-ii;
ii=iifac*ii;
jittered_shift=shift1+ii;
// Use mode 2 to get soft-decision symbols
t0 = clock();
sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep,
&jiggered_shift, lagmin, lagmax, lagstep, &drift1, symfac,
&sync1, 2);
tsync2 += (float)(clock()-t0)/CLOCKS_PER_SEC;
sq=0.0;
for(i=0; i<162; i++) {
y=(float)symbols[i] - 128.0;
sq += y*y;
}
rms=sqrt(sq/162.0);
if((sync1 > minsync2) && (rms > minrms)) {
deinterleave(symbols);
t0 = clock();
if ( stackdecoder ) {
not_decoded = jelinek(&metric, &cycles, decdata, symbols, nbits,
stacksize, stack, mettab,maxcycles);
} else {
not_decoded = fano(&metric,&cycles,&maxnp,decdata,symbols,nbits,
mettab,delta,maxcycles);
noncoherent_sequence_detection(idat, qdat, npoints, symbols, &f1,
&jittered_shift, &drift1, symfac, &blocksize);
tsync2 += (float)(clock()-t0)/CLOCKS_PER_SEC;
sq=0.0;
for(i=0; i<162; i++) {
y=(float)symbols[i] - 128.0;
sq += y*y;
}
rms=sqrt(sq/162.0);
tfano += (float)(clock()-t0)/CLOCKS_PER_SEC;
if((sync1 > minsync2) && (rms > minrms)) {
deinterleave(symbols);
t0 = clock();
if ( stackdecoder ) {
not_decoded = jelinek(&metric, &cycles, decdata, symbols, nbits,
stacksize, stack, mettab,maxcycles);
} else {
not_decoded = fano(&metric,&cycles,&maxnp,decdata,symbols,nbits,
mettab,delta,maxcycles);
}
tfano += (float)(clock()-t0)/CLOCKS_PER_SEC;
}
idt++;
if( quickmode ) break;
}
idt++;
if( quickmode ) break;
}
ib++;
}
if( worth_a_try && !not_decoded ) {
ndecodes_pass++;
@@ -1157,7 +1311,6 @@ int main(int argc, char *argv[])
} else {
break;
}
}
// Remove dupes (same callsign and freq within 3 Hz)
@@ -1192,6 +1345,8 @@ int main(int argc, char *argv[])
decodes[uniques-1].drift=drift1;
decodes[uniques-1].cycles=cycles;
decodes[uniques-1].jitter=ii;
decodes[uniques-1].blocksize=blocksize;
decodes[uniques-1].metric=metric;
}
}
}
@@ -1223,11 +1378,11 @@ int main(int argc, char *argv[])
decodes[i].time, decodes[i].snr,decodes[i].dt, decodes[i].freq,
(int)decodes[i].drift, decodes[i].message);
fprintf(fall_wspr,
"%6s %4s %3d %3.0f %5.2f %11.7f %-22s %2d %5u %4d\n",
"%6s %4s %3d %3.0f %5.2f %11.7f %-22s %2d %5u %4d %4d %4d\n",
decodes[i].date, decodes[i].time, (int)(10*decodes[i].sync),
decodes[i].snr, decodes[i].dt, decodes[i].freq,
decodes[i].message, (int)decodes[i].drift, decodes[i].cycles/81,
decodes[i].jitter);
decodes[i].jitter,decodes[i].blocksize,decodes[i].metric);
fprintf(fwsprd,
"%6s %4s %3d %3.0f %4.1f %10.6f %-22s %2d %5u %4d\n",
decodes[i].date, decodes[i].time, (int)(10*decodes[i].sync),
@@ -1280,7 +1435,15 @@ int main(int argc, char *argv[])
}
fclose(fhash);
}
free(hashtab);
free(symbols);
free(decdata);
free(channel_symbols);
free(callsign);
free(call_loc_pow);
free(idat);
free(qdat);
if( stackdecoder ) {
free(stack);
}
lib/wsprd/wsprsim.c
+7 -5
View File
@@ -20,6 +20,7 @@ void usage() {
printf("Options:\n");
printf(" -c (print channel symbols)\n");
printf(" -d (print packed data with zero tail - 11 bytes)\n");
printf(" -f x (-100 Hz < f < 100 Hz)\n");
printf(" -o filename (write a c2 file with this name)\n");
printf(" -s x (x is snr of signal that is written to .c2 file)\n");
printf("\n");
@@ -126,6 +127,7 @@ int main(int argc, char *argv[])
extern int optind;
int i, c, printchannel=0, writec2=0;
float snr=50.0;
float f0=0.0, t0=1.0;
char *message, *c2filename, *hashtab;
c2filename=malloc(sizeof(char)*15);
hashtab=malloc(sizeof(char)*32768*13);
@@ -138,7 +140,7 @@ int main(int argc, char *argv[])
srand(getpid());
while ( (c = getopt(argc, argv, "cdo:s:")) !=-1 ) {
while ( (c = getopt(argc, argv, "cdf:o:s:")) !=-1 ) {
switch (c) {
case 'c':
printchannel=1;
@@ -146,12 +148,15 @@ int main(int argc, char *argv[])
case 'd':
printdata=1;
break;
case 'f':
f0 = atof(optarg);
case 'o':
c2filename = optarg;
writec2=1;
break;
case 's':
snr = (float)atoi(optarg);
// snr = (float)atoi(optarg);
snr = atof(optarg);
break;
}
}
@@ -192,9 +197,6 @@ int main(int argc, char *argv[])
snr=1.0;
}
float f0, t0;
f0=0.0;
t0=1.0;
add_signal_vector(f0, t0, snr, channel_symbols, isig, qsig);
if( writec2) {
// write a .c2 file
lib/wsprd/wsprsim_utils.c
+38 -37
View File
@@ -6,6 +6,13 @@
#include "nhash.h"
#include "fano.h"
static char get_locator_character_code(char ch);
static char get_callsign_character_code(char ch);
static long unsigned int pack_grid4_power(char const *grid4, int power);
static long unsigned int pack_call(char const *callsign);
static void pack_prefix(char *callsign, int32_t *n, int32_t *m, int32_t *nadd );
static void interleave(unsigned char *sym);
char get_locator_character_code(char ch) {
if( ch >=48 && ch <=57 ) { //0-9
return ch-48;
@@ -32,7 +39,7 @@ char get_callsign_character_code(char ch) {
return -1;
}
long unsigned int pack_grid4_power(char *grid4, int power) {
long unsigned int pack_grid4_power(char const *grid4, int power) {
long unsigned int m;
m=(179-10*grid4[0]-grid4[2])*180+10*grid4[1]+grid4[3];
@@ -40,32 +47,23 @@ long unsigned int pack_grid4_power(char *grid4, int power) {
return m;
}
long unsigned int pack_call(char *callsign) {
long unsigned int pack_call(char const *callsign) {
unsigned int i;
long unsigned int n;
char call6[6];
memset(call6,32,sizeof(char)*6);
memset(call6,' ',sizeof(call6));
// callsign is 6 characters in length. Exactly.
size_t call_len = strlen(callsign);
if( call_len > 6 ) {
return 0;
}
if( isdigit(*(callsign+2)) ) {
if( isdigit(callsign[2]) ) {
for (i=0; i<call_len; i++) {
if( callsign[i] == 0 ) {
call6[i]=32;
} else {
call6[i]=*(callsign+i);
}
call6[i]=callsign[i];
}
} else if( isdigit(*(callsign+1)) ) {
call6[0]=32;
} else if( isdigit(callsign[1]) ) {
for (i=1; i<call_len+1; i++) {
if( callsign[i-1]==0 ) {
call6[i]=32;
} else {
call6[i]=*(callsign+i-1);
}
call6[i]=callsign[i-1];
}
}
for (i=0; i<6; i++) {
@@ -82,9 +80,7 @@ long unsigned int pack_call(char *callsign) {
void pack_prefix(char *callsign, int32_t *n, int32_t *m, int32_t *nadd ) {
size_t i;
char *call6;
call6=malloc(sizeof(char)*6);
memset(call6,32,sizeof(char)*6);
char * call6 = calloc(7,sizeof (char));
size_t i1=strcspn(callsign,"/");
if( callsign[i1+2] == 0 ) {
@@ -92,6 +88,7 @@ void pack_prefix(char *callsign, int32_t *n, int32_t *m, int32_t *nadd ) {
for (i=0; i<i1; i++) {
call6[i]=callsign[i];
}
call6[i] = '\0';
*n=pack_call(call6);
*nadd=1;
int nc = callsign[i1+1];
@@ -113,10 +110,10 @@ void pack_prefix(char *callsign, int32_t *n, int32_t *m, int32_t *nadd ) {
*m=10*(callsign[i1+1]-48)+(callsign[i1+2]-48);
*m=60000 + 26 + *m;
} else {
char* pfx=strtok(callsign,"/");
call6=strtok(NULL," ");
*n=pack_call(call6);
size_t plen=strlen(pfx);
char const * pfx = strtok (callsign,"/");
char const * call = strtok(NULL," ");
*n = pack_call (call);
size_t plen=strlen (pfx);
if( plen ==1 ) {
*m=36;
*m=37*(*m)+36;
@@ -142,6 +139,7 @@ void pack_prefix(char *callsign, int32_t *n, int32_t *m, int32_t *nadd ) {
*nadd=1;
}
}
free (call6);
}
void interleave(unsigned char *sym)
@@ -165,7 +163,8 @@ void interleave(unsigned char *sym)
}
int get_wspr_channel_symbols(char* rawmessage, char* hashtab, unsigned char* symbols) {
int m=0, n=0, ntype=0;
int m=0, ntype=0;
long unsigned int n=0;
int i, j, ihash;
unsigned char pr3[162]=
{1,1,0,0,0,0,0,0,1,0,0,0,1,1,1,0,0,0,1,0,
@@ -197,7 +196,7 @@ int get_wspr_channel_symbols(char* rawmessage, char* hashtab, unsigned char* sym
// Use the presence and/or absence of "<" and "/" to decide what
// type of message. No sanity checks! Beware!
if( (i1>3) & (i1<7) & (i2==mlen) & (i3==mlen) ) {
if( i1 > 3 && i1 < 7 && i2 == mlen && i3 == mlen ) {
// Type 1 message: K9AN EN50 33
// xxnxxxx xxnn nn
callsign = strtok(message," ");
@@ -227,20 +226,20 @@ int get_wspr_channel_symbols(char* rawmessage, char* hashtab, unsigned char* sym
ihash=nhash(callsign,strlen(callsign),(uint32_t)146);
m=128*ihash + ntype + 64;
char grid6[6];
memset(grid6,32,sizeof(char)*6);
char grid6[7];
memset(grid6,0,sizeof(char)*7);
j=strlen(grid);
for(i=0; i<j-1; i++) {
grid6[i]=grid[i+1];
}
grid6[5]=grid[0];
n=pack_call(grid6);
n = pack_call(grid6);
} else if ( i2 < mlen ) { // just looks for a right slash
// Type 2: PJ4/K1ABC 37
callsign=strtok(message," ");
if( strlen(callsign) < i2 ) return 0; //guards against pathological case
powstr=strtok(NULL," ");
int power = atoi(powstr);
callsign = strtok (message," ");
if( i2==0 || i2>strlen(callsign) ) return 0; //guards against pathological case
powstr = strtok (NULL," ");
int power = atoi (powstr);
if( power < 0 ) power=0;
if( power > 60 ) power=60;
power=power+nu[power%10];
@@ -252,7 +251,7 @@ int get_wspr_channel_symbols(char* rawmessage, char* hashtab, unsigned char* sym
} else {
return 0;
}
// pack 50 bits + 31 (0) tail bits into 11 bytes
unsigned char it, data[11];
memset(data,0,sizeof(char)*11);
@@ -292,20 +291,22 @@ int get_wspr_channel_symbols(char* rawmessage, char* hashtab, unsigned char* sym
check_callsign=malloc(sizeof(char)*13);
signed char check_data[11];
memcpy(check_data,data,sizeof(char)*11);
unpk_(check_data,hashtab,check_call_loc_pow,check_callsign);
// printf("Will decode as: %s\n",check_call_loc_pow);
unsigned int nbytes=11; // The message with tail is packed into almost 11 bytes.
unsigned char channelbits[nbytes*8*2]; /* 162 rounded up */
memset(channelbits,0,sizeof channelbits);
memset(channelbits,0,sizeof(char)*nbytes*8*2);
encode(channelbits,data,nbytes);
interleave(channelbits);
for (i=0; i<162; i++) {
symbols[i]=2*channelbits[i]+pr3[i];
}
free(check_call_loc_pow);
free(check_callsign);
return 1;
}
lib/wsprd/wsprsim_utils.h
-12
View File
@@ -11,18 +11,6 @@
extern int printdata;
char get_locator_character_code(char ch);
char get_callsign_character_code(char ch);
long unsigned int pack_grid4_power(char *grid4, int power);
long unsigned int pack_call(char *callsign);
void pack_prefix(char *callsign, int32_t *n, int32_t *m, int32_t *nadd );
void interleave(unsigned char *sym);
int get_wspr_channel_symbols(char* message, char* hashtab, unsigned char* symbols);
#endif
lib/xcall.txt
+268
View File
@@ -0,0 +1,268 @@
2E0DGP IO83
5P6MJ JO54
AA2UK FM29
AA4HV EM55
AA4QE EM78
AA7UN DN32
AB6BT CM88
AB9QZ EN41
AC4VM EM78
AC9QI EN52
AD0PL EM48
AD9H EN61
AF5NP EM10
AF7M DM42
AG4QX EL87
AH0U CM97
AK3Q EM79
CC6IJM FO03
CE4SFG FF45
CF7GEM CN89
CO2DC EL83
CO2ER EL83
CO2YQ EL83
CO3LT EL93
CT1FIU IN50
CT7AEL IM69
CU2DX HM77
DL5UZ JN49
DL6BEN JO44
EA1AAE IN81
EA5IGV IM99
EA5ISK IM99
EA5WO IM99
EA5YI IM99
EA7OM IM87
EB3ENW JN11
F6CAX JO00
F6GCP JN18
G4IUA IO91
GI4FUE IO74
HK2PMR FJ29
HK4SAN FJ26
HK6JCF FJ25
I3FGX JN55
IK2DJV JN45
IK5BSC JN53
IK8IJN JM78
IN3BJS JN55
IS0FWY JM49
IU8CNE JN71
IW4EJK JN54
JA9AVA PM86
JA9LJS PM86
JR3IIR PM74
K0AY FN20
K1BMW CM99
K1GG EM97
K1HTV FM18
K1VOI FN32
K2AK DM41
K2RMA EM90
K2SST EM85
K2TE EL98
K3DBD FN20
K3ZGA EL98
K4DL EM63
K4ELI EM74
K4OP EM77
K4SHQ EM64
K5CIA EM12
K5EJ EM45
K5KLA EL49
K5RCD EL09
K5RWD EL09
K5WP EM71
K6JQ CM88
K6MKF CM97
K6RIM CM87
K6SJT DM13
K7CAH CN87
K7NN DM42
K7VNE DM43
K9LRE EM57
K9PY EN61
KA1AQP FN42
KA4RSZ EM73
KA5JTM EL29
KA6A EM13
KA8TBW EN61
KA9KQH EM59
KB2M EL99
KB5IKR EM70
KC6AWX CM88
KC9H EN62
KC9UPE EN53
KC9WIB EN61
KC9WNZ EM48
KD9E EM58
KE0HQZ EN12
KE0N EN34
KE7HHW DN13
KF4ZLO EM78
KG5GCC EM50
KG6TT CM88
KG7GPM DN17
KI7JFH CN85
KI7MT DN46
KK0M CM97
KK6PTO DM14
KM2J EL87
KM4DDJ EM76
KM4PJJ EM72
KN1SIX EM90
KN4CRD EM73
KN9TVE EN52
KO4PU EM67
KP2L EM93
KP4KD EL95
KP4PR FK68
KP4SX FK78
KR6EN EM59
KS0CW FM16
KS4OT EM83
KW4HT EM64
LA5SJA KQ50
LU6UBM FF84
LU8AFR GF05
LU8DQS GF05
LU8EKC GF05
LV7QFH EM95
LZ1OI KN22
M0LVL IO84
M0OIC IO92
M6RUG IO83
MI0KOA IO74
MM0LGS IO85
N0BAK EN34
N1SER EM90
N2BJ EN61
N2PPI FN30
N3HI DM03
N3MK FM27
N4HYK EL87
N4LAG EM85
N4MKA EM84
N5AYB EL17
N5BCA EM12
N5BSA EM12
N5SLY EM13
N6GP DM13
N6OJ CM88
N6PM DM13
N6QQ DM03
N6UK DM14
N7IP DN26
N7IY CN84
N7NT DM43
N7ZO CN85
N8EHW EN81
N8HMG EN91
N8JAF EM89
N9MUF EN51
N9NTC EN53
NA6L DM12
NE6I DM12
NN3V DM13
NQ6F DM12
NS2X EM76
NU4T EM74
NV8B EN63
NX8Y EN80
NY4I EL87
ON3BZ JO20
ON3EA JO21
ON3LMA JO20
ON7ZV JO20
OT1V JO20
OX6EYS LB60
OZ1FHU JO55
PA2GP JO33
PD0LH JO22
PD9BG JO21
PE2K JO22
PR7MB HI22
PY2LK GG66
PY2RJ GG66
PY2XIZ GG66
PY2YZB GG66
PY4OY GG78
PY7BC HI21
RW0SR OO22
SM6THE JO68
SV2WT KN10
TI4DJ EK70
UT7QF KN77
VA3DAZ EN82
VA3LU EN58
VE7AHT CN89
VE9GJ FN77
W0OGH DM52
W0TW EN74
W0YF EN11
W1PFZ FN42
W2HRO FN20
W2PKY EL88
W3BI FN20
W3BS EM55
W3KM FN20
W3MR FM18
W4EIS EM13
W4GE FM02
W4JSI EM64
W4SFG EM74
W4WYI EM83
W5JPT EM11
W5ZTX EL29
W6AER CM87
W6AUN DM79
W6NWS FM05
W6RYO DM08
W7AUF CN85
W7CT DN41
W7DMC CN85
W7SUR DM49
W7VP CN87
W8AKS EM97
W8FHF EN90
W8HC EM98
W8MSC EN82
W8OI EM88
W8RES EM79
W8WEJ EM99
W8WKE EL16
W9CTH EM69
W9EO DM04
W9WB EN51
W9YSX EM79
WA0LIF EN35
WA1SXK EM95
WA2HIP FN54
WA4MIT EM63
WA4VJK EM66
WA6PHR CM94
WA7DVD DN40
WA9DU EM69
WA9EIC EN60
WA9JWL EN70
WA9NNN EN61
WB2JEP DM33
WB2KSP FN31
WB2REM EL97
WB3FSR FN20
WB5OZA EM30
WB5TKI EL29
WB5UDI EM20
WB5XX EM33
WB7UZO CN78
WD4KAV CN87
WD5IQR EM10
WE5EE EL49
WL7CG BP61
WP4NSE FK68
WS5W EM13
WV5Y EL29
WV8DOH EM99
WV9L EM59
WW7B DM33
YV5BM FK60