mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-11-22 04:11:16 -05:00
Remove obsolete routines related to msk144.
This commit is contained in:
Steve Franke
parent
6f966f613d
commit
e434bc5b55
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
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
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