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 2018-11-23 23:37:56 +00:00
commit 155a56364a
14 changed files with 61 additions and 1097 deletions

View File

@ -383,7 +383,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
@ -415,7 +414,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
@ -423,7 +421,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
@ -498,10 +495,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
@ -520,6 +515,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
@ -562,7 +559,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
@ -1253,14 +1249,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

View File

@ -36,5 +36,7 @@
<string>NSApplication</string>
<key>NSHighResolutionCapable</key>
<string>True</string>
<key>NSRequiresAquaSystemAppearance</key>
<true/>
</dict>
</plist>

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

24
lib/platanh.f90 Normal file
View 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
View 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

View File

@ -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