From 88ad573de9daf2b17a5c79484fe532ba932af2c1 Mon Sep 17 00:00:00 2001 From: Jordan Sherer Date: Sun, 5 Aug 2018 17:40:19 -0400 Subject: [PATCH] Experimenting with full packing of 72-bit messages using an intermediate base64 alphabet (12 x 6-bit characters) --- lib/ft8/extractmessage174.f90 | 14 ++++++- lib/ft8/ft8b.f90 | 72 ++++++++++++++++++----------------- lib/ft8/genft8.f90 | 27 ++++++++++++- 3 files changed, 74 insertions(+), 39 deletions(-) diff --git a/lib/ft8/extractmessage174.f90 b/lib/ft8/extractmessage174.f90 index 3734377..066591b 100644 --- a/lib/ft8/extractmessage174.f90 +++ b/lib/ft8/extractmessage174.f90 @@ -2,13 +2,15 @@ subroutine extractmessage174(decoded,msgreceived,ncrcflag) use iso_c_binding, only: c_loc,c_size_t use crc use packjt - + character*68 alphabet character*22 msgreceived character*87 cbits integer*1 decoded(87) integer*1, target:: i1Dec8BitBytes(11) integer*4 i4Dec6BitWords(12) + alphabet='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+/?. abcdefghijklmnopqrstuvwxyz' + ! Write decoded bits into cbits: 75-bit message plus 12-bit CRC write(cbits,1000) decoded 1000 format(87i1) @@ -31,7 +33,15 @@ subroutine extractmessage174(decoded,msgreceived,ncrcflag) enddo i4Dec6BitWords(ibyte)=itmp enddo - call unpackmsg(i4Dec6BitWords,msgreceived,.false.,' ') + + !call unpackmsg(i4Dec6BitWords,msgreceived,.false.,' ') + + msgreceived=' ' + do ibyte=1,12 + itmp=i4Dec6BitWords(ibyte) + msgreceived(ibyte:ibyte) = alphabet(itmp+1:itmp+1) + enddo + ncrcflag=1 else msgreceived=' ' diff --git a/lib/ft8/ft8b.f90 b/lib/ft8/ft8b.f90 index 341d921..67a9cbe 100644 --- a/lib/ft8/ft8b.f90 +++ b/lib/ft8/ft8b.f90 @@ -7,7 +7,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & include 'ft8_params.f90' parameter(NP2=2812) character*37 msg37 - character message*22,msgsent*22 + character message*22,msgsent*22,origmsg*22 character*12 mycall12,hiscall12 character*6 mycall6,mygrid6,hiscall6,c1,c2 character*87 cbits @@ -378,7 +378,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & if(nbadcrc.eq.0) then decoded0=decoded if(i3bit.eq.1) decoded(57:)=0 - call extractmessage174(decoded,message,ncrcflag) + call extractmessage174(decoded,origmsg,ncrcflag) decoded=decoded0 ! This needs fixing for messages with i3bit=1: @@ -399,40 +399,42 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & 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(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 - 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 + msg37=origmsg//' ' if(i3bit.gt.1) then msg37(22:22) = char(48 + i3bit) diff --git a/lib/ft8/genft8.f90 b/lib/ft8/genft8.f90 index 4d01267..331408b 100644 --- a/lib/ft8/genft8.f90 +++ b/lib/ft8/genft8.f90 @@ -5,6 +5,7 @@ subroutine genft8(msg,mygrid,bcontest,i3bit,msgsent,msgbits,itone) use crc use packjt include 'ft8_params.f90' + character*68 alphabet character*22 msg,msgsent character*6 mygrid character*87 cbits @@ -16,8 +17,30 @@ subroutine genft8(msg,mygrid,bcontest,i3bit,msgsent,msgbits,itone) integer icos7(0:6) data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern - call packmsg(msg,i4Msg6BitWords,itype,bcontest) !Pack into 12 6-bit bytes - call unpackmsg(i4Msg6BitWords,msgsent,bcontest,mygrid) !Unpack to get msgsent + alphabet='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-+/?. abcdefghijklmnopqrstuvwxyz' + + itype=6 + do i=1,12 + v=index(alphabet, msg(i:i)) - 1 + i4Msg6BitWords(i)=v + enddo + !i4Msg6BitWords( 1)=index(alphabet, msg( 1: 2)) + !i4Msg6BitWords( 2)=index(alphabet, msg( 2: 3)) + !i4Msg6BitWords( 3)=index(alphabet, msg( 3: 4)) + !i4Msg6BitWords( 4)=index(alphabet, msg( 4: 5)) + !i4Msg6BitWords( 5)=index(alphabet, msg( 5: 6)) + !i4Msg6BitWords( 6)=index(alphabet, msg( 6: 7)) + !i4Msg6BitWords( 7)=index(alphabet, msg( 7: 8)) + !i4Msg6BitWords( 8)=index(alphabet, msg( 8: 9)) + !i4Msg6BitWords( 9)=index(alphabet, msg( 9:10)) + !i4Msg6BitWords(10)=index(alphabet, msg(10:11)) + !i4Msg6BitWords(11)=index(alphabet, msg(11:12)) + !i4Msg6BitWords(12)=index(alphabet, msg(12:13)) + msgsent=' ' + msgsent(1:12)=msg(1:12) + + ! call packmsg(msg,i4Msg6BitWords,itype,bcontest) !Pack into 12 6-bit bytes + ! call unpackmsg(i4Msg6BitWords,msgsent,bcontest,mygrid) !Unpack to get msgsent write(cbits,1000) i4Msg6BitWords,32*i3bit 1000 format(12b6.6,b8.8)