w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2026-07-26 03:54:32 -04:00
Code Issues Packages Projects Releases Wiki Activity

Reintegrate merge from wsjtx_exp branch.

Browse Source 
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6122 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Bill Somerville
2015-11-18 01:28:12 +00:00
parent 1be194efdd
commit 1a23757b26
148 changed files with 10084 additions and 1574 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lib/CQnnnCAT.txt
+39
View File
@@ -0,0 +1,39 @@
Before using the new "CQ nnn ..." feature in JTMSK mode, I suggest
performing the following tests of the necessary CAT control for your
radio. (I'm assuming that you already have some experience with
JTMSK.)
TEST 1:
--------------------------------------------------------------------------
1. Start WSJT-X
2. Settings: "Enable VHF/UHF/Microwave features, "Rx frequency offset
with 'CQ nnn ...'", Split=Rig, or Split="Fake it"
3. Main screen settings: Band=50.280, mode=JTMSK, T/R=15 s
4. Activate CQRx, set CQ Rx=265
==> Rx dial should now read 50.265 and Tx6 should be queued
5. Click "Enable Tx"
==> Tx sequences should occur at 50.280, Rx at 50.265
With most rigs, this test should work with Split configured as either
"Rig" or "Fake it".
TEST 2:
--------------------------------------------------------------------------
1. Start WSJT-X
2. Settings: MyCall=K1JT, "Enable VHF/UHF/Microwave features,
"Rx frequency offset with 'CQ nnn ...'", Split=Rig or "Fake it"
4. Main screen settings: Band=50.280, mode=JTMSK, T/R=15 s
5. Open file 150826_120515.wav
==> see decoded message "K1JT VE1SKY FN74"
6. Click "Monitor" to restart monitoring
7. Activate CQRx, set CQ Rx=265
==> Rx dial should now read 50.265; Tx6 should be queued
8. Click "Enable Tx"
==> Tx sequences should occur at 50.280, Rx at 50.265
9. After the start of a transmission, double-click on the decoded message
"K1JT VE1SKY FN74"
==> Tx2 should be generated and queued; transmission will pause
briefly, Tx freq changed to 50.265, then Tx resumed.
The test file is posted at
http://physics.princeton.edu/pulsar/K1JT/150826_120515.wav
lib/Fast_Modes.txt
+395
View File
@@ -0,0 +1,395 @@
Fast Modes in WSJT-X
--------------------
#######################################################################
IMPORTANT - IMPORTANT - IMPORTANT - IMPORTANT - IMPORTANT - IMPORTANT
Third-party individuals (i.e., others not part of the WSJT development
team) have been compiling WSJT-X from the open source code and making
unauthorized "releases" of their builds. I do NOT reccommend use of
unauthorized builds on the air. If a program revision has been released
in an official way, you will see it listed here.
If you operate with an unauthorized "rXXXX" code revisions in our
experimental code branch you have no idea what you've got. Quite
possibly, the program was built from an intermediate temporary "save"
of various files, and was not even supposed to produce a usable
program. Your observetions about what works or does not work are then
worse than useless -- they waste your time and ours.
So please, PLEASE, *PLEASE*: use *authorized*, "released* revisions
of this still-in-development software, like the revisions described here.
*ALSO:* If you choose to try an experimental release of JTMSK, please
accept the responsibility of reporting on your results. You can send
reports to the "wsjtgroup" reflector, wsjtgroup@yahoogroups.com, or
email them directly to me. All suggestions for improvements are
welcome!
Bug reports should include details on how to reproduce the undesirable
program behavior. Reports on decoding performance are especially
useful when accompanied by example *.wav files with signals that
you think should have decoded, but did not.
#######################################################################
September 18, 2015
-----------------
New alpha release of experimental WSJT-X v1.6.1, r5910
------------------------------------------------------
Changes since revision 5889 include the following:
1. Improved behavior for auto-QSY with "CQ nnn ..." feature. (May not
be exactly correct, yet, for all radios. Please report if you find
problems with your rig.)
2. Allow optional use of Wide Graph in fast modes.
3. Add UTC labels to Fast Graph spectrograms.
4. Display correct DXCC entiry for "CQ nnn ..." messages.
5. Implement "Save Decoded" for fast modes.
6. Select Tx6 when "CQ Rx nnn" is enabled.
7. Fix bug in setting of TRperiod after switch to ISCAT mode.
8. Display proper symbol '&' in Tx messages in JTMSK mode.
To download this alpha release for Windows, paste the following link
into your browser:
http://physics.princeton.edu/pulsar/K1JT/wsjtx-1.6.1-r5910-win32.exe
-- 73, Joe, K1JT
#######################################################################
September 12, 2015
-----------------
New alpha release of experimental WSJT-X v1.6.1, r5889
------------------------------------------------------
A principal new feature in this release is designed to promote the use
of an agreed "calling frequency" for transmissions of the form
CQ 265 K1ABC FN42
signifying that K1ABC will listen for replies on 50.265 (or 144.265,
or whatever) and will complete the QSO there. The feature uses the
rig-control features of WSJT-X to handle the necessary frequency
switching.
##########################################################################
Changes since revision 5865 include the following:
1. New features that allow automatic rig control when you transmit or
respond to messages of the form "CQ 265 K1ABC FN42" on an agreed
calling frequency. This feature should be especially useful for
meteor scatter.
2. Yellow-highlighted "Tx" messages in the right text window are now
properly labeled with 6-digit UTC (hhmmss) in all fast modes.
3. Fixed a bug (introduced in r5865) that inhibited transmitting in
JT4 mode.
4. Fixed a bug that caused Wide Graph to continue issuing green
separator lines at short (e.g. 15 s) intervals after you have switched
to a slow mode.
5. Fixed several more GUI appearance bugs associated with changing
modes or submodes.
6. Fixed a bug in which double-clicking on the Fast Graph could cause
program crashes.
7. Fixed a bug that sometimes caused "high tones" to be emitted in
JTMSK mode.
#######################################################################
Here's a brief description of how to use the "CQ nnn ..." features.
1. On program startup, go to the Settings | General tab and tick the
box labeled 'Rx frequency offset with "CQ nnn ..."'
2. Select JTMSK mode and 50.280 (or your some other agreed calling
frequency) from the drop-down band menu. Remember that this menu is
not pre-populated with preferred frequencies for all modes on all
bands. Use Settings | Frequencies to add your desired modes and
frequencies to the list.
3. Tick the unlabeled checkbox just under the "Report: spinner to
activate the "CQ Rx nnn" spinner. Set this control to your desired
QSO frequency in kHz above the nominal band edge. On 6 meters, for
example, "265" means "50.265".
4. Your transceiver dial frequency should now show 50.265. Changes to
the "CQ Rx nnn" spinner value should be reflected immediately in the
transceiver dial frequency, the displayed value on the WSJT-X main
screen, and in Tx message #6, the "CQ nnn... " message.
5. When you transmit the Tx6 message, the Tx frequency will be set at
the calling frequency. Otherwise (when receiving, or when
transmitting any of the messages Tx1 through Tx5) the offset frequency
(50.265 in my example) will be used.
6. If you double-click on a received "CQ nnn ..." message on the
calling frequency, your rig will QSY to specified response frequency,
e.g. 50.265, for both Rx and Tx.
7. To go back to listening on the calling frequency, uncheck the box
that activated the "CQ Rx nnn" spinner.
#######################################################################
Fair warning: I have not yet tested all possible combinations of
"Split Operation" configuration (i.e., "None", "Rig", and "Fake it").
If you normally use Split operation, that should be OK for the "CQ
nnn ..." feature.
As always, please report any bugs that you find in r5889, including
pertinent details on your settings and the exact series of steps
required to reproduce the bug.
To download this alpha release for Windows, paste the following link
into your browser:
http://physics.princeton.edu/pulsar/K1JT/wsjtx-1.6.1-r5889-win32.exe
-- 73, Joe, K1JT
#######################################################################
New alpha release of experimental WSJT-X v1.6.1, r5865
------------------------------------------------------
This alpha release of WSJT-X includes major improvements to the JTMSK
decoder. Changes since revision 5823 include the following:
1. On-screen controls labeled "Rx nnnn Hz" and "F Tol" (Rx frequency
and tolerance) now function as expected in JTMSK mode. The frequency
search range can be up to 500 Hz, but note that sensitivity is
necessarily reduced for signals off frequency by more than about 250
Hz. Normally you should leave Rx Freq set at 1500 Hz; suitable values
for F Tol are 100 to 500 Hz.
2. The JTMSK decoder now makes good use of strong, short pings (as
short as 0.1 s) as well as weak pings several times longer.
3. Improved calculation of S/N and frequency of decoded signals.
4. Unified appearance of window titles on all non-modal windows.
5. CW ID is disabled (for now, at least) when operating in any of the
WSJT fast modes.
6. In WSPR mode, display of "Receiving ... <band>" messages is
disabled when band-hopping is not in use.
7. Fixed several bugs affecting status and visibility of certain
on-screen controls after changes in operating mode.
8. Fixed a bug allowing display of duplicate decodes for the same
signal.
9. Fixed a bug preventing compilation on 64-bit systems, and cleaned
up some harmless compiler warnings.
#######################################################################
Summary Description of JTMSK Protocol
JTMSK uses the same standard message structure as slow modes JT4, JT9,
and JT65. User information is "source encoded" to 72 bits. A 15-bit
CRC is appended and a convolutional code with constraint length K=13
and rate r=1/2 is applied, making a total of (72+15+12)*2 = 198
information bits. Three copies of the "Barker-11" code and three
even-parity bits are added for synchronization, making a total of
198+33+3 = 234 channel symbols. Modulation uses a constant-envelope,
continuous-phase "minimum-shift keying" (MSK) waveform, with tone
frequencies of 1000 and 2000 Hz.
#######################################################################
To download this alpha release for Windows, paste the following link
into your browser:
http://physics.princeton.edu/pulsar/K1JT/wsjtx-1.6.1-r5865-win32.exe
-- 73, Joe, K1JT
August 28, 2015
---------------
New release of experimental WSJT-X v1.6.1, r5823
------------------------------------------------
To download for Windows, paste the following link into your browser:
http://physics.princeton.edu/pulsar/K1JT/wsjtx-1.6.1-r5823-win32.exe
This experimental version of WSJT-X introduces a new fast mode called
JTMSK. The letters MS, of course, imply meteor scatter; the three
letters MSK mean "Minimum Shift Keying", the modulation scheme used in
this mode.
Revision 5823 also includes a number of (mostly minor) bug fixes
relative to r5789.
IMPORTANT: If you choose to try JTMSK, please accept the
responsibility of reporting on your results. You can send reports to
the "wsjtgroup" reflector, wsjtgroup@yahoogroups.com or email them
directly to me. All suggestions for improvements are welcome! Bug
reports should include details on how to reproduce the undesirable
program behavior.
The present JTMSK decoder has been optimized for short pings. It does
not yet do a wide search for proper frequency alignment; you and your
QSO partner need to be "on frequency" to within +/- 100 Hz or better.
The decoder does not (yet) attempt to make optimal use of weak, slowly
varying signals. These and other characteristics may be improved in
coming revisions.
KNOWN BUG: At present you should use T/R sequence lengths 15 s in
JTMSK mode. If you have a program crash, open Windows Task Manager,
select the "Processes" tab, right-click on wsjtx.exe, and select "End
Process Tree". Then restart the program.
I view JTMSK as a candidate for replacing both FSK441 and JTMS for all
meteor scatter work. JTMSK has the major advantage of including
strong forward error correction (FEC), similar in usage to the schemes
used for many years in JT4, JT9, and JT65. The structure of user
messages and the format of minimal QSOs is also identical to those
other modes. But JTMSK is very fast, transmitting its full encoded
message content in 0.117 s, in a 2 kHz bandwidth. JTMSK therefore
makes much better use of short pings than (for example) JT9H can do.
The Tx waveform of JTMSK has been carefully designed to have a number
of desirable features. All messages are exactly the same length: 72
bits of user information are followed by a 15-bit CRC and encoded into
198 channel bits with a convolutional code (constraint length K=13,
rate r=1/2). Three sequences of the "Barker-11" code are added, along
with three parity bits, making a total of 234 channel bits in each
message. The MSK symbols for these bits are transmitted at 2000 baud,
and the full encoded message is repeated every 117 ms.
A summary description of modulation parameters for all WSJT(-X) modes
is shown in a table posted here:
http://physics.princeton.edu/pulsar/K1JT/wsjt_modes.txt and
illustrated graphically here:
http://physics.princeton.edu/pulsar/K1JT/wsjt_modes.pdf
-- 73, Joe, K1jT
August 15, 2015
---------------
New release of experimental WSJT-X v1.6.1, r5789
Changes since WSJT-X v1.6.1, revision 5779:
1. Major speedup (5x) of fast-JT9 decoder.
2. Corrected logic for Auto-Sequencing operation.
3. Stop after sending 73 five times in auto-sequence mode.
4. Add an "Auto-Level" control to Fast Graph window.
5. Send fast-mode decodes to PSKreporter web site.
6. Support automatic logging via JTAlert-X.
7. Send fast-mode output to file ALL.TXT.
8. Better definition of dB levels for fast-JT9 signals.
9. Rationalize the GUI behavior when changing mode, submode, fast/slow
status, and T/R period.
10. Correct a flaw in the display of multiple decodes in a single
fast-JT9 sequence.
11. Fix minor bugs reported by G3WDG, ND0B, OZ1PIF, and others.
To download for Windows, paste the following link into your browser:
http://physics.princeton.edu/pulsar/K1JT/wsjtx-1.6.1-r5789-win32.exe
Please keep in mind that this is an experimental version of WSJT-X.
Bug reports and other feedback will be much appreciated, and will help
to make the program better!
-- 73, Joe, K1JT
August 11, 2015
---------------
Since its origin in the dark ages (ca. 2001) WSJT has supported "fast"
modes (designed for meteor scatter, etc.) and "slow" modes (optimized
for EME and other weak-signal propagation types). The most recent new
mode, JT9, now has *both* fast and slow submodes.
JT9A (the "original" JT9) is like JT65 and JT4: its T/R sequences are
one minute long, and its primary goal is best possible sensitivity for
very weak, approximately steady signals. The new experimental JT9
submodes use the same message structure, encoding, and modulation type
(9-tone FSK) as JT9A, but wider tone spacing and (optionally) faster
keying rates.
You can download an experimental version of WSJT-X (v1.6.1, r5779) here:
http://physics.princeton.edu/pulsar/K1JT/wsjtx-1.6.1-r5779-win32.exe
The fast submodes currently being tested, JT9E - JT9H, have been found
highly effective for meteors and ionoscatter propagation on 6 and 10
meters. Sensitivity is similar to ISCAT, or slightly better.
Decoding is much more reliable, because the JT9 protocol includes
strong forward error correction. Decoding results are like those for
all the WSJT "slow" modes: you should see messages exactly as they
were transmitted, or nothing at all. A potential side benefit is
automatic reporting of decodes to PSKreporter.
For details on the modulation parameters of the JT9 submodes, see the
table posted at
http://physics.princeton.edu/pulsar/K1JT/wsjt_modes.txt.
WSJT-X v1.6.1 r5779 has the following changes from r5769:
1. Numerous bug fixes
2. Double-click on decoded message now behaves properly
3. Faster decoding (further optimization still to come)
4. Decoded text is highlighted as in WSJT-X slow modes
5. Optional auto-sequencing
Fair warning: auto-sequencing is basically functional, but scarcely
tested. Please watch what it is doing, and tell us how you think it
should be improved!
If you use WSJT-X also for other modes and other purposes, you may
want to save several different sets of configuration settings. In
that case it's convenient to use the "-r xxx" option and start the
program from a command-prompt window. For example:
C:\Users\joe> cd \wsjt\wsjtx\bin
C:\WSJT\wsjtx\bin> wsjtx -r xxx
... where "xxx" can be anything you like, for example "ISCAT",
"FAST9", etc.
Proper configuration for the JT9 fast modes includes the following
settings:
On the Settings | General tab:
- check "Enable VHF/UHF/Microwave features"
Main window settings:
- Mode JT9
- Tx 700 Hz
- Rx 700 Hz
- Sync 0
- Submode G ... or E, F, and H (H not legal in US on 10m)
- Tick "Fast"
- T/R 30 s (also 5, 10, 15 s)
- FTol 500
Please keep in mind that this is an experimental version of WSJT-X.
It still has some rough edges, and no doubt some bugs. Your feedback
will be much appreciated, and will help to make the program better!
-- 73, Joe, K1JT
lib/JTMSKcode.f90
+123
View File
@@ -0,0 +1,123 @@
program JTMSKcode
! Generate simulated data for testing of JTMSK
use iso_c_binding, only: c_loc,c_size_t
use hashing
use packjt
character msg*22,decoded*22,bad*1,msgtype*13
integer*4 i4tone(234) !Channel symbols (values 0-1)
integer*1 e1(201)
integer*1 r1(201)
integer*1, target :: d8(13)
integer mettab(0:255,0:1) !Metric table for BPSK modulation
integer*1 i1hash(4)
integer*4 i4Msg6BitWords(12) !72-bit message as 6-bit words
character*72 c72
! real*8 twopi,dt,f0,f1,f,phi,dphi
real xp(29)
equivalence (ihash,i1hash)
data xp/0.500000, 0.401241, 0.309897, 0.231832, 0.168095, &
0.119704, 0.083523, 0.057387, 0.039215, 0.026890, &
0.018084, 0.012184, 0.008196, 0.005475, 0.003808, &
0.002481, 0.001710, 0.001052, 0.000789, 0.000469, &
0.000329, 0.000225, 0.000187, 0.000086, 0.000063, &
0.000017, 0.000091, 0.000032, 0.000045/
include 'testmsg.f90'
nargs=iargc()
if(nargs.ne.1) then
print*,'Usage: JTMSKcode "message"'
! print*,' JTMSKcode -t'
go to 999
endif
call getarg(1,msg)
nmsg=1
if(msg(1:2).eq."-t") nmsg=NTEST
! Get the metric table
bias=0.0
scale=20.0
xln2=log(2.0)
do i=128,156
x0=log(max(0.0001,2.0*xp(i-127)))/xln2
x1=log(max(0.001,2.0*(1.0-xp(i-127))))/xln2
mettab(i,0)=nint(scale*(x0-bias))
mettab(i,1)=nint(scale*(x1-bias))
mettab(256-i,0)=mettab(i,1)
mettab(256-i,1)=mettab(i,0)
enddo
do i=157,255
mettab(i,0)=mettab(156,0)
mettab(i,1)=mettab(156,1)
mettab(256-i,0)=mettab(i,1)
mettab(256-i,1)=mettab(i,0)
enddo
write(*,1010)
1010 format(" Message Decoded Err? Type"/ &
74("-"))
do imsg=1,nmsg
if(nmsg.gt.1) msg=testmsg(imsg)
call fmtmsg(msg,iz) !To upper case, collapse multiple blanks
ichk=0
call genmsk(msg,ichk,decoded,i4tone,itype) !Encode message into tone #s
msgtype=""
if(itype.eq.1) msgtype="Std Msg"
if(itype.eq.2) msgtype="Type 1 prefix"
if(itype.eq.3) msgtype="Type 1 suffix"
if(itype.eq.4) msgtype="Type 2 prefix"
if(itype.eq.5) msgtype="Type 2 suffix"
if(itype.eq.6) msgtype="Free text"
! Extract the data symbols, skipping over sync and parity bits
n1=35
n2=69
n3=94
r1(1:n1)=i4tone(11+1:11+n1)
r1(n1+1:n1+n2)=i4tone(23+n1+1:23+n1+n2)
r1(n1+n2+1:n1+n2+n3)=i4tone(35+n1+n2+1:35+n1+n2+n3)
where(r1.eq.0) r1=127
where(r1.eq.1) r1=-127
j=0
do i=1,99
j=j+1
e1(j)=r1(i)
j=j+1
e1(j)=r1(i+99)
enddo
nb1=87
call vit213(e1,nb1,mettab,d8,metric)
ihash=nhash(c_loc(d8),int(9,c_size_t),146)
ihash=2*iand(ihash,32767)
decoded=" "
if(d8(10).eq.i1hash(2) .and. d8(11).eq.i1hash(1)) then
write(c72,1012) d8(1:9)
1012 format(9b8.8)
read(c72,1014) i4Msg6BitWords
1014 format(12b6.6)
call unpackmsg(i4Msg6BitWords,decoded) !Unpack to get msgsent
endif
bad=" "
if(decoded.ne.msg) bad="*"
write(*,1020) imsg,msg,decoded,bad,itype,msgtype
1020 format(i2,'.',2x,a22,2x,a22,3x,a1,i3,": ",a13)
enddo
if(nmsg.eq.1) then
open(10,file='JTMSKcode.out',status='unknown')
do j=1,234
write(10,1030) j,i4tone(j)
1030 format(2i5)
enddo
close(10)
endif
999 end program JTMSKcode
lib/JTMSKsim.f90
+131
View File
@@ -0,0 +1,131 @@
program JTMSKsim
use wavhdr
parameter (NSPM=1404)
parameter (NFFT=256*1024)
parameter (NMAX=15*12000)
type(hdr) h
complex cb11(0:NSPM-1)
complex cmsg(0:NSPM-1)
complex c(0:NFFT-1)
complex c1(0:NSPM-1)
complex c2(0:NSPM-1)
integer i4tone(NSPM)
integer*2 iwave(NMAX)
real w(0:255)
character*8 arg
nargs=iargc()
if(nargs.ne.2) then
print*,'Usage: JTMSK freq dB'
go to 999
endif
call getarg(1,arg)
read(arg,*) fmid
call getarg(2,arg)
read(arg,*) snrdb
open(10,file='JTMSKcode.out',status='old')
do j=1,234
read(10,*) junk,i4tone(j)
enddo
close(10)
npts=NMAX
h=default_header(12000,npts)
twopi=8.0*atan(1.0)
dt=1.0/12000.0
df=12000.0/NFFT
k=-1
phi=0.
phi0=0.
sig=10.0**(0.05*snrdb)
! Generate the Tx waveform
cb11=0.
do j=1,234
dphi=twopi*(fmid-500.0)*dt
if(i4tone(j).eq.1) dphi=twopi*(fmid+500.0)*dt
dphi0=twopi*1000.0*dt
if(i4tone(j).eq.1) dphi0=twopi*2000.0*dt
do i=1,6
k=k+1
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
cmsg(k)=cmplx(cos(phi),sin(phi))
phi0=phi0+dphi0
if(phi0.gt.twopi) phi0=phi0-twopi
! if((k.ge.1 .and. k.le.66) .or. (k.ge.283 .and. k.le.348) .or. &
! (k.ge.769 .and.k.le.834)) cb11(k)=cmplx(cos(phi0),sin(phi0))
if(k.ge.1 .and. k.le.66) cb11(k)=cmplx(cos(phi0),sin(phi0))
! write(11,3001) k*dt,cmsg(k),phi
!3001 format(4f12.6)
enddo
enddo
! Generate noise with B=2500 Hz, rms=1.0
c=0.
ia=nint(250.0/df)
ib=nint(2759.0/df)
do i=ia,ib
x=gran()
y=gran()
c(i)=cmplx(x,y)
enddo
call four2a(c,NFFT,1,1,1)
sq=0.
do i=0,npts-1
sq=sq + real(c(i))**2 + aimag(c(i))**2
enddo
rms=sqrt(0.5*sq/npts)
c=c/rms
i0=3*12000
ncopy=NSPM
! ncopy=0.5*NSPM
c(i0:i0+ncopy-1)=c(i0:i0+ncopy-1) + sig*cmsg(0:ncopy-1)
do i=1,npts
iwave(i)=100.0*real(c(i))
enddo
open(12,file='150901_000000.wav',status='unknown',access='stream')
write(12) h,iwave(1:npts)
smax=0.
fpk=0.
jpk=0
nfft1=256
w=0.
do i=0,65
w(i)=sin(i*twopi/132.0)
enddo
do ia=0,npts-nfft1
c1(0:nfft1-1)=c(ia:ia+nfft1-1)*conjg(cb11(0:nfft1-1))
c2(0:nfft1-1)=w(0:nfft1-1)*c1(0:nfft1-1)
call four2a(c2,nfft1,1,-1,1)
do i=0,nfft1-1
! write(21,1100) i,c1(i)
!1100 format(i6,2f12.3)
enddo
df1=12000.0/nfft1
do i=-20,20
j=i
if(i.lt.0) j=j+nfft1
f=j*df1
if(i.lt.0) f=f-12000.0
s=1.e-3*(real(c2(j))**2 + aimag(c2(j))**2)
if(abs(ia-i0).lt.1404) write(22,1110) f,c2(j),s,ia
1110 format(4f12.3,i6)
if(s.gt.smax) then
smax=s
jpk=ia
fpk=f
endif
enddo
enddo
print*,smax,jpk*dt,fpk
999 end program JTMSKsim
lib/Makefile
+54
View File
@@ -0,0 +1,54 @@
CC = gcc
CXX = g++
FC = gfortran
AR = ar cr
MKDIR = mkdir -p
CP = cp
RANLIB = ranlib
RM = rm -f
FFLAGS = -O3 -funroll-loops -Wall -Wno-conversion -fno-second-underscore -DUNIX
CFLAGS = -I. -fPIE
# 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 $<
%.mod: %.f90
${FC} ${FFLAGS} -c $<
#all: jt4.mod testjt4 testfast9
all: testjt65
OBJS1 = testjt4.o jt4.o sync4.o ps4.o four2a.o flat1a.o smo.o xcor4.o \
slope.o peakup.o db.o pctile.o sort.o timer.o image.o zplt.o
testjt4: $(OBJS1)
$(FC) -o testjt4 $(OBJS1) -L. -lfftw3f_threads -lfftw3f
OBJS2 = t2.o image.o
t2: $(OBJS2)
$(FC) -o t2 $(OBJS2)
OBJS3 = testfast9.o fast9.o four2a.o pctile.o db.o interleave9.o jt9fano.o \
sort.o fano232.o packjt.o deg2grid.o grid2deg.o fmtmsg.o \
spec9f.o foldspec9f.o sync9f.o softsym9f.o
testfast9: $(OBJS3)
$(FC) -o testfast9 $(OBJS3) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS4 = testjt65.o symspec65.o four2a.o db.o flat65.o pctile.o shell.o \
xcor.o setup65.o slope.o peakup.o sync65.o
testjt65: $(OBJS4)
$(FC) -o testjt65 $(OBJS4) C:\JTSDK\fftw3f\libfftw3f-3.dll
.PHONY : clean
clean:
$(RM) *.o libjt9.a testjt4
lib/Makefile.jt65
+76
View File
@@ -0,0 +1,76 @@
# Set paths
EXE_DIR = ../../wsjtx_exp_install_latest
QT_DIR = /usr/include/qt5
INCPATH = -I${QT_DIR} -I${QT_DIR}/QtCore
CC = gcc
CXX = g++
FC = gfortran
AR = ar cr
MKDIR = mkdir -p
CP = cp
RANLIB = ranlib
RM = rm -f
FFLAGS = -I/opt/local/include -O3 -funroll-loops -Wall -Wno-conversion -fno-second-underscore -DUNIX
CFLAGS = -I. -fbounds-check -fPIE
# 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: libjt9.a jt65 jt65sim
OBJS1 = astrosub.o astro0.o astro.o sun.o coord.o tmoonsub.o \
fmtmsg.o deg2grid.o\
prog_args.o options.o pctile.o graycode.o sort.o chkmsg.o \
igray.o fftw3mod.o packjt.o\
four2a.o grid2deg.o wisdom.o \
symspec.o analytic.o db.o \
encode232.o interleave9.o\
entail.o fano232.o gran.o sync9.o decjt9.o \
fil3.o decoder.o timer.o \
twkfreq.o symspec2.o shell.o sync65.o peakup.o slope.o xcor.o\
fillcom.o chkss2.o zplot9.o flat1.o flat2.o \
jt65a.o symspec65.o flat65.o ccf65.o decode65a.o \
filbig.o fil6521.o afc65b.o decode65b.o setup65.o \
extract.o fchisq65.o demod64a.o chkhist.o interleave63.o ccf2.o \
move.o indexx.o graycode65.o twkfreq65.o smo.o smo121.o \
wrapkarn.o init_rs.o encode_rs.o decode_rs.o gen65.o fil4.o \
flat4.o determ.o baddata.o subtract65.o
libjt9.a: $(OBJS1)
$(AR) libjt9.a $(OBJS1)
$(RANLIB) libjt9.a
OBJS7 = jt65.o
jt65: $(OBJS7) libjt9.a libsfrsd.a
$(FC) -o jt65 $(OBJS7) -L. -L/opt/local/lib -L./sfrsd2 -ljt9 -lsfrsd -lfftw3f_threads -lfftw3f
$(CP) jt65 $(EXE_DIR)
OBJS2 = jt65sim.o wavhdr.o
jt65sim: $(OBJS2) libjt9.a
$(FC) -o jt65sim $(OBJS2) -L. -L/opt/local/lib -ljt9
$(CP) jt65sim $(EXE_DIR)
init_rs.o: init_rs.c
$(CC) -c -DBIGSYM=1 -o init_rs.o init_rs.c
encode_rs.o: encode_rs.c
$(CC) -c -DBIGSYM=1 -o encode_rs.o encode_rs.c
decode_rs.o: decode_rs.c
$(CC) -c -DBIGSYM=1 -o decode_rs.o decode_rs.c
.PHONY : clean
clean:
$(RM) *.o libjt9.a jt65
lib/Makefile.jt65.win
+63
View File
@@ -0,0 +1,63 @@
# Set paths
EXE_DIR = ../../wsjtx_exp_install_latest
QT_DIR = /usr/include/qt5
INCPATH = -I${QT_DIR} -I${QT_DIR}/QtCore
CC = gcc
CXX = g++
FC = gfortran
AR = ar cr
MKDIR = mkdir -p
CP = cp
RANLIB = ranlib
RM = rm -f
FFLAGS = -I/opt/local/include -O2 -Wall -Wno-conversion \
-fno-second-underscore -fbounds-check -DUNIX
CFLAGS = -I. -fPIE
# 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: libjt9.a jt65
OBJS1 = astrosub.o astro0.o astro.o sun.o coord.o tmoonsub.o \
fmtmsg.o deg2grid.o\
prog_args.o options.o pctile.o graycode.o sort.o chkmsg.o \
igray.o fftw3mod.o packjt.o\
four2a.o grid2deg.o wisdom.o \
symspec.o analytic.o db.o \
encode232.o interleave9.o\
entail.o fano232.o gran.o sync9.o decjt9.o \
fil3.o decoder.o timer.o \
twkfreq.o symspec2.o shell.o sync65.o peakup.o slope.o xcor.o\
fillcom.o chkss2.o zplot9.o flat1.o flat2.o \
jt65a.o symspec65.o flat65.o ccf65.o decode65a.o \
filbig.o fil6521.o afc65b.o decode65b.o setup65.o \
extract.o fchisq65.o demod64a.o chkhist.o interleave63.o ccf2.o \
move.o indexx.o graycode65.o twkfreq65.o smo.o smo121.o \
wrapkarn.o init_rs.o encode_rs.o decode_rs.o gen65.o fil4.o \
flat4.o determ.o baddata.o subtract65.o
libjt9.a: $(OBJS1)
$(AR) libjt9.a $(OBJS1)
$(RANLIB) libjt9.a
OBJS7 = jt65.o
jt65: $(OBJS7) libjt9.a libsfrsd.a
$(FC) -o jt65 $(OBJS7) -L. -ljt9 -lsfrsd -lfftw3f_threads -lfftw3f
$(CP) jt65 $(EXE_DIR)
.PHONY : clean
clean:
$(RM) *.o libjt9.a jt65
lib/Makefile.msk
+67
View File
@@ -0,0 +1,67 @@
# 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
all: testmsk JTMSKcode
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 nhash.o tab.o vit213.o
JTMSKcode: $(OBJS5)
$(FC) -o JTMSKcode $(OBJS5)
OBJS6 = testmsk.o jtmsk.o analytic.o four2a.o db.o mskdf.o pctile.o \
sort.o tweak1.o syncmsk.o genmsk.o packjt.o fmtmsg.o indexx.o \
deg2grid.o grid2deg.o entail.o nhash.o tab.o vit213.o
testmsk: $(OBJS6)
$(FC) -o testmsk $(OBJS6) -lfftw3f
OBJS1 = t1.o four2a.o db.o
t1: $(OBJS1)
$(FC) -o t1 $(OBJS1) -lfftw3f
OBJS2 = t6.o four2a.o db.o
t6: $(OBJS2)
$(FC) -o t6 $(OBJS2) -lfftw3f
nhash.o: wsprd/nhash.h wsprd/nhash.c
$(CC) -c -O2 wsprd/nhash.c
.PHONY : clean
clean:
$(RM) *.o JTMSKcode JTMSKcode.exe
lib/Makefile.mskWin
+69
View File
@@ -0,0 +1,69 @@
# 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: testmsk.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 = testmsk.o 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 timer.o rectify_msk.o
testmsk.exe: $(OBJS6)
$(FC) -o testmsk.exe $(OBJS6) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS1 = fixwav.o wavhdr.o
fixwav.exe: $(OBJS1)
$(FC) -o fixwav.exe $(OBJS1)
OBJS2 = t6.o four2a.o db.o
t6: $(OBJS2)
$(FC) -o t6 $(OBJS2) C:\JTSDK\fftw3f\libfftw3f-3.dll
.PHONY : clean
clean:
$(RM) *.o JTMSKcode JTMSKcode.exe
lib/afc65b.f90
+6 -3
View File
@@ -9,11 +9,14 @@ subroutine afc65b(cx,npts,fsample,nflip,a,ccfbest,dtbest)
a(2)=0.
a(3)=0.
a(4)=0.
! deltaa(1)=2.0
! deltaa(2)=2.0
! deltaa(3)=2.0
! deltaa(4)=0.05
deltaa(1)=2.0
deltaa(2)=2.0
deltaa(3)=2.0
deltaa(4)=0.05
nterms=3 !Maybe 2 is enough?
deltaa(3)=1.0
nterms=2 !Maybe 2 is enough?
! Start the iteration
chisqr=0.
lib/ana932.f90
+21
View File
@@ -0,0 +1,21 @@
subroutine ana932(dat,npts0,cdat,npts)
real dat(npts0)
complex cdat(262145)
n=log(float(npts0))/log(2.0)
nfft1=2**(n+1)
nfft2=9*nfft1/32
df932=11025.0/nfft1
fac=2.0/nfft1
do i=1,npts0/2
cdat(i)=fac*cmplx(dat(2*i-1),dat(2*i))
enddo
cdat(npts0/2+1:nfft1/2)=0.
call four2a(cdat,nfft1,1,-1,0) !Forward r2c FFT
call four2a(cdat,nfft2,1,1,1) !Inverse c2c FFT
npts=npts0*9.0/32.0 !Downsampled data length
npts2=npts
return
end subroutine ana932
lib/analytic.f90
+37 -8
View File
@@ -1,24 +1,53 @@
subroutine analytic(d,npts,nfft,s,c)
subroutine analytic(d,npts,nfft,c)
! Convert real data to analytic signal
parameter (NFFTMAX=128*1024)
parameter (NFFTMAX=1024*1024)
real d(npts)
real s(npts)
real h(NFFTMAX/2)
complex c(NFFTMAX)
data nfft0/0/
save nfft0,h
df=12000.0/nfft
nh=nfft/2
if(nfft.ne.nfft0) then
t=1.0/2000.0
beta=0.6
pi=4.0*atan(1.0)
do i=1,nh+1
ff=(i-1)*df
f=ff-1500.0
h(i)=0.
if(abs(f).le.(1-beta)/(2*t)) h(i)=1.0
if(abs(f).gt.(1-beta)/(2*t) .and. abs(f).le.(1+beta)/(2*t)) then
h(i)=0.5*(1+cos((pi*t/beta )*(abs(f)-(1-beta)/(2*t))))
endif
h(i)=sqrt(h(i))
enddo
nfft0=nfft
endif
fac=2.0/nfft
c(1:npts)=fac*d(1:npts)
c(npts+1:nfft)=0.
call four2a(c,nfft,1,-1,1) !Forward c2c FFT
do i=1,nh
s(i)=real(c(i))**2 + aimag(c(i))**2
enddo
! do i=1,nh
! f=(i-1)*df
! s(i)=real(c(i))**2 + aimag(c(i))**2
! write(12,3001) f,s(i),db(s(i))
!3001 format(3f12.3)
! enddo
c(1)=0.5*c(1)
c(nh+2:nfft)=0.
! ia=700.0/df
! c(1:ia)=0.
! ib=2300.0/df
! c(ib:nfft)=0.
c(1:nh+1)=h(1:nh+1)*c(1:nh+1)
c(1)=0.5*c(1) !Half of DC term
c(nh+2:nfft)=0. !Zero the negative frequencies
call four2a(c,nfft,1,1,1) !Inverse c2c FFT
return
lib/astro0.f90
+2 -1
View File
@@ -7,7 +7,7 @@ subroutine astro0(nyear,month,nday,uth8,freq8,mygrid,hisgrid, &
character*6 mygrid,hisgrid
real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8
real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0,dt
real*8 sd8,poloffset8,day8,width1,width2,xlst8
real*8 sd8,poloffset8,width1,width2,xlst8
real*8 uth8,techo8,freq8
real*8 xl,b
common/librcom/xl(2),b(2)
@@ -53,6 +53,7 @@ subroutine astro0(nyear,month,nday,uth8,freq8,mygrid,hisgrid, &
RAMoon8=RAMoon/15.0
DecMoon8=DecMoon
HA8=HA
xlst8=xlst
Dgrd8=Dgrd
sd8=sd
poloffset8=poloffset
lib/bpskmetrics.dat
-256
View File
@@ -1,256 +0,0 @@
-12.8 1.000 -9.966 1.000000 0.000000
-12.7 1.000 -9.966 1.000000 0.000000
-12.6 1.000 -9.966 1.000000 0.000000
-12.5 1.000 -9.966 1.000000 0.000000
-12.4 1.000 -9.966 1.000000 0.000000
-12.3 1.000 -9.966 1.000000 0.000000
-12.2 1.000 -9.966 1.000000 0.000000
-12.1 1.000 -9.966 1.000000 0.000000
-12.0 1.000 -9.966 1.000000 0.000000
-11.9 1.000 -9.966 1.000000 0.000000
-11.8 1.000 -9.966 1.000000 0.000000
-11.7 1.000 -9.966 1.000000 0.000000
-11.6 1.000 -9.966 1.000000 0.000000
-11.5 1.000 -9.966 1.000000 0.000000
-11.4 1.000 -9.966 1.000000 0.000000
-11.3 1.000 -9.966 1.000000 0.000000
-11.2 1.000 -9.966 1.000000 0.000000
-11.1 1.000 -9.966 1.000000 0.000000
-11.0 1.000 -9.966 1.000000 0.000000
-10.9 1.000 -9.966 1.000000 0.000000
-10.8 1.000 -9.966 1.000000 0.000000
-10.7 1.000 -9.966 1.000000 0.000000
-10.6 1.000 -9.966 1.000000 0.000000
-10.5 1.000 -9.966 1.000000 0.000000
-10.4 1.000 -9.966 1.000000 0.000000
-10.3 1.000 -9.966 1.000000 0.000000
-10.2 1.000 -9.966 1.000000 0.000000
-10.1 1.000 -9.966 1.000000 0.000000
-10.0 1.000 -9.966 1.000000 0.000000
-9.9 1.000 -9.966 1.000000 0.000000
-9.8 1.000 -9.966 1.000000 0.000000
-9.7 1.000 -9.966 1.000000 0.000000
-9.6 1.000 -9.966 1.000000 0.000000
-9.5 1.000 -9.966 1.000000 0.000000
-9.4 1.000 -9.966 1.000000 0.000000
-9.3 1.000 -9.966 1.000000 0.000000
-9.2 1.000 -9.966 1.000000 0.000000
-9.1 1.000 -9.966 1.000000 0.000000
-9.0 1.000 -9.966 1.000000 0.000000
-8.9 1.000 -9.966 1.000000 0.000000
-8.8 1.000 -9.966 1.000000 0.000000
-8.7 1.000 -9.966 1.000000 0.000000
-8.6 1.000 -9.966 1.000000 0.000000
-8.5 1.000 -9.966 1.000000 0.000000
-8.4 1.000 -9.966 1.000000 0.000000
-8.3 1.000 -9.966 1.000000 0.000000
-8.2 1.000 -9.966 1.000000 0.000000
-8.1 1.000 -9.966 1.000000 0.000000
-8.0 1.000 -9.966 1.000000 0.000000
-7.9 1.000 -9.966 1.000000 0.000000
-7.8 1.000 -9.966 1.000000 0.000000
-7.7 1.000 -9.966 1.000000 0.000000
-7.6 1.000 -9.966 1.000000 0.000000
-7.5 1.000 -9.966 1.000000 0.000000
-7.4 1.000 -9.966 1.000000 0.000000
-7.3 1.000 -9.966 1.000000 0.000000
-7.2 1.000 -9.966 1.000000 0.000000
-7.1 1.000 -9.966 1.000000 0.000000
-7.0 1.000 -9.966 1.000000 0.000000
-6.9 1.000 -9.966 1.000000 0.000000
-6.8 1.000 -9.966 1.000000 0.000000
-6.7 1.000 -9.966 1.000000 0.000000
-6.6 1.000 -9.966 1.000000 0.000000
-6.5 1.000 -9.966 1.000000 0.000000
-6.4 1.000 -9.966 1.000000 0.000000
-6.3 1.000 -9.966 1.000000 0.000000
-6.2 1.000 -9.966 1.000000 0.000000
-6.1 1.000 -9.966 1.000000 0.000000
-6.0 1.000 -9.966 1.000000 0.000000
-5.9 1.000 -9.966 1.000000 0.000000
-5.8 1.000 -9.966 1.000000 0.000000
-5.7 1.000 -9.966 1.000000 0.000000
-5.6 1.000 -9.966 1.000000 0.000000
-5.5 1.000 -9.966 1.000000 0.000000
-5.4 1.000 -9.966 1.000000 0.000000
-5.3 1.000 -9.966 1.000000 0.000000
-5.2 1.000 -9.966 1.000000 0.000000
-5.1 1.000 -9.966 1.000000 0.000000
-5.0 1.000 -9.966 1.000000 0.000000
-4.9 1.000 -9.966 1.000000 0.000000
-4.8 1.000 -9.966 1.000000 0.000000
-4.7 1.000 -9.966 1.000000 0.000000
-4.6 1.000 -9.966 1.000000 0.000000
-4.5 1.000 -9.966 1.000000 0.000000
-4.4 1.000 -9.966 1.000000 0.000000
-4.3 1.000 -9.966 1.000000 0.000000
-4.2 1.000 -9.966 1.000000 0.000000
-4.1 1.000 -9.966 1.000000 0.000000
-4.0 1.000 -9.966 1.000000 0.000000
-3.9 1.000 -9.966 1.000000 0.000000
-3.8 1.000 -9.966 1.000000 0.000000
-3.7 1.000 -9.966 1.000000 0.000000
-3.6 1.000 -9.966 1.000000 0.000000
-3.5 1.000 -9.966 1.000000 0.000000
-3.4 1.000 -9.966 1.000000 0.000000
-3.3 1.000 -9.966 1.000000 0.000000
-3.2 1.000 -9.966 1.000000 0.000000
-3.1 1.000 -9.966 1.000000 0.000000
-3.0 1.000 -9.966 1.000000 0.000000
-2.9 1.000 -9.966 1.000000 0.000000
-2.8 1.000 -9.966 0.999955 0.000045
-2.7 1.000 -9.966 0.999968 0.000032
-2.6 1.000 -9.966 0.999909 0.000091
-2.5 1.000 -9.966 0.999983 0.000017
-2.4 1.000 -9.966 0.999937 0.000063
-2.3 1.000 -9.966 0.999914 0.000086
-2.2 1.000 -9.966 0.999813 0.000187
-2.1 1.000 -9.966 0.999775 0.000225
-2.0 1.000 -9.966 0.999671 0.000329
-1.9 0.999 -9.966 0.999531 0.000469
-1.8 0.999 -9.308 0.999211 0.000789
-1.7 0.998 -8.893 0.998948 0.001052
-1.6 0.998 -8.191 0.998290 0.001710
-1.5 0.996 -7.655 0.997519 0.002481
-1.4 0.994 -7.037 0.996192 0.003808
-1.3 0.992 -6.513 0.994525 0.005475
-1.2 0.988 -5.931 0.991804 0.008196
-1.1 0.982 -5.359 0.987816 0.012184
-1.0 0.974 -4.789 0.981916 0.018084
-0.9 0.961 -4.217 0.973110 0.026890
-0.8 0.942 -3.672 0.960785 0.039215
-0.7 0.915 -3.123 0.942613 0.057387
-0.6 0.874 -2.582 0.916477 0.083523
-0.5 0.816 -2.062 0.880296 0.119704
-0.4 0.734 -1.573 0.831905 0.168095
-0.3 0.619 -1.109 0.768168 0.231832
-0.2 0.465 -0.690 0.690103 0.309897
-0.1 0.260 -0.317 0.598759 0.401241
0.0 0.000 0.000 0.500000 0.500000
0.1 -0.317 0.260 0.401241 0.598759
0.2 -0.690 0.465 0.309897 0.690103
0.3 -1.109 0.619 0.231832 0.768168
0.4 -1.573 0.734 0.168095 0.831905
0.5 -2.062 0.816 0.119704 0.880296
0.6 -2.582 0.874 0.083523 0.916477
0.7 -3.123 0.915 0.057387 0.942613
0.8 -3.672 0.942 0.039215 0.960785
0.9 -4.217 0.961 0.026890 0.973110
1.0 -4.789 0.974 0.018084 0.981916
1.1 -5.359 0.982 0.012184 0.987816
1.2 -5.931 0.988 0.008196 0.991804
1.3 -6.513 0.992 0.005475 0.994525
1.4 -7.037 0.994 0.003808 0.996192
1.5 -7.655 0.996 0.002481 0.997519
1.6 -8.191 0.998 0.001710 0.998290
1.7 -8.893 0.998 0.001052 0.998948
1.8 -9.308 0.999 0.000789 0.999211
1.9 -9.966 0.999 0.000469 0.999531
2.0 -9.966 1.000 0.000329 0.999671
2.1 -9.966 1.000 0.000225 0.999775
2.2 -9.966 1.000 0.000187 0.999813
2.3 -9.966 1.000 0.000086 0.999914
2.4 -9.966 1.000 0.000063 0.999937
2.5 -9.966 1.000 0.000017 0.999983
2.6 -9.966 1.000 0.000091 0.999909
2.7 -9.966 1.000 0.000032 0.999968
2.8 -9.966 1.000 0.000045 0.999955
2.9 -9.966 1.000 0.000000 1.000000
3.0 -9.966 1.000 0.000000 1.000000
3.1 -9.966 1.000 0.000000 1.000000
3.2 -9.966 1.000 0.000000 1.000000
3.3 -9.966 1.000 0.000000 1.000000
3.4 -9.966 1.000 0.000000 1.000000
3.5 -9.966 1.000 0.000000 1.000000
3.6 -9.966 1.000 0.000000 1.000000
3.7 -9.966 1.000 0.000000 1.000000
3.8 -9.966 1.000 0.000000 1.000000
3.9 -9.966 1.000 0.000000 1.000000
4.0 -9.966 1.000 0.000000 1.000000
4.1 -9.966 1.000 0.000000 1.000000
4.2 -9.966 1.000 0.000000 1.000000
4.3 -9.966 1.000 0.000000 1.000000
4.4 -9.966 1.000 0.000000 1.000000
4.5 -9.966 1.000 0.000000 1.000000
4.6 -9.966 1.000 0.000000 1.000000
4.7 -9.966 1.000 0.000000 1.000000
4.8 -9.966 1.000 0.000000 1.000000
4.9 -9.966 1.000 0.000000 1.000000
5.0 -9.966 1.000 0.000000 1.000000
5.1 -9.966 1.000 0.000000 1.000000
5.2 -9.966 1.000 0.000000 1.000000
5.3 -9.966 1.000 0.000000 1.000000
5.4 -9.966 1.000 0.000000 1.000000
5.5 -9.966 1.000 0.000000 1.000000
5.6 -9.966 1.000 0.000000 1.000000
5.7 -9.966 1.000 0.000000 1.000000
5.8 -9.966 1.000 0.000000 1.000000
5.9 -9.966 1.000 0.000000 1.000000
6.0 -9.966 1.000 0.000000 1.000000
6.1 -9.966 1.000 0.000000 1.000000
6.2 -9.966 1.000 0.000000 1.000000
6.3 -9.966 1.000 0.000000 1.000000
6.4 -9.966 1.000 0.000000 1.000000
6.5 -9.966 1.000 0.000000 1.000000
6.6 -9.966 1.000 0.000000 1.000000
6.7 -9.966 1.000 0.000000 1.000000
6.8 -9.966 1.000 0.000000 1.000000
6.9 -9.966 1.000 0.000000 1.000000
7.0 -9.966 1.000 0.000000 1.000000
7.1 -9.966 1.000 0.000000 1.000000
7.2 -9.966 1.000 0.000000 1.000000
7.3 -9.966 1.000 0.000000 1.000000
7.4 -9.966 1.000 0.000000 1.000000
7.5 -9.966 1.000 0.000000 1.000000
7.6 -9.966 1.000 0.000000 1.000000
7.7 -9.966 1.000 0.000000 1.000000
7.8 -9.966 1.000 0.000000 1.000000
7.9 -9.966 1.000 0.000000 1.000000
8.0 -9.966 1.000 0.000000 1.000000
8.1 -9.966 1.000 0.000000 1.000000
8.2 -9.966 1.000 0.000000 1.000000
8.3 -9.966 1.000 0.000000 1.000000
8.4 -9.966 1.000 0.000000 1.000000
8.5 -9.966 1.000 0.000000 1.000000
8.6 -9.966 1.000 0.000000 1.000000
8.7 -9.966 1.000 0.000000 1.000000
8.8 -9.966 1.000 0.000000 1.000000
8.9 -9.966 1.000 0.000000 1.000000
9.0 -9.966 1.000 0.000000 1.000000
9.1 -9.966 1.000 0.000000 1.000000
9.2 -9.966 1.000 0.000000 1.000000
9.3 -9.966 1.000 0.000000 1.000000
9.4 -9.966 1.000 0.000000 1.000000
9.5 -9.966 1.000 0.000000 1.000000
9.6 -9.966 1.000 0.000000 1.000000
9.7 -9.966 1.000 0.000000 1.000000
9.8 -9.966 1.000 0.000000 1.000000
9.9 -9.966 1.000 0.000000 1.000000
10.0 -9.966 1.000 0.000000 1.000000
10.1 -9.966 1.000 0.000000 1.000000
10.2 -9.966 1.000 0.000000 1.000000
10.3 -9.966 1.000 0.000000 1.000000
10.4 -9.966 1.000 0.000000 1.000000
10.5 -9.966 1.000 0.000000 1.000000
10.6 -9.966 1.000 0.000000 1.000000
10.7 -9.966 1.000 0.000000 1.000000
10.8 -9.966 1.000 0.000000 1.000000
10.9 -9.966 1.000 0.000000 1.000000
11.0 -9.966 1.000 0.000000 1.000000
11.1 -9.966 1.000 0.000000 1.000000
11.2 -9.966 1.000 0.000000 1.000000
11.3 -9.966 1.000 0.000000 1.000000
11.4 -9.966 1.000 0.000000 1.000000
11.5 -9.966 1.000 0.000000 1.000000
11.6 -9.966 1.000 0.000000 1.000000
11.7 -9.966 1.000 0.000000 1.000000
11.8 -9.966 1.000 0.000000 1.000000
11.9 -9.966 1.000 0.000000 1.000000
12.0 -9.966 1.000 0.000000 1.000000
12.1 -9.966 1.000 0.000000 1.000000
12.2 -9.966 1.000 0.000000 1.000000
12.3 -9.966 1.000 0.000000 1.000000
12.4 -9.966 1.000 0.000000 1.000000
12.5 -9.966 1.000 0.000000 1.000000
12.6 -9.966 1.000 0.000000 1.000000
12.7 -9.966 1.000 0.000000 1.000000
lib/ccf2.f90
+9 -6
View File
@@ -1,7 +1,7 @@
subroutine ccf2(ss,nz,nflip,ccfbest,lagpk)
subroutine ccf2(ss,nz,nflip,ccfbest,xlagpk)
parameter (LAGMAX=60)
! parameter (LAGMAX=200)
! parameter (LAGMAX=60)
parameter (LAGMAX=200)
real ss(nz)
real ccf(-LAGMAX:LAGMAX)
integer npr(126)
@@ -24,9 +24,9 @@ subroutine ccf2(ss,nz,nflip,ccfbest,lagpk)
s0=0.
s1=0.
do i=1,126
j=2*(8*i + 43) + lag
j=16*(i-1)+1 + lag
if(j.ge.1 .and. j.le.nz-8) then
x=ss(j)+ss(j+8) !Add two half-symbol contributions
x=ss(j)
if(npr(i).eq.0) then
s0=s0 + x
else
@@ -40,6 +40,9 @@ subroutine ccf2(ss,nz,nflip,ccfbest,lagpk)
lagpk=lag
endif
enddo
if( lagpk.gt.-LAGMAX .and. lagpk.lt.LAGMAX) then
call peakup(ccf(lagpk-1),ccf(lagpk),ccf(lagpk+1),dx)
xlagpk=lagpk+dx
endif
return
end subroutine ccf2
lib/decjt9.f90
+1 -6
View File
@@ -4,14 +4,13 @@ subroutine decjt9(ss,id2,nutc,nfqso,newdat,npts8,nfa,nfsplit,nfb,ntol, &
include 'constants.f90'
real ss(184,NSMAX)
character*22 msg
character*500 infile
real*4 ccfred(NSMAX)
real*4 red2(NSMAX)
logical ccfok(NSMAX)
logical done(NSMAX)
integer*2 id2(NTMAX*12000)
integer*1 i1SoftSymbols(207)
common/decstats/num65,numbm,numkv,num9,numfano,infile
common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano
save ccfred,red2
nsynced=0
@@ -114,10 +113,6 @@ subroutine decjt9(ss,id2,nutc,nfqso,newdat,npts8,nfa,nfsplit,nfb,ntol, &
!$omp critical(decode_results) ! serialize writes - see also jt65a.f90
write(*,1000) nutc,nsnr,xdt,nint(freq),msg
1000 format(i4.4,i4,f5.1,i5,1x,'@',1x,a22)
! i1=index(infile,'.wav')
! write(*,1000) infile(i1-11:i1-1),nsnr,xdt,nint(freq),msg, &
! schk,drift,a3,nlim
!1000 format(a11,i4,f5.1,i5,1x,'@',1x,a22,3f6.1,i6)
write(13,1002) nutc,nsync,nsnr,xdt,freq,ndrift,msg
1002 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT9')
call flush(6)
lib/decode65a.f90
+15 -29
View File
@@ -1,5 +1,5 @@
subroutine decode65a(dd,npts,newdat,nqd,f0,nflip,mode65,sync2,a,dt, &
nbmkv,nhist,decoded)
subroutine decode65a(dd,npts,newdat,nqd,f0,nflip,mode65,ntrials, &
naggressive,ndepth,sync2,a,dt,nsf,nhist,decoded)
! Apply AFC corrections to a candidate JT65 signal, then decode it.
@@ -17,35 +17,23 @@ subroutine decode65a(dd,npts,newdat,nqd,f0,nflip,mode65,sync2,a,dt, &
save
! Mix sync tone to baseband, low-pass filter, downsample to 1378.125 Hz
dt00=dt
call timer('filbig ',0)
call filbig(dd,npts,f0,newdat,cx,n5,sq0)
call timer('filbig ',1)
! NB: cx has sample rate 12000*77125/672000 = 1378.125 Hz
! Find best DF, f1, f2, and DT. Start by downsampling to 344.53125 Hz
! Find best DF, drift, curvature, and DT. Start by downsampling to 344.53125 Hz
call timer('fil6521 ',0)
! Add some zeros at start of c5 arrays -- empirical fix for negative DT's
nadd=1089
c5x(:nadd)=0.
call fil6521(cx,n5,c5x(nadd+1),n6)
n6=n6+nadd
call fil6521(cx,n5,c5x,n6)
call timer('fil6521 ',1)
fsample=1378.125/4.
a(5)=dt00
i0=nint((a(5)+0.5)*fsample) - 2 + nadd
if(i0.lt.1) then
i0=1
endif
nz=n6+1-i0
! We're looking only at sync tone here... so why not downsample by another
! factor of 1/8, say? Should be a significant execution speed-up.
call timer('afc65b ',0)
! Best fit for DF, f1, and f2
call afc65b(c5x(i0),nz,fsample,nflip,a,ccfbest,dtbest)
! Best fit for DF, drift, banana-coefficient, and dt. fsample = 344.53125 S/s
dtbest=dt
call afc65b(c5x,n6,fsample,nflip,a,ccfbest,dtbest)
call timer('afc65b ',1)
sync2=3.7e-4*ccfbest/sq0 !Constant is empirical
@@ -53,26 +41,23 @@ subroutine decode65a(dd,npts,newdat,nqd,f0,nflip,mode65,sync2,a,dt, &
! Apply AFC corrections to the time-domain signal
! Now we are back to using the 1378.125 Hz sample rate, enough to
! accommodate the full JT65C bandwidth.
a(3)=0
call timer('twkfreq ',0)
call twkfreq65(cx,n5,a)
call timer('twkfreq ',1)
! Compute spectrum for each half symbol.
! Adding or subtracting a small number (e.g., 5) to j may make it decode.\
! NB: might want to try computing full-symbol spectra (nfft=512, even for
! submodes B and C).
! Compute spectrum for each symbol.
nsym=126
nfft=512
j=(dt00+dtbest+2.685)*1378.125
j=int(dtbest*1378.125)
if(j.lt.0) j=0
c5a=cmplx(0.0,0.0)
call timer('sh_ffts ',0)
do k=1,nsym
do i=1,nfft
j=j+1
c5a(i)=cx(j)
if( j .le. NMAX/8 ) c5a(i)=cx(j)
enddo
call four2a(c5a,nfft,1,1,1)
do i=1,66
@@ -85,8 +70,9 @@ subroutine decode65a(dd,npts,newdat,nqd,f0,nflip,mode65,sync2,a,dt, &
call timer('sh_ffts ',1)
call timer('dec65b ',0)
call decode65b(s2,nflip,mode65,nqd,nbmkv,nhist,decoded)
dt=dt00 + dtbest + 1.7
call decode65b(s2,nflip,mode65,ntrials,naggressive,ndepth,nqd,nsf, &
nhist,decoded)
dt=dtbest !return new, improved estimate of dt
call timer('dec65b ',1)
return
lib/decode65b.f90
+6 -3
View File
@@ -1,4 +1,5 @@
subroutine decode65b(s2,nflip,mode65,nqd,nbmkv,nhist,decoded)
subroutine decode65b(s2,nflip,mode65,ntrials,naggressive,ndepth,nqd, &
nsf,nhist,decoded)
real s2(66,126)
real s3(64,63)
@@ -22,13 +23,15 @@ subroutine decode65b(s2,nflip,mode65,nqd,nbmkv,nhist,decoded)
enddo
nadd=mode65
call extract(s3,nadd,nqd,ncount,nhist,decoded,ltext,nbmkv) !Extract message
call extract(s3,nadd,nqd,ntrials,naggressive,ndepth,ncount,nhist, &
decoded,ltext,nsf) !Extract the message
! Suppress "birdie messages" and other garbage decodes:
if(decoded(1:7).eq.'000AAA ') ncount=-1
if(decoded(1:7).eq.'0L6MWK ') ncount=-1
if(nflip.lt.0 .and. ltext) ncount=-1
if(ncount.lt.0) then
nbmkv=0
nsf=0
decoded=' '
endif
lib/decoder.f90
+13 -5
View File
@@ -13,13 +13,21 @@ subroutine decoder(ss,id2,nfsample)
ntol,kin,nzhsym,nsubmode,nagain,ndepth,ntxmode,nmode,minw,nclearave, &
minsync,emedelay,dttol,nlist,listutc(10),datetime,mycall,mygrid, &
hiscall,hisgrid
common/tracer/limtrace,lu
integer onlevel(0:10)
common/tracer_priv/level,onlevel
!$omp threadprivate(/tracer_priv/)
!$omp threadprivate(/tracer_priv/)
save
n2pass=ndepth/100000
ndepth=ndepth-n2pass*100000
n=ndepth/1000
if(mod(n,2).eq.0) ntrials=10**(n/2)
if(mod(n,2).eq.1) ntrials=3*10**(n/2)
if(n.eq.0) ntrials=0
naggressive=(ndepth - (n*1000))/10
ndepth=mod(ndepth,10)
rms=sqrt(dot_product(float(id2(300000:310000)), &
float(id2(300000:310000)))/10000.0)
if(rms.lt.2.0) go to 800
@@ -55,7 +63,7 @@ subroutine decoder(ss,id2,nfsample)
go to 800
endif
ntol65=20
ntol65=ntol !### is this OK? ###
newdat65=newdat
newdat9=newdat
@@ -70,7 +78,7 @@ subroutine decoder(ss,id2,nfsample)
nf2=nfb
call timer('jt65a ',0)
call jt65a(dd,npts65,newdat65,nutc,nf1,nf2,nfqso,ntol65,nsubmode, &
nagain,ndecoded)
minsync,nagain,n2pass,ntrials,naggressive,ndepth,ndecoded)
call timer('jt65a ',1)
else if(nmode.eq.9 .or. (nmode.eq.(65+9) .and. ntxmode.eq.9)) then
@@ -89,7 +97,7 @@ subroutine decoder(ss,id2,nfsample)
nf2=nfb
call timer('jt65a ',0)
call jt65a(dd,npts65,newdat65,nutc,nf1,nf2,nfqso,ntol65,nsubmode, &
nagain,ndecoded)
minsync,nagain,n2pass,ntrials,naggressive,ndepth,ndecoded)
call timer('jt65a ',1)
else
call timer('decjt9 ',0)
lib/demod64a.f90
+66 -62
View File
@@ -1,62 +1,66 @@
subroutine demod64a(s3,nadd,afac1,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
! Demodulate the 64-bin spectra for each of 63 symbols in a frame.
! Parameters
! nadd number of spectra already summed
! mrsym most reliable symbol value
! mr2sym second most likely symbol value
! mrprob probability that mrsym was the transmitted value
! mr2prob probability that mr2sym was the transmitted value
implicit real*8 (a-h,o-z)
real*4 s3(64,63),afac1
real*8 fs(64)
integer mrsym(63),mrprob(63),mr2sym(63),mr2prob(63)
if(nadd.eq.-999) return
afac=afac1 * float(nadd)**0.64
scale=255.999
! Compute average spectral value
ave=sum(s3)/(64.*63.)
i1=1 !Silence warning
i2=1
! Compute probabilities for most reliable symbol values
do j=1,63
s1=-1.e30
fsum=0.
do i=1,64
x=min(afac*s3(i,j)/ave,50.d0)
fs(i)=exp(x)
fsum=fsum+fs(i)
if(s3(i,j).gt.s1) then
s1=s3(i,j)
i1=i !Most reliable
endif
enddo
s2=-1.e30
do i=1,64
if(i.ne.i1 .and. s3(i,j).gt.s2) then
s2=s3(i,j)
i2=i !Second most reliable
endif
enddo
p1=fs(i1)/fsum !Normalized probabilities
p2=fs(i2)/fsum
mrsym(j)=i1-1
mr2sym(j)=i2-1
mrprob(j)=scale*p1
mr2prob(j)=scale*p2
enddo
nlow=0
do j=1,63
if(mrprob(j).le.5) nlow=nlow+1
enddo
ntest=sum(mrprob)/63.0
return
end subroutine demod64a
subroutine demod64a(s3,nadd,afac1,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
! Demodulate the 64-bin spectra for each of 63 symbols in a frame.
! Parameters
! nadd number of spectra already summed
! mrsym most reliable symbol value
! mr2sym second most likely symbol value
! mrprob probability that mrsym was the transmitted value
! mr2prob probability that mr2sym was the transmitted value
implicit real*8 (a-h,o-z)
real*4 s3(64,63),afac1
real*8 fs(64)
integer mrsym(63),mrprob(63),mr2sym(63),mr2prob(63)
if(nadd.eq.-999) return
afac=afac1 * float(nadd)**0.64
scale=255.999
! Compute average spectral value
ave=sum(s3)/(64.*63.)
i1=1 !Silence warning
i2=1
! Compute probabilities for most reliable symbol values
do j=1,63
s1=-1.e30
fsum=0.
psum=0. ! used for sfrsd metrics
do i=1,64
x=min(afac*s3(i,j)/ave,50.d0)
fs(i)=exp(x)
psum=psum+s3(i,j)
fsum=fsum+fs(i)
if(s3(i,j).gt.s1) then
s1=s3(i,j)
i1=i !Most reliable
endif
enddo
s2=-1.e30
do i=1,64
if(i.ne.i1 .and. s3(i,j).gt.s2) then
s2=s3(i,j)
i2=i !Second most reliable
endif
enddo
! p1=fs(i1)/fsum !Normalized probabilities for kvasd
! p2=fs(i2)/fsum
p1=s1/psum !Use these for sfrsd
p2=s2/psum !
mrsym(j)=i1-1
mr2sym(j)=i2-1
mrprob(j)=scale*p1
mr2prob(j)=scale*p2
enddo
nlow=0
do j=1,63
if(mrprob(j).le.5) nlow=nlow+1
enddo
ntest=sum(mrprob)
return
end subroutine demod64a
lib/ephem.f90
+1 -3
View File
@@ -11,7 +11,7 @@ subroutine ephem(mjd0,dut,east_long,geodetic_lat,height,nspecial, &
real*8 rmeTrue(6) !Include nutation
real*8 raeTrue(6) !Vector from Earth center to Obs at Date
real*8 rmaTrue(6) !Vector from Obs to Moon at Date
logical km,bary,jplok !Set km=.true. to get km, km/s from ephemeris
logical km,bary !Set km=.true. to get km, km/s from ephemeris
common/stcomx/km,bary,pvsun(6) !Common used in JPL subroutines
common/librcom/xl(2),b(2)
@@ -32,8 +32,6 @@ subroutine ephem(mjd0,dut,east_long,geodetic_lat,height,nspecial, &
djtt=mjd + sla_DTT(jd)/86400.d0
ttjd=jd + sla_DTT(jd)/86400.d0
! inquire(file='JPLEPH',exist=jplok)
! if(jplok) then
if(nspecial.ne.8) then
call pleph(ttjd,10,3,rme2000) !RME (J2000) from JPL ephemeris
lib/extract.F90 → lib/extract.f90
+40 -59
View File
@@ -1,4 +1,5 @@
subroutine extract(s3,nadd,nqd,ncount,nhist,decoded,ltext,nbmkv)
subroutine extract(s3,nadd,nqd,ntrials,naggressive,ndepth,ncount,nhist, &
decoded,ltext,nsf)
! Input:
! s3 64-point spectra for each of 63 data symbols
@@ -10,7 +11,7 @@ subroutine extract(s3,nadd,nqd,ncount,nhist,decoded,ltext,nbmkv)
! nhist maximum number of identical symbol values
! decoded decoded message (if ncount >=0)
! ltext true if decoded message is free text
! nbmkv 0=no decode; 1=BM decode; 2=KV decode
! nsf 0=no decode; 1=BM decode; 2=KV decode
use prog_args !shm_key, exe_dir, data_dir
use packjt
@@ -19,29 +20,26 @@ subroutine extract(s3,nadd,nqd,ncount,nhist,decoded,ltext,nbmkv)
character decoded*22
integer dat4(12)
integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
integer correct(63),tmp(63)
integer param(0:7)
integer indx(0:62)
real*8 tt
logical nokv,ltext
common/decstats/num65,numbm,numkv,num9,numfano
common/chansyms65/correct
data nokv/.false./,nsec1/0/
save
nbirdie=7
npct=40
afac1=10.1
xlambda=7.999
if(nqd.eq.1) xlambda=11.999 !Increase depth at QSO frequency
nbmkv=0
nbirdie=20
npct=50
afac1=1.1
nsf=0
nfail=0
decoded=' '
call pctile(s3,4032,npct,base)
s3=s3/base
! Get most reliable and second-most-reliable symbol values, and their
! probabilities
1 call demod64a(s3,nadd,afac1,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
if(ntest.lt.100) then
ncount=-999 !Flag and reject bad data
go to 900
endif
call chkhist(mrsym,nhist,ipk) !Test for birdies and QRM
if(nhist.ge.nbirdie) then
@@ -59,63 +57,46 @@ subroutine extract(s3,nadd,nqd,ncount,nhist,decoded,ltext,nbmkv)
call graycode65(mrsym,63,-1) !Remove gray code
call interleave63(mrsym,-1) !Remove interleaving
call interleave63(mrprob,-1)
num65=num65+1
! Decode using Berlekamp-Massey algorithm
call timer('rs_decod',0)
call rs_decode(mrsym,0,0,dat4,ncount)
call timer('rs_decod',1)
if(ncount.ge.0) then
call unpackmsg(dat4,decoded)
if(iand(dat4(10),8).ne.0) ltext=.true.
nbmkv=1
go to 900
endif
! Berlekamp-Massey algorithm failed, try Koetter-Vardy
if(nokv) go to 900
maxe=8 !Max KV errors in 12 most reliable symbols
call graycode65(mr2sym,63,-1) !Remove gray code and interleaving
call interleave63(mr2sym,-1) !from second-most-reliable symbols
call interleave63(mr2prob,-1)
nsec1=nsec1+1
dat4=0
write(22,rec=1) nsec1,xlambda,maxe,200,mrsym,mrprob,mr2sym,mr2prob
write(22,rec=2) -1,-1,dat4
call flush(22)
call timer('kvasd ',0)
nverbose=0
ntry=0
call timer('sfrsd ',0)
call sfrsd2(mrsym,mrprob,mr2sym,mr2prob,ntrials,nverbose,correct, &
param,indx,tt,ntry)
call timer('sfrsd ',1)
ncandidates=param(0)
nhard=param(1)
nsoft=param(2)
nera=param(3)
ngmd=param(4)
ndone=ndone+1
do i=1,12
dat4(i)=correct(13-i)
enddo
#ifdef WIN32
iret=system('""'//trim(exe_dir)//'/kvasd" "'//trim(temp_dir)//'/kvasd.dat" >"'//trim(temp_dir)//'/dev_null""')
#else
iret=system('"'//trim(exe_dir)//'/kvasd" "'//trim(temp_dir)//'/kvasd.dat" >/dev/null')
#endif
call timer('kvasd ',1)
if(iret.ne.0) then
if(.not.nokv) write(*,1000) iret
1000 format('Error in KV decoder, or no KV decoder present.',i12)
! nokv=.true.
go to 900
endif
read(22,rec=2,err=900) nsec2,ncount,dat4
j=nsec2 !Silence compiler warning
ncount=-1
decoded=' '
ltext=.false.
if(ncount.ge.0) then
if(nhard.ge.0) then
!turn the corrected symbol array into channel symbols for subtraction
!pass it back to jt65a via common block "chansyms65"
do i=1,63
tmp(i)=correct(64-i)
enddo
correct(1:63)=tmp(1:63)
call interleave63(correct,63,1)
call graycode65(correct,63,1)
call unpackmsg(dat4,decoded) !Unpack the user message
if(index(decoded,'...... ').gt.0) then
ncount=-1
go to 900
endif
ncount=0
if(iand(dat4(10),8).ne.0) ltext=.true.
nbmkv=2
nsf=1
endif
900 continue
return
end subroutine extract
lib/fano232.f90
+7 -7
View File
@@ -9,14 +9,14 @@ subroutine fano232(symbol,nbits,mettab,ndelta,maxcycles,dat, &
parameter (MAXBYTES=(MAXBITS+7)/8)
integer*1 symbol(0:2*MAXBITS-1) !Soft symbols (as unsigned i*1)
integer*1 dat(MAXBYTES) !Decoded user data, 8 bits per byte
integer mettab(-128:127,0:1) !Metric table
integer mettab(-128:127,0:1) !Metric table
! These were the "node" structure in Karn's C code:
integer nstate(0:MAXBITS-1) !Encoder state of next node
integer gamma(0:MAXBITS-1) !Cumulative metric to this node
integer metrics(0:3,0:MAXBITS-1) !Metrics indexed by all possible Tx syms
integer tm(0:1,0:MAXBITS-1) !Sorted metrics for current hypotheses
integer ii(0:MAXBITS-1) !Current branch being tested
integer nstate(0:MAXBITS) !Encoder state of next node
integer gamma(0:MAXBITS) !Cumulative metric to this node
integer metrics(0:3,0:MAXBITS) !Metrics indexed by all possible Tx syms
integer tm(0:1,0:MAXBITS) !Sorted metrics for current hypotheses
integer ii(0:MAXBITS) !Current branch being tested
logical noback
include 'conv232.f90' !Polynomials defined here
@@ -69,7 +69,7 @@ subroutine fano232(symbol,nbits,mettab,ndelta,maxcycles,dat, &
gamma(np+1)=ngamma !Move forward
nstate(np+1)=ishft(nstate(np),1)
np=np+1
if(np.eq.nbits-1) go to 100 !We're done!
if(np.eq.nbits) go to 100 !We're done!
n=iand(nstate(np),npoly1)
n=ieor(n,ishft(n,-16))
lib/fast9.f90
+191
View File
@@ -0,0 +1,191 @@
subroutine fast9(id2,narg,line)
! Decoder for "fast9" modes, JT9E to JT9H.
parameter (NMAX=30*12000,NSAVE=500)
integer*2 id2(0:NMAX)
integer narg(0:11)
integer*1 i1SoftSymbols(207)
integer*1 i1save(207,NSAVE)
integer indx(NSAVE)
integer*8 count0,count1,clkfreq
real s1(720000) !To reserve space. Logically s1(nq,jz)
real s2(240,340) !Symbol spectra at quarter-symbol steps
real ss2(0:8,85) !Folded symbol spectra
real ss3(0:7,69) !Folded spectra without sync symbols
real s(1500)
real ccfsave(NSAVE)
real t0save(NSAVE)
real t1save(NSAVE)
real freqSave(NSAVE)
real t(6)
character*22 msg !Decoded message
character*80 line(100)
data nsubmode0/-1/,ntot/0/
save s1,nsubmode0,ntot
! Parameters from GUI are in narg():
nutc=narg(0) !UTC
npts=min(narg(1),NMAX) !Number of samples in id2 (12000 Hz)
nsubmode=narg(2) !0=A 1=B 2=C 3=D 4=E 5=F 6=G 7=H
if(nsubmode.lt.4) go to 900
newdat=narg(3) !1==> new data, compute symbol spectra
minsync=narg(4) !Lower sync limit
npick=narg(5)
t0=0.001*narg(6)
t1=0.001*narg(7)
maxlines=narg(8) !Max # of decodes to return to caller
nmode=narg(9)
nrxfreq=narg(10) !Targer Rx audio frequency (Hz)
ntol=narg(11) !Search range, +/- ntol (Hz)
tmid=npts*0.5/12000.0
line(1:100)(1:1)=char(0)
s=0
s2=0
nsps=60 * 2**(7-nsubmode) !Samples per sysbol
nfft=2*nsps !FFT size
nh=nfft/2
nq=nfft/4
istep=nsps/4 !Symbol spectra at quarter-symbol steps
jz=npts/istep
df=12000.0/nfft !FFT bin width
db1=db(2500.0/df)
nfa=max(200,nrxfreq-ntol) !Lower frequency limit
nfb=min(nrxfreq+ntol,2500) !Upper frequency limit
nline=0
t=0.
if(newdat.eq.1 .or. nsubmode.ne.nsubmode0) then
call system_clock(count0,clkfreq)
call spec9f(id2,npts,nsps,s1,jz,nq) !Compute symbol spectra, s1
call system_clock(count1,clkfreq)
t(1)=t(1)+float(count1-count0)/float(clkfreq)
endif
nsubmode0=nsubmode
tmsg=nsps*85.0/12000.0
limit=2000
nlen0=0
i1=0
i2=0
ccfsave=0.
do ilength=1,14
nlen=1.4142136**(ilength-1)
if(nlen.gt.jz/340) nlen=jz/340
if(nlen.eq.nlen0) cycle
nlen0=nlen
db0=db(float(nlen))
jlen=nlen*340
jstep=jlen/4 !### Is this about right? ###
if(nsubmode.ge.6) jstep=jlen/2
do ja=1,jz-jlen,jstep
jb=ja+jlen-1
call system_clock(count0,clkfreq)
call foldspec9f(s1,nq,jz,ja,jb,s2) !Fold symbol spectra into s2
call system_clock(count1,clkfreq)
t(2)=t(2)+float(count1-count0)/float(clkfreq)
! Find sync; put sync'ed symbol spectra into ss2 and ss3
! Might want to do a peakup in DT and DF, then re-compute symbol spectra.
call system_clock(count0,clkfreq)
call sync9f(s2,nq,nfa,nfb,ss2,ss3,lagpk,ipk,ccfbest)
call system_clock(count1,clkfreq)
t(3)=t(3)+float(count1-count0)/float(clkfreq)
i1=i1+1
if(ccfbest.lt.30.0) cycle
call system_clock(count0,clkfreq)
call softsym9f(ss2,ss3,i1SoftSymbols) !Compute soft symbols
call system_clock(count1,clkfreq)
t(4)=t(4)+float(count1-count0)/float(clkfreq)
i2=i2+1
ccfsave(i2)=ccfbest
i1save(1:207,i2)=i1SoftSymbols
t0=(ja-1)*istep/12000.0
t1=(jb-1)*istep/12000.0
t0save(i2)=t0
t1save(i2)=t1
freq=ipk*df
freqSave(i2)=freq
enddo
enddo
nsaved=i2
ccfsave(1:nsaved)=-ccfsave(1:nsaved)
call system_clock(count0,clkfreq)
indx=0
call indexx(ccfsave,nsaved,indx)
call system_clock(count1,clkfreq)
t(5)=t(5)+float(count1-count0)/float(clkfreq)
ccfsave(1:nsaved)=-ccfsave(1:nsaved)
do iter=1,2
! do isave=1,nsaved
do isave=1,50
i2=indx(isave)
if(i2.lt.1 .or. i2.gt.nsaved) cycle !### Why needed? ###
t0=t0save(i2)
t1=t1save(i2)
if(iter.eq.1 .and. t1.lt.tmid) cycle
if(iter.eq.2 .and. t1.ge.tmid) cycle
ccfbest=ccfsave(i2)
i1SoftSymbols=i1save(1:207,i2)
freq=freqSave(i2)
call system_clock(count0,clkfreq)
call jt9fano(i1SoftSymbols,limit,nlim,msg) !Invoke Fano decoder
call system_clock(count1,clkfreq)
t(6)=t(6)+float(count1-count0)/float(clkfreq)
i=t0*12000.0
kz=(t1-t0)/0.02
smax=0.
do k=1,kz
sq=0.
do n=1,240
i=i+1
x=id2(i)
sq=sq+x*x
enddo
s(k)=sq/240.
smax=max(s(k),smax)
enddo
call pctile(s,kz,35,base)
snr=smax/(1.1*base) - 1.0
nsnr=-20
if(snr.gt.0.0) nsnr=nint(db(snr))
! write(72,3002) nutc,iter,isave,nlen,tmid,t0,t1,ccfbest, &
! nint(freq),nlim,msg
!3002 format(i6.6,i1,i4,i3,4f6.1,i5,i7,1x,a22)
if(msg.ne.' ') then
! Display multiple decodes only if they differ:
do n=1,nline
if(index(line(n),msg).gt.1) go to 100
enddo
!### Might want to use decoded message to get a complete estimate of S/N.
nline=nline+1
write(line(nline),1000) nutc,nsnr,t0,nint(freq),msg,char(0)
1000 format(i6.6,i4,f5.1,i5,1x,'@',1x,a22,a1)
ntot=ntot+1
! write(70,5001) nsaved,isave,nline,maxlines,ntot,nutc,msg
!5001 format(5i5,i7.6,1x,a22)
if(nline.ge.maxlines) go to 900
endif
100 continue
enddo
enddo
900 continue
! write(*,6001) t,t(6)/sum(t)
!6001 format(7f10.3)
return
end subroutine fast9
lib/fast_decode.f90
+79
View File
@@ -0,0 +1,79 @@
subroutine fast_decode(id2,narg,line)
parameter (NMAX=30*12000)
integer*2 id2(NMAX)
integer narg(0:9)
real dat(30*12000)
complex cdat(262145),cdat2(262145)
real psavg(450)
logical pick
character*6 cfile6
character*80 line(100)
save npts
nutc=narg(0)
ndat0=narg(1)
nsubmode=narg(2)
newdat=narg(3)
minsync=narg(4)
npick=narg(5)
t0=0.001*narg(6)
t1=0.001*narg(7)
maxlines=narg(8)
nmode=narg(9)
! call sleep_msec(100) !### TEMPORARY ###
if(nmode.eq.102) then
call fast9(id2,narg,line)
go to 900
else if(nmode.eq.103) then
call jtmsk(id2,narg,line)
go to 900
endif
if(newdat.eq.1) then
cdat2=cdat
ndat=ndat0
call wav11(id2,ndat,dat)
ndat=min(ndat,30*11025)
call ana932(dat,ndat,cdat,npts) !Make downsampled analytic signal
endif
! Now cdat() is the downsampled analytic signal.
! New sample rate = fsample = BW = 11025 * (9/32) = 3100.78125 Hz
! NB: npts, nsps, etc., are all reduced by 9/32
write(cfile6,'(i6.6)') nutc
ntol=400
nfreeze=1
mousedf=0
mousebutton=0
mode4=1
if(nsubmode.eq.1) mode4=2
nafc=0
ndebug=0
t2=0.
ia=1
ib=npts
pick=.false.
if(npick.gt.0) then
pick=.true.
dt=1.0/11025.0 * (32.0/9.0)
ia=t0/dt + 1.
ib=t1/dt + 1.
t2=t0
endif
jz=ib-ia+1
line(1:100)(1:1)=char(0)
if(npick.eq.2) then
call iscat(cdat2(ia),jz,3,40,t2,pick,cfile6,minsync,ntol,NFreeze, &
MouseDF,mousebutton,mode4,nafc,ndebug,psavg,nmax,nlines,line)
else
call iscat(cdat(ia),jz,3,40,t2,pick,cfile6,minsync,ntol,NFreeze, &
MouseDF,mousebutton,mode4,nafc,ndebug,psavg,maxlines,nlines,line)
endif
900 return
end subroutine fast_decode
lib/fchisq65.f90
+9 -11
View File
@@ -17,7 +17,7 @@ real function fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax)
nout=ndiv*npts/nsps
dtstep=1.0/(ndiv*baud) !Time per output step
if(a(1).ne.a1 .or. a(2).ne.a2 .or. a(3).ne.a3) then
if(a(1).ne.a1 .or. a(2).ne.a2 .or. a(3).ne.a3) then
a1=a(1)
a2=a(2)
a3=a(3)
@@ -32,37 +32,35 @@ real function fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax)
if(mod(i,100).eq.1) then
p2=1.5*x*x - 0.5
dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/fsample)
wstep=cmplx(cos(dphi),sin(dphi))
wstep=cmplx(cos(dphi),sin(dphi))
endif
w=w*wstep
csx(i)=csx(i-1) + w*cx(i)
enddo
endif
! Compute 1/2-symbol powers at 1/16-symbol steps.
! Compute whole-symbol powers at 1/16-symbol steps.
fac=1.e-4
do i=1,nout
j=i*nsps/ndiv
k=j-nsph
j=nsps+(i-1)*nsps/16 !steps by 8 samples (1/16 of a symbol)
k=j-nsps
ss(i)=0.
if(k.ge.1) then
z=csx(j)-csx(k)
if(k.ge.0) then
z=csx(j)-csx(k) ! difference over span of 128 pts
ss(i)=fac*(real(z)**2 + aimag(z)**2)
endif
enddo
ccfmax=0.
call timer('ccf2 ',0)
call ccf2(ss,nout,nflip,ccf,lagpk)
call ccf2(ss,nout,nflip,ccf,xlagpk)
call timer('ccf2 ',1)
if(ccf.gt.ccfmax) then
ccfmax=ccf
dtmax=lagpk*dtstep
dtmax=xlagpk*dtstep
endif
fchisq65=-ccfmax
call timer('fchisq65',1)
return
end function fchisq65
lib/fixwav.f90
+66
View File
@@ -0,0 +1,66 @@
program fixwav
use wavhdr
parameter (NBANDS=23,NMODES=11)
parameter(NMAX=120*12000)
type(hdr) h
integer*2 id2(NMAX),id(4)
character*8 mode,mode0
character*6 band
character*12 arg
character*80 infile
character*1 c
logical ok
nargs=iargc()
if(nargs.ne.1 .and. nargs.ne.5) then
print*,'Usage: fixwav [fMHz mode submode TRperiod] infile'
go to 999
endif
call getarg(1,infile)
if(nargs.eq.1) go to 10
read(infile,*) fMHz
call getarg(2,mode0)
call getarg(3,arg)
nsubmode0=-1
do i=1,8
if(arg(1:1).eq.char(ichar('A')-1+i)) nsubmode0=i
enddo
if(nsubmode0.lt.0) read(arg,*) nsubmode0
call getarg(4,arg)
read(arg,*) ntrperiod0
call getarg(5,infile)
10 open(10,file=infile,status='old',access='stream')
read(10) h
npts=h%ndata/2
nfsample=h%nsamrate
read(10) id2(1:npts)
write(*,1002) h%nchan2,h%nbitsam2,h%nsamrate,npts
1002 format('Channels:',i2,' Bits/sample:',i3,' Sample rate:',i6, &
' Npts:',i8)
call get_wsjtx_wav_params(id2,band,mode,nsubmode,ntrperiod,ok)
if(nfsample.ne.11025 .and. nfsample.ne.12000) ok=.false.
if(ok) write(*,1010) band,ntrperiod,mode,char(ichar('A')-1+id2(3))
1010 format('Band: ',a6,' T/R period:',i4,' Mode: ',a8,1x,a1)
if(.not.ok) write(*,'(a)') 'File has no valid WSJT-X params.'
if(ok .and. nargs.eq.1) go to 999
write(*,'(a)',advance='no') 'Do you want to add or change them? (Y/N): '
read*,c
if(c.ne.'y' .and. c.ne.'Y') go to 999
print*,fMHz,mode0,nsubmode0,ntrperiod0
call set_wsjtx_wav_params(fMHz,mode0,nsubmode0,ntrperiod0,id2)
band=""
mode=""
nsubmode=0
ntrperiod=0
call get_wsjtx_wav_params(id2,band,mode,nsubmode,ntrperiod,ok)
write(*,1010) band,ntrperiod,mode,char(ichar('A')-1+id2(3))
rewind 10
write(10) h,id2(1:npts)
999 end program fixwav
lib/flat4.f90
+2 -2
View File
@@ -22,7 +22,7 @@ subroutine flat4(s,npts0,nflatten)
nlen=npts/nseg !Length of test segment
i0=npts/2 !Midpoint
k=0
do n=2,nseg !Skip first segment, likely rolloff here
do n=1,nseg !Skip first segment, likely rolloff here
ib=n*nlen
ia=ib-nlen+1
if(n.eq.nseg) ib=npts
@@ -37,7 +37,7 @@ subroutine flat4(s,npts0,nflatten)
enddo
kz=k
a=0.
nterms=3
nterms=5
call polyfit(x,y,y,kz,nterms,0,a,chisqr) !Fit a low-order polynomial
lib/foldspec9f.f90
+30
View File
@@ -0,0 +1,30 @@
subroutine foldspec9f(s1,nq,jz,ja,jb,s2)
! Fold symbol spectra (quarter-symbol steps) from s1 into s2
real s1(nq,jz)
real s2(240,340) !340 = 4*85
integer nsum(340)
s2=0.
nsum=0
do j=ja,jb
k=mod(j-1,340)+1
nsum(k)=nsum(k)+1
do i=1,NQ
s2(i,k)=s2(i,k) + s1(i,j)
enddo
enddo
do k=1,340
fac=1.0
if(nsum(k).gt.0) fac=1.0/nsum(k)
s2(1:nq,k)=fac*s2(1:nq,k)
enddo
ave=sum(s2)/(340.0*nq)
if(ave.gt.0.0) s2=s2/ave
return
end subroutine foldspec9f
lib/geniscat.f90
+55
View File
@@ -0,0 +1,55 @@
subroutine geniscat(msg,msgsent,itone)
! Generate an ISCAT waveform.
parameter (NSZ=1291)
character msg*28,msgsent*28 !Message to be transmitted
integer imsg(30)
integer itone(NSZ)
real*8 sps
character c*42
integer icos(4) !Costas array
data icos/0,1,3,2/
data nsync/4/,nlen/2/,ndat/18/
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ /.?@-'/
sps=256.d0*12000.d0/11025.d0
nsym=int(30*12000.d0/sps)
nblk=nsync+nlen+ndat
do i=22,1,-1
if(msg(i:i).ne.' ' .and. msg(i:i).ne.char(0)) exit
enddo
nmsg=i
msglen=nmsg+1
k=0
kk=1
imsg(1)=40 !Always start with BOM char: '@'
do i=1,nmsg !Define the tone sequence
imsg(i+1)=36 !Illegal char set to blank
do j=1,42
if(msg(i:i).eq.c(j:j)) imsg(i+1)=j-1
enddo
enddo
do i=1,nsym !Total symbols in 30 s
j=mod(i-1,nblk)+1
if(j.le.nsync) then
itone(i)=icos(j) !Insert 4x4 Costas array
else if(j.gt.nsync .and. j.le.nsync+nlen) then
itone(i)=msglen !Insert message-length indicator
if(j.ge.nsync+2) then
n=msglen + 5*(j-nsync-1)
if(n.gt.41) n=n-42
itone(i)=n
endif
else
k=k+1
kk=mod(k-1,msglen)+1
itone(i)=imsg(kk)
endif
enddo
msgsent=msg
return
end subroutine geniscat
lib/genmsk.f90
+100
View File
@@ -0,0 +1,100 @@
subroutine genmsk(msg0,ichk,msgsent,i4tone,itype)
! Encode a JTMSK message
! Input:
! - msg0 requested message to be transmitted
! - ichk if nonzero, return only msgsent
! - msgsent message as it will be decoded
! - i4tone array of audio tone values, 0 or 1
! - itype message type
! 1 = standard message <call1> <call2> <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)
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
integer*4 i4Msg6BitWords(13) !72-bit message as 6-bit words
integer*1, target:: i1Msg8BitBytes(13) !72 bits and zero tail as 8-bit bytes
integer*1 e1(198) !Encoded bits before re-ordering
integer*1 i1EncodedBits(198) !Encoded information-carrying bits
integer i4tone(234) !Tone #s, data and sync (values 0-1)
integer*1 i1hash(4)
integer b11(11)
data b11/1,1,1,0,0,0,1,0,0,1,0/ !Barker 11 code
equivalence (ihash,i1hash)
save
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
call packmsg(message,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent
if(ichk.ne.0) go to 999
call entail(i4Msg6BitWords,i1Msg8BitBytes) !Add tail, make 8-bit bytes
ihash=nhash(c_loc(i1Msg8BitBytes),int(9,c_size_t),146)
ihash=2*iand(ihash,32767) !Generate the CRC
i1Msg8BitBytes(10)=i1hash(2) !CRC to bytes 10 and 11
i1Msg8BitBytes(11)=i1hash(1)
nsym=198 !(72+12+15)*2 = 198
kc=13
nc=2
nbits=87
call enc213(i1Msg8BitBytes,nbits,e1,nsym,kc,nc) !Encode the message
j=0
do i=1,nsym/2 !Reorder the encoded bits
j=j+1
i1EncodedBits(j)=e1(2*i-1)
i1EncodedBits(j+99)=e1(2*i)
enddo
! Insert three Barker 11 codes and three "even-f0-parity" bits
i4tone=0 !Start with all 0's
n1=35
n2=69
n3=94
i4tone(1:11)=b11 !11 sync bits
i4tone(11+1:11+n1)=i1EncodedBits(1:n1) !n1 data bits
nn1=count(i4tone(11+1:11+n1).eq.0) !Count the 0's
if(mod(nn1,2).eq.0) i4tone(12+n1)=1 !1 parity bit
i4tone(13+n1:23+n1)=b11 !11 sync bits
i4tone(23+n1+1:23+n1+n2)=i1EncodedBits(n1+1:n1+n2) !n2 data bits
nn2=count(i4tone(23+n1+1:23+n1+n2).eq.0) !Count the 0's
if(mod(nn2,2).eq.0) i4tone(24+n1+n2)=1 !1 parity bit
i4tone(25+n1+n2:35+n1+n2)=b11 !11 sync bits
i4tone(35+n1+n2+1:35+n1+n2+n3)=i1EncodedBits(n1+n2+1:n1+n2+n3)!n3 data bits
nn3=count(i4tone(35+n1+n2+1:35+n1+n2+n3).eq.0) !Count the 0's
if(mod(nn3,2).eq.0) i4tone(36+n1+n2+n3)=1 !1 parity bit
endif
n=count(i4tone.eq.0)
if(mod(n,2).ne.0) stop 'Parity error in genmsk.'
999 return
end subroutine genmsk
lib/hash.f90
+5 -10
View File
@@ -1,15 +1,10 @@
subroutine hash(string,len,ihash)
use iso_c_binding, only: c_loc,c_size_t
use hashing
parameter (MASK15=32767)
character*(*) string
integer*1 ic(12)
do i=1,len
ic(i)=ichar(string(i:i))
enddo
i=nhash(ic,len,146)
! character*(*), target :: string
character*1, target :: string
i=nhash(c_loc(string),int(len,c_size_t),146)
ihash=iand(i,MASK15)
! print*,'C',ihash,len,string
return
end subroutine hash
lib/hashing.f90
+10
View File
@@ -0,0 +1,10 @@
module hashing
interface
integer(c_int32_t) function nhash (key, length, initval) bind(C, name="nhash")
use iso_c_binding, only: c_ptr, c_size_t, c_int32_t
type(c_ptr), intent(in), value :: key
integer(c_size_t), intent(in), value :: length
integer(c_int32_t), intent(in), value :: initval
end function nhash
end interface
end module hashing
lib/hspec.f90
+59
View File
@@ -0,0 +1,59 @@
subroutine hspec(id2,k,ingain,green,s,jh)
! Input:
! k pointer to the most recent new data
! Output:
! green() power
! s() spectrum for horizontal spectrogram
! jh index of most recent data in green(), s()
parameter (JZ=703)
integer*2 id2(0:120*12000-1)
real green(0:JZ-1)
real s(0:63,0:JZ-1)
real x(512)
complex cx(0:256)
data rms/999.0/,k0/99999999/
equivalence (x,cx)
save ja,rms0
gain=10.0**(0.1*ingain)
nfft=512
if(k.gt.30*12000) go to 900
if(k.lt.nfft) then
jh=0
go to 900 !Wait for enough samples to start
endif
if(k.lt.k0) then !Start a new data block
ja=0
jh=-1
rms0=0.0
endif
do iblk=1,7
if(jh.lt.JZ-1) jh=jh+1
jb=ja+nfft-1
x=id2(ja:jb)
sq=dot_product(x,x)
rms=sqrt(gain*sq/nfft)
green(jh)=0.
if(rms.gt.0.0) green(jh)=20.0*log10(0.5*(rms0+rms))
rms0=rms
call four2a(x,nfft,1,-1,0) !Real-to-complex FFT
df=12000.0/nfft
fac=(1.0/nfft)**2
do i=1,64
j=2*i
sx=real(cx(j))**2 + aimag(cx(j))**2 + real(cx(j-1))**2 + &
aimag(cx(j-1))**2
s(i-1,jh)=fac*gain*sx
enddo
if(ja+2*nfft.gt.k) exit
ja=ja+nfft
enddo
k0=k
900 return
end subroutine hspec
lib/indexx.f90
+1 -1
View File
@@ -2,7 +2,7 @@ subroutine indexx(arr,n,indx)
parameter (M=7,NSTACK=50)
integer n,indx(n)
integer arr(n)
real arr(n)
integer i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK)
real a
lib/iscat.f90
+204
View File
@@ -0,0 +1,204 @@
subroutine iscat(cdat0,npts0,nh,npct,t2,pick,cfile6,minsync,ntol, &
NFreeze,MouseDF,mousebutton,mode4,nafc,nmore,psavg,maxlines,nlines,line)
! Decode an ISCAT signal
parameter (NMAX=30*3101)
parameter (NSZ=4*1400)
character cfile6*6 !File time
character c42*42
character msg*29,msg1*29,msgbig*29
character*80 line(100)
character csync*1
complex cdat0(NMAX)
complex cdat(NMAX)
real s0(288,NSZ)
real fs1(0:41,30)
real psavg(72) !Average spectrum of whole file
integer nsum(30)
integer ntol
integer icos(4)
logical pick,last
data icos/0,1,3,2/
data nsync/4/,nlen/2/,ndat/18/
data c42/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ /.?@-'/
nlines = 0
fsample=3100.78125 !Sample rate after 9/32 downsampling
nsps=144/mode4
bigworst=-1.e30 !Silence compiler warnings ...
bigxsync=0.
bigsig=-1.e30
msglenbig=0
ndf0big=0
nfdotbig=0
bigt2=0.
bigavg=0.
bigtana=0.
if(nmore.eq.-999) bigsig=-1 !... to here
last=.false.
do inf=1,6 !Loop over data-segment sizes
nframes=2**inf
if(nframes*24*nsps.gt.npts0) then
nframes=npts0/(24*nsps)
last=.true.
endif
npts=nframes*24*nsps
do ia=1,npts0-npts,nsps*24 !Loop over start times stepped by 1 frame
ib=ia+npts-1
cdat(1:npts)=cdat0(ia:ib)
t3=(ia + 0.5*npts)/fsample + 0.9
if(pick) t3=t2+t3
! Compute symbol spectra and establish sync:
call synciscat(cdat,npts,nh,npct,s0,jsym,df,ntol,NFreeze, &
MouseDF,mousebutton,mode4,nafc,psavg,xsync,sig,ndf0,msglen, &
ipk,jpk,idf,df1)
nfdot=nint(idf*df1)
isync=xsync
if(msglen.eq.0 .or. isync.lt.max(minsync,0)) then
msglen=0
worst=1.
avg=1.
ndf0=0
cycle
endif
ipk3=0 !Silence compiler warning
nblk=nsync+nlen+ndat
fs1=0.
nsum=0
nfold=jsym/96
jb=96*nfold
k=0
n=0
do j=jpk,jsym,4 !Fold information symbols into fs1
k=k+1
km=mod(k-1,nblk)+1
if(km.gt.6) then
n=n+1
m=mod(n-1,msglen)+1
ii=nint(idf*float(j-jb/2)/float(jb))
do i=0,41
iii=ii+ipk+2*i
if(iii.ge.1 .and. iii.le.288) fs1(i,m)=fs1(i,m) + s0(iii,j)
enddo
nsum(m)=nsum(m)+1
endif
enddo
do m=1,msglen
fs1(0:41,m)=fs1(0:41,m)/nsum(m)
enddo
! Read out the message contents:
msg= ' '
msg1=' '
mpk=0
worst=9999.
sum=0.
do m=1,msglen
smax=0.
smax2=0.
do i=0,41
if(fs1(i,m).gt.smax) then
smax=fs1(i,m)
ipk3=i
endif
enddo
do i=0,41
if(fs1(i,m).gt.smax2 .and. i.ne.ipk3) smax2=fs1(i,m)
enddo
rr=0.
if(smax2.gt.0.0) rr=smax/smax2
sum=sum + rr
if(rr.lt.worst) worst=rr
if(ipk3.eq.40) mpk=m
msg1(m:m)=c42(ipk3+1:ipk3+1)
enddo
avg=sum/msglen
if(mpk.eq.1) then
msg=msg1(2:)
else if(mpk.lt.msglen) then
msg=msg1(mpk+1:msglen)//msg1(1:mpk-1)
else
msg=msg1(1:msglen-1)
endif
ttot=npts/3100.78125
if(worst.gt.bigworst) then
bigworst=worst
bigavg=avg
bigxsync=xsync
bigsig=sig
ndf0big=ndf0
nfdotbig=nfdot
msgbig=msg
msglenbig=msglen
bigt2=t3
bigtana=nframes*24*nsps/fsample
endif
isync = xsync
if(navg.gt.0 .and. isync.ge.max(minsync,0) .and. maxlines.ge.2) then
nsig=nint(sig)
nworst=10.0*(worst-1.0)
navg=10.0*(avg-1.0)
if(nworst.gt.10) nworst=10
if(navg.gt.10) navg=10
tana=nframes*24*nsps/fsample
csync=' '
if(isync.ge.1) csync='*'
if(nlines.le.maxlines-1) nlines = nlines + 1
write(line(nlines),1020) cfile6,isync,nsig,t2,ndf0,nfdot,csync, &
msg(1:28),msglen,nworst,navg,tana,char(0)
endif
enddo
if(last) exit
enddo
worst=bigworst
avg=bigavg
xsync=bigxsync
sig=bigsig
ndf0=ndf0big
nfdot=nfdotbig
msg=msgbig
msglen=msglenbig
t2=bigt2
tana=bigtana
isync=xsync
nworst=10.0*(worst-1.0)
navg=10.0*(avg-1.0)
if(nworst.gt.10) nworst=10
if(navg.gt.10) navg=10
if(navg.le.0 .or. isync.lt.max(minsync,0)) then
msg=' '
nworst=0
navg=0
ndf0=0
nfdot=0
sig=-20
msglen=0
tana=0.
t2=0.
endif
csync=' '
if(isync.ge.1) csync='*'
nsig=nint(sig)
if(nlines.le.maxlines-1) nlines = nlines + 1
write(line(nlines),1020) cfile6,isync,nsig,t2,ndf0,nfdot,csync,msg(1:28), &
msglen,nworst,navg,tana,char(0)
1020 format(a6,2i4,f5.1,i5,i4,1x,a1,2x,a28,i4,2i3,f5.1,a1)
return
end subroutine iscat
lib/jplsubs.f
+2 -1
View File
@@ -52,6 +52,7 @@ C IF 'INQUIRE' DOES NOT WORK, USUALLY IRECSZ WILL BE LEFT AT 0
. ' INQUIRE STATEMENT PROBABLY DID NOT WORK'
KSIZE=IRECSZ/NRECL
if(nrfile.eq.-99) stop !silence compiler warning
RETURN
@@ -290,7 +291,7 @@ C (SEE THE DISCUSSION IN THE SUBROUTINE STATE)
11 IF(FIRST) CALL STATE(ZIPS,LIST,PVST,PNUT)
FIRST=.FALSE.
96 IF(NTARG .EQ. NCENT) RETURN
IF(NTARG .EQ. NCENT) RETURN
DO I=1,12
LIST(I)=0
lib/jt4sim.f90
+2
View File
@@ -42,6 +42,8 @@ program jt4sim
npts=60*12000
sps=12000.d0/4.375d0 !2742.857...
f0=1000.d0 !Frequency of lowest tone (Hz)
freq=f0 !Silence compiler warning
dphi=0.0 !Silence compiler warning
h=default_header(12000,npts)
lib/jt65.f90
+58 -30
View File
@@ -2,67 +2,95 @@ program jt65
! Test the JT65 decoder for WSJT-X
use options
character c
logical :: display_help=.false.,err
parameter (NZMAX=60*12000)
integer*4 ihdr(11)
integer*2 id2(NZMAX)
real*4 dd(NZMAX)
character*80 infile
integer*2 nfmt2,nchan2,nbitsam2,nbytesam2
character*4 ariff,awave,afmt,adata
common/hdr/ariff,lenfile,awave,afmt,lenfmt,nfmt2,nchan2, &
nsamrate,nbytesec,nbytesam2,nbitsam2,adata,ndata
character(len=500) optarg
common/tracer/limtrace,lu
equivalence (lenfile,ihdr(2))
type (option) :: long_options(3) = [ &
option ('help',.false.,'h','Display this help message',''), &
option ('ntrials',.true.,'n','default=1000',''), &
option ('single-signal mode',.false.,'s','default=1000','') ]
limtrace=0
lu=12
ntol=50
nfqso=1270
nagain=0
nsubmode=0
ntrials=10000
nlow=200
nhigh=4000
n2pass=2
do
call getopt('hn:s',long_options,c,optarg,narglen,nstat,noffset,nremain,err)
if( nstat .ne. 0 ) then
exit
end if
select case (c)
case ('h')
display_help = .true.
case ('n')
read (optarg(:narglen), *) ntrials
case ('s')
nlow=1250
nhigh=1290
n2pass=1
end select
end do
nargs=iargc()
if(nargs.lt.1) then
print*,'Usage: jt65 file1 [file2 ...]'
if(display_help .or. (nargs.lt.1)) then
print*,'Usage: jt65 [-n ntrials] [-s] file1 [file2 ...]'
print*,' -s single-signal mode'
go to 999
endif
limtrace=0
lu=12
newdat=1
ntol=50
nfa=2700
! nfb=4000
nfqso=933
nagain=0
open(12,file='timer.out',status='unknown')
open(22,file='kvasd.dat',access='direct',recl=1024,status='unknown')
call timer('jt65 ',0)
ndecoded=0
do ifile=1,nargs
call getarg(ifile,infile)
newdat=1
nfa=nlow
nfb=nhigh
call getarg(ifile+noffset,infile)
if( infile.eq.'' ) goto 900
open(10,file=infile,access='stream',status='old',err=998)
call timer('read ',0)
read(10) ihdr
nutc=ihdr(1) !Silence compiler warning
i1=index(infile,'.wav')
read(infile(i1-4:i1-1),*,err=10) nutc
go to 20
10 nutc=0
20 npts=52*12000
if( i1 .eq. 0 ) i1=index(infile,'.WAV')
read(infile(i1-4:i1-1),*,err=998) nutc
npts=52*12000
read(10) id2(1:npts)
call timer('read ',1)
dd(1:npts)=id2(1:npts)
dd(npts+1:)=0.
call timer('jt65a ',0)
call jt65a(dd,npts,newdat,nutc,ntol,nfa,nfqso,nagain,ndecoded)
! open(56,file='subtracted.wav',access='stream',status='unknown')
! write(56) ihdr(1:11)
call jt65a(dd,npts,newdat,nutc,nfa,nfb,nfqso,ntol,nsubmode, &
minsync,nagain,n2pass,ntrials, naggressive,ndepth,ndecoded)
call timer('jt65a ',1)
enddo
call timer('jt65 ',1)
900 call timer('jt65 ',1)
call timer('jt65 ',101)
call four2a(a,-1,1,1,1) !Free the memory used for plans
call filbig(a,-1,1,0.0,0,0,0,0,0) ! (ditto)
! call four2a(a,-1,1,1,1) !Free the memory used for plans
! call filbig(a,-1,1,0.0,0,0,0,0,0) ! (ditto)
go to 999
998 print*,'Cannot open file:'
998 print*,'Cannot read from file:'
print*,infile
999 end program jt65
lib/jt65a.f90
+119 -82
View File
@@ -1,106 +1,143 @@
subroutine jt65a(dd0,npts,newdat,nutc,nf1,nf2,nfqso,ntol,nsubmode, &
nagain,ndecoded)
minsync,nagain,n2pass,ntrials,naggressive,ndepth,ndecoded)
! Process dd() data to find and decode JT65 signals.
! Process dd0() data to find and decode JT65 signals.
parameter (NSZ=3413)
parameter (NZMAX=60*12000)
parameter (NFFT=8192)
parameter (NSZ=3413,NZMAX=60*12000)
parameter (NFFT=1000)
real dd0(NZMAX)
real dd(NZMAX)
real*4 ss(322,NSZ)
real*4 savg(NSZ)
logical done(NSZ)
! integer*2 id2(NZMAX)
real ss(322,NSZ)
real savg(NSZ)
real a(5)
character decoded*22
common/decstats/num65,numbm,numkv,num9,numfano
character*22 decoded,decoded0
type candidate
real freq
real dt
real sync
end type candidate
type(candidate) ca(300)
type decode
real freq
real dt
real sync
character*22 decoded
end type decode
type(decode) dec(30)
common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano
common/steve/thresh0
save
dd=0.
tskip=2.0
nskip=12000*tskip
dd(1+nskip:npts+nskip)=dd0(1:npts)
npts=npts+nskip
dd=dd0
ndecoded=0
if(newdat.ne.0) then
do ipass=1,n2pass ! 2-pass decoding loop
newdat=1
if(ipass.eq.1) then !first-pass parameters
thresh0=2.5 ! use thresh0=2.0 for -24dB files when using 1-bit sync ccf
nsubtract=1
elseif( ipass.eq.2 ) then !second-pass parameters
thresh0=2.5
nsubtract=0
endif
if(n2pass.lt.2) nsubtract=0
! if(newdat.ne.0) then
call timer('symsp65 ',0)
ss=0.
call symspec65(dd,npts,ss,nhsym,savg) !Get normalized symbol spectra
call timer('symsp65 ',1)
endif
! endif
nfa=nf1
nfb=nf2
! nfa=max(200,nfqso-ntol)
! nfb=min(4000,nfqso+ntol)
df=12000.0/NFFT !df = 12000.0/16384 = 0.732 Hz
ftol=16.0 !Frequency tolerance (Hz)
mode65=2**nsubmode
done=.false.
freq0=-999.
ncand=0
nrobust=0 ! controls use of robust correlation estimator in sync65
call timer('sync65 ',0)
call sync65(ss,nfa,nfb,nhsym,ca,ncand,nrobust) !Get a list of JT65 candidates
call timer('sync65 ',1)
do nqd=1,0,-1
if(nqd.eq.1) then !Quick decode, at fQSO
fa=nfqso - ntol
fb=nfqso + ntol
else !Wideband decode at all freqs
fa=nf1
fb=nf2
endif
ia=max(51,nint(fa/df))
ib=min(NSZ-51,nint(fb/df))
thresh0=1.5
! When AGC threshold is set too low, noise will suddenly quiet when a strong
! signal starts up. This causes a lot of false syncs, and bogs down the decoder.
! If 1-bit correlation doesn't tame the resulting false syncs then, as a last
! resort, drop down to nrials=100.
if(ncand.ge.50) then
ncand=0
nrobust=1
call timer('sync65 ',0)
call sync65(ss,nfa,nfb,nhsym,ca,ncand,nrobust) !Get a list of JT65 candidates
call timer('sync65 ',1)
endif
!write(*,*) 'ncand',ncand
nvec=ntrials
if(ncand.gt.75) then
! write(*,*) 'Pass ',ipass,' ncandidates too large ',ncand
nvec=100
endif
do i=ia,ib !Search over freq range
freq=i*df
if(savg(i).lt.thresh0 .or. done(i)) cycle
df=12000.0/NFFT !df = 12000.0/8192 = 1.465 Hz
mode65=2**nsubmode
nflip=1 !### temporary ###
nqd=0
decoded0=""
call timer('ccf65 ',0)
call ccf65(ss(1,i),nhsym,savg(i),sync1,dt,flipk,syncshort,snr2,dt2)
call timer('ccf65 ',1)
do icand=1,ncand
freq=ca(icand)%freq
dtx=ca(icand)%dt
sync1=ca(icand)%sync
ftest=abs(freq-freq0)
thresh1=1.0
if(nqd.eq.1 .and. ntol.le.100) thresh1=0.
if(sync1.lt.thresh1 .or. ftest.lt.ftol) cycle
if(ipass.eq.1) ntry65a=ntry65a + 1
if(ipass.eq.2) ntry65b=ntry65b + 1
call timer('decod65a',0)
call decode65a(dd,npts,newdat,nqd,freq,nflip,mode65,nvec, &
naggressive,ndepth,sync2,a,dtx,nsf,nhist,decoded)
call timer('decod65a',1)
!write(*,*) icand,freq+a(1),dtx,sync1,sync2
if(decoded.eq.decoded0) cycle !Don't display dupes
nflip=nint(flipk)
call timer('decod65a',0)
call decode65a(dd,npts,newdat,nqd,freq,nflip,mode65,sync2,a,dt, &
nbmkv,nhist,decoded)
call timer('decod65a',1)
ftest=abs(freq+a(1)-freq0)
if(ftest.lt.ftol) cycle
if(decoded.ne.' ') then
ndecoded=1
nfreq=nint(freq+a(1))
ndrift=nint(2.0*a(2))
s2db=10.0*log10(sync2) - 32 !### empirical (was 40) ###
nsnr=nint(s2db)
if(nsnr.lt.-30) nsnr=-30
if(nsnr.gt.-1) nsnr=-1
dt=dt-tskip
if(nbmkv.eq.1) numbm=numbm+1
if(nbmkv.eq.2) numkv=numkv+1
if(decoded.ne.' ' .or. minsync.lt.0) then
if( nsubtract .eq. 1 ) then
call timer('subtr65 ',0)
call subtract65(dd,npts,freq,dtx)
call timer('subtr65 ',1)
endif
nfreq=nint(freq+a(1))
ndrift=nint(2.0*a(2))
s2db=10.0*log10(sync2) - 35 !### empirical ###
nsnr=nint(s2db)
if(nsnr.lt.-30) nsnr=-30
if(nsnr.gt.-1) nsnr=-1
! Serialize writes - see also decjt9.f90
!$omp critical(decode_results)
write(*,1010) nutc,nsnr,dt,nfreq,decoded
1010 format(i4.4,i4,f5.1,i5,1x,'#',1x,a22)
write(13,1012) nutc,nint(sync1),nsnr,dt,float(nfreq),ndrift, &
decoded,nbmkv
1012 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT65',i4)
call flush(6)
call flush(13)
!$omp end critical(decode_results)
freq0=freq+a(1)
i2=min(NSZ,i+15) !### ??? ###
done(i:i2)=.true.
!$omp critical(decode_results)
ndupe=0 ! de-dedupe
do i=1, ndecoded
if( decoded==dec(i)%decoded ) ndupe=1
enddo
if(ndupe.ne.1) then
if(ipass.eq.1) n65a=n65a + 1
if(ipass.eq.2) n65b=n65b + 1
ndecoded=ndecoded+1
dec(ndecoded)%freq=freq+a(1)
dec(ndecoded)%dt=dtx
dec(ndecoded)%sync=sync2
dec(ndecoded)%decoded=decoded
write(*,1010) nutc,nsnr,dtx-1.0,nfreq,decoded
1010 format(i4.4,i4,f5.1,i5,1x,'#',1x,a22)
write(13,1012) nutc,nint(sync1),nsnr,dtx-1.0,float(nfreq),ndrift, &
decoded,nsf
1012 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT65',i4)
call flush(6)
call flush(13)
endif
enddo
if(nagain.eq.1) exit
enddo
!$omp end critical(decode_results)
endif
enddo !candidate loop
if(ndecoded.lt.1) exit
enddo !two-pass loop
return
end subroutine jt65a
lib/jt65sim.f90
+131
View File
@@ -0,0 +1,131 @@
program jt65sim
! Generate simulated data for testing of WSJT-X
use wavhdr
use packjt
parameter (NTMAX=54)
parameter (NMAX=NTMAX*12000)
type(hdr) h
integer*2 iwave(NMAX) !Generated waveform (no noise)
integer*4 itone(126) !Channel symbols (values 0-65)
integer dgen(12),sent(63)
real*4 dat(NMAX)
real*8 f0,dt,twopi,phi,dphi,baud,fsample,freq,sps
character msg*22,arg*8,fname*11,csubmode*1
integer nprc(126)
data nprc/1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, &
0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, &
0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, &
0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, &
1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, &
0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, &
1,1,1,1,1,1/
nargs=iargc()
if(nargs.ne.5) then
print*,'Usage: jt65sim mode nRay nsigs SNR nfiles'
print*,'Example: jt65sim B 0 10 -24 1'
print*,'Enter SNR = 0 to generate a range of SNRs.'
go to 999
endif
csubmode='A'
call getarg(1,csubmode)
mode65=1
if(csubmode.eq.'B') mode65=2
if(csubmode.eq.'C') mode65=4
call getarg(2,arg)
read(arg,*) nRay !1 ==> Rayleigh fading
call getarg(3,arg)
read(arg,*) nsigs !Number of signals in each file
call getarg(4,arg)
read(arg,*) snrdb !S/N in dB (2500 hz reference BW)
call getarg(5,arg)
read(arg,*) nfiles !Number of files
rmsdb=25.
rms=10.0**(0.05*rmsdb)
fsample=12000.d0 !Sample rate (Hz)
dt=1.d0/fsample !Sample interval (s)
twopi=8.d0*atan(1.d0)
npts=54*12000
baud=11025.d0/4096.d0
sps=12000.d0/baud !Samples per symbol, at fsample=12000 Hz
nsym=126
h=default_header(12000,npts)
do ifile=1,nfiles !Loop over all files
nmin=ifile
ihr=nmin/60
imin=mod(nmin,60)
write(fname,1002) ihr,imin !Output filename
1002 format('000000_',2i2.2)
open(10,file=fname//'.wav',access='stream',status='unknown')
if(snrdb.lt.90) then
do i=1,npts
dat(i)=gran() !Generate AWGN
enddo
else
dat(1:npts)=0.
endif
dfsig=2000.0/nsigs
do isig=1,nsigs
if(mod(nsigs,2).eq.0) f0=1500.0 + dfsig*(isig-0.5-nsigs/2)
if(mod(nsigs,2).eq.1) f0=1500.0 + dfsig*(isig-(nsigs+1)/2)
nsnr=nint(snrdb)
if(snrdb.eq.0.0) nsnr=-19 - isig
write(msg,1010) nsnr
1010 format('K1ABC W9XYZ ',i3.2)
call packmsg(msg,dgen,itype) !Pack message into 12 six-bit bytes
call rs_encode(dgen,sent) !RS encode
call interleave63(sent,1) !Interleave channel symbols
call graycode65(sent,63,1) !Apply Gray code
k=0
do j=1,nsym
if(nprc(j).eq.0) then
k=k+1
itone(j)=sent(k)+2
else
itone(j)=0
endif
enddo
sig=10.0**(0.05*nsnr)
if(nsnr.gt.90.0) sig=1.0
write(*,1020) ifile,isig,f0,csubmode,nsnr,sig,msg
1020 format(i3,i4,f10.3,1x,a1,i5,f8.4,2x,a22)
phi=0.d0
dphi=0.d0
k=12000 !Start audio at t = 1.0 s
isym0=-99
do i=1,npts
isym=nint(i/sps)+1
if(isym.gt.nsym) exit
if(isym.ne.isym0) then
freq=f0 + itone(isym)*baud*mode65
dphi=twopi*freq*dt
isym0=isym
endif
phi=phi + dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
k=k+1
dat(k)=dat(k) + sig*sin(xphi)
enddo
enddo
fac=32767.0/nsigs !### ??? ###
if(snrdb.ge.90.0) iwave(1:npts)=nint(fac*dat(1:npts))
if(snrdb.lt.90.0) iwave(1:npts)=nint(rms*dat(1:npts))
write(10) h,iwave(1:npts)
close(10)
enddo
999 end program jt65sim
lib/jt9.f90
+8 -7
View File
@@ -17,7 +17,7 @@ program jt9
character(len=500) optarg, infile
character wisfile*80
integer :: arglen,stat,offset,remain,mode=0,flow=200,fsplit=2700, &
fhigh=4000,nrxfreq=1500,ntrperiod=1,ndepth=1
fhigh=4000,nrxfreq=1500,ntrperiod=1,ndepth=60001
logical :: shmem = .false., read_files = .false., have_args = .false., &
tx9 = .false., display_help = .false.
type (option) :: long_options(17) = [ &
@@ -58,7 +58,7 @@ program jt9
common/tracer/limtrace,lu
common/patience/npatience,nthreads
common/decstats/num65,numbm,numkv,num9,numfano,infile
common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano
data npatience/1/,nthreads/1/
do
@@ -144,9 +144,10 @@ program jt9
wisfile=trim(data_dir)//'/jt9_wisdom.dat'// C_NULL_CHAR
iret=fftwf_import_wisdom_from_filename(wisfile)
num65=0
numbm=0
numkv=0
ntry65a=0
ntry65b=0
n65a=0
n65b=0
num9=0
numfano=0
@@ -243,8 +244,8 @@ program jt9
999 continue
! Output decoder statistics
write(12,1100) numbm,numkv,numbm+numkv,num65,numfano,num9
1100 format(58('-')/' BM KV JT65 Tries JT9 Tries'/ &
write(12,1100) n65a,ntry65a,n65b,ntry65b,numfano,num9
1100 format(58('-')/' JT65_1 Tries_1 JT65_2 Tries_2 JT9 Tries'/ &
58('-')/6i8)
! Save wisdom and free memory
lib/jtmsk.f90
+113
View File
@@ -0,0 +1,113 @@
subroutine jtmsk(id2,narg,line)
! Decoder for JTMSK
parameter (NMAX=30*12000)
parameter (NFFTMAX=512*1024)
parameter (NSPM=1404) !Samples per JTMSK message
integer*2 id2(0:NMAX) !Raw i*2 data, up to T/R = 30 s
real d(0:NMAX) !Raw r*4 data
real ty(703)
real yellow(703)
! real spk2(20)
! real fpk2(20)
! integer jpk2(20)
complex c(NFFTMAX) !Complex (analytic) data
complex cdat(24000) !Short segments, up to 2 s
complex cdat2(24000)
integer narg(0:11) !Arguments passed from calling pgm
character*22 msg,msg0 !Decoded message
character*80 line(100) !Decodes passed back to caller
common/tracer/ limtrace,lu
limtrace=-1
lu=12
! Parameters from GUI are in narg():
nutc=narg(0) !UTC
npts=min(narg(1),NMAX) !Number of samples in id2 (12000 Hz)
newdat=narg(3) !1==> new data, compute symbol spectra
minsync=narg(4) !Lower sync limit
npick=narg(5)
t0=0.001*narg(6)
t1=0.001*narg(7)
maxlines=narg(8) !Max # of decodes to return to caller
nmode=narg(9)
nrxfreq=narg(10) !Target Rx audio frequency (Hz)
ntol=narg(11) !Search range, +/- ntol (Hz)
nsnr0=-99
nline=0
line(1:100)(1:1)=char(0)
msg0=' '
msg=msg0
d(0:npts-1)=id2(0:npts-1)
rms=sqrt(dot_product(d(0:npts-1),d(0:npts-1))/npts)
d(0:npts-1)=d(0:npts-1)/rms
call timer('mskdt ',0)
call mskdt(d,npts,ty,yellow,nyel)
nyel=min(nyel,5)
call timer('mskdt ',1)
n=log(float(npts))/log(2.0) + 1.0
nfft=min(2**n,1024*1024)
call timer('analytic',0)
call analytic(d,npts,nfft,c) !Convert to analytic signal
call timer('analytic',1)
nbefore=NSPM
nafter=4*NSPM
! Process ping list (sorted by S/N) from top down.
do n=1,nyel
ia=ty(n)*12000.0 - nbefore
if(ia.lt.1) ia=1
ib=ia + nafter
if(ib.gt.NFFTMAX) ib=NFFTMAX
iz=ib-ia+1
cdat2(1:iz)=c(ia:ib) !Select nlen complex samples
ja=ia/NSPM + 1
jb=ib/NSPM
t0=ia/12000.0
! call msksync(cdat,iz,jpk2,fpk2,spk2)
! call softmsk(cdat,iz,jpk2,fpk2,spk2)
do itry=1,21
idf1=(itry/2) * 50
if(mod(itry,2).eq.1) idf1=-idf1
if(abs(idf1).gt.ntol) exit
fpk=idf1 + nrxfreq
call timer('tweak1 ',0)
call tweak1(cdat2,iz,1500.0-fpk,cdat)
call timer('tweak1 ',1)
call timer('syncmsk ',0)
call syncmsk(cdat,iz,jpk,ipk,idf,rmax,snr,metric,msg)
call timer('syncmsk ',1)
freq=fpk+idf
! write(72,4001) jpk,idf,nint(freq),rmax,snr,msg
!4001 format(3i6,2f9.2,2x,a22)
if(metric.eq.-9999) cycle !No output if no significant sync
t0=(ia+jpk)/12000.0
nsnr=nint(yellow(n)-2.0)
if(msg.ne.' ') then
if(msg.ne.msg0) then
nline=nline+1
nsnr0=-99
endif
if(nsnr.gt.nsnr0) then
call rectify_msk(cdat2(jpk:jpk+NSPM-1),msg,freq2)
write(line(nline),1020) nutc,nsnr,t0,nint(freq2),msg
1020 format(i6.6,i4,f5.1,i5,' & ',a22)
nsnr0=nsnr
go to 900
endif
msg0=msg
if(nline.ge.maxlines) go to 900
endif
enddo
enddo
900 if(line(1)(1:6).eq.' ') line(1)(1:1)=char(0)
return
end subroutine jtmsk
lib/moondopjpl.f90
+2 -2
View File
@@ -32,8 +32,8 @@ subroutine MoonDopJPL(nyear,month,nday,uth4,lon4,lat4,RAMoon4, &
RAMoon4=RA
DecMoon4=Dec
LST4=LST
HA4=HA
LST4=0. !These two variables not presently used
HA4=0.
AzMoon4=Az*rad
ElMoon4=El*rad
vr4=vr
lib/mskdt.f90
+78
View File
@@ -0,0 +1,78 @@
subroutine mskdt(d,npts,ty,yellow,nyel)
parameter (NFFT=1024,NH=NFFT/2)
real d(npts)
real x(0:NFFT-1)
real green(703)
real yellow(703) !703 = 30*12000/512
real ty(703)
real y2(175)
real ty2(175)
integer indx(703)
logical ok
complex c(0:NH)
equivalence (x,c)
df=12000.0/NFFT
i1=nint(300.0/df)
i2=nint(800.0/df)
i3=nint(2200.0/df)
i4=nint(2700.0/df)
nblks=npts/NH - 1
do j=1,nblks
ib=(j+1)*NH
ia=ib-NFFT+1
x=d(ia:ib)
call four2a(x,NFFT,1,-1,0) !r2c FFT
sqlow=0.
do i=i1,i2
sqlow=sqlow + real(c(i))**2 + aimag(c(i))**2
enddo
sqmid=0.
do i=i2,i3
sqmid=sqmid + real(c(i))**2 + aimag(c(i))**2
enddo
sqhigh=0.
do i=i3,i4
sqhigh=sqhigh + real(c(i))**2 + aimag(c(i))**2
enddo
green(j)=db(sqlow+sqmid+sqhigh)
yellow(j)=db(sqmid/(sqlow+sqhigh))
ty(j)=j*512.0/12000.0
enddo
npct=20
call pctile(green,nblks,npct,base)
green(1:nblks)=green(1:nblks) - base - 0.3
call pctile(yellow,nblks,npct,base)
yellow(1:nblks)=yellow(1:nblks) - base - 0.6
call indexx(yellow,nblks,indx)
do j=1,nblks/4
k=indx(nblks+1-j)
ty(j)=ty(k)
yellow(j)=yellow(k)
if(yellow(j).lt.1.5) exit
enddo
nyel=j-1
k=1
y2(1)=yellow(1)
ty2(1)=ty(1)
do j=2,nyel
ok=.true.
do i=1,j-1
if(abs(ty(i)-ty(j)).lt.0.117) ok=.false.
enddo
if(ok) then
k=k+1
y2(k)=yellow(j)
ty2(k)=ty(j)
endif
enddo
nyel=k
yellow(1:nyel)=y2(1:nyel)
ty(1:nyel)=ty2(1:nyel)
return
end subroutine mskdt
lib/pctile.f90
+2 -2
View File
@@ -10,8 +10,8 @@ subroutine pctile(x,npts,npct,xpct)
endif
if(npts.gt.NMAX) stop
tmp(1:npts)=x
call sort(npts,tmp)
tmp(1:npts)=x
call shell(npts,tmp)
j=nint(npts*0.01*npct)
if(j.lt.1) j=1
if(j.gt.npts) j=npts
lib/pfx.f90
+1 -1
View File
@@ -23,7 +23,7 @@
'FOA ','FOC ','FOM ','FP ','FR ','FRG ','FRJ ','FRT ', &
'FT5W ','FT5X ','FT5Z ','FW ','FY ','M ','MD ','MI ', &
'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ', &
'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0A ', &
'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0 ', &
'HK0M ','HL ','HM ','HP ','HR ','HS ','HV ','HZ ', &
'I ','IS ','IS0 ', 'J2 ','J3 ','J5 ','J6 ', &
'J7 ','J8 ','JA ','JDM ','JDO ','JT ','JW ', &
lib/prcom.f90
+1
View File
@@ -0,0 +1 @@
common/prcom/pr(126),mdat(126),mref(126,2),mdat2(126),mref2(126,2)
lib/rectify_msk.f90
+75
View File
@@ -0,0 +1,75 @@
subroutine rectify_msk(c,msg,freq2)
parameter (NSPM=1404)
complex c(0:NSPM-1) !Received data
complex cmsg(0:NSPM-1) !Message waveform
complex c1(0:NSPM-1) !Rectified signal
complex c2(0:NSPM-1) !Integral of rectified signal
complex c3(0:2*NSPM-1) !FFT of rectified signal
complex cfac,z
character*22 msg,msgsent
integer i4tone(234)
ichk=0
call genmsk(msg,ichk,msgsent,i4tone,itype) !Get tone sequence for msg
twopi=8.0*atan(1.0)
dt=1.0/12000.0
f0=1000.0
f1=2000.0
phi=0.
dphi=0.
k=-1
c2=0.
do j=1,234 !Generate Tx waveform for msg
if(i4tone(j).eq.0) dphi=twopi*f0*dt
if(i4tone(j).eq.1) dphi=twopi*f1*dt
do i=1,6
k=k+1
phi=phi+dphi
cmsg(k)=cmplx(cos(phi),sin(phi))
c1(k)=conjg(cmsg(k))*c(k)
if(k.ge.1) c2(k)=c2(k-1) + c1(k)
enddo
enddo
c2(0)=c2(1)
pha=atan2(aimag(c2(NSPM-1)),real(c2(NSPM-1)))
cfac=cmplx(cos(pha),-sin(pha))
c1=cfac*c1
c2=cfac*c2
! sq=0.
! do k=0,NSPM-1
! pha=atan2(aimag(c2(k)),real(c2(k)))
! write(61,3001) k,c1(k),c2(k),pha
!3001 format(i6,7f12.3)
! sq=sq + aimag(c1(k))**2
! enddo
! z=c2(5)
! do j=1,234
! k=j*6 - 1
! if(j.ge.2) z=c2(k)-c2(k-6)
! pha=atan2(aimag(z),real(z))
! write(62,3001) j,z,pha
! enddo
nfft=2*NSPM
c3(0:NSPM-1)=c2
c3(NSPM:nfft-1)=0.
df=12000.0/nfft
call four2a(c3,nfft,1,-1,1)
smax=0.
do i=0,nfft-1
f=i*df
if(i.gt.nfft/2) f=f-12000.0
s=1.e-10*(real(c3(i))**2 + aimag(c3(i))**2)
if(s.gt.smax) then
smax=s
freq2=1500.0 + f
endif
! write(63,3002) f,s,db(s),c3(i)
!3002 format(f10.1,f12.3,f10.2,2f12.1)
enddo
return
end subroutine rectify_msk
lib/sfrsd.f90
+121
View File
@@ -0,0 +1,121 @@
subroutine sfrsd(mrsym,mrprob,mr2sym,mr2prob,ntrials,correct,indexes, &
param,ntry)
integer mrsym(0:62),mrprob(0:62),mr2sym(0:62),mr2prob(0:62)
integer correct(0:62),indexes(0:62),probs(0:62),thresh0(0:62)
integer rxdat(0:62),rxdat2(0:62),rxprob(0:62),rxprob2(0:62)
integer workdat(0:62),era_pos(0:50)
integer perr(0:7,0:7)
integer param(0:7)
real ratio0(0:62)
call init_rs_int()
do i=0,62
rxdat(i)=mrsym(62-i)
rxdat2(i)=mr2sym(62-i)
rxprob(i)=mrprob(62-i)
rxprob2(i)=mr2prob(62-i)
enddo
do i=0,62
indexes(i)=i
probs(i)=rxprob(i)
enddo
do ip=1,62
do k=0,63-ip
if(probs(k).lt.probs(k+1)) then
ntmp=probs(k)
probs(k)=probs(k+1)
probs(k+1)=ntmp
ntmp=indexes(k)
indexes(k)=indexes(k+1)
indexes(k+1)=ntmp
endif
enddo
enddo
era_pos=0
numera=0
workdat=rxdat
call decode_rs_int()
if(nerr.ge.0) then
correct=workdat
param=0
return
endif
call random_seed()
ncandidates=0
nsum=0
do i=0,62
nsum=nsum+rxprob(i)
j=indexes(62-i)
ratio0(i)=float(rxprob2(j))/(float(rxprob(j))+0.01)
ii=int(7.999*ratio0(i))
jj=(62-i)/8
thresh0(i)=nint(1.3*perr(jj,ii))
enddo
if(nsum.eq.0) return
do k=0,ntrials
era_pos=0
workdat=rxdat
numera=0
do i=0,62
j=indexes(62-i)
thresh=thresh0(i)
ir=rand()
if(...) then
era_pos(numera)=j
numera=numera+1
endif
enddo
call decode_rs_int()
if(nerr.ge.0) then
ncandidates=ncandidates+1
nhard=0
nsoft=0
nsofter=0
do i=0,62
if(workdat(i).ne.rxdat(i)) then
nhard=nhard+1
nsofter=nsofter+rxprob(i)
if(workdat(i).ne.rxdat2(i)) nsoft=nsoft+rxprob(i)
else
nsofter=nsofter-rxprob(i)
endif
enddo
nsoft=63*nsoft/nsum
nsofter=63*nsofter/nsum
ntotal=nsoft+nhard
if(ntotal.lt.ntotal_min) then
nsoft_min=nsoft
nhard_min=nhard
nsofter_min=nsofter
ntotal_min=ntotal
correct=workdat
nera_best=numera
ntry=k
endif
if(ntotal_min.lt.72 .and. nhard_min.lt.42) exit
endif
if(k.eq.ntrials-1) ntry=k+1
enddo
if(ntotal_min.ge.76 .or. nhard.ge.44) nhard_min=-1
param(0)=ncandidates
param(1)=nhard_min
param(2)=nsoft_min
param(3)=nera_best
param(4)=nsofter_min
if(param(0).eq.0) param(2)=-1
return
end subroutine sfrsd
lib/sfrsd/Makefile
+24
View File
@@ -0,0 +1,24 @@
srcdir = .
prefix = /usr/local
exec_prefix=${prefix}
CC=gcc
CFLAGS=-I/usr/local/include -Wall -O3
all: sfrsd
encode_rs_int.o: encode_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
decode_rs_int.o: decode_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
init_rs_int.o: init_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
sfrsd: sfrsd.o encode_rs_int.o decode_rs_int.o init_rs_int.o
gcc -g -o $@ $^
clean:
rm -f *.o *.a sfrsd
lib/sfrsd/Makefile.win32
+24
View File
@@ -0,0 +1,24 @@
srcdir = .
prefix = /usr/local
exec_prefix=${prefix}
CC=gcc
CFLAGS=-I/usr/local/include -Wall -O3
all: sfrsd.exe
encode_rs_int.o: encode_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
decode_rs_int.o: decode_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
init_rs_int.o: init_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
sfrsd.exe: sfrsd.o encode_rs_int.o decode_rs_int.o init_rs_int.o
gcc -g -DWIN32 -o $@ $^
clean:
rm -f *.o *.a sfrsd.exe
lib/sfrsd/char.h
+56
View File
@@ -0,0 +1,56 @@
/* Include file to configure the RS codec for character symbols
*
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#define DTYPE unsigned char
/* Reed-Solomon codec control block */
struct rs {
unsigned int mm; /* Bits per symbol */
unsigned int nn; /* Symbols per block (= (1<<mm)-1) */
unsigned char *alpha_to; /* log lookup table */
unsigned char *index_of; /* Antilog lookup table */
unsigned char *genpoly; /* Generator polynomial */
unsigned int nroots; /* Number of generator roots = number of parity symbols */
unsigned char fcr; /* First consecutive root, index form */
unsigned char prim; /* Primitive element, index form */
unsigned char iprim; /* prim-th root of 1, index form */
};
static inline int modnn(struct rs *rs,int x){
while (x >= rs->nn) {
x -= rs->nn;
x = (x >> rs->mm) + (x & rs->nn);
}
return x;
}
#define MODNN(x) modnn(rs,x)
#define MM (rs->mm)
#define NN (rs->nn)
#define ALPHA_TO (rs->alpha_to)
#define INDEX_OF (rs->index_of)
#define GENPOLY (rs->genpoly)
#define NROOTS (rs->nroots)
#define FCR (rs->fcr)
#define PRIM (rs->prim)
#define IPRIM (rs->iprim)
#define A0 (NN)
#define ENCODE_RS encode_rs_char
#define DECODE_RS decode_rs_char
#define INIT_RS init_rs_char
#define FREE_RS free_rs_char
void ENCODE_RS(void *p,DTYPE *data,DTYPE *parity);
int DECODE_RS(void *p,DTYPE *data,int *eras_pos,int no_eras);
void *INIT_RS(unsigned int symsize,unsigned int gfpoly,unsigned int fcr,
unsigned int prim,unsigned int nroots);
void FREE_RS(void *p);
lib/sfrsd/decode_rs.c
+268
View File
@@ -0,0 +1,268 @@
/* Reed-Solomon decoder
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
* Modified by Steve Franke, K9AN, for use in a soft-symbol RS decoder
*/
#ifdef DEBUG
#include <stdio.h>
#endif
#include <string.h>
#define NULL ((void *)0)
#define min(a,b) ((a) < (b) ? (a) : (b))
#ifdef FIXED
#include "fixed.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
int DECODE_RS(
#ifndef FIXED
void *p,
#endif
DTYPE *data, int *eras_pos, int no_eras, int calc_syn){
#ifndef FIXED
struct rs *rs = (struct rs *)p;
#endif
int deg_lambda, el, deg_omega;
int i, j, r,k;
DTYPE u,q,tmp,num1,num2,den,discr_r;
DTYPE lambda[NROOTS+1]; // Err+Eras Locator poly
static DTYPE s[51]; // and syndrome poly
DTYPE b[NROOTS+1], t[NROOTS+1], omega[NROOTS+1];
DTYPE root[NROOTS], reg[NROOTS+1], loc[NROOTS];
int syn_error, count;
if( calc_syn ) {
/* form the syndromes; i.e., evaluate data(x) at roots of g(x) */
for(i=0;i<NROOTS;i++)
s[i] = data[0];
for(j=1;j<NN;j++){
for(i=0;i<NROOTS;i++){
if(s[i] == 0){
s[i] = data[j];
} else {
s[i] = data[j] ^ ALPHA_TO[MODNN(INDEX_OF[s[i]] + (FCR+i)*PRIM)];
}
}
}
/* Convert syndromes to index form, checking for nonzero condition */
syn_error = 0;
for(i=0;i<NROOTS;i++){
syn_error |= s[i];
s[i] = INDEX_OF[s[i]];
}
if (!syn_error) {
/* if syndrome is zero, data[] is a codeword and there are no
* errors to correct. So return data[] unmodified
*/
count = 0;
goto finish;
}
}
memset(&lambda[1],0,NROOTS*sizeof(lambda[0]));
lambda[0] = 1;
if (no_eras > 0) {
/* Init lambda to be the erasure locator polynomial */
lambda[1] = ALPHA_TO[MODNN(PRIM*(NN-1-eras_pos[0]))];
for (i = 1; i < no_eras; i++) {
u = MODNN(PRIM*(NN-1-eras_pos[i]));
for (j = i+1; j > 0; j--) {
tmp = INDEX_OF[lambda[j - 1]];
if(tmp != A0)
lambda[j] ^= ALPHA_TO[MODNN(u + tmp)];
}
}
#if DEBUG >= 1
/* Test code that verifies the erasure locator polynomial just constructed
Needed only for decoder debugging. */
/* find roots of the erasure location polynomial */
for(i=1;i<=no_eras;i++)
reg[i] = INDEX_OF[lambda[i]];
count = 0;
for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) {
q = 1;
for (j = 1; j <= no_eras; j++)
if (reg[j] != A0) {
reg[j] = MODNN(reg[j] + j);
q ^= ALPHA_TO[reg[j]];
}
if (q != 0)
continue;
/* store root and error location number indices */
root[count] = i;
loc[count] = k;
count++;
}
if (count != no_eras) {
printf("count = %d no_eras = %d\n lambda(x) is WRONG\n",count,no_eras);
count = -1;
goto finish;
}
#if DEBUG >= 2
printf("\n Erasure positions as determined by roots of Eras Loc Poly:\n");
for (i = 0; i < count; i++)
printf("%d ", loc[i]);
printf("\n");
#endif
#endif
}
for(i=0;i<NROOTS+1;i++)
b[i] = INDEX_OF[lambda[i]];
/*
* Begin Berlekamp-Massey algorithm to determine error+erasure
* locator polynomial
*/
r = no_eras;
el = no_eras;
while (++r <= NROOTS) { /* r is the step number */
/* Compute discrepancy at the r-th step in poly-form */
discr_r = 0;
for (i = 0; i < r; i++){
if ((lambda[i] != 0) && (s[r-i-1] != A0)) {
discr_r ^= ALPHA_TO[MODNN(INDEX_OF[lambda[i]] + s[r-i-1])];
}
}
discr_r = INDEX_OF[discr_r]; /* Index form */
if (discr_r == A0) {
/* 2 lines below: B(x) <-- x*B(x) */
memmove(&b[1],b,NROOTS*sizeof(b[0]));
b[0] = A0;
} else {
/* 7 lines below: T(x) <-- lambda(x) - discr_r*x*b(x) */
t[0] = lambda[0];
for (i = 0 ; i < NROOTS; i++) {
if(b[i] != A0)
t[i+1] = lambda[i+1] ^ ALPHA_TO[MODNN(discr_r + b[i])];
else
t[i+1] = lambda[i+1];
}
if (2 * el <= r + no_eras - 1) {
el = r + no_eras - el;
/*
* 2 lines below: B(x) <-- inv(discr_r) *
* lambda(x)
*/
for (i = 0; i <= NROOTS; i++)
b[i] = (lambda[i] == 0) ? A0 : MODNN(INDEX_OF[lambda[i]] - discr_r + NN);
} else {
/* 2 lines below: B(x) <-- x*B(x) */
memmove(&b[1],b,NROOTS*sizeof(b[0]));
b[0] = A0;
}
memcpy(lambda,t,(NROOTS+1)*sizeof(t[0]));
}
}
/* Convert lambda to index form and compute deg(lambda(x)) */
deg_lambda = 0;
for(i=0;i<NROOTS+1;i++){
lambda[i] = INDEX_OF[lambda[i]];
if(lambda[i] != A0)
deg_lambda = i;
}
/* Find roots of the error+erasure locator polynomial by Chien search */
memcpy(&reg[1],&lambda[1],NROOTS*sizeof(reg[0]));
count = 0; /* Number of roots of lambda(x) */
for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) {
q = 1; /* lambda[0] is always 0 */
for (j = deg_lambda; j > 0; j--){
if (reg[j] != A0) {
reg[j] = MODNN(reg[j] + j);
q ^= ALPHA_TO[reg[j]];
}
}
if (q != 0)
continue; /* Not a root */
/* store root (index-form) and error location number */
#if DEBUG>=2
printf("count %d root %d loc %d\n",count,i,k);
#endif
root[count] = i;
loc[count] = k;
/* If we've already found max possible roots,
* abort the search to save time
*/
if(++count == deg_lambda)
break;
}
if (deg_lambda != count) {
/*
* deg(lambda) unequal to number of roots => uncorrectable
* error detected
*/
count = -1;
goto finish;
}
/*
* Compute err+eras evaluator poly omega(x) = s(x)*lambda(x) (modulo
* x**NROOTS). in index form. Also find deg(omega).
*/
deg_omega = 0;
for (i = 0; i < NROOTS;i++){
tmp = 0;
j = (deg_lambda < i) ? deg_lambda : i;
for(;j >= 0; j--){
if ((s[i - j] != A0) && (lambda[j] != A0))
tmp ^= ALPHA_TO[MODNN(s[i - j] + lambda[j])];
}
if(tmp != 0)
deg_omega = i;
omega[i] = INDEX_OF[tmp];
}
omega[NROOTS] = A0;
/*
* Compute error values in poly-form. num1 = omega(inv(X(l))), num2 =
* inv(X(l))**(FCR-1) and den = lambda_pr(inv(X(l))) all in poly-form
*/
for (j = count-1; j >=0; j--) {
num1 = 0;
for (i = deg_omega; i >= 0; i--) {
if (omega[i] != A0)
num1 ^= ALPHA_TO[MODNN(omega[i] + i * root[j])];
}
num2 = ALPHA_TO[MODNN(root[j] * (FCR - 1) + NN)];
den = 0;
/* lambda[i+1] for i even is the formal derivative lambda_pr of lambda[i] */
for (i = min(deg_lambda,NROOTS-1) & ~1; i >= 0; i -=2) {
if(lambda[i+1] != A0)
den ^= ALPHA_TO[MODNN(lambda[i+1] + i * root[j])];
}
if (den == 0) {
#if DEBUG >= 1
printf("\n ERROR: denominator = 0\n");
#endif
count = -1;
goto finish;
}
/* Apply error to data */
if (num1 != 0) {
data[loc[j]] ^= ALPHA_TO[MODNN(INDEX_OF[num1] + INDEX_OF[num2] + NN - INDEX_OF[den])];
}
}
finish:
if(eras_pos != NULL){
for(i=0;i<count;i++)
eras_pos[i] = loc[i];
}
return count;
}
lib/sfrsd/encode_rs.c
+47
View File
@@ -0,0 +1,47 @@
/* Reed-Solomon encoder
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#include <string.h>
#ifdef FIXED
#include "fixed.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
void ENCODE_RS(
#ifndef FIXED
void *p,
#endif
DTYPE *data, DTYPE *bb){
#ifndef FIXED
struct rs *rs = (struct rs *)p;
#endif
int i, j;
DTYPE feedback;
memset(bb,0,NROOTS*sizeof(DTYPE));
for(i=0;i<NN-NROOTS;i++){
feedback = INDEX_OF[data[i] ^ bb[0]];
if(feedback != A0){ /* feedback term is non-zero */
#ifdef UNNORMALIZED
/* This line is unnecessary when GENPOLY[NROOTS] is unity, as it must
* always be for the polynomials constructed by init_rs()
*/
feedback = MODNN(NN - GENPOLY[NROOTS] + feedback);
#endif
for(j=1;j<NROOTS;j++)
bb[j] ^= ALPHA_TO[MODNN(feedback + GENPOLY[NROOTS-j])];
}
/* Shift */
memmove(&bb[0],&bb[1],sizeof(DTYPE)*(NROOTS-1));
if(feedback != A0)
bb[NROOTS-1] = ALPHA_TO[MODNN(feedback + GENPOLY[0])];
else
bb[NROOTS-1] = 0;
}
}
lib/sfrsd/fixed.h
+38
View File
@@ -0,0 +1,38 @@
/* Configure the RS codec with fixed parameters for CCSDS standard
* (255,223) code over GF(256). Note: the conventional basis is still
* used; the dual-basis mappings are performed in [en|de]code_rs_ccsds.c
*
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#define DTYPE unsigned char
static inline int mod255(int x){
while (x >= 255) {
x -= 255;
x = (x >> 8) + (x & 255);
}
return x;
}
#define MODNN(x) mod255(x)
extern unsigned char CCSDS_alpha_to[];
extern unsigned char CCSDS_index_of[];
extern unsigned char CCSDS_poly[];
#define MM 8
#define NN 255
#define ALPHA_TO CCSDS_alpha_to
#define INDEX_OF CCSDS_index_of
#define GENPOLY CCSDS_poly
#define NROOTS 32
#define FCR 112
#define PRIM 11
#define IPRIM 116
#define A0 (NN)
#define ENCODE_RS encode_rs_8
#define DECODE_RS decode_rs_8
void ENCODE_RS(DTYPE *data,DTYPE *parity);
int DECODE_RS(DTYPE *data, int *eras_pos, int no_eras);
lib/sfrsd/init_rs.c
+121
View File
@@ -0,0 +1,121 @@
/* Initialize a RS codec
*
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#include <stdlib.h>
#ifdef CCSDS
#include "ccsds.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
#define NULL ((void *)0)
void FREE_RS(void *p){
struct rs *rs = (struct rs *)p;
free(rs->alpha_to);
free(rs->index_of);
free(rs->genpoly);
free(rs);
}
/* Initialize a Reed-Solomon codec
* symsize = symbol size, bits (1-8)
* gfpoly = Field generator polynomial coefficients
* fcr = first root of RS code generator polynomial, index form
* prim = primitive element to generate polynomial roots
* nroots = RS code generator polynomial degree (number of roots)
*/
void *INIT_RS(unsigned int symsize,unsigned int gfpoly,unsigned fcr,unsigned prim,
unsigned int nroots){
struct rs *rs;
int i, j, sr,root,iprim;
if(symsize > 8*sizeof(DTYPE))
return NULL; /* Need version with ints rather than chars */
if(fcr >= (1<<symsize))
return NULL;
if(prim == 0 || prim >= (1<<symsize))
return NULL;
if(nroots >= (1<<symsize))
return NULL; /* Can't have more roots than symbol values! */
rs = (struct rs *)calloc(1,sizeof(struct rs));
rs->mm = symsize;
rs->nn = (1<<symsize)-1;
rs->alpha_to = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1));
if(rs->alpha_to == NULL){
free(rs);
return NULL;
}
rs->index_of = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1));
if(rs->index_of == NULL){
free(rs->alpha_to);
free(rs);
return NULL;
}
/* Generate Galois field lookup tables */
rs->index_of[0] = A0; /* log(zero) = -inf */
rs->alpha_to[A0] = 0; /* alpha**-inf = 0 */
sr = 1;
for(i=0;i<rs->nn;i++){
rs->index_of[sr] = i;
rs->alpha_to[i] = sr;
sr <<= 1;
if(sr & (1<<symsize))
sr ^= gfpoly;
sr &= rs->nn;
}
if(sr != 1){
/* field generator polynomial is not primitive! */
free(rs->alpha_to);
free(rs->index_of);
free(rs);
return NULL;
}
/* Form RS code generator polynomial from its roots */
rs->genpoly = (DTYPE *)malloc(sizeof(DTYPE)*(nroots+1));
if(rs->genpoly == NULL){
free(rs->alpha_to);
free(rs->index_of);
free(rs);
return NULL;
}
rs->fcr = fcr;
rs->prim = prim;
rs->nroots = nroots;
/* Find prim-th root of 1, used in decoding */
for(iprim=1;(iprim % prim) != 0;iprim += rs->nn)
;
rs->iprim = iprim / prim;
rs->genpoly[0] = 1;
for (i = 0,root=fcr*prim; i < nroots; i++,root += prim) {
rs->genpoly[i+1] = 1;
/* Multiply rs->genpoly[] by @**(root + x) */
for (j = i; j > 0; j--){
if (rs->genpoly[j] != 0)
rs->genpoly[j] = rs->genpoly[j-1] ^ rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[j]] + root)];
else
rs->genpoly[j] = rs->genpoly[j-1];
}
/* rs->genpoly[0] can never be zero */
rs->genpoly[0] = rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[0]] + root)];
}
/* convert rs->genpoly[] to index form for quicker encoding */
for (i = 0; i <= nroots; i++)
rs->genpoly[i] = rs->index_of[rs->genpoly[i]];
return rs;
}
lib/sfrsd/int.h
+54
View File
@@ -0,0 +1,54 @@
/* Include file to configure the RS codec for integer symbols
*
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#define DTYPE int
/* Reed-Solomon codec control block */
struct rs {
unsigned int mm; /* Bits per symbol */
unsigned int nn; /* Symbols per block (= (1<<mm)-1) */
int *alpha_to; /* log lookup table */
int *index_of; /* Antilog lookup table */
int *genpoly; /* Generator polynomial */
unsigned int nroots; /* Number of generator roots = number of parity symbols */
unsigned int fcr; /* First consecutive root, index form */
unsigned int prim; /* Primitive element, index form */
unsigned int iprim; /* prim-th root of 1, index form */
};
static inline int modnn(struct rs *rs,int x){
while (x >= rs->nn) {
x -= rs->nn;
x = (x >> rs->mm) + (x & rs->nn);
}
return x;
}
#define MODNN(x) modnn(rs,x)
#define MM (rs->mm)
#define NN (rs->nn)
#define ALPHA_TO (rs->alpha_to)
#define INDEX_OF (rs->index_of)
#define GENPOLY (rs->genpoly)
#define NROOTS (rs->nroots)
#define FCR (rs->fcr)
#define PRIM (rs->prim)
#define IPRIM (rs->iprim)
#define A0 (NN)
#define ENCODE_RS encode_rs_int
#define DECODE_RS decode_rs_int
#define INIT_RS init_rs_int
#define FREE_RS free_rs_int
void ENCODE_RS(void *p,DTYPE *data,DTYPE *parity);
int DECODE_RS(void *p,DTYPE *data,int *eras_pos,int no_eras, int calc_syn);
void *INIT_RS(unsigned int symsize,unsigned int gfpoly,unsigned int fcr,
unsigned int prim,unsigned int nroots);
void FREE_RS(void *p);
lib/sfrsd/kvasd.dat
BIN
View File
Binary file not shown.
lib/sfrsd/kvasd7.dat
BIN
View File
Binary file not shown.
lib/sfrsd/kvasd_bmfail.dat
BIN
View File
Binary file not shown.
lib/sfrsd/kvasd_sample.dat
BIN
View File
Binary file not shown.
lib/sfrsd/rs.h
+16
View File
@@ -0,0 +1,16 @@
/* User include file for the Reed-Solomon codec
* Copyright 2002, Phil Karn KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
/* General purpose RS codec, integer symbols */
void encode_rs_int(void *rs,int *data,int *parity);
int decode_rs_int(void *rs,int *data,int *eras_pos,int no_eras, int calc_syn);
void *init_rs_int(int symsize,int gfpoly,int fcr,
int prim,int nroots,int pad);
void free_rs_int(void *rs);
/* Tables to map from conventional->dual (Taltab) and
* dual->conventional (Tal1tab) bases
*/
extern unsigned char Taltab[],Tal1tab[];
lib/sfrsd/rstest.c
+130
View File
@@ -0,0 +1,130 @@
/*
./jt65code "Hi there"
Message Decoded Err? Type
--------------------------------------------------------------------------
1. HI THERE HI THERE 6: Free text
Packed message, 6-bit symbols 25 57 1 8 29 22 61 14 46 15 56 28
Information-carrying channel symbols
34 27 12 48 28 59 12 38 25 47 21 40 46 9 12 24 36 7 4 15 49
50 6 49 56 2 19 15 7 59 22 7 5 14 20 3 29 56 2 9 17 14
45 26 43 31 17 10 50 31 2 25 57 1 8 29 22 61 14 46 15 56 28
*/
#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include <string.h>
#include "rs.h"
static void *rs;
int main(){
int hi_there[]={25,57,1,8,29,22,61,14,46,15,56,28};
int data[12], revdat[12];
int parity[51];
int rxdat[63], errlocs[63];
int era_pos[51];
int i, numera, nerr, nn=63;
FILE *datfile;
//nsec,xlambda,maxe,nads,mrsym,mrprob,mr2sym,mr2prob
int nsec, maxe, nads;
float xlambda;
int mrsym[63],mrprob[63],mr2sym[63],mr2prob[63];
int nsec2,ncount,dat4[12];
datfile=fopen("kvasd.dat","rb");
if( !datfile ) {
printf("Unable to open kvasd.dat\n");
return 1;
} else {
fread(&nsec,sizeof(int),1,datfile);
fread(&xlambda,sizeof(float),1,datfile);
fread(&maxe,sizeof(int),1,datfile);
fread(&nads,sizeof(int),1,datfile);
fread(&mrsym,sizeof(int),63,datfile);
fread(&mrprob,sizeof(int),63,datfile);
fread(&mr2sym,sizeof(int),63,datfile);
fread(&mr2prob,sizeof(int),63,datfile);
fread(&nsec2,sizeof(int),1,datfile);
fread(&ncount,sizeof(int),1,datfile);
fread(&dat4,sizeof(int),12,datfile);
fclose(datfile);
printf("%d %f %d %d \n",nsec,xlambda,maxe,nads);
for (i=0; i<63; i++) printf("%d ",mrsym[i]);
printf("\n");
// for (i=0; i<63; i++) printf("%d ",mrprob[i]);
// printf("\n");
// for (i=0; i<63; i++) printf("%d ",mr2sym[i]);
// printf("\n");
// for (i=0; i<63; i++) printf("%d ",mr2prob[i]);
// printf("\n");
// printf("%d %d \n",nsec2,ncount);
printf("kv decode: ");
for (i=0; i<12; i++) printf("%d ",dat4[i]);
printf("\n");
}
// initialize the ka9q reed solomon encoder/decoder
unsigned int symsize=6, gfpoly=0x43, fcr=3, prim=1, nroots=51;
rs=init_rs_int(symsize, gfpoly, fcr, prim, nroots, 0);
// copy the 'hi there' message to the data vector
// memcpy(data,hi_there,sizeof(hi_there));
// memcpy(data,dat4,sizeof(dat4));
// printf("data symbols\n");
// for( i=0; i<12; i++) {
// revdat[i]=data[11-i];
// printf("%d ",data[i]);
// }
// printf("\n");
// encode_rs_int(rs,revdat,parity);
//set up the received symbol vector
// for( i=0; i<63; i++ ) {
// if( i < 12 ) rxdat[i]=revdat[i];
// if( i >=12 ) rxdat[i]=parity[i-12];
// }
/*
int errval, errloc;
int num_errors=0;
printf("num_errors = %d\n",num_errors);
for( i=0; i<num_errors; i++) {
do {
errval = random() & nn;
} while(errval == 0); //generate random
do {
errloc = random() % nn;
} while(errlocs[errloc]!=0);
errlocs[errloc] = errval;
rxdat[errloc] ^= errval;
}
*/
numera=0;
printf("channel symbols\n");
for( i=0; i<63; i++ ) {
rxdat[i]=mrsym[i];
printf("%d ",rxdat[i]);
}
printf("\n");
nerr=decode_rs_int(rs,rxdat,era_pos,numera);
printf("nerr %d\n",nerr);
printf("decoded data\n");
for(i=0; i<63; i++) printf("%d ",rxdat[i]);
printf("\n");
exit(0);
}
lib/sfrsd/sfrsd.c
+344
View File
@@ -0,0 +1,344 @@
/*
sfrsd.c
A soft-decision decoder for the JT65 (63,12) Reed-Solomon code.
This decoding scheme is built around Phil Karn's Berlekamp-Massey
errors and erasures decoder. The approach is inspired by a number of
publications, including the stochastic Chase decoder described
in "Stochastic Chase Decoding of Reed-Solomon Codes", by Leroux et al.,
IEEE Communications Letters, Vol. 14, No. 9, September 2010 and
"Soft-Decision Decoding of Reed-Solomon Codes Using Successive Error-
and-Erasure Decoding," by Soo-Woong Lee and B. V. K. Vijaya Kumar.
Steve Franke K9AN, Urbana IL, September 2015
*/
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <time.h>
#include <string.h>
#include "rs.h"
static void *rs;
//***************************************************************************
void usage(void)
{
printf("Usage: sfrsd [options...] <path to kvasd.dat>\n");
printf(" input file should be in kvasd format\n");
printf("\n");
printf("Options:\n");
printf(" -n number of random erasure vectors to try\n");
printf(" -v verbose\n");
}
int main(int argc, char *argv[]){
extern char *optarg;
extern int optind;
int rxdat[63], rxprob[63], rxdat2[63], rxprob2[63];
int workdat[63], correct[63];
int era_pos[51];
int c, i, numera, nerr, nn=63, kk=12;
char *infile;
FILE *datfile, *logfile;
int nsec, maxe, nads;
float xlambda;
int mrsym[63],mrprob[63],mr2sym[63],mr2prob[63];
int nsec2,ncount,dat4[12],bestdat[12];
int ntrials=10000;
int verbose=0;
int nhard=0,nhard_min=32768,nsoft=0,nsoft_min=32768, ncandidates;
while ( (c = getopt(argc, argv, "n:qv")) !=-1 ) {
switch (c) {
case 'n':
ntrials=(int)strtof(optarg,NULL);
printf("ntrials set to %d\n",ntrials);
break;
case 'v':
verbose=1;
break;
case 'q': //accept (and ignore) -q option for WSJT10 compatibility
break;
case '?':
usage();
exit(1);
}
}
if( optind+1 > argc) {
// usage();
// exit(1);
infile="kvasd.dat";
} else {
infile=argv[optind];
}
logfile=fopen("/tmp/sfrsd.log","a");
if( !logfile ) {
printf("Unable to open sfrsd.log\n");
exit(1);
}
datfile=fopen(infile,"rb");
if( !datfile ) {
printf("Unable to open kvasd.dat\n");
exit(1);
} else {
fread(&nsec,sizeof(int),1,datfile);
fread(&xlambda,sizeof(float),1,datfile);
fread(&maxe,sizeof(int),1,datfile);
fread(&nads,sizeof(int),1,datfile);
fread(&mrsym,sizeof(int),63,datfile);
fread(&mrprob,sizeof(int),63,datfile);
fread(&mr2sym,sizeof(int),63,datfile);
fread(&mr2prob,sizeof(int),63,datfile);
fread(&nsec2,sizeof(int),1,datfile);
fread(&ncount,sizeof(int),1,datfile);
// printf("ncount %d\n",ncount);
fread(&dat4,sizeof(int),12,datfile);
fclose(datfile);
}
// initialize the ka9q reed solomon encoder/decoder
unsigned int symsize=6, gfpoly=0x43, fcr=3, prim=1, nroots=51;
rs=init_rs_int(symsize, gfpoly, fcr, prim, nroots, 0);
/* // debug
int revdat[12], parity[51], correct[63];
for (i=0; i<12; i++) {
revdat[i]=dat4[11-i];
printf("%d ",revdat[i]);
}
printf("\n");
encode_rs_int(rs,revdat,parity);
for (i=0; i<63; i++) {
if( i<12 ) {
correct[i]=revdat[i];
printf("%d ",parity[i]);
} else {
correct[i]=parity[i-12];
}
}
printf("\n");
*/
// reverse the received symbol vector for bm decoder
for (i=0; i<63; i++) {
rxdat[i]=mrsym[62-i];
rxprob[i]=mrprob[62-i];
rxdat2[i]=mr2sym[62-i];
rxprob2[i]=mr2prob[62-i];
}
// sort the mrsym probabilities to find the least reliable symbols
int k, pass, tmp, nsym=63;
int probs[63], indexes[63];
for (i=0; i<63; i++) {
indexes[i]=i;
probs[i]=rxprob[i]; // must un-comment sfrsd metrics in demod64a
}
for (pass = 1; pass <= nsym-1; pass++) {
for (k = 0; k < nsym - pass; k++) {
if( probs[k] < probs[k+1] ) {
tmp = probs[k];
probs[k] = probs[k+1];
probs[k+1] = tmp;
tmp = indexes[k];
indexes[k] = indexes[k+1];
indexes[k+1] = tmp;
}
}
}
// see if we can decode using BM HDD (and calculate the syndrome vector)
memset(era_pos,0,51*sizeof(int));
numera=0;
memcpy(workdat,rxdat,sizeof(rxdat));
nerr=decode_rs_int(rs,workdat,era_pos,numera,1);
if( nerr >= 0 ) {
fprintf(logfile," BM decode nerrors= %3d : ",nerr);
for(i=0; i<12; i++) printf("%2d ",workdat[11-i]);
fprintf(logfile,"\n");
fclose(logfile);
exit(0);
}
// generate random erasure-locator vectors and see if any of them
// decode. This will generate a list of potential codewords. The
// "soft" distance between each codeword and the received word is
// used to decide which codeword is "best".
//
// srandom(time(NULL));
#ifdef WIN32
srand(0xdeadbeef);
#else
srandom(0xdeadbeef);
#endif
float p_erase;
int thresh, nsum;
ncandidates=0;
for( k=0; k<ntrials; k++) {
memset(era_pos,0,51*sizeof(int));
memcpy(workdat,rxdat,sizeof(rxdat));
// mark a subset of the symbols as erasures
numera=0;
for (i=0; i<nn; i++) {
p_erase=0.0;
if( probs[62-i] >= 255 ) {
p_erase = 0.5;
} else if ( probs[62-i] >= 196 ) {
p_erase = 0.6;
} else if ( probs[62-i] >= 128 ) {
p_erase = 0.6;
} else if ( probs[62-i] >= 32 ) {
p_erase = 0.6;
} else {
p_erase = 0.8;
}
thresh = p_erase*100;
long int ir;
#ifdef WIN32
ir=rand();
#else
ir=random();
#endif
if( ((ir % 100) < thresh ) && numera < 51 ) {
era_pos[numera]=indexes[62-i];
numera=numera+1;
}
}
nerr=decode_rs_int(rs,workdat,era_pos,numera,0);
if( nerr >= 0 ) {
ncandidates=ncandidates+1;
for(i=0; i<12; i++) dat4[i]=workdat[11-i];
// fprintf(logfile,"loop1 decode nerr= %3d : ",nerr);
// for(i=0; i<12; i++) fprintf(logfile, "%2d ",dat4[i]);
// fprintf(logfile,"\n");
nhard=0;
nsoft=0;
nsum=0;
for (i=0; i<63; i++) {
nsum=nsum+rxprob[i];
if( workdat[i] != rxdat[i] ) {
nhard=nhard+1;
nsoft=nsoft+rxprob[i];
}
}
if( nsum != 0 ) {
nsoft=63*nsoft/nsum;
if( (nsoft < nsoft_min) ) {
nsoft_min=nsoft;
nhard_min=nhard;
memcpy(bestdat,dat4,12*sizeof(int));
memcpy(correct,workdat,63*sizeof(int));
}
} else {
fprintf(logfile,"error - nsum %d nsoft %d nhard %d\n",nsum,nsoft,nhard);
}
// if( ncandidates >= 5000 ) {
if( ncandidates >= ntrials/2 ) {
break;
}
}
}
fprintf(logfile,"%d candidates after stochastic loop\n",ncandidates);
// do Forney Generalized Minimum Distance pattern
for (k=0; k<25; k++) {
memset(era_pos,0,51*sizeof(int));
numera=2*k;
for (i=0; i<numera; i++) {
era_pos[i]=indexes[62-i];
}
memcpy(workdat,rxdat,sizeof(rxdat));
nerr=decode_rs_int(rs,workdat,era_pos,numera,0);
if( nerr >= 0 ) {
ncandidates=ncandidates+1;
for(i=0; i<12; i++) dat4[i]=workdat[11-i];
// fprintf(logfile,"GMD decode nerr= %3d : ",nerr);
// for(i=0; i<12; i++) fprintf(logfile, "%2d ",dat4[i]);
// fprintf(logfile,"\n");
nhard=0;
nsoft=0;
nsum=0;
for (i=0; i<63; i++) {
nsum=nsum+rxprob[i];
if( workdat[i] != rxdat[i] ) {
nhard=nhard+1;
nsoft=nsoft+rxprob[i];
}
}
if( nsum != 0 ) {
nsoft=63*nsoft/nsum;
if( (nsoft < nsoft_min) ) {
nsoft_min=nsoft;
nhard_min=nhard;
memcpy(bestdat,dat4,12*sizeof(int));
memcpy(correct,workdat,63*sizeof(int));
}
} else {
fprintf(logfile,"error - nsum %d nsoft %d nhard %d\n",nsum,nsoft,nhard);
}
// if( ncandidates >=5000 ) {
if( ncandidates >= ntrials/2 ) {
break;
}
}
}
fprintf(logfile,"%d candidates after GMD\n",ncandidates);
if( (ncandidates >= 0) && (nsoft_min < 36) && (nhard_min < 44) ) {
for (i=0; i<63; i++) {
fprintf(logfile,"%3d %3d %3d %3d %3d %3d\n",i,correct[i],rxdat[i],rxprob[i],rxdat2[i],rxprob2[i]);
// fprintf(logfile,"%3d %3d %3d %3d %3d\n",i,workdat[i],rxdat[i],rxprob[i],rxdat2[i],rxprob2[i]);
}
fprintf(logfile,"**** ncandidates %d nhard %d nsoft %d nsum %d\n",ncandidates,nhard_min,nsoft_min,nsum);
} else {
nhard_min=-1;
memset(bestdat,0,12*sizeof(int));
}
datfile=fopen(infile,"wb");
if( !datfile ) {
printf("Unable to open kvasd.dat\n");
return 1;
} else {
fwrite(&nsec,sizeof(int),1,datfile);
fwrite(&xlambda,sizeof(float),1,datfile);
fwrite(&maxe,sizeof(int),1,datfile);
fwrite(&nads,sizeof(int),1,datfile);
fwrite(&mrsym,sizeof(int),63,datfile);
fwrite(&mrprob,sizeof(int),63,datfile);
fwrite(&mr2sym,sizeof(int),63,datfile);
fwrite(&mr2prob,sizeof(int),63,datfile);
fwrite(&nsec2,sizeof(int),1,datfile);
fwrite(&nhard_min,sizeof(int),1,datfile);
fwrite(&bestdat,sizeof(int),12,datfile);
fclose(datfile);
}
fprintf(logfile,"exiting sfrsd\n");
fflush(logfile);
fclose(logfile);
exit(0);
}
lib/sfrsd2/Makefile
+53
View File
@@ -0,0 +1,53 @@
# Makefile for Windows in JTSDK-PY environment
# Re-direct stdout and stderr: cmd.exe bash
# make > junk 2>&1 make &> junk
CC = gcc
FC = gfortran
FFLAGS = -O2 -DWIN32 -fbounds-check -fno-second-underscore -Wall \
-Wno-conversion -Wno-character-truncation
CFLAGS = -I. -DWIN32 -DWin32 -DBIGSYM -DHAVE_STRUCT_TIMESPEC
# 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: libsfrsd.a
OBJS1 = extract2.o sfrsd2.o init_rs_int.o encode_rs_int.o decode_rs_int.o
libsfrsd.a: $(OBJS1)
ar cr libsfrsd.a $(OBJS1)
ranlib libsfrsd.a
cp libsfrsd.a ..
# Build rsdtest
OBJS2 = rsdtest.o
rsdtest: $(OBJS2) ../libjt.a
$(FC) -o rsdtest $(OBJS2) libsfrsd.a ../libjt.a ../libpthreadGC2.a
sfrsd: sfrsd.o encode_rs_int.o decode_rs_int.o init_rs_int.o
gcc -g -o $@ $^
encode_rs_int.o: encode_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
decode_rs_int.o: decode_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
init_rs_int.o: init_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
.PHONY : clean
clean:
rm -rf *.o libjt.a rsdtest sfrsd
lib/sfrsd2/Makefile.sfrsd
+30
View File
@@ -0,0 +1,30 @@
srcdir = .
prefix = /usr/local
exec_prefix=${prefix}
CC=gcc
CFLAGS=-I/usr/local/include -Wall -O2
all: encode_rs_int.o decode_rs_int.o init_rs_int.o sfrsd2.o sfrsd.o sfrsd
encode_rs_int.o: encode_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
decode_rs_int.o: decode_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
init_rs_int.o: init_rs.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
sfrsd2.o: sfrsd2.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
sfrsd.o: sfrsd.c
gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^
sfrsd: sfrsd.o encode_rs_int.o decode_rs_int.o init_rs_int.o sfrsd2.o
gcc -g -o $@ $^
clean:
rm -f *.o *.a sfrsd
lib/sfrsd2/Makefile.sfrsd3
+38
View File
@@ -0,0 +1,38 @@
# Makefile for Windows in JTSDK-PY environment
# Re-direct stdout and stderr: cmd.exe bash
# make > junk 2>&1 make &> junk
CC = gcc
FC = gfortran
FFLAGS = -O2 -DWIN32 -fbounds-check -fno-second-underscore -Wall \
-Wno-conversion -Wno-character-truncation
CFLAGS = -I. -DWIN32 -DWin32 -DBIGSYM -DHAVE_STRUCT_TIMESPEC
# 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: rsdtest
# Build rsdtest
OBJS2 = rsdtest.o extract2.o demod64b.o sfrsd3.o
rsdtest: $(OBJS2) ../libjt.a
$(FC) -o rsdtest $(OBJS2) ../libjt.a ../libpthreadGC2.a
sfrsd: sfrsd.o encode_rs_int.o decode_rs_int.o init_rs_int.o
gcc -g -o $@ $^
.PHONY : clean
clean:
rm -rf *.o libjt.a rsdtest sfrsd
lib/sfrsd2/decode_rs.c
+268
View File
@@ -0,0 +1,268 @@
/* Reed-Solomon decoder
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
* Modified by Steve Franke, K9AN, for use in a soft-symbol RS decoder
*/
#ifdef DEBUG
#include <stdio.h>
#endif
#include <string.h>
#define NULL ((void *)0)
#define min(a,b) ((a) < (b) ? (a) : (b))
#ifdef FIXED
#include "fixed.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
int DECODE_RS(
#ifndef FIXED
void *p,
#endif
DTYPE *data, int *eras_pos, int no_eras, int calc_syn){
#ifndef FIXED
struct rs *rs = (struct rs *)p;
#endif
int deg_lambda, el, deg_omega;
int i, j, r,k;
DTYPE u,q,tmp,num1,num2,den,discr_r;
DTYPE lambda[NROOTS+1]; // Err+Eras Locator poly
static DTYPE s[51]; // and syndrome poly
DTYPE b[NROOTS+1], t[NROOTS+1], omega[NROOTS+1];
DTYPE root[NROOTS], reg[NROOTS+1], loc[NROOTS];
int syn_error, count;
if( calc_syn ) {
/* form the syndromes; i.e., evaluate data(x) at roots of g(x) */
for(i=0;i<NROOTS;i++)
s[i] = data[0];
for(j=1;j<NN;j++){
for(i=0;i<NROOTS;i++){
if(s[i] == 0){
s[i] = data[j];
} else {
s[i] = data[j] ^ ALPHA_TO[MODNN(INDEX_OF[s[i]] + (FCR+i)*PRIM)];
}
}
}
/* Convert syndromes to index form, checking for nonzero condition */
syn_error = 0;
for(i=0;i<NROOTS;i++){
syn_error |= s[i];
s[i] = INDEX_OF[s[i]];
}
if (!syn_error) {
/* if syndrome is zero, data[] is a codeword and there are no
* errors to correct. So return data[] unmodified
*/
count = 0;
goto finish;
}
}
memset(&lambda[1],0,NROOTS*sizeof(lambda[0]));
lambda[0] = 1;
if (no_eras > 0) {
/* Init lambda to be the erasure locator polynomial */
lambda[1] = ALPHA_TO[MODNN(PRIM*(NN-1-eras_pos[0]))];
for (i = 1; i < no_eras; i++) {
u = MODNN(PRIM*(NN-1-eras_pos[i]));
for (j = i+1; j > 0; j--) {
tmp = INDEX_OF[lambda[j - 1]];
if(tmp != A0)
lambda[j] ^= ALPHA_TO[MODNN(u + tmp)];
}
}
#if DEBUG >= 1
/* Test code that verifies the erasure locator polynomial just constructed
Needed only for decoder debugging. */
/* find roots of the erasure location polynomial */
for(i=1;i<=no_eras;i++)
reg[i] = INDEX_OF[lambda[i]];
count = 0;
for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) {
q = 1;
for (j = 1; j <= no_eras; j++)
if (reg[j] != A0) {
reg[j] = MODNN(reg[j] + j);
q ^= ALPHA_TO[reg[j]];
}
if (q != 0)
continue;
/* store root and error location number indices */
root[count] = i;
loc[count] = k;
count++;
}
if (count != no_eras) {
printf("count = %d no_eras = %d\n lambda(x) is WRONG\n",count,no_eras);
count = -1;
goto finish;
}
#if DEBUG >= 2
printf("\n Erasure positions as determined by roots of Eras Loc Poly:\n");
for (i = 0; i < count; i++)
printf("%d ", loc[i]);
printf("\n");
#endif
#endif
}
for(i=0;i<NROOTS+1;i++)
b[i] = INDEX_OF[lambda[i]];
/*
* Begin Berlekamp-Massey algorithm to determine error+erasure
* locator polynomial
*/
r = no_eras;
el = no_eras;
while (++r <= NROOTS) { /* r is the step number */
/* Compute discrepancy at the r-th step in poly-form */
discr_r = 0;
for (i = 0; i < r; i++){
if ((lambda[i] != 0) && (s[r-i-1] != A0)) {
discr_r ^= ALPHA_TO[MODNN(INDEX_OF[lambda[i]] + s[r-i-1])];
}
}
discr_r = INDEX_OF[discr_r]; /* Index form */
if (discr_r == A0) {
/* 2 lines below: B(x) <-- x*B(x) */
memmove(&b[1],b,NROOTS*sizeof(b[0]));
b[0] = A0;
} else {
/* 7 lines below: T(x) <-- lambda(x) - discr_r*x*b(x) */
t[0] = lambda[0];
for (i = 0 ; i < NROOTS; i++) {
if(b[i] != A0)
t[i+1] = lambda[i+1] ^ ALPHA_TO[MODNN(discr_r + b[i])];
else
t[i+1] = lambda[i+1];
}
if (2 * el <= r + no_eras - 1) {
el = r + no_eras - el;
/*
* 2 lines below: B(x) <-- inv(discr_r) *
* lambda(x)
*/
for (i = 0; i <= NROOTS; i++)
b[i] = (lambda[i] == 0) ? A0 : MODNN(INDEX_OF[lambda[i]] - discr_r + NN);
} else {
/* 2 lines below: B(x) <-- x*B(x) */
memmove(&b[1],b,NROOTS*sizeof(b[0]));
b[0] = A0;
}
memcpy(lambda,t,(NROOTS+1)*sizeof(t[0]));
}
}
/* Convert lambda to index form and compute deg(lambda(x)) */
deg_lambda = 0;
for(i=0;i<NROOTS+1;i++){
lambda[i] = INDEX_OF[lambda[i]];
if(lambda[i] != A0)
deg_lambda = i;
}
/* Find roots of the error+erasure locator polynomial by Chien search */
memcpy(&reg[1],&lambda[1],NROOTS*sizeof(reg[0]));
count = 0; /* Number of roots of lambda(x) */
for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) {
q = 1; /* lambda[0] is always 0 */
for (j = deg_lambda; j > 0; j--){
if (reg[j] != A0) {
reg[j] = MODNN(reg[j] + j);
q ^= ALPHA_TO[reg[j]];
}
}
if (q != 0)
continue; /* Not a root */
/* store root (index-form) and error location number */
#if DEBUG>=2
printf("count %d root %d loc %d\n",count,i,k);
#endif
root[count] = i;
loc[count] = k;
/* If we've already found max possible roots,
* abort the search to save time
*/
if(++count == deg_lambda)
break;
}
if (deg_lambda != count) {
/*
* deg(lambda) unequal to number of roots => uncorrectable
* error detected
*/
count = -1;
goto finish;
}
/*
* Compute err+eras evaluator poly omega(x) = s(x)*lambda(x) (modulo
* x**NROOTS). in index form. Also find deg(omega).
*/
deg_omega = 0;
for (i = 0; i < NROOTS;i++){
tmp = 0;
j = (deg_lambda < i) ? deg_lambda : i;
for(;j >= 0; j--){
if ((s[i - j] != A0) && (lambda[j] != A0))
tmp ^= ALPHA_TO[MODNN(s[i - j] + lambda[j])];
}
if(tmp != 0)
deg_omega = i;
omega[i] = INDEX_OF[tmp];
}
omega[NROOTS] = A0;
/*
* Compute error values in poly-form. num1 = omega(inv(X(l))), num2 =
* inv(X(l))**(FCR-1) and den = lambda_pr(inv(X(l))) all in poly-form
*/
for (j = count-1; j >=0; j--) {
num1 = 0;
for (i = deg_omega; i >= 0; i--) {
if (omega[i] != A0)
num1 ^= ALPHA_TO[MODNN(omega[i] + i * root[j])];
}
num2 = ALPHA_TO[MODNN(root[j] * (FCR - 1) + NN)];
den = 0;
/* lambda[i+1] for i even is the formal derivative lambda_pr of lambda[i] */
for (i = min(deg_lambda,NROOTS-1) & ~1; i >= 0; i -=2) {
if(lambda[i+1] != A0)
den ^= ALPHA_TO[MODNN(lambda[i+1] + i * root[j])];
}
if (den == 0) {
#if DEBUG >= 1
printf("\n ERROR: denominator = 0\n");
#endif
count = -1;
goto finish;
}
/* Apply error to data */
if (num1 != 0) {
data[loc[j]] ^= ALPHA_TO[MODNN(INDEX_OF[num1] + INDEX_OF[num2] + NN - INDEX_OF[den])];
}
}
finish:
if(eras_pos != NULL){
for(i=0;i<count;i++)
eras_pos[i] = loc[i];
}
return count;
}
lib/sfrsd2/encode_rs.c
+47
View File
@@ -0,0 +1,47 @@
/* Reed-Solomon encoder
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#include <string.h>
#ifdef FIXED
#include "fixed.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
void ENCODE_RS(
#ifndef FIXED
void *p,
#endif
DTYPE *data, DTYPE *bb){
#ifndef FIXED
struct rs *rs = (struct rs *)p;
#endif
int i, j;
DTYPE feedback;
memset(bb,0,NROOTS*sizeof(DTYPE));
for(i=0;i<NN-NROOTS;i++){
feedback = INDEX_OF[data[i] ^ bb[0]];
if(feedback != A0){ /* feedback term is non-zero */
#ifdef UNNORMALIZED
/* This line is unnecessary when GENPOLY[NROOTS] is unity, as it must
* always be for the polynomials constructed by init_rs()
*/
feedback = MODNN(NN - GENPOLY[NROOTS] + feedback);
#endif
for(j=1;j<NROOTS;j++)
bb[j] ^= ALPHA_TO[MODNN(feedback + GENPOLY[NROOTS-j])];
}
/* Shift */
memmove(&bb[0],&bb[1],sizeof(DTYPE)*(NROOTS-1));
if(feedback != A0)
bb[NROOTS-1] = ALPHA_TO[MODNN(feedback + GENPOLY[0])];
else
bb[NROOTS-1] = 0;
}
}
lib/sfrsd2/extract2.f90
+145
View File
@@ -0,0 +1,145 @@
subroutine extract2(s3,nadd,ntrials,param,msg)
real s3(64,63)
real tmp(4032)
integer np1(0:7,0:7),np2(0:7,0:7),np0(0:7,0:7)
integer ns(0:7,0:7)
integer perr(0:7,0:7),pmr2(0:7,0:7)
character msg*22
integer dat4(12)
integer mrsym(0:62),mr2sym(0:62),mrprob(0:62),mr2prob(0:62)
integer correct(0:62)
integer param(0:7)
integer indx(0:62)
logical first
real*8 tt
common/extcom/ntdecode
data ndone/0/,ngood/0/,nbad/0/,first/.true./
save
if(first) then
np1=0
np2=0
np0=0
ns=0
first=.false.
endif
nfail=0
1 call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
! if(ntest.lt.50 .or. nlow.gt.20) then
! ncount=-999 !Flag bad data
! go to 900
! endif
call chkhist(mrsym,nhist,ipk)
if(nhist.ge.20) then
nfail=nfail+1
call pctile(s3,tmp,4032,50,base) ! ### or, use ave from demod64a ?
do j=1,63
s3(ipk,j)=base
enddo
go to 1
endif
call graycode(mrsym,63,-1)
call interleave63(mrsym,-1)
call interleave63(mrprob,-1)
call graycode(mr2sym,63,-1)
call interleave63(mr2sym,-1)
call interleave63(mr2prob,-1)
nverbose=0
call sfrsd2(mrsym,mrprob,mr2sym,mr2prob,ntrials,nverbose,correct, &
param,indx,tt,ntry)
ncandidates=param(0)
nhard=param(1)
nsoft=param(2)
nera=param(3)
ngmd=param(4)
ndone=ndone+1
do i=1,12
dat4(i)=correct(12-i)
enddo
msg=' '
! if(nhard.ge.0) then
if(nhard.ge.0 .and. nhard.le.42 .and. nsoft.le.32 .and. &
(nhard+nsoft).le.73) then
call unpackmsg(dat4,msg) !Unpack the user message
if(msg.eq.'VK7MO K1JT FN20 ') then
ngood=ngood+1
do k=0,62
j=indx(k)
i=(62-j)
p1=mrprob(i)/255.0 + 1.e-10
p2=mr2prob(i)/255.0
ii=k/8
jj=7.9999*p2/p1
ns(ii,jj)=ns(ii,jj)+1
if(correct(j).eq.mrsym(i)) then
np1(ii,jj)=np1(ii,jj)+1
else
np0(ii,jj)=np0(ii,jj)+1
endif
if(correct(j).eq.mr2sym(i)) np2(ii,jj)=np2(ii,jj)+1
enddo
else
nbad=nbad+1
endif
endif
fgood=float(ngood)/ndone
fbad=float(nbad)/ndone
nboth=nhard+nsoft
if(nhard.lt.0) then
nsoft=99
nera=99
nboth=99
endif
write(*,1010) ndone,fgood,fbad,ncandidates,nhard,nsoft,nera,nboth, &
ntry,tt,msg
write(32,1010) ndone,fgood,fbad,ncandidates,nhard,nsoft,nera,nboth, &
ntry,tt,msg
1010 format(i4,2f7.3,i7,4i3,i8,f8.1,1x,a22)
flush(32)
if(msg.eq.'VK7MO K1JT FN20 ') then
write(33,1012) ndone,ngood,nbad,ntry,log10(float(1+ntry))
1012 format(4i8,f8.3)
flush(33)
endif
rewind 40
write(40,1080)
1080 format('Totals:')
write(40,1090) ns
1090 format(8i7)
write(40,1091)
1091 format(/'error:')
write(40,1090) np0
write(40,1092)
1092 format(/'sym = mrsym:')
write(40,1090) np1
write(40,1093)
1093 format(/'sym = mr2sym:')
write(40,1090) np2
write(40,1095)
1095 format(/'Probability of error:')
perr=nint(100.0*float(np0)/(ns+0.001))
write(40,1096) perr
1096 format(8i7)
write(40,1097)
1097 format(/'P(mr2 correct | mr not correct) :')
pmr2=nint(100.0*float(np2)/(np0+0.001))
write(40,1096) pmr2
flush(40)
return
end subroutine extract2
lib/sfrsd2/init_rs.c
+121
View File
@@ -0,0 +1,121 @@
/* Initialize a RS codec
*
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#include <stdlib.h>
#ifdef CCSDS
#include "ccsds.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
#define NULL ((void *)0)
void FREE_RS(void *p){
struct rs *rs = (struct rs *)p;
free(rs->alpha_to);
free(rs->index_of);
free(rs->genpoly);
free(rs);
}
/* Initialize a Reed-Solomon codec
* symsize = symbol size, bits (1-8)
* gfpoly = Field generator polynomial coefficients
* fcr = first root of RS code generator polynomial, index form
* prim = primitive element to generate polynomial roots
* nroots = RS code generator polynomial degree (number of roots)
*/
void *INIT_RS(unsigned int symsize,unsigned int gfpoly,unsigned fcr,unsigned prim,
unsigned int nroots){
struct rs *rs;
int i, j, sr,root,iprim;
if(symsize > 8*sizeof(DTYPE))
return NULL; /* Need version with ints rather than chars */
if(fcr >= (1<<symsize))
return NULL;
if(prim == 0 || prim >= (1<<symsize))
return NULL;
if(nroots >= (1<<symsize))
return NULL; /* Can't have more roots than symbol values! */
rs = (struct rs *)calloc(1,sizeof(struct rs));
rs->mm = symsize;
rs->nn = (1<<symsize)-1;
rs->alpha_to = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1));
if(rs->alpha_to == NULL){
free(rs);
return NULL;
}
rs->index_of = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1));
if(rs->index_of == NULL){
free(rs->alpha_to);
free(rs);
return NULL;
}
/* Generate Galois field lookup tables */
rs->index_of[0] = A0; /* log(zero) = -inf */
rs->alpha_to[A0] = 0; /* alpha**-inf = 0 */
sr = 1;
for(i=0;i<rs->nn;i++){
rs->index_of[sr] = i;
rs->alpha_to[i] = sr;
sr <<= 1;
if(sr & (1<<symsize))
sr ^= gfpoly;
sr &= rs->nn;
}
if(sr != 1){
/* field generator polynomial is not primitive! */
free(rs->alpha_to);
free(rs->index_of);
free(rs);
return NULL;
}
/* Form RS code generator polynomial from its roots */
rs->genpoly = (DTYPE *)malloc(sizeof(DTYPE)*(nroots+1));
if(rs->genpoly == NULL){
free(rs->alpha_to);
free(rs->index_of);
free(rs);
return NULL;
}
rs->fcr = fcr;
rs->prim = prim;
rs->nroots = nroots;
/* Find prim-th root of 1, used in decoding */
for(iprim=1;(iprim % prim) != 0;iprim += rs->nn)
;
rs->iprim = iprim / prim;
rs->genpoly[0] = 1;
for (i = 0,root=fcr*prim; i < nroots; i++,root += prim) {
rs->genpoly[i+1] = 1;
/* Multiply rs->genpoly[] by @**(root + x) */
for (j = i; j > 0; j--){
if (rs->genpoly[j] != 0)
rs->genpoly[j] = rs->genpoly[j-1] ^ rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[j]] + root)];
else
rs->genpoly[j] = rs->genpoly[j-1];
}
/* rs->genpoly[0] can never be zero */
rs->genpoly[0] = rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[0]] + root)];
}
/* convert rs->genpoly[] to index form for quicker encoding */
for (i = 0; i <= nroots; i++)
rs->genpoly[i] = rs->index_of[rs->genpoly[i]];
return rs;
}
lib/sfrsd2/int.h
+54
View File
@@ -0,0 +1,54 @@
/* Include file to configure the RS codec for integer symbols
*
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#define DTYPE int
/* Reed-Solomon codec control block */
struct rs {
unsigned int mm; /* Bits per symbol */
unsigned int nn; /* Symbols per block (= (1<<mm)-1) */
int *alpha_to; /* log lookup table */
int *index_of; /* Antilog lookup table */
int *genpoly; /* Generator polynomial */
unsigned int nroots; /* Number of generator roots = number of parity symbols */
unsigned int fcr; /* First consecutive root, index form */
unsigned int prim; /* Primitive element, index form */
unsigned int iprim; /* prim-th root of 1, index form */
};
static inline int modnn(struct rs *rs,int x){
while (x >= rs->nn) {
x -= rs->nn;
x = (x >> rs->mm) + (x & rs->nn);
}
return x;
}
#define MODNN(x) modnn(rs,x)
#define MM (rs->mm)
#define NN (rs->nn)
#define ALPHA_TO (rs->alpha_to)
#define INDEX_OF (rs->index_of)
#define GENPOLY (rs->genpoly)
#define NROOTS (rs->nroots)
#define FCR (rs->fcr)
#define PRIM (rs->prim)
#define IPRIM (rs->iprim)
#define A0 (NN)
#define ENCODE_RS encode_rs_int
#define DECODE_RS decode_rs_int
#define INIT_RS init_rs_int
#define FREE_RS free_rs_int
void ENCODE_RS(void *p,DTYPE *data,DTYPE *parity);
int DECODE_RS(void *p,DTYPE *data,int *eras_pos,int no_eras, int calc_syn);
void *INIT_RS(unsigned int symsize,unsigned int gfpoly,unsigned int fcr,
unsigned int prim,unsigned int nroots);
void FREE_RS(void *p);
lib/sfrsd2/rs2.h
+16
View File
@@ -0,0 +1,16 @@
/* User include file for the Reed-Solomon codec
* Copyright 2002, Phil Karn KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
/* General purpose RS codec, integer symbols */
void encode_rs_int(void *rs,int *data,int *parity);
int decode_rs_int(void *rs,int *data,int *eras_pos,int no_eras, int calc_syn);
void *init_rs_int(int symsize,int gfpoly,int fcr,
int prim,int nroots,int pad);
void free_rs_int(void *rs);
/* Tables to map from conventional->dual (Taltab) and
* dual->conventional (Tal1tab) bases
*/
extern unsigned char Taltab[],Tal1tab[];
lib/sfrsd2/rsdtest.f90
+34
View File
@@ -0,0 +1,34 @@
program rsdtest
real s3(64,63)
character msg*22,arg*12
integer param(0:7)
nargs=iargc()
if(nargs.ne.2) then
print*,'Usage: rsdtest ntrials nfiles'
go to 999
endif
call getarg(1,arg)
read(arg,*) ntrials
call getarg(2,arg)
read(arg,*) nfiles
open(10,file='s3_1000.bin',access='stream', status='old')
open(22,file='kvasd.dat',access='direct',recl=1024,status='unknown')
nadd=1
ifile0=0
if(nfiles.lt.0) then
ifile0=-nfiles
nfiles=99999
endif
do ifile=1,nfiles
read(10,end=999) s3
if(ifile.lt.ifile0) cycle
call extract2(s3,nadd,ntrials,param,msg)
if(ifile.eq.ifile0) exit
enddo
999 end program rsdtest
lib/sfrsd2/sfrsd.c
+137
View File
@@ -0,0 +1,137 @@
/*
sfrsd.c
A soft-decision decoder for the JT65 (63,12) Reed-Solomon code.
This decoding scheme is built around Phil Karn's Berlekamp-Massey
errors and erasures decoder. The approach is inspired by a number of
publications, including the stochastic Chase decoder described
in "Stochastic Chase Decoding of Reed-Solomon Codes", by Leroux et al.,
IEEE Communications Letters, Vol. 14, No. 9, September 2010 and
"Soft-Decision Decoding of Reed-Solomon Codes Using Successive Error-
and-Erasure Decoding," by Soo-Woong Lee and B. V. K. Vijaya Kumar.
Steve Franke K9AN, Urbana IL, September 2015
*/
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <time.h>
#include <string.h>
#include "sfrsd2.h"
//***************************************************************************
void usage(void)
{
printf("Usage: sfrsd [options...] <path to kvasd.dat>\n");
printf(" input file should be in kvasd format\n");
printf("\n");
printf("Options:\n");
printf(" -n number of random erasure vectors to try\n");
printf(" -v verbose\n");
}
int main(int argc, char *argv[]){
extern char *optarg;
extern int optind;
int correct[63], indx[63], param[8];
int c,i;
char *infile;
FILE *datfile, *logfile;
int nsec, maxe, nads;
float xlambda;
int mrsym[63],mrprob[63],mr2sym[63],mr2prob[63];
int nsec2,ncount,dat4[12];
int ntrials, nverbose, ntry;
int nhard;
double tt;
ntrials=10000;
nverbose=1;
while ( (c = getopt(argc, argv, "n:qv")) !=-1 ) {
switch (c) {
case 'n':
ntrials=(int)strtof(optarg,NULL);
printf("ntrials set to %d\n",ntrials);
break;
case 'v':
nverbose=1;
break;
case 'q': //accept (and ignore) -q option for WSJT10 compatibility
break;
case '?':
usage();
exit(1);
}
}
if( optind+1 > argc) {
// usage();
// exit(1);
infile="kvasd.dat";
} else {
infile=argv[optind];
}
logfile=fopen("/tmp/sfrsd.log","a");
if( !logfile ) {
printf("Unable to open sfrsd.log\n");
exit(1);
}
datfile=fopen(infile,"rb");
if( !datfile ) {
printf("Unable to open kvasd.dat\n");
exit(1);
} else {
fread(&nsec,sizeof(int),1,datfile);
fread(&xlambda,sizeof(float),1,datfile);
fread(&maxe,sizeof(int),1,datfile);
fread(&nads,sizeof(int),1,datfile);
fread(&mrsym,sizeof(int),63,datfile);
fread(&mrprob,sizeof(int),63,datfile);
fread(&mr2sym,sizeof(int),63,datfile);
fread(&mr2prob,sizeof(int),63,datfile);
fread(&nsec2,sizeof(int),1,datfile);
fread(&ncount,sizeof(int),1,datfile);
fread(&dat4,sizeof(int),12,datfile);
fclose(datfile);
}
sfrsd2_(mrsym,mrprob,mr2sym,mr2prob,&ntrials,&nverbose,correct,param,indx,&tt,&ntry);
nhard=param[1];
if( nhard>=0 ) {
for (i=0; i<12; i++) {
dat4[i]=correct[11-i];
}
} else {
nhard=-1;
memset(dat4,0,12*sizeof(int));
}
datfile=fopen(infile,"wb");
if( !datfile ) {
printf("Unable to open kvasd.dat\n");
return 1;
} else {
fwrite(&nsec,sizeof(int),1,datfile);
fwrite(&xlambda,sizeof(float),1,datfile);
fwrite(&maxe,sizeof(int),1,datfile);
fwrite(&nads,sizeof(int),1,datfile);
fwrite(&mrsym,sizeof(int),63,datfile);
fwrite(&mrprob,sizeof(int),63,datfile);
fwrite(&mr2sym,sizeof(int),63,datfile);
fwrite(&mr2prob,sizeof(int),63,datfile);
fwrite(&nsec2,sizeof(int),1,datfile);
fwrite(&nhard,sizeof(int),1,datfile);
fwrite(&dat4,sizeof(int),12,datfile);
fclose(datfile);
}
exit(0);
}
lib/sfrsd2/sfrsd2.c
+270
View File
@@ -0,0 +1,270 @@
/*
sfrsd2.c
A soft-decision decoder for the JT65 (63,12) Reed-Solomon code.
This decoding scheme is built around Phil Karn's Berlekamp-Massey
errors and erasures decoder. The approach is inspired by a number of
publications, including the stochastic Chase decoder described
in "Stochastic Chase Decoding of Reed-Solomon Codes", by Leroux et al.,
IEEE Communications Letters, Vol. 14, No. 9, September 2010 and
"Soft-Decision Decoding of Reed-Solomon Codes Using Successive Error-
and-Erasure Decoding," by Soo-Woong Lee and B. V. K. Vijaya Kumar.
Steve Franke K9AN and Joe Taylor K1JT
*/
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <time.h>
#include <string.h>
#include "rs2.h"
static void *rs;
void sfrsd2_(int mrsym[], int mrprob[], int mr2sym[], int mr2prob[],
int* ntrials0, int* verbose0, int correct[], int param[],
int indexes[], double tt[], int ntry[])
{
int rxdat[63], rxprob[63], rxdat2[63], rxprob2[63];
int workdat[63];
int era_pos[51];
int i, j, numera, nerr, nn=63, kk=12;
FILE *datfile, *logfile;
int ntrials = *ntrials0;
int verbose = *verbose0;
int nhard=0,nhard_min=32768,nsoft=0,nsoft_min=32768;
int nsofter=0,nsofter_min=32768,ntotal=0,ntotal_min=32768,ncandidates;
int nera_best;
clock_t t0=0,t1=0;
static unsigned int nseed;
/* For JT exp(x) symbol metrics - gaussian noise, no fading
int perr[8][8] = {
12, 31, 44, 52, 60, 57, 50, 50,
28, 38, 49, 58, 65, 69, 64, 80,
40, 41, 53, 62, 66, 73, 76, 81,
50, 53, 53, 64, 70, 76, 77, 81,
50, 50, 52, 60, 71, 72, 77, 84,
50, 50, 56, 62, 67, 73, 81, 85,
50, 50, 71, 62, 70, 77, 80, 85,
50, 50, 62, 64, 71, 75, 82, 87};
*/
/* For JT exp(x) symbol metrics - hf conditions
int perr[8][8] = {
10, 10, 10, 12, 13, 15, 15, 9,
28, 30, 43, 50, 61, 58, 50, 34,
40, 40, 50, 53, 70, 65, 58, 45,
50, 50, 53, 74, 71, 68, 66, 52,
50, 50, 52, 45, 67, 70, 70, 60,
50, 50, 56, 73, 55, 74, 69, 67,
50, 50, 70, 81, 81, 69, 76, 75,
50, 50, 62, 57, 77, 81, 73, 78};
*/
// For SF power-percentage symbol metrics - composite gnnf/hf
int perr[8][8] = {
4, 9, 11, 13, 14, 14, 15, 15,
2, 20, 20, 30, 40, 50, 50, 50,
7, 24, 27, 40, 50, 50, 50, 50,
13, 25, 35, 46, 52, 70, 50, 50,
17, 30, 42, 54, 55, 64, 71, 70,
25, 39, 48, 57, 64, 66, 77, 77,
32, 45, 54, 63, 66, 75, 78, 83,
51, 58, 57, 66, 72, 77, 82, 86};
//
/* For SF power-percentage symbol metrics - gaussian noise, no fading
int perr[8][8] = {
1, 10, 10, 20, 30, 50, 50, 50,
2, 20, 20, 30, 40, 50, 50, 50,
7, 24, 27, 40, 50, 50, 50, 50,
13, 25, 35, 46, 52, 70, 50, 50,
17, 30, 42, 54, 55, 64, 71, 70,
25, 39, 48, 57, 64, 66, 77, 77,
32, 45, 54, 63, 66, 75, 78, 83,
51, 58, 57, 66, 72, 77, 82, 86};
*/
/* For SF power-percentage symbol metrics - hf
int perr[8][8] = {
4, 9, 11, 13, 14, 14, 15, 15,
9, 12, 14, 25, 28, 30, 50, 50,
18, 22, 22, 28, 32, 35, 50, 50,
30, 35, 38, 38, 57, 50, 50, 50,
43, 46, 45, 53, 50, 64, 70, 50,
56, 58, 58, 57, 67, 66, 80, 77,
65, 72, 73, 72, 67, 75, 80, 83,
70, 74, 73, 70, 75, 77, 80, 86};
*/
if(verbose) {
logfile=fopen("/tmp/sfrsd.log","a");
if( !logfile ) {
printf("Unable to open sfrsd.log\n");
exit(1);
}
}
// Initialize the KA9Q Reed-Solomon encoder/decoder
unsigned int symsize=6, gfpoly=0x43, fcr=3, prim=1, nroots=51;
rs=init_rs_int(symsize, gfpoly, fcr, prim, nroots, 0);
// Reverse the received symbol vector for BM decoder
for (i=0; i<63; i++) {
rxdat[i]=mrsym[62-i];
rxprob[i]=mrprob[62-i];
rxdat2[i]=mr2sym[62-i];
rxprob2[i]=mr2prob[62-i];
}
// Sort the mrsym probabilities to find the least reliable symbols
int k, pass, tmp, nsym=63;
int probs[63];
for (i=0; i<63; i++) {
indexes[i]=i;
probs[i]=rxprob[i];
}
for (pass = 1; pass <= nsym-1; pass++) {
for (k = 0; k < nsym - pass; k++) {
if( probs[k] < probs[k+1] ) {
tmp = probs[k];
probs[k] = probs[k+1];
probs[k+1] = tmp;
tmp = indexes[k];
indexes[k] = indexes[k+1];
indexes[k+1] = tmp;
}
}
}
// See if we can decode using BM HDD, and calculate the syndrome vector.
memset(era_pos,0,51*sizeof(int));
numera=0;
memcpy(workdat,rxdat,sizeof(rxdat));
nerr=decode_rs_int(rs,workdat,era_pos,numera,1);
if( nerr >= 0 ) {
if(verbose) {
fprintf(logfile,"BM decode nerrors= %3d : \n",nerr);
fclose(logfile);
}
memcpy(correct,workdat,63*sizeof(int));
param[0]=0;
param[1]=0;
param[2]=0;
param[3]=0;
param[4]=0;
ntry[0]=0;
return;
}
/*
Generate random erasure-locator vectors and see if any of them
decode. This will generate a list of potential codewords. The
"soft" distance between each codeword and the received word is
used to decide which codeword is "best".
*/
nseed=1; //Seed for random numbers
float ratio, ratio0[63];
int thresh, nsum;
int thresh0[63];
ncandidates=0;
nsum=0;
int ii,jj;
for (i=0; i<nn; i++) {
nsum=nsum+rxprob[i];
j = indexes[62-i];
ratio = (float)rxprob2[j]/((float)rxprob[j]+0.01);
ratio0[i]=ratio;
ii = 7.999*ratio;
jj = (62-i)/8;
thresh0[i] = 1.3*perr[ii][jj];
}
if(nsum==0) return;
for (k=0; k<ntrials; k++) {
memset(era_pos,0,51*sizeof(int));
memcpy(workdat,rxdat,sizeof(rxdat));
/*
Mark a subset of the symbols as erasures.
Run through the ranked symbols, starting with the worst, i=0.
NB: j is the symbol-vector index of the symbol with rank i.
*/
numera=0;
for (i=0; i<nn; i++) {
j = indexes[62-i];
thresh=thresh0[i];
long int ir;
// Generate a random number ir, 0 <= ir < 100 (see POSIX.1-2001 example).
nseed = nseed * 1103515245 + 12345;
ir = (unsigned)(nseed/65536) % 32768;
ir = (100*ir)/32768;
if((ir < thresh ) && numera < 51) {
era_pos[numera]=j;
numera=numera+1;
}
}
t0=clock();
nerr=decode_rs_int(rs,workdat,era_pos,numera,0);
t1=clock();
tt[0]+=(double)(t1-t0)/CLOCKS_PER_SEC;
if( nerr >= 0 ) {
ncandidates=ncandidates+1;
nhard=0;
nsoft=0;
nsofter=0;
for (i=0; i<63; i++) {
if(workdat[i] != rxdat[i]) {
nhard=nhard+1;
nsofter=nsofter+rxprob[i];
if(workdat[i] != rxdat2[i]) {
nsoft=nsoft+rxprob[i];
}
} else {
nsofter=nsofter-rxprob[i];
}
}
nsoft=63*nsoft/nsum;
nsofter=63*nsofter/nsum;
ntotal=nsoft+nhard;
if( ntotal<ntotal_min ) {
nsoft_min=nsoft;
nhard_min=nhard;
nsofter_min=nsofter;
ntotal_min=ntotal;
memcpy(correct,workdat,63*sizeof(int));
nera_best=numera;
ntry[0]=k;
}
if(ntotal_min<72 && nhard_min<42) break;
}
if(k == ntrials-1) ntry[0]=k+1;
}
if( ntotal_min>=76 || nhard>=44 ) {
nhard_min=-1;
}
if(verbose) {
fprintf(logfile,"ncand %4d nhard %4d nsoft %4d nhard+nsoft %4d nsum %8d\n",
ncandidates,nhard_min,nsoft_min,ntotal_min,nsum);
fclose(logfile);
}
param[0]=ncandidates;
param[1]=nhard_min;
param[2]=nsoft_min;
param[3]=nera_best;
param[4]=nsofter_min;
if(param[0]==0) param[2]=-1;
return;
}
lib/sfrsd2/sfrsd2.h
+3
View File
@@ -0,0 +1,3 @@
void sfrsd2_(int mrsym[], int mrprob[], int mr2sym[], int mr2prob[],
int* ntrials0, int* verbose0, int correct[], int param[],
int indexes[], double tt[], int ntry[]);
lib/sfrsd2/sfrsd3.c
+243
View File
@@ -0,0 +1,243 @@
/*
sfrsd2.c
A soft-decision decoder for the JT65 (63,12) Reed-Solomon code.
This decoding scheme is built around Phil Karn's Berlekamp-Massey
errors and erasures decoder. The approach is inspired by a number of
publications, including the stochastic Chase decoder described
in "Stochastic Chase Decoding of Reed-Solomon Codes", by Leroux et al.,
IEEE Communications Letters, Vol. 14, No. 9, September 2010 and
"Soft-Decision Decoding of Reed-Solomon Codes Using Successive Error-
and-Erasure Decoding," by Soo-Woong Lee and B. V. K. Vijaya Kumar.
Steve Franke K9AN and Joe Taylor K1JT
*/
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <time.h>
#include <string.h>
#include "rs2.h"
static void *rs;
void sfrsd2_(int mrsym[], int mrprob[], int mr2sym[], int mr2prob[],
int* ntrials0, int* verbose0, int correct[], int param[],
int indexes[], double tt[], int ntry[])
{
int rxdat[63], rxprob[63], rxdat2[63], rxprob2[63];
int workdat[63],workdat2[63];
int era_pos[51];
int c, i, j, numera, nmr2, nerr, nn=63, kk=12;
FILE *datfile, *logfile;
int ntrials = *ntrials0;
int verbose = *verbose0;
int nhard=0,nhard_min=32768,nsoft=0,nsoft_min=32768, ncandidates;
int ngmd,nera_best;
clock_t t0=0,t1=0;
int perr[8][8] = {
12, 31, 44, 52, 60, 57, 50, 50,
28, 38, 49, 58, 65, 69, 64, 80,
40, 41, 53, 62, 66, 73, 76, 81,
50, 53, 53, 64, 70, 76, 77, 81,
50, 50, 52, 60, 71, 72, 77, 84,
50, 50, 56, 62, 67, 73, 81, 85,
50, 50, 71, 62, 70, 77, 80, 85,
50, 50, 62, 64, 71, 75, 82, 87};
int pmr2[8][8] = {
4, 8, 9, 7, 6, 0, 0, 0,
13, 18, 15, 11, 9, 7, 5, 0,
0, 23, 21, 15, 12, 10, 7, 4,
0, 34, 28, 20, 16, 14, 11, 7,
0, 20, 26, 25, 19, 14, 12, 9,
0, 0, 28, 27, 22, 19, 14, 11,
0, 0, 40, 29, 29, 23, 18, 12,
0, 0, 40, 35, 31, 21, 20, 13};
if(verbose) {
logfile=fopen("sfrsd.log","a");
if( !logfile ) {
printf("Unable to open sfrsd.log\n");
exit(1);
}
}
// Initialize the KA9Q Reed-Solomon encoder/decoder
unsigned int symsize=6, gfpoly=0x43, fcr=3, prim=1, nroots=51;
rs=init_rs_int(symsize, gfpoly, fcr, prim, nroots, 0);
// Reverse the received symbol vector for BM decoder
for (i=0; i<63; i++) {
rxdat[i]=mrsym[62-i];
rxprob[i]=mrprob[62-i];
rxdat2[i]=mr2sym[62-i];
rxprob2[i]=mr2prob[62-i];
}
// Sort the mrsym probabilities to find the least reliable symbols
int k, pass, tmp, nsym=63;
int probs[63];
for (i=0; i<63; i++) {
indexes[i]=i;
probs[i]=rxprob[i];
}
for (pass = 1; pass <= nsym-1; pass++) {
for (k = 0; k < nsym - pass; k++) {
if( probs[k] < probs[k+1] ) {
tmp = probs[k];
probs[k] = probs[k+1];
probs[k+1] = tmp;
tmp = indexes[k];
indexes[k] = indexes[k+1];
indexes[k+1] = tmp;
}
}
}
// See if we can decode using BM HDD, and calculate the syndrome vector.
memset(era_pos,0,51*sizeof(int));
numera=0;
memcpy(workdat,rxdat,sizeof(rxdat));
nerr=decode_rs_int(rs,workdat,era_pos,numera,1);
if( nerr >= 0 ) {
if(verbose) fprintf(logfile," BM decode nerrors= %3d : ",nerr);
memcpy(correct,workdat,63*sizeof(int));
ngmd=-1;
param[0]=0;
param[1]=0;
param[2]=0;
param[3]=0;
param[4]=0;
return;
}
/*
Generate random erasure-locator vectors and see if any of them
decode. This will generate a list of potential codewords. The
"soft" distance between each codeword and the received word is
used to decide which codeword is "best".
*/
#ifdef WIN32
srand(0xdeadbeef);
#else
srandom(0xdeadbeef);
#endif
float ratio, ratio0[63];
int threshe, thresh2, nsum;
int thresh0[63],thresh1[63], mr2flag;
ncandidates=0;
nsum=0;
int ii,jj;
for (i=0; i<nn; i++) {
nsum=nsum+rxprob[i];
j = indexes[62-i];
ratio = (float)rxprob2[j]/(float)rxprob[j];
ratio0[i]=ratio;
ii = 7.999*ratio;
jj = (62-i)/8;
thresh0[i] = 1.3*perr[ii][jj];
thresh1[i] = 0.4*pmr2[ii][jj];
}
if(nsum==0) return;
for( k=0; k<ntrials; k++) {
memset(era_pos,0,51*sizeof(int));
memcpy(workdat,rxdat,sizeof(rxdat));
/*
Mark a subset of the symbols as erasures.
Run through the ranked symbols, starting with the worst, i=0.
NB: j is the symbol-vector index of the symbol with rank i.
*/
numera=0;
nmr2=0;
for (i=0; i<nn; i++) {
j = indexes[62-i];
threshe=thresh0[i];
thresh2=thresh1[i];
long int ir, ir2;
#ifdef WIN32
ir=rand();
ir2=rand();
#else
ir=random();
ir2=random();
#endif
if( ((ir % 100) < threshe ) && (numera+2*nmr2) < 51 ) {
era_pos[numera]=j;
numera=numera+1;
}
if( ((ir2 % 100) < thresh2) && (numera+2*nmr2)<51) {
workdat[j]=rxdat2[j];
nmr2=nmr2+1;
}
}
t0=clock();
// rs=init_rs_int(symsize, gfpoly, fcr, prim, nroots, 1);
nerr=decode_rs_int(rs,workdat,era_pos,numera,1);
t1=clock();
tt[0]+=(double)(t1-t0)/CLOCKS_PER_SEC;
if( nerr >= 0 ) {
ncandidates=ncandidates+1;
nhard=0;
nsoft=0;
for (i=0; i<63; i++) {
if(workdat[i] != rxdat[i]) {
nhard=nhard+1;
if(workdat[i] != rxdat2[i]) {
nsoft=nsoft+rxprob[i];
}
}
}
nsoft=63*nsoft/nsum;
if((nsoft < 33) && (nhard < 43) && (nhard+nsoft) < 74) { //???
if( (nsoft < nsoft_min) ) {
nsoft_min=nsoft;
nhard_min=nhard;
memcpy(correct,workdat,63*sizeof(int));
ngmd=0;
nera_best=numera;
ntry[0]=k;
}
}
if(nsoft_min < 27) break;
if((nsoft_min < 32) && (nhard_min < 43) &&
(nhard_min+nsoft_min) < 74) break;
}
if(k == ntrials-1) ntry[0]=k+1;
}
if(verbose) fprintf(logfile,
"%d trials and %d candidates after stochastic loop\n",k,ncandidates);
if( (ncandidates >= 0) && (nsoft_min < 36) && (nhard_min < 44) ) {
if(verbose) {
for (i=0; i<63; i++) {
fprintf(logfile,"%3d %3d %3d %3d %3d %3d\n",i,correct[i],
rxdat[i],rxprob[i],rxdat2[i],rxprob2[i]);
}
fprintf(logfile,"**** ncandidates %d nhard %d nsoft %d nsum %d\n",
ncandidates,nhard_min,nsoft_min,nsum);
}
} else {
nhard_min=-1;
}
if(verbose) {
fprintf(logfile,"exiting sfrsd\n");
fclose(logfile);
}
param[0]=ncandidates;
param[1]=nhard_min;
param[2]=nsoft_min;
param[3]=nera_best;
param[4]=ngmd;
if(param[0]==0) param[2]=-1;
return;
}
lib/shell.f90
+27
View File
@@ -0,0 +1,27 @@
subroutine shell(n,a)
integer n
real a(n)
integer i,j,inc
real v
inc=1
1 inc=3*inc+1
if(inc.le.n) go to 1
2 inc=inc/3
do i=inc+1,n
v=a(i)
j=i
3 if(a(j-inc).gt.v) then
a(j)=a(j-inc)
j=j-inc
if(j.le.inc) go to 4
go to 3
endif
4 a(j)=v
enddo
if(inc.gt.1) go to 2
return
end subroutine shell
lib/slope.f90
+9 -10
View File
@@ -4,11 +4,6 @@ subroutine slope(y,npts,xpk)
! ignore the peak around xpk +/- 2.
real y(npts)
real x(100)
do i=1,npts
x(i)=i
enddo
sumw=0.
sumx=0.
@@ -16,14 +11,14 @@ subroutine slope(y,npts,xpk)
sumx2=0.
sumxy=0.
sumy2=0.
do i=1,npts
if(abs(i-xpk).gt.2.0) then
sumw=sumw + 1.0
sumx=sumx + x(i)
x=i
sumx=sumx + x
sumy=sumy + y(i)
sumx2=sumx2 + x(i)**2
sumxy=sumxy + x(i)*y(i)
sumx2=sumx2 + x*x
sumxy=sumxy + x*y(i)
sumy2=sumy2 + y(i)**2
endif
enddo
@@ -32,9 +27,13 @@ subroutine slope(y,npts,xpk)
a=(sumx2*sumy - sumx*sumxy) / delta
b=(sumw*sumxy - sumx*sumy) / delta
sq=0.
do i=1,npts
y(i)=y(i)-(a + b*x(i))
y(i)=y(i)-(a + b*i)
if(abs(i-xpk).gt.2.0) sq=sq + y(i)**2
enddo
rms=sqrt(sq/(sumw-2.0))
y=y/rms
return
end subroutine slope
lib/softsym9f.f90
+55
View File
@@ -0,0 +1,55 @@
subroutine softsym9f(ss2,ss3,i1SoftSymbols)
! Compute soft symbols and S/N
real ss2(0:8,85)
real ss3(0:7,69)
integer*1 i1SoftSymbolsScrambled(207)
integer*1 i1SoftSymbols(207)
ss=0.
sig=0.
if(ss2(0,1).eq.-999.0) return !Silence compiler warning
do j=1,69
smax=0.
do i=0,7
smax=max(smax,ss3(i,j))
ss=ss+ss3(i,j)
enddo
sig=sig+smax
ss=ss-smax
enddo
ave=ss/(69*7) !Baseline
! call pctile(ss2,9*85,35,xmed) !### better? ###
ss3=ss3/ave
sig=sig/69. !Signal
m0=3
k=0
scale=10.0
do j=1,69
do m=m0-1,0,-1 !Get bit-wise soft symbols
if(m.eq.2) then
r1=max(ss3(4,j),ss3(5,j),ss3(6,j),ss3(7,j))
r0=max(ss3(0,j),ss3(1,j),ss3(2,j),ss3(3,j))
else if(m.eq.1) then
r1=max(ss3(2,j),ss3(3,j),ss3(4,j),ss3(5,j))
r0=max(ss3(0,j),ss3(1,j),ss3(6,j),ss3(7,j))
else
r1=max(ss3(1,j),ss3(2,j),ss3(4,j),ss3(7,j))
r0=max(ss3(0,j),ss3(3,j),ss3(5,j),ss3(6,j))
endif
k=k+1
i4=nint(scale*(r1-r0))
if(i4.lt.-127) i4=-127
if(i4.gt.127) i4=127
i1SoftSymbolsScrambled(k)=i4
enddo
enddo
call interleave9(i1SoftSymbolsScrambled,-1,i1SoftSymbols)
return
end subroutine softsym9f
lib/sort.f90
+9
View File
@@ -9,6 +9,7 @@ subroutine sort(n,arr)
jstack=0
l=1
ir=n
n0=n
1 if(ir-l.lt.m) then
do j=l+1,ir
@@ -55,6 +56,14 @@ subroutine sort(n,arr)
j=ir
a=arr(l)
3 i=i+1
if(i.gt.n0) then
do jj=1,n0
write(99,3001) jj,arr(jj),i,n,ir
3001 format(i10,e12.3,3i10)
enddo
close(99)
stop 'Bounds error in sort.f90'
endif
if(arr(i).lt.a) goto 3
4 j=j-1
lib/spec9f.f90
+30
View File
@@ -0,0 +1,30 @@
subroutine spec9f(id2,npts,nsps,s1,jz,nq)
! Compute symbol spectra at quarter-symbol steps.
integer*2 id2(0:npts)
real s1(nq,jz)
real x(960)
complex c(0:480)
equivalence (x,c)
nfft=2*nsps !FFTs at twice the symbol length
nh=nfft/2
do j=1,jz
ia=(j-1)*nsps/4
ib=ia+nsps-1
if(ib.gt.npts) exit
x(1:nh)=id2(ia:ib)
x(nh+1:)=0.
call four2a(x,nfft,1,-1,0) !r2c
k=mod(j-1,340)+1
do i=1,NQ
s1(i,j)=1.e-10*(real(c(i))**2 + aimag(c(i))**2)
enddo
enddo
!### Reference spectrum should be applied here (or possibly earlier?) ###
!### Normalize so that rms (or level?) is 1.0 ? ###
return
end subroutine spec9f
lib/subtract65.f90
+110
View File
@@ -0,0 +1,110 @@
subroutine subtract65(dd,npts,f0,dt)
! Subtract a jt65 signal
!
! Measured signal : dd(t) = a(t)cos(2*pi*f0*t+theta(t))
! Reference signal : cref(t) = exp( j*(2*pi*f0*t+phi(t)) )
! Complex amp : cfilt(t) = LPF[ dd(t)*CONJG(cref(t)) ]
! Subtract : dd(t) = dd(t) - 2*REAL{cref*cfilt}
use packjt
integer correct(63)
parameter (NMAX=60*12000) !Samples per 60 s
parameter (NFILT=1600)
real*4 dd(NMAX), window(-NFILT/2:NFILT/2)
complex cref,camp,cfilt,cw
integer nprc(126)
real*8 dphi,phi
logical first
data nprc/ &
1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, &
0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, &
0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, &
0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, &
1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, &
0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, &
1,1,1,1,1,1/
data first/.true./
common/chansyms65/correct
common/heap1/cref(NMAX),camp(NMAX),cfilt(NMAX),cw(NMAX)
save first
pi=4.0*atan(1.0)
! Symbol duration is 4096/11025 s.
! Sample rate is 12000/s, so 12000*(4096/11025)=4458.23 samples/symbol.
! For now, call it 4458 samples/symbol. Over the message duration, we'll be off
! by about (4458.23-4458)*126=28.98 samples; 29 samples, or 0.7% of 1 symbol.
! Could eliminate accumulated error by injecting one extra sample every
! 5 or so symbols... Maybe try this later.
nstart=dt*12000+1;
nsym=126
ns=4458
nref=nsym*ns
nend=nstart+nref-1
phi=0.0
iref=1
ind=1
isym=1
call timer('subtr_1 ',0)
do k=1,nsym
if( nprc(k) .eq. 1 ) then
omega=2*pi*f0
else
omega=2*pi*(f0+2.6917*(correct(isym)+2))
isym=isym+1
endif
dphi=omega/12000.0
do i=1,ns
cref(ind)=cexp(cmplx(0.0,phi))
phi=modulo(phi+dphi,2*pi)
id=nstart-1+ind
if(id.ge.1) camp(ind)=dd(id)*conjg(cref(ind))
ind=ind+1
enddo
enddo
call timer('subtr_1 ',1)
call timer('subtr_2 ',0)
! Smoothing filter: do the convolution by means of FFTs. Ignore end-around
! cyclic effects for now.
nfft=564480
if(first) then
! Create and normalize the filter
sum=0.0
do j=-NFILT/2,NFILT/2
window(j)=cos(pi*j/NFILT)**2
sum=sum+window(j)
enddo
cw=0.
do i=-NFILT/2,NFILT/2
j=i+1
if(j.lt.1) j=j+nfft
cw(j)=window(i)/sum
enddo
call four2a(cw,nfft,1,-1,1)
first=.false.
endif
nz=561708
cfilt(1:nz)=camp(1:nz)
cfilt(nz+1:nfft)=0.
call four2a(cfilt,nfft,1,-1,1)
fac=1.0/float(nfft)
cfilt(1:nfft)=fac*cfilt(1:nfft)*cw(1:nfft)
call four2a(cfilt,nfft,1,1,1)
call timer('subtr_2 ',1)
! Subtract the reconstructed signal
call timer('subtr_3 ',0)
do i=1,nref
j=nstart+i-1
if(j.ge.1 .and. j.le.npts) dd(j)=dd(j)-2*REAL(cfilt(i)*cref(i))
enddo
call timer('subtr_3 ',1)
return
end subroutine subtract65
lib/sync65.f90
+77
View File
@@ -0,0 +1,77 @@
subroutine sync65(ss,nfa,nfb,nhsym,ca,ncand,nrobust)
parameter (NSZ=3413,NFFT=8192,MAXCAND=300)
real ss(322,NSZ)
real ccfblue(-5:540) !CCF with pseudorandom sequence
real ccfred(NSZ) !Peak of ccfblue, as function of freq
type candidate
real freq
real dt
real sync
end type candidate
type(candidate) ca(MAXCAND)
common/steve/thresh0
call setup65
df=12000.0/NFFT !df = 12000.0/16384 = 0.732 Hz
ia=max(2,nint(nfa/df))
ib=min(NSZ-1,nint(nfb/df))
lag1=-5
lag2=59
nsym=126
!! thresh0=5.5
ncand=0
fdot=0.
ccfred=0.
ccfblue=0.
do i=ia,ib
call xcor(ss,i,nhsym,nsym,lag1,lag2,ccfblue,ccf0,lagpk0,flip,fdot,nrobust)
! Remove best-fit slope from ccfblue and normalize so baseline rms=1.0
call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0)
ccfred(i)=ccfblue(lagpk0)
enddo
call pctile(ccfred(ia:ib),ib-ia+1,35,xmed)
ccfred(ia:ib)=ccfred(ia:ib)-xmed
ccfred(ia-1)=ccfred(ia)
ccfred(ib+1)=ccfred(ib)
do i=ia,ib
freq=i*df
itry=0
if(ccfred(i).gt.thresh0 .and. ccfred(i).gt.ccfred(i-1) .and. &
ccfred(i).gt.ccfred(i+1)) then
itry=1
ncand=ncand+1
endif
! write(79,1010) i,freq,ccfred(i),itry,ncand
!1010 format(i6,2f10.2,i5,i6)
! flush(79)
if(itry.ne.0) then
call xcor(ss,i,nhsym,nsym,lag1,lag2,ccfblue,ccf0,lagpk,flip,fdot,nrobust)
call slope(ccfblue(lag1),lag2-lag1+1,lagpk-lag1+1.0)
xlag=lagpk
if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then
call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2)
xlag=lagpk+dx2
endif
dtx=xlag*2048.0/11025.0
ccfblue(lag1)=0.
ccfblue(lag2)=0.
! open(14,file="/tmp/fort.14",access="append")
! do j=lag1,lag2
! write(14,1020) j,ccfblue(j)
!1020 format(i5,f10.3)
! enddo
! close(14)
ca(ncand)%freq=freq
ca(ncand)%dt=dtx
ca(ncand)%sync=ccfred(i)
endif
if(ncand.eq.MAXCAND) return
enddo
return
end subroutine sync65
lib/sync9f.f90
+55
View File
@@ -0,0 +1,55 @@
subroutine sync9f(s2,nq,nfa,nfb,ss2,ss3,lagpk,ipk,ccfbest)
! Look for JT9 sync pattern in the folded symbol spectra, s2.
! Frequency search extends from nfa to nfb. Synchronized symbol
! spectra are put into ss2() and ss3().
integer ii4(16)
real s2(240,340)
real ss2(0:8,85)
real ss3(0:7,69)
include 'jt9sync.f90'
ii4=4*ii-3
ccf=0.
ccfbest=0.
nfft=4*nq
df=12000.0/nfft
ia=nfa/df
ib=nfb/df + 0.9999
do i=ia,ib
do lag=0,339
t=0.
do n=1,16
j=ii4(n)+lag
if(j.gt.340) j=j-340
t=t + s2(i,j)
enddo
if(t.gt.ccfbest) then
lagpk=lag
ipk=i
ccfbest=t
endif
enddo
enddo
do i=0,8
j4=lagpk-4
i2=2*i + ipk
if(i2.lt.1) i2=1
m=0
do j=1,85
j4=j4+4
if(j4.gt.340) j4=j4-340
if(j4.lt.1) j4=j4+340
ss2(i,j)=s2(i2,j4)
if(i.ge.1 .and. isync(j).eq.0) then
m=m+1
ss3(i-1,m)=ss2(i,j)
endif
enddo
enddo
return
end subroutine sync9f
lib/synciscat.f90
+192
View File
@@ -0,0 +1,192 @@
subroutine synciscat(cdat,npts,nh,npct,s0,jsym,df,ntol,NFreeze, &
MouseDF,mousebutton,mode4,nafc,psavg,xsync,sig,ndf0,msglen, &
ipk,jpk,idf,df1)
! Synchronize an ISCAT signal
! cdat() is the downsampled analytic signal.
! Sample rate = fsample = BW = 11025 * (9/32) = 3100.78125 Hz
! npts, nsps, etc., are all reduced by 9/32
parameter (NMAX=30*3101)
parameter (NSZ=4*1400)
complex cdat(NMAX)
complex c(288)
real s0(288,NSZ)
real fs0(288,96) !108 = 96 + 3*4
real savg(288)
real sref(288)
real psavg(72) !Average spectrum of whole file
integer icos(4)
data icos/0,1,3,2/
data nsync/4/,nlen/2/,ndat/18/
! Silence compiler warnings:
sigbest=-20.0
ndf0best=0
msglenbest=0
ipkbest=0
jpkbest=0
ipk2=0
idfbest=mousebutton
fsample=3100.78125 !New sample rate
nsps=144/mode4
nsym=npts/nsps - 1
nblk=nsync+nlen+ndat
nfft=2*nsps !FFTs at twice the symbol length,
kstep=nsps/4 ! stepped by 1/4 symbol
df=fsample/nfft
fac=1.0/1000.0 !Somewhat arbitrary
savg=0.
ia=1-kstep
do j=1,4*nsym !Compute symbol spectra
ia=ia+kstep
ib=ia+nsps-1
if(ib.gt.npts) exit
c(1:nsps)=fac*cdat(ia:ib)
c(nsps+1:nfft)=0.
call four2a(c,nfft,1,-1,1)
do i=1,nfft
s0(i,j)=real(c(i))**2 + aimag(c(i))**2
savg(i)=savg(i) + s0(i,j) !Accumulate avg spectrum
enddo
i0=40
enddo
jsym=4*nsym
savg=savg/jsym
do i=1,71 !Compute spectrum in dB, for plot
if(mode4.eq.1) then
psavg(i)=2*db(savg(4*i)+savg(4*i-1)+savg(4*i-2)+savg(4*i-3)) + 1.0
else
psavg(i)=2*db(savg(2*i)+savg(2*i-1)) + 7.0
endif
enddo
do i=nh+1,nfft-nh
call pctile(savg(i-nh),2*nh+1,npct,sref(i))
enddo
sref(1:nh)=sref(nh+11)
sref(nfft-nh+1:nfft)=sref(nfft-nh)
do i=1,nfft !Normalize the symbol spectra
fac=1.0/sref(i)
if(i.lt.11) fac=1.0/savg(11)
do j=1,jsym
s0(i,j)=fac*s0(i,j)
enddo
enddo
nfold=jsym/96
jb=96*nfold
ttot=npts/fsample !Length of record (s)
df1=df/ttot !Step size for f1=fdot
idf1=-25.0/df1
idf2=5.0/df1
if(nafc.eq.0) then
idf1=0
idf2=0
else if(mod(-idf1,2).eq.1) then
idf1=idf1-1
endif
xsyncbest=0.
do idf=idf1,idf2 !Loop over fdot
fs0=0.
do j=1,jb !Fold s0 into fs0, modulo 4*nblk
k=mod(j-1,4*nblk)+1
ii=nint(idf*float(j-jb/2)/float(jb))
ia=max(1-ii,1)
ib=min(nfft-ii,nfft)
do i=ia,ib
fs0(i,k)=fs0(i,k) + s0(i+ii,j)
enddo
enddo
ref=nfold*4
i0=27
ia=i0-400/df !Set search range in frequency...
ib=i0+400/df
if(mode4.eq.1) then
i0=95
ia=i0-600/df !Set search range in frequency...
ib=i0+600/df
endif
if(nfreeze.eq.1) then
ia=i0+(mousedf-ntol)/df
ib=i0+(mousedf+ntol)/df
endif
if(ia.lt.1) ia=1
if(ib.gt.nfft-3) ib=nfft-3
smax=0.
ipk=1
jpk=1
do j=0,4*nblk-1 !Find sync pattern: lags 0-95
do i=ia,ib !Search specified freq range
ss=0.
do n=1,4 !Sum over 4 sync tones
k=j+4*n-3
if(k.gt.96) k=k-96
ss=ss + fs0(i+2*icos(n),k)
enddo
if(ss.gt.smax) then
smax=ss
ipk=i !Frequency offset, DF
jpk=j+1 !Time offset, DT
endif
enddo
enddo
xsync=smax/ref - 1.0
if(nfold.lt.26) xsync=xsync * sqrt(nfold/26.0)
xsync=xsync-0.5 !Empirical
sig=db(smax/ref - 1.0) - 15.0
if(mode4.eq.1) sig=sig-5.0
! if(sig.lt.-20 .or. xsync.lt.1.0) sig=-20.0
! if(sig.lt.-20) sig=-20.0
ndf0=nint(df*(ipk-i0))
smax=0.
ja=jpk+16
if(ja.gt.4*nblk) ja=ja-4*nblk
jj=jpk+20
if(jj.gt.4*nblk) jj=jj-4*nblk
do i=ipk,ipk+60,2 !Find User's message length
ss=fs0(i,ja) + fs0(i+10,jj)
if(ss.gt.smax) then
smax=ss
ipk2=i
endif
enddo
msglen=(ipk2-ipk)/2
if(msglen.lt.2 .or. msglen.gt.29) msglen=3
if(xsync.ge.xsyncbest) then
xsyncbest=xsync
sigbest=sig
ndf0best=ndf0
msglenbest=msglen
ipkbest=ipk
jpkbest=jpk
idfbest=idf
endif
enddo
xsync=xsyncbest
sig=sigbest
ndf0=ndf0best
msglen=msglenbest
ipk=ipkbest
jpk=jpkbest
idf=idfbest
if(nafc.eq.0) idf=0
return
end subroutine synciscat
lib/syncmsk.f90
+312
View File
@@ -0,0 +1,312 @@
subroutine syncmsk(cdat,npts,jpk,ipk,idf,rmax,snr,metric,decoded)
! Attempt synchronization, and if successful decode using Viterbi algorithm.
use iso_c_binding, only: c_loc,c_size_t
use packjt
use hashing
parameter (NSPM=1404,NSAVE=2000)
complex cdat(npts) !Analytic signal
complex cb(66) !Complex waveform for Barker-11 code
complex cd(0:11,0:3)
complex c(0:NSPM-1) !Complex data for one message length
complex c2(0:NSPM-1)
complex cb3(1:NSPM,3)
real r(12000)
real rdat(12000)
real ss1(12000)
real symbol(234)
real rdata(198)
real rd2(198)
real rsave(NSAVE)
real xp(29)
complex z,z0,z1,z2,z3,cfac
integer*1 e1(198)
integer*1, target :: d8(13)
integer*1 i1hash(4)
integer*1 i1
integer*4 i4Msg6BitWords(12) !72-bit message as 6-bit words
integer mettab(0:255,0:1) !Metric table for BPSK modulation
integer ipksave(NSAVE)
integer jpksave(NSAVE)
integer indx(NSAVE)
integer b11(11) !Barker-11 code
character*22 decoded
character*72 c72
logical first
equivalence (i1,i4)
equivalence (ihash,i1hash)
data xp/0.500000, 0.401241, 0.309897, 0.231832, 0.168095, &
0.119704, 0.083523, 0.057387, 0.039215, 0.026890, &
0.018084, 0.012184, 0.008196, 0.005475, 0.003808, &
0.002481, 0.001710, 0.001052, 0.000789, 0.000469, &
0.000329, 0.000225, 0.000187, 0.000086, 0.000063, &
0.000017, 0.000091, 0.000032, 0.000045/
data first/.true./
data b11/1,1,1,0,0,0,1,0,0,1,0/
save first,cb,cd,twopi,dt,f0,f1,mettab
phi=0.
if(first) then
! Get the metric table
bias=0.0
scale=20.0
xln2=log(2.0)
do i=128,156
x0=log(max(0.0001,2.0*xp(i-127)))/xln2
x1=log(max(0.001,2.0*(1.0-xp(i-127))))/xln2
mettab(i,0)=nint(scale*(x0-bias))
mettab(i,1)=nint(scale*(x1-bias))
mettab(256-i,0)=mettab(i,1)
mettab(256-i,1)=mettab(i,0)
enddo
do i=157,255
mettab(i,0)=mettab(156,0)
mettab(i,1)=mettab(156,1)
mettab(256-i,0)=mettab(i,1)
mettab(256-i,1)=mettab(i,0)
enddo
j=0
twopi=8.0*atan(1.0)
dt=1.0/12000.0
f0=1000.0
f1=2000.0
do i=1,11
if(b11(i).eq.0) dphi=twopi*f0*dt
if(b11(i).eq.1) dphi=twopi*f1*dt
do n=1,6
j=j+1
phi=phi+dphi
cb(j)=cmplx(cos(phi),sin(phi))
enddo
enddo
cb3=0.
cb3(1:66,1)=cb
cb3(283:348,1)=cb
cb3(769:834,1)=cb
cb3(1:66,2)=cb
cb3(487:552,2)=cb
cb3(1123:1188,2)=cb
cb3(1:66,3)=cb
cb3(637:702,3)=cb
cb3(919:984,3)=cb
phi=0.
do n=0,3
k=-1
dphi=twopi*f0*dt
if(n.ge.2) dphi=twopi*f1*dt
do i=0,5
k=k+1
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
cd(k,n)=cmplx(cos(phi),sin(phi))
enddo
dphi=twopi*f0*dt
if(mod(n,2).eq.1) dphi=twopi*f1*dt
do i=6,11
k=k+1
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
cd(k,n)=cmplx(cos(phi),sin(phi))
enddo
enddo
first=.false.
endif
nfft=NSPM
jz=npts-nfft
decoded=" "
ipk=0
jpk=0
metric=-9999
r=0.
call timer('sync1 ',0)
do j=1,jz !Find the Barker-11 sync vectors
z=0.
ss=0.
do i=1,66
ss=ss + real(cdat(j+i-1))**2 + aimag(cdat(j+i-1))**2
z=z + cdat(j+i-1)*conjg(cb(i)) !Signal matching Barker 11
enddo
ss=sqrt(ss/66.0)*66.0
r(j)=abs(z)/(0.908*ss) !Goodness-of-fit to Barker 11
ss1(j)=ss
enddo
call timer('sync1 ',1)
call timer('sync2 ',0)
jz=npts-nfft
rmax=0.
! n1=35, n2=69, n3=94
k=0
do j=1,jz !Find best full-message sync
if(ss1(j).lt.85.0) cycle
r1=r(j) + r(j+282) + r(j+768) ! 6*(12+n1) 6*(24+n1+n2)
r2=r(j) + r(j+486) + r(j+1122) ! 6*(12+n2) 6*(24+n2+n3)
r3=r(j) + r(j+636) + r(j+918) ! 6*(12+n3) 6*(24+n3+n1)
if(r1.gt.rmax) then
rmax=r1
jpk=j
ipk=1
endif
if(r2.gt.rmax) then
rmax=r2
jpk=j
ipk=2
endif
if(r3.gt.rmax) then
rmax=r3
jpk=j
ipk=3
endif
rrmax=max(r1,r2,r3)
if(rrmax.gt.1.9) then
k=min(k+1,NSAVE)
if(r1.eq.rrmax) ipksave(k)=1
if(r2.eq.rrmax) ipksave(k)=2
if(r3.eq.rrmax) ipksave(k)=3
jpksave(k)=j
rsave(k)=rrmax
endif
enddo
call timer('sync2 ',1)
kmax=k
call timer('indexx ',0)
call indexx(rsave,kmax,indx)
call timer('indexx ',1)
call timer('sync3 ',0)
do kk=1,kmax
k=indx(kmax+1-kk)
ipk=ipksave(k)
jpk=jpksave(k)
rmax=rsave(k)
c=conjg(cb3(1:NSPM,ipk))*cdat(jpk:jpk+nfft-1)
smax=0.
dfx=0.
idfbest=0
call timer('idf ',0)
do itry=1,25
idf=itry/2
if(mod(itry,2).eq.0) idf=-idf
idf=4*idf
twk=idf
call tweak1(c,NSPM,-twk,c2)
z=sum(c2)
if(abs(z).gt.smax) then
dfx=twk
smax=abs(z)
phi=atan2(aimag(z),real(z)) !Carrier phase offset
idfbest=idf
endif
enddo
idf=idfbest
call tweak1(cdat,npts,-dfx,cdat)
cfac=cmplx(cos(phi),-sin(phi))
cdat=cfac*cdat
call timer('idf ',1)
call timer('softsym ',0)
sig=0.
ref=0.
rdat(1:npts)=cdat
iz=11
do k=1,234 !Compute soft symbols
j=jpk+6*(k-1)
z0=2.0*dot_product(cdat(j:j+iz),cd(0:iz,0))
z1=2.0*dot_product(cdat(j:j+iz),cd(0:iz,1))
z2=2.0*dot_product(cdat(j:j+iz),cd(0:iz,2))
z3=2.0*dot_product(cdat(j:j+iz),cd(0:iz,3))
!### Maybe these should be weighted by yellow() ?
if(j+1404+iz.lt.npts) then
z0=z0 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,0))
z1=z1 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,1))
z2=z2 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,2))
z3=z3 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,3))
endif
if(j-1404.ge.1) then
z0=z0 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,0))
z1=z1 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,1))
z2=z2 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,2))
z3=z3 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,3))
endif
sym=max(abs(real(z2)),abs(real(z3))) - max(abs(real(z0)),abs(real(z1)))
if(sym.lt.0.0) then
phi=atan2(aimag(z0),real(z0))
sig=sig + real(z0)**2
ref=ref + aimag(z0)**2
else
phi=atan2(aimag(z1),real(z1))
sig=sig + real(z1)**2
ref=ref + aimag(z1)**2
endif
n=k
if(ipk.eq.2) n=k+47
if(ipk.eq.3) n=k+128
if(n.gt.234) n=n-234
ibit=0
if(sym.ge.0) ibit=1
symbol(n)=sym
enddo
snr=db(sig/ref-1.0)
call timer('softsym ',1)
rdata(1:35)=symbol(12:46)
rdata(36:104)=symbol(59:127)
rdata(105:198)=symbol(140:233)
! Re-order the symbols and make them i*1
j=0
do i=1,99
i4=128+rdata(i) !### Should be nint() ??? ###
if(i4.gt.255) i4=255
if(i4.lt.0) i4=0
j=j+1
e1(j)=i1
rd2(j)=rdata(i)
i4=128+rdata(i+99)
if(i4.gt.255) i4=255
if(i4.lt.0) i4=0
j=j+1
e1(j)=i1
rd2(j)=rdata(i+99)
enddo
! call system_clock(count0,clkfreq)
! tsoft=tsoft + (count0-count1)/float(clkfreq)
! Decode the message
nb1=87
call timer('vit213 ',0)
call vit213(e1,nb1,mettab,d8,metric)
call timer('vit213 ',1)
! call system_clock(count1,clkfreq)
! tvit=tvit + (count1-count0)/float(clkfreq)
ihash=nhash(c_loc(d8),int(9,c_size_t),146)
ihash=2*iand(ihash,32767)
decoded=' '
if(d8(10).eq.i1hash(2) .and. d8(11).eq.i1hash(1)) then
write(c72,1012) d8(1:9)
1012 format(9b8.8)
read(c72,1014) i4Msg6BitWords
1014 format(12b6.6)
call unpackmsg(i4Msg6BitWords,decoded) !Unpack to get msgsent
endif
if(decoded.ne.' ') exit
enddo
call timer('sync3 ',1)
return
end subroutine syncmsk
lib/t1.f90
+137
View File
@@ -0,0 +1,137 @@
program t1
parameter (NSPM=1404)
complex csig(0:NSPM-1)
complex c(0:NSPM-1)
complex cnoise(0:NSPM-1)
complex cd(0:11,0:3)
complex z,zmax
integer itone(234)
real r(234)
real ss(0:3)
character*12 arg
nargs=iargc()
if(nargs.ne.3) then
print*,'Usage: t1 nsymtest snrdb iters'
go to 999
endif
call getarg(1,arg)
read(arg,*) nsymtest
call getarg(2,arg)
read(arg,*) snrdb
call getarg(3,arg)
read(arg,*) iters
call random_number(r)
itone=0
where(r.gt.0.5) itone=1
twopi=8.0*atan(1.0)
fmid=1500.0
f0=fmid-500.
f1=fmid+500.
dt=1.0/12000.0
phi=0.
do n=0,3
k=-1
dphi=twopi*f0*dt
if(n.ge.2) dphi=twopi*f1*dt
do i=0,5
k=k+1
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
cd(k,n)=cmplx(cos(phi),sin(phi))
enddo
dphi=twopi*f0*dt
if(mod(n,2).eq.1) dphi=twopi*f1*dt
do i=6,11
k=k+1
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
cd(k,n)=cmplx(cos(phi),sin(phi))
enddo
enddo
! do k=0,11
! write(13,1000) k,cd(k,0:3)
!1000 format(i4,8f9.3)
!enddo
! Generate signal waveform
k=-1
phi=0.
do j=1,234
dphi=twopi*f0*dt
if(itone(j).eq.1) dphi=twopi*f1*dt
do i=1,6
k=k+1
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
csig(k)=cmplx(cos(phi),sin(phi))
! write(14,1000) k,csig(k)
enddo
enddo
write(*,1010)
1010 format(' S/N (S+N)/N BER'/'----------------------')
isnra=10
isnrb=-3
nsyms=234
do isnr=isnra,isnrb,-1
snr=10.0**(0.1*isnr)
if(snrdb.ne.0.0) snr=10.0**(0.1*snrdb)
fac=1.0/sqrt(snr)
nsumerr=0
do iter=1,iters
do i=0,NSPM-1
x=gran()
y=gran()
cnoise(i)=cmplx(x,y)
enddo
c=csig + fac*cnoise
nerr=0
n1=2
nstep=2
iz=5
if(nsymtest.eq.2) then
n1=3
nstep=1
iz=11
endif
do j=1,nsyms
smax=0.
do n=0,n1,nstep
s=0.
k=6*(j-1)
do i=0,iz
s=s + aimag(c(k+i))*aimag(cd(i,n))
enddo
ss(n)=s
if(abs(s).gt.abs(smax)) then
smax=s
npk=n
endif
enddo
sym=max(abs(ss(2)),abs(ss(3))) - max(abs(ss(0)),abs(ss(1)))
! ibit=npk/2
ibit=0
if(sym.ge.0.0) ibit=1
if(ibit.ne.itone(j)) nerr=nerr+1
enddo
nsumerr=nsumerr+nerr
enddo
write(*,1020) 10.0*log10(snr),10.0*log10(snr+1.0), &
float(nsumerr)/(nsyms*iters)
1020 format(f5.1,f7.1,f9.3)
if(snrdb.ne.0.0) exit
enddo
999 end program t1
lib/t6.f90
+56
View File
@@ -0,0 +1,56 @@
program t6
parameter (MAXFFT=1404)
complex c(0:MAXFFT-1)
real s(0:MAXFFT-1)
m1=45
m2=67
m3=89
nsym=3*11 + m1 + m2 + m3
nfft=6*nsym
nh=nfft/2
best=9999.
! do m1=22,67
! do m2=37,97
do m1=30,67
do m2=26,100
m3=201-m2-m1
if(m3.lt.13) cycle
c=0.
n1=6*(11+m1)
n2=n1+6*(11+m2)
c(1:66)=1.
c(1+n1:66+n1)=1.
c(1+n2:66+n2)=1.
call four2a(c,nfft,1,-1,1) !c2c FFT
df=12000.0/nfft
smax=0.
do i=0,nfft-1
s(i)=real(c(i))**2 + aimag(c(i))**2
if(i.ne.0) smax=max(s(i),smax)
enddo
sidelobe=db(smax/s(0))
if(sidelobe.lt.best) then
write(*,1000) m1,m2,m3,sidelobe
1000 format(3i5,f8.2)
best=sidelobe
s=s/s(0)
rewind 13
do j=0,nfft-1
i=mod(j+nh,nfft)
f=i*df
if(i.gt.nh) f=f-12000.0
write(13,1020) f,s(i)
1020 format(2f12.4)
enddo
endif
enddo
enddo
end program t6
lib/testfast9.f90
+42
View File
@@ -0,0 +1,42 @@
program testfast9
parameter (NMAX=359424)
integer*2 id2(NMAX)
integer narg(0:11)
character*80 line(100)
character submode*1,infile*80
nargs=iargc()
if(nargs.ne.2) then
print*,'Usage: testfast9 submode infile'
print*,'Example: testfast9 E /data/VE1SKY/K1JT/JT9E/150806_123300.wav'
go to 999
endif
call getarg(1,submode)
call getarg(2,infile)
open(10,file=infile,access='stream',status='old')
read(10) id2(1:22) !Skip 44 header bytes
npts=NMAX
read(10,end=1) id2(1:npts) !Read the raw data
1 i1=index(infile,'.wav')
read(infile(i1-6:i1-1),*) narg(0)
narg(1)=NMAX
n=ichar(submode)
narg(2)=n-ichar('A')
if(n.ge.97 .and. n.le.104) narg(2)=n-ichar('a')
narg(3)=1
narg(4)=0
narg(5)=0
narg(6)=0
narg(7)=29951
narg(8)=1
narg(9)=102
narg(10)=700
narg(11)=500
call fast9(id2,narg,line)
print*,line(1)
999 end program testfast9
lib/testmsk.f90
+64
View File
@@ -0,0 +1,64 @@
program testmsk
parameter (NMAX=359424)
integer*2 id2(NMAX)
integer narg(0:11)
character*80 line(100)
character infile*80
nargs=iargc()
if(nargs.lt.1) then
print*,'Usage: testmsk infile1 [infile2 ...]'
print*,'Examples: testmsk ~/data/JTMSK3/150825_115515.wav'
print*,' testmsk C:/data/JTMSK3/150825_120245.wav'
go to 999
endif
nfiles=nargs
tsync1=0.
tsync2=0.
tsoft=0.
tvit=0.
ttotal=0.
ndecodes=0
call timer('testmsk ',0)
do ifile=1,nfiles
call getarg(ifile,infile)
open(10,file=infile,access='stream',status='old')
read(10) id2(1:22) !Skip 44 header bytes
npts=179712 !### T/R = 15 s
read(10,end=1) id2(1:npts) !Read the raw data
1 close(10)
i1=index(infile,'.wav')
read(infile(i1-6:i1-1),*) narg(0)
nrxfreq=1500
ntol=100
narg(1)=npts !npts
narg(2)=0 !nsubmode
narg(3)=1 !newdat
narg(4)=0 !minsync
narg(5)=0 !npick
narg(6)=0 !t0 (ms)
narg(7)=npts/12 !t1 (ms) ???
narg(8)=2 !maxlines
narg(9)=103 !nmode
narg(10)=nrxfreq
narg(11)=ntol
call timer('jtmsk ',0)
call jtmsk(id2,narg,line)
call timer('jtmsk ',1)
do i=1,narg(8)
if(line(i)(1:1).eq.char(0)) exit
ndecodes=ndecodes+1
write(*,1002) line(i)(1:60),ndecodes
1002 format(a60,i10)
enddo
enddo
call timer('testmsk ',1)
call timer('testmsk ',101)
999 end program testmsk
lib/tweak1.f90
+21
View File
@@ -0,0 +1,21 @@
subroutine tweak1(ca,jz,f0,cb)
! Shift frequency of analytic signal ca, with output to cb
complex ca(jz),cb(jz)
real*8 twopi
complex*16 w,wstep
data twopi/0.d0/
save twopi
if(twopi.eq.0.d0) twopi=8.d0*atan(1.d0)
w=1.d0
dphi=twopi*f0/11025.d0
wstep=cmplx(cos(dphi),sin(dphi))
do i=1,jz
w=w*wstep
cb(i)=w*ca(i)
enddo
return
end subroutine tweak1
lib/vit213.c
+219
View File
@@ -0,0 +1,219 @@
/* Viterbi decoder for arbitrary convolutional code
* viterbi27 and viterbi37 for the r=1/2 and r=1/3 K=7 codes are faster
* Copyright 1999 Phil Karn, KA9Q
* Modifications by Joe Taylor, K1JT
* May be used under the terms of the GNU Public License
*/
/* Select code here */
#define V213
#ifdef V213
#define K 13 /* Constraint length */
#define N 2 /* Number of symbols per data bit */
#define Polys Poly213 /* Select polynomials here */
#endif
/* Rate 1/2 codes */
unsigned int Poly213[] = {012767,016461}; /* k = 13 */
#include <memory.h>
#define NULL ((void *)0)
#define LONGBITS 32
#define LOGLONGBITS 5
#undef max
#define max(x,y) ((x) > (y) ? (x) : (y))
#define D (1 << max(0,K-LOGLONGBITS-1))
#define MAXNBITS 200 /* Maximum frame size (user bits) */
extern unsigned char Partab[]; /* Parity lookup table */
int Syms[1 << K];
int parity(int x)
{
x ^= (x >> 16);
x ^= (x >> 8);
return Partab[x & 0xff];
}
/* Convolutionally encode data into binary symbols */
int enc213(unsigned char symbols[], unsigned char data[],
unsigned int nbytes, unsigned int startstate,
unsigned int endstate)
{
int i,j,k,n=-1;
unsigned int encstate = startstate;
for(k=0; k<nbytes; k++) {
for(i=7;i>=0;i--){
encstate = (encstate + encstate) + ((data[k] >> i) & 1);
for(j=0;j<N;j++) {
n=n+1;
symbols[n] = parity(encstate & Polys[j]);
}
}
}
// Flush out with zero tail. (No need, if tail-biting code.)
for(i=0; i<K-1;i++){
encstate = (encstate << 1) | ((endstate >> i) & 1);
for(j=0;j<N;j++) {
n=n+1;
symbols[n] = parity(encstate & Polys[j]);
}
}
return 0;
}
/* Viterbi decoder */
int vit213(
int *metric, /* Final path metric (returned value) */
unsigned char *data, /* Decoded output data */
unsigned char *symbols, /* Raw deinterleaved input symbols */
unsigned int nbits, /* Number of output bits */
int mettab[2][256], /* Metric table, [sent sym][rx symbol] */
unsigned int startstate, /* Encoder starting state */
unsigned int endstate /* Encoder ending state */
){
int bitcnt = -(K-1);
int m0,m1;
int i,j,sym,ipp;
int mets[1 << N];
unsigned int paths[(MAXNBITS+K-1)*D];
unsigned int *pp,mask;
int cmetric[1 << (K-1)],nmetric[1 << (K-1)];
static int VDInit = 0;
memset(paths,0,sizeof(paths));
// Initialize on first time through:
if(!VDInit){
for(i=0;i<(1<<K);i++){
sym = 0;
for(j=0;j<N;j++)
sym = (sym << 1) + parity(i & Polys[j]);
Syms[i] = sym;
}
VDInit++;
}
// Keep only lower K-1 bits of specified startstate and endstate
startstate &= ~((1<<(K-1)) - 1);
endstate &= ~((1<<(K-1)) - 1);
/* Initialize starting metrics */
for(i=0;i< 1<<(K-1);i++)
cmetric[i] = -999999;
cmetric[startstate] = 0;
pp = paths;
ipp=0;
for(;;){ /* For each data bit */
/* Read input symbols and compute branch metrics */
for(i=0;i< 1<<N;i++){
mets[i] = 0;
for(j=0;j<N;j++){
mets[i] += mettab[(i >> (N-j-1)) & 1][symbols[j]];
}
}
symbols += N;
/* Run the add-compare-select operations */
mask = 1;
for(i=0;i< 1 << (K-1);i+=2){
int b1,b2;
b1 = mets[Syms[i]];
nmetric[i] = m0 = cmetric[i/2] + b1;
b2 = mets[Syms[i+1]];
b1 -= b2;
m1 = cmetric[(i/2) + (1<<(K-2))] + b2;
if(m1 > m0){
nmetric[i] = m1;
*pp |= mask;
}
m0 -= b1;
nmetric[i+1] = m0;
m1 += b1;
if(m1 > m0){
nmetric[i+1] = m1;
*pp |= mask << 1;
}
mask <<= 2;
if(mask == 0){
mask = 1;
pp++;
ipp++;
}
}
if(mask != 1){
pp++;
ipp++;
}
if(++bitcnt == nbits){
*metric = nmetric[endstate];
break;
}
memcpy(cmetric,nmetric,sizeof(cmetric));
}
/* Chain back from terminal state to produce decoded data */
if(data == NULL)
return 0;/* Discard output */
memset(data,0,(nbits+7)/8); /* round up in case nbits % 8 != 0 */
for(i=nbits-1;i >= 0;i--){
// int a0,a1;
pp -= D;
ipp -= D;
m0=endstate >> LOGLONGBITS;
m1=1L << (endstate & (LONGBITS-1));
if(pp[m0] & m1) {
// a0=nmetric[endstate];
endstate |= (1 << (K-1));
// a1=nmetric[endstate];
data[i>>3] |= 0x80 >> (i&7);
// printf("B %d %d %d %d\n",*metric,i,a0,a1);
}
endstate >>= 1;
}
return 0;
}
// Wrapper for calling "encode" from Fortran:
void enc213_(
unsigned char data[], // User data, 8 bits per byte
int *nbits, // Number of user bits
unsigned char symbols[], // Encoded one-bit symbols, 8 per byte
int *nsymbols, // Number of symbols
int *kk, // K
int *nn) // N
{
int nbytes;
nbytes=(*nbits+7)/8; // Always encode multiple of 8 information bits
enc213(symbols,data,nbytes,0,0); // Do the encoding
*nsymbols=(*nbits+K-1)*N; // Return number of encoded symbols
*kk=K;
*nn=N;
}
// Wrapper for calling "viterbi" from Fortran:
void vit213_(
unsigned char symbols[], /* Raw deinterleaved input symbols */
unsigned int *Nbits, /* Number of decoded information bits */
int mettab[2][256], /* Metric table, [sent sym][rx symbol] */
unsigned char ddec[], /* Decoded output data */
int *Metric /* Final path metric (bigger is better) */
){
int metric;
vit213(&metric,ddec,symbols,*Nbits,mettab,0,0);
*Metric=metric;
}
lib/wavhdr.f90
+72
View File
@@ -35,4 +35,76 @@ module wavhdr
default_header=h
end function default_header
subroutine set_wsjtx_wav_params(fMHz,mode,nsubmode,ntrperiod,id2)
parameter (NBANDS=23,NMODES=11)
character*8 mode,modes(NMODES)
integer*2 id2(4)
integer iperiod(7)
real fband(NBANDS)
data fband/0.137,0.474,1.8,3.5,5.1,7.0,10.14,14.0,18.1,21.0,24.9, &
28.0,50.0,144.0,222.0,432.0,902.0,1296.0,2304.0,3400.0, &
5760.0,10368.0,24048.0/
data modes/'Echo','FSK441','ISCAT','JT4','JT65','JT6M','JT9', &
'JT9+JT65','JTMS','JTMSK','WSPR'/
data iperiod/5,10,15,30,60,120,900/
dmin=1.e30
iband=0
do i=1,NBANDS
if(abs(fMHz-fband(i)).lt.dmin) then
dmin=abs(fMHz-fband(i))
iband=i
endif
enddo
imode=0
do i=1,NMODES
if(mode.eq.modes(i)) imode=i
enddo
ip=0
do i=1,7
if(ntrperiod.eq.iperiod(i)) ip=i
enddo
id2(1)=iband
id2(2)=imode
id2(3)=nsubmode
id2(4)=ip
return
end subroutine set_wsjtx_wav_params
subroutine get_wsjtx_wav_params(id2,band,mode,nsubmode,ntrperiod,ok)
parameter (NBANDS=23,NMODES=11)
character*8 mode,modes(NMODES)
character*6 band,bands(NBANDS)
integer*2 id2(4)
integer iperiod(7)
logical ok
data modes/'Echo','FSK441','ISCAT','JT4','JT65','JT6M','JT9', &
'JT9+JT65','JTMS','JTMSK','WSPR'/
data iperiod/5,10,15,30,60,120,900/
data bands/'2190m','630m','160m','80m','60m','40m','30m','20m', &
'17m','15m','12m','10m','6m','2m','1.25m','70cm','33cm', &
'23cm','13cm','9cm','6cm','3cm','1.25cm'/
ok=.true.
if(id2(1).lt.1 .or. id2(1).gt.NBANDS) ok=.false.
if(id2(2).lt.1 .or. id2(2).gt.NMODES) ok=.false.
if(id2(3).lt.1 .or. id2(3).gt.8) ok=.false.
if(id2(4).lt.1 .or. id2(4).gt.7) ok=.false.
if(ok) then
band=bands(id2(1))
mode=modes(id2(2))
nsubmode=id2(3)
ntrperiod=iperiod(id2(4))
endif
return
end subroutine get_wsjtx_wav_params
end module wavhdr
lib/wsjt_modes.txt
+68
View File
@@ -0,0 +1,68 @@
WSJT modes: Modulation Parameters
---------------------------------
------------------------------------------------------------------------
Mode nsps Rate B t_sym t_msg Suggested
(baud) (Hz) (ms) (s) applications
------------------------------------------------------------------------
Fast modes, sample Rate 11025 Hz:
------------------------------------------------------------------------
JTMS 8 689 1378 0.7 0.097 MS on 144+
FSK441 25 441 1764 2.3 0.129 MS
ISCAT-A 512 21.5 905 46.4 1.11 Aircraft Scatter
ISCAT-B 256 43.1 1809 23.2 0.56 Ionoscatter (6m)
JT6M 512 21.5 947 46.4 1.32 Ionoscatter (6m)
Slow modes, sample Rate 11025 Hz:
------------------------------------------------------------------------
JT65A 4096 2.69 178 372 46.81 EME 50 MHz
JT65B 4096 2.69 355 372 46.81 EME 144, 432
JT65C 4096 2.69 711 372 46.81 EME 1296-and-up
JT4A 2520 4.375 17.5 229 47.09 QRP HF dxing
JT4B 2520 4.375 35 229 47.09
JT4C 2520 4.375 70 229 47.09
JT4D 2520 4.375 158 229 47.09
JT4E 2520 4.375 315 229 47.09
JT4F 2520 4.375 630 229 47.09 Microwave EME
JT4G 2520 4.375 1260 229 47.09 Microwave EME
------------------------------------------------------------------------
Mode nsps Rate B t_sym t_msg Suggested
(baud) (Hz) (ms) (s) applications
------------------------------------------------------------------------
Slow modes, sample Rate 12000 Hz:
------------------------------------------------------------------------
JT9A 6912 1.736 15.625 576 48.96 QRP HF dxing
JT9B 3840 1.736 28.125 576 48.96
JT9C 1920 1.736 56.25 576 48.96
JT9D 960 1.736 112.5 576 48.96
JT9E 480 1.736 225 576 48.96
JT9F 240 1.736 450 576 48.96
JT9G 120 1.736 900 576 48.96
JT9H 60 1.736 1800 576 48.96 Microwave EME?
WSPR 8192 1.465 5.86 683 110.59 Propagation probe
------------------------------------------------------------------------
Fast modes, sample Rate 12000 Hz:
------------------------------------------------------------------------
JT9B 3840 3.125 28.125 320 27.20 Not yet...
JT9C 1920 6.25 56.25 160 13.60 Not yet...
JT9D 960 12.5 112.5 80 6.80 Ionoscatter
JT9E 480 25 225 40 3.40 Ionoscatter
JT9F 240 50 450 20 1.70 Ionoscatter
JT9G 120 100 900 10 0.85 Ionoscatter
JT9H 60 200 1800 5 0.43 Ionoscat (no 10m)
JTMSK 6 2000 2000 0.5 0.117 MS
------------------------------------------------------------------------
nsps - Samples per symbol, at stated sample rate
Rate - Keying rate (baud)
B - Bandwidth (Hz)
t_sym - Symbol duration (ms)
t_msg - Time (s) to transmit typical 18-character message
lib/wspr_downsample.f90
+1 -2
View File
@@ -13,10 +13,9 @@ subroutine wspr_downsample(id2,k)
parameter (NFFT1=1024)
parameter (MAXFFT3=32768)
real*4 w3(MAXFFT3)
real*4 x0(NFFT1),x1(NFFT1)
real*4 x0(NFFT1)
real*4 x2(NFFT1+105)
real*4 ssum(NSMAX)
logical*1 lstrong(0:1023) !Should be (0:512)
integer*2 id2(NMAX)
complex c0
common/c0com/c0(NDMAX)
lib/wsprd/README
Executable
+54
View File
@@ -0,0 +1,54 @@
wsprd is a decoder for K1JT's Weak Signal Propagation Reporter (WSPR) mode.
The program is written in C and is a command-line program that reads from a
.c2 file or .wav file and writes output to the console. It is used by WSJT-X
for wspr-mode decoding.
USAGE:
wsprd [options...] infile
OPTIONS:
-a <path> path to writeable data files, default="."
-c write .c2 file at the end of the first pass
-e x (x is transceiver dial frequency error in Hz)
-f x (x is transceiver dial frequency in MHz)
-H do not use (or update) the hash table
-m decode wspr-15 .wav file
-q quick mode - doesn't dig deep for weak signals
-s single pass mode, no subtraction (same as original wsprd)
-v verbose mode (shows dupes)
-w wideband mode - decode signals within +/- 150 Hz of center
-z x (x is fano metric table bias, default is 0.42)
infile can be either .wav or .c2
e.g.
./wsprd -wf 14.0956 140709_2258.wav
Note that for .c2 files, the frequency within the file overrides the command
line value.
FEATURES:
By default, wsprd reports signals that are within +/- 110 Hz of the
subband center frequency. The wideband option (-w) extends this to +/- 150 Hz.
wsprd maintains a hashtable and will decode all three types of wspr
messages. An option (-H) is available to turn off use of the hashtable.
The symbols are decoded using Phil Karn's sequential decoder routine,
fano.c.
NOTES:
This program attempts to maximize the number of successful decodes per transmit
interval by trying to decode virtually every peak in the averaged spectrum.
The program also implements two-pass decoding, whereby signals that are successfully
decoded are subtracted one-by-one during the first decoding pass. Then, the
decoder is run again. In many cases the subtraction process will uncover signals
that can then be successfully decoded on the second pass.
There will be occasional duplicate decodes when two closely spaced
peaks come from the same signal. The program removes dupes based on callsign
and frequency. Two decodes that have the same callsign and estimated frequencies
that are within 1 Hz will be treated as decodes of the same signal. This
dupechecking is turned off with the -v flag.
lib/wsprd/nhash.c
-8
View File
@@ -370,11 +370,3 @@ uint32_t nhash( const void *key, size_t length, uint32_t initval)
return c;
}
/*
* Fortran argument compatible wrapper
*/
uint32_t nhash_( const void * key, size_t const * length, uint32_t const * initval)
{
return nhash (key, *length, *initval);
}

Some files were not shown because too many files have changed in this diff Show More