From e434bc5b550ec34632cfa2b9fc46beb3641cf363 Mon Sep 17 00:00:00 2001 From: Steve Franke Date: Fri, 23 Nov 2018 15:10:44 -0600 Subject: [PATCH] Remove obsolete routines related to msk144. --- CMakeLists.txt | 13 +-- lib/Makefile.mskWin | 75 --------------- lib/encode_msk144.f90 | 111 --------------------- lib/extractmessage144.f90 | 51 ---------- lib/genmsk144.f90 | 146 ---------------------------- lib/genmsk_short.f90 | 66 ------------- lib/ldpcsim144.f90 | 175 --------------------------------- lib/msk144d.f90 | 136 -------------------------- lib/msk144sd.f90 | 197 -------------------------------------- lib/msk144sim.f90 | 21 ++-- lib/platanh.f90 | 24 +++++ lib/pltanh.f90 | 24 +++++ lib/unpackmsg144.f90 | 117 ---------------------- 13 files changed, 59 insertions(+), 1097 deletions(-) delete mode 100644 lib/Makefile.mskWin delete mode 100644 lib/encode_msk144.f90 delete mode 100644 lib/extractmessage144.f90 delete mode 100644 lib/genmsk144.f90 delete mode 100644 lib/genmsk_short.f90 delete mode 100644 lib/ldpcsim144.f90 delete mode 100644 lib/msk144d.f90 delete mode 100644 lib/msk144sd.f90 create mode 100644 lib/platanh.f90 create mode 100644 lib/pltanh.f90 delete mode 100644 lib/unpackmsg144.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 39411f8a2..5818cc8b3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -382,7 +382,6 @@ set (wsjt_FSRCS lib/badmsg.f90 lib/ft8/baseline.f90 lib/bpdecode40.f90 - lib/bpdecode144.f90 lib/bpdecode128_90.f90 lib/ft8/bpdecode174.f90 lib/ft8/bpdecode174_91.f90 @@ -414,7 +413,6 @@ set (wsjt_FSRCS lib/encode232.f90 lib/encode4.f90 lib/encode_msk40.f90 - lib/encode_msk144.f90 lib/encode_128_90.f90 lib/ft8/encode174.f90 lib/ft8/encode174_91.f90 @@ -422,7 +420,6 @@ set (wsjt_FSRCS lib/ephem.f90 lib/extract.f90 lib/extract4.f90 - lib/extractmessage144.f90 lib/extractmessage77.f90 lib/ft8/extractmessage174.f90 lib/ft8/extractmessage174_91.f90 @@ -497,10 +494,8 @@ set (wsjt_FSRCS lib/moondopjpl.f90 lib/morse.f90 lib/move.f90 - lib/msk144d.f90 lib/msk40decodeframe.f90 lib/msk144decodeframe.f90 - lib/msk144sd.f90 lib/msk40spd.f90 lib/msk144spd.f90 lib/msk40sync.f90 @@ -519,6 +514,8 @@ set (wsjt_FSRCS lib/peakdt9.f90 lib/peakup.f90 lib/plotsave.f90 + lib/platanh.f90 + lib/pltanh.f90 lib/polyfit.f90 lib/prog_args.f90 lib/ps4.f90 @@ -561,7 +558,6 @@ set (wsjt_FSRCS lib/twkfreq.f90 lib/ft8/twkfreq1.f90 lib/twkfreq65.f90 - lib/unpackmsg144.f90 lib/update_recent_calls.f90 lib/update_hasharray.f90 lib/ft8/watterson.f90 @@ -1252,14 +1248,9 @@ 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) -add_executable (msk144sd lib/msk144sd.f90 wsjtx.rc) -target_link_libraries (msk144sd wsjt_fort wsjt_cxx) - add_executable (msk144sim lib/msk144sim.f90 wsjtx.rc) target_link_libraries (msk144sim wsjt_fort wsjt_cxx) -add_executable (msk144d lib/msk144d.f90 wsjtx.rc) -target_link_libraries (msk144d wsjt_fort wsjt_cxx) endif(WSJT_BUILD_UTILS) # build the main application diff --git a/lib/Makefile.mskWin b/lib/Makefile.mskWin deleted file mode 100644 index 9d5e6e62b..000000000 --- a/lib/Makefile.mskWin +++ /dev/null @@ -1,75 +0,0 @@ - -# Set paths -EXE_DIR = ..\\..\\wsjtx_install -QT_DIR = C:/wsjt-env/Qt5/5.2.1/mingw48_32 -FFTW3_DIR = .. - -INCPATH = -I${QT_DIR}/include/QtCore -I${QT_DIR}/include - -# Compilers -CC = gcc -CXX = g++ -FC = gfortran -AR = ar cr -RANLIB = ranlib -MKDIR = mkdir -p -CP = cp -RM = rm -f - -FFLAGS = -O2 -fbounds-check -Wall -Wno-conversion -CFLAGS = -O2 -I. - -# Default rules -%.o: %.c - ${CC} ${CFLAGS} -c $< -%.o: %.f - ${FC} ${FFLAGS} -c $< -%.o: %.F - ${FC} ${FFLAGS} -c $< -%.o: %.f90 - ${FC} ${FFLAGS} -c $< -%.o: %.F90 - ${FC} ${FFLAGS} -c $< - -#all: jt9code JTMSKcode.exe -all: jtmsk.exe JTMSKsim.exe JTMSKcode.exe fixwav.exe - -OBJS3 = JTMSKsim.o wavhdr.o gran.o four2a.o db.o -JTMSKsim.exe: $(OBJS3) - $(FC) -o JTMSKsim.exe $(OBJS3) C:\JTSDK\fftw3f\libfftw3f-3.dll - -OBJS4 = jt9code.o packjt.o fmtmsg.o gen9.o deg2grid.o grid2deg.o \ - entail.o encode232.o interleave9.o graycode.o igray.o -jt9code: $(OBJS4) - $(FC) -o jt9code $(OBJS4) - -OBJS5 = JTMSKcode.o packjt.o fmtmsg.o genmsk.o deg2grid.o grid2deg.o \ - entail.o tab.o vit213.o hashing.o nhash.o -JTMSKcode.exe: $(OBJS5) - $(FC) -o JTMSKcode.exe $(OBJS5) - -OBJS6 = jtmsk.o analytic.o four2a.o db.o pctile.o \ - shell.o tweak1.o syncmsk.o genmsk.o packjt.o fmtmsg.o indexx.o \ - deg2grid.o grid2deg.o entail.o hashing.o nhash.o tab.o vit213.o \ - mskdt.o rectify_msk.o timer.o jtmsk_decode.o genmsk_short.o \ - jtmsk_short.o golay24_table.o hash.o - -jtmsk.exe: $(OBJS6) - $(FC) -o jtmsk.exe $(OBJS6) C:\JTSDK\fftw3f\libfftw3f-3.dll - -OBJS1 = fixwav.o wavhdr.o -fixwav.exe: $(OBJS1) - $(FC) -o fixwav.exe $(OBJS1) - -OBJS2 = t2.o four2a.o db.o -t2: $(OBJS2) - $(FC) -o t2 $(OBJS2) C:\JTSDK\fftw3f\libfftw3f-3.dll - -OBJS6 = t6.o four2a.o db.o -t6: $(OBJS6) - $(FC) -o t6 $(OBJS6) C:\JTSDK\fftw3f\libfftw3f-3.dll - -.PHONY : clean - -clean: - $(RM) *.o JTMSKcode JTMSKcode.exe diff --git a/lib/encode_msk144.f90 b/lib/encode_msk144.f90 deleted file mode 100644 index 4e4d8968e..000000000 --- a/lib/encode_msk144.f90 +++ /dev/null @@ -1,111 +0,0 @@ -subroutine encode_msk144(message,codeword) -! Encode an 80-bit message and return a 128-bit codeword. -! The generator matrix has dimensions (48,80). -! The code is a (128,80) 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 stored in Radford Neal's "pchk" format. -! -character*20 g(48) -integer*1 codeword(128) -integer*1 colorder(128) -integer*1 gen144(48,80) -integer*1 itmp(128) -integer*1 message(80) -integer*1 pchecks(48) -logical first -data first/.true./ -data g/ & !parity-check generator matrix for (128,80) code - "24084000800020008000", & - "b39678f7ccdb1baf5f4c", & - "10001000400408012000", & - "08104000100002010800", & - "dc9c18f61ea0e4b7f05c", & - "42c040160909ca002c00", & - "cc50b52b9a80db0d7f9e", & - "dde5ace80780bae74740", & - "00800080020000890080", & - "01020040010400400040", & - "20008010020000100030", & - "80400008004000040050", & - "a4b397810915126f5604", & - "04040100001040200008", & - "00800006000888000800", & - "00010c00000104040001", & - "cc7cd7d953cdc204eba0", & - "0094abe7dd146beb16ce", & - "5af2aec8c7b051c7544a", & - "14040508801840200088", & - "7392f5e720f8f5a62c1e", & - "503cc2a06bff4e684ec9", & - "5a2efd46f1efbb513b80", & - "ac06e9513fd411f1de03", & - "16a31be3dd3082ca2bd6", & - "28542e0daf62fe1d9332", & - "00210c002001540c0401", & - "0ed90d56f84298706a98", & - "939670f7ecdf9baf4f4c", & - "cfe41dec47a433e66240", & - "16d2179c2d5888222630", & - "408000160108ca002800", & - "808000830a00018900a0", & - "9ae2ed8ef3afbf8c3a52", & - "5aaafd86f3efbfc83b02", & - "f39658f68cdb0baf1f4c", & - "9414bb6495106261366a", & - "71ba18670c08411bf682", & - "7298f1a7217cf5c62e5e", & - "86d7a4864396a981369b", & - "a8042c01ae22fe191362", & - "9235ae108b2d60d0e306", & - "dfe5ade807a03be74640", & - "d2451588e6e27ccd9bc4", & - "12b51ae39d20e2ea3bde", & - "a49387810d95136fd604", & - "467e7578e51d5b3b8a0e", & - "f6ad1ac7cc3aaa3fe580"/ - -data colorder/0,1,2,3,4,5,6,7,8,9, & - 10,11,12,13,14,15,24,26,29,30, & - 32,43,44,47,60,77,79,97,101,111, & - 96,38,64,53,93,34,59,94,74,90, & - 108,123,85,57,70,25,69,62,48,49, & - 50,51,52,33,54,55,56,21,58,36, & - 16,61,23,63,20,65,66,67,68,46, & - 22,71,72,73,31,75,76,45,78,17, & - 80,81,82,83,84,42,86,87,88,89, & - 39,91,92,35,37,95,19,27,98,99, & - 100,28,102,103,104,105,106,107,40,109, & - 110,18,112,113,114,115,116,117,118,119, & - 120,121,122,41,124,125,126,127/ - -save first,gen144 - -if( first ) then ! fill the generator matrix - gen144=0 - do i=1,48 - do j=1,5 - read(g(i)( (j-1)*4+1:(j-1)*4+4 ),"(Z4)") istr - do jj=1,16 - icol=(j-1)*16+jj - if( btest(istr,16-jj) ) gen144(i,icol)=1 - enddo - enddo - enddo -first=.false. -endif - -do i=1,48 - nsum=0 - do j=1,80 - nsum=nsum+message(j)*gen144(i,j) - enddo - pchecks(i)=mod(nsum,2) -enddo -itmp(1:48)=pchecks -itmp(49:128)=message(1:80) -codeword(colorder+1)=itmp(1:128) - -return -end subroutine encode_msk144 diff --git a/lib/extractmessage144.f90 b/lib/extractmessage144.f90 deleted file mode 100644 index a5dadb0b4..000000000 --- a/lib/extractmessage144.f90 +++ /dev/null @@ -1,51 +0,0 @@ -subroutine extractmessage144(decoded,msgreceived,nhashflag,recent_calls,nrecent) - use iso_c_binding, only: c_loc,c_size_t - use packjt - use hashing - - character*22 msgreceived - character*12 call1,call2 - character*12 recent_calls(nrecent) - integer*1 decoded(80) - integer*1, target:: i1Dec8BitBytes(10) - integer*1 i1hashdec - integer*4 i4Dec6BitWords(12) - -! Collapse 80 decoded bits to 10 bytes. Bytes 1-9 are the message, byte 10 is the hash - do ibyte=1,10 - itmp=0 - do ibit=1,8 - itmp=ishft(itmp,1)+iand(1,decoded((ibyte-1)*8+ibit)) - enddo - i1Dec8BitBytes(ibyte)=itmp - enddo - -! Calculate the hash using the first 9 bytes. - ihashdec=nhash(c_loc(i1Dec8BitBytes),int(9,c_size_t),146) - ihashdec=2*iand(ihashdec,255) - -! Compare calculated hash with received byte 10 - if they agree, keep the message. - i1hashdec=ihashdec - if( i1hashdec .eq. i1Dec8BitBytes(10) ) then -! Good hash --- unpack 72-bit message - do ibyte=1,12 - itmp=0 - do ibit=1,6 - itmp=ishft(itmp,1)+iand(1,decoded((ibyte-1)*6+ibit)) - enddo - i4Dec6BitWords(ibyte)=itmp - enddo - call unpackmsg144(i4Dec6BitWords,msgreceived,call1,call2) - nhashflag=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=' ' - nhashflag=-1 - endif - return - end subroutine extractmessage144 diff --git a/lib/genmsk144.f90 b/lib/genmsk144.f90 deleted file mode 100644 index f02344439..000000000 --- a/lib/genmsk144.f90 +++ /dev/null @@ -1,146 +0,0 @@ -subroutine genmsk144(msg0,mygrid,ichk,msgsent,i4tone,itype) -! s8 + 48bits + s8 + 80 bits = 144 bits (72ms message duration) -! -! Encode an MSK144 message -! Input: -! - msg0 requested message to be transmitted -! - ichk if ichk=1, return only msgsent -! if ichk.ge.10000, set imsg=ichk-10000 for short msg -! - msgsent message as it will be decoded -! - i4tone array of audio tone values, 0 or 1 -! - itype message type -! 1 = standard message "Call_1 Call_2 Grid/Rpt" -! 2 = type 1 prefix -! 3 = type 1 suffix -! 4 = type 2 prefix -! 5 = type 2 suffix -! 6 = free text (up to 13 characters) -! 7 = short message " Rpt" - - use iso_c_binding, only: c_loc,c_size_t - use packjt - use hashing - character*22 msg0 - character*22 message !Message to be generated - character*22 msgsent !Message as it will be received - character*6 mygrid - integer*4 i4Msg6BitWords(13) !72-bit message as 6-bit words - integer*4 i4tone(144) ! - integer*1, target:: i1Msg8BitBytes(10) !80 bits represented in 10 bytes - integer*1 codeword(128) !Encoded bits before re-ordering - integer*1 msgbits(80) !72-bit message + 8-bit hash - integer*1 bitseq(144) !Tone #s, data and sync (values 0-1) - integer*1 i1hash(4) - integer*1 s8(8) - real*8 pp(12) - real*8 xi(864),xq(864),pi,twopi - data s8/0,1,1,1,0,0,1,0/ - equivalence (ihash,i1hash) - logical first - data first/.true./ - save - - if(first) then - first=.false. - nsym=128 - pi=4.0*atan(1.0) - twopi=8.*atan(1.0) - do i=1,12 - pp(i)=sin((i-1)*pi/12) - enddo - endif - - if(msg0(1:1).eq.'@') then !Generate a fixed tone - read(msg0(2:5),*,end=1,err=1) nfreq !at specified frequency - go to 2 -1 nfreq=1000 -2 i4tone(1)=nfreq - else - message=msg0 - do i=1,22 - if(ichar(message(i:i)).eq.0) then - message(i:)=' ' - exit - endif - enddo - - do i=1,22 !Strip leading blanks - if(message(1:1).ne.' ') exit - message=message(i+1:) - enddo - - if(message(1:1).eq.'<') then - call genmsk40(message,msgsent,ichk,i4tone,itype) - if(itype.lt.0) go to 999 - i4tone(41)=-40 - go to 999 - endif - - call packmsg(message,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes - call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent - - if(ichk.eq.1) go to 999 - i4=0 - ik=0 - im=0 - do i=1,12 - nn=i4Msg6BitWords(i) - do j=1, 6 - ik=ik+1 - i4=i4+i4+iand(1,ishft(nn,j-6)) - i4=iand(i4,255) - if(ik.eq.8) then - im=im+1 - i1Msg8BitBytes(im)=i4 - ik=0 - endif - enddo - enddo - - 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) !Hash code to byte 10 - - mbit=0 - do i=1, 10 - i1=i1Msg8BitBytes(i) - do ibit=1,8 - mbit=mbit+1 - msgbits(mbit)=iand(1,ishft(i1,ibit-8)) - enddo - enddo - - call encode_msk144(msgbits,codeword) - -!Create 144-bit channel vector: -!8-bit sync word + 48 bits + 8-bit sync word + 80 bits - bitseq=0 - bitseq(1:8)=s8 - bitseq(9:56)=codeword(1:48) - bitseq(57:64)=s8 - bitseq(65:144)=codeword(49:128) - bitseq=2*bitseq-1 - - xq(1:6)=bitseq(1)*pp(7:12) !first bit is mapped to 1st half-symbol on q - do i=1,71 - is=(i-1)*12+7 - xq(is:is+11)=bitseq(2*i+1)*pp - enddo - xq(864-5:864)=bitseq(1)*pp(1:6) !last half symbol - do i=1,72 - is=(i-1)*12+1 - xi(is:is+11)=bitseq(2*i)*pp - enddo -! Map I and Q to tones. - i4tone=0 - do i=1,72 - i4tone(2*i-1)=(bitseq(2*i)*bitseq(2*i-1)+1)/2; - i4tone(2*i)=-(bitseq(2*i)*bitseq(mod(2*i,144)+1)-1)/2; - enddo - endif - -! Flip polarity - i4tone=-i4tone+1 - -999 return -end subroutine genmsk144 diff --git a/lib/genmsk_short.f90 b/lib/genmsk_short.f90 deleted file mode 100644 index f1b555f34..000000000 --- a/lib/genmsk_short.f90 +++ /dev/null @@ -1,66 +0,0 @@ -subroutine genmsk_short(msg,msgsent,ichk,itone,itype) - - use hashing - character*22 msg,msgsent - character*3 crpt,rpt(0:7) - logical first - integer itone(35) - integer ig24(0:4096-1) !Codewords for Golay (24,12) code - integer b11(11) - data b11/1,1,1,0,0,0,1,0,0,1,0/ !Barker 11 code - data rpt /'26 ','27 ','28 ','R26','R27','R28','RRR','73 '/ - data first/.true./ - save first,ig24 - - if(first) then - call golay24_table(ig24) !Define the Golay(24,12) codewords - first=.false. - endif - - itype=-1 - msgsent='*** bad message ***' - itone=0 - i1=index(msg,'>') - if(i1.lt.9) go to 900 - call fmtmsg(msg,iz) - crpt=msg(i1+2:i1+5) - do i=0,7 - if(crpt.eq.rpt(i)) go to 10 - enddo - go to 900 - -10 irpt=i !Report index, 0-7 - if(ichk.lt.10000) then - call hash(msg(2:i1-1),i1-2,ihash) - ihash=iand(ihash,511) !9-bit hash for the two callsigns - ig=8*ihash + irpt !12-bit message information - else - ig=ichk-10000 - endif - ncodeword=ig24(ig) - itone(1:11)=b11 !Insert the Barker-11 code - n=2**24 - do i=12,35 !Insert codeword into itone array - n=n/2 - itone(i)=0 - if(iand(ncodeword,n).ne.0) itone(i)=1 - enddo - msgsent=msg - itype=7 - - n=count(itone(1:35).eq.0) - if(mod(n,2).ne.0) stop 'Parity error in genmsk_short.' - -900 return -end subroutine genmsk_short - -subroutine hash_calls(calls,ih9) - - use hashing - character*(*) calls - i1=index(calls,'>') - call hash(calls(2:i1-1),i1-2,ih9) - ih9=iand(ih9,511) !9-bit hash for the two callsigns - - return -end subroutine hash_calls diff --git a/lib/ldpcsim144.f90 b/lib/ldpcsim144.f90 deleted file mode 100644 index 3121ada2c..000000000 --- a/lib/ldpcsim144.f90 +++ /dev/null @@ -1,175 +0,0 @@ -program ldpcsim - -use, intrinsic :: iso_c_binding -use iso_c_binding, only: c_loc,c_size_t -use hashing -use packjt -parameter(NRECENT=10) -character*12 recent_calls(NRECENT) -character*22 msg,msgsent,msgreceived -character*8 arg -integer*1, allocatable :: codeword(:), decoded(:), message(:) -integer*1, target:: i1Msg8BitBytes(10) -integer*1 i1hash(4) -integer*1 msgbits(80) -integer*4 i4Msg6BitWords(13) -integer ihash -integer nerrtot(0:128),nerrdec(0:128) -real*8, allocatable :: lratio(:), rxdata(:), rxavgd(:) -real, allocatable :: yy(:), llr(:) -equivalence(ihash,i1hash) - -do i=1,NRECENT - recent_calls(i)=' ' -enddo -nerrtot=0 -nerrdec=0 - -nargs=iargc() -if(nargs.ne.4) then - print*,'Usage: ldpcsim niter navg #trials s ' - print*,'eg: ldpcsim 10 1 1000 0.75' - return -endif -call getarg(1,arg) -read(arg,*) max_iterations -call getarg(2,arg) -read(arg,*) navg -call getarg(3,arg) -read(arg,*) ntrials -call getarg(4,arg) -read(arg,*) s - -! don't count hash bits as data bits -K=72 -N=128 -rate=real(K)/real(N) - -write(*,*) "rate: ",rate - -write(*,*) "niter= ",max_iterations," navg= ",navg," s= ",s - -allocate ( codeword(N), decoded(K), message(K) ) -allocate ( lratio(N), rxdata(N), rxavgd(N), yy(N), llr(N) ) - -msg="K9AN K1JT EN50" - call packmsg(msg,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes - call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent - write(*,*) "message sent ",msgsent - - i4=0 - ik=0 - im=0 - do i=1,12 - nn=i4Msg6BitWords(i) - do j=1, 6 - ik=ik+1 - i4=i4+i4+iand(1,ishft(nn,j-6)) - i4=iand(i4,255) - if(ik.eq.8) then - im=im+1 -! if(i4.gt.127) i4=i4-256 - i1Msg8BitBytes(im)=i4 - ik=0 - endif - enddo - enddo - - 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) !Hash code to byte 10 - mbit=0 - do i=1, 10 - i1=i1Msg8BitBytes(i) - do ibit=1,8 - mbit=mbit+1 - msgbits(mbit)=iand(1,ishft(i1,ibit-8)) - enddo - enddo - call encode_msk144(msgbits,codeword) - call init_random_seed() - -write(*,*) "Eb/N0 SNR2500 ngood nundetected nbadhash sigma" -do idb = 14,-6,-1 - db=idb/2.0-1.0 - sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) - ngood=0 - nue=0 - nbadhash=0 - - do itrial=1, ntrials - rxavgd=0d0 - do iav=1,navg - call sgran() -! Create a realization of a noisy received word - do i=1,N - rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran() - enddo - rxavgd=rxavgd+rxdata - enddo - rxdata=rxavgd - nerr=0 - do i=1,N - if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1 - enddo - nerrtot(nerr)=nerrtot(nerr)+1 - -! 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 -! 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 -! magnitude in UER - if( s .lt. 0 ) then - ss=sigma - else - ss=s - endif - - llr=2.0*rxdata/(ss*ss) - lratio=exp(llr) - yy=rxdata - -! max_iterations is max number of belief propagation iterations -! call ldpc_decode(lratio, decoded, max_iterations, niterations, max_dither, ndither) -! call amsdecode(yy, max_iterations, decoded, niterations) -! call bitflipmsk144(rxdata, decoded, niterations) - call bpdecode144(llr, max_iterations, decoded, niterations) - -! If the decoder finds a valid codeword, niterations will be .ge. 0. - if( niterations .ge. 0 ) then - call extractmessage144(decoded,msgreceived,nhashflag,recent_calls,nrecent) - if( nhashflag .ne. 1 ) then - nbadhash=nbadhash+1 - endif - nueflag=0 - -! Check the message plus hash against what was sent. - do i=1,K - if( msgbits(i) .ne. decoded(i) ) then - nueflag=1 - endif - enddo - if( nhashflag .eq. 1 .and. nueflag .eq. 0 ) then - ngood=ngood+1 - nerrdec(nerr)=nerrdec(nerr)+1 - else if( nhashflag .eq. 1 .and. nueflag .eq. 1 ) then - nue=nue+1; - endif - endif - enddo - snr2500=db-3.5 - write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2)") db,snr2500,ngood,nue,nbadhash,ss - -enddo - -open(unit=23,file='nerrhisto.dat',status='unknown') -do i=0,128 - write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10) -enddo -close(23) - -end program ldpcsim diff --git a/lib/msk144d.f90 b/lib/msk144d.f90 deleted file mode 100644 index 60c8b0c1d..000000000 --- a/lib/msk144d.f90 +++ /dev/null @@ -1,136 +0,0 @@ -program msk144d - - ! Test the msk144 decoder for WSJT-X - - use options - use timer_module, only: timer - use timer_impl, only: init_timer - use readwav - - character c - character*80 line - character*512 datadir - character*500 infile - character*12 mycall,hiscall - character*6 mygrid - character(len=500) optarg - - logical :: display_help=.false. - logical*1 bShMsgs - logical*1 btrain - logical*1 bswl - - type(wav_header) :: wav - - integer*2 id2(30*12000) - integer*2 ichunk(7*1024) - - real*8 pcoeffs(5) - - type (option) :: long_options(9) = [ & - option ('ndepth',.true.,'c','ndepth',''), & - option ('dxcall',.true.,'d','hiscall',''), & - option ('evemode',.true.,'e','Must be used with -s.',''), & - option ('frequency',.true.,'f','rxfreq',''), & - option ('help',.false.,'h','Display this help message',''), & - option ('mycall',.true.,'m','mycall',''), & - option ('nftol',.true.,'n','nftol',''), & - option ('rxequalize',.false.,'r','Rx Equalize',''), & - option ('short',.false.,'s','enable Sh','') & - ] - t0=0.0 - ndepth=3 - ntol=100 - nrxfreq=1500 - mycall='' - mygrid='EN50WC' - hiscall='' - bShMsgs=.false. - btrain=.false. - bswl=.false. - datadir='.' - pcoeffs=0.d0 - - do - call getopt('c:d:ef:hm:n:rs',long_options,c,optarg,narglen,nstat,noffset,nremain,.true.) - if( nstat .ne. 0 ) then - exit - end if - select case (c) - case ('c') - read (optarg(:narglen), *) ndepth - case ('d') - read (optarg(:narglen), *) hiscall - case ('e') - bswl=.true. - case ('f') - read (optarg(:narglen), *) nrxfreq - case ('h') - display_help = .true. - case ('m') - read (optarg(:narglen), *) mycall - case ('n') - read (optarg(:narglen), *) ntol - case ('r') - btrain=.true. - case ('s') - bShMsgs=.true. - end select - end do - - if(display_help .or. nstat.lt.0 .or. nremain.lt.1) then - print *, '' - print *, 'Usage: msk144d [OPTIONS] file1 [file2 ...]' - print *, '' - print *, ' msk144 decode pre-recorded .WAV file(s)' - print *, '' - print *, 'OPTIONS:' - do i = 1, size (long_options) - call long_options(i) % print (6) - end do - go to 999 - endif - - call init_timer ('timer.out') - call timer('msk144 ',0) - ndecoded=0 - do ifile=noffset+1,noffset+nremain - call get_command_argument(ifile,optarg,narglen) - infile=optarg(:narglen) - call timer('read ',0) - call wav%read (infile) - i1=index(infile,'.wav') - if( i1 .eq. 0 ) i1=index(infile,'.WAV') - read(infile(i1-6:i1-1),*,err=998) nutc - inquire(FILE=infile,SIZE=isize) - npts=min((isize-216)/2,360000) - read(unit=wav%lun) id2(1:npts) - close(unit=wav%lun) - call timer('read ',1) - - do i=1,npts-7*1024+1,7*512 - ichunk=id2(i:i+7*1024-1) - tsec=(i-1)/12000.0 - tt=sum(float(abs(id2(i:i+7*512-1)))) - if( tt .ne. 0.0 ) then - call mskrtd(ichunk,nutc,tsec,ntol,nrxfreq,ndepth,mycall,mygrid,hiscall,bShMsgs, & - btrain,pcoeffs,bswl,datadir,line) - if( index(line,"&") .ne. 0 .or. & - index(line,"^") .ne. 0 .or. & - index(line,"!") .ne. 0 .or. & - index(line,"@") .ne. 0 ) then - write(*,*) line - endif - endif - enddo - enddo - - call timer('msk144 ',1) - call timer('msk144 ',101) - go to 999 - -998 print*,'Cannot read from file:' - print*,infile - -999 continue -end program msk144d diff --git a/lib/msk144sd.f90 b/lib/msk144sd.f90 deleted file mode 100644 index 267fff545..000000000 --- a/lib/msk144sd.f90 +++ /dev/null @@ -1,197 +0,0 @@ -program msk144sd -! -! A simple decoder for slow msk144. -! Can be used as a (slow) brute-force multi-decoder by looping -! over a set of carrier frequencies. -! - use options - use timer_module, only: timer - use timer_impl, only: init_timer - use readwav - - parameter (NRECENT=10) - parameter (NSPM=864) - parameter (NPATTERNS=4) - - character ch - character*80 line - character*500 infile - character*12 mycall,hiscall - character*6 mygrid - character(len=500) optarg - character*22 msgreceived - character*12 recent_calls(NRECENT) - - complex cdat(30*375) - complex c(NSPM) - complex ct(NSPM) - - real softbits(144) - real xmc(NPATTERNS) - - logical :: display_help=.false. - - type(wav_header) :: wav - - integer iavmask(8) - integer iavpatterns(8,NPATTERNS) - integer npkloc(10) - - integer*2 id2(30*12000) - integer*2 ichunk(7*1024) - - data iavpatterns/ & - 1,1,1,1,0,0,0,0, & - 0,1,1,1,1,0,0,0, & - 0,0,1,1,1,1,0,0, & - 1,1,1,1,1,1,0,0/ - data xmc/2.0,4.5,2.5,3.0/ - - type (option) :: long_options(2) = [ & - option ('frequency',.true.,'f','rxfreq',''), & - option ('help',.false.,'h','Display this help message','') & - ] - t0=0.0 - ntol=100 - nrxfreq=1500 - - do - call getopt('f:h',long_options,ch,optarg,narglen,nstat,noffset,nremain,.true.) - if( nstat .ne. 0 ) then - exit - end if - select case (ch) - case ('f') - read (optarg(:narglen), *) nrxfreq - case ('h') - display_help = .true. - end select - end do - - if(display_help .or. nstat.lt.0 .or. nremain.lt.1) then - print *, '' - print *, 'Usage: msk144sd [OPTIONS] file1 [file2 ...]' - print *, '' - print *, ' decode pre-recorded .WAV file(s)' - print *, '' - print *, 'OPTIONS:' - do i = 1, size (long_options) - call long_options(i) % print (6) - end do - go to 999 - endif - - call init_timer ('timer.out') - call timer('msk144 ',0) - ndecoded=0 - do ifile=noffset+1,noffset+nremain - call get_command_argument(ifile,optarg,narglen) - infile=optarg(:narglen) - call timer('read ',0) - call wav%read (infile) - i1=index(infile,'.wav') - if( i1 .eq. 0 ) i1=index(infile,'.WAV') - read(infile(i1-6:i1-1),*,err=998) nutc - inquire(FILE=infile,SIZE=isize) - npts=min((isize-216)/2,360000) - read(unit=wav%lun) id2(1:npts) - close(unit=wav%lun) - call timer('read ',1) - -! do if=1,89 ! brute force multi-decoder - fo=nrxfreq -! fo=(if-1)*25.0+300.0 - call msksddc(id2,npts,fo,cdat) - np=npts/32 - ntol=200 ! actual ntol is ntol/32=6.25 Hz. Detection window is 12.5 Hz wide - fc=1500.0 - call msk144spd(cdat,np,ntol,ndecodesuccess,msgreceived,fc,fest,tdec,navg,ct, & - softbits,recent_calls,nrecent) - nsnr=0 ! need an snr estimate - if( ndecodesuccess .eq. 1 ) then - fest=fo+fest-fc ! fudging because spd thinks input signal is at 1500 Hz - goto 900 - endif -! If short ping decoder doesn't find a decode - npat=NPATTERNS - do iavg=1,npat - iavmask=iavpatterns(1:8,iavg) - navg=sum(iavmask) - deltaf=4.0/real(navg) ! search increment for frequency sync - npeaks=4 - ntol=200 - fc=1500.0 - call msk144sync(cdat(1:6*NSPM),6,ntol,deltaf,iavmask,npeaks,fc, & - fest,npkloc,nsyncsuccess,xmax,c) - if( nsyncsuccess .eq. 0 ) cycle - - do ipk=1,npeaks - do is=1,3 - ic0=npkloc(ipk) - if(is.eq.2) ic0=max(1,ic0-1) - if(is.eq.3) ic0=min(NSPM,ic0+1) - ct=cshift(c,ic0-1) - call msk144decodeframe(ct,softbits,msgreceived,ndecodesuccess, & - recent_calls,nrecent) - if(ndecodesuccess .gt. 0) then - tdec=tsec+xmc(iavg)*tframe - fest=fo+(fest-fc)/32.0 - goto 900 - endif - enddo !Slicer dither - enddo !Peak loop - enddo - -! enddo -900 continue - if( ndecodesuccess .gt. 0 ) then - write(*,1020) nutc,nsnr,tdec,nint(fest),' % ',msgreceived,navg -1020 format(i6.6,i4,f5.1,i5,a3,a22,i4) - endif - enddo - - call timer('msk144 ',1) - call timer('msk144 ',101) - go to 999 - -998 print*,'Cannot read from file:' - print*,infile - -999 continue -end program msk144sd - -subroutine msksddc(id2,npts,fc,cdat) - -! The msk144 detector/demodulator/decoder will decode signals -! with carrier frequency, fc, in the range fN/4 +/- 0.03333*fN. -! -! For slow MSK144 with nslow=32: -! fs=12000/32=375 Hz, fN=187.5 Hz -! -! This routine accepts input samples with fs=12000 Hz. It -! downconverts and decimates by 32 to center a signal with input carrier -! frequency fc at new carrier frequency 1500/32=46.875 Hz. -! The analytic signal is returned. - - parameter (NFFT1=30*12000,NFFT2=30*375) - integer*2 id2(npts) - complex cx(0:NFFT1) - complex cdat(30*375) - - dt=1.0/12000.0 - df=1.0/(NFFT1*dt) - icenter=int(fc/df+0.5) - i46p875=int(46.875/df+0.5) - ishift=icenter-i46p875 - cx=cmplx(0.0,0.0) - cx(1:npts)=id2 - call four2a(cx,NFFT1,1,-1,1) - cx=cshift(cx,ishift) - cx(1)=0.5*cx(1) - cx(2*i46p875+1:)=cmplx(0.0,0.0) - call four2a(cx,NFFT2,1,1,1) - cdat(1:npts/32)=cx(0:npts/32-1)/NFFT1 - return - -end subroutine msksddc - diff --git a/lib/msk144sim.f90 b/lib/msk144sim.f90 index 75c6a1e64..7b2a8a00b 100644 --- a/lib/msk144sim.f90 +++ b/lib/msk144sim.f90 @@ -13,10 +13,10 @@ program msk144sim integer itone(144) !Message bits nargs=iargc() - if(nargs.ne.6) then - print*,'Usage: msk144sim message freq width nslow snr nfiles' - print*,'Example: msk144sim "K1ABC W9XYZ EN37" 1500 0.12 1 2 1' - print*,' msk144sim "K1ABC W9XYZ EN37" 1500 2.5 32 15 1' + if(nargs.ne.5) then + print*,'Usage: msk144sim message freq width snr nfiles' + print*,'Example: msk144sim "K1ABC W9XYZ EN37" 1500 0.12 2 1' + print*,' msk144sim "K1ABC W9XYZ EN37" 1500 2.5 15 1' go to 999 endif call getarg(1,msg) @@ -25,10 +25,8 @@ program msk144sim call getarg(3,arg) read(arg,*) width call getarg(4,arg) - read(arg,*) nslow - call getarg(5,arg) read(arg,*) snrdb - call getarg(6,arg) + call getarg(5,arg) read(arg,*) nfiles !sig is the peak amplitude of the ping. @@ -50,9 +48,9 @@ program msk144sim twopi=8.d0*atan(1.d0) nsym=144 - nsps=6*nslow + nsps=6 if( itone(41) .lt. 0 ) nsym=40 - baud=2000.d0/nslow + baud=2000.d0 dphi0=twopi*(freq-0.25d0*baud)/12000.d0 dphi1=twopi*(freq+0.25d0*baud)/12000.d0 phi=0.0 @@ -79,7 +77,7 @@ program msk144sim go to 999 endif - if(nslow.eq.1) call makepings(pings,NMAX,width,sig) + call makepings(pings,NMAX,width,sig) ! call sgran() do ifile=1,nfiles !Loop over requested number of files @@ -92,8 +90,7 @@ program msk144sim fac=sqrt(6000.0/2500.0) do i=0,NMAX-1 xx=gran() - if(nslow.eq.1) wave(i)=pings(i)*waveform(i) + fac*xx - if(nslow.gt.1) wave(i)=sig*waveform(i) + fac*xx + wave(i)=pings(i)*waveform(i) + fac*xx iwave(i)=30.0*wave(i) enddo diff --git a/lib/platanh.f90 b/lib/platanh.f90 new file mode 100644 index 000000000..e610366d7 --- /dev/null +++ b/lib/platanh.f90 @@ -0,0 +1,24 @@ +subroutine platanh(x,y) + isign=+1 + z=x + if( x.lt.0 ) then + isign=-1 + z=abs(x) + endif + if( z.le. 0.664 ) then + y=x/0.83 + return + elseif( z.le. 0.9217 ) then + y=isign*(z-0.4064)/0.322 + return + elseif( z.le. 0.9951 ) then + y=isign*(z-0.8378)/0.0524 + return + elseif( z.le. 0.9998 ) then + y=isign*(z-0.9914)/0.0012 + return + else + y=isign*7.0 + return + endif +end subroutine platanh diff --git a/lib/pltanh.f90 b/lib/pltanh.f90 new file mode 100644 index 000000000..4c6c2b6d6 --- /dev/null +++ b/lib/pltanh.f90 @@ -0,0 +1,24 @@ +subroutine pltanh(x,y) + isign=+1 + z=x + if( x.lt.0 ) then + isign=-1 + z=abs(x) + endif + if( z.le. 0.8 ) then + y=0.83*x + return + elseif( z.le. 1.6 ) then + y=isign*(0.322*z+0.4064) + return + elseif( z.le. 3.0 ) then + y=isign*(0.0524*z+0.8378) + return + elseif( z.lt. 7.0 ) then + y=isign*(0.0012*z+0.9914) + return + else + y=isign*0.9998 + return + endif +end subroutine pltanh diff --git a/lib/unpackmsg144.f90 b/lib/unpackmsg144.f90 deleted file mode 100644 index 96423ff69..000000000 --- a/lib/unpackmsg144.f90 +++ /dev/null @@ -1,117 +0,0 @@ - subroutine unpackmsg144(dat,msg,c1,c2) -! special unpackmsg for MSK144 - returns call1 and call2 to enable -! maintenance of a recent-calls-heard list - - use packjt - parameter (NBASE=37*36*10*27*27*27) - parameter (NGBASE=180*180) - integer dat(12) - character c1*12,c2*12,grid*4,msg*22,grid6*6,psfx*4,junk2*4 - logical cqnnn - - cqnnn=.false. - nc1=ishft(dat(1),22) + ishft(dat(2),16) + ishft(dat(3),10)+ & - ishft(dat(4),4) + iand(ishft(dat(5),-2),15) - - nc2=ishft(iand(dat(5),3),26) + ishft(dat(6),20) + & - ishft(dat(7),14) + ishft(dat(8),8) + ishft(dat(9),2) + & - iand(ishft(dat(10),-4),3) - - ng=ishft(iand(dat(10),15),12) + ishft(dat(11),6) + dat(12) - - if(ng.ge.32768) then - call unpacktext(nc1,nc2,ng,msg) - c1(1:12)=' ' - c2(1:12)=' ' - go to 100 - endif - - call unpackcall(nc1,c1,iv2,psfx) - if(iv2.eq.0) then - ! This is an "original JT65" message - if(nc1.eq.NBASE+1) c1='CQ ' - if(nc1.eq.NBASE+2) c1='QRZ ' - nfreq=nc1-NBASE-3 - if(nfreq.ge.0 .and. nfreq.le.999) then - write(c1,1002) nfreq - 1002 format('CQ ',i3.3) - cqnnn=.true. - endif - endif - - call unpackcall(nc2,c2,junk1,junk2) - call unpackgrid(ng,grid) - - if(iv2.gt.0) then - ! This is a JT65v2 message - do i=1,4 - if(ichar(psfx(i:i)).eq.0) psfx(i:i)=' ' - enddo - - n1=len_trim(psfx) - n2=len_trim(c2) - if(iv2.eq.1) msg='CQ '//psfx(:n1)//'/'//c2(:n2)//' '//grid - if(iv2.eq.2) msg='QRZ '//psfx(:n1)//'/'//c2(:n2)//' '//grid - if(iv2.eq.3) msg='DE '//psfx(:n1)//'/'//c2(:n2)//' '//grid - if(iv2.eq.4) msg='CQ '//c2(:n2)//'/'//psfx(:n1)//' '//grid - if(iv2.eq.5) msg='QRZ '//c2(:n2)//'/'//psfx(:n1)//' '//grid - if(iv2.eq.6) msg='DE '//c2(:n2)//'/'//psfx(:n1)//' '//grid - if(iv2.eq.7) msg='DE '//c2(:n2)//' '//grid - if(iv2.eq.8) msg=' ' - go to 100 - else - - endif - - grid6=grid//'ma' - call grid2k(grid6,k) - if(k.ge.1 .and. k.le.450) call getpfx2(k,c1) - if(k.ge.451 .and. k.le.900) call getpfx2(k,c2) - - i=index(c1,char(0)) - if(i.ge.3) c1=c1(1:i-1)//' ' - i=index(c2,char(0)) - if(i.ge.3) c2=c2(1:i-1)//' ' - - msg=' ' - j=0 - if(cqnnn) then - msg=c1//' ' - j=7 !### ??? ### - go to 10 - endif - - do i=1,12 - j=j+1 - msg(j:j)=c1(i:i) - if(c1(i:i).eq.' ') go to 10 - enddo - j=j+1 - msg(j:j)=' ' - - 10 do i=1,12 - if(j.le.21) j=j+1 - msg(j:j)=c2(i:i) - if(c2(i:i).eq.' ') go to 20 - enddo - if(j.le.21) j=j+1 - msg(j:j)=' ' - - 20 if(k.eq.0) then - do i=1,4 - if(j.le.21) j=j+1 - msg(j:j)=grid(i:i) - enddo - if(j.le.21) j=j+1 - msg(j:j)=' ' - endif - - 100 continue - if(msg(1:6).eq.'CQ9DX ') msg(3:3)=' ' - if(msg(1:2).eq.'E9' .and. & - msg(3:3).ge.'A' .and. msg(3:3).le.'Z' .and. & - msg(4:4).ge.'A' .and. msg(4:4).le.'Z' .and. & - msg(5:5).eq.' ') msg='CQ '//msg(3:) - - return - end subroutine unpackmsg144