mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-11-25 21:58:38 -05:00
Merge branch 'hotfix-2.0.0-rc5' of bitbucket.org:k1jt/wsjtx into hotfix-2.0.0-rc5
This commit is contained in:
Bill Somerville
commit
155a56364a
@ -383,7 +383,6 @@ set (wsjt_FSRCS
|
|||||||
lib/badmsg.f90
|
lib/badmsg.f90
|
||||||
lib/ft8/baseline.f90
|
lib/ft8/baseline.f90
|
||||||
lib/bpdecode40.f90
|
lib/bpdecode40.f90
|
||||||
lib/bpdecode144.f90
|
|
||||||
lib/bpdecode128_90.f90
|
lib/bpdecode128_90.f90
|
||||||
lib/ft8/bpdecode174.f90
|
lib/ft8/bpdecode174.f90
|
||||||
lib/ft8/bpdecode174_91.f90
|
lib/ft8/bpdecode174_91.f90
|
||||||
@ -415,7 +414,6 @@ set (wsjt_FSRCS
|
|||||||
lib/encode232.f90
|
lib/encode232.f90
|
||||||
lib/encode4.f90
|
lib/encode4.f90
|
||||||
lib/encode_msk40.f90
|
lib/encode_msk40.f90
|
||||||
lib/encode_msk144.f90
|
|
||||||
lib/encode_128_90.f90
|
lib/encode_128_90.f90
|
||||||
lib/ft8/encode174.f90
|
lib/ft8/encode174.f90
|
||||||
lib/ft8/encode174_91.f90
|
lib/ft8/encode174_91.f90
|
||||||
@ -423,7 +421,6 @@ set (wsjt_FSRCS
|
|||||||
lib/ephem.f90
|
lib/ephem.f90
|
||||||
lib/extract.f90
|
lib/extract.f90
|
||||||
lib/extract4.f90
|
lib/extract4.f90
|
||||||
lib/extractmessage144.f90
|
|
||||||
lib/extractmessage77.f90
|
lib/extractmessage77.f90
|
||||||
lib/ft8/extractmessage174.f90
|
lib/ft8/extractmessage174.f90
|
||||||
lib/ft8/extractmessage174_91.f90
|
lib/ft8/extractmessage174_91.f90
|
||||||
@ -498,10 +495,8 @@ set (wsjt_FSRCS
|
|||||||
lib/moondopjpl.f90
|
lib/moondopjpl.f90
|
||||||
lib/morse.f90
|
lib/morse.f90
|
||||||
lib/move.f90
|
lib/move.f90
|
||||||
lib/msk144d.f90
|
|
||||||
lib/msk40decodeframe.f90
|
lib/msk40decodeframe.f90
|
||||||
lib/msk144decodeframe.f90
|
lib/msk144decodeframe.f90
|
||||||
lib/msk144sd.f90
|
|
||||||
lib/msk40spd.f90
|
lib/msk40spd.f90
|
||||||
lib/msk144spd.f90
|
lib/msk144spd.f90
|
||||||
lib/msk40sync.f90
|
lib/msk40sync.f90
|
||||||
@ -520,6 +515,8 @@ set (wsjt_FSRCS
|
|||||||
lib/peakdt9.f90
|
lib/peakdt9.f90
|
||||||
lib/peakup.f90
|
lib/peakup.f90
|
||||||
lib/plotsave.f90
|
lib/plotsave.f90
|
||||||
|
lib/platanh.f90
|
||||||
|
lib/pltanh.f90
|
||||||
lib/polyfit.f90
|
lib/polyfit.f90
|
||||||
lib/prog_args.f90
|
lib/prog_args.f90
|
||||||
lib/ps4.f90
|
lib/ps4.f90
|
||||||
@ -562,7 +559,6 @@ set (wsjt_FSRCS
|
|||||||
lib/twkfreq.f90
|
lib/twkfreq.f90
|
||||||
lib/ft8/twkfreq1.f90
|
lib/ft8/twkfreq1.f90
|
||||||
lib/twkfreq65.f90
|
lib/twkfreq65.f90
|
||||||
lib/unpackmsg144.f90
|
|
||||||
lib/update_recent_calls.f90
|
lib/update_recent_calls.f90
|
||||||
lib/update_hasharray.f90
|
lib/update_hasharray.f90
|
||||||
lib/ft8/watterson.f90
|
lib/ft8/watterson.f90
|
||||||
@ -1253,14 +1249,9 @@ target_link_libraries (ft8code wsjt_fort wsjt_cxx)
|
|||||||
add_executable (ft8sim lib/ft8/ft8sim.f90 wsjtx.rc)
|
add_executable (ft8sim lib/ft8/ft8sim.f90 wsjtx.rc)
|
||||||
target_link_libraries (ft8sim wsjt_fort wsjt_cxx)
|
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)
|
add_executable (msk144sim lib/msk144sim.f90 wsjtx.rc)
|
||||||
target_link_libraries (msk144sim wsjt_fort wsjt_cxx)
|
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)
|
endif(WSJT_BUILD_UTILS)
|
||||||
|
|
||||||
# build the main application
|
# build the main application
|
||||||
|
|||||||
@ -36,5 +36,7 @@
|
|||||||
<string>NSApplication</string>
|
<string>NSApplication</string>
|
||||||
<key>NSHighResolutionCapable</key>
|
<key>NSHighResolutionCapable</key>
|
||||||
<string>True</string>
|
<string>True</string>
|
||||||
|
<key>NSRequiresAquaSystemAppearance</key>
|
||||||
|
<true/>
|
||||||
</dict>
|
</dict>
|
||||||
</plist>
|
</plist>
|
||||||
|
|||||||
@ -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
|
|
||||||
@ -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
|
|
||||||
@ -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
|
|
||||||
@ -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 "<Call_1 Call2> 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
|
|
||||||
@ -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
|
|
||||||
@ -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
|
|
||||||
136
lib/msk144d.f90
136
lib/msk144d.f90
@ -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
|
|
||||||
197
lib/msk144sd.f90
197
lib/msk144sd.f90
@ -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
|
|
||||||
|
|
||||||
@ -13,10 +13,10 @@ program msk144sim
|
|||||||
integer itone(144) !Message bits
|
integer itone(144) !Message bits
|
||||||
|
|
||||||
nargs=iargc()
|
nargs=iargc()
|
||||||
if(nargs.ne.6) then
|
if(nargs.ne.5) then
|
||||||
print*,'Usage: msk144sim message freq width nslow snr nfiles'
|
print*,'Usage: msk144sim message freq width snr nfiles'
|
||||||
print*,'Example: msk144sim "K1ABC W9XYZ EN37" 1500 0.12 1 2 1'
|
print*,'Example: msk144sim "K1ABC W9XYZ EN37" 1500 0.12 2 1'
|
||||||
print*,' msk144sim "K1ABC W9XYZ EN37" 1500 2.5 32 15 1'
|
print*,' msk144sim "K1ABC W9XYZ EN37" 1500 2.5 15 1'
|
||||||
go to 999
|
go to 999
|
||||||
endif
|
endif
|
||||||
call getarg(1,msg)
|
call getarg(1,msg)
|
||||||
@ -25,10 +25,8 @@ program msk144sim
|
|||||||
call getarg(3,arg)
|
call getarg(3,arg)
|
||||||
read(arg,*) width
|
read(arg,*) width
|
||||||
call getarg(4,arg)
|
call getarg(4,arg)
|
||||||
read(arg,*) nslow
|
|
||||||
call getarg(5,arg)
|
|
||||||
read(arg,*) snrdb
|
read(arg,*) snrdb
|
||||||
call getarg(6,arg)
|
call getarg(5,arg)
|
||||||
read(arg,*) nfiles
|
read(arg,*) nfiles
|
||||||
|
|
||||||
!sig is the peak amplitude of the ping.
|
!sig is the peak amplitude of the ping.
|
||||||
@ -50,9 +48,9 @@ program msk144sim
|
|||||||
|
|
||||||
twopi=8.d0*atan(1.d0)
|
twopi=8.d0*atan(1.d0)
|
||||||
nsym=144
|
nsym=144
|
||||||
nsps=6*nslow
|
nsps=6
|
||||||
if( itone(41) .lt. 0 ) nsym=40
|
if( itone(41) .lt. 0 ) nsym=40
|
||||||
baud=2000.d0/nslow
|
baud=2000.d0
|
||||||
dphi0=twopi*(freq-0.25d0*baud)/12000.d0
|
dphi0=twopi*(freq-0.25d0*baud)/12000.d0
|
||||||
dphi1=twopi*(freq+0.25d0*baud)/12000.d0
|
dphi1=twopi*(freq+0.25d0*baud)/12000.d0
|
||||||
phi=0.0
|
phi=0.0
|
||||||
@ -79,7 +77,7 @@ program msk144sim
|
|||||||
go to 999
|
go to 999
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if(nslow.eq.1) call makepings(pings,NMAX,width,sig)
|
call makepings(pings,NMAX,width,sig)
|
||||||
|
|
||||||
! call sgran()
|
! call sgran()
|
||||||
do ifile=1,nfiles !Loop over requested number of files
|
do ifile=1,nfiles !Loop over requested number of files
|
||||||
@ -92,8 +90,7 @@ program msk144sim
|
|||||||
fac=sqrt(6000.0/2500.0)
|
fac=sqrt(6000.0/2500.0)
|
||||||
do i=0,NMAX-1
|
do i=0,NMAX-1
|
||||||
xx=gran()
|
xx=gran()
|
||||||
if(nslow.eq.1) wave(i)=pings(i)*waveform(i) + fac*xx
|
wave(i)=pings(i)*waveform(i) + fac*xx
|
||||||
if(nslow.gt.1) wave(i)=sig*waveform(i) + fac*xx
|
|
||||||
iwave(i)=30.0*wave(i)
|
iwave(i)=30.0*wave(i)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
|||||||
24
lib/platanh.f90
Normal file
24
lib/platanh.f90
Normal file
@ -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
|
||||||
24
lib/pltanh.f90
Normal file
24
lib/pltanh.f90
Normal file
@ -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
|
||||||
@ -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
|
|
||||||
Loading…
Reference in New Issue
Block a user