diff --git a/CMakeLists.txt b/CMakeLists.txt index 21a20355d..a91121d7d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -446,6 +446,7 @@ set (wsjt_FSRCS lib/fsk4hf/fsk4hf.f90 lib/ft8/ft8apset.f90 lib/ft8/ft8b.f90 + lib/ft8/ft8code.f90 lib/ft8/ft8_downsample.f90 lib/ft8/ft8sim.f90 lib/gen4.f90 @@ -1221,6 +1222,9 @@ target_link_libraries (ldpcsim168 wsjt_fort wsjt_cxx) add_executable (fsk4hf lib/fsk4hf/fsk4hf.f90 wsjtx.rc) target_link_libraries (fsk4hf wsjt_fort wsjt_cxx) +add_executable (ft8code lib/ft8/ft8code.f90 wsjtx.rc) +target_link_libraries (ft8code wsjt_fort wsjt_cxx) + add_executable (ft8sim lib/ft8/ft8sim.f90 wsjtx.rc) target_link_libraries (ft8sim wsjt_fort wsjt_cxx) @@ -1416,7 +1420,7 @@ install (TARGETS udp_daemon message_aggregator BUNDLE DESTINATION ${CMAKE_INSTALL_BINDIR} COMPONENT runtime ) -install (TARGETS jt9 jt65code qra64code qra64sim jt9code jt4code +install (TARGETS jt9 ft8code jt65code qra64code qra64sim jt9code jt4code msk144code wsprd wspr_fsk8d fmtave fcal fmeasure RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} COMPONENT runtime BUNDLE DESTINATION ${CMAKE_INSTALL_BINDIR} COMPONENT runtime diff --git a/lib/ft8/extractmessage174.f90 b/lib/ft8/extractmessage174.f90 index 28789846a..e7c7c3a1b 100644 --- a/lib/ft8/extractmessage174.f90 +++ b/lib/ft8/extractmessage174.f90 @@ -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) @@ -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 diff --git a/lib/ft8/ft8b.f90 b/lib/ft8/ft8b.f90 index aabee1dca..504c547af 100644 --- a/lib/ft8/ft8b.f90 +++ b/lib/ft8/ft8b.f90 @@ -5,10 +5,10 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & 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 mycall12,hiscall12,recent_calls(NRECENT) + character*12 mycall12,hiscall12 character*6 mycall6,mygrid6,hiscall6,c1,c2 character*87 cbits logical bcontest @@ -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,recent_calls,nrecent) + call extractmessage174(decoded,message,ncrcflag) decoded=decoded0 ! This needs fixing for messages with i3bit=1: call genft8(message,mygrid6,bcontest,i3bit,msgsent,msgbits,itone) @@ -401,7 +401,6 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & 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 @@ -411,17 +410,13 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & 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//' <...> ' - write(51,*) 'a ',msg37,'|' + msg37=c1//' RR73; '//c2//' <...> ' write(msg37(35:37),1010) irpt 1010 format(i3.2) - if(msg37(30:30).ne.'-') msg37(35:35)='+' - write(51,*) 'b ',msg37,'|' + if(msg37(35:35).ne.'-') msg37(35:35)='+' iz=len(trim(msg37)) - do iter=1,10 !Collapse multiple blanks into one + do iter=1,10 !Collapse multiple blanks ib2=index(msg37(1:iz),' ') if(ib2.lt.1) exit msg37=msg37(1:ib2)//msg37(ib2+2:) diff --git a/lib/ft8/ft8code.f90 b/lib/ft8/ft8code.f90 new file mode 100644 index 000000000..df7ae5614 --- /dev/null +++ b/lib/ft8/ft8code.f90 @@ -0,0 +1,137 @@ +program ft8code + +! Provides examples of message packing, LDPC(144,87) encoding, bit and +! symbol ordering, and other details of the FT8 protocol. + +! Generate simulated data for a 15-second HF/6m mode using 8-FSK. +! Output is saved to a *.wav file. + + use packjt + use crc + include 'ft8_params.f90' !Set various constants + include 'ft8_testmsg.f90' + parameter (NWAVE=NN*NSPS) + +! character*40 msg40,msgchk40 + 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 -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 Expected"/ & + 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,.false.) + 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) + endif + +999 end program ft8code diff --git a/lib/ft8/ldpcsim174.f90 b/lib/ft8/ldpcsim174.f90 index bffccb618..08b181ebb 100644 --- a/lib/ft8/ldpcsim174.f90 +++ b/lib/ft8/ldpcsim174.f90 @@ -3,8 +3,6 @@ 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 @@ -31,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 @@ -194,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