w4kek
/
WSJT-X
mirror of https://github.com/saitohirga/WSJT-X.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'hotfix-2.2.1' into develop

This commit is contained in:
Bill Somerville 2020-06-05 23:47:51 +01:00
parent b9491862a1 01a1a421d5
commit 1b8fd35e03
No known key found for this signature in database
GPG Key ID: D864B06D1E81618F
149 changed files with 750 additions and 21889 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
NEWS
View File

@ -10,7 +10,115 @@
\$$ \$$ \$$$$$$ \$$$$$$ \$$ \$$ \$$
Copyright 2001 - 2019 by Joe Taylor, K1JT.
Copyright 2001 - 2020 by Joe Taylor, K1JT.
Release: WSJT-X 2.2.1
June 6, 2020
---------------------
WSJT-X v2.2.1 is a bug fix release that fixes regressions found in the
prior v2.2.0 release. Here is a brief summary;
- Incorporate a revised Hamlib version the address a regression in
rig control of some rigs including the Yaesu FT-991 and FT-891.
- Repair a defect in 6 character gridsquare lookup from the CALL3.TXT
database, and improve "Lookup" button processing.
- Repair a defect with selecting Wide Graph 2D spectrum types in
translated UIs.
- Repair a regression that blocked the Highlight Callsign UDP request
from highlighting terms including a '+' character.
- Repair a regression where occasional Highlight Callsign UDP
requests with the 'Highlight last' parameter as true highlighted a
match in a prior period. This fix include a performance improvement
when processing any Highlight Callsign request with 'Highlight
last' as true.
- Include support for the Yaesu FT-920 when controlled by Ham Radio
Deluxe. This change inadvertently missed the v2.2.0 GA release.
- Correct a documentation issue with the UDP Message Protocol
Status(1) message Special Operations Mode enumeration values ("WW
DIGI added", Fox, and Hound renumbered). Thanks to Sam, W2JDB, for
raising this issue.
- Updated Catalan UI translation, tnx Xavi, EA3W.
- Italian UI translation, tnx Marco, PY1ZRJ.
- Updated Spanish UI translation, tnx Cédric, EA4AC.
Release: WSJT-X 2.2
June 2, 2020
-------------------
WSJT-X 2.2 is a program upgrade that provides a number of new features
and capabilities. Here is a brief summary; for further details see
the notes for candidate releases 2.2.0-rc1, -rc2, and -rc3, below, and
of course the updated WSJT-X 2.2 User Guide.
- Significant improvements to the decoders for FT4, FT8, JT4, JT65,
and WSPR.
- New format for "EU VHF Contest" Tx2 and Tx3 messages
When "EU VHF Contest" is selected, the Tx2 and Tx3 messages (those
conveying signal report, serial number, and 6-character locator)
now use hashcodes for both callsigns. This change is NOT backward
compatible with earlier versions of _WSJT-X_, so all users of EU
VHF Contest messages should be sure to upgrade to version 2.2.0.
- Accessibility
Keyboard shortcuts have been added as an aid to accessibility:
Alt+R sets Tx4 message to RR73, Ctrl+R sets it to RRR.
As an aid for partial color-blindness, the "inverted goal posts"
marking Rx frequency on the Wide Graph's frequency scale are now
rendered in a darker shade of green.
- User Interface Translations have been enabled. Translations are
now available for Catalan, Spanish, Japanese, Chinese, and Hong
Kong Chinese. Additiional languages will follow, when available.
Note that UI translation is automatic, based on your system primary
language. If you do not want the WSJT-X UI translated to your local
language then start WSJT-X with the '--language=en' command line
option:
wsjtx --language=en
If you wish to contribute by authoring WSJT-X UI translations
please join the new discussion group wsjtx-l10n@Groups.io
(https://groups.io/g/wsjtx-l10n), where help from other translation
authors and coordination with the development team is available.
- Minor enhancements and bug fixes
"Save None" now writes no .wav files to disk, even temporarily.
An explicit entry for "WW Digi Contest" has been added to
"Special operating activities" on the "Settings | Advanced" tab.
Contest mode FT4 now always uses RR73 for the Tx4 message.
The Status bar now displays the number of decodes found in the
most recent Rx sequence.
The "Highlight Callsign" UDP message has been enhanced to allow
clearing of old highlighting for a specified callsign. Please note
a recommended restriction on the use of this message in the
documentation here: https://tinyurl.com/y85nc3tg
- Hamlib - this library which we use for direct rig control has had
many defect repairs and enhancements, we thank the contributors to
that project for their work.
Release: WSJT-X 2.2.0-rc3
May 30, 2020

40
Release_Notes.txt
View File

@ -13,6 +13,46 @@
Copyright 2001 - 2020 by Joe Taylor, K1JT.
Release: WSJT-X 2.2.1
June 6, 2020
---------------------
WSJT-X v2.2.1 is a bug fix release that fixes regressions found in the
prior v2.2.0 release. Here is a brief summary;
- Incorporate a revised Hamlib version the address a regression in
rig control of some rigs including the Yaesu FT-991 and FT-891.
- Repair a defect in 6 character gridsquare lookup from the CALL3.TXT
database, and improve "Lookup" button processing.
- Repair a defect with selecting Wide Graph 2D spectrum types in
translated UIs.
- Repair a regression that blocked the Highlight Callsign UDP request
from highlighting terms including a '+' character.
- Repair a regression where occasional Highlight Callsign UDP
requests with the 'Highlight last' parameter as true highlighted a
match in a prior period. This fix include a performance improvement
when processing any Highlight Callsign request with 'Highlight
last' as true.
- Include support for the Yaesu FT-920 when controlled by Ham Radio
Deluxe. This change inadvertently missed the v2.2.0 GA release.
- Correct a documentation issue with the UDP Message Protocol
Status(1) message Special Operations Mode enumeration values ("WW
DIGI added", Fox, and Hound renumbered). Thanks to Sam, W2JDB, for
raising this issue.
- Updated Catalan UI translation, tnx Xavi, EA3W.
- Italian UI translation, tnx Marco, PY1ZRJ.
- Updated Spanish UI translation, tnx Cédric, EA4AC.
Release: WSJT-X 2.2
June 2, 2020
-------------------

10
Transceiver/HRDTransceiver.cpp
View File

@ -236,7 +236,7 @@ int HRDTransceiver::do_start ()
vfo_A_button_ = find_button (QRegExp ("^(VFO~A|Main)$"));
vfo_B_button_ = find_button (QRegExp ("^(VFO~B|Sub)$"));
vfo_toggle_button_ = find_button (QRegExp ("^(A~/~B)$"));
vfo_toggle_button_ = find_button (QRegExp ("^(A~/~B|VFO~A/B)$"));
split_mode_button_ = find_button (QRegExp ("^(Spl~On|Spl_On|Split|Split~On)$"));
split_off_button_ = find_button (QRegExp ("^(Spl~Off|Spl_Off|Split~Off)$"));
@ -392,17 +392,17 @@ std::vector<int> HRDTransceiver::find_dropdown_selection (int dropdown, QRegExp
void HRDTransceiver::map_modes (int dropdown, ModeMap *map)
{
// order matters here (both in the map and in the regexps)
map->push_back (std::forward_as_tuple (CW, find_dropdown_selection (dropdown, QRegExp ("^(CW|CW\\(N\\))|CWL$"))));
map->push_back (std::forward_as_tuple (CW_R, find_dropdown_selection (dropdown, QRegExp ("^(CW-R|CW-R\\(N\\)|CW|CWU)$"))));
map->push_back (std::forward_as_tuple (CW, find_dropdown_selection (dropdown, QRegExp ("^(CW|CW\\(N\\)|CW-LSB|CWL)$"))));
map->push_back (std::forward_as_tuple (CW_R, find_dropdown_selection (dropdown, QRegExp ("^(CW-R|CW-R\\(N\\)|CW|CW-USB|CWU)$"))));
map->push_back (std::forward_as_tuple (LSB, find_dropdown_selection (dropdown, QRegExp ("^(LSB\\(N\\)|LSB)$"))));
map->push_back (std::forward_as_tuple (USB, find_dropdown_selection (dropdown, QRegExp ("^(USB\\(N\\)|USB)$"))));
map->push_back (std::forward_as_tuple (DIG_U, find_dropdown_selection (dropdown, QRegExp ("^(DIG|DIGU|DATA-U|PKT-U|DATA|USER-U|USB)$"))));
map->push_back (std::forward_as_tuple (DIG_U, find_dropdown_selection (dropdown, QRegExp ("^(DIG|DIGU|DATA-U|PKT-U|DATA|AFSK|USER-U|USB)$"))));
map->push_back (std::forward_as_tuple (DIG_L, find_dropdown_selection (dropdown, QRegExp ("^(DIG|DIGL|DATA-L|PKT-L|DATA-R|USER-L|LSB)$"))));
map->push_back (std::forward_as_tuple (FSK, find_dropdown_selection (dropdown, QRegExp ("^(DIG|FSK|RTTY|RTTY-LSB)$"))));
map->push_back (std::forward_as_tuple (FSK_R, find_dropdown_selection (dropdown, QRegExp ("^(DIG|FSK-R|RTTY-R|RTTY|RTTY-USB)$"))));
map->push_back (std::forward_as_tuple (AM, find_dropdown_selection (dropdown, QRegExp ("^(AM|DSB|SAM|DRM)$"))));
map->push_back (std::forward_as_tuple (FM, find_dropdown_selection (dropdown, QRegExp ("^(FM|FM\\(N\\)|FM-N|WFM)$"))));
map->push_back (std::forward_as_tuple (DIG_FM, find_dropdown_selection (dropdown, QRegExp ("^(PKT-FM|PKT|FM)$"))));
map->push_back (std::forward_as_tuple (DIG_FM, find_dropdown_selection (dropdown, QRegExp ("^(PKT-FM|PKT|DATA\\(FM\\)|FM)$"))));
#if WSJT_TRACE_CAT
TRACE_CAT ("HRDTransceiver", "for dropdown" << dropdown_names_[dropdown]);

5
UDPExamples/ClientWidget.cpp
View File

@ -415,8 +415,9 @@ void ClientWidget::update_status (QString const& id, Frequency f, QString const&
case 2: special = "[EU VHF]"; break;
case 3: special = "[FD]"; break;
case 4: special = "[RTTY RU]"; break;
case 5: special = "[Fox]"; break;
case 6: special = "[Hound]"; break;
case 5: special = "[WW DIGI]"; break;
case 6: special = "[Fox]"; break;
case 7: special = "[Hound]"; break;
default: break;
}
de_label_->setText (de_call.size () >= 0 ? QString {"DE: %1%2%3"}.arg (de_call)

50
lib/fsk4hf/Makefile
View File

@ -1,50 +0,0 @@
# Compilers
CC = gcc
CXX = g++
FC = gfortran
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: wsprlf
OBJS0 = testpsk.o four2a.o bpfilter.o nonlinear.o tweak1.o spectrum.o smo.o
testpsk: $(OBJS0)
$(FC) -o testpsk $(OBJS0) -lfftw3f
OBJS1 = gmsk8.o four2a.o gaussfilt.o
gmsk8: $(OBJS1)
$(FC) -o gmsk8 $(OBJS1) -lfftw3f
OBJS2 = testfsk.o four2a.o smo.o
testfsk: $(OBJS2)
$(FC) -o testfsk $(OBJS2) -lfftw3f
OBJS3 = fsk2sim.o four2a.o smo.o wavhdr.o gran.o
fsk2sim: $(OBJS3)
$(FC) -o fsk2sim $(OBJS3) -lfftw3f
OBJS4 = fsk4sim.o four2a.o wavhdr.o gran.o tweak1.o
fsk4sim: $(OBJS4)
$(FC) -o fsk4sim $(OBJS4) -lfftw3f
OBJS5 = wsprlf.o four2a.o
wsprlf: $(OBJS5)
$(FC) -o wsprlf $(OBJS5) -lfftw3f
.PHONY : clean
clean:
$(RM) *.o testpsk testfsk fsk2sim fsk4sim wsprlf

84
lib/fsk4hf/Makefile.win
View File

@ -1,84 +0,0 @@
# Compilers
CC = gcc
CXX = g++
FC = gfortran
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: dbpsksim.exe
OBJS0 = testpsk.o four2a.o bpfilter.o nonlinear.o tweak1.o spectrum.o smo.o
testpsk: $(OBJS0)
$(FC) -o testpsk $(OBJS0) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS1 = gmsk8.o four2a.o gaussfilt.o
gmsk8: $(OBJS1)
$(FC) -o gmsk8 $(OBJS1) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS2 = testfsk.o four2a.o smo.o
testfsk: $(OBJS2)
$(FC) -o testfsk $(OBJS2) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS3 = fsk2sim.o four2a.o smo.o wavhdr.o gran.o
fsk2sim: $(OBJS3)
$(FC) -o fsk2sim $(OBJS3) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS4 = fsk4sim.o four2a.o gran.o genfsk4.o smo.o getsnr.o spec4.o \
watterson.o db.o snr2_wsprlf.o pctile.o shell.o snr_wsprlf.o
fsk4sim.exe: $(OBJS4)
$(FC) -o fsk4sim.exe $(OBJS4) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS5 = wsprlf.o four2a.o downsample.o
wsprlf.exe: $(OBJS5)
$(FC) -o wsprlf.exe $(OBJS5) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS6 = wspr_gmsk.o four2a.o gaussfilt.o
wspr_gmsk.exe: $(OBJS6)
$(FC) -o wspr_gmsk.exe $(OBJS6) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS7 = wspr_msk.o four2a.o bpfilter.o
wspr_msk.exe: $(OBJS7)
$(FC) -o wspr_msk.exe $(OBJS7) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS8 = dbpsksim.o four2a.o gran.o genbpsk.o watterson.o db.o \
encode120.o bpdecode120.o platanh.o
dbpsksim.exe: $(OBJS8)
$(FC) -o dbpsksim.exe $(OBJS8) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS9 = fsk4a.o four2a.o gran.o genfsk4a.o spec4.o \
watterson.o db.o
fsk4a.exe: $(OBJS9)
$(FC) -o fsk4a.exe $(OBJS9) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS10 = gmsk8.o gaussfilt.o four2a.o
gmsk8.exe: $(OBJS10)
$(FC) -o gmsk8.exe $(OBJS10) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS11 = gmsksim.o four2a.o gran.o gengmsk.o genbpsk.o watterson.o db.o \
encode168.o bpdecode168.o platanh.o gaussfilt.o tweak1.o smo121.o
gmsksim.exe: $(OBJS11)
$(FC) -o gmsksim.exe $(OBJS11) C:\JTSDK\fftw3f\libfftw3f-3.dll
OBJS12 = mskhfsim.o four2a.o gran.o genmskhf.o watterson.o db.o \
encode168.o bpdecode168.o platanh.o twkfreq1.o smo121.o \
polyfit4.o
mskhfsim.exe: $(OBJS12)
$(FC) -o mskhfsim.exe $(OBJS12) C:\JTSDK\fftw3f\libfftw3f-3.dll
.PHONY : clean
clean:
$(RM) *.o testpsk.exe testfsk.exe fsk2sim.exe fsk4sim.exe wsprlf.exe

59
lib/fsk4hf/bitflip128_90.f90
View File

@ -1,59 +0,0 @@
subroutine bitflip128_90(llr,message77,cw,nharderror)
!
! A hard-decision bit flipping decoder for the (128,90) code.
!
use iso_c_binding, only: c_loc,c_size_t
use crc
integer, parameter:: N=128, K=90, M=N-K
integer*1 cw(N),apmask(N)
integer*1 decoded(K)
integer*1 message77(77)
integer Nm(11,M)
integer Mn(3,N)
integer nrw(M)
integer synd(M)
integer nuns(N)
real zn(N)
real llr(N)
include "ldpc_128_90_reordered_parity.f90"
decoded=0
zn=llr
do iter=0,0
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
nuns=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) then
ncheck=ncheck+1
do j=1,nrw(i)
nuns(Nm(j,i))=nuns(Nm(j,i))+1
enddo
endif
enddo
if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it
decoded=cw(1:K)
call chkcrc13a(decoded,nbadcrc)
if(nbadcrc.eq.0) then
message77=decoded(1:77)
nharderror=count( (2*cw-1)*llr .lt. 0.0 )
return
endif
endif
! flip the sign on the symbols that show up in the largest number
! of un-satisfied parity checks
where( nuns .eq. maxval(nuns) ) zn=-zn
enddo
llr=zn
nharderror=-1
return
end subroutine bitflip128_90

306
lib/fsk4hf/bpdecode120.f90
View File

@ -1,306 +0,0 @@
subroutine bpdecode120(llr,apmask,maxiterations,decoded,niterations,cw)
! A log-domain belief propagation decoder for the (120,60) code.
integer, parameter:: N=120, K=60, M=N-K
integer*1 codeword(N),cw(N),apmask(N)
integer colorder(N)
integer*1 decoded(K)
integer Nm(7,M) ! 5, 6, or 7 bits per check
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(7,M)
real tanhtoc(7,M)
real zn(N)
real llr(N)
real Tmn
integer nrw(M)
data colorder/ &
0,1,2,21,3,4,5,6,7,8,20,10,9,11,12,23,13,28,14,31, &
15,16,22,26,17,30,18,29,25,32,41,34,19,33,27,36,38,43,42,24, &
37,39,45,40,35,44,47,46,50,51,53,48,52,56,54,57,55,49,58,61, &
60,59,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79, &
80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99, &
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119/
data Mn/ &
1, 18, 48, &
2, 4, 51, &
3, 23, 47, &
5, 36, 42, &
6, 43, 49, &
7, 24, 55, &
8, 35, 60, &
9, 26, 30, &
10, 29, 45, &
11, 13, 46, &
12, 53, 54, &
14, 20, 57, &
15, 16, 58, &
17, 39, 44, &
19, 37, 41, &
21, 28, 34, &
22, 50, 59, &
25, 31, 52, &
27, 32, 38, &
33, 40, 56, &
1, 11, 47, &
2, 10, 16, &
3, 12, 27, &
4, 24, 28, &
5, 23, 60, &
6, 29, 39, &
7, 31, 54, &
8, 50, 56, &
9, 13, 14, &
15, 22, 41, &
17, 26, 40, &
18, 25, 45, &
19, 20, 55, &
21, 30, 36, &
32, 49, 59, &
33, 53, 58, &
34, 38, 46, &
29, 35, 57, &
37, 43, 48, &
42, 51, 52, &
7, 11, 44, &
1, 42, 58, &
2, 13, 49, &
3, 20, 40, &
4, 18, 56, &
5, 45, 55, &
6, 21, 31, &
8, 46, 52, &
9, 12, 48, &
10, 37, 38, &
14, 15, 25, &
16, 17, 60, &
19, 39, 53, &
22, 44, 51, &
23, 28, 41, &
24, 32, 35, &
26, 45, 59, &
27, 33, 36, &
30, 47, 54, &
34, 50, 57, &
33, 43, 55, &
1, 41, 57, &
2, 40, 54, &
3, 6, 24, &
4, 11, 59, &
5, 13, 56, &
7, 16, 34, &
8, 19, 26, &
9, 31, 58, &
10, 21, 53, &
12, 22, 60, &
14, 38, 51, &
15, 43, 46, &
17, 48, 50, &
18, 27, 39, &
20, 28, 44, &
23, 25, 49, &
4, 29, 36, &
30, 32, 52, &
35, 37, 47, &
39, 42, 59, &
1, 21, 40, &
2, 50, 55, &
3, 8, 10, &
5, 31, 37, &
6, 14, 60, &
7, 36, 49, &
9, 34, 39, &
11, 19, 25, &
12, 52, 57, &
13, 22, 29, &
15, 30, 56, &
16, 18, 20, &
17, 24, 46, &
23, 38, 58, &
26, 28, 43, &
2, 27, 41, &
5, 32, 44, &
33, 47, 51, &
35, 48, 53, &
42, 43, 54, &
34, 45, 47, &
1, 8, 49, &
3, 14, 59, &
4, 31, 46, &
6, 20, 50, &
7, 26, 53, &
9, 10, 36, &
11, 58, 60, &
12, 21, 45, &
13, 28, 33, &
15, 17, 35, &
16, 38, 52, &
18, 41, 54, &
19, 23, 32, &
22, 40, 55, &
24, 25, 42, &
26, 27, 56, &
29, 44, 54, &
30, 37, 55/
data Nm/ &
1, 21, 42, 62, 82, 103, 0, &
2, 22, 43, 63, 83, 97, 0, &
3, 23, 44, 64, 84, 104, 0, &
2, 24, 45, 65, 78, 105, 0, &
4, 25, 46, 66, 85, 98, 0, &
5, 26, 47, 64, 86, 106, 0, &
6, 27, 41, 67, 87, 107, 0, &
7, 28, 48, 68, 84, 103, 0, &
8, 29, 49, 69, 88, 108, 0, &
9, 22, 50, 70, 84, 108, 0, &
10, 21, 41, 65, 89, 109, 0, &
11, 23, 49, 71, 90, 110, 0, &
10, 29, 43, 66, 91, 111, 0, &
12, 29, 51, 72, 86, 104, 0, &
13, 30, 51, 73, 92, 112, 0, &
13, 22, 52, 67, 93, 113, 0, &
14, 31, 52, 74, 94, 112, 0, &
1, 32, 45, 75, 93, 114, 0, &
15, 33, 53, 68, 89, 115, 0, &
12, 33, 44, 76, 93, 106, 0, &
16, 34, 47, 70, 82, 110, 0, &
17, 30, 54, 71, 91, 116, 0, &
3, 25, 55, 77, 95, 115, 0, &
6, 24, 56, 64, 94, 117, 0, &
18, 32, 51, 77, 89, 117, 0, &
8, 31, 57, 68, 96, 107, 118, &
19, 23, 58, 75, 97, 118, 0, &
16, 24, 55, 76, 96, 111, 0, &
9, 26, 38, 78, 91, 119, 0, &
8, 34, 59, 79, 92, 120, 0, &
18, 27, 47, 69, 85, 105, 0, &
19, 35, 56, 79, 98, 115, 0, &
20, 36, 58, 61, 99, 111, 0, &
16, 37, 60, 67, 88, 102, 0, &
7, 38, 56, 80, 100, 112, 0, &
4, 34, 58, 78, 87, 108, 0, &
15, 39, 50, 80, 85, 120, 0, &
19, 37, 50, 72, 95, 113, 0, &
14, 26, 53, 75, 81, 88, 0, &
20, 31, 44, 63, 82, 116, 0, &
15, 30, 55, 62, 97, 114, 0, &
4, 40, 42, 81, 101, 117, 0, &
5, 39, 61, 73, 96, 101, 0, &
14, 41, 54, 76, 98, 119, 0, &
9, 32, 46, 57, 102, 110, 0, &
10, 37, 48, 73, 94, 105, 0, &
3, 21, 59, 80, 99, 102, 0, &
1, 39, 49, 74, 100, 0, 0, &
5, 35, 43, 77, 87, 103, 0, &
17, 28, 60, 74, 83, 106, 0, &
2, 40, 54, 72, 99, 0, 0, &
18, 40, 48, 79, 90, 113, 0, &
11, 36, 53, 70, 100, 107, 0, &
11, 27, 59, 63, 101, 114, 119, &
6, 33, 46, 61, 83, 116, 120, &
20, 28, 45, 66, 92, 118, 0, &
12, 38, 60, 62, 90, 0, 0, &
13, 36, 42, 69, 95, 109, 0, &
17, 35, 57, 65, 81, 104, 0, &
7, 25, 52, 71, 86, 109, 0/
data nrw/ &
6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, &
6,6,6,6,6,7,6,6,6,6,6,6,6,6,6,6,6,6,6,6, &
6,6,6,6,6,6,6,5,6,6,5,6,6,7,7,6,5,6,6,6/
ncw=3
toc=0
tov=0
tanhtoc=0
!write(*,*) llr
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
!write(*,*) 'number of unsatisfied parity checks ',ncheck
if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it
niterations=iter
codeword=cw(colorder+1)
decoded=codeword(M+1:N)
return
endif
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 3 .and. iter .ge. 5 .and. ncheck .gt. 10) then
niterations=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:7,i)=tanh(-toc(1:7,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo
niterations=-1
return
end subroutine bpdecode120

380
lib/fsk4hf/bpdecode168.f90
View File

@ -1,380 +0,0 @@
subroutine bpdecode168(llr,apmask,maxiterations,decoded,niterations)
!
! A log-domain belief propagation decoder for the (168,84) code.
!
integer, parameter:: N=168, K=84, M=N-K
integer*1 codeword(N),cw(N),apmask(N)
integer colorder(N)
integer*1 decoded(K)
integer Nm(7,M) ! 5, 6, or 7 bits per check
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(7,M)
real tanhtoc(7,M)
real zn(N)
real llr(N)
real Tmn
integer nrw(M)
data colorder/0,1,2,3,28,4,5,6,7,8,9,10,11,34,12,32,13,14,15,16,17, &
18,36,29,42,31,20,21,41,40,30,38,22,19,47,37,46,35,44,33,49,24, &
43,51,25,26,27,50,52,57,69,54,55,45,59,58,56,61,60,53,48,23,62, &
63,64,67,66,65,68,39,70,71,72,74,73,75,76,77,80,81,78,82,79,83, &
84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104, &
105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125, &
126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146, &
147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167/
data Mn/ &
1,24,67, &
2,5,71, &
3,31,66, &
4,50,58, &
6,60,65, &
7,32,76, &
8,49,83, &
9,36,41, &
10,40,63, &
11,14,62, &
12,72,75, &
13,23,78, &
15,16,80, &
17,54,64, &
18,51,59, &
19,30,48, &
20,68,81, &
21,29,70, &
22,25,43, &
26,34,73, &
27,35,37, &
28,39,44, &
33,53,55, &
38,52,84, &
42,56,57, &
45,74,82, &
46,69,79, &
47,61,77, &
1,4,5, &
2,48,52, &
3,47,82, &
6,26,76, &
7,9,16, &
8,10,78, &
11,36,56, &
12,38,65, &
13,43,81, &
14,33,68, &
15,18,44, &
17,59,77, &
19,27,69, &
20,21,58, &
22,45,79, &
23,34,54, &
24,28,40, &
25,80,84, &
29,37,51, &
30,42,83, &
31,63,72, &
32,50,66, &
35,67,73, &
39,55,74, &
41,61,71, &
46,60,62, &
49,70,74, &
53,64,75, &
25,57,67, &
1,46,64, &
2,51,63, &
3,14,80, &
4,15,78, &
5,27,74, &
6,13,70, &
7,19,20, &
8,38,77, &
9,75,83, &
10,36,69, &
11,22,29, &
12,58,82, &
16,35,60, &
17,32,43, &
18,42,45, &
21,53,84, &
23,39,48, &
24,52,68, &
26,33,61, &
28,56,76, &
30,65,66, &
31,34,49, &
37,47,81, &
16,40,54, &
41,44,65, &
50,73,79, &
55,59,60, &
54,57,71, &
23,62,72, &
1,36,47, &
2,32,70, &
3,28,69, &
4,7,33, &
5,20,26, &
6,14,63, &
8,22,68, &
9,13,67, &
10,55,71, &
11,15,19, &
12,51,56, &
17,27,52, &
18,34,46, &
21,41,42, &
24,50,80, &
25,39,75, &
29,54,76, &
30,40,84, &
31,35,58, &
37,79,83, &
38,43,73, &
44,72,81, &
7,45,62, &
47,48,49, &
53,57,78, &
20,59,66, &
28,61,64, &
11,75,77, &
33,54,82, &
1,14,44, &
2,62,73, &
3,9,26, &
4,37,84, &
5,56,80, &
6,45,71, &
8,67,72, &
10,76,81, &
12,32,78, &
13,59,82, &
15,17,79, &
16,42,69, &
18,61,70, &
19,31,64, &
21,39,63, &
22,30,58, &
23,27,66, &
24,41,49, &
25,36,60, &
29,65,67, &
34,36,53, &
35,48,76, &
15,38,55, &
40,43,74, &
46,52,57, &
50,63,77, &
51,68,69, &
2,44,83, &
1,30,55, &
3,29,78, &
4,34,65, &
5,31,38, &
6,52,58, &
7,25,51, &
8,16,66, &
9,46,74, &
10,70,75, &
11,32,84, &
12,48,79, &
13,50,64, &
14,37,57, &
17,42,72, &
18,43,48, &
19,24,60, &
20,54,83, &
21,47,62, &
22,28,59, &
23,61,80, &
8,26,39, &
27,44,53, &
33,49,56, &
35,68,71, &
12,26,40/
data Nm/ &
1,29,58,87,116,144,0,&
2,30,59,88,117,143,0,&
3,31,60,89,118,145,0,&
4,29,61,90,119,146,0,&
2,29,62,91,120,147,0,&
5,32,63,92,121,148,0,&
6,33,64,90,109,149,0,&
7,34,65,93,122,150,164,&
8,33,66,94,118,151,0,&
9,34,67,95,123,152,0,&
10,35,68,96,114,153,0,&
11,36,69,97,124,154,168,&
12,37,63,94,125,155,0,&
10,38,60,92,116,156,0,&
13,39,61,96,126,138,0,&
13,33,70,81,127,150,0,&
14,40,71,98,126,157,0,&
15,39,72,99,128,158,0,&
16,41,64,96,129,159,0,&
17,42,64,91,112,160,0,&
18,42,73,100,130,161,0,&
19,43,68,93,131,162,0,&
12,44,74,86,132,163,0,&
1,45,75,101,133,159,0,&
19,46,57,102,134,149,0,&
20,32,76,91,118,164,168,&
21,41,62,98,132,165,0,&
22,45,77,89,113,162,0,&
18,47,68,103,135,145,0,&
16,48,78,104,131,144,0,&
3,49,79,105,129,147,0,&
6,50,71,88,124,153,0,&
23,38,76,90,115,166,0,&
20,44,79,99,136,146,0,&
21,51,70,105,137,167,0,&
8,35,67,87,134,136,0,&
21,47,80,106,119,156,0,&
24,36,65,107,138,147,0,&
22,52,74,102,130,164,0,&
9,45,81,104,139,168,0,&
8,53,82,100,133,0,0,&
25,48,72,100,127,157,0,&
19,37,71,107,139,158,0,&
22,39,82,108,116,143,165,&
26,43,72,109,121,0,0,&
27,54,58,99,140,151,0,&
28,31,80,87,110,161,0,&
16,30,74,110,137,154,158,&
7,55,79,110,133,166,0,&
4,50,83,101,141,155,0,&
15,47,59,97,142,149,0,&
24,30,75,98,140,148,0,&
23,56,73,111,136,165,0,&
14,44,81,85,103,115,160,&
23,52,84,95,138,144,0,&
25,35,77,97,120,166,0,&
25,57,85,111,140,156,0,&
4,42,69,105,131,148,0,&
15,40,84,112,125,162,0,&
5,54,70,84,134,159,0,&
28,53,76,113,128,163,0,&
10,54,86,109,117,161,0,&
9,49,59,92,130,141,0,&
14,56,58,113,129,155,0,&
5,36,78,82,135,146,0,&
3,50,78,112,132,150,0,&
1,51,57,94,122,135,0,&
17,38,75,93,142,167,0,&
27,41,67,89,127,142,0,&
18,55,63,88,128,152,0,&
2,53,85,95,121,167,0,&
11,49,86,108,122,157,0,&
20,51,83,107,117,0,0,&
26,52,55,62,139,151,0,&
11,56,66,102,114,152,0,&
6,32,77,103,123,137,0,&
28,40,65,114,141,0,0,&
12,34,61,111,124,145,0,&
27,43,83,106,126,154,0,&
13,46,60,101,120,163,0,&
17,37,80,108,123,0,0,&
26,31,69,115,125,0,0,&
7,48,66,106,143,160,0,&
24,46,73,104,119,153,0/
data nrw/ &
6,6,6,6,6,6,6,7,6,6,6,7,6,6,6,6,6,6,6,6,6, &
6,6,6,6,7,6,6,6,6,6,6,6,6,6,6,6,6,6,6,5,6, &
6,7,5,6,6,7,6,6,6,6,6,7,6,6,6,6,6,6,6,6,6, &
6,6,6,6,6,6,6,6,6,5,6,6,6,5,6,6,6,5,5,6,6/
ncw=3
toc=0
tov=0
tanhtoc=0
!write(*,*) llr
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
!write(*,*) 'number of unsatisfied parity checks ',ncheck
if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it
niterations=iter
codeword=cw(colorder+1)
decoded=codeword(M+1:N)
return
endif
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 3 .and. iter .ge. 5 .and. ncheck .gt. 10) then
niterations=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:7,i)=tanh(-toc(1:7,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo
niterations=-1
return
end subroutine bpdecode168

111
lib/fsk4hf/bpdecode174_101.f90
View File

@ -1,111 +0,0 @@
subroutine bpdecode174_101(llr,apmask,maxiterations,message101,cw,nharderror,iter,ncheck)
!
! A log-domain belief propagation decoder for the (174,101) code.
!
integer, parameter:: N=174, K=101, M=N-K
integer*1 cw(N),apmask(N)
integer*1 decoded(K)
integer*1 message101(101)
integer nrw(M),ncw
integer Nm(8,M)
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(8,M)
real tanhtoc(8,M)
real zn(N)
real llr(N)
real Tmn
include "ldpc_174_101_parity.f90"
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
nclast=0
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it
decoded=cw(1:101)
call get_crc24(decoded,101,nbadcrc)
nharderror=count( (2*cw-1)*llr .lt. 0.0 )
if(nbadcrc.eq.0) then
message101=decoded(1:101)
return
endif
endif
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:8,i)=tanh(-toc(1:8,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo
nharderror=-1
return
end subroutine bpdecode174_101

113
lib/fsk4hf/bpdecode174_74.f90
View File

@ -1,113 +0,0 @@
subroutine bpdecode174_74(llr,apmask,maxiterations,message50,cw,nharderror,iter,ncheck)
!
! A log-domain belief propagation decoder for the (174,74) code.
!
integer, parameter:: N=174, K=74, M=N-K
integer*1 cw(N),apmask(N)
integer*1 decoded(K)
integer*1 message50(50)
integer nrw(M),ncw
integer Nm(6,M)
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(6,M)
real tanhtoc(6,M)
real zn(N)
real llr(N)
real Tmn
include "ldpc_174_74_parity.f90"
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
nclast=0
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it
decoded=cw(1:74)
call get_crc24(decoded,74,nbadcrc)
nharderror=count( (2*cw-1)*llr .lt. 0.0 )
if(nbadcrc.eq.0) then
message50=decoded(1:50)
return
endif
endif
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:6,i)=tanh(-toc(1:6,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo
nharderror=-1
return
end subroutine bpdecode174_74

393
lib/fsk4hf/bpdecode174b.f90
View File

@ -1,393 +0,0 @@
subroutine bpdecode174b(llr,apmask,maxiterations,decoded,cw,nharderror,iter)
!
! A log-domain belief propagation decoder for the (174,91) code.
!
integer, parameter:: N=174, K=91, M=N-K
integer*1 codeword(N),cw(N),apmask(N)
integer colorder(N)
integer*1 decoded(K)
integer Nm(7,M)
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(7,M)
real tanhtoc(7,M)
real zn(N)
real llr(N)
real Tmn
integer nrw(M)
data colorder/ &
0, 1, 2, 3, 28, 4, 5, 6, 7, 8, 9, 10, 11, 34, 12, 32, 13, 14, 15, 16,&
17, 18, 36, 29, 40, 19, 20, 38, 21, 41, 30, 42, 22, 44, 37, 47, 48, 23, 33, 43,&
49, 45, 56, 39, 25, 26, 46, 50, 51, 52, 24, 57, 58, 61, 31, 54, 64, 35, 27, 62,&
59, 53, 60, 63, 55, 70, 66, 67, 68, 65, 71, 74, 72, 73, 77, 75, 69, 76, 79, 82,&
83, 78, 81, 80, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99,&
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,&
120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,&
140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,&
160,161,162,163,164,165,166,167,168,169,170,171,172,173/
data Mn/ &
1, 24, 66, &
2, 5, 70, &
3, 31, 65, &
4, 49, 58, &
6, 60, 67, &
7, 32, 75, &
8, 48, 82, &
9, 35, 41, &
10, 39, 62, &
11, 14, 61, &
12, 71, 74, &
13, 23, 78, &
15, 16, 79, &
17, 54, 63, &
18, 50, 57, &
19, 30, 47, &
20, 64, 80, &
21, 28, 69, &
22, 25, 43, &
26, 34, 72, &
27, 36, 37, &
29, 40, 44, &
33, 52, 53, &
38, 55, 83, &
42, 51, 59, &
45, 76, 81, &
46, 68, 77, &
56, 67, 73, &
1, 4, 5, &
2, 47, 51, &
3, 46, 82, &
6, 24, 76, &
7, 9, 16, &
8, 10, 78, &
11, 35, 55, &
12, 38, 64, &
13, 42, 83, &
14, 27, 54, &
15, 21, 34, &
17, 44, 53, &
18, 25, 28, &
19, 33, 57, &
20, 22, 73, &
23, 40, 81, &
26, 49, 68, &
29, 71, 75, &
30, 65, 79, &
31, 36, 60, &
32, 43, 77, &
37, 62, 70, &
39, 69, 74, &
41, 52, 66, &
45, 50, 61, &
48, 63, 80, &
56, 59, 72, &
58, 64, 65, &
1, 13, 28, &
2, 48, 75, &
3, 53, 69, &
4, 11, 44, &
5, 73, 79, &
6, 12, 17, &
7, 57, 60, &
8, 15, 61, &
9, 39, 59, &
10, 19, 49, &
14, 43, 52, &
16, 54, 68, &
18, 41, 63, &
20, 36, 45, &
21, 67, 77, &
10, 22, 55, &
23, 65, 72, &
24, 27, 82, &
25, 26, 29, &
30, 35, 37, &
31, 51, 66, &
17, 32, 78, &
33, 42, 76, &
34, 70, 83, &
38, 46, 81, &
40, 62, 80, &
45, 47, 74, &
50, 56, 71, &
7, 37, 58, &
1, 16, 71, &
2, 6, 61, &
3, 22, 50, &
4, 59, 77, &
5, 41, 81, &
8, 58, 74, &
9, 20, 26, &
11, 21, 31, &
12, 66, 79, &
13, 14, 57, &
15, 33, 40, &
18, 44, 82, &
19, 69, 83, &
23, 49, 63, &
24, 29, 39, &
25, 47, 56, &
27, 55, 72, &
28, 64, 70, &
30, 48, 77, &
32, 34, 45, &
35, 68, 80, &
36, 38, 52, &
42, 43, 62, &
46, 60, 78, &
51, 54, 67, &
53, 73, 75, &
14, 73, 76, &
1, 22, 30, &
2, 35, 43, &
3, 47, 63, &
4, 25, 76, &
5, 33, 78, &
6, 20, 83, &
7, 12, 72, &
8, 54, 70, &
9, 61, 65, &
10, 34, 51, &
11, 46, 75, &
13, 39, 68, &
15, 17, 56, &
16, 23, 36, &
18, 32, 55, &
19, 31, 81, &
21, 37, 71, &
24, 57, 64, &
26, 38, 48, &
27, 49, 50, &
28, 52, 59, &
29, 41, 58, &
40, 60, 74, &
42, 44, 79, &
51, 53, 80, &
62, 67, 82, &
23, 66, 69, &
1, 53, 61, &
2, 18, 39, &
3, 4, 12, &
5, 26, 74, &
6, 30, 52, &
7, 82, 83, &
8, 35, 73, &
9, 19, 67, &
10, 64, 75, &
11, 20, 33, &
13, 45, 48, &
3, 14, 40, &
15, 43, 49, &
16, 55, 76, &
17, 62, 65, &
21, 47, 78, &
22, 59, 81, &
24, 34, 63, &
25, 37, 66, &
27, 79, 80, &
28, 60, 79, &
29, 31, 70, &
32, 58, 69, &
10, 36, 77, &
38, 50, 51, &
13, 41, 56, &
42, 63, 71, &
44, 47, 68, &
1, 46, 72, &
54, 57, 75, &
2, 33, 58, &
4, 17, 83, &
5, 14, 55, &
6, 23, 48, &
7, 52, 56/
data Nm/ &
1, 29, 57, 86, 113, 140, 168, &
2, 30, 58, 87, 114, 141, 170, &
3, 31, 59, 88, 115, 142, 151, &
4, 29, 60, 89, 116, 142, 171, &
2, 29, 61, 90, 117, 143, 172, &
5, 32, 62, 87, 118, 144, 173, &
6, 33, 63, 85, 119, 145, 174, &
7, 34, 64, 91, 120, 146, 0, &
8, 33, 65, 92, 121, 147, 0, &
9, 34, 66, 72, 122, 148, 163, &
10, 35, 60, 93, 123, 149, 0, &
11, 36, 62, 94, 119, 142, 0, &
12, 37, 57, 95, 124, 150, 165, &
10, 38, 67, 95, 112, 151, 172, &
13, 39, 64, 96, 125, 152, 0, &
13, 33, 68, 86, 126, 153, 0, &
14, 40, 62, 78, 125, 154, 171, &
15, 41, 69, 97, 127, 141, 0, &
16, 42, 66, 98, 128, 147, 0, &
17, 43, 70, 92, 118, 149, 0, &
18, 39, 71, 93, 129, 155, 0, &
19, 43, 72, 88, 113, 156, 0, &
12, 44, 73, 99, 126, 139, 173, &
1, 32, 74, 100, 130, 157, 0, &
19, 41, 75, 101, 116, 158, 0, &
20, 45, 75, 92, 131, 143, 0, &
21, 38, 74, 102, 132, 159, 0, &
18, 41, 57, 103, 133, 160, 0, &
22, 46, 75, 100, 134, 161, 0, &
16, 47, 76, 104, 113, 144, 0, &
3, 48, 77, 93, 128, 161, 0, &
6, 49, 78, 105, 127, 162, 0, &
23, 42, 79, 96, 117, 149, 170, &
20, 39, 80, 105, 122, 157, 0, &
8, 35, 76, 106, 114, 146, 0, &
21, 48, 70, 107, 126, 163, 0, &
21, 50, 76, 85, 129, 158, 0, &
24, 36, 81, 107, 131, 164, 0, &
9, 51, 65, 100, 124, 141, 0, &
22, 44, 82, 96, 135, 151, 0, &
8, 52, 69, 90, 134, 165, 0, &
25, 37, 79, 108, 136, 166, 0, &
19, 49, 67, 108, 114, 152, 0, &
22, 40, 60, 97, 136, 167, 0, &
26, 53, 70, 83, 105, 150, 0, &
27, 31, 81, 109, 123, 168, 0, &
16, 30, 83, 101, 115, 155, 167, &
7, 54, 58, 104, 131, 150, 173, &
4, 45, 66, 99, 132, 152, 0, &
15, 53, 84, 88, 132, 164, 0, &
25, 30, 77, 110, 122, 137, 164, &
23, 52, 67, 107, 133, 144, 174, &
23, 40, 59, 111, 137, 140, 0, &
14, 38, 68, 110, 120, 169, 0, &
24, 35, 72, 102, 127, 153, 172, &
28, 55, 84, 101, 125, 165, 174, &
15, 42, 63, 95, 130, 169, 0, &
4, 56, 85, 91, 134, 162, 170, &
25, 55, 65, 89, 133, 156, 0, &
5, 48, 63, 109, 135, 160, 0, &
10, 53, 64, 87, 121, 140, 0, &
9, 50, 82, 108, 138, 154, 0, &
14, 54, 69, 99, 115, 157, 166, &
17, 36, 56, 103, 130, 148, 0, &
3, 47, 56, 73, 121, 154, 0, &
1, 52, 77, 94, 139, 158, 0, &
5, 28, 71, 110, 138, 147, 0, &
27, 45, 68, 106, 124, 167, 0, &
18, 51, 59, 98, 139, 162, 0, &
2, 50, 80, 103, 120, 161, 0, &
11, 46, 84, 86, 129, 166, 0, &
20, 55, 73, 102, 119, 168, 0, &
28, 43, 61, 111, 112, 146, 0, &
11, 51, 83, 91, 135, 143, 0, &
6, 46, 58, 111, 123, 148, 169, &
26, 32, 79, 112, 116, 153, 0, &
27, 49, 71, 89, 104, 163, 0, &
12, 34, 78, 109, 117, 155, 0, &
13, 47, 61, 94, 136, 159, 160, &
17, 54, 82, 106, 137, 159, 0, &
26, 44, 81, 90, 128, 156, 0, &
7, 31, 74, 97, 138, 145, 0, &
24, 37, 80, 98, 118, 145, 171/
data nrw/ &
7,7,7,7,7,7,7,6,6,7,6,6,7,7,6,6,7,6, &
6,6,6,6,7,6,6,6,6,6,6,6,6,6,7,6,6,6, &
6,6,6,6,6,6,6,6,6,6,7,7,6,6,7,7,6,6, &
7,7,6,7,6,6,6,6,7,6,6,6,6,6,6,6,6,6, &
6,6,7,6,6,6,7,6,6,6,7/
ncw=3
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
! write(*,*) 'number of unsatisfied parity checks ',ncheck
if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it
codeword=cw(colorder+1)
decoded=codeword(M+1:N)
nerr=0
do i=1,N
if( (2*cw(i)-1)*llr(i) .lt. 0.0 ) nerr=nerr+1
enddo
nharderror=nerr
return
endif
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:6,i)=tanh(-toc(1:6,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo
nharderror=-1
return
end subroutine bpdecode174b

482
lib/fsk4hf/bpdecode204.f90
View File

@ -1,482 +0,0 @@
subroutine bpdecode204(llr,apmask,maxiterations,decoded,cw,nharderror,iter)
!
! A log-domain belief propagation decoder for the (204,68) code.
!
integer, parameter:: N=204, K=68, M=N-K
integer*1 codeword(N),cw(N),apmask(N)
integer colorder(N)
integer*1 decoded(K)
integer Nm(6,M) ! 4, 5, or 6 bits per check
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(6,M)
real tanhtoc(6,M)
real zn(N)
real llr(N)
real Tmn
integer nrw(M)
data colorder/ &
0, 1, 2, 3, 4, 5, 47, 6, 7, 8, 9, 10, 11, 12, 58, 55, 13, &
14, 15, 46, 17, 18, 60, 19, 20, 21, 22, 23, 24, 25, 57, 26, 27, 49, &
28, 52, 65, 16, 50, 73, 59, 68, 63, 29, 30, 31, 32, 51, 62, 56, 66, &
45, 33, 34, 53, 67, 35, 36, 37, 61, 69, 54, 38, 71, 82, 39, 77, 80, &
83, 78, 84, 48, 41, 85, 40, 64, 75, 96, 74, 72, 76, 86, 87, 89, 90, &
79, 70, 92, 99, 93,101, 95,100, 97, 94, 42, 98,103,105,102, 43,104, &
88, 44,106, 81,107,110,108,111,112,109,113,114,117,118,116,121,115, &
119,122,120,125,129,124,127,126,128, 91,123,133,131,130,134,135,137, &
136,132,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152, &
153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169, &
170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186, &
187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203/
data Mn/ &
1, 38, 107, &
2, 7, 114, &
3, 48, 106, &
4, 79, 94, &
5, 97, 108, &
6, 50, 122, &
8, 78, 134, &
9, 55, 65, &
10, 62, 100, &
11, 16, 99, &
12, 113, 119, &
13, 31, 125, &
14, 15, 127, &
17, 87, 103, &
18, 81, 98, &
19, 43, 77, &
20, 102, 130, &
21, 36, 111, &
22, 23, 60, &
24, 39, 112, &
25, 37, 42, &
26, 41, 51, &
27, 67, 70, &
28, 64, 136, &
29, 61, 68, &
30, 91, 124, &
32, 80, 121, &
33, 40, 117, &
34, 35, 90, &
44, 88, 93, &
45, 128, 133, &
46, 56, 69, &
47, 49, 52, &
53, 76, 131, &
54, 104, 116, &
57, 84, 86, &
58, 120, 135, &
59, 75, 92, &
63, 71, 109, &
66, 74, 126, &
72, 85, 105, &
73, 82, 95, &
83, 89, 123, &
96, 115, 118, &
101, 110, 129, &
52, 99, 132, &
1, 3, 20, &
2, 77, 89, &
4, 72, 75, &
5, 34, 79, &
6, 24, 130, &
7, 48, 88, &
8, 36, 116, &
9, 71, 114, &
10, 87, 101, &
11, 22, 121, &
12, 50, 64, &
13, 39, 53, &
14, 41, 78, &
15, 68, 96, &
16, 83, 90, &
17, 23, 45, &
18, 47, 126, &
19, 70, 91, &
21, 57, 76, &
25, 110, 117, &
26, 82, 135, &
27, 46, 58, &
28, 37, 56, &
29, 66, 102, &
30, 62, 125, &
31, 85, 93, &
32, 104, 113, &
33, 81, 92, &
35, 100, 118, &
38, 95, 133, &
40, 86, 109, &
42, 61, 124, &
43, 59, 119, &
44, 49, 134, &
51, 97, 122, &
54, 105, 107, &
55, 128, 136, &
60, 67, 84, &
63, 112, 115, &
65, 74, 131, &
69, 80, 94, &
73, 98, 123, &
103, 130, 134, &
46, 106, 111, &
1, 84, 108, &
120, 129, 132, &
65, 75, 127, &
2, 80, 101, &
3, 118, 119, &
4, 52, 124, &
5, 13, 68, &
6, 27, 81, &
7, 51, 76, &
8, 77, 108, &
9, 31, 58, &
10, 18, 57, &
11, 63, 105, &
12, 14, 132, &
15, 56, 123, &
16, 21, 128, &
17, 37, 59, &
19, 85, 126, &
20, 71, 91, &
22, 26, 117, &
23, 79, 98, &
24, 32, 95, &
25, 90, 93, &
28, 49, 109, &
29, 116, 120, &
30, 54, 136, &
33, 53, 107, &
34, 64, 103, &
35, 39, 67, &
36, 71, 73, &
38, 47, 125, &
40, 66, 94, &
41, 70, 104, &
42, 55, 112, &
43, 44, 82, &
29, 45, 88, &
48, 86, 127, &
50, 72, 135, &
60, 74, 96, &
61, 121, 131, &
62, 78, 92, &
69, 100, 133, &
83, 122, 129, &
87, 97, 106, &
89, 102, 113, &
24, 99, 108, &
20, 72, 110, &
111, 115, 117, &
35, 52, 114, &
1, 44, 94, &
2, 23, 107, &
3, 81, 136, &
4, 8, 96, &
5, 37, 70, &
6, 43, 131, &
7, 103, 115, &
9, 94, 122, &
10, 68, 82, &
11, 56, 88, &
12, 46, 126, &
13, 16, 75, &
14, 79, 112, &
15, 47, 110, &
17, 36, 39, &
18, 63, 120, &
19, 22, 55, &
21, 49, 113, &
25, 54, 57, &
26, 89, 125, &
27, 101, 109, &
28, 31, 60, &
30, 74, 97, &
32, 92, 93, &
33, 83, 91, &
34, 58, 121, &
38, 65, 111, &
40, 99, 118, &
3, 41, 61, &
42, 50, 100, &
45, 78, 106, &
48, 95, 129, &
51, 85, 133, &
53, 59, 69, &
11, 62, 66, &
64, 73, 124, &
67, 123, 134, &
76, 104, 132, &
77, 100, 127, &
36, 80, 119, &
84, 102, 135, &
86, 105, 124, &
4, 87, 128, &
90, 106, 116, &
65, 98, 130, &
92, 108, 114, &
1, 52, 121, &
2, 84, 117, &
5, 83, 105, &
6, 15, 63, &
7, 28, 82, &
8, 32, 135, &
9, 104, 134, &
9, 10, 89, &
12, 62, 107, &
13, 40, 103, &
14, 31, 95, &
16, 27, 74, &
17, 90, 132, &
18, 34, 69, &
19, 103, 129, &
20, 76, 87, &
21, 22, 130, &
23, 25, 99, &
24, 101, 126/
data Nm/ &
1, 47, 91, 140, 186, 0, &
2, 48, 94, 141, 187, 0, &
3, 47, 95, 142, 168, 0, &
4, 49, 96, 143, 182, 0, &
5, 50, 97, 144, 188, 0, &
6, 51, 98, 145, 189, 0, &
2, 52, 99, 146, 190, 0, &
7, 53, 100, 143, 191, 0, &
8, 54, 101, 147, 192, 193, &
9, 55, 102, 148, 193, 0, &
10, 56, 103, 149, 174, 0, &
11, 57, 104, 150, 194, 0, &
12, 58, 97, 151, 195, 0, &
13, 59, 104, 152, 196, 0, &
13, 60, 105, 153, 189, 0, &
10, 61, 106, 151, 197, 0, &
14, 62, 107, 154, 198, 0, &
15, 63, 102, 155, 199, 0, &
16, 64, 108, 156, 200, 0, &
17, 47, 109, 137, 201, 0, &
18, 65, 106, 157, 202, 0, &
19, 56, 110, 156, 202, 0, &
19, 62, 111, 141, 203, 0, &
20, 51, 112, 136, 204, 0, &
21, 66, 113, 158, 203, 0, &
22, 67, 110, 159, 0, 0, &
23, 68, 98, 160, 197, 0, &
24, 69, 114, 161, 190, 0, &
25, 70, 115, 126, 0, 0, &
26, 71, 116, 162, 0, 0, &
12, 72, 101, 161, 196, 0, &
27, 73, 112, 163, 191, 0, &
28, 74, 117, 164, 0, 0, &
29, 50, 118, 165, 199, 0, &
29, 75, 119, 139, 0, 0, &
18, 53, 120, 154, 179, 0, &
21, 69, 107, 144, 0, 0, &
1, 76, 121, 166, 0, 0, &
20, 58, 119, 154, 0, 0, &
28, 77, 122, 167, 195, 0, &
22, 59, 123, 168, 0, 0, &
21, 78, 124, 169, 0, 0, &
16, 79, 125, 145, 0, 0, &
30, 80, 125, 140, 0, 0, &
31, 62, 126, 170, 0, 0, &
32, 68, 90, 150, 0, 0, &
33, 63, 121, 153, 0, 0, &
3, 52, 127, 171, 0, 0, &
33, 80, 114, 157, 0, 0, &
6, 57, 128, 169, 0, 0, &
22, 81, 99, 172, 0, 0, &
33, 46, 96, 139, 186, 0, &
34, 58, 117, 173, 0, 0, &
35, 82, 116, 158, 0, 0, &
8, 83, 124, 156, 0, 0, &
32, 69, 105, 149, 0, 0, &
36, 65, 102, 158, 0, 0, &
37, 68, 101, 165, 0, 0, &
38, 79, 107, 173, 0, 0, &
19, 84, 129, 161, 0, 0, &
25, 78, 130, 168, 0, 0, &
9, 71, 131, 174, 194, 0, &
39, 85, 103, 155, 189, 0, &
24, 57, 118, 175, 0, 0, &
8, 86, 93, 166, 184, 0, &
40, 70, 122, 174, 0, 0, &
23, 84, 119, 176, 0, 0, &
25, 60, 97, 148, 0, 0, &
32, 87, 132, 173, 199, 0, &
23, 64, 123, 144, 0, 0, &
39, 54, 109, 120, 0, 0, &
41, 49, 128, 137, 0, 0, &
42, 88, 120, 175, 0, 0, &
40, 86, 129, 162, 197, 0, &
38, 49, 93, 151, 0, 0, &
34, 65, 99, 177, 201, 0, &
16, 48, 100, 178, 0, 0, &
7, 59, 131, 170, 0, 0, &
4, 50, 111, 152, 0, 0, &
27, 87, 94, 179, 0, 0, &
15, 74, 98, 142, 0, 0, &
42, 67, 125, 148, 190, 0, &
43, 61, 133, 164, 188, 0, &
36, 84, 91, 180, 187, 0, &
41, 72, 108, 172, 0, 0, &
36, 77, 127, 181, 0, 0, &
14, 55, 134, 182, 201, 0, &
30, 52, 126, 149, 0, 0, &
43, 48, 135, 159, 193, 0, &
29, 61, 113, 183, 198, 0, &
26, 64, 109, 164, 0, 0, &
38, 74, 131, 163, 185, 0, &
30, 72, 113, 163, 0, 0, &
4, 87, 122, 140, 147, 0, &
42, 76, 112, 171, 196, 0, &
44, 60, 129, 143, 0, 0, &
5, 81, 134, 162, 0, 0, &
15, 88, 111, 184, 0, 0, &
10, 46, 136, 167, 203, 0, &
9, 75, 132, 169, 178, 0, &
45, 55, 94, 160, 204, 0, &
17, 70, 135, 180, 0, 0, &
14, 89, 118, 146, 195, 200, &
35, 73, 123, 177, 192, 0, &
41, 82, 103, 181, 188, 0, &
3, 90, 134, 170, 183, 0, &
1, 82, 117, 141, 194, 0, &
5, 91, 100, 136, 185, 0, &
39, 77, 114, 160, 0, 0, &
45, 66, 137, 153, 0, 0, &
18, 90, 138, 166, 0, 0, &
20, 85, 124, 152, 0, 0, &
11, 73, 135, 157, 0, 0, &
2, 54, 139, 185, 0, 0, &
44, 85, 138, 146, 0, 0, &
35, 53, 115, 183, 0, 0, &
28, 66, 110, 138, 187, 0, &
44, 75, 95, 167, 0, 0, &
11, 79, 95, 179, 0, 0, &
37, 92, 115, 155, 0, 0, &
27, 56, 130, 165, 186, 0, &
6, 81, 133, 147, 0, 0, &
43, 88, 105, 176, 0, 0, &
26, 78, 96, 175, 181, 0, &
12, 71, 121, 159, 0, 0, &
40, 63, 108, 150, 204, 0, &
13, 93, 127, 178, 0, 0, &
31, 83, 106, 182, 0, 0, &
45, 92, 133, 171, 200, 0, &
17, 51, 89, 184, 202, 0, &
34, 86, 130, 145, 0, 0, &
46, 92, 104, 177, 198, 0, &
31, 76, 132, 172, 0, 0, &
7, 80, 89, 176, 192, 0, &
37, 67, 128, 180, 191, 0, &
24, 83, 116, 142, 0, 0/
data nrw/ &
5,5,5,5,5,5,5,5,6,5,5,5,5,5,5,5,5, &
5,5,5,5,5,5,5,5,4,5,5,4,4,5,5,4,5, &
4,5,4,4,4,5,4,4,4,4,4,4,4,4,4,4,4, &
5,4,4,4,4,4,4,4,4,4,5,5,4,5,4,4,4, &
5,4,4,4,4,5,4,5,4,4,4,4,4,5,5,5,4, &
4,5,4,5,5,4,5,4,5,5,4,4,4,5,5,5,4, &
6,5,5,5,5,5,4,4,4,4,4,4,4,4,5,4,4, &
4,5,4,4,5,4,5,4,4,5,5,4,5,4,5,5,4/
ncw=3
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
! write(*,*) 'number of unsatisfied parity checks ',ncheck
if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it
codeword=cw(colorder+1)
decoded=codeword(M+1:N)
nerr=0
do i=1,N
if( (2*cw(i)-1)*llr(i) .lt. 0.0 ) nerr=nerr+1
enddo
nharderror=nerr
return
endif
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:6,i)=tanh(-toc(1:6,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo
nharderror=-1
return
end subroutine bpdecode204

111
lib/fsk4hf/bpdecode240_101.f90
View File

@ -1,111 +0,0 @@
subroutine bpdecode240_101(llr,apmask,maxiterations,message101,cw,nharderror,iter,ncheck)
!
! A log-domain belief propagation decoder for the (240,101) code.
!
integer, parameter:: N=240, K=101, M=N-K
integer*1 cw(N),apmask(N)
integer*1 decoded(K)
integer*1 message101(101)
integer nrw(M),ncw
integer Nm(6,M)
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(6,M)
real tanhtoc(6,M)
real zn(N)
real llr(N)
real Tmn
include "ldpc_240_101_parity.f90"
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
nclast=0
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it
decoded=cw(1:101)
call get_crc24(decoded,101,nbadcrc)
nharderror=count( (2*cw-1)*llr .lt. 0.0 )
if(nbadcrc.eq.0) then
message101=decoded(1:101)
return
endif
endif
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:6,i)=tanh(-toc(1:6,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo
nharderror=-1
return
end subroutine bpdecode240_101

111
lib/fsk4hf/bpdecode280_101.f90
View File

@ -1,111 +0,0 @@
subroutine bpdecode280_101(llr,apmask,maxiterations,message101,cw,nharderror,iter,ncheck)
!
! A log-domain belief propagation decoder for the (280,101) code.
!
integer, parameter:: N=280, K=101, M=N-K
integer*1 cw(N),apmask(N)
integer*1 decoded(K)
integer*1 message101(101)
integer nrw(M),ncw
integer Nm(6,M)
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(6,M)
real tanhtoc(6,M)
real zn(N)
real llr(N)
real Tmn
include "ldpc_280_101_parity.f90"
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
nclast=0
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it
decoded=cw(1:101)
call get_crc24(decoded,101,nbadcrc)
nharderror=count( (2*cw-1)*llr .lt. 0.0 )
if(nbadcrc.eq.0) then
message101=decoded(1:101)
return
endif
endif
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:6,i)=tanh(-toc(1:6,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo
nharderror=-1
return
end subroutine bpdecode280_101

708
lib/fsk4hf/bpdecode300.f90
View File

@ -1,708 +0,0 @@
subroutine bpdecode300(llr,apmask,maxiterations,decoded,niterations,cw)
! A log-domain belief propagation decoder for the (300,60) code.
integer, parameter:: N=300, K=60, M=N-K
integer*1 codeword(N),cw(N),apmask(N)
integer colorder(N)
integer*1 decoded(K)
integer Nm(5,M) ! 4, or 5 bits per check
integer Mn(7,N) ! 2, 3, or 7 checks per bit
integer synd(M)
real tov(7,N)
real toc(5,M)
real tanhtoc(5,M)
real zn(N)
real llr(N)
real Tmn
integer nrw(M)
integer ncw(N)
data colorder/ &
0,1,2,3,4,5,6,7,8,9,10,11,123,12,13,14,15,16,17,18, &
19,20,21,22,23,24,25,138,26,145,27,28,29,30,31,32,33,34,35,36, &
37,154,38,39,40,41,42,43,44,144,46,47,48,49,50,51,52,53,143,54, &
125,56,57,58,124,59,120,140,157,160,55,60,61,62,156,162,141,64,65,153, &
181,183,66,170,67,68,69,130,70,164,71,72,73,74,75,63,76,77,135,78, &
79,80,176,169,82,83,84,167,180,85,136,158,129,166,175,142,134,146,121,165, &
88,89,192,90,45,91,92,93,182,189,94,95,96,173,81,97,98,178,122,126, &
132,99,100,152,186,193,101,102,151,103,104,172,159,168,150,190,147,148,201,107, &
205,177,108,198,197,174,127,109,185,110,202,87,199,171,179,187,139,137,106,131, &
206,194,112,149,155,113,128,184,196,86,114,203,212,195,208,105,188,161,163,191, &
200,209,214,204,115,218,133,111,207,117,213,216,211,217,116,215,219,220,210,221, &
118,222,223,225,224,228,226,229,231,227,233,119,234,235,232,230,237,239,236,238, &
240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259, &
260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279, &
280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299/
data Mn/ &
1, 67, 0, 0, 0, 0, 0, &
2, 189, 0, 0, 0, 0, 0, &
3, 201, 0, 0, 0, 0, 0, &
4, 13, 0, 0, 0, 0, 0, &
5, 84, 0, 0, 0, 0, 0, &
6, 188, 0, 0, 0, 0, 0, &
7, 140, 0, 0, 0, 0, 0, &
8, 167, 0, 0, 0, 0, 0, &
9, 187, 0, 0, 0, 0, 0, &
10, 173, 0, 0, 0, 0, 0, &
11, 88, 0, 0, 0, 0, 0, &
12, 213, 0, 0, 0, 0, 0, &
14, 141, 0, 0, 0, 0, 0, &
15, 236, 0, 0, 0, 0, 0, &
16, 117, 0, 0, 0, 0, 0, &
17, 99, 0, 0, 0, 0, 0, &
18, 111, 0, 0, 0, 0, 0, &
19, 178, 0, 0, 0, 0, 0, &
20, 28, 0, 0, 0, 0, 0, &
21, 177, 0, 0, 0, 0, 0, &
22, 199, 0, 0, 0, 0, 0, &
23, 209, 0, 0, 0, 0, 0, &
24, 220, 0, 0, 0, 0, 0, &
25, 59, 0, 0, 0, 0, 0, &
26, 224, 0, 0, 0, 0, 0, &
27, 30, 0, 0, 0, 0, 0, &
29, 157, 0, 0, 0, 0, 0, &
31, 184, 0, 0, 0, 0, 0, &
32, 179, 0, 0, 0, 0, 0, &
33, 149, 0, 0, 0, 0, 0, &
34, 144, 0, 0, 0, 0, 0, &
35, 80, 0, 0, 0, 0, 0, &
36, 228, 0, 0, 0, 0, 0, &
37, 185, 0, 0, 0, 0, 0, &
38, 197, 0, 0, 0, 0, 0, &
39, 69, 0, 0, 0, 0, 0, &
40, 42, 0, 0, 0, 0, 0, &
41, 112, 0, 0, 0, 0, 0, &
43, 70, 0, 0, 0, 0, 0, &
44, 198, 0, 0, 0, 0, 0, &
45, 76, 0, 0, 0, 0, 0, &
46, 68, 0, 0, 0, 0, 0, &
47, 90, 0, 0, 0, 0, 0, &
48, 75, 0, 0, 0, 0, 0, &
49, 118, 0, 0, 0, 0, 0, &
50, 125, 0, 0, 0, 0, 0, &
51, 114, 0, 0, 0, 0, 0, &
52, 239, 0, 0, 0, 0, 0, &
53, 108, 0, 0, 0, 0, 0, &
54, 120, 0, 0, 0, 0, 0, &
55, 162, 0, 0, 0, 0, 0, &
56, 218, 0, 0, 0, 0, 0, &
57, 138, 0, 0, 0, 0, 0, &
58, 212, 0, 0, 0, 0, 0, &
60, 207, 0, 0, 0, 0, 0, &
61, 71, 0, 0, 0, 0, 0, &
62, 65, 0, 0, 0, 0, 0, &
63, 161, 0, 0, 0, 0, 0, &
64, 166, 0, 0, 0, 0, 0, &
66, 158, 0, 0, 0, 0, 0, &
72, 235, 0, 0, 0, 0, 0, &
73, 225, 0, 0, 0, 0, 0, &
74, 116, 0, 0, 0, 0, 0, &
77, 96, 0, 0, 0, 0, 0, &
78, 81, 0, 0, 0, 0, 0, &
79, 82, 0, 0, 0, 0, 0, &
83, 229, 0, 0, 0, 0, 0, &
85, 134, 0, 0, 0, 0, 0, &
86, 176, 0, 0, 0, 0, 0, &
87, 203, 0, 0, 0, 0, 0, &
89, 145, 0, 0, 0, 0, 0, &
91, 152, 0, 0, 0, 0, 0, &
92, 237, 0, 0, 0, 0, 0, &
93, 215, 0, 0, 0, 0, 0, &
94, 130, 0, 0, 0, 0, 0, &
95, 156, 0, 0, 0, 0, 0, &
97, 104, 0, 0, 0, 0, 0, &
98, 182, 0, 0, 0, 0, 0, &
100, 222, 0, 0, 0, 0, 0, &
101, 123, 0, 0, 0, 0, 0, &
102, 181, 0, 0, 0, 0, 0, &
103, 135, 0, 0, 0, 0, 0, &
105, 146, 0, 0, 0, 0, 0, &
106, 115, 0, 0, 0, 0, 0, &
107, 109, 0, 0, 0, 0, 0, &
110, 194, 0, 0, 0, 0, 0, &
113, 164, 0, 0, 0, 0, 0, &
119, 172, 0, 0, 0, 0, 0, &
121, 190, 0, 0, 0, 0, 0, &
122, 169, 0, 0, 0, 0, 0, &
124, 211, 0, 0, 0, 0, 0, &
126, 165, 0, 0, 0, 0, 0, &
127, 139, 0, 0, 0, 0, 0, &
128, 129, 0, 0, 0, 0, 0, &
131, 205, 0, 0, 0, 0, 0, &
132, 196, 0, 0, 0, 0, 0, &
133, 193, 0, 0, 0, 0, 0, &
136, 200, 0, 0, 0, 0, 0, &
137, 159, 0, 0, 0, 0, 0, &
142, 204, 0, 0, 0, 0, 0, &
143, 154, 0, 0, 0, 0, 0, &
147, 238, 0, 0, 0, 0, 0, &
148, 175, 0, 0, 0, 0, 0, &
150, 216, 0, 0, 0, 0, 0, &
151, 171, 0, 0, 0, 0, 0, &
153, 231, 0, 0, 0, 0, 0, &
155, 208, 0, 0, 0, 0, 0, &
160, 230, 0, 0, 0, 0, 0, &
163, 223, 0, 0, 0, 0, 0, &
168, 217, 0, 0, 0, 0, 0, &
170, 180, 0, 0, 0, 0, 0, &
174, 233, 0, 0, 0, 0, 0, &
183, 202, 0, 0, 0, 0, 0, &
186, 214, 0, 0, 0, 0, 0, &
191, 206, 0, 0, 0, 0, 0, &
192, 219, 0, 0, 0, 0, 0, &
195, 227, 0, 0, 0, 0, 0, &
210, 226, 0, 0, 0, 0, 0, &
221, 234, 0, 0, 0, 0, 0, &
232, 240, 0, 0, 0, 0, 0, &
1, 106, 0, 0, 0, 0, 0, &
2, 119, 0, 0, 0, 0, 0, &
3, 139, 0, 0, 0, 0, 0, &
4, 14, 0, 0, 0, 0, 0, &
5, 65, 0, 0, 0, 0, 0, &
6, 61, 0, 0, 0, 0, 0, &
7, 223, 0, 0, 0, 0, 0, &
8, 171, 0, 0, 0, 0, 0, &
9, 136, 0, 0, 0, 0, 0, &
10, 113, 0, 0, 0, 0, 0, &
11, 104, 0, 0, 0, 0, 0, &
12, 175, 0, 0, 0, 0, 0, &
13, 203, 0, 0, 0, 0, 0, &
15, 149, 0, 0, 0, 0, 0, &
16, 226, 0, 0, 0, 0, 0, &
17, 219, 0, 0, 0, 0, 0, &
18, 98, 0, 0, 0, 0, 0, &
19, 211, 0, 0, 0, 0, 0, &
20, 49, 0, 0, 0, 0, 0, &
21, 214, 0, 0, 0, 0, 0, &
22, 68, 0, 0, 0, 0, 0, &
23, 77, 0, 0, 0, 0, 0, &
24, 116, 0, 0, 0, 0, 0, &
25, 235, 0, 0, 0, 0, 0, &
26, 50, 0, 0, 0, 0, 0, &
27, 124, 0, 0, 0, 0, 0, &
28, 229, 0, 0, 0, 0, 0, &
29, 83, 0, 0, 0, 0, 0, &
30, 158, 0, 0, 0, 0, 0, &
31, 220, 0, 0, 0, 0, 0, &
32, 155, 0, 0, 0, 0, 0, &
33, 152, 0, 0, 0, 0, 0, &
34, 231, 0, 0, 0, 0, 0, &
35, 207, 0, 0, 0, 0, 0, &
36, 40, 0, 0, 0, 0, 0, &
37, 142, 0, 0, 0, 0, 0, &
38, 75, 0, 0, 0, 0, 0, &
39, 90, 167, 0, 0, 0, 0, &
41, 55, 125, 0, 0, 0, 0, &
42, 153, 196, 0, 0, 0, 0, &
43, 72, 112, 0, 0, 0, 0, &
44, 183, 233, 0, 0, 0, 0, &
45, 81, 178, 0, 0, 0, 0, &
46, 187, 230, 0, 0, 0, 0, &
47, 133, 176, 0, 0, 0, 0, &
48, 54, 186, 0, 0, 0, 0, &
51, 150, 224, 0, 0, 0, 0, &
52, 53, 190, 0, 0, 0, 0, &
56, 143, 228, 0, 0, 0, 0, &
57, 97, 197, 0, 0, 0, 0, &
58, 62, 89, 0, 0, 0, 0, &
59, 174, 194, 0, 0, 0, 0, &
60, 91, 93, 0, 0, 0, 0, &
63, 85, 96, 0, 0, 0, 0, &
64, 92, 205, 0, 0, 0, 0, &
66, 67, 164, 0, 0, 0, 0, &
69, 103, 159, 0, 0, 0, 0, &
70, 117, 122, 0, 0, 0, 0, &
71, 88, 160, 0, 0, 0, 0, &
73, 148, 180, 0, 0, 0, 0, &
74, 108, 109, 0, 0, 0, 0, &
76, 102, 151, 0, 0, 0, 0, &
78, 128, 206, 0, 0, 0, 0, &
79, 215, 239, 0, 0, 0, 0, &
80, 138, 221, 0, 0, 0, 0, &
82, 162, 195, 0, 0, 0, 0, &
84, 161, 184, 0, 0, 0, 0, &
86, 213, 218, 0, 0, 0, 0, &
87, 120, 240, 0, 0, 0, 0, &
94, 100, 157, 0, 0, 0, 0, &
95, 202, 217, 0, 0, 0, 0, &
99, 199, 201, 0, 0, 0, 0, &
101, 127, 225, 0, 0, 0, 0, &
105, 168, 185, 0, 0, 0, 0, &
107, 182, 237, 0, 0, 0, 0, &
110, 147, 208, 0, 0, 0, 0, &
111, 118, 172, 0, 0, 0, 0, &
114, 140, 165, 0, 0, 0, 0, &
115, 130, 141, 0, 0, 0, 0, &
121, 144, 173, 0, 0, 0, 0, &
123, 204, 209, 0, 0, 0, 0, &
126, 137, 188, 0, 0, 0, 0, &
129, 179, 189, 0, 0, 0, 0, &
131, 192, 210, 0, 0, 0, 0, &
132, 200, 238, 0, 0, 0, 0, &
134, 177, 191, 0, 0, 0, 0, &
135, 145, 222, 0, 0, 0, 0, &
146, 229, 236, 0, 0, 0, 0, &
154, 169, 232, 0, 0, 0, 0, &
124, 156, 163, 0, 0, 0, 0, &
166, 223, 234, 0, 0, 0, 0, &
1, 11, 170, 0, 0, 0, 0, &
3, 181, 227, 0, 0, 0, 0, &
193, 198, 220, 0, 0, 0, 0, &
10, 16, 212, 0, 0, 0, 0, &
42, 96, 216, 0, 0, 0, 0, &
2, 6, 215, 0, 0, 0, 0, &
4, 208, 219, 0, 0, 0, 0, &
5, 22, 35, 0, 0, 0, 0, &
7, 12, 20, 0, 0, 0, 0, &
8, 15, 75, 0, 0, 0, 0, &
9, 74, 83, 0, 0, 0, 0, &
13, 37, 50, 0, 0, 0, 0, &
14, 52, 86, 0, 0, 0, 0, &
17, 30, 177, 0, 0, 0, 0, &
18, 25, 97, 0, 0, 0, 0, &
19, 72, 157, 0, 0, 0, 0, &
21, 58, 116, 0, 0, 0, 0, &
23, 111, 226, 0, 0, 0, 0, &
24, 26, 180, 0, 0, 0, 0, &
27, 34, 39, 0, 0, 0, 0, &
28, 32, 161, 0, 0, 0, 0, &
29, 36, 60, 0, 0, 0, 0, &
31, 76, 154, 0, 0, 0, 0, &
33, 101, 238, 0, 0, 0, 0, &
38, 95, 162, 0, 0, 0, 0, &
40, 164, 183, 0, 0, 0, 0, &
41, 92, 196, 0, 0, 0, 0, &
43, 48, 99, 165, 190, 198, 204, &
44, 129, 138, 145, 160, 203, 237, &
45, 65, 66, 98, 127, 137, 146, &
46, 131, 149, 181, 211, 218, 224, &
47, 49, 55, 191, 194, 207, 232, &
51, 69, 106, 109, 119, 184, 217, &
53, 62, 104, 155, 166, 206, 231, &
54, 61, 63, 73, 118, 151, 163, &
56, 94, 110, 117, 185, 189, 214, &
57, 81, 91, 115, 173, 175, 227, &
59, 79, 103, 136, 171, 201, 212, &
24, 64, 77, 93, 202, 235, 236, &
67, 132, 142, 150, 156, 176, 222, &
68, 153, 159, 169, 170, 186, 221, &
70, 84, 89, 113, 174, 197, 205, &
71, 125, 130, 140, 158, 200, 210, &
8, 78, 143, 182, 192, 193, 216, &
23, 80, 82, 90, 108, 139, 228, &
85, 122, 123, 128, 141, 187, 188, &
25, 87, 100, 152, 209, 213, 234, &
88, 134, 147, 167, 172, 178, 239, &
18, 40, 102, 114, 133, 144, 179, &
4, 105, 108, 112, 148, 230, 240, &
29, 33, 50, 62, 107, 195, 199, &
3, 83, 113, 120, 126, 177, 216, &
11, 55, 116, 121, 135, 168, 225, &
1, 27, 28, 76, 187, 226, 233, &
2, 4, 7, 10, 22, 75, 222, &
5, 30, 131, 152, 156, 168, 215, &
6, 13, 19, 58, 196, 228, 229, &
9, 26, 144, 147, 158, 223, 240, &
12, 31, 66, 79, 92, 96, 155, &
14, 54, 103, 173, 202, 232, 238, &
15, 17, 37, 69, 129, 164, 209, &
16, 72, 91, 114, 163, 169, 237, &
20, 45, 89, 99, 143, 180, 208, &
21, 39, 60, 141, 171, 198, 234, &
21, 32, 52, 78, 95, 148, 199, &
34, 73, 84, 157, 200, 221, 236, &
35, 36, 63, 97, 105, 119, 220, &
38, 46, 93, 111, 136, 191, 203, &
41, 51, 151, 160, 213, 214, 231, &
42, 57, 65, 161, 167, 194, 204, &
43, 109, 162, 175, 189, 210, 212, &
44, 74, 100, 149, 170, 188, 197, &
47, 64, 88, 107, 122, 165, 211, &
48, 139, 179, 184, 218, 233, 239, &
49, 94, 106, 112, 138, 142, 205, &
53, 59, 102, 115, 134, 182, 225, &
56, 68, 101, 150, 166, 178, 207, &
61, 117, 126, 154, 195, 219, 224, &
67, 80, 118, 174, 185, 190, 235, &
70, 77, 86, 125, 153, 172, 193, &
32, 71, 87, 90, 98, 110, 135, &
41, 75, 81, 85, 124, 133, 201, &
82, 120, 128, 140, 159, 176, 183, &
22, 72, 104, 130, 146, 181, 217, &
25, 89, 96, 121, 132, 186, 230, &
118, 123, 145, 192, 196, 227, 240, &
1, 14, 35, 38, 114, 127, 192, &
7, 23, 43, 63, 116, 137, 206, &
2, 37, 52, 57, 64, 76, 120/
data Nm/ &
1, 121, 212, 265, 298, &
2, 122, 217, 266, 300, &
3, 123, 213, 263, 0, &
4, 124, 218, 261, 266, &
5, 125, 219, 267, 0, &
6, 126, 217, 268, 0, &
7, 127, 220, 266, 299, &
8, 128, 221, 255, 0, &
9, 129, 222, 269, 0, &
10, 130, 215, 266, 0, &
11, 131, 212, 264, 0, &
12, 132, 220, 270, 0, &
4, 133, 223, 268, 0, &
13, 124, 224, 271, 298, &
14, 134, 221, 272, 0, &
15, 135, 215, 273, 0, &
16, 136, 225, 272, 0, &
17, 137, 226, 260, 0, &
18, 138, 227, 268, 0, &
19, 139, 220, 274, 0, &
20, 140, 228, 275, 276, &
21, 141, 219, 266, 295, &
22, 142, 229, 256, 299, &
23, 143, 230, 250, 0, &
24, 144, 226, 258, 296, &
25, 145, 230, 269, 0, &
26, 146, 231, 265, 0, &
19, 147, 232, 265, 0, &
27, 148, 233, 262, 0, &
26, 149, 225, 267, 0, &
28, 150, 234, 270, 0, &
29, 151, 232, 276, 292, &
30, 152, 235, 262, 0, &
31, 153, 231, 277, 0, &
32, 154, 219, 278, 298, &
33, 155, 233, 278, 0, &
34, 156, 223, 272, 300, &
35, 157, 236, 279, 298, &
36, 158, 231, 275, 0, &
37, 155, 237, 260, 0, &
38, 159, 238, 280, 293, &
37, 160, 216, 281, 0, &
39, 161, 239, 282, 299, &
40, 162, 240, 283, 0, &
41, 163, 241, 274, 0, &
42, 164, 242, 279, 0, &
43, 165, 243, 284, 0, &
44, 166, 239, 285, 0, &
45, 139, 243, 286, 0, &
46, 145, 223, 262, 0, &
47, 167, 244, 280, 0, &
48, 168, 224, 276, 300, &
49, 168, 245, 287, 0, &
50, 166, 246, 271, 0, &
51, 159, 243, 264, 0, &
52, 169, 247, 288, 0, &
53, 170, 248, 281, 300, &
54, 171, 228, 268, 0, &
24, 172, 249, 287, 0, &
55, 173, 233, 275, 0, &
56, 126, 246, 289, 0, &
57, 171, 245, 262, 0, &
58, 174, 246, 278, 299, &
59, 175, 250, 284, 300, &
57, 125, 241, 281, 0, &
60, 176, 241, 270, 0, &
1, 176, 251, 290, 0, &
42, 141, 252, 288, 0, &
36, 177, 244, 272, 0, &
39, 178, 253, 291, 0, &
56, 179, 254, 292, 0, &
61, 161, 227, 273, 295, &
62, 180, 246, 277, 0, &
63, 181, 222, 283, 0, &
44, 157, 221, 266, 293, &
41, 182, 234, 265, 300, &
64, 142, 250, 291, 0, &
65, 183, 255, 276, 0, &
66, 184, 249, 270, 0, &
32, 185, 256, 290, 0, &
65, 163, 248, 293, 0, &
66, 186, 256, 294, 0, &
67, 148, 222, 263, 0, &
5, 187, 253, 277, 0, &
68, 174, 257, 293, 0, &
69, 188, 224, 291, 0, &
70, 189, 258, 292, 0, &
11, 179, 259, 284, 0, &
71, 171, 253, 274, 296, &
43, 158, 256, 292, 0, &
72, 173, 248, 273, 0, &
73, 175, 238, 270, 0, &
74, 173, 250, 279, 0, &
75, 190, 247, 286, 0, &
76, 191, 236, 276, 0, &
64, 174, 216, 270, 296, &
77, 170, 226, 278, 0, &
78, 137, 241, 292, 0, &
16, 192, 239, 274, 0, &
79, 190, 258, 283, 0, &
80, 193, 235, 288, 0, &
81, 182, 260, 287, 0, &
82, 177, 249, 271, 0, &
77, 131, 245, 295, 0, &
83, 194, 261, 278, 0, &
84, 121, 244, 286, 0, &
85, 195, 262, 284, 0, &
49, 181, 256, 261, 0, &
85, 181, 244, 282, 0, &
86, 196, 247, 292, 0, &
17, 197, 229, 279, 0, &
38, 161, 261, 286, 0, &
87, 130, 253, 263, 0, &
47, 198, 260, 273, 298, &
84, 199, 248, 287, 0, &
63, 143, 228, 264, 299, &
15, 178, 247, 289, 0, &
45, 197, 246, 290, 297, &
88, 122, 244, 278, 0, &
50, 189, 263, 294, 300, &
89, 200, 264, 296, 0, &
90, 178, 257, 284, 0, &
80, 201, 257, 297, 0, &
91, 146, 210, 293, 0, &
46, 159, 254, 291, 0, &
92, 202, 263, 289, 0, &
93, 193, 241, 298, 0, &
94, 183, 257, 294, 0, &
94, 203, 240, 272, 0, &
75, 199, 254, 295, 0, &
95, 204, 242, 267, 0, &
96, 205, 251, 296, 0, &
97, 165, 260, 293, 0, &
68, 206, 259, 287, 0, &
82, 207, 264, 292, 0, &
98, 129, 249, 279, 0, &
99, 202, 241, 299, 0, &
53, 185, 240, 286, 0, &
93, 123, 256, 285, 0, &
7, 198, 254, 294, 0, &
13, 199, 257, 275, 0, &
100, 156, 251, 286, 0, &
101, 169, 255, 274, 0, &
31, 200, 260, 269, 0, &
71, 207, 240, 297, 0, &
83, 208, 241, 295, 0, &
102, 196, 259, 269, 0, &
103, 180, 261, 276, 0, &
30, 134, 242, 283, 0, &
104, 167, 251, 288, 0, &
105, 182, 246, 280, 0, &
72, 152, 258, 267, 0, &
106, 160, 252, 291, 0, &
101, 209, 234, 289, 0, &
107, 151, 245, 270, 0, &
76, 210, 251, 267, 0, &
27, 190, 227, 277, 0, &
60, 149, 254, 269, 0, &
99, 177, 252, 294, 0, &
108, 179, 240, 280, 0, &
58, 187, 232, 281, 0, &
51, 186, 236, 282, 0, &
109, 210, 246, 273, 0, &
87, 176, 237, 272, 0, &
92, 198, 239, 284, 0, &
59, 211, 245, 288, 0, &
8, 158, 259, 281, 0, &
110, 194, 264, 267, 0, &
90, 209, 252, 273, 0, &
111, 212, 252, 283, 0, &
105, 128, 249, 275, 0, &
88, 197, 259, 291, 0, &
10, 200, 248, 271, 0, &
112, 172, 253, 290, 0, &
103, 132, 248, 282, 0, &
69, 165, 251, 294, 0, &
20, 206, 225, 263, 0, &
18, 163, 259, 288, 0, &
29, 203, 260, 285, 0, &
111, 180, 230, 274, 0, &
81, 213, 242, 295, 0, &
78, 195, 255, 287, 0, &
113, 162, 237, 294, 0, &
28, 187, 244, 285, 0, &
34, 194, 247, 290, 0, &
114, 166, 252, 296, 0, &
9, 164, 257, 265, 0, &
6, 202, 257, 283, 0, &
2, 203, 247, 282, 0, &
89, 168, 239, 290, 0, &
115, 206, 243, 279, 0, &
116, 204, 255, 297, 298, &
97, 214, 255, 291, 0, &
86, 172, 243, 281, 0, &
117, 186, 262, 289, 0, &
96, 160, 238, 268, 297, &
35, 170, 253, 283, 0, &
40, 214, 239, 275, 0, &
21, 192, 262, 276, 0, &
98, 205, 254, 277, 0, &
3, 192, 249, 293, 0, &
113, 191, 250, 271, 0, &
70, 133, 240, 279, 0, &
100, 201, 239, 281, 0, &
95, 175, 253, 286, 0, &
115, 183, 245, 299, 0, &
55, 154, 243, 288, 0, &
107, 196, 218, 274, 0, &
22, 201, 258, 272, 0, &
118, 204, 254, 282, 0, &
91, 138, 242, 284, 0, &
54, 215, 249, 282, 0, &
12, 188, 258, 280, 0, &
114, 140, 247, 280, 0, &
74, 184, 217, 267, 0, &
104, 216, 255, 263, 0, &
110, 191, 244, 295, 0, &
52, 188, 242, 285, 0, &
116, 136, 218, 289, 0, &
23, 150, 214, 278, 0, &
119, 185, 252, 277, 0, &
79, 207, 251, 266, 0, &
109, 127, 211, 269, 0, &
25, 167, 242, 289, 0, &
62, 193, 264, 287, 0, &
118, 135, 229, 265, 0, &
117, 213, 248, 297, 0, &
33, 169, 256, 268, 0, &
67, 147, 208, 268, 0, &
108, 164, 261, 296, 0, &
106, 153, 245, 280, 0, &
120, 209, 243, 271, 0, &
112, 162, 265, 285, 0, &
119, 211, 258, 275, 0, &
61, 144, 250, 290, 0, &
14, 208, 250, 277, 0, &
73, 195, 240, 273, 0, &
102, 205, 235, 271, 0, &
48, 184, 259, 285, 0, &
120, 189, 261, 269, 297/
data nrw/ &
5,5,4,5,4,4,5,4,4,4,4,4,4,5,4,4,4,4,4,4, &
5,5,5,4,5,4,4,4,4,4,4,5,4,4,5,4,5,5,4,4, &
5,4,5,4,4,4,4,4,4,4,4,5,4,4,4,4,5,4,4,4, &
4,4,5,5,4,4,4,4,4,4,4,5,4,4,5,5,4,4,4,4, &
4,4,4,4,4,4,4,4,5,4,4,4,4,4,4,5,4,4,4,4, &
4,4,4,4,4,4,4,4,4,4,4,4,4,5,4,5,4,5,4,5, &
4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, &
4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, &
4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, &
4,4,4,4,4,4,4,4,4,4,4,5,4,4,4,5,4,4,4,4, &
4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, &
4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,5/
data ncw/ &
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, &
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, &
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, &
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, &
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, &
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, &
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, &
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3, &
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, &
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, &
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, &
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,7,7, &
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, &
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, &
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7/
!ncw=3
toc=0
tov=0
tanhtoc=0
!write(*,*) llr
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw(i),i))
else
zn(i)=llr(i)
endif
enddo
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
!write(*,*) 'number of unsatisfied parity checks ',ncheck
if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it
! niterations=iter
codeword=cw(colorder+1)
decoded=codeword(M+1:N)
nerr=0
do i=1,N
if( (2*cw(i)-1)*llr(i) .lt. 0.0 ) nerr=nerr+1
enddo
niterations=nerr
return
endif
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 15 .and. ncheck .gt. 50) then
niterations=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
! do kk=1,ncw(ibj) ! subtract off what the bit had received from the check
do kk=1,7 ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:5,i)=tanh(-toc(1:5,i)/2)
enddo
do j=1,N
do i=1,ncw(j)
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo
niterations=-1
return
end subroutine bpdecode300

27
lib/fsk4hf/chkcrc10.f90
View File

@ -1,27 +0,0 @@
subroutine chkcrc10(decoded,nbadcrc)
use crc
integer*1 decoded(60)
integer*1, target:: i1Dec8BitBytes(9)
! Check the CRC
do ibyte=1,6
itmp=0
do ibit=1,8
itmp=ishft(itmp,1)+iand(1,decoded((ibyte-1)*8+ibit))
enddo
i1Dec8BitBytes(ibyte)=itmp
enddo
i1Dec8BitBytes(7)=decoded(49)*128+decoded(50)*64
! Pack received CRC into bytes 8 and 9 for crc10_check
i1Dec8BitBytes(8)=decoded(51)*2+decoded(52)
i1Dec8BitBytes(9)=decoded(53)*128 + decoded(54)*64+decoded(55)*32 + &
decoded(56)*16
i1Dec8BitBytes(9)=i1Dec8BitBytes(9) + decoded(57)*8+decoded(58)*4 + &
decoded(59)*2+decoded(60)*1
nbadcrc=1
if(crc10_check(c_loc(i1Dec8BitBytes),9)) nbadcrc=0
return
end subroutine chkcrc10

27
lib/fsk4hf/chkcrc12.f90
View File

@ -1,27 +0,0 @@
subroutine chkcrc12(decoded,nbadcrc)
use crc
integer*1 decoded(84)
integer*1, target:: i1Dec8BitBytes(11)
! Check the CRC
! Collapse 84 decoded bits to 11 bytes. Bytes 1-9 are the message,
! byte 10 and first half of byte 11 is the crc
do ibyte=1,9
itmp=0
do ibit=1,8
itmp=ishft(itmp,1)+iand(1,decoded((ibyte-1)*8+ibit))
enddo
i1Dec8BitBytes(ibyte)=itmp
enddo
! Pack the crc into bytes 10 and 11 for crc12_check
i1Dec8BitBytes(10)=decoded(73)*8 + decoded(74)*4 + decoded(75)*2 + decoded(76)
i1Dec8BitBytes(11)=decoded(77)*128 + decoded(78)*64 + &
decoded(79)*32 + decoded(80)*16 + decoded(81)*8 + decoded(82)*4 + &
decoded(83)*2 + decoded(84)
nbadcrc=1
if( crc12_check(c_loc (i1Dec8BitBytes), 11) ) nbadcrc=0
return
end subroutine chkcrc12

14
lib/fsk4hf/costasxcorr.m
View File

@ -1,14 +0,0 @@
# Gnu Octave script to calculate
# cross correlation between 2 Costas arrays
costas1=[2,5,6,0,4,1,3];
costas2=[3,1,4,0,6,5,2];
array1=zeros(7,7);
array2=zeros(7,7);
for i=1:7
array1(i,costas1(i)+1)=1;
array2(i,costas2(i)+1)=1;
endfor
xcorr2(array1,array1,"none")
xcorr2(array2,array2,"none")
xcorr2(array1,array2,"none")

76
lib/fsk4hf/cpolyfit.f90
View File

@ -1,76 +0,0 @@
subroutine cpolyfit(c,pp,id,maxn,aa,bb,zz,nhardsync)
parameter (KK=84) !Information bits (72 + CRC12)
parameter (ND=168) !Data symbols: LDPC (168,84), r=1/2
parameter (NS=65) !Sync symbols (2 x 26 + Barker 13)
parameter (NR=3) !Ramp up/down
parameter (NN=NR+NS+ND) !Total symbols (236)
parameter (NSPS=16) !Samples per MSK symbol (16)
parameter (N2=2*NSPS) !Samples per OQPSK symbol (32)
parameter (N13=13*N2) !Samples in central sync vector (416)
parameter (NZ=NSPS*NN) !Samples in baseband waveform (3760)
parameter (NFFT1=4*NSPS,NH1=NFFT1/2)
complex c(0:NZ-1) !Complex waveform
complex zz(NS+ND) !Complex symbol values (intermediate)
complex z,z0
real x(NS),yi(NS),yq(NS) !For complex polyfit
real pp(2*NSPS) !Shaped pulse for OQPSK
real aa(20),bb(20) !Fitted polyco's
integer id(NS+ND) !NRZ values (+/-1) for Sync and Data
ib=NSPS-1
ib2=N2-1
n=0
do j=1,117 !First-pass demodulation
ia=ib+1
ib=ia+N2-1
zz(j)=sum(pp*c(ia:ib))/NSPS
if(abs(id(j)).eq.2) then !Save all sync symbols
n=n+1
x(n)=float(ia+ib)/NZ - 1.0
yi(n)=real(zz(j))*0.5*id(j)
yq(n)=aimag(zz(j))*0.5*id(j)
! write(54,1225) n,x(n),yi(n),yq(n)
!1225 format(i5,3f12.4)
endif
if(j.le.116) then
zz(j+117)=sum(pp*c(ia+NSPS:ib+NSPS))/NSPS
endif
enddo
aa=0.
bb=0.
nterms=0
chisqa=0.
chisqb=0.
if(maxn.gt.0) then
npts=n
mode=0
nterms=maxn
call polyfit4(x,yi,yi,npts,nterms,mode,aa,chisqa)
call polyfit4(x,yq,yq,npts,nterms,mode,bb,chisqb)
endif
nhardsync=0
do j=1,117
if(abs(id(j)).ne.2) cycle
xx=j*2.0/117.0 - 1.0
yii=1.
yqq=0.
if(nterms.gt.0) then
yii=aa(1)
yqq=bb(1)
do i=2,nterms
yii=yii + aa(i)*xx**(i-1)
yqq=yqq + bb(i)*xx**(i-1)
enddo
endif
z0=cmplx(yii,yqq)
z=zz(j)*conjg(z0)
p=real(z)
if(p*id(j).lt.0) nhardsync=nhardsync+1
enddo
return
end subroutine cpolyfit

68
lib/fsk4hf/cpolyfitw.f90
View File

@ -1,68 +0,0 @@
subroutine cpolyfitw(c,pp,id,maxn,aa,bb,zz,nhardsync)
include 'wsprlf_params.f90'
complex c(0:NZ-1) !Complex waveform
complex zz(NS+ND) !Complex symbol values (intermediate)
complex z,z0
real x(NS),yi(NS),yq(NS) !For complex polyfit
real pp(2*NSPS) !Shaped pulse for OQPSK
real aa(20),bb(20) !Fitted polyco's
integer id(NS+ND) !NRZ values (+/-1) for Sync and Data
ib=NSPS-1
ib2=N2-1
n=0
jz=(NS+ND+1)/2
do j=1,jz !First-pass demodulation
ia=ib+1
ib=ia+N2-1
zz(j)=sum(pp*c(ia:ib))/NSPS
if(abs(id(j)).eq.2) then !Save all sync symbols
n=n+1
x(n)=float(ia+ib)/NZ - 1.0
yi(n)=real(zz(j))*0.5*id(j)
yq(n)=aimag(zz(j))*0.5*id(j)
! write(54,1225) n,x(n),yi(n),yq(n)
!1225 format(i5,3f12.4)
endif
if(j.lt.jz) then
zz(j+jz)=sum(pp*c(ia+NSPS:ib+NSPS))/NSPS
endif
enddo
aa=0.
bb=0.
nterms=0
chisqa=0.
chisqb=0.
if(maxn.gt.0) then
npts=n
mode=0
nterms=maxn
call polyfit4(x,yi,yi,npts,nterms,mode,aa,chisqa)
call polyfit4(x,yq,yq,npts,nterms,mode,bb,chisqb)
endif
nhardsync=0
do j=1,205
if(abs(id(j)).ne.2) cycle
xx=j*2.0/205.0 - 1.0
yii=1.
yqq=0.
if(nterms.gt.0) then
yii=aa(1)
yqq=bb(1)
do i=2,nterms
yii=yii + aa(i)*xx**(i-1)
yqq=yqq + bb(i)*xx**(i-1)
enddo
endif
z0=cmplx(yii,yqq)
z=zz(j)*conjg(z0)
p=real(z)
if(p*id(j).lt.0) nhardsync=nhardsync+1
enddo
return
end subroutine cpolyfitw

241
lib/fsk4hf/dbpsksim.f90
View File

@ -1,241 +0,0 @@
program dbpsksim
parameter (ND=121) !Data symbols: LDPC (120,60), r=1/2
parameter (NN=ND) !Total symbols (121)
parameter (NSPS=28800) !Samples per symbol at 12000 sps
parameter (NZ=NSPS*NN) !Samples in waveform (3484800)
parameter (NFFT1=65536,NH1=NFFT1/2)
parameter (NFFT2=128,NH2=NFFT2/2)
character*8 arg
complex c(0:NZ-1) !Complex waveform
complex c2(0:NFFT1-1) !Short spectra
complex cr(0:NZ-1)
complex ct(0:NZ-1)
complex cz(0:NFFT2-1)
complex z0,z,zp
real s(-NH1+1:NH1)
real s2(-NH2+1:NH2)
real xnoise(0:NZ-1) !Generated random noise
real ynoise(0:NZ-1) !Generated random noise
real rxdata(120),llr(120)
integer id(NN) !Encoded NRZ data (values +/-1)
integer id1(NN) !Recovered data (1st pass)
integer id2(NN) !Recovered data (2nd pass)
! integer icw(NN)
integer*1 msgbits(60),decoded(60),codeword(120),apmask(120),cw(120)
data msgbits/0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,&
0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,1,0,0,1,0,1,1,0,1,0/
nnn=0
nargs=iargc()
if(nargs.ne.6) then
print*,'Usage: dbpsksim f0(Hz) delay(ms) fspread(Hz) ndiff iters snr(dB)'
print*,'Example: dbpsksim 1500 0 0 10 -35'
print*,'Set snr=0 to cycle through a range'
go to 999
endif
call getarg(1,arg)
read(arg,*) f0 !Low tone frequency
call getarg(2,arg)
read(arg,*) delay
call getarg(3,arg)
read(arg,*) fspread
call getarg(4,arg)
read(arg,*) ndiff
call getarg(5,arg)
read(arg,*) iters
call getarg(6,arg)
read(arg,*) snrdb
twopi=8.d0*atan(1.d0)
fs=12000.d0
dt=1.0/fs
ts=NSPS*dt
baud=1.d0/ts
txt=NZ*dt
bandwidth_ratio=2500.0/6000.0
write(*,1000) baud,5*baud,txt,delay,fspread,ndiff
1000 format('Baud:',f6.3,' BW:',f4.1,' TxT:',f6.1,' Delay:',f5.2, &
' fSpread:',f5.2,' ndiff:',i2/)
write(*,1004)
1004 format(' SNR err ber fer fsigma'/35('-'))
call encode120(msgbits,codeword) !Encode the test message
isna=-28
isnb=-40
if(snrdb.ne.0.0) then
isna=nint(snrdb)
isnb=isna
endif
do isnr=isna,isnb,-1
snrdb=isnr
sig=sqrt(bandwidth_ratio) * 10.0**(0.05*snrdb)
if(snrdb.gt.90.0) sig=1.0
nhard=0
nhardc=0
nfe1=0
nfe2=0
sqf=0.
do iter=1,iters
nnn=nnn+1
id(1)=1 !First bit is always 1
id(2:NN)=2*codeword-1
call genbpsk(id,f0,ndiff,0,c) !Generate the 4-FSK waveform
if(delay.ne.0.0 .or. fspread.ne.0.0) call watterson(c,delay,fspread)
c=sig*c !Scale to requested SNR
if(snrdb.lt.90) then
do i=0,NZ-1 !Generate gaussian noise
xnoise(i)=gran()
ynoise(i)=gran()
enddo
c=c + cmplx(xnoise,ynoise) !Add noise to signal
endif
! First attempt at finding carrier frequency fc: 64k FFTs ==> avg power spectra
nspec=NZ/NFFT1
df1=12000.0/NFFT1
s=0.
do k=1,nspec
ia=(k-1)*NSPS
ib=ia+NSPS-1
c2(0:NSPS-1)=c(ia:ib)
c2(NSPS:)=0.
call four2a(c2,NFFT1,1,-1,1)
do i=0,NFFT1-1
j=i
if(j.gt.NH1) j=j-NFFT1
s(j)=s(j) + real(c2(i))**2 + aimag(c2(i))**2
enddo
enddo
s=1.e-6*s
smax=0.
ipk=0
ia=(1400.0)/df1
ib=(1600.0)/df1
do i=ia,ib
f=i*df1
if(s(i).gt.smax) then
smax=s(i)
ipk=i
fc=f
endif
enddo
a=(s(ipk+1)-s(ipk-1))/2.0
b=(s(ipk+1)+s(ipk-1)-2.0*s(ipk))/2.0
dx=-a/(2.0*b)
fc=fc + df1*dx !Estimated carrier frequency
sqf=sqf + (fc-f0)**2
! The following is for testing SNR calibration:
! sp5n=(s(ipk-2)+s(ipk-1)+s(ipk)+s(ipk+1)+s(ipk+2)) !Sig + 5*noise
! base=(sum(s)-sp5n)/(NFFT1-5.0) !Noise per bin
! psig=sp5n-5*base !Sig only
! pnoise=(2500.0/df1)*base !Noise in 2500 Hz
! xsnrdb=db(psig/pnoise)
call genbpsk(id,fc,ndiff,1,cr) !Generate reference carrier
c=c*conjg(cr) !Mix signal to baseband
z0=1.0
do j=1,NN !Demodulate
ia=(j-1)*NSPS
ib=ia+NSPS-1
z=sum(c(ia:ib))
cz(j-1)=z
zp=z*conjg(z0)
p=1.e-4*real(zp)
id1(j)=-1
if(p.ge.0.0) id1(j)=1
if(j.ge.2) rxdata(j-1)=p
z0=z
enddo
rxav=sum(rxdata)/120
rx2av=sum(rxdata*rxdata)/120
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
ss=0.84
llr=2.0*rxdata/(ss*ss)
apmask=0
max_iterations=10
call bpdecode120(llr,apmask,max_iterations,decoded,niterations,cw)
! Count frame errors
if(niterations.lt.0 .or. count(msgbits.ne.decoded).gt.0) nfe1=nfe1+1
! Find carrier frequency from squared cz array.
cz(121:)=0.
cz=cz*cz
call four2a(cz,NFFT2,1,-1,1)
s2max=0.
do i=0,NFFT2-1
j=i
if(i.gt.NH2) j=j-NFFT2
s2(j)=real(cz(i))**2 + aimag(cz(i))**2
if(s2(j).gt.s2max) then
s2max=s2(j)
jpk=j
endif
! write(16,1200) j*baud/NFFT2,1.e-12*s2(j)
!1200 format(2f12.3)
enddo
a=(s2(jpk+1)-s2(jpk-1))/2.0
b=(s2(jpk+1)+s2(jpk-1)-2.0*s2(jpk))/2.0
dx=-a/(2.0*b)
fc2=0.5*(jpk+dx)*baud/NFFT2
call genbpsk(id,fc2,ndiff,1,cr) !Generate new ref carrier at fc2
c=c*conjg(cr)
z0=1.0
do j=1,NN !Demodulate
ia=(j-1)*NSPS
ib=ia+NSPS-1
z=sum(c(ia:ib))
if(j.eq.1) z0=z
zp=z*conjg(z0)
p=1.e-4*real(zp)
id2(j)=-1
if(p.ge.0.0) id2(j)=1
if(j.ge.2) rxdata(j-1)=p
ierr=0
if(id2(j).ne.id(j)) ierr=1
id3=-1
if(real(z).ge.0.0) id3=1
if(j.ge.2 .and. id3.ne.id(j)) nhardc=nhardc+1
if(j.ge.2 .and. ndiff.eq.0) rxdata(j-1)=real(z)
z0=z
enddo
nhard=nhard + count(id2.ne.id) !Count hard errors
rxav=sum(rxdata)/120
rx2av=sum(rxdata*rxdata)/120
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
ss=0.84
llr=2.0*rxdata/(ss*ss) !Soft symbols
apmask=0
max_iterations=10
decoded=0
call bpdecode120(llr,apmask,max_iterations,decoded,niterations,cw)
! if(niterations.lt.0) then
! llr=-llr
! call bpdecode120(llr,apmask,max_iterations,decoded,niterations,cw)
! if(niterations.ge.0) nhard=NN*iters-nhard
! endif
if(niterations.ge.0) call chkcrc10(decoded,nbadcrc)
if(niterations.lt.0 .or. count(msgbits.ne.decoded).gt.0 .or. &
nbadcrc.ne.0) nfe2=nfe2+1
enddo
if(ndiff.eq.0) nhard=nhardc
fsigma=sqrt(sqf/iters)
ber=float(nhard)/(NN*iters)
fer=float(nfe2)/iters
write(*,1050) snrdb,nhard,ber,fer,fsigma
write(14,1050) snrdb,nhard,ber,fer,fsigma
1050 format(f6.1,i5,f8.4,f7.3,f8.2)
enddo
999 end program dbpsksim

128
lib/fsk4hf/decode174_101.f90
View File

@ -1,128 +0,0 @@
subroutine decode174_101(llr,Keff,ndeep,apmask,maxsuper,message101,cw,nharderror,iter,ncheck,dmin,isuper)
!
! A hybrid bp/osd decoder for the (174,101) code.
!
integer, parameter:: N=174, K=101, M=N-K
integer*1 cw(N),apmask(N)
integer*1 decoded(K)
integer*1 message101(101)
integer nrw(M),ncw
integer Nm(8,M)
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(8,M)
real tanhtoc(8,M)
real zn(N),zsum(N)
real llr(N)
real Tmn
include "ldpc_174_101_parity.f90"
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
nclast=0
maxiterations=1
zsum=0.0
do isuper=1,maxsuper
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
zsum=zsum+zn
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
! write(*,*) 'number of unsatisfied parity checks ',ncheck
if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it
decoded=cw(1:K)
call get_crc24(decoded,74,nbadcrc)
nharderror=count( (2*cw-1)*llr .lt. 0.0 )
if(nbadcrc.eq.0) then
message101=decoded(1:101)
dmin=0.0
return
endif
endif
! if( iter.gt.0 ) then ! this code block implements an early stopping criterion
if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:8,i)=tanh(-toc(1:8,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo ! bp iterations
llr=zsum
call osd174_101(llr,Keff,apmask,ndeep,message101,cw,nharderror,dmin)
if(nharderror.gt.0) then
return
endif
enddo ! super iterations
nharderror=-1
return
end subroutine decode174_101

128
lib/fsk4hf/decode174_74.f90
View File

@ -1,128 +0,0 @@
subroutine decode174_74(llr,Keff,ndeep,apmask,maxsuper,message74,cw,nharderror,iter,ncheck,dmin,isuper)
!
! A hybrid bp/osd decoder for the (174,74) code.
!
integer, parameter:: N=174, K=74, M=N-K
integer*1 cw(N),apmask(N)
integer*1 decoded(K)
integer*1 message74(74)
integer nrw(M),ncw
integer Nm(6,M)
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(6,M)
real tanhtoc(6,M)
real zn(N),zsum(N)
real llr(N)
real Tmn
include "ldpc_174_74_parity.f90"
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
nclast=0
maxiterations=1
zsum=0.0
do isuper=1,maxsuper
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
zsum=zsum+zn
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
! write(*,*) 'number of unsatisfied parity checks ',ncheck
if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it
decoded=cw(1:K)
call get_crc24(decoded,74,nbadcrc)
nharderror=count( (2*cw-1)*llr .lt. 0.0 )
if(nbadcrc.eq.0) then
message74=decoded(1:74)
dmin=0.0
return
endif
endif
! if( iter.gt.0 ) then ! this code block implements an early stopping criterion
if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:6,i)=tanh(-toc(1:6,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo ! bp iterations
llr=zsum
call osd174_74(llr,Keff,apmask,ndeep,message74,cw,nharderror,dmin)
if(nharderror.gt.0) then
return
endif
enddo ! super iterations
nharderror=-1
return
end subroutine decode174_74

133
lib/fsk4hf/decode240_101.f90
View File

@ -1,133 +0,0 @@
subroutine decode240_101(llr,Keff,ndeep,apmask,maxsuper,message101,cw,nharderror,iter,ncheck,dmin,isuper)
!
! A hybrid bp/osd decoder for the (240,101) code.
!
integer, parameter:: N=240, K=101, M=N-K
integer*1 cw(N),apmask(N)
integer*1 decoded(K)
integer*1 nxor(N),hdec(N)
integer*1 message101(101)
integer nrw(M),ncw
integer Nm(6,M)
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(6,M)
real tanhtoc(6,M)
real zn(N),zsum(N)
real llr(N)
real Tmn
include "ldpc_240_101_parity.f90"
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
nclast=0
maxiterations=1
zsum=0.0
do isuper=1,maxsuper
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
zsum=zsum+zn
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
! write(*,*) 'number of unsatisfied parity checks ',ncheck
if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it
decoded=cw(1:K)
call get_crc24(decoded,74,nbadcrc)
nharderror=count( (2*cw-1)*llr .lt. 0.0 )
if(nbadcrc.eq.0) then
message101=decoded(1:101)
dmin=0.0
return
endif
endif
! if( iter.gt.0 ) then ! this code block implements an early stopping criterion
if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:6,i)=tanh(-toc(1:6,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo ! bp iterations
call osd240_101(zsum,Keff,apmask,ndeep,message101,cw,nharderror,dminosd)
if(nharderror.gt.0) then
hdec=0
where(llr .ge. 0) hdec=1
nxor=ieor(hdec,cw)
dmin=sum(nxor*abs(llr))
return
endif
enddo ! super iterations
nharderror=-1
return
end subroutine decode240_101

133
lib/fsk4hf/decode280_101.f90
View File

@ -1,133 +0,0 @@
subroutine decode280_101(llr,Keff,ndeep,apmask,maxsuper,message101,cw,nharderror,iter,ncheck,dmin,isuper)
!
! A hybrid bp/osd decoder for the (280,101) code.
!
integer, parameter:: N=280, K=101, M=N-K
integer*1 cw(N),apmask(N)
integer*1 decoded(K)
integer*1 nxor(N),hdec(N)
integer*1 message101(101)
integer nrw(M),ncw
integer Nm(6,M)
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(6,M)
real tanhtoc(6,M)
real zn(N),zsum(N)
real llr(N)
real Tmn
include "ldpc_280_101_parity.f90"
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
nclast=0
maxiterations=1
zsum=0.0
do isuper=1,maxsuper
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
zsum=zsum+zn
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
! write(*,*) 'number of unsatisfied parity checks ',ncheck
if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it
decoded=cw(1:K)
call get_crc24(decoded,74,nbadcrc)
nharderror=count( (2*cw-1)*llr .lt. 0.0 )
if(nbadcrc.eq.0) then
message101=decoded(1:101)
dmin=0.0
return
endif
endif
! if( iter.gt.0 ) then ! this code block implements an early stopping criterion
if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:6,i)=tanh(-toc(1:6,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo ! bp iterations
call osd280_101(zsum,Keff,apmask,ndeep,message101,cw,nharderror,dminosd)
if(nharderror.gt.0) then
hdec=0
where(llr .ge. 0) hdec=1
nxor=ieor(hdec,cw)
dmin=sum(nxor*abs(llr))
return
endif
enddo ! super iterations
nharderror=-1
return
end subroutine decode280_101

62
lib/fsk4hf/dopspread.f90
View File

@ -1,62 +0,0 @@
subroutine dopspread(c,fspread)
parameter (NFFT=268800,NH=NFFT/2)
complex c(0:NFFT-1)
complex cspread(0:NFFT-1)
df=12000.0/nfft
twopi=8*atan(1.0)
cspread(0)=1.0
cspread(NH)=0.
b=6.0 !Lorenzian 3/28 onward
do i=1,NH
f=i*df
x=b*f/fspread
z=0.
a=0.
if(x.lt.3.0) then !Cutoff beyond x=3
a=sqrt(1.111/(1.0+x*x)-0.1) !Lorentzian
call random_number(r1)
phi1=twopi*r1
z=a*cmplx(cos(phi1),sin(phi1))
endif
cspread(i)=z
z=0.
if(x.lt.50.0) then
call random_number(r2)
phi2=twopi*r2
z=a*cmplx(cos(phi2),sin(phi2))
endif
cspread(NFFT-i)=z
enddo
izh=fspread/df
do i=-izh,izh
f=i*df
j=i
if(j.lt.0) j=j+nfft
s=real(cspread(j))**2 + aimag(cspread(j))**2
! write(23,3000) f,s,cspread(j)
!3000 format(f10.3,3f12.6)
enddo
call four2a(cspread,NFFT,1,1,1) !Transform to time domain
sum=0.
do i=0,NFFT-1
p=real(cspread(i))**2 + aimag(cspread(i))**2
sum=sum+p
enddo
avep=sum/NFFT
fac=sqrt(1.0/avep)
cspread=fac*cspread !Normalize to constant avg power
c=cspread*c !Apply Rayleigh fading to c()
do i=0,NFFT-1
p=real(cspread(i))**2 + aimag(cspread(i))**2
! write(24,3010) i,p,cspread(i)
!3010 format(i8,3f12.6)
enddo
return
end subroutine dopspread

116
lib/fsk4hf/encode120.f90
View File

@ -1,116 +0,0 @@
subroutine encode120(message,codeword)
! Encode an 60-bit message and return a 120-bit codeword.
! The generator matrix has dimensions (60,60).
! The code is a (120,60) regular ldpc code with column weight 3.
! The code was generated using the PEG algorithm.
! After creating the codeword, the columns are re-ordered according to
! "colorder" to make the codeword compatible with the parity-check matrix
!
character*15 g(60)
integer*1 codeword(120)
integer colorder(120)
integer*1 gen(60,60)
integer*1 itmp(120)
integer*1 message(60)
integer*1 pchecks(60)
logical first
data first/.true./
data g/ &
"65541ad98feab6e",&
"27249940a5895a3",&
"c80eac7506bf794",&
"aa50393e3e18d3f",&
"28527e87d47dced",&
"5da0dcaf8db048c",&
"d6509a43ca9b01a",&
"9a7dadd9c94f1d4",&
"bb673d3ba07cf29",&
"65e190f2fbed447",&
"bc2062a4e520969",&
"9e357f3feed059b",&
"aa6b59212036a57",&
"f78a326722d6565",&
"416754bc34c6405",&
"f77000b3f04ff67",&
"d48fbd7d48c5ab9",&
"031ffb5db3a70cb",&
"125964e358c4df5",&
"bd02c32a5a241ea",&
"4c15ecdd8561abd",&
"7f0f1b352c7413e",&
"26edb94dfd0ae79",&
"ca1ba1ee0f8fb24",&
"49878a58cb4544c",&
"3dbcd0ff821b203",&
"c1f4440160d5345",&
"b5ea9dc7a5a70ab",&
"cebcf7d94976be4",&
"0968265f5977c88",&
"c5a36937faa78c3",&
"f0d4fef11e01c10",&
"e35fc0c779bebfe",&
"cf49c3eb41a31d5",&
"3f0b19352c7013e",&
"0e15eccd8521abd",&
"dda8dcaf9d3048c",&
"fee31438fba59ed",&
"ad74a27e939189c",&
"736ac01b439106e",&
"ab5d2729b29bfa1",&
"edf11fb02e5a426",&
"5f38be1c93ecc83",&
"1e4b3b8dc516b3e",&
"84443d8bee614c6",&
"d854d9f355ceac4",&
"a476b5ece51f0ea",&
"831c2b36c4c2f68",&
"f485c97a91615ae",&
"e9376d828ade9ba",&
"cac586f089d3185",&
"b8f8c67613dafe2",&
"1a3142b401b315d",&
"87dbedc43265d2e",&
"bb64ec6e652e7da",&
"e71bfd4c95dfd38",&
"31209af07ad4f75",&
"cff1a8ccc5f4978",&
"742eded1e1dfefd",&
"1cd7154a904dac4"/
data colorder/ &
0,1,2,21,3,4,5,6,7,8,20,10,9,11,12,23,13,28,14,31, &
15,16,22,26,17,30,18,29,25,32,41,34,19,33,27,36,38,43,42,24, &
37,39,45,40,35,44,47,46,50,51,53,48,52,56,54,57,55,49,58,61, &
60,59,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79, &
80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99, &
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119/
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,60
do j=1,15
read(g(i)(j:j),"(Z1)") istr
do jj=1, 4
icol=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(i,icol)=1
enddo
enddo
enddo
first=.false.
endif
do i=1, 60
nsum=0
do j=1, 60
nsum=nsum+message(j)*gen(i,j)
enddo
pchecks(i)=mod(nsum,2)
enddo
itmp(1:60)=pchecks
itmp(61:120)=message(1:60)
codeword(colorder+1)=itmp(1:120)
return
end subroutine encode120

141
lib/fsk4hf/encode168.f90
View File

@ -1,141 +0,0 @@
subroutine encode168(message,codeword)
! Encode an 84-bit message and return a 168-bit codeword.
! The generator matrix has dimensions (84,84).
! The code is a (168,84) regular ldpc code with column weight 3.
! The code was generated using the PEG algorithm.
! After creating the codeword, the columns are re-ordered according to
! "colorder" to make the codeword compatible with the parity-check matrix
!
character*21 g(84)
integer*1 codeword(168)
integer colorder(168)
integer*1 gen(84,168)
integer*1 itmp(168)
integer*1 message(84)
integer*1 pchecks(84)
logical first
data first/.true./
data g/ & !parity generator matrix for (168,84) code
"25c5bf31ef6710fde9a5a", &
"18038ef7899cd97a77d96", &
"270dde504dad076c02b1f", &
"ed37fe12616565bd7d500", &
"12b99aa49b5367aff3838", &
"41cc27f2fac8b228aac21", &
"2265b233a3cff0b9cee24", &
"292760cd4f7f4a526a2f1", &
"2b3db4c8bd831911680cc", &
"cef2b24ce203bdc60b266", &
"5045a24f9340915d807ab", &
"3592b7fc60ba85139502e", &
"9318023145637bd798f0e", &
"ad796023c3d58d1e6509c", &
"3da5eab57f040e75d7413", &
"27466d1d2734d0ff64830", &
"2ed50bb1ce313bbfb1ab0", &
"9a616bda01b25b7e6eeaf", &
"a84c8c1e9df103169d10d", &
"a40da29b4aca9234a8942", &
"dd258d02d79a5f209d3d0", &
"bdfdc06713511997b5621", &
"25c58f12f4096cd8ead1a", &
"b2638a478f21e10fe97de", &
"4051020f43c605d458156", &
"f651aad14322a526dae35", &
"a1c147e31bcc9d87330bf", &
"7524b53d996d48284647b", &
"a72e7d25ce31b27282e56", &
"a97f53b019022350b7519", &
"56106c6340c0810790984", &
"c63b8e03a57208635992b", &
"43a3de2aa3a2b1afb65dc", &
"9baa64847ead03b77fecc", &
"251cbd1895c8839c46b0d", &
"2858107dde2d173e13530", &
"20096f6a870f636b704e7", &
"7f833ccbceec52dd6eb79", &
"a9108dd77b8015b75242a", &
"689666a79e5579c916236", &
"aa5dff46459787f69911f", &
"794558c13138d08171089", &
"c937042857b291cee8dfd", &
"6f0bf3248bb9a231366b8", &
"1c09e756ef1656c96f2d2", &
"073b875b6774e71fba549", &
"f7d840aafc037febd2d5c", &
"dcc0e7d0da5fe17c99ad3", &
"98238ef7819cd97a77d94", &
"177c2594743477421a262", &
"7d01a833c19374fbaaa6e", &
"7bb800216660482ffd1c4", &
"39a92e2dba0d4cfda98d2", &
"44b8d88622698816456a8", &
"791db2334d6d86639229b", &
"ba6004b086bd38559ea48", &
"f94558e13138d18170089", &
"08ba145302cfbed7845ae", &
"fb8e64b6da3602168ed38", &
"1045a2cf1340915d8072b", &
"7592b6fc64ba85139582e", &
"3eb238a11bc6654452bae", &
"b69d8d23b1ea170f70214", &
"0123dfae84fb20462a614", &
"4131066ad52a339b3c0d7", &
"fd2cc26850951c43ed737", &
"a644d4eb7e56c40f0d050", &
"0c3bd9d5dab7c9ee2c8fc", &
"4a198b37af56d7ceffb56", &
"b6e946c429294cf0eed8b", &
"98384d75e758774f5ff3b", &
"5c58e5d9a4d0531d37384", &
"7a0af02719afed521fd06", &
"8cd5b2e694e7854abbc70", &
"1a2f061912d0ea19702d3", &
"6ffbce557d8fa691a50e8", &
"d43438e2e2ed5d9f14011", &
"8d502106083b809adba00", &
"67e22f9b9983aa715964d", &
"b31f3a3f3c1f406b1fd58", &
"529f60ac291f827d97331", &
"476a815424f2e2cbe641f", &
"81c82c89bcc3feec42458", &
"2c882d0e281b178e80364"/
data colorder/0,1,2,3,28,4,5,6,7,8,9,10,11,34,12,32,13,14,15,16,17, &
18,36,29,42,31,20,21,41,40,30,38,22,19,47,37,46,35,44,33,49,24, &
43,51,25,26,27,50,52,57,69,54,55,45,59,58,56,61,60,53,48,23,62, &
63,64,67,66,65,68,39,70,71,72,74,73,75,76,77,80,81,78,82,79,83, &
84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104, &
105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125, &
126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146, &
147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167/
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,84
do j=1,21
read(g(i)(j:j),"(Z1)") istr
do jj=1, 4
icol=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(i,icol)=1
enddo
enddo
enddo
first=.false.
endif
do i=1, 84
nsum=0
do j=1, 84
nsum=nsum+message(j)*gen(i,j)
enddo
pchecks(i)=mod(nsum,2)
enddo
itmp(1:84)=pchecks
itmp(85:168)=message(1:84)
codeword(colorder+1)=itmp(1:168)
return
end subroutine encode168

46
lib/fsk4hf/encode174_101.f90
View File

@ -1,46 +0,0 @@
subroutine encode174_101(message,codeword)
use, intrinsic :: iso_c_binding
use iso_c_binding, only: c_loc,c_size_t
use crc
integer, parameter:: N=174, K=101, M=N-K
character*24 c24
integer*1 codeword(N)
integer*1 gen(M,K)
integer*1 message(K)
integer*1 pchecks(M)
integer*4 ncrc24
include "ldpc_174_101_generator.f90"
logical first
data first/.true./
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,M
do j=1,26
read(g(i)(j:j),"(Z1)") istr
ibmax=4
if(j.eq.26) ibmax=1
do jj=1, ibmax
icol=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(i,icol)=1
enddo
enddo
enddo
first=.false.
endif
do i=1,M
nsum=0
do j=1,K
nsum=nsum+message(j)*gen(i,j)
enddo
pchecks(i)=mod(nsum,2)
enddo
codeword(1:K)=message
codeword(K+1:N)=pchecks
return
end subroutine encode174_101

47
lib/fsk4hf/encode174_74.f90
View File

@ -1,47 +0,0 @@
subroutine encode174_74(message,codeword)
use, intrinsic :: iso_c_binding
use iso_c_binding, only: c_loc,c_size_t
use crc
integer, parameter:: N=174, K=74, M=N-K
character*24 c24
integer*1 codeword(N)
integer*1 gen(M,K)
integer*1 message(K)
integer*1 pchecks(M)
integer*1, target :: i1MsgBytes(10)
integer*4 ncrc24
include "ldpc_174_74_generator.f90"
logical first
data first/.true./
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,M
do j=1,19
read(g(i)(j:j),"(Z1)") istr
ibmax=4
if(j.eq.19) ibmax=2
do jj=1, ibmax
icol=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(i,icol)=1
enddo
enddo
enddo
first=.false.
endif
do i=1,M
nsum=0
do j=1,K
nsum=nsum+message(j)*gen(i,j)
enddo
pchecks(i)=mod(nsum,2)
enddo
codeword(1:K)=message
codeword(K+1:N)=pchecks
return
end subroutine encode174_74

48
lib/fsk4hf/encode204.f90
View File

@ -1,48 +0,0 @@
subroutine encode204(message,codeword)
! Encode an 68-bit message and return a 204-bit codeword.
! The generator matrix has dimensions (136,68).
! The code is a (204,68) regular ldpc code with column weight 3.
! The code was generated using the PEG algorithm.
! After creating the codeword, the columns are re-ordered according to
! "colorder" to make the codeword compatible with the parity-check matrix
!
include "ldpc_204_68_params.f90"
integer*1 codeword(N)
integer*1 gen(M,K)
integer*1 itmp(N)
integer*1 message(K)
integer*1 pchecks(M)
logical first
data first/.true./
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,M
do j=1,17
read(g(i)(j:j),"(Z1)") istr
do jj=1, 4
icol=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(i,icol)=1
enddo
enddo
enddo
first=.false.
endif
do i=1,M
nsum=0
do j=1,K
nsum=nsum+message(j)*gen(i,j)
enddo
pchecks(i)=mod(nsum,2)
enddo
itmp(1:M)=pchecks
itmp(M+1:N)=message(1:K)
codeword(colorder+1)=itmp(1:N)
return
end subroutine encode204

46
lib/fsk4hf/encode240_101.f90
View File

@ -1,46 +0,0 @@
subroutine encode240_101(message,codeword)
use, intrinsic :: iso_c_binding
use iso_c_binding, only: c_loc,c_size_t
use crc
integer, parameter:: N=240, K=101, M=N-K
character*24 c24
integer*1 codeword(N)
integer*1 gen(M,K)
integer*1 message(K)
integer*1 pchecks(M)
integer*4 ncrc24
include "ldpc_240_101_generator.f90"
logical first
data first/.true./
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,M
do j=1,26
read(g(i)(j:j),"(Z1)") istr
ibmax=4
if(j.eq.26) ibmax=1
do jj=1, ibmax
icol=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(i,icol)=1
enddo
enddo
enddo
first=.false.
endif
do i=1,M
nsum=0
do j=1,K
nsum=nsum+message(j)*gen(i,j)
enddo
pchecks(i)=mod(nsum,2)
enddo
codeword(1:K)=message
codeword(K+1:N)=pchecks
return
end subroutine encode240_101

46
lib/fsk4hf/encode280_101.f90
View File

@ -1,46 +0,0 @@
subroutine encode280_101(message,codeword)
use, intrinsic :: iso_c_binding
use iso_c_binding, only: c_loc,c_size_t
use crc
integer, parameter:: N=280, K=101, M=N-K
character*24 c24
integer*1 codeword(N)
integer*1 gen(M,K)
integer*1 message(K)
integer*1 pchecks(M)
integer*4 ncrc24
include "ldpc_280_101_generator.f90"
logical first
data first/.true./
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,M
do j=1,26
read(g(i)(j:j),"(Z1)") istr
ibmax=4
if(j.eq.26) ibmax=1
do jj=1, ibmax
icol=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(i,icol)=1
enddo
enddo
enddo
first=.false.
endif
do i=1,M
nsum=0
do j=1,K
nsum=nsum+message(j)*gen(i,j)
enddo
pchecks(i)=mod(nsum,2)
enddo
codeword(1:K)=message
codeword(K+1:N)=pchecks
return
end subroutine encode280_101

308
lib/fsk4hf/encode300.f90
View File

@ -1,308 +0,0 @@
subroutine encode300(message,codeword)
! Encode an 60-bit message and return a 300-bit codeword.
! The generator matrix has dimensions (240,60).
! The code is a (300,60) irregular ldpc code with column weights:
! 52% column weight 2
! 27% column weight 3
! 21% column weight 7
! The code was generated using the PEG algorithm.
! After creating the codeword, the columns are re-ordered according to
! "colorder" to make the codeword compatible with the parity-check matrix
!
character*15 g(240)
integer*1 codeword(300)
integer colorder(300)
integer*1 gen(240,60)
integer*1 itmp(300)
integer*1 message(60)
integer*1 pchecks(240)
logical first
data first/.true./
data g/ &
"316fd3bb18bcefd", &
"a9c1c984f91244e", &
"9e04bd3d5d78d89", &
"f81617089621bd4", &
"12997ce2f44dbf4", &
"3ebddaf9b0fa1fc", &
"d0c114b0b0ef162", &
"f8c4f115f98bd92", &
"d0a79c0c5b8ca19", &
"477f6712f357b3b", &
"fa28b2444a7e66b", &
"bedcd4df8d95c64", &
"da30de73e57022c", &
"bc099bbb90fe09e", &
"cffc1e47e5708e8", &
"713d808563ca9a3", &
"70fcf1741d5d5d7", &
"32e80bc15112008", &
"804cef4df9b18ec", &
"3736881819d1033", &
"f4e37db7f9c5efe", &
"9e84b93d4d78d09", &
"2250c3518ec830a", &
"55a529a92e18021", &
"1cb80b14c9f6eae", &
"80c504b031ef926", &
"ece6636d0ac9c6d", &
"5d50a1690782cd0", &
"3d54a1fb30937a2", &
"ba8fe8006318041", &
"02917ce2fc45bf4", &
"abc1d984f95a44e", &
"fc05b4c4ab2d850", &
"467f7718f357b3b", &
"472cc094546c6b2", &
"fcdd94cf8c9cc64", &
"4dbc1647e970cc8", &
"6caa465c442aed1", &
"aead5af8b0da1be", &
"d8e1fa45a2e8431", &
"9d4dc4cc63abb7f", &
"9b2df6b48264637", &
"7335808563ca3a3", &
"36bf8d5cd93e6cc", &
"004ccf4db9b08ec", &
"90a71c8c598ca19", &
"f8c5d115f90bc92", &
"b95546c4e3f7934", &
"7d50a1690786cd0", &
"c90939921a0d7c6", &
"d0c504b030ef126", &
"ce3e6f9396fc542", &
"a0072a59f3707f5", &
"532d0a8fe3da1ea", &
"68b9e5cd7d142db", &
"fedc94df8c9dc64", &
"6da2465c448aed0", &
"3574aa19cb273c0", &
"1e54768c6bc6843", &
"691f65654498186", &
"fe2c92444a6ef6b", &
"9caad933e038cc4", &
"ad4e6f4defb28ec", &
"4f3d80947c6d2b2", &
"1caad933e0b8cc4", &
"b14fd3bf18bcafd", &
"ad091bbbb0f809e", &
"90b71c8c598da19", &
"f8c4d115f90bd92", &
"9d4dcccc63afb7f", &
"fa2c92444a6e76b", &
"1e14768c6bc6c43", &
"d1baf5aacb86087", &
"bdf762b92ee51c7", &
"caacec06ad8a90c", &
"804ccf4df9b08ec", &
"69e969f9da5cbd8", &
"814ccf4df9b086c", &
"cebe4f9796f4542", &
"491f65654499186", &
"8fbf5b9796f6d2a", &
"ce3e4f9396f4542", &
"47558560e7debc3", &
"94aadd33e038cc4", &
"a94eef4debb286e", &
"d8e5d115f91bcd2", &
"532d488fe3da0ab", &
"664e7bc4e23a80c", &
"94a2dd33a038cd4", &
"d8c5d115f91bc92", &
"0fef071eee60bd5", &
"9a89a09163c2b97", &
"0eaf071e6c60bd5", &
"bc0d1bbbb0fe0be", &
"f9babd3d12d0f31", &
"69a969f9da5c9d8", &
"6e4e7bc4e23a82c", &
"b0042659f3227f5", &
"2d51418f0f28347", &
"be0d5bbbb0da0be", &
"225003508ec8302", &
"8fbf4b9796f4d2a", &
"bead5af9b0da1be", &
"6ca2465c440aed1", &
"4fbc1e47ed708c8", &
"bd091bbbb0fc09e", &
"b0062259f3307f5", &
"a8072a59f3727f5", &
"a0062259f3707f5", &
"3c380b14c974eae", &
"30042659f3226f5", &
"48b9e4cd7d142db", &
"728bcd4b38308fb", &
"c0c504b031ef126", &
"314fd3bb18bcafd", &
"1c29148305faec1", &
"44c92a9c28ada63", &
"88e99b370aae32b", &
"695081690386ad8", &
"572d0a8de3da1ea", &
"467f6610f357b2b", &
"733d008563da1a3", &
"d1baf4aacb84087", &
"4315551d71c8ff0", &
"48bde4cd7d140db", &
"3ebd58f9b0da9fc", &
"51baf4aacb84083", &
"814e4f4de9b082c", &
"814ecf4de9b086c", &
"be0d1bbbb0fa0be", &
"4f7580947c792b3", &
"cdf2dce48c39c3b", &
"d8c5c115f91bc12", &
"a94e6f4debb28ee", &
"be2d5afbb0da1be", &
"cdd6dce48439c2b", &
"bebd5af9b0da1fe", &
"fa2892444a6e66b", &
"51bbf4aacb8c083", &
"baa73d81eebcd83", &
"79a2ce47f138cc9", &
"cc28cf198e6dbd4", &
"fcde94dfcc9cc64", &
"1016fcf59286717", &
"12917ce2fc4dbf4", &
"4fbc1647e9708c8", &
"3e382b1cc974fae", &
"d5bafdaad386087", &
"0fef473eee60bd5", &
"c0e504b031ee126", &
"8bbf5b9797f6d2a", &
"0eef071e6e60bd5", &
"1806fcf59386517", &
"fcdc94df8c9cc64", &
"141eca2bfa25656", &
"5fbc1767e9708e8", &
"5aa4c7803a6bdf1", &
"b14bd3b718bcafd", &
"3ebd5af9b0da1fc", &
"d0a7148c5b8ca09", &
"a94ecf4debb086e", &
"733d808563ca1a3", &
"fd9abd1d92d0f31", &
"bc091bbbb0fe09e", &
"d0c514b0b0ef122", &
"4f7d80947c7d2b3", &
"8b3f5b97b7f6d2a", &
"4fbc1767e9708c8", &
"cebf4f9796f4502", &
"9c76c880a864e67", &
"abc1c984f95244e", &
"795081690786ad8", &
"467f6710f357b3b", &
"1c380b14c9f4eae", &
"d5baf5aac386087", &
"bedc94df8c95c64", &
"553d0a8de2da1fa", &
"0315551d71d8ff0", &
"1c1eca2ffa25656", &
"d4bafdaad3c6087", &
"be2d5bfbb0da0be", &
"b0062659f3207f5", &
"5ffc1765e9708e8", &
"8d62e8bcd303e33", &
"cc08cf198e69bd4", &
"573d0a8de3da1fa", &
"cd56dce48639c2b", &
"472dc094546c2b2", &
"7950a16907868d8", &
"7283cf4b38308fb", &
"894ecf4de9b086e", &
"0f7580b47c792b3", &
"cfbf4b9796f4d0a", &
"3e380b14c974fae", &
"732d0085e3da1a3", &
"1816fcf59386717", &
"532d088fe3da1ab", &
"1c300b94c9fcaae", &
"d0a71c8c5b8ca19", &
"9e84bd3d5d78d09", &
"225083508ec830a", &
"f99abd1d12d0f31", &
"35f4aa19cb673c0", &
"cdd2dce48c39c2b", &
"0f7780b47c792bf", &
"0e33a5f114f5730", &
"bc05b4c4ab0d850", &
"1c300b14c9f4aae", &
"cfbc1e47ed708e8", &
"0f7180b47c392b3", &
"d8c7c115f91be12", &
"c09148adfa94e97", &
"9c66c880a844e67", &
"2226c13b73519f8", &
"cebf4b9796f4d02", &
"c0e706b031ee126", &
"6a6629715e53ce3", &
"73f9aa824e7d0b8", &
"473d80947c6c2b2", &
"1df140e0ddb5632", &
"473dc0945c6c2b2", &
"81b4d95f671971d", &
"663945ca758e2b6", &
"02ec3d98a2306fd", &
"5dadb0fa1275690", &
"4bb8aaa854948d0", &
"8359ba40886971c", &
"49cc3d2a2be2ee0", &
"bfdf13af137f318", &
"a1de773a2b1ff04", &
"8ff3945a2f465c7", &
"532d0087e3da1a3", &
"f3eaf7fa454d385", &
"a606aa5aeba07d9", &
"67f0627b0af8a53", &
"56698bed69d1c2c", &
"d5f420011fbf924", &
"2a8f86c810e2c62", &
"43cc1cf1208c206", &
"ee784c4900258de"/
data colorder/ &
0,1,2,3,4,5,6,7,8,9,10,11,123,12,13,14,15,16,17,18, &
19,20,21,22,23,24,25,138,26,145,27,28,29,30,31,32,33,34,35,36, &
37,154,38,39,40,41,42,43,44,144,46,47,48,49,50,51,52,53,143,54, &
125,56,57,58,124,59,120,140,157,160,55,60,61,62,156,162,141,64,65,153, &
181,183,66,170,67,68,69,130,70,164,71,72,73,74,75,63,76,77,135,78, &
79,80,176,169,82,83,84,167,180,85,136,158,129,166,175,142,134,146,121,165, &
88,89,192,90,45,91,92,93,182,189,94,95,96,173,81,97,98,178,122,126, &
132,99,100,152,186,193,101,102,151,103,104,172,159,168,150,190,147,148,201,107, &
205,177,108,198,197,174,127,109,185,110,202,87,199,171,179,187,139,137,106,131, &
206,194,112,149,155,113,128,184,196,86,114,203,212,195,208,105,188,161,163,191, &
200,209,214,204,115,218,133,111,207,117,213,216,211,217,116,215,219,220,210,221, &
118,222,223,225,224,228,226,229,231,227,233,119,234,235,232,230,237,239,236,238, &
240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259, &
260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279, &
280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299/
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,240
do j=1,15
read(g(i)(j:j),"(Z1)") istr
do jj=1, 4
icol=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(i,icol)=1
enddo
enddo
enddo
first=.false.
endif
do i=1, 240
nsum=0
do j=1, 60
nsum=nsum+message(j)*gen(i,j)
enddo
pchecks(i)=mod(nsum,2)
enddo
itmp(1:240)=pchecks
itmp(241:300)=message(1:60)
codeword(colorder+1)=itmp(1:300)
return
end subroutine encode300

56
lib/fsk4hf/encode4K25A.f90
View File

@ -1,56 +0,0 @@
subroutine encode4K25A(message,codeword)
! A (280,70) rate 1/4 tailbiting convolutional code using
! the "4K25A" polynomials from EbNaut website.
! Code is transparent, has constraint length 25, and has dmin=58
character*10 g1,g2,g3,g4
integer*1 codeword(280)
!integer*1 p1(25),p2(25),p3(25),p4(25)
integer*1 p1(16),p2(16),p3(16),p4(16)
integer*1 gg(100)
integer*1 gen(280,70)
integer*1 itmp(280)
integer*1 message(70)
logical first
data first/.true./
data g1/"106042635"/
data g2/"125445117"/
data g3/"152646773"/
data g4/"167561761"/
!data p1/1,0,0,0,1,1,0,0,0,0,1,0,0,0,1,0,1,1,0,0,1,1,1,0,1/
!data p2/1,0,1,0,1,0,1,1,0,0,1,0,0,1,0,1,0,0,1,0,0,1,1,1,1/
!data p3/1,1,0,1,0,1,0,1,1,0,1,0,0,1,1,0,1,1,1,1,1,1,0,1,1/
!data p4/1,1,1,0,1,1,1,1,0,1,1,1,0,0,0,1,1,1,1,1,1,0,0,0,1/
data p1/1,0,1,0,1,1,0,0,1,1,0,1,1,1,1,1/
data p2/1,0,1,1,0,1,0,0,1,1,1,1,1,0,0,1/
data p3/1,1,0,0,1,0,1,1,0,1,1,1,0,0,1,1/
data p4/1,1,1,0,1,1,0,1,1,1,1,0,0,1,0,1/
save first,gen
if( first ) then ! fill the generator matrix
gg=0
! gg(1:25)=p1
! gg(26:50)=p2
! gg(51:75)=p3
! gg(76:100)=p4
gg(1:16)=p1
gg(17:32)=p2
gg(33:48)=p3
gg(49:64)=p4
gen=0
! gen(1:100,1)=gg(1:100)
gen(1:64,1)=gg(1:64)
do i=2,70
gen(:,i)=cshift(gen(:,i-1),-4,1)
enddo
first=.false.
endif
codeword=0
do i=1,70
if(message(i).eq.1) codeword=codeword+gen(:,i)
enddo
codeword=mod(codeword,2)
return
end subroutine encode4K25A

48
lib/fsk4hf/extractmessage168.f90
View File

@ -1,48 +0,0 @@
subroutine extractmessage168(decoded,msgreceived,ncrcflag,recent_calls,nrecent)
use iso_c_binding, only: c_loc,c_size_t
use crc
use packjt
character*22 msgreceived
character*12 call1,call2
character*12 recent_calls(nrecent)
integer*1 decoded(84)
integer*1, target:: i1Dec8BitBytes(11)
integer*4 i4Dec6BitWords(12)
! Collapse 84 decoded bits to 11 bytes. Bytes 1-9 are the message, byte 10 and first half of byte 11 is the crc
do ibyte=1,9
itmp=0
do ibit=1,8
itmp=ishft(itmp,1)+iand(1,decoded((ibyte-1)*8+ibit))
enddo
i1Dec8BitBytes(ibyte)=itmp
enddo
! Need to pack the crc into bytes 10 and 11 for crc12_check
i1Dec8BitBytes(10)=decoded(73)*8+decoded(74)*4+decoded(75)*2+decoded(76)
i1Dec8BitBytes(11)=decoded(77)*128+decoded(78)*64+decoded(79)*2*32+decoded(80)*16
i1Dec8BitBytes(11)=i1Dec8BitBytes(11)+decoded(81)*8+decoded(82)*4+decoded(83)*2+decoded(84)
if( crc12_check(c_loc (i1Dec8BitBytes), 11) ) then
! CRC12 checks out --- unpack 72-bit message
do ibyte=1,12
itmp=0
do ibit=1,6
itmp=ishft(itmp,1)+iand(1,decoded((ibyte-1)*6+ibit))
enddo
i4Dec6BitWords(ibyte)=itmp
enddo
call unpackmsg144(i4Dec6BitWords,msgreceived,call1,call2)
ncrcflag=1
if( call1(1:2) .ne. 'CQ' .and. call1(1:2) .ne. ' ' ) then
call update_recent_calls(call1,recent_calls,nrecent)
endif
if( call2(1:2) .ne. ' ' ) then
call update_recent_calls(call2,recent_calls,nrecent)
endif
else
msgreceived=' '
ncrcflag=-1
endif
return
end subroutine extractmessage168

64
lib/fsk4hf/fftw3.f90
View File

@ -1,64 +0,0 @@
INTEGER FFTW_R2HC
PARAMETER (FFTW_R2HC=0)
INTEGER FFTW_HC2R
PARAMETER (FFTW_HC2R=1)
INTEGER FFTW_DHT
PARAMETER (FFTW_DHT=2)
INTEGER FFTW_REDFT00
PARAMETER (FFTW_REDFT00=3)
INTEGER FFTW_REDFT01
PARAMETER (FFTW_REDFT01=4)
INTEGER FFTW_REDFT10
PARAMETER (FFTW_REDFT10=5)
INTEGER FFTW_REDFT11
PARAMETER (FFTW_REDFT11=6)
INTEGER FFTW_RODFT00
PARAMETER (FFTW_RODFT00=7)
INTEGER FFTW_RODFT01
PARAMETER (FFTW_RODFT01=8)
INTEGER FFTW_RODFT10
PARAMETER (FFTW_RODFT10=9)
INTEGER FFTW_RODFT11
PARAMETER (FFTW_RODFT11=10)
INTEGER FFTW_FORWARD
PARAMETER (FFTW_FORWARD=-1)
INTEGER FFTW_BACKWARD
PARAMETER (FFTW_BACKWARD=+1)
INTEGER FFTW_MEASURE
PARAMETER (FFTW_MEASURE=0)
INTEGER FFTW_DESTROY_INPUT
PARAMETER (FFTW_DESTROY_INPUT=1)
INTEGER FFTW_UNALIGNED
PARAMETER (FFTW_UNALIGNED=2)
INTEGER FFTW_CONSERVE_MEMORY
PARAMETER (FFTW_CONSERVE_MEMORY=4)
INTEGER FFTW_EXHAUSTIVE
PARAMETER (FFTW_EXHAUSTIVE=8)
INTEGER FFTW_PRESERVE_INPUT
PARAMETER (FFTW_PRESERVE_INPUT=16)
INTEGER FFTW_PATIENT
PARAMETER (FFTW_PATIENT=32)
INTEGER FFTW_ESTIMATE
PARAMETER (FFTW_ESTIMATE=64)
INTEGER FFTW_ESTIMATE_PATIENT
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
INTEGER FFTW_BELIEVE_PCOST
PARAMETER (FFTW_BELIEVE_PCOST=256)
INTEGER FFTW_DFT_R2HC_ICKY
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
INTEGER FFTW_NONTHREADED_ICKY
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
INTEGER FFTW_NO_BUFFERING
PARAMETER (FFTW_NO_BUFFERING=2048)
INTEGER FFTW_NO_INDIRECT_OP
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
INTEGER FFTW_ALLOW_LARGE_GENERIC
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
INTEGER FFTW_NO_RANK_SPLITS
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
INTEGER FFTW_NO_VRANK_SPLITS
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
INTEGER FFTW_NO_VRECURSE
PARAMETER (FFTW_NO_VRECURSE=65536)
INTEGER FFTW_NO_SIMD
PARAMETER (FFTW_NO_SIMD=131072)

115
lib/fsk4hf/four2a.f90
View File

@ -1,115 +0,0 @@
subroutine four2a(a,nfft,ndim,isign,iform)
! IFORM = 1, 0 or -1, as data is
! complex, real, or the first half of a complex array. Transform
! values are returned in array DATA. They are complex, real, or
! the first half of a complex array, as IFORM = 1, -1 or 0.
! The transform of a real array (IFORM = 0) dimensioned N(1) by N(2)
! by ... will be returned in the same array, now considered to
! be complex of dimensions N(1)/2+1 by N(2) by .... Note that if
! IFORM = 0 or -1, N(1) must be even, and enough room must be
! reserved. The missing values may be obtained by complex conjugation.
! The reverse transformation of a half complex array dimensioned
! N(1)/2+1 by N(2) by ..., is accomplished by setting IFORM
! to -1. In the N array, N(1) must be the true N(1), not N(1)/2+1.
! The transform will be real and returned to the input array.
! This version of four2a makes calls to the FFTW library to do the
! actual computations.
parameter (NPMAX=2100) !Max numberf of stored plans
parameter (NSMALL=16384) !Max size of "small" FFTs
complex a(nfft) !Array to be transformed
complex aa(NSMALL) !Local copy of "small" a()
integer nn(NPMAX),ns(NPMAX),nf(NPMAX) !Params of stored plans
integer*8 nl(NPMAX),nloc !More params of plans
integer*8 plan(NPMAX) !Pointers to stored plans
logical found_plan
data nplan/0/ !Number of stored plans
common/patience/npatience,nthreads !Patience and threads for FFTW plans
include 'fftw3.f90' !FFTW definitions
save plan,nplan,nn,ns,nf,nl
if(nfft.lt.0) go to 999
nloc=loc(a)
found_plan = .false.
!$omp critical(four2a_setup)
do i=1,nplan
if(nfft.eq.nn(i) .and. isign.eq.ns(i) .and. &
iform.eq.nf(i) .and. nloc.eq.nl(i)) then
found_plan = .true.
exit
end if
enddo
if(i.ge.NPMAX) stop 'Too many FFTW plans requested.'
if (.not. found_plan) then
nplan=nplan+1
i=nplan
nn(i)=nfft
ns(i)=isign
nf(i)=iform
nl(i)=nloc
! Planning: FFTW_ESTIMATE, FFTW_ESTIMATE_PATIENT, FFTW_MEASURE,
! FFTW_PATIENT, FFTW_EXHAUSTIVE
nflags=FFTW_ESTIMATE
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
aa(1:jz)=a(1:jz)
endif
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
if(isign.eq.-1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_FORWARD,nflags)
else if(isign.eq.1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_BACKWARD,nflags)
else if(isign.eq.-1 .and. iform.eq.0) then
call sfftw_plan_dft_r2c_1d(plan(i),nfft,a,a,nflags)
else if(isign.eq.1 .and. iform.eq.-1) then
call sfftw_plan_dft_c2r_1d(plan(i),nfft,a,a,nflags)
else
stop 'Unsupported request in four2a'
endif
!$omp end critical(fftw)
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
a(1:jz)=aa(1:jz)
endif
end if
!$omp end critical(four2a_setup)
call sfftw_execute(plan(i))
return
999 continue
!$omp critical(four2a)
do i=1,nplan
! The test is only to silence a compiler warning:
if(ndim.ne.-999) then
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
call sfftw_destroy_plan(plan(i))
!$omp end critical(fftw)
end if
enddo
nplan=0
!$omp end critical(four2a)
return
end subroutine four2a

145
lib/fsk4hf/fsk4hf.f90
View File

@ -1,145 +0,0 @@
program fsk4hf
! Simulate characteristics of a potential mode using LDPC (168,84) code,
! 4-FSK modulation, and 30 s T/R sequences.
parameter (KK=84) !Information bits (72 + CRC12)
parameter (ND=84) !Data symbols: LDPC (168,84), r=1/2
parameter (NS=12) !Sync symbols (3 @ 4x4 Costas arrays)
parameter (NR=2) !Ramp up/down
parameter (NN=NR+NS+ND) !Total symbols (98)
parameter (NSPS=2688/84) !Samples per symbol (32)
parameter (NZ=NSPS*NN) !Samples in baseband waveform (3760)
character*8 arg
complex c0(0:NZ-1) !Complex waveform
complex c(0:NZ-1) !Complex waveform
real xnoise(0:NZ-1) !Generated random noise
real ynoise(0:NZ-1) !Generated random noise
real rxdata(2*ND),llr(2*ND) !Soft symbols
real s(0:NSPS,NN)
real savg(0:NSPS)
real ps(0:3)
integer id(ND) !Symbol values (0-3), data only
integer id1(ND) !Recovered data values
integer*1 msgbits(KK),decoded(KK),apmask(ND),cw(ND)
data msgbits/0,0,1,0,0,1,1,1,1,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,1,1,0,0,0,1, &
1,1,1,0,1,1,1,1,1,1,1,0,0,1,0,0,1,1,0,1,0,1,1,1,0,1,1,0,1,1, &
1,1,0,1,0,1,1,0,0,0,0,0,1,0,0,0,0,0,1,0,1,0,1,0/
nargs=iargc()
if(nargs.ne.5) then
print*,'Usage: fsk4hf f0(Hz) delay(ms) fspread(Hz) iters snr(dB)'
print*,'Example: fsk4hf 20 0 0 10 -20'
print*,'Set snr=0 to cycle through a range'
go to 999
endif
call getarg(1,arg)
read(arg,*) f0 !Generated carrier frequency
call getarg(2,arg)
read(arg,*) delay !Delta_t (ms) for Watterson model
call getarg(3,arg)
read(arg,*) fspread !Fspread (Hz) for Watterson model
call getarg(4,arg)
read(arg,*) iters !Iterations at each SNR
call getarg(5,arg)
read(arg,*) snrdb !Specified SNR_2500
twopi=8.0*atan(1.0)
fs=12000.0/84.0 !Sample rate = 142.857... Hz
dt=1.0/fs !Sample interval (s)
tt=NSPS*dt !Duration of "itone" symbols (s)
baud=1.0/tt !Keying rate for "itone" symbols (baud)
txt=NZ*dt !Transmission length (s)
bandwidth_ratio=2500.0/(fs/2.0)
write(*,1000) f0,delay,fspread,iters,baud,4*baud,txt
1000 format('f0:',f5.1,' Delay:',f4.1,' fSpread:',f5.2, &
' Iters:',i6/'Baud:',f7.3,' BW:',f5.1,' TxT:',f5.1,f5.2/)
write(*,1004)
1004 format(/' SNR sym bit ser ber fer fsigma'/50('-'))
call genfsk4hf(msgbits,f0,id,c0) !Generate baseband waveform
isna=-10
isnb=-30
if(snrdb.ne.0.0) then
isna=nint(snrdb)
isnb=isna
endif
do isnr=isna,isnb,-1 !Loop over SNR range
snrdb=isnr
sig=sqrt(bandwidth_ratio) * 10.0**(0.05*snrdb)
if(snrdb.gt.90.0) sig=1.0
nhard=0
nbit=0
nfe=0
sqf=0.
do iter=1,iters !Loop over requested iterations
c=c0
if(delay.ne.0.0 .or. fspread.ne.0.0) then
call watterson(c,NZ,fs,delay,fspread)
endif
c=sig*c !Scale to requested SNR
if(snrdb.lt.90) then
do i=0,NZ-1 !Generate gaussian noise
xnoise(i)=gran()
ynoise(i)=gran()
enddo
c=c + cmplx(xnoise,ynoise) !Add AWGN noise
endif
df=fs/(2*NSPS)
i0=nint(f0/df)
call spec4(c,s,savg)
do i=0,NSPS
write(12,3001) i*df,savg(i),db(savg(i))
3001 format(3f15.3)
enddo
do j=1,ND
nlo=0
nhi=0
k=j+5
if(j.ge.43) k=j+9
ps=s(i0:i0+6:2,k)
ps=sqrt(ps) !###
rlo=max(ps(1),ps(3))-max(ps(0),ps(2))
rhi=max(ps(2),ps(3))-max(ps(0),ps(1))
if(rlo.ge.0.0) nlo=1
if(rhi.ge.0.0) nhi=1
rxdata(2*j-1)=rhi
rxdata(2*j)=rlo
id1(j)=2*nhi+nlo
enddo
! write(*,1001) id(1:70)
! write(*,1001) id1(1:70)
!1001 format(70i1)
nhard=nhard+count(id.ne.id1)
nbit=nbit + count(iand(id,1).ne.iand(id1,1)) + &
count(iand(id,2).ne.iand(id1,2))
rxav=sum(rxdata)/ND
rx2av=sum(rxdata*rxdata)/ND
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
ss=0.84
llr=2.0*rxdata/(ss*ss)
apmask=0
max_iterations=40
ifer=0
call bpdecode168(llr,apmask,max_iterations,decoded,niterations,cw)
nbadcrc=0
if(niterations.ge.0) call chkcrc12(decoded,nbadcrc)
if(niterations.lt.0 .or. count(msgbits.ne.decoded).gt.0 .or. &
nbadcrc.ne.0) ifer=1
nfe=nfe+ifer
enddo
fsigma=sqrt(sqf/iters)
ser=float(nhard)/(ND*iters)
ber=float(nbit)/(2*ND*iters)
fer=float(nfe)/iters
write(*,1050) snrdb,nhard,nbit,ser,ber,fer,fsigma
! write(60,1050) snrdb,nhard,ber,fer,fsigma
1050 format(f6.1,2i6,2f8.4,f7.3,f8.2)
enddo
999 end program fsk4hf

185
lib/fsk4hf/fsk4sim.f90
View File

@ -1,185 +0,0 @@
program fsk4sim
parameter (ND=60) !Data symbols: LDPC (120,60), r=1/2
parameter (NN=ND) !Total symbols (60)
parameter (NSPS=57600) !Samples per symbol at 12000 sps
parameter (NZ=NSPS*NN) !Samples in waveform (3456000)
character*8 arg
complex c(0:NZ-1) !Complex waveform
complex cr(0:NZ-1)
complex cs(NSPS,NN)
complex cps(0:3)
complex ct(0:2*NN-1)
complex z,w,zsum
real r(0:NZ-1)
real s(NSPS,NN)
real savg(NSPS)
real tmp(NN) !For generating random data
real xnoise(0:NZ-1) !Generated random noise
real ps(0:3)
integer id(NN) !Encoded 2-bit data (values 0-3)
integer id2(NN) !Recovered data
equivalence (r,cr)
nnn=0
nargs=iargc()
if(nargs.ne.6) then
print*,'Usage: fsk8sim f0 delay(ms) fspread(Hz) nts iters snr(dB)'
go to 999
endif
call getarg(1,arg)
read(arg,*) f0 !Low tone frequency
call getarg(2,arg)
read(arg,*) delay
call getarg(3,arg)
read(arg,*) fspread
call getarg(4,arg)
read(arg,*) nts
call getarg(5,arg)
read(arg,*) iters
call getarg(6,arg)
read(arg,*) snrdb
twopi=8.d0*atan(1.d0)
fs=12000.d0
dt=1.0/fs
ts=NSPS*dt
baud=1.d0/ts
txt=NZ*dt
bandwidth_ratio=2500.0/6000.0
write(*,1000) baud,5*baud,txt,delay,fspread,nts
1000 format('Baud:',f6.3,' BW:',f5.1,' TxT:',f5.1,' Delay:',f5.2, &
' fSpread:',f5.2,' nts:',i3/)
write(*,1004)
1004 format(' SNR Sym Bit SER BER Sym Bit SER BER'/59('-'))
isna=-25
isnb=-40
if(snrdb.ne.0.0) then
isna=nint(snrdb)
isnb=isna
endif
do isnr=isna,isnb,-1
snrdb=isnr
sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb)
if(snrdb.gt.90.0) sig=1.0
nhard1=0
nhard2=0
nbit1=0
nbit2=0
nh2=0
nb2=0
do iter=1,iters
nnn=nnn+1
id=0
call random_number(tmp)
where(tmp.ge.0.25 .and. tmp.lt.0.50) id=1
where(tmp.ge.0.50 .and. tmp.lt.0.75) id=2
where(tmp.ge.0.75) id=3
call genfsk4(id,f0,nts,c) !Generate the 4-FSK waveform
call watterson(c,delay,fspread)
if(sig.ne.1.0) c=sig*c !Scale to requested SNR
if(snrdb.lt.90) then
do i=0,NZ-1 !Generate gaussian noise
xnoise(i)=gran()
enddo
endif
r(0:NZ-1)=real(c(0:NZ-1)) + xnoise !Add noise to signal
call snr2_wsprlf(r,freq,snr2500,width,1)
write(*,3001) freq,snr2500,width
3001 format(40x,3f10.3)
df=12000.0/(2*NSPS)
! i0=nint(f0/df)
! i0=nint((1500.0+freq)/df)
i0=nint((f0+freq)/df)
call spec4(r,cs,s,savg)
do j=1,NN
nlo=0
nhi=0
ps=s(i0:i0+6*nts:2*nts,j)
cps=cs(i0:i0+6*nts:2*nts,j)
if(max(ps(1),ps(3)).ge.max(ps(0),ps(2))) nlo=1
if(max(ps(2),ps(3)).ge.max(ps(0),ps(1))) nhi=1
id2(j)=2*nhi+nlo
z=cps(id2(j))
ct(j-1)=z
enddo
nh1=count(id.ne.id2)
nb1=count(iand(id,1).ne.iand(id2,1)) + count(iand(id,2).ne.iand(id2,2))
ct(NN:)=0.
call four2a(ct,2*NN,1,-1,1)
df2=baud/(2*NN)
ct=cshift(ct,NN)
ppmax=0.
dfpk=0.
do i=0,2*NN-1
f=(i-NN)*df2
pp=real(ct(i))**2 + aimag(ct(i))**2
if(pp.gt.ppmax) then
ppmax=pp
dfpk=f
endif
enddo
zsum=0.
do j=1,NN
phi=(j-1)*twopi*dfpk*ts
w=cmplx(cos(phi),sin(phi))
cps=cs(i0:i0+6*nts:2*nts,j)*conjg(w)
z=cps(id2(j))
ct(j)=z
zsum=zsum+z
write(12,1042) j,id(j),id2(j),20*ps,atan2(aimag(z),real(z)), &
atan2(aimag(zsum),real(zsum)),zsum
1042 format(3i2,6f8.3,2f8.1)
enddo
phi0=atan2(aimag(zsum),real(zsum))
zsum=0.
do j=1,NN
phi=(j-1)*twopi*dfpk*ts + phi0
w=cmplx(cos(phi),sin(phi))
nlo=0
nhi=0
cps=cs(i0:i0+6*nts:2*nts,j)*conjg(w)
ps=real(cps)
if(max(ps(1),ps(3)).ge.max(ps(0),ps(2))) nlo=1
if(max(ps(2),ps(3)).ge.max(ps(0),ps(1))) nhi=1
id2(j)=2*nhi+nlo
z=cps(id2(j))
ct(j)=z
zsum=zsum+z
enddo
nh2=count(id.ne.id2)
nb2=count(iand(id,1).ne.iand(id2,1)) + count(iand(id,2).ne.iand(id2,2))
nhard1=nhard1+nh1
nhard2=nhard2+nh2
nbit1=nbit1+nb1
nbit2=nbit2+nb2
fdiff=1500.0+freq - f0
write(13,1040) snrdb,snr2500,f0,fdiff,width,nh1,nb1,nh2,nb2
1040 format(2f7.1,f9.2,f7.2,f6.1,2(i8,i6))
40 continue
enddo
ser1=float(nhard1)/(NN*iters)
ser2=float(nhard2)/(NN*iters)
ber1=float(nbit1)/(2*NN*iters)
ber2=float(nbit2)/(2*NN*iters)
write(*,1050) snrdb,nhard1,nbit1,ser1,ber1,nhard2,nbit2,ser2,ber2
write(14,1050) snrdb,nhard1,nbit1,ser1,ber1,nhard2,nbit2,ser2,ber2
1050 format(f6.1,2(2i5,2f8.4))
enddo
write(*,1060) NN*iters,2*NN*iters
1060 format(59('-')/'Max: ',2i5)
999 end program fsk4sim

427
lib/fsk4hf/ft280d.f90
View File

@ -1,427 +0,0 @@
program ft280d
! Decode ft280 data read from *.c2 or *.wav files.
use packjt77
include 'ft4s280_params.f90'
parameter (NSPS2=NSPS/NDOWN)
character arg*8,cbits*50,infile*80,fname*16,datetime*11
character ch1*1,ch4*4,cseq*31
character*22 decodes(100)
character*37 msg
character*120 data_dir
character*77 c77
complex c2(0:NMAX/NDOWN-1) !Complex waveform
complex cframe(0:164*NSPS2-1) !Complex waveform
complex cd(0:164*20-1) !Complex waveform
real*8 fMHz
real llr(280),llra(280),llrb(280),llrc(280),llrd(280)
real candidates(100,2)
real bitmetrics(328,4)
integer ihdr(11)
integer*2 iwave(NMAX) !Generated full-length waveform
integer*1 apmask(280),cw(280)
integer*1 hbits(328)
integer*1 message101(101)
logical badsync,unpk77_success
fs=12000.0/NDOWN !Sample rate
dt=1.0/fs !Sample interval (s)
tt=NSPS*dt !Duration of "itone" symbols (s)
txt=NZ*dt !Transmission length (s)
hmod=1.0
Keff=91
nargs=iargc()
if(nargs.lt.1) then
print*,'Usage: ft280d [-a <data_dir>] [-f fMHz] [-h hmod] [-k Keff] file1 [file2 ...]'
go to 999
endif
iarg=1
data_dir="."
call getarg(iarg,arg)
if(arg(1:2).eq.'-a') then
call getarg(iarg+1,data_dir)
iarg=iarg+2
call getarg(iarg,arg)
endif
if(arg(1:2).eq.'-f') then
call getarg(iarg+1,arg)
read(arg,*) fMHz
iarg=iarg+2
call getarg(iarg,arg)
endif
if(arg(1:2).eq.'-h') then
call getarg(iarg+1,arg)
read(arg,*) hmod
iarg=iarg+2
call getarg(iarg,arg)
endif
if(arg(1:2).eq.'-k') then
call getarg(iarg+1,arg)
read(arg,*) Keff
iarg=iarg+2
call getarg(iarg,arg)
endif
if(arg(1:2).eq.'-d') then
call getarg(iarg+1,arg)
read(arg,*) ndeep
iarg=iarg+2
endif
ngood=0
ngoodsync=0
do ifile=iarg,nargs
call getarg(ifile,infile)
open(10,file=infile,status='old',access='stream')
j1=index(infile,'.c2')
j2=index(infile,'.wav')
if(j1.gt.0) then
read(10,end=999) fname,ntrmin,fMHz,c2
read(fname(8:11),*) nutc
write(datetime,'(i11)') nutc
else if(j2.gt.0) then
read(10,end=999) ihdr,iwave
read(infile(j2-4:j2-1),*) nutc
datetime=infile(j2-11:j2-1)
call ft280_downsample(iwave,c2)
else
print*,'Wrong file format?'
go to 999
endif
close(10)
fa=-100.0
fb=100.0
fs=12000.0/32.0
npts=120*12000.0/32.0
call getcandidate_ft280(c2,npts,hmod,fs,fa,fb,ncand,candidates) !First approx for freq
del=1.5*hmod*fs/300.0
ndecodes=0
do icand=1,ncand
! do icand=1,1
fc0=candidates(icand,1)
xsnr=candidates(icand,2)
!write(*,*) 'candidates ',icand,fc0,xsnr
do isync=0,1
if(isync.eq.0) then
fc1=fc0-del
is0=375
ishw=350
isst=30
ifhw=10
df=.1
else if(isync.eq.1) then
fc1=fc2
is0=isbest
ishw=100
isst=10
ifhw=10
df=.02
endif
smax=0.0
do if=-ifhw,ifhw
fc=fc1+df*if
do istart=max(1,is0-ishw),is0+ishw,isst
call coherent_sync_ft280(c2,istart,hmod,fc,1,sync)
if(sync.gt.smax) then
fc2=fc
isbest=istart
smax=sync
endif
enddo
enddo
! write(*,*) ifile,icand,isync,fc1+del,fc2+del,isbest,smax
enddo
if(abs((isbest-429)/429.0) .lt. 0.07 .and. abs(fc2+del).lt.0.2) ngoodsync=ngoodsync+1
!cycle
! if(smax .lt. 100.0 ) cycle
!isbest=429
!fc2=-del
do ijitter=0,2
if(ijitter.eq.0) ioffset=0
if(ijitter.eq.1) ioffset=45
if(ijitter.eq.2) ioffset=-45
is0=isbest+ioffset
if(is0.lt.0) cycle
cframe=c2(is0:is0+164*300-1)
call downsample_ft280(cframe,fc2+del,hmod,cd)
s2=sum(cd*conjg(cd))/(20*144)
cd=cd/sqrt(s2)
call get_ft280_bitmetrics(cd,hmod,bitmetrics,badsync)
hbits=0
where(bitmetrics(:,1).ge.0) hbits=1
ns1=count(hbits( 1: 8).eq.(/0,0,0,1,1,0,1,1/))
ns2=count(hbits( 9: 16).eq.(/0,1,0,0,1,1,1,0/))
ns3=count(hbits(157:164).eq.(/0,0,0,1,1,0,1,1/))
ns4=count(hbits(165:172).eq.(/0,1,0,0,1,1,1,0/))
ns5=count(hbits(313:320).eq.(/0,0,0,1,1,0,1,1/))
ns6=count(hbits(321:328).eq.(/0,1,0,0,1,1,1,0/))
nsync_qual=ns1+ns2+ns3+ns4+ns5+ns6
! if(nsync_qual.lt. 20) cycle
scalefac=2.83
llra( 1:140)=bitmetrics( 17:156, 1)
llra(141:280)=bitmetrics(173:312, 1)
llra=scalefac*llra
llrb( 1:140)=bitmetrics( 17:156, 2)
llrb(141:280)=bitmetrics(173:312, 2)
llrb=scalefac*llrb
llrc( 1:140)=bitmetrics( 17:156, 3)
llrc(141:280)=bitmetrics(173:312, 3)
llrc=scalefac*llrc
llrd( 1:140)=bitmetrics( 17:156, 4)
llrd(141:280)=bitmetrics(173:312, 4)
llrd=scalefac*llrd
apmask=0
max_iterations=40
do itry=4,1,-1
if(itry.eq.1) llr=llra
if(itry.eq.2) llr=llrb
if(itry.eq.3) llr=llrc
if(itry.eq.4) llr=llrd
nhardbp=0
nhardosd=0
dmin=0.0
call bpdecode280_101(llr,apmask,max_iterations,message101,cw,nhardbp,niterations,nchecks)
! if(nhardbp.lt.0) call osd280_101(llr,Keff,apmask,5,message101,cw,nhardosd,dmin)
maxsuperits=2
if(nhardbp.lt.0) then
! call osd280_101(llr,Keff,apmask,ndeep,message101,cw,nhardosd,dmin)
call decode280_101(llr,Keff,ndeep,apmask,maxsuperits,message101,cw,nhardosd,iter,ncheck,dmin,isuper)
endif
if(nhardbp.ge.0 .or. nhardosd.ge.0) then
write(c77,'(77i1)') message101(1:77)
call unpack77(c77,0,msg,unpk77_success)
if(unpk77_success .and. index(msg,'K9AN').gt.0) then
ngood=ngood+1
write(*,1100) ifile-2,icand,xsnr,isbest/375.0-1.0,1500.0+fc2+del,msg(1:20),itry,nhardbp,nhardosd,dmin,ijitter
1100 format(i5,2x,i5,2x,f6.1,2x,f6.2,2x,f8.2,2x,a20,i4,i4,i4,f7.2,i6)
goto 2002
else
cycle
endif
endif
enddo ! metrics
enddo ! istart jitter
enddo !candidate list
2002 continue
enddo !files
nfiles=nargs-iarg+1
write(*,*) 'nfiles: ',nfiles,' ngood: ',ngood,' ngoodsync: ',ngoodsync
write(*,1120)
1120 format("<DecodeFinished>")
999 end program ft280d
subroutine coherent_sync_ft280(cd0,i0,hmod,f0,itwk,sync)
! Compute sync power for a complex, downsampled FT4s signal.
include 'ft4s280_params.f90'
parameter(NP=NMAX/NDOWN,NSS=NSPS/NDOWN)
complex cd0(0:NP-1)
complex csynca(8*NSS)
complex csync2(8*NSS)
complex ctwk(8*NSS)
complex z1,z2,z3,z4,z5,z6
logical first
integer icos4(0:7)
data icos4/0,1,3,2,1,0,2,3/
data first/.true./
save first,twopi,csynca,fac
p(z1)=(real(z1*fac)**2 + aimag(z1*fac)**2)**0.5 !Statement function for power
if( first ) then
twopi=8.0*atan(1.0)
k=1
phia=0.0
do i=0,7
dphia=twopi*hmod*icos4(i)/real(NSS)
do j=1,NSS
csynca(k)=cmplx(cos(phia),sin(phia))
phia=mod(phia+dphia,twopi)
k=k+1
enddo
enddo
first=.false.
fac=1.0/(8.0*NSS)
endif
i1=i0 !four Costas arrays
i2=i0+78*NSS
i3=i0+156*NSS
z1=0.
z2=0.
z3=0.
if(itwk.eq.1) then
dt=1/(12000.0/32.0)
dphi=twopi*f0*dt
phi=0.0
do i=1,8*NSS
ctwk(i)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
enddo
endif
if(itwk.eq.1) csync2=ctwk*csynca !Tweak the frequency
if(i1.ge.0 .and. i1+8*NSS-1.le.NP-1) then
z1=sum(cd0(i1:i1+8*NSS-1)*conjg(csync2))
! z1=abs(sum(cd0(i1:i1+4*NSS-1)*conjg(csync2(1:4*NSS))))**2
! z1=z1+abs(sum(cd0(i1+4*NSS:i1+8*NSS-1)*conjg(csync2(4*NSS+1:8*NSS))))**2
elseif( i1.lt.0 ) then
npts=(i1+8*NSS-1)/2
if(npts.le.40) then
z1=0.
else
z1=sum(cd0(0:i1+8*NSS-1)*conjg(csync2(8*NSS-npts:)))
endif
endif
if(i2.ge.0 .and. i2+8*NSS-1.le.NP-1) then
z2=sum(cd0(i2:i2+8*NSS-1)*conjg(csync2))
! z2=abs(sum(cd0(i2:i2+4*NSS-1)*conjg(csync2(1:4*NSS))))**2
! z2=z2+abs(sum(cd0(i2+4*NSS:i2+8*NSS-1)*conjg(csync2(4*NSS+1:8*NSS))))**2
endif
if(i3.ge.0 .and. i3+8*NSS-1.le.NP-1) then
z3=sum(cd0(i3:i3+8*NSS-1)*conjg(csync2))
! z3=abs(sum(cd0(i3:i3+4*NSS-1)*conjg(csync2(1:4*NSS))))**2
! z3=z3+abs(sum(cd0(i3+4*NSS:i3+8*NSS-1)*conjg(csync2(4*NSS+1:8*NSS))))**2
elseif( i3+8*NSS-1.gt.NP-1 ) then
npts=(NP-1-i3+1)
if(npts.le.40) then
z3=0.
else
z3=sum(cd0(i3:i3+npts-1)*conjg(csync2(1:npts)))
endif
endif
sync = p(z1) + p(z2) + p(z3)
!sync=z1+z2+z3
return
end subroutine coherent_sync_ft280
subroutine downsample_ft280(ci,f0,hmod,co)
parameter(NI=164*300,NH=NI/2,NO=NI/15) ! downsample from 315 samples per symbol to 20
complex ci(0:NI-1),ct(0:NI-1)
complex co(0:NO-1)
fs=12000.0/28.0
df=fs/NI
ct=ci
call four2a(ct,NI,1,-1,1) !c2c FFT to freq domain
i0=nint(f0/df)
ct=cshift(ct,i0)
co=0.0
co(0)=ct(0)
! b=16.0*hmod
b=16.0*hmod
icutoff=nint(24.0/df)
do i=1,NO/2
! arg=(i*df/b)**2
! filt=exp(-arg)
filt=0
if(i.le.icutoff) filt=1
co(i)=ct(i)*filt
co(NO-i)=ct(NI-i)*filt
enddo
co=co/NO
call four2a(co,NO,1,1,1) !c2c FFT back to time domain
return
end subroutine downsample_ft280
subroutine getcandidate_ft280(c,npts,hmod,fs,fa,fb,ncand,candidates)
parameter(NFFT1=120*12000/28,NH1=NFFT1/2,NFFT2=120*12000/300,NH2=NFFT2/2)
complex c(0:npts-1) !Complex waveform
complex cc(0:NFFT1-1)
complex csfil(0:NFFT2-1)
complex cwork(0:NFFT2-1)
real bigspec(0:NFFT2-1)
complex c2(0:NFFT1-1) !Short spectra
real s(-NH1+1:NH1) !Coarse spectrum
real ss(-NH1+1:NH1) !Smoothed coarse spectrum
real candidates(100,2)
integer indx(NFFT2-1)
logical first
data first/.true./
save first,w,df,csfil
if(first) then
df=10*fs/NFFT1
csfil=cmplx(0.0,0.0)
do i=0,NFFT2-1
! csfil(i)=exp(-((i-NH2)/32.0)**2) ! revisit this
csfil(i)=exp(-((i-NH2)/(hmod*28.0))**2) ! revisit this
enddo
csfil=cshift(csfil,NH2)
call four2a(csfil,NFFT2,1,-1,1)
first=.false.
endif
cc=cmplx(0.0,0.0)
cc(0:npts-1)=c;
call four2a(cc,NFFT1,1,-1,1)
cc=abs(cc)**2
call four2a(cc,NFFT1,1,-1,1)
cwork(0:NH2)=cc(0:NH2)*conjg(csfil(0:NH2))
cwork(NH2+1:NFFT2-1)=cc(NFFT1-NH2+1:NFFT1-1)*conjg(csfil(NH2+1:NFFT2-1))
call four2a(cwork,NFFT2,1,+1,1)
bigspec=cshift(real(cwork),-NH2)
il=NH2+fa/df
ih=NH2+fb/df
nnl=ih-il+1
call indexx(bigspec(il:il+nnl-1),nnl,indx)
xn=bigspec(il-1+indx(nint(0.3*nnl)))
bigspec=bigspec/xn
ncand=0
do i=il,ih
if((bigspec(i).gt.bigspec(i-1)).and. &
(bigspec(i).gt.bigspec(i+1)).and. &
(bigspec(i).gt.1.15).and.ncand.lt.100) then
ncand=ncand+1
candidates(ncand,1)=df*(i-NH2)
candidates(ncand,2)=10*log10(bigspec(i)-1)-26.5
endif
enddo
return
end subroutine getcandidate_ft280
subroutine ft280_downsample(iwave,c)
! Input: i*2 data in iwave() at sample rate 12000 Hz
! Output: Complex data in c(), sampled at 375 Hz
include 'ft4s280_params.f90'
parameter (NFFT2=NMAX/28)
integer*2 iwave(NMAX)
complex c(0:NMAX/28-1)
complex c1(0:NFFT2-1)
complex cx(0:NMAX/2)
real x(NMAX)
equivalence (x,cx)
df=12000.0/NMAX
x=iwave
call four2a(x,NMAX,1,-1,0) !r2c FFT to freq domain
i0=nint(1500.0/df)
c1(0)=cx(i0)
do i=1,NFFT2/2
c1(i)=cx(i0+i)
c1(NFFT2-i)=cx(i0-i)
enddo
c1=c1/NFFT2
call four2a(c1,NFFT2,1,1,1) !c2c FFT back to time domain
c=c1(0:NMAX/28-1)
return
end subroutine ft280_downsample

113
lib/fsk4hf/ft280sim.f90
View File

@ -1,113 +0,0 @@
program ft280sim
! Generate simulated signals for experimental slow FT4 mode
use wavhdr
use packjt77
include 'ft4s280_params.f90' !Set various constants
type(hdr) h !Header for .wav file
character arg*12,fname*17
character msg37*37,msgsent37*37
character c77*77
complex c0(0:NMAX-1)
complex c(0:NMAX-1)
real wave(NMAX)
integer itone(NN)
integer*1 msgbits(101)
integer*2 iwave(NMAX) !Generated full-length waveform
! Get command-line argument(s)
nargs=iargc()
if(nargs.ne.8) then
print*,'Usage: ft280sim "message" f0 DT h fdop del nfiles snr'
print*,'Examples: ft280sim "K1JT K9AN EN50" 1500 0.0 1.0 0.1 1.0 10 -15'
go to 999
endif
call getarg(1,msg37) !Message to be transmitted
call getarg(2,arg)
read(arg,*) f0 !Frequency (only used for single-signal)
call getarg(3,arg)
read(arg,*) xdt !Time offset from nominal (s)
call getarg(4,arg)
read(arg,*) hmod !Modulation index, h
call getarg(5,arg)
read(arg,*) fspread !Watterson frequency spread (Hz)
call getarg(6,arg)
read(arg,*) delay !Watterson delay (ms)
call getarg(7,arg)
read(arg,*) nfiles !Number of files
call getarg(8,arg)
read(arg,*) snrdb !SNR_2500
nfiles=abs(nfiles)
twopi=8.0*atan(1.0)
fs=12000.0 !Sample rate (Hz)
dt=1.0/fs !Sample interval (s)
tt=NSPS*dt !Duration of symbols (s)
baud=1.0/tt !Keying rate (baud)
txt=NZ2*dt !Transmission length (s)
bandwidth_ratio=2500.0/(fs/2.0)
sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb)
if(snrdb.gt.90.0) sig=1.0
call genft280(msg37,0,msgsent37,msgbits,itone)
write(*,*)
write(*,'(a9,a37,3x,a7,i1,a1,i1)') 'Message: ',msgsent37,'i3.n3: ',i3,'.',n3
write(*,1000) f0,xdt,hmod,txt,snrdb
1000 format('f0:',f9.3,' DT:',f6.2,' hmod:',f6.3,' TxT:',f6.1,' SNR:',f6.1)
write(*,*)
if(i3.eq.1) then
write(*,*) ' mycall hiscall hisgrid'
write(*,'(28i1,1x,i1,1x,28i1,1x,i1,1x,i1,1x,15i1,1x,3i1)') msgbits(1:77)
else
write(*,'(a14)') 'Message bits: '
write(*,'(50i1,1x,24i1)') msgbits
endif
write(*,*)
write(*,'(a17)') 'Channel symbols: '
write(*,'(10i1)') itone
write(*,*)
call sgran()
fsample=12000.0
icmplx=1
call gen_wspr4wave(itone,NN,NSPS,fsample,hmod,f0,c0,wave,icmplx,NMAX)
k=nint((xdt+1.0)/dt)-NSPS
c0=cshift(c0,-k)
if(k.gt.0) c0(0:k-1)=0.0
if(k.lt.0) c0(NMAX+k:NMAX-1)=0.0
do ifile=1,nfiles
c=c0
if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c,NMAX,NZ,fs,delay,fspread)
c=sig*c
wave=real(c)
if(snrdb.lt.90) then
do i=1,NMAX !Add gaussian noise at specified SNR
xnoise=gran()
wave(i)=wave(i) + xnoise
enddo
endif
gain=100.0
if(snrdb.lt.90.0) then
wave=gain*wave
else
datpk=maxval(abs(wave))
fac=32766.9/datpk
wave=fac*wave
endif
if(any(abs(wave).gt.32767.0)) print*,"Warning - data will be clipped."
iwave=nint(wave)
h=default_header(12000,NMAX)
write(fname,1102) ifile
1102 format('000000_',i6.6,'.wav')
open(10,file=fname,status='unknown',access='stream')
write(10) h,iwave !Save to *.wav file
close(10)
write(*,1110) ifile,xdt,f0,snrdb,fname
1110 format(i4,f7.2,f8.2,f7.1,2x,a17)
enddo
999 end program ft280sim

12
lib/fsk4hf/ft2_params.f90
View File

@ -1,12 +0,0 @@
! LDPC (128,90) code
parameter (KK=90) !Information bits (77 + CRC13)
parameter (ND=128) !Data symbols
parameter (NS=16) !Sync symbols (2x8)
parameter (NN=NS+ND) !Total channel symbols (144)
parameter (NSPS=160) !Samples per symbol at 12000 S/s
parameter (NZ=NSPS*NN) !Samples in full 1.92 s waveform (23040)
parameter (NMAX=2.5*12000) !Samples in iwave (36,000)
parameter (NFFT1=400, NH1=NFFT1/2) !Length of FFTs for symbol spectra
parameter (NSTEP=NSPS/4) !Rough time-sync step size
parameter (NHSYM=NMAX/NSTEP-3) !Number of symbol spectra (1/4-sym steps)
parameter (NDOWN=16) !Downsample factor

335
lib/fsk4hf/ft2d.f90
View File

@ -1,335 +0,0 @@
program ft2d
use crc
use packjt77
include 'ft2_params.f90'
character arg*8,message*37,c77*77,infile*80,fname*16,datetime*11
character*37 decodes(100)
character*120 data_dir
character*90 dmsg
complex c2(0:NMAX/16-1) !Complex waveform
complex cb(0:NMAX/16-1)
complex cd(0:144*10-1) !Complex waveform
complex c1(0:9),c0(0:9)
complex ccor(0:1,144)
complex csum,cterm,cc0,cc1,csync1,csync2
complex csync(16),csl(0:159)
real*8 fMHz
real a(5)
real rxdata(128),llr(128) !Soft symbols
real llr2(128)
real sbits(144),sbits1(144),sbits3(144)
real ps(0:8191),psbest(0:8191)
real candidates(100,2)
real savg(NH1),sbase(NH1)
integer ihdr(11)
integer*2 iwave(NMAX) !Generated full-length waveform
integer*1 message77(77),apmask(128),cw(128)
integer*1 hbits(144),hbits1(144),hbits3(144)
integer*1 s16(16),s45(45)
logical unpk77_success
data s16/0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0/
data s45/0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,1,0,0,1,1,1,1,0,0,1,0,0,0,1,1,0,1,0,0,0,1,1,1,0,0/
fs=12000.0/NDOWN !Sample rate
dt=1/fs !Sample interval after downsample (s)
tt=NSPS*dt !Duration of "itone" symbols (s)
baud=1.0/tt !Keying rate for "itone" symbols (baud)
txt=NZ*dt !Transmission length (s)
twopi=8.0*atan(1.0)
h=0.800 !h=0.8 seems to be optimum for AWGN sensitivity (not for fading)
dphi=twopi/2*baud*h*dt*16 ! dt*16 is samp interval after downsample
dphi0=-1*dphi
dphi1=+1*dphi
phi0=0.0
phi1=0.0
do i=0,9
c1(i)=cmplx(cos(phi1),sin(phi1))
c0(i)=cmplx(cos(phi0),sin(phi0))
phi1=mod(phi1+dphi1,twopi)
phi0=mod(phi0+dphi0,twopi)
enddo
the=twopi*h/2.0
cc1=cmplx(cos(the),-sin(the))
cc0=cmplx(cos(the),sin(the))
k=0
do j=1,16
dphi1=(2*s16(j)-1)*dphi
phi1=0.0
do i=0,9
csl(k)=cmplx(cos(phi1),sin(phi1))
phi1=mod(phi1+dphi1,twopi)
k=k+1
enddo
enddo
nargs=iargc()
if(nargs.lt.1) then
print*,'Usage: ft2d [-a <data_dir>] [-f fMHz] file1 [file2 ...]'
go to 999
endif
iarg=1
data_dir="."
call getarg(iarg,arg)
if(arg(1:2).eq.'-a') then
call getarg(iarg+1,data_dir)
iarg=iarg+2
endif
call getarg(iarg,arg)
if(arg(1:2).eq.'-f') then
call getarg(iarg+1,arg)
read(arg,*) fMHz
iarg=iarg+2
endif
ncoh=1
do ifile=iarg,nargs
call getarg(ifile,infile)
j2=index(infile,'.wav')
open(10,file=infile,status='old',access='stream')
read(10,end=999) ihdr,iwave
read(infile(j2-4:j2-1),*) nutc
datetime=infile(j2-11:j2-1)
close(10)
candidates=0.0
ncand=0
call getcandidates2(iwave,375.0,3000.0,0.2,2200.0,100,savg,candidates,ncand,sbase)
ndecodes=0
do icand=1,ncand
f0=candidates(icand,1)
xsnr=1.0
if( f0.le.375.0 .or. f0.ge.(5000.0-375.0) ) cycle
call ft2_downsample(iwave,f0,c2) ! downsample from 160s/Symbol to 10s/Symbol
!c2=c2/sqrt(sum(abs(c2(0:NMAX/16-1))))
!ishift=-1
!rccbest=-99.
!do is=0,435
!rcc=0.0
! do id=10,10
! rcc=rcc+abs(sum(conjg(c2(is:is+159-id))*c2(is+id:is+159)*csl(0:159-id)*conjg(csl(id:159))))
! enddo
! if(rcc.gt.rccbest) then
! rccbest=rcc
! ishift=is
! endif
!write(21,*) is,rcc
!enddo
! 750 samples/second here
ibest=-1
sybest=-99.
dfbest=-1.
do if=-30,+30
df=if
a=0.
a(1)=-df
call twkfreq1(c2,NMAX/16,fs,a,cb)
do is=0,374
csync1=0.
cterm=1
do ib=1,16
! do ib=1,45
i1=(ib-1)*10+is
if(s16(ib).eq.1) then
! if(s45(ib).eq.1) then
csync1=csync1+sum(cb(i1:i1+9)*conjg(c1(0:9)))*cterm
cterm=cterm*cc1
else
csync1=csync1+sum(cb(i1:i1+9)*conjg(c0(0:9)))*cterm
cterm=cterm*cc0
endif
enddo
if(abs(csync1).gt.sybest) then
ibest=is
sybest=abs(csync1)
dfbest=df
endif
enddo
enddo
a=0.
!dfbest=1500.0-f0
a(1)=-dfbest
call twkfreq1(c2,NMAX/16,fs,a,cb)
!ibest=197
ib=ibest
cd=cb(ib:ib+144*10-1)
s2=sum(cd*conjg(cd))/(10*144)
cd=cd/sqrt(s2)
do nseq=1,4
if( nseq.eq.1 ) then ! noncoherent single-symbol detection
sbits1=0.0
do ibit=1,144
ib=(ibit-1)*10
ccor(1,ibit)=sum(cd(ib:ib+9)*conjg(c1(0:9)))
ccor(0,ibit)=sum(cd(ib:ib+9)*conjg(c0(0:9)))
sbits1(ibit)=abs(ccor(1,ibit))-abs(ccor(0,ibit))
hbits1(ibit)=0
if(sbits1(ibit).gt.0) hbits1(ibit)=1
enddo
sbits=sbits1
hbits=hbits1
sbits3=sbits1
hbits3=hbits1
elseif( nseq.ge.2 ) then
nbit=2*nseq-1
numseq=2**(nbit)
ps=0
do ibit=nbit/2+1,144-nbit/2
ps=0.0
pmax=0.0
do iseq=0,numseq-1
csum=0.0
cterm=1.0
k=1
do i=nbit-1,0,-1
ibb=iand(iseq/(2**i),1)
csum=csum+ccor(ibb,ibit-(nbit/2+1)+k)*cterm
if(ibb.eq.0) cterm=cterm*cc0
if(ibb.eq.1) cterm=cterm*cc1
k=k+1
enddo
ps(iseq)=abs(csum)
if( ps(iseq) .gt. pmax ) then
pmax=ps(iseq)
ibflag=1
endif
enddo
if( ibflag .eq. 1 ) then
psbest=ps
ibflag=0
endif
call getbitmetric(2**(nbit/2),psbest,numseq,sbits3(ibit))
hbits3(ibit)=0
if(sbits3(ibit).gt.0) hbits3(ibit)=1
enddo
sbits=sbits3
hbits=hbits3
endif
nsync_qual=count(hbits(1:16).eq.s16)
! if(nsync_qual.lt.10) exit
rxdata=sbits(17:144)
rxav=sum(rxdata(1:128))/128.0
rx2av=sum(rxdata(1:128)*rxdata(1:128))/128.0
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
sigma=0.80
llr(1:128)=2*rxdata/(sigma*sigma)
!xllrmax=maxval(abs(llr))
!write(*,*) ifile,icand,nseq,nsync_qual
apmask=0
!apmask(1:29)=1
!llr(1:29)=xllrmax*(2*s45(17:45)-1)
max_iterations=40
do ibias=0,0
llr2=llr
if(ibias.eq.1) llr2=llr+0.4
if(ibias.eq.2) llr2=llr-0.4
call bpdecode128_90(llr2,apmask,max_iterations,message77,cw,nharderror,niterations)
if(nharderror.ge.0) exit
enddo
if(sum(message77).eq.0) cycle
if( nharderror.ge.0 ) then
write(c77,'(77i1)') message77(1:77)
call unpack77(c77,1,message,unpk77_success)
idupe=0
do i=1,ndecodes
if(decodes(i).eq.message) idupe=1
enddo
if(idupe.eq.1) goto 888
ndecodes=ndecodes+1
decodes(ndecodes)=message
nsnr=nint(xsnr)
freq=f0+dfbest
1210 format(a11,2i4,f6.2,f12.7,2x,a22,i3)
write(*,1212) datetime(8:11),nsnr,ibest/750.0,freq,message,'*',nseq,nharderror,nsync_qual
1212 format(a4,i4,2x,f5.3,f11.1,2x,a22,a1,i5,i5,i5)
goto 888
endif
enddo ! nseq
888 continue
enddo !candidate list
enddo !files
write(*,1120)
1120 format("<DecodeFinished>")
999 end program ft2d
subroutine getbitmetric(ib,ps,ns,xmet)
real ps(0:ns-1)
xm1=0
xm0=0
do i=0,ns-1
if( iand(i/ib,1) .eq. 1 .and. ps(i) .gt. xm1 ) xm1=ps(i)
if( iand(i/ib,1) .eq. 0 .and. ps(i) .gt. xm0 ) xm0=ps(i)
enddo
xmet=xm1-xm0
return
end subroutine getbitmetric
subroutine downsample2(ci,f0,co)
parameter(NI=144*160,NH=NI/2,NO=NI/16) ! downsample from 200 samples per symbol to 10
complex ci(0:NI-1),ct(0:NI-1)
complex co(0:NO-1)
fs=12000.0
df=fs/NI
ct=ci
call four2a(ct,NI,1,-1,1) !c2c FFT to freq domain
i0=nint(f0/df)
ct=cshift(ct,i0)
co=0.0
co(0)=ct(0)
b=8.0
do i=1,NO/2
arg=(i*df/b)**2
filt=exp(-arg)
co(i)=ct(i)*filt
co(NO-i)=ct(NI-i)*filt
enddo
co=co/NO
call four2a(co,NO,1,1,1) !c2c FFT back to time domain
return
end subroutine downsample2
subroutine ft2_downsample(iwave,f0,c)
! Input: i*2 data in iwave() at sample rate 12000 Hz
! Output: Complex data in c(), sampled at 1200 Hz
include 'ft2_params.f90'
parameter (NFFT2=NMAX/16)
integer*2 iwave(NMAX)
complex c(0:NMAX/16-1)
complex c1(0:NFFT2-1)
complex cx(0:NMAX/2)
real x(NMAX)
equivalence (x,cx)
BW=4.0*75
df=12000.0/NMAX
x=iwave
call four2a(x,NMAX,1,-1,0) !r2c FFT to freq domain
ibw=nint(BW/df)
i0=nint(f0/df)
c1=0.
c1(0)=cx(i0)
do i=1,NFFT2/2
arg=(i-1)*df/bw
win=exp(-arg*arg)
c1(i)=cx(i0+i)*win
c1(NFFT2-i)=cx(i0-i)*win
enddo
c1=c1/NFFT2
call four2a(c1,NFFT2,1,1,1) !c2c FFT back to time domain
c=c1(0:NMAX/16-1)
return
end subroutine ft2_downsample

154
lib/fsk4hf/ft2sim.f90
View File

@ -1,154 +0,0 @@
program ft2sim
! Generate simulated signals for experimental "FT2" mode
use wavhdr
use packjt77
include 'ft2_params.f90' !Set various constants
parameter (NWAVE=NN*NSPS)
type(hdr) h !Header for .wav file
character arg*12,fname*17
character msg37*37,msgsent37*37
character c77*77
complex c0(0:NMAX-1)
complex c(0:NMAX-1)
real wave(NMAX)
real dphi(0:NMAX-1)
real pulse(480)
integer itone(NN)
integer*1 msgbits(77)
integer*2 iwave(NMAX) !Generated full-length waveform
! Get command-line argument(s)
nargs=iargc()
if(nargs.ne.8) then
print*,'Usage: ft2sim "message" f0 DT fdop del width nfiles snr'
print*,'Examples: ft2sim "K1ABC W9XYZ EN37" 1500.0 0.0 0.1 1.0 0 10 -18'
print*,' ft2sim "WA9XYZ/R KA1ABC/R FN42" 1500.0 0.0 0.1 1.0 0 10 -18'
print*,' ft2sim "K1ABC RR73; W9XYZ <KH1/KH7Z> -11" 300 0 0 0 25 1 -10'
go to 999
endif
call getarg(1,msg37) !Message to be transmitted
call getarg(2,arg)
read(arg,*) f0 !Frequency (only used for single-signal)
call getarg(3,arg)
read(arg,*) xdt !Time offset from nominal (s)
call getarg(4,arg)
read(arg,*) fspread !Watterson frequency spread (Hz)
call getarg(5,arg)
read(arg,*) delay !Watterson delay (ms)
call getarg(6,arg)
read(arg,*) width !Filter transition width (Hz)
call getarg(7,arg)
read(arg,*) nfiles !Number of files
call getarg(8,arg)
read(arg,*) snrdb !SNR_2500
nfiles=abs(nfiles)
twopi=8.0*atan(1.0)
fs=12000.0 !Sample rate (Hz)
dt=1.0/fs !Sample interval (s)
hmod=0.800 !Modulation index (0.5 is MSK, 1.0 is FSK)
tt=NSPS*dt !Duration of symbols (s)
baud=1.0/tt !Keying rate (baud)
txt=NZ*dt !Transmission length (s)
bandwidth_ratio=2500.0/(fs/2.0)
sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb)
if(snrdb.gt.90.0) sig=1.0
txt=NN*NSPS/12000.0
! Source-encode, then get itone()
i3=-1
n3=-1
call pack77(msg37,i3,n3,c77)
read(c77,'(77i1)') msgbits
call genft2(msg37,0,msgsent37,itone,itype)
write(*,*)
write(*,'(a9,a37,3x,a7,i1,a1,i1)') 'Message: ',msgsent37,'i3.n3: ',i3,'.',n3
write(*,1000) f0,xdt,txt,snrdb
1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1)
write(*,*)
if(i3.eq.1) then
write(*,*) ' mycall hiscall hisgrid'
write(*,'(28i1,1x,i1,1x,28i1,1x,i1,1x,i1,1x,15i1,1x,3i1)') msgbits(1:77)
else
write(*,'(a14)') 'Message bits: '
write(*,'(77i1)') msgbits
endif
write(*,*)
write(*,'(a17)') 'Channel symbols: '
write(*,'(79i1)') itone
write(*,*)
call sgran()
! The filtered frequency pulse
do i=1,480
tt=(i-240.5)/160.0
pulse(i)=gfsk_pulse(1.0,tt)
enddo
! Define the instantaneous frequency waveform
dphi_peak=twopi*(hmod/2.0)/real(NSPS)
dphi=0.0
do j=1,NN
ib=(j-1)*160
ie=ib+480-1
dphi(ib:ie)=dphi(ib:ie)+dphi_peak*pulse*(2*itone(j)-1)
enddo
phi=0.0
c0=0.0
dphi=dphi+twopi*f0*dt
do j=0,NMAX-1
c0(j)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi(j),twopi)
enddo
c0(0:159)=c0(0:159)*(1.0-cos(twopi*(/(i,i=0,159)/)/320.0) )/2.0
c0(145*160:145*160+159)=c0(145*160:145*160+159)*(1.0+cos(twopi*(/(i,i=0,159)/)/320.0 ))/2.0
c0(146*160:)=0.
k=nint((xdt+0.25)/dt)
c0=cshift(c0,-k)
ia=k
do ifile=1,nfiles
c=c0
if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c,NMAX,NWAVE,fs,delay,fspread)
c=sig*c
ib=k
wave=real(c)
peak=maxval(abs(wave(ia:ib)))
nslots=1
if(width.gt.0.0) call filt8(f0,nslots,width,wave)
if(snrdb.lt.90) then
do i=1,NMAX !Add gaussian noise at specified SNR
xnoise=gran()
wave(i)=wave(i) + xnoise
enddo
endif
gain=100.0
if(snrdb.lt.90.0) then
wave=gain*wave
else
datpk=maxval(abs(wave))
fac=32766.9/datpk
wave=fac*wave
endif
if(any(abs(wave).gt.32767.0)) print*,"Warning - data will be clipped."
iwave=nint(wave)
h=default_header(12000,NMAX)
write(fname,1102) ifile
1102 format('000000_',i6.6,'.wav')
open(10,file=fname,status='unknown',access='stream')
write(10) h,iwave !Save to *.wav file
close(10)
write(*,1110) ifile,xdt,f0,snrdb,fname
1110 format(i4,f7.2,f8.2,f7.1,2x,a17)
enddo
999 end program ft2sim

329
lib/fsk4hf/ft4d.f90
View File

@ -1,329 +0,0 @@
program ft4d
use crc
use packjt77
include 'ft4_params.f90'
character arg*8,message*37,c77*77,infile*80,fname*16,datetime*11
character*37 decodes(100)
character*120 data_dir
character*90 dmsg
complex cd2(0:NMAX/16-1) !Complex waveform
complex cb(0:NMAX/16-1)
complex cd(0:76*20-1) !Complex waveform
complex csum,cterm
complex ctwk(80),ctwk2(80)
complex csymb(20)
complex cs(0:3,NN)
real s4(0:3,NN)
real*8 fMHz
real ps(0:8191),psbest(0:8191)
real bmeta(152),bmetb(152),bmetc(152)
real s(NH1,NHSYM)
real a(5)
real llr(128),llr2(128),llra(128),llrb(128),llrc(128)
real s2(0:255)
real candidate(3,100)
real savg(NH1),sbase(NH1)
integer ihdr(11)
integer icos4(0:3)
integer*2 iwave(NMAX) !Generated full-length waveform
integer*1 message77(77),apmask(128),cw(128)
integer*1 hbits(152),hbits1(152),hbits3(152)
integer*1 s12(12)
integer graymap(0:3)
integer ip(1)
logical unpk77_success
logical one(0:511,0:7) ! 256 4-symbol sequences, 8 bits
data s12/1,1,1,2,2,2,2,2,2,1,1,1/
data icos4/0,1,3,2/
data graymap/0,1,3,2/
save one
fs=12000.0/NDOWN !Sample rate
dt=1/fs !Sample interval after downsample (s)
tt=NSPS*dt !Duration of "itone" symbols (s)
baud=1.0/tt !Keying rate for "itone" symbols (baud)
txt=NZ*dt !Transmission length (s)
twopi=8.0*atan(1.0)
h=1.0 !h=0.8 seems to be optimum for AWGN sensitivity (not for fading)
one=.false.
do i=0,255
do j=0,7
if(iand(i,2**j).ne.0) one(i,j)=.true.
enddo
enddo
nargs=iargc()
if(nargs.lt.1) then
print*,'Usage: ft4d [-a <data_dir>] [-f fMHz] file1 [file2 ...]'
go to 999
endif
iarg=1
data_dir="."
call getarg(iarg,arg)
if(arg(1:2).eq.'-a') then
call getarg(iarg+1,data_dir)
iarg=iarg+2
endif
call getarg(iarg,arg)
if(arg(1:2).eq.'-f') then
call getarg(iarg+1,arg)
read(arg,*) fMHz
iarg=iarg+2
endif
ncoh=1
do ifile=iarg,nargs
call getarg(ifile,infile)
j2=index(infile,'.wav')
open(10,file=infile,status='old',access='stream')
read(10,end=999) ihdr,iwave
read(infile(j2-4:j2-1),*) nutc
datetime=infile(j2-11:j2-1)
close(10)
candidate=0.0
ncand=0
nfqso=1500
nfa=500
nfb=2700
syncmin=1.0
maxcand=100
! call syncft4(iwave,nfa,nfb,syncmin,nfqso,maxcand,s,candidate,ncand,sbase)
call getcandidates4(iwave,375.0,3000.0,0.2,2200.0,100,savg,candidate,ncand,sbase)
ndecodes=0
do icand=1,ncand
f0=candidate(1,icand)-1.5*37.5
xsnr=1.0
if( f0.le.375.0 .or. f0.ge.(5000.0-375.0) ) cycle
call ft4_downsample(iwave,f0,cd2) ! downsample from 320 Sa/Symbol to 20 Sa/Symbol
sum2=sum(cd2*conjg(cd2))/(20.0*76)
if(sum2.gt.0.0) cd2=cd2/sqrt(sum2)
! 750 samples/second here
ibest=-1
smax=-99.
dfbest=-1.
do idf=-90,+90,5
df=idf
a=0.
a(1)=df
ctwk=1.
call twkfreq1(ctwk,80,fs,a,ctwk2)
do istart=0,315
call sync4d(cd2,istart,ctwk2,1,sync)
if(sync.gt.smax) then
smax=sync
ibest=istart
dfbest=df
endif
enddo
enddo
f0=f0+dfbest
!f0=1443.75
call ft4_downsample(iwave,f0,cb) ! downsample from 320s/Symbol to 20s/Symbol
sum2=sum(abs(cb)**2)/(20.0*76)
if(sum2.gt.0.0) cb=cb/sqrt(sum2)
!ibest=208
cd=cb(ibest:ibest+76*20-1)
do k=1,NN
i1=(k-1)*20
csymb=cd(i1:i1+19)
call four2a(csymb,20,1,-1,1)
cs(0:3,k)=csymb(1:4)/1e2
s4(0:3,k)=abs(csymb(1:4))
enddo
! sync quality check
is1=0
is2=0
is3=0
do k=1,4
ip=maxloc(s4(:,k))
if(icos4(k-1).eq.(ip(1)-1)) is1=is1+1
ip=maxloc(s4(:,k+36))
if(icos4(k-1).eq.(ip(1)-1)) is2=is2+1
ip=maxloc(s4(:,k+72))
if(icos4(k-1).eq.(ip(1)-1)) is3=is3+1
enddo
! hard sync sum - max is 12
nsync=is1+is2+is3
do nseq=1,3
if(nseq.eq.1) nsym=1
if(nseq.eq.2) nsym=2
if(nseq.eq.3) nsym=4
nt=2**(2*nsym)
do ks=1,76,nsym
amax=-1.0
do i=0,nt-1
i1=i/64
i2=iand(i,63)/16
i3=iand(i,15)/4
i4=iand(i,3)
if(nsym.eq.1) then
s2(i)=abs(cs(graymap(i4),ks))
elseif(nsym.eq.2) then
s2(i)=abs(cs(graymap(i3),ks)+cs(graymap(i4),ks+1))
elseif(nsym.eq.4) then
s2(i)=abs(cs(graymap(i1),ks ) + &
cs(graymap(i2),ks+1) + &
cs(graymap(i3),ks+2) + &
cs(graymap(i4),ks+3) &
)
else
print*,"Error - nsym must be 1, 2, or 4."
endif
enddo
ipt=1+(ks-1)*2
if(nsym.eq.1) ibmax=1
if(nsym.eq.2) ibmax=3
if(nsym.eq.4) ibmax=7
do ib=0,ibmax
bm=maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)) - &
maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib))
if(ipt+ib .gt.152) cycle
if(nsym.eq.1) then
bmeta(ipt+ib)=bm
elseif(nsym.eq.2) then
bmetb(ipt+ib)=bm
elseif(nsym.eq.4) then
bmetc(ipt+ib)=bm
endif
enddo
enddo
enddo
call normalizebmet(bmeta,152)
call normalizebmet(bmetb,152)
call normalizebmet(bmetc,152)
hbits=0
where(bmeta.ge.0) hbits=1
ns1=count(hbits( 1: 8).eq.(/0,0,0,1,1,0,1,1/))
ns2=count(hbits( 73: 80).eq.(/0,0,0,1,1,0,1,1/))
ns3=count(hbits(145:152).eq.(/0,0,0,1,1,0,1,1/))
nsync_qual=ns1+ns2+ns3
sigma=0.7
llra(1:64)=bmeta(9:72)
llra(65:128)=bmeta(81:144)
llra=2*llra/sigma**2
llrb(1:64)=bmetb(9:72)
llrb(65:128)=bmetb(81:144)
llrb=2*llrb/sigma**2
llrc(1:64)=bmetc(9:72)
llrc(65:128)=bmetc(81:144)
llrc=2*llrc/sigma**2
do isd=1,3
if(isd.eq.1) llr=llra
if(isd.eq.2) llr=llrb
if(isd.eq.3) llr=llrc
apmask=0
max_iterations=40
do ibias=0,0
llr2=llr
if(ibias.eq.1) llr2=llr+0.4
if(ibias.eq.2) llr2=llr-0.4
call bpdecode128_90(llr2,apmask,max_iterations,message77,cw,nharderror,niterations)
if(nharderror.ge.0) exit
enddo
if(sum(message77).eq.0) cycle
if( nharderror.ge.0 ) then
write(c77,'(77i1)') message77(1:77)
call unpack77(c77,1,message,unpk77_success)
idupe=0
do i=1,ndecodes
if(decodes(i).eq.message) idupe=1
enddo
if(idupe.eq.1) cycle
ndecodes=ndecodes+1
decodes(ndecodes)=message
nsnr=nint(xsnr)
write(*,1212) datetime(8:11),nsnr,ibest/750.0,f0,message,'*',nharderror,nsync_qual,isd,niterations
1212 format(a4,i4,2x,f5.3,f11.1,2x,a22,a1,i5,i5,i5,i5)
endif
enddo ! sequence estimation
enddo !candidate list
enddo !files
write(*,1120)
1120 format("<DecodeFinished>")
999 end program ft4d
subroutine getbitmetric(ib,ps,ns,xmet)
real ps(0:ns-1)
xm1=0
xm0=0
do i=0,ns-1
if( iand(i/ib,1) .eq. 1 .and. ps(i) .gt. xm1 ) xm1=ps(i)
if( iand(i/ib,1) .eq. 0 .and. ps(i) .gt. xm0 ) xm0=ps(i)
enddo
xmet=xm1-xm0
return
end subroutine getbitmetric
subroutine downsample4(ci,f0,co)
parameter(NI=144*160,NH=NI/2,NO=NI/16) ! downsample from 200 samples per symbol to 10
complex ci(0:NI-1),ct(0:NI-1)
complex co(0:NO-1)
fs=12000.0
df=fs/NI
ct=ci
call four2a(ct,NI,1,-1,1) !c2c FFT to freq domain
i0=nint(f0/df)
ct=cshift(ct,i0)
co=0.0
co(0)=ct(0)
b=8.0
do i=1,NO/2
arg=(i*df/b)**2
filt=exp(-arg)
co(i)=ct(i)*filt
co(NO-i)=ct(NI-i)*filt
enddo
co=co/NO
call four2a(co,NO,1,1,1) !c2c FFT back to time domain
return
end subroutine downsample4
subroutine ft4_downsample(iwave,f0,c)
! Input: i*2 data in iwave() at sample rate 12000 Hz
! Output: Complex data in c(), sampled at 1200 Hz
include 'ft4_params.f90'
parameter (NFFT2=NMAX/16)
integer*2 iwave(NMAX)
complex c(0:NMAX/16-1)
complex c1(0:NFFT2-1)
complex cx(0:NMAX/2)
real x(NMAX)
equivalence (x,cx)
BW=6.0*75
df=12000.0/NMAX
x=iwave
call four2a(x,NMAX,1,-1,0) !r2c FFT to freq domain
ibw=nint(BW/df)
i0=nint(f0/df)
c1=0.
c1(0)=cx(i0)
do i=1,NFFT2/2
arg=(i-1)*df/bw
win=exp(-arg*arg)
c1(i)=cx(i0+i)*win
c1(NFFT2-i)=cx(i0-i)*win
enddo
c1=c1/NFFT2
call four2a(c1,NFFT2,1,1,1) !c2c FFT back to time domain
c=c1(0:NMAX/16-1)
return
end subroutine ft4_downsample

16
lib/fsk4hf/ft4s280_params.f90
View File

@ -1,16 +0,0 @@
! FT4S280
! LDPC(280,101)/CRC24 code, six 4x4 Costas arrays for sync, ramp-up and ramp-down symbols
parameter (KK=77) !Information bits (77 + CRC24)
parameter (ND=140) !Data symbols
parameter (NS=24) !Sync symbols
parameter (NN=NS+ND) !Sync and data symbols (164)
parameter (NN2=NS+ND+2) !Total channel symbols (166)
parameter (NSPS=8400) !Samples per symbol at 12000 S/s
parameter (NZ=NSPS*NN) !Sync and Data samples (1,377,600)
parameter (NZ2=NSPS*NN2) !Total samples in shaped waveform (1,394,400)
parameter (NMAX=408*3456) !Samples in iwave (1,410,048)
parameter (NFFT1=4*NSPS, NH1=NFFT1/2) !Length of FFTs for symbol spectra
parameter (NSTEP=NSPS) !Coarse time-sync step size
parameter (NHSYM=(NMAX-NFFT1)/NSTEP) !Number of symbol spectra (1/4-sym steps)
parameter (NDOWN=28) !Downsample factor

16
lib/fsk4hf/ft4s_params.f90
View File

@ -1,16 +0,0 @@
! FT4A
! LDPC(240,101)/CRC24 code, four 4x4 Costas arrays for sync, ramp-up and ramp-down symbols
parameter (KK=77) !Information bits (77 + CRC24)
parameter (ND=120) !Data symbols
parameter (NS=24) !Sync symbols
parameter (NN=NS+ND) !Sync and data symbols (144)
parameter (NN2=NS+ND+2) !Total channel symbols (146)
parameter (NSPS=9600) !Samples per symbol at 12000 S/s
parameter (NZ=NSPS*NN) !Sync and Data samples (1,382,400)
parameter (NZ2=NSPS*NN2) !Total samples in shaped waveform (1,397,760)
parameter (NMAX=408*3456) !Samples in iwave (1,410,048)
parameter (NFFT1=4*NSPS, NH1=NFFT1/2) !Length of FFTs for symbol spectra
parameter (NSTEP=NSPS) !Coarse time-sync step size
parameter (NHSYM=(NMAX-NFFT1)/NSTEP) !Number of symbol spectra (1/4-sym steps)
parameter (NDOWN=32) !Downsample factor

473
lib/fsk4hf/ft4sd.f90
View File

@ -1,473 +0,0 @@
program ft4sd
! Decode ft4slow data read from *.c2 or *.wav files.
use packjt77
include 'ft4s_params.f90'
parameter (NSPS2=NSPS/32)
character arg*8,cbits*50,infile*80,fname*16,datetime*11
character ch1*1,ch4*4,cseq*31
character*22 decodes(100)
character*37 msg
character*120 data_dir
character*77 c77
complex c2(0:NMAX/32-1) !Complex waveform
complex cframe(0:144*NSPS2-1) !Complex waveform
complex cd(0:144*20-1) !Complex waveform
real*8 fMHz
real llr(240),llra(240),llrb(240),llrc(240),llrd(240)
real candidates(100,2)
real bitmetrics(288,4)
integer ihdr(11)
integer*2 iwave(NMAX) !Generated full-length waveform
integer*1 apmask(240),cw(240)
integer*1 hbits(288)
integer*1 message101(101)
logical badsync,unpk77_success
fs=12000.0/NDOWN !Sample rate
dt=1.0/fs !Sample interval (s)
tt=NSPS*dt !Duration of "itone" symbols (s)
txt=NZ*dt !Transmission length (s)
hmod=1.0
Keff=91
nargs=iargc()
if(nargs.lt.1) then
print*,'Usage: ft4sd [-a <data_dir>] [-f fMHz] [-h hmod] [-k Keff] file1 [file2 ...]'
go to 999
endif
iarg=1
data_dir="."
call getarg(iarg,arg)
if(arg(1:2).eq.'-a') then
call getarg(iarg+1,data_dir)
iarg=iarg+2
call getarg(iarg,arg)
endif
if(arg(1:2).eq.'-f') then
call getarg(iarg+1,arg)
read(arg,*) fMHz
iarg=iarg+2
call getarg(iarg,arg)
endif
if(arg(1:2).eq.'-h') then
call getarg(iarg+1,arg)
read(arg,*) hmod
iarg=iarg+2
call getarg(iarg,arg)
endif
if(arg(1:2).eq.'-k') then
call getarg(iarg+1,arg)
read(arg,*) Keff
iarg=iarg+2
endif
ngood=0
do ifile=iarg,nargs
call getarg(ifile,infile)
open(10,file=infile,status='old',access='stream')
j1=index(infile,'.c2')
j2=index(infile,'.wav')
if(j1.gt.0) then
read(10,end=999) fname,ntrmin,fMHz,c2
read(fname(8:11),*) nutc
write(datetime,'(i11)') nutc
else if(j2.gt.0) then
read(10,end=999) ihdr,iwave
read(infile(j2-4:j2-1),*) nutc
datetime=infile(j2-11:j2-1)
call ft4s_downsample(iwave,c2)
else
print*,'Wrong file format?'
go to 999
endif
close(10)
fa=-100.0
fb=100.0
fs=12000.0/32.0
npts=120*12000.0/32.0
call getcandidate_ft4s(c2,npts,hmod,fs,fa,fb,ncand,candidates) !First approx for freq
del=1.5*hmod*fs/300.0
ndecodes=0
do icand=1,ncand
fc0=candidates(icand,1)
xsnr=candidates(icand,2)
!write(*,*) 'candidates ',icand,fc0,xsnr
do isync=0,1
if(isync.eq.0) then
fc1=fc0-del
is0=375
ishw=350
isst=30
ifhw=10
df=.1
else if(isync.eq.1) then
fc1=fc2
is0=isbest
ishw=100
isst=10
ifhw=10
df=.02
endif
smax=0.0
do if=-ifhw,ifhw
fc=fc1+df*if
do istart=max(1,is0-ishw),is0+ishw,isst
call coherent_sync_ft4s(c2,istart,hmod,fc,1,sync)
if(sync.gt.smax) then
fc2=fc
isbest=istart
smax=sync
endif
enddo
enddo
! write(*,*) ifile,icand,isync,fc1+del,fc2+del,isbest,smax
enddo
! if(smax .lt. 100.0 ) cycle
!isbest=375
!fc2=-del
do ijitter=0,2
if(ijitter.eq.0) ioffset=0
if(ijitter.eq.1) ioffset=45
if(ijitter.eq.2) ioffset=-45
is0=isbest+ioffset
if(is0.lt.0) cycle
cframe=c2(is0:is0+144*300-1)
call downsample_ft4s(cframe,fc2+del,hmod,cd)
s2=sum(cd*conjg(cd))/(20*144)
cd=cd/sqrt(s2)
call get_ft4s_bitmetrics(cd,hmod,bitmetrics,badsync)
hbits=0
where(bitmetrics(:,1).ge.0) hbits=1
ns1=count(hbits( 1: 8).eq.(/0,0,0,1,1,0,1,1/))
ns2=count(hbits( 57: 64).eq.(/0,1,0,0,1,1,1,0/))
ns3=count(hbits(113:120).eq.(/1,1,1,0,0,1,0,0/))
ns4=count(hbits(169:176).eq.(/1,0,1,1,0,0,0,1/))
ns5=count(hbits(225:232).eq.(/0,0,1,1,1,0,0,1/))
ns6=count(hbits(281:288).eq.(/0,1,1,1,0,0,1,0/))
nsync_qual=ns1+ns2+ns3+ns4+ns5+ns6
! if(nsync_qual.lt. 20) cycle
scalefac=2.83
llra( 1: 48)=bitmetrics( 9: 56, 1)
llra( 49: 96)=bitmetrics( 65:112, 1)
llra( 97:144)=bitmetrics(121:168, 1)
llra(145:192)=bitmetrics(177:224, 1)
llra(193:240)=bitmetrics(233:280, 1)
llra=scalefac*llra
llrb( 1: 48)=bitmetrics( 9: 56, 2)
llrb( 49: 96)=bitmetrics( 65:112, 2)
llrb( 97:144)=bitmetrics(121:168, 2)
llrb(145:192)=bitmetrics(177:224, 2)
llrb(193:240)=bitmetrics(233:280, 2)
llrb=scalefac*llrb
llrc( 1: 48)=bitmetrics( 9: 56, 3)
llrc( 49: 96)=bitmetrics( 65:112, 3)
llrc( 97:144)=bitmetrics(121:168, 3)
llrc(145:192)=bitmetrics(177:224, 3)
llrc(193:240)=bitmetrics(233:280, 3)
llrc=scalefac*llrc
llrd( 1: 48)=bitmetrics( 9: 56, 4)
llrd( 49: 96)=bitmetrics( 65:112, 4)
llrd( 97:144)=bitmetrics(121:168, 4)
llrd(145:192)=bitmetrics(177:224, 4)
llrd(193:240)=bitmetrics(233:280, 4)
llrd=scalefac*llrd
apmask=0
max_iterations=40
do itry=4,1,-1
if(itry.eq.1) llr=llra
if(itry.eq.2) llr=llrb
if(itry.eq.3) llr=llrc
if(itry.eq.4) llr=llrd
nhardbp=0
nhardosd=0
dmin=0.0
call bpdecode240_101(llr,apmask,max_iterations,message101,cw,nhardbp,niterations,nchecks)
! if(nhardbp.lt.0) call osd240_101(llr,Keff,apmask,5,message101,cw,nhardosd,dmin)
maxsuperits=2
ndeep=3 ! use ndeep=3 with Keff=91
if(Keff.eq.77) ndeep=4
if(nhardbp.lt.0) then
! call osd240_101(llr,Keff,apmask,ndeep,message101,cw,nhardosd,dmin)
call decode240_101(llr,Keff,ndeep,apmask,maxsuperits,message101,cw,nhardosd,iter,ncheck,dmin,isuper)
endif
if(nhardbp.ge.0 .or. nhardosd.ge.0) then
write(c77,'(77i1)') message101(1:77)
call unpack77(c77,0,msg,unpk77_success)
if(unpk77_success .and. index(msg,'K9AN').gt.0) then
ngood=ngood+1
write(*,1100) ifile-2,icand,xsnr,isbest/375.0-1.0,1500.0+fc2+del,msg(1:20),itry,nhardbp,nhardosd,dmin,ijitter
1100 format(i5,2x,i5,2x,f6.1,2x,f6.2,2x,f8.2,2x,a20,i4,i4,i4,f7.2,i6)
goto 2002
else
cycle
endif
endif
enddo ! metrics
enddo ! istart jitter
enddo !candidate list
2002 continue
enddo !files
nfiles=nargs-iarg+1
write(*,*) 'nfiles: ',nfiles,' ngood: ',ngood
write(*,1120)
1120 format("<DecodeFinished>")
999 end program ft4sd
subroutine coherent_sync_ft4s(cd0,i0,hmod,f0,itwk,sync)
! Compute sync power for a complex, downsampled FT4s signal.
include 'ft4s_params.f90'
parameter(NP=NMAX/NDOWN,NSS=NSPS/NDOWN)
complex cd0(0:NP-1)
complex csynca(4*NSS),csyncb(4*NSS)
complex csyncc(4*NSS),csyncd(4*NSS)
complex csynce(4*NSS),csyncf(4*NSS)
complex csync2(4*NSS)
complex ctwk(4*NSS)
complex z1,z2,z3,z4,z5,z6
logical first
integer icos4a(0:3),icos4b(0:3)
integer icos4c(0:3),icos4d(0:3)
integer icos4e(0:3),icos4f(0:3)
data icos4a/0,1,3,2/
data icos4b/1,0,2,3/
data icos4c/2,3,1,0/
data icos4d/3,2,0,1/
data icos4e/0,2,3,1/
data icos4f/1,2,0,3/
data first/.true./
save first,twopi,csynca,csyncb,csyncc,csyncd,csynce,csyncf,fac
p(z1)=(real(z1*fac)**2 + aimag(z1*fac)**2)**0.5 !Statement function for power
if( first ) then
twopi=8.0*atan(1.0)
k=1
phia=0.0
phib=0.0
phic=0.0
phid=0.0
phie=0.0
phif=0.0
do i=0,3
dphia=twopi*hmod*icos4a(i)/real(NSS)
dphib=twopi*hmod*icos4b(i)/real(NSS)
dphic=twopi*hmod*icos4c(i)/real(NSS)
dphid=twopi*hmod*icos4d(i)/real(NSS)
dphie=twopi*hmod*icos4e(i)/real(NSS)
dphif=twopi*hmod*icos4f(i)/real(NSS)
do j=1,NSS
csynca(k)=cmplx(cos(phia),sin(phia))
csyncb(k)=cmplx(cos(phib),sin(phib))
csyncc(k)=cmplx(cos(phic),sin(phic))
csyncd(k)=cmplx(cos(phid),sin(phid))
csynce(k)=cmplx(cos(phie),sin(phie))
csyncf(k)=cmplx(cos(phif),sin(phif))
phia=mod(phia+dphia,twopi)
phib=mod(phib+dphib,twopi)
phic=mod(phic+dphic,twopi)
phid=mod(phid+dphid,twopi)
phie=mod(phie+dphie,twopi)
phif=mod(phif+dphif,twopi)
k=k+1
enddo
enddo
first=.false.
fac=1.0/(4.0*NSS)
endif
i1=i0 !four Costas arrays
i2=i0+28*NSS
i3=i0+56*NSS
i4=i0+84*NSS
i5=i0+112*NSS
i6=i0+140*NSS
z1=0.
z2=0.
z3=0.
z4=0.
z5=0.
z6=0.
if(itwk.eq.1) then
dt=1/(12000.0/32.0)
dphi=twopi*f0*dt
phi=0.0
do i=1,4*NSS
ctwk(i)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
enddo
endif
if(itwk.eq.1) csync2=ctwk*csynca !Tweak the frequency
if(i1.ge.0 .and. i1+4*NSS-1.le.NP-1) then
z1=sum(cd0(i1:i1+4*NSS-1)*conjg(csync2))
elseif( i1.lt.0 ) then
npts=(i1+4*NSS-1)/2
if(npts.le.40) then
z1=0.
else
z1=sum(cd0(0:i1+4*NSS-1)*conjg(csync2(4*NSS-npts:)))
endif
endif
if(itwk.eq.1) csync2=ctwk*csyncb !Tweak the frequency
if(i2.ge.0 .and. i2+4*NSS-1.le.NP-1) then
z2=sum(cd0(i2:i2+4*NSS-1)*conjg(csync2))
endif
if(itwk.eq.1) csync2=ctwk*csyncc !Tweak the frequency
if(i3.ge.0 .and. i3+4*NSS-1.le.NP-1) then
z3=sum(cd0(i3:i3+4*NSS-1)*conjg(csync2))
endif
if(itwk.eq.1) csync2=ctwk*csyncd !Tweak the frequency
if(i4.ge.0 .and. i4+4*NSS-1.le.NP-1) then
z4=sum(cd0(i4:i4+4*NSS-1)*conjg(csync2))
endif
if(itwk.eq.1) csync2=ctwk*csynce !Tweak the frequency
if(i5.ge.0 .and. i5+4*NSS-1.le.NP-1) then
z5=sum(cd0(i5:i5+4*NSS-1)*conjg(csync2))
endif
if(itwk.eq.1) csync2=ctwk*csyncf !Tweak the frequency
if(i6.ge.0 .and. i6+4*NSS-1.le.NP-1) then
z6=sum(cd0(i6:i6+4*NSS-1)*conjg(csync2))
elseif( i6+4*NSS-1.gt.NP-1 ) then
npts=(NP-1-i6+1)
if(npts.le.40) then
z6=0.
else
z6=sum(cd0(i6:i6+npts-1)*conjg(csync2(1:npts)))
endif
endif
sync = p(z1) + p(z2) + p(z3) + p(z4) + p(z5) + p(z6)
return
end subroutine coherent_sync_ft4s
subroutine downsample_ft4s(ci,f0,hmod,co)
parameter(NI=144*300,NH=NI/2,NO=NI/15) ! downsample from 315 samples per symbol to 20
complex ci(0:NI-1),ct(0:NI-1)
complex co(0:NO-1)
fs=12000.0/32.0
df=fs/NI
ct=ci
call four2a(ct,NI,1,-1,1) !c2c FFT to freq domain
i0=nint(f0/df)
ct=cshift(ct,i0)
co=0.0
co(0)=ct(0)
b=16.0*hmod
do i=1,NO/2
arg=(i*df/b)**2
filt=exp(-arg)
co(i)=ct(i)*filt
co(NO-i)=ct(NI-i)*filt
enddo
co=co/NO
call four2a(co,NO,1,1,1) !c2c FFT back to time domain
return
end subroutine downsample_ft4s
subroutine getcandidate_ft4s(c,npts,hmod,fs,fa,fb,ncand,candidates)
parameter(NFFT1=120*12000/32,NH1=NFFT1/2,NFFT2=120*12000/320,NH2=NFFT2/2)
complex c(0:npts-1) !Complex waveform
complex cc(0:NFFT1-1)
complex csfil(0:NFFT2-1)
complex cwork(0:NFFT2-1)
real bigspec(0:NFFT2-1)
complex c2(0:NFFT1-1) !Short spectra
real s(-NH1+1:NH1) !Coarse spectrum
real ss(-NH1+1:NH1) !Smoothed coarse spectrum
real candidates(100,2)
integer indx(NFFT2-1)
logical first
data first/.true./
save first,w,df,csfil
if(first) then
df=10*fs/NFFT1
csfil=cmplx(0.0,0.0)
do i=0,NFFT2-1
! csfil(i)=exp(-((i-NH2)/32.0)**2) ! revisit this
csfil(i)=exp(-((i-NH2)/(hmod*28.0))**2) ! revisit this
enddo
csfil=cshift(csfil,NH2)
call four2a(csfil,NFFT2,1,-1,1)
first=.false.
endif
cc=cmplx(0.0,0.0)
cc(0:npts-1)=c;
call four2a(cc,NFFT1,1,-1,1)
cc=abs(cc)**2
call four2a(cc,NFFT1,1,-1,1)
cwork(0:NH2)=cc(0:NH2)*conjg(csfil(0:NH2))
cwork(NH2+1:NFFT2-1)=cc(NFFT1-NH2+1:NFFT1-1)*conjg(csfil(NH2+1:NFFT2-1))
call four2a(cwork,NFFT2,1,+1,1)
bigspec=cshift(real(cwork),-NH2)
il=NH2+fa/df
ih=NH2+fb/df
nnl=ih-il+1
call indexx(bigspec(il:il+nnl-1),nnl,indx)
xn=bigspec(il-1+indx(nint(0.3*nnl)))
bigspec=bigspec/xn
ncand=0
do i=il,ih
if((bigspec(i).gt.bigspec(i-1)).and. &
(bigspec(i).gt.bigspec(i+1)).and. &
(bigspec(i).gt.1.15).and.ncand.lt.100) then
ncand=ncand+1
candidates(ncand,1)=df*(i-NH2)
candidates(ncand,2)=10*log10(bigspec(i)-1)-26.5
endif
enddo
return
end subroutine getcandidate_ft4s
subroutine ft4s_downsample(iwave,c)
! Input: i*2 data in iwave() at sample rate 12000 Hz
! Output: Complex data in c(), sampled at 375 Hz
include 'ft4s_params.f90'
parameter (NFFT2=NMAX/32)
integer*2 iwave(NMAX)
complex c(0:NMAX/32-1)
complex c1(0:NFFT2-1)
complex cx(0:NMAX/2)
real x(NMAX)
equivalence (x,cx)
df=12000.0/NMAX
x=iwave
call four2a(x,NMAX,1,-1,0) !r2c FFT to freq domain
i0=nint(1500.0/df)
c1(0)=cx(i0)
do i=1,NFFT2/2
c1(i)=cx(i0+i)
c1(NFFT2-i)=cx(i0-i)
enddo
c1=c1/NFFT2
call four2a(c1,NFFT2,1,1,1) !c2c FFT back to time domain
c=c1(0:NMAX/32-1)
return
end subroutine ft4s_downsample

113
lib/fsk4hf/ft4slowsim.f90
View File

@ -1,113 +0,0 @@
program ft4slowsim
! Generate simulated signals for experimental slow FT4 mode
use wavhdr
use packjt77
include 'ft4s_params.f90' !Set various constants
type(hdr) h !Header for .wav file
character arg*12,fname*17
character msg37*37,msgsent37*37
character c77*77
complex c0(0:NMAX-1)
complex c(0:NMAX-1)
real wave(NMAX)
integer itone(NN)
integer*1 msgbits(101)
integer*2 iwave(NMAX) !Generated full-length waveform
! Get command-line argument(s)
nargs=iargc()
if(nargs.ne.8) then
print*,'Usage: ft4slowsim "message" f0 DT h fdop del nfiles snr'
print*,'Examples: ft4slowsim "K1JT K9AN EN50" 1500 0.0 1.0 0.1 1.0 10 -15'
go to 999
endif
call getarg(1,msg37) !Message to be transmitted
call getarg(2,arg)
read(arg,*) f0 !Frequency (only used for single-signal)
call getarg(3,arg)
read(arg,*) xdt !Time offset from nominal (s)
call getarg(4,arg)
read(arg,*) hmod !Modulation index, h
call getarg(5,arg)
read(arg,*) fspread !Watterson frequency spread (Hz)
call getarg(6,arg)
read(arg,*) delay !Watterson delay (ms)
call getarg(7,arg)
read(arg,*) nfiles !Number of files
call getarg(8,arg)
read(arg,*) snrdb !SNR_2500
nfiles=abs(nfiles)
twopi=8.0*atan(1.0)
fs=12000.0 !Sample rate (Hz)
dt=1.0/fs !Sample interval (s)
tt=NSPS*dt !Duration of symbols (s)
baud=1.0/tt !Keying rate (baud)
txt=NZ2*dt !Transmission length (s)
bandwidth_ratio=2500.0/(fs/2.0)
sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb)
if(snrdb.gt.90.0) sig=1.0
call genft4slow(msg37,0,msgsent37,msgbits,itone)
write(*,*)
write(*,'(a9,a37,3x,a7,i1,a1,i1)') 'Message: ',msgsent37,'i3.n3: ',i3,'.',n3
write(*,1000) f0,xdt,hmod,txt,snrdb
1000 format('f0:',f9.3,' DT:',f6.2,' hmod:',f6.3,' TxT:',f6.1,' SNR:',f6.1)
write(*,*)
if(i3.eq.1) then
write(*,*) ' mycall hiscall hisgrid'
write(*,'(28i1,1x,i1,1x,28i1,1x,i1,1x,i1,1x,15i1,1x,3i1)') msgbits(1:77)
else
write(*,'(a14)') 'Message bits: '
write(*,'(50i1,1x,24i1)') msgbits
endif
write(*,*)
write(*,'(a17)') 'Channel symbols: '
write(*,'(10i1)') itone
write(*,*)
call sgran()
fsample=12000.0
icmplx=1
call gen_wspr4wave(itone,NN,NSPS,fsample,hmod,f0,c0,wave,icmplx,NMAX)
k=nint((xdt+1.0)/dt)-NSPS
c0=cshift(c0,-k)
if(k.gt.0) c0(0:k-1)=0.0
if(k.lt.0) c0(NMAX+k:NMAX-1)=0.0
do ifile=1,nfiles
c=c0
if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c,NMAX,NZ,fs,delay,fspread)
c=sig*c
wave=real(c)
if(snrdb.lt.90) then
do i=1,NMAX !Add gaussian noise at specified SNR
xnoise=gran()
wave(i)=wave(i) + xnoise
enddo
endif
gain=100.0
if(snrdb.lt.90.0) then
wave=gain*wave
else
datpk=maxval(abs(wave))
fac=32766.9/datpk
wave=fac*wave
endif
if(any(abs(wave).gt.32767.0)) print*,"Warning - data will be clipped."
iwave=nint(wave)
h=default_header(12000,NMAX)
write(fname,1102) ifile
1102 format('000000_',i6.6,'.wav')
open(10,file=fname,status='unknown',access='stream')
write(10) h,iwave !Save to *.wav file
close(10)
write(*,1110) ifile,xdt,f0,snrdb,fname
1110 format(i4,f7.2,f8.2,f7.1,2x,a17)
enddo
999 end program ft4slowsim

68
lib/fsk4hf/gen_wspr4wave.f90
View File

@ -1,68 +0,0 @@
subroutine gen_wspr4wave(itone,nsym,nsps,fsample,hmod,f0,cwave,wave,icmplx,nwave)
real wave(nwave)
complex cwave(nwave)
real, allocatable, save :: pulse(:)
real, allocatable :: dphi(:)
integer itone(nsym)
logical first
data first/.true./
save pulse,first,twopi,dt,tsym
if(first) then
allocate( pulse(3*nsps*fsample) )
twopi=8.0*atan(1.0)
dt=1.0/fsample
tsym=nsps/fsample
! Compute the smoothed frequency-deviation pulse
do i=1,3*nsps
tt=(i-1.5*nsps)/real(nsps)
pulse(i)=gfsk_pulse(4.0,tt)
enddo
first=.false.
endif
! Compute the smoothed frequency waveform.
! Length = (nsym+2)*nsps samples, zero-padded
allocate( dphi(0:(nsym+2)*nsps-1) )
dphi_peak=twopi*hmod/real(nsps)
dphi=0.0
do j=1,nsym
ib=(j-1)*nsps
ie=ib+3*nsps-1
dphi(ib:ie) = dphi(ib:ie) + dphi_peak*pulse(1:3*nsps)*itone(j)
enddo
! Calculate and insert the audio waveform
phi=0.0
dphi = dphi + twopi*(f0-1.5*hmod/tsym)*dt !Shift frequency up by f0
wave=0.
if(icmplx.eq.1) cwave=0.
k=0
do j=0,(nsym+2)*nsps-1
k=k+1
if(icmplx.eq.0) then
wave(k)=sin(phi)
else
cwave(k)=cmplx(cos(phi),sin(phi))
endif
phi=mod(phi+dphi(j),twopi)
enddo
! Compute the ramp-up and ramp-down symbols
if(icmplx.eq.0) then
wave(1:nsps)=wave(1:nsps) * &
(1.0-cos(twopi*(/(i,i=0,nsps-1)/)/(2.0*nsps)))/2.0
k1=(nsym+1)*nsps+1
wave(k1:k1+nsps-1)=wave(k1:k1+nsps-1) * &
(1.0+cos(twopi*(/(i,i=0,nsps-1)/)/(2.0*nsps)))/2.0
else
cwave(1:nsps)=cwave(1:nsps) * &
(1.0-cos(twopi*(/(i,i=0,nsps-1)/)/(2.0*nsps)))/2.0
k1=(nsym+1)*nsps+1
cwave(k1:k1+nsps-1)=cwave(k1:k1+nsps-1) * &
(1.0+cos(twopi*(/(i,i=0,nsps-1)/)/(2.0*nsps)))/2.0
endif
return
end subroutine gen_wspr4wave

44
lib/fsk4hf/genbpsk.f90
View File

@ -1,44 +0,0 @@
subroutine genbpsk(id,f00,ndiff,nref,c)
parameter (ND=121) !Data symbols: LDPC (120,60), r=1/2
parameter (NN=ND) !Total symbols (121)
parameter (NSPS=28800) !Samples per symbol at 12000 sps
parameter (NZ=NSPS*NN) !Samples in waveform (3456000)
complex c(0:NZ-1) !Complex waveform
real*8 twopi,dt,fs,baud,f0,dphi,phi
integer id(NN) !Encoded NRZ data (values +/-1)
integer ie(NN) !Differentially encoded data
f0=f00
twopi=8.d0*atan(1.d0)
fs=12000.d0
dt=1.0/fs
baud=1.d0/(NSPS*dt)
if(ndiff.ne.0) then
ie(1)=1 !First bit is always 1
do i=2,NN !Differentially encode
ie(i)=id(i)*ie(i-1)
enddo
endif
! Generate the BPSK waveform
phi=0.d0
k=-1
do j=1,NN
dphi=twopi*f0*dt
x=id(j)
if(ndiff.ne.0) x=ie(j) !Differential
if(nref.ne.0) x=1.0 !Generate reference carrier
do i=1,NSPS
k=k+1
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
c(k)=x*cmplx(cos(xphi),sin(xphi))
enddo
enddo
return
end subroutine genbpsk

36
lib/fsk4hf/genfsk4.f90
View File

@ -1,36 +0,0 @@
subroutine genfsk4(id,f00,nts,c)
parameter (ND=60) !Data symbols: LDPC (120,60), r=1/2
parameter (NN=ND) !Total symbols (60)
parameter (NSPS=57600) !Samples per symbol at 12000 sps
parameter (NZ=NSPS*NN) !Samples in waveform (3456000)
parameter (NFFT=NZ) !Full length FFT
complex c(0:NFFT-1) !Complex waveform
real*8 twopi,dt,fs,baud,f0,dphi,phi
integer id(NN) !Encoded 2-bit data (values 0-3)
f0=f00
twopi=8.d0*atan(1.d0)
fs=12000.d0
dt=1.0/fs
baud=1.d0/(NSPS*dt)
! Generate the 4-FSK waveform
x=0.
c=0.
phi=0.d0
k=-1
do j=1,NN
dphi=twopi*(f0 + nts*id(j)*baud)*dt
do i=1,NSPS
k=k+1
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
c(k)=cmplx(cos(xphi),sin(xphi))
enddo
enddo
return
end subroutine genfsk4

51
lib/fsk4hf/genfsk4hf.f90
View File

@ -1,51 +0,0 @@
subroutine genfsk4hf(msgbits,f0,id,c)
parameter (KK=84) !Information bits (72 + CRC12)
parameter (ND=84) !Data symbols: LDPC (168,84), r=1/2
parameter (NS=12) !Sync symbols (3 @ 4x4 Costas arrays)
parameter (NR=2) !Ramp up/down
parameter (NN=NR+NS+ND) !Total symbols (98)
parameter (NSPS=2688/84) !Samples per symbol (32)
parameter (NZ=NSPS*NN) !Samples in baseband waveform (3136)
complex c(0:NZ-1) !Complex waveform
integer id0(NN) !2-bit data (values 0-3), all symbols
integer id(ND) !2-bit data (values 0-3), data only
integer*1 msgbits(KK),codeword(2*ND)
integer icos4(4) !4x4 Costas array
data icos4/0,1,3,2/
twopi=8.0*atan(1.0)
fs=12000.0/84.0
dt=1.0/fs
baud=1.0/(NSPS*dt)
call encode168(msgbits,codeword) !Encode the test message
id0(1)=0 !Ramp-up
id0(2:5)=icos4 !First Costas array
id0(48:51)=icos4 !Second
id0(94:97)=icos4 !Third
id0(98)=0 !Ramp down
j=5
do i=1,84 !Data symbols
id(i)=2*codeword(2*i-1) + codeword(2*i)
j=j+1
if(i.eq.43) j=j+4
id0(j)=id(i)
enddo
! Generate the 4-FSK waveform, low tone at f=0
c=0.
phi=0.d0
k=-1
do j=1,NN
dphi=twopi*(f0+id0(j)*baud)*dt
do i=1,NSPS
k=k+1
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
c(k)=cmplx(cos(phi),sin(phi))
enddo
enddo
return
end subroutine genfsk4hf

86
lib/fsk4hf/genft2.f90
View File

@ -1,86 +0,0 @@
subroutine genft2(msg0,ichk,msgsent,i4tone,itype)
! s8 + 48bits + s8 + 80 bits = 144 bits (72ms message duration)
!
! Encode an MSK144 message
! Input:
! - msg0 requested message to be transmitted
! - ichk if ichk=1, return only msgsent
! if ichk.ge.10000, set imsg=ichk-10000 for short msg
! - msgsent message as it will be decoded
! - i4tone array of audio tone values, 0 or 1
! - itype message type
! 1 = 77 bit message
! 7 = 16 bit message "<Call_1 Call2> Rpt"
use iso_c_binding, only: c_loc,c_size_t
use packjt77
character*37 msg0
character*37 message !Message to be generated
character*37 msgsent !Message as it will be received
character*77 c77
integer*4 i4tone(144)
integer*1 codeword(128)
integer*1 msgbits(77)
integer*1 bitseq(144) !Tone #s, data and sync (values 0-1)
integer*1 s16(16)
real*8 xi(864),xq(864),pi,twopi
data s16/0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0/
equivalence (ihash,i1hash)
logical unpk77_success
nsym=128
pi=4.0*atan(1.0)
twopi=8.*atan(1.0)
message(1:37)=' '
itype=1
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, 37
if(ichar(message(i:i)).eq.0) then
message(i:37)=' '
exit
endif
enddo
do i=1,37 !Strip leading blanks
if(message(1:1).ne.' ') exit
message=message(i+1:)
enddo
if(message(1:1).eq.'<') then
i2=index(message,'>')
i1=0
if(i2.gt.0) i1=index(message(1:i2),' ')
if(i1.gt.0) then
call genmsk40(message,msgsent,ichk,i4tone,itype)
if(itype.lt.0) go to 999
i4tone(41)=-40
go to 999
endif
endif
i3=-1
n3=-1
call pack77(message,i3,n3,c77)
call unpack77(c77,0,msgsent,unpk77_success) !Unpack to get msgsent
if(ichk.eq.1) go to 999
read(c77,"(77i1)") msgbits
call encode_128_90(msgbits,codeword)
!Create 144-bit channel vector:
bitseq=0
bitseq(1:16)=s16
bitseq(17:144)=codeword
i4tone=bitseq
endif
999 return
end subroutine genft2

95
lib/fsk4hf/genft280.f90
View File

@ -1,95 +0,0 @@
subroutine genft280(msg0,ichk,msgsent,msgbits,i4tone)
! Encode an FT4 message
! Input:
! - msg0 requested message to be transmitted
! - ichk if ichk=1, return only msgsent
! - msgsent message as it will be decoded
! - i4tone array of audio tone values, {0,1,2,3}
! Frame structure:
! s4s4 d70 s4s4 d70 s4s4
! Message duration: TxT = 144*9600/12000 = 115.2 s
use packjt77
include 'ft4s280_params.f90'
character*37 msg0
character*37 message !Message to be generated
character*37 msgsent !Message as it will be received
character*77 c77
character*24 c24
integer*4 i4tone(NN),itmp(ND)
integer*1 codeword(2*ND)
integer*1 msgbits(101),rvec(77)
integer icos4a(4),icos4b(4),icos4c(4),icos4d(4),icos4e(4),icos4f(4)
integer ncrc24
logical unpk77_success
data icos4a/0,1,3,2/
data icos4b/1,0,2,3/
data icos4c/2,3,1,0/
data icos4d/3,2,0,1/
data icos4e/0,2,3,1/
data icos4f/1,2,0,3/
data rvec/0,1,0,0,1,0,1,0,0,1,0,1,1,1,1,0,1,0,0,0,1,0,0,1,1,0,1,1,0, &
1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,1,0,1,0,0,1,1,1,1,0,0,1,0,1, &
0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/
message=msg0
do i=1, 37
if(ichar(message(i:i)).eq.0) then
message(i:37)=' '
exit
endif
enddo
do i=1,37 !Strip leading blanks
if(message(1:1).ne.' ') exit
message=message(i+1:)
enddo
i3=-1
n3=-1
call pack77(message,i3,n3,c77)
call unpack77(c77,0,msgsent,unpk77_success) !Unpack to get msgsent
msgbits=0
read(c77,'(77i1)') msgbits(1:77)
call get_crc24(msgbits,101,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') msgbits(78:101)
if(ichk.eq.1) go to 999
if(unpk77_success) go to 2
1 msgbits=0
itone=0
msgsent='*** bad message *** '
go to 999
entry get_ft4s280_tones_from_101bits(msgbits,i4tone)
2 call encode280_101(msgbits,codeword)
! Grayscale mapping:
! bits tone
! 00 0
! 01 1
! 11 2
! 10 3
do i=1,ND
is=codeword(2*i)+2*codeword(2*i-1)
if(is.le.1) itmp(i)=is
if(is.eq.2) itmp(i)=3
if(is.eq.3) itmp(i)=2
enddo
i4tone(1:4)=icos4a
i4tone(5:8)=icos4b
i4tone(9:78)=itmp(1:70)
i4tone(79:82)=icos4a
i4tone(83:86)=icos4b
i4tone(87:156)=itmp(71:140)
i4tone(157:160)=icos4a
i4tone(161:164)=icos4b
999 return
end subroutine genft280

98
lib/fsk4hf/genft4slow.f90
View File

@ -1,98 +0,0 @@
subroutine genft4slow(msg0,ichk,msgsent,msgbits,i4tone)
! Encode an FT4 message
! Input:
! - msg0 requested message to be transmitted
! - ichk if ichk=1, return only msgsent
! - msgsent message as it will be decoded
! - i4tone array of audio tone values, {0,1,2,3}
! Frame structure:
! s4 d24 s4 d24 s4 d24 s4 d24 s4 d24 s4
! Message duration: TxT = 144*9600/12000 = 115.2 s
use packjt77
include 'ft4s_params.f90'
character*37 msg0
character*37 message !Message to be generated
character*37 msgsent !Message as it will be received
character*77 c77
character*24 c24
integer*4 i4tone(NN),itmp(ND)
integer*1 codeword(2*ND)
integer*1 msgbits(101),rvec(77)
integer icos4a(4),icos4b(4),icos4c(4),icos4d(4),icos4e(4),icos4f(4)
integer ncrc24
logical unpk77_success
data icos4a/0,1,3,2/
data icos4b/1,0,2,3/
data icos4c/2,3,1,0/
data icos4d/3,2,0,1/
data icos4e/0,2,3,1/
data icos4f/1,2,0,3/
data rvec/0,1,0,0,1,0,1,0,0,1,0,1,1,1,1,0,1,0,0,0,1,0,0,1,1,0,1,1,0, &
1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,1,0,1,0,0,1,1,1,1,0,0,1,0,1, &
0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/
message=msg0
do i=1, 37
if(ichar(message(i:i)).eq.0) then
message(i:37)=' '
exit
endif
enddo
do i=1,37 !Strip leading blanks
if(message(1:1).ne.' ') exit
message=message(i+1:)
enddo
i3=-1
n3=-1
call pack77(message,i3,n3,c77)
call unpack77(c77,0,msgsent,unpk77_success) !Unpack to get msgsent
msgbits=0
read(c77,'(77i1)') msgbits(1:77)
call get_crc24(msgbits,101,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') msgbits(78:101)
if(ichk.eq.1) go to 999
if(unpk77_success) go to 2
1 msgbits=0
itone=0
msgsent='*** bad message *** '
go to 999
entry get_ft4slow_tones_from_101bits(msgbits,i4tone)
2 call encode240_101(msgbits,codeword)
! Grayscale mapping:
! bits tone
! 00 0
! 01 1
! 11 2
! 10 3
do i=1,ND
is=codeword(2*i)+2*codeword(2*i-1)
if(is.le.1) itmp(i)=is
if(is.eq.2) itmp(i)=3
if(is.eq.3) itmp(i)=2
enddo
i4tone(1:4)=icos4a
i4tone(5:28)=itmp(1:24)
i4tone(29:32)=icos4b
i4tone(33:56)=itmp(25:48)
i4tone(57:60)=icos4c
i4tone(61:84)=itmp(49:72)
i4tone(85:88)=icos4d
i4tone(89:112)=itmp(73:96)
i4tone(113:116)=icos4e
i4tone(117:140)=itmp(97:120)
i4tone(141:144)=icos4f
999 return
end subroutine genft4slow

126
lib/fsk4hf/genmskhf.f90
View File

@ -1,126 +0,0 @@
subroutine genmskhf(msgbits,id,icw,cbb,csync)
!Encode an MSK-HF message, produce baseband waveform and sync vector.
parameter (KK=84) !Information bits (72 + CRC12)
parameter (ND=168) !Data symbols: LDPC (168,84), r=1/2
parameter (NS=65) !Sync symbols (2 x 26 + Barker 13)
parameter (NR=3) !Ramp up/down
parameter (NN=NR+NS+ND) !Total symbols (236)
parameter (NSPS=16) !Samples per MSK symbol (16)
parameter (N2=2*NSPS) !Samples per OQPSK symbol (32)
parameter (NZ=NSPS*NN) !Samples in baseband waveform (3760)
complex cbb(0:NZ-1)
complex csync(0:NZ-1)
real x(0:NZ-1)
real y(0:NZ-1)
real pp(N2)
logical first
integer*1 msgbits(KK),codeword(ND)
integer icw(ND)
integer id(NS+ND)
integer isync(26) !Long sync vector
integer ib13(13) !Barker 13 code
data ib13/1,1,1,1,1,-1,-1,1,1,-1,1,-1,1/
data first/.true./
save first,isync,twopi,pp
if(first) then
n=z'2c1aeb1'
do i=1,26
isync(i)=-1
if(iand(n,1).eq.1) isync(i)=1
n=n/2
enddo
twopi=8.0*atan(1.0)
do i=1,N2 !Half-sine shaped pulse
pp(i)=sin(0.5*(i-1)*twopi/N2)
enddo
first=.false.
endif
call encode168(msgbits,codeword) !Encode the test message
icw=2*codeword - 1
! Message structure: R1 26*(S1+D1) S13 26*(D1+S1) R1
! Generate QPSK without any offset; then shift the y array to get OQPSK.
! Do the I channel first: results in array x
n=0
k=0
ia=0
ib=NSPS-1
x(ia:ib)=0. !Ramp up (half-symbol; shape TBD)
do j=1,26 !Insert group of 26*(S1+D1)
ia=ib+1
ib=ia+N2-1
n=n+1
id(n)=2*isync(j)
x(ia:ib)=isync(j)*pp !Insert Sync bit
ia=ib+1
ib=ia+N2-1
k=k+1
n=n+1
id(n)=icw(k)
x(ia:ib)=id(n)*pp !Insert data bit
enddo
do j=1,13 !Insert Barker 13 code
ia=ib+1
ib=ia+N2-1
n=n+1
id(n)=2*ib13(j)
x(ia:ib)=ib13(j)*pp
enddo
do j=1,26 !Insert group of 26*(S1+D1)
ia=ib+1
ib=ia+N2-1
k=k+1
n=n+1
id(n)=icw(k)
x(ia:ib)=id(n)*pp !Insert data bit
ia=ib+1
ib=ia+N2-1
n=n+1
id(n)=2*isync(j)
x(ia:ib)=isync(j)*pp !Insert Sync bit
enddo
ia=ib+1
ib=ia+NSPS-1
x(ia:ib)=0. !Ramp down (half-symbol; shape TBD)
! Now do the Q channel: results in array y
ia=0
ib=NSPS-1
y(ia:ib)=0. !Ramp up (half-symbol; shape TBD)
do j=1,116
ia=ib+1
ib=ia+N2-1
k=k+1
n=n+1
id(n)=icw(k)
y(ia:ib)=id(n)*pp
enddo
ia=ib+1
ib=ia+NSPS-1
y(ia:ib)=0. !Ramp down (half-symbol; shape TBD)
y=cshift(y,-NSPS) !Shift Q array to get OQPSK
cbb=cmplx(x,y) !Complex baseband waveform
ib=NSPS-1
ib2=NSPS-1+64*N2
do j=1,26 !Zero all data symbols in x
ia=ib+1+N2
ib=ia+N2-1
x(ia:ib)=0.
ia2=ib2+1+N2
ib2=ia2+N2-1
x(ia2:ib2)=0.
enddo
csync=x
return
end subroutine genmskhf

95
lib/fsk4hf/genwspr4.f90
View File

@ -1,95 +0,0 @@
subroutine genwspr4(msg0,ichk,msgsent,msgbits,i4tone)
! Encode an FT4 message
! Input:
! - msg0 requested message to be transmitted
! - ichk if ichk=1, return only msgsent
! - msgsent message as it will be decoded
! - i4tone array of audio tone values, {0,1,2,3}
! Frame structure:
! s16 + 87symbols + 2 ramp up/down = 105 total channel symbols
! r1 + s4 + d29 + s4 + d29 + s4 + d29 + s4 + r1
! Message duration: TxT = 105*13312/12000 = 116.48 s
! use iso_c_binding, only: c_loc,c_size_t
use packjt77
include 'wspr4_params.f90'
character*37 msg0
character*37 message !Message to be generated
character*37 msgsent !Message as it will be received
character*77 c77
character*24 c24
integer*4 i4tone(NN),itmp(ND)
integer*1 codeword(2*ND)
integer*1 msgbits(74),rvec(77)
integer icos4a(4),icos4b(4),icos4c(4),icos4d(4)
integer ncrc24
logical unpk77_success
data icos4a/0,1,3,2/
data icos4b/1,0,2,3/
data icos4c/2,3,1,0/
data icos4d/3,2,0,1/
data rvec/0,1,0,0,1,0,1,0,0,1,0,1,1,1,1,0,1,0,0,0,1,0,0,1,1,0,1,1,0, &
1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,1,0,1,0,0,1,1,1,1,0,0,1,0,1, &
0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/
message=msg0
do i=1, 37
if(ichar(message(i:i)).eq.0) then
message(i:37)=' '
exit
endif
enddo
do i=1,37 !Strip leading blanks
if(message(1:1).ne.' ') exit
message=message(i+1:)
enddo
i3=-1
n3=-1
call pack77(message,i3,n3,c77)
call unpack77(c77,0,msgsent,unpk77_success) !Unpack to get msgsent
msgbits=0
read(c77,'(50i1)') msgbits(1:50)
call get_crc24(msgbits,74,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') msgbits(51:74)
if(ichk.eq.1) go to 999
if(unpk77_success) go to 2
1 msgbits=0
itone=0
msgsent='*** bad message *** '
go to 999
entry get_wspr4_tones_from_74bits(msgbits,i4tone)
2 call encode174_74(msgbits,codeword)
! Grayscale mapping:
! bits tone
! 00 0
! 01 1
! 11 2
! 10 3
do i=1,ND
is=codeword(2*i)+2*codeword(2*i-1)
if(is.le.1) itmp(i)=is
if(is.eq.2) itmp(i)=3
if(is.eq.3) itmp(i)=2
enddo
i4tone(1:4)=icos4a
i4tone(5:33)=itmp(1:29)
i4tone(34:37)=icos4b
i4tone(38:66)=itmp(30:58)
i4tone(67:70)=icos4c
i4tone(71:99)=itmp(59:87)
i4tone(100:103)=icos4d
999 return
end subroutine genwspr4

107
lib/fsk4hf/genwspr5.f90
View File

@ -1,107 +0,0 @@
subroutine genwspr5(msg,msgsent,itone)
! Encode a WSPR-LF message, producing array itone().
use crc
include 'wsprlf_params.f90'
character*22 msg,msgsent
character*60 cbits
integer*1,target :: idat(9)
integer*1 msgbits(KK),codeword(ND)
logical first
integer icw(ND)
integer id(NS+ND)
integer jd(NS+ND)
integer isync(48) !Long sync vector
integer ib13(13) !Barker 13 code
integer itone(NN)
integer*8 n8
data ib13/1,1,1,1,1,-1,-1,1,1,-1,1,-1,1/
data first/.true./
save first,isync
if(first) then
n8=z'cbf089223a51'
do i=1,48
isync(i)=-1
if(iand(n8,1).eq.1) isync(i)=1
n8=n8/2
enddo
first=.false.
endif
idat=0
call wqencode(msg,ntype0,idat) !Source encoding
id7=idat(7)
if(id7.lt.0) id7=id7+256
id7=id7/64
icrc=crc10(c_loc(idat),9) !Compute the 10-bit CRC
idat(8)=icrc/256 !Insert CRC into idat(8:9)
idat(9)=iand(icrc,255)
call wqdecode(idat,msgsent,itype)
write(cbits,1004) idat(1:6),id7,icrc
1004 format(6b8.8,b2.2,b10.10)
read(cbits,1006) msgbits
1006 format(60i1)
! call chkcrc10(msgbits,nbadcrc)
! print*,msgsent,itype,crc10_check(c_loc(idat),9),nbadcrc
call encode300(msgbits,codeword) !Encode the test message
icw=2*codeword - 1 !NRZ codeword
! Message structure:
! I channel: R1 48*(S1+D1) S13 48*(D1+S1) R1
! Q channel: R1 D204 R1
! Generate QPSK with no offset, then shift the y array to get OQPSK.
! I channel:
n=0
k=0
do j=1,48 !Insert group of 48*(S1+D1)
n=n+1
id(n)=2*isync(j)
k=k+1
n=n+1
id(n)=icw(k)
enddo
do j=1,13 !Insert Barker 13 code
n=n+1
id(n)=2*ib13(j)
enddo
do j=1,48 !Insert group of 48*(S1+D1)
k=k+1
n=n+1
id(n)=icw(k)
n=n+1
id(n)=2*isync(j)
enddo
! Q channel
do j=1,204
k=k+1
n=n+1
id(n)=icw(k)
enddo
! Map I and Q to tones.
n=0
jz=(NS+ND+1)/2
do j=1,jz-1
jd(2*j-1)=id(j)/abs(id(j))
jd(2*j)=id(j+jz)/abs(id(j+jz))
enddo
jd(NS+ND)=id(jz)/abs(id(jz))
itone=0
do j=1,jz-1
itone(2*j+1)=(jd(2*j)*jd(2*j-1)+1)/2;
itone(2*j+2)=-(jd(2*j)*jd(2*j+1)-1)/2;
enddo
itone(NS+ND+2)=jd(NS+ND) !### Is this correct ??? ###
return
end subroutine genwspr5

45
lib/fsk4hf/genwspr_fsk8.f90
View File

@ -1,45 +0,0 @@
subroutine genwspr_fsk8(msg,msgsent,itone)
! Encode a WSPR-LF 8-FSK message, producing array itone().
use crc
include 'wspr_fsk8_params.f90'
character*22 msg,msgsent
character*60 cbits
integer*1,target :: idat(9)
integer*1 msgbits(KK),codeword(3*ND)
integer itone(NN)
integer icos7(0:6)
data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern
idat=0
call wqencode(msg,ntype0,idat) !Source encoding
id7=idat(7)
if(id7.lt.0) id7=id7+256
id7=id7/64
icrc=crc10(c_loc(idat),9) !Compute the 10-bit CRC
idat(8)=icrc/256 !Insert CRC into idat(8:9)
idat(9)=iand(icrc,255)
call wqdecode(idat,msgsent,itype)
write(cbits,1004) idat(1:6),id7,icrc
1004 format(6b8.8,b2.2,b10.10)
read(cbits,1006) msgbits
1006 format(60i1)
! call chkcrc10(msgbits,nbadcrc)
! print*,msgsent,itype,crc10_check(c_loc(idat),9),nbadcrc
call encode300(msgbits,codeword) !Encode the test message
! Message structure: S7 D100 S7
itone(1:7)=icos7
itone(NN-6:NN)=icos7
do j=1,ND
i=3*j -2
itone(j+7)=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2)
enddo
return
end subroutine genwspr_fsk8

76
lib/fsk4hf/genwsprcpm.f90
View File

@ -1,76 +0,0 @@
subroutine genwsprcpm(msg,msgsent,itone)
! Encode a WSPRCPM message, producing array itone().
!
use crc
include 'wsprcpm_params.f90'
character*22 msg,msgsent
character*64 cbits
character*32 sbits
character c1*1,c4*4
character*31 cseq
integer*1,target :: idat(9)
integer*1 msgbits(68),codeword(ND)
logical first
integer icw(ND)
integer id(NS+ND)
integer jd(NS+ND)
! integer ipreamble(16) !Freq estimation preamble
integer isyncword(16)
integer isync(200) !Long sync vector
integer itone(NN)
data cseq /'9D9F C48B 797A DD60 58CB 2EBC 6'/
! data ipreamble/1,1,1,1,0,0,0,0,0,0,0,0,1,1,1,1/
data isyncword/0,1,3,2,1,0,2,3,2,3,1,0,3,2,0,1/
data first/.true./
save first,isync,ipreamble,isyncword
if(first) then
k=0
do i=1,31
c1=cseq(i:i)
if(c1.eq.' ') cycle
read(c1,'(z1)') n
write(c4,'(b4.4)') n
do j=1,4
k=k+1
isync(k)=0
if(c4(j:j).eq.'1') isync(k)=1
enddo
isync(101:200)=isync(1:100)
enddo
first=.false.
endif
idat=0
call wqencode(msg,ntype0,idat) !Source encoding
id7=idat(7)
if(id7.lt.0) id7=id7+256
id7=id7/64
write(*,*) 'idat ',idat
icrc=crc14(c_loc(idat),9)
write(*,*) 'icrc: ',icrc
write(*,'(a6,b16.16)') 'icrc: ',icrc
call wqdecode(idat,msgsent,itype)
print*,msgsent,itype
write(cbits,1004) idat(1:6),id7,iand(icrc,z'3FFF')
1004 format(6b8.8,b2.2,b14.14)
msgbits=0
read(cbits,1006) msgbits(1:64)
1006 format(64i1)
write(*,'(50i1,1x,14i1,1x,4i1)') msgbits
call encode204(msgbits,codeword) !Encode the test message
! Message structure:
! d100 p16 d100
itone(1:100)=isync(1:100)+2*codeword(1:100)
itone(101:116)=isyncword
itone(117:216)=isync(101:200)+2*codeword(101:200)
itone=2*itone-3
return
end subroutine genwsprcpm

63
lib/fsk4hf/genwsprdpsk.f90
View File

@ -1,63 +0,0 @@
subroutine genwsprdpsk(msg,msgsent,imsgde)
! Encode a WSPRDPSK message, producing array txwave().
!
use crc
include 'wsprdpsk_params.f90'
character*22 msg,msgsent
character*64 cbits
character*32 sbits
integer iuniqueword0
integer*1,target :: idat(9)
integer*1 msgbits(68),codeword(ND)
logical first
integer ipreamble(16) !Freq estimation preamble
integer isync(32) !Long sync vector
integer imsg(NN),imsgde(NN)
data ipreamble/1,1,1,1,0,0,0,0,0,0,0,0,1,1,1,1/
data first/.true./
data iuniqueword0/z'30C9E8AD'/
save first,isync,ipreamble
if(first) then
write(sbits,'(b32.32)') iuniqueword0
read(sbits,'(32i1)') isync(1:32)
first=.false.
endif
idat=0
call wqencode(msg,ntype0,idat) !Source encoding
id7=idat(7)
if(id7.lt.0) id7=id7+256
id7=id7/64
write(*,*) 'idat ',idat
icrc=crc14(c_loc(idat),9)
write(*,*) 'icrc: ',icrc
write(*,'(a6,b16.16)') 'icrc: ',icrc
call wqdecode(idat,msgsent,itype)
print*,msgsent,itype
write(cbits,1004) idat(1:6),id7,iand(icrc,z'3FFF')
1004 format(6b8.8,b2.2,b14.14)
msgbits=0
read(cbits,1006) msgbits(1:64)
1006 format(64i1)
write(*,'(50i1,1x,14i1,1x,4i1)') msgbits
call encode204(msgbits,codeword) !Encode the test message
imsg(1)=1 !reference bit
imsg(2:101)=codeword(1:100)
imsg(102:132)=isync(1:31) !only use 31 of the sync bits
imsg(133:232)=codeword(101:200)
write(*,'(232i1)') imsg(1:232)
imsgde(1)=1
do i=2,232
imsgde(i)=mod(imsgde(i-1)+imsg(i),2)
enddo
write(*,*) '-------------'
write(*,'(232i1)') imsgde(1:232)
return
end subroutine genwsprdpsk

137
lib/fsk4hf/genwsprlf.f90
View File

@ -1,137 +0,0 @@
subroutine genwsprlf(msgbits,id,icw,cbb,csync,itone)
!Encode a WSPR-LF message, produce baseband waveform and sync vector.
include 'wsprlf_params.f90'
complex cbb(0:NZ-1)
complex csync(0:NZ-1)
real x(0:NZ-1)
real y(0:NZ-1)
real pp(N2)
logical first
integer*1 msgbits(KK),codeword(ND)
integer icw(ND)
integer id(NS+ND)
integer jd(NS+ND)
integer isync(48) !Long sync vector
integer ib13(13) !Barker 13 code
integer itone(NN)
integer*8 n8
data ib13/1,1,1,1,1,-1,-1,1,1,-1,1,-1,1/
data first/.true./
save first,isync,twopi,pp
if(first) then
n8=z'cbf089223a51'
do i=1,48
isync(i)=-1
if(iand(n8,1).eq.1) isync(i)=1
n8=n8/2
enddo
twopi=8.0*atan(1.0)
do i=1,N2 !Half-sine shaped pulse
pp(i)=sin(0.5*(i-1)*twopi/N2)
enddo
first=.false.
endif
call encode300(msgbits,codeword) !Encode the test message
icw=2*codeword - 1
! Message structure: R1 48*(S1+D1) S13 48*(D1+S1) R1
! Generate QPSK without any offset; then shift the y array to get OQPSK.
! Do the I channel first: results in array x
n=0
k=0
ia=0
ib=NSPS-1
x(ia:ib)=0. !Ramp up (half-symbol; shape TBD)
do j=1,48 !Insert group of 48*(S1+D1)
ia=ib+1
ib=ia+N2-1
n=n+1
id(n)=2*isync(j)
x(ia:ib)=isync(j)*pp !Insert Sync bit
ia=ib+1
ib=ia+N2-1
k=k+1
n=n+1
id(n)=icw(k)
x(ia:ib)=id(n)*pp !Insert data bit
enddo
do j=1,13 !Insert Barker 13 code
ia=ib+1
ib=ia+N2-1
n=n+1
id(n)=2*ib13(j)
x(ia:ib)=ib13(j)*pp
enddo
do j=1,48 !Insert group of 48*(S1+D1)
ia=ib+1
ib=ia+N2-1
k=k+1
n=n+1
id(n)=icw(k)
x(ia:ib)=id(n)*pp !Insert data bit
ia=ib+1
ib=ia+N2-1
n=n+1
id(n)=2*isync(j)
x(ia:ib)=isync(j)*pp !Insert Sync bit
enddo
ia=ib+1
ib=ia+NSPS-1
x(ia:ib)=0. !Ramp down (half-symbol; shape TBD)
! Now do the Q channel: results in array y
ia=0
ib=NSPS-1
y(ia:ib)=0. !Ramp up (half-symbol; shape TBD)
do j=1,204
ia=ib+1
ib=ia+N2-1
k=k+1
n=n+1
id(n)=icw(k)
y(ia:ib)=id(n)*pp
enddo
ia=ib+1
ib=ia+NSPS-1
y(ia:ib)=0. !Ramp down (half-symbol; shape TBD)
y=cshift(y,-NSPS) !Shift Q array to get OQPSK
cbb=cmplx(x,y) !Complex baseband waveform
ib=NSPS-1
ib2=NSPS-1+64*N2
do j=1,48 !Zero all data symbols in x
ia=ib+1+N2
ib=ia+N2-1
x(ia:ib)=0.
ia2=ib2+1+N2
ib2=ia2+N2-1
x(ia2:ib2)=0.
enddo
csync=x
! Map I and Q to tones.
n=0
jz=(NS+ND+1)/2
do j=1,jz-1
jd(2*j-1)=id(j)/abs(id(j))
jd(2*j)=id(j+jz)/abs(id(j+jz))
enddo
jd(NS+ND)=id(jz)/abs(id(jz))
itone=0
do j=1,jz-1
itone(2*j-1)=(jd(2*j)*jd(2*j-1)+1)/2;
itone(2*j)=-(jd(2*j)*jd(2*j+1)-1)/2;
enddo
itone(NS+ND)=jd(NS+ND) !### Is this correct ??? ###
return
end subroutine genwsprlf

25
lib/fsk4hf/get_crc24.f90
View File

@ -1,25 +0,0 @@
subroutine get_crc24(mc,len,ncrc)
!
! 1. To calculate 24-bit CRC, mc(1:len-24) is the message and mc(len-23:len) are zero.
! 2. To check a received CRC, mc(1:len) is the received message plus CRC.
! ncrc will be zero if the received message/CRC are consistent.
!
character c24*24
integer*1 mc(len)
integer*1 r(25),p(25)
integer ncrc
! polynomial for 24-bit CRC 0x100065b
data p/1,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,0,1,1,0,1,1/
! divide by polynomial
r=mc(1:25)
do i=0,len-25
r(25)=mc(i+25)
r=mod(r+r(1)*p,2)
r=cshift(r,1)
enddo
write(c24,'(24b1)') r(1:24)
read(c24,'(b24.24)') ncrc
end subroutine get_crc24

117
lib/fsk4hf/get_ft280_bitmetrics.f90
View File

@ -1,117 +0,0 @@
subroutine get_ft280_bitmetrics(cd,hmod,bitmetrics,badsync)
include 'ft4s280_params.f90'
parameter (NSS=20)
complex cd(0:NN*NSS-1)
complex cs(0:3,NN)
complex csymb(NSS)
complex c1(NSS,0:3) ! ideal waveforms, 20 samples per symbol, 4 tones
complex ccor(0:3,NN) ! correlations with each ideal waveform, for each symbol
complex cp(0:3) ! accumulated phase shift over symbol types 0:3
complex csum,cterm
integer icos8(0:7)
integer graymap(0:3)
integer ip(1)
logical one(0:65535,0:15) ! 65536 8-symbol sequences, 16 bits
logical first
logical badsync
real bitmetrics(2*NN,4)
real s2(0:65535)
real s4(0:3,NN)
data icos8/0,1,3,2,1,0,2,3/
data graymap/0,1,3,2/
data first/.true./
save first,one,c1,cp
if(first) then
one=.false.
do i=0,65535
do j=0,15
if(iand(i,2**j).ne.0) one(i,j)=.true.
enddo
enddo
twopi=8.0*atan(1.0)
dphi=twopi*hmod/NSS
do itone=0,3
dp=(itone-1.5)*dphi
phi=0.0
do j=1,NSS
c1(j,itone)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dp,twopi)
enddo
cp(itone)=cmplx(cos(phi),sin(phi))
enddo
first=.false.
endif
do k=1,NN
i1=(k-1)*NSS
csymb=cd(i1:i1+NSS-1)
do itone=0,3
cs(itone,k)=sum(csymb*conjg(c1(:,itone)))
enddo
s4(0:3,k)=abs(cs(0:3,k))
enddo
! Sync quality check
is1=0
is2=0
is3=0
badsync=.false.
ibmax=0
do k=1,8
ip=maxloc(s4(:,k))
if(icos8(k-1).eq.(ip(1)-1)) is1=is1+1
ip=maxloc(s4(:,k+78))
if(icos8(k-1).eq.(ip(1)-1)) is2=is2+1
ip=maxloc(s4(:,k+156))
if(icos8(k-1).eq.(ip(1)-1)) is3=is3+1
enddo
nsync=is1+is2+is3 !Number of correct hard sync symbols, 0-24
badsync=.false.
! if(nsync .lt. 8) then
! badsync=.true.
! return
! endif
do nseq=4,1,-1 !Try coherent sequences of 1, 2, and 4 symbols
if(nseq.eq.1) nsym=1
if(nseq.eq.2) nsym=2
if(nseq.eq.3) nsym=4
if(nseq.eq.4) nsym=8
nt=4**nsym
do ks=1,NN-nsym+1,nsym
s2=0
do i=0,nt-1
csum=0
cterm=1
do j=0,nsym-1
ntone=mod(i/4**(nsym-1-j),4)
csum=csum+cs(graymap(ntone),ks+j)*cterm
cterm=cterm*conjg(cp(graymap(ntone)))
enddo
s2(i)=abs(csum)
enddo
ipt=1+(ks-1)*2
if(nsym.eq.1) ibmax=1
if(nsym.eq.2) ibmax=3
if(nsym.eq.4) ibmax=7
if(nsym.eq.8) ibmax=15
do ib=0,ibmax
bm=maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)) - &
maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib))
if(ipt+ib.gt.2*NN) cycle
bitmetrics(ipt+ib,nseq)=bm
enddo
enddo
enddo
call normalizebmet(bitmetrics(:,1),2*NN)
call normalizebmet(bitmetrics(:,2),2*NN)
call normalizebmet(bitmetrics(:,3),2*NN)
call normalizebmet(bitmetrics(:,4),2*NN)
return
end subroutine get_ft280_bitmetrics

133
lib/fsk4hf/get_ft4s_bitmetrics.f90
View File

@ -1,133 +0,0 @@
subroutine get_ft4s_bitmetrics(cd,hmod,bitmetrics,badsync)
include 'ft4s_params.f90'
parameter (NSS=20)
complex cd(0:NN*NSS-1)
complex cs(0:3,NN)
complex csymb(NSS)
complex c1(NSS,0:3) ! ideal waveforms, 20 samples per symbol, 4 tones
complex ccor(0:3,NN) ! correlations with each ideal waveform, for each symbol
complex cp(0:3) ! accumulated phase shift over symbol types 0:3
complex csum,cterm
integer icos4a(0:3),icos4b(0:3)
integer icos4c(0:3),icos4d(0:3)
integer icos4e(0:3),icos4f(0:3)
integer graymap(0:3)
integer ip(1)
logical one(0:65535,0:15) ! 65536 8-symbol sequences, 16 bits
logical first
logical badsync
real bitmetrics(2*NN,4)
real s2(0:65535)
real s4(0:3,NN)
data icos4a/0,1,3,2/
data icos4b/1,0,2,3/
data icos4c/2,3,1,0/
data icos4d/3,2,0,1/
data icos4e/0,2,3,1/
data icos4f/1,2,0,3/
data graymap/0,1,3,2/
data first/.true./
save first,one,c1,cp
if(first) then
one=.false.
do i=0,65535
do j=0,15
if(iand(i,2**j).ne.0) one(i,j)=.true.
enddo
enddo
twopi=8.0*atan(1.0)
dphi=twopi*hmod/NSS
do itone=0,3
dp=(itone-1.5)*dphi
phi=0.0
do j=1,NSS
c1(j,itone)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dp,twopi)
enddo
cp(itone)=cmplx(cos(phi),sin(phi))
enddo
first=.false.
endif
do k=1,NN
i1=(k-1)*NSS
csymb=cd(i1:i1+NSS-1)
do itone=0,3
cs(itone,k)=sum(csymb*conjg(c1(:,itone)))
enddo
s4(0:3,k)=abs(cs(0:3,k))
enddo
! Sync quality check
is1=0
is2=0
is3=0
is4=0
is5=0
is6=0
badsync=.false.
ibmax=0
do k=1,4
ip=maxloc(s4(:,k))
if(icos4a(k-1).eq.(ip(1)-1)) is1=is1+1
ip=maxloc(s4(:,k+28))
if(icos4b(k-1).eq.(ip(1)-1)) is2=is2+1
ip=maxloc(s4(:,k+56))
if(icos4c(k-1).eq.(ip(1)-1)) is3=is3+1
ip=maxloc(s4(:,k+84))
if(icos4d(k-1).eq.(ip(1)-1)) is4=is4+1
ip=maxloc(s4(:,k+112))
if(icos4e(k-1).eq.(ip(1)-1)) is5=is5+1
ip=maxloc(s4(:,k+140))
if(icos4f(k-1).eq.(ip(1)-1)) is6=is6+1
enddo
nsync=is1+is2+is3+is4+is5+is6 !Number of correct hard sync symbols, 0-24
badsync=.false.
! if(nsync .lt. 8) then
! badsync=.true.
! return
! endif
do nseq=4,1,-1 !Try coherent sequences of 1, 2, and 4 symbols
if(nseq.eq.1) nsym=1
if(nseq.eq.2) nsym=2
if(nseq.eq.3) nsym=4
if(nseq.eq.4) nsym=8
nt=4**nsym
do ks=1,NN-nsym+1,nsym !87+16=103 symbols.
s2=0
do i=0,nt-1
csum=0
cterm=1
do j=0,nsym-1
ntone=mod(i/4**(nsym-1-j),4)
csum=csum+cs(graymap(ntone),ks+j)*cterm
cterm=cterm*conjg(cp(graymap(ntone)))
enddo
s2(i)=abs(csum)
enddo
ipt=1+(ks-1)*2
if(nsym.eq.1) ibmax=1
if(nsym.eq.2) ibmax=3
if(nsym.eq.4) ibmax=7
if(nsym.eq.8) ibmax=15
do ib=0,ibmax
bm=maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)) - &
maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib))
if(ipt+ib.gt.2*NN) cycle
bitmetrics(ipt+ib,nseq)=bm
enddo
enddo
enddo
call normalizebmet(bitmetrics(:,1),2*NN)
call normalizebmet(bitmetrics(:,2),2*NN)
call normalizebmet(bitmetrics(:,3),2*NN)
call normalizebmet(bitmetrics(:,4),2*NN)
return
end subroutine get_ft4s_bitmetrics

118
lib/fsk4hf/get_wspr4_bitmetrics.f90
View File

@ -1,118 +0,0 @@
subroutine get_wspr4_bitmetrics(cd,bitmetrics,badsync)
include 'wspr4_params.f90'
parameter (NSS=16)
complex cd(0:NN*NSS-1)
complex cs(0:3,NN)
complex csymb(NSS)
integer icos4a(0:3),icos4b(0:3),icos4c(0:3),icos4d(0:3)
integer graymap(0:3)
integer ip(1)
logical one(0:255,0:7) ! 256 4-symbol sequences, 8 bits
logical first
logical badsync
real bitmetrics(2*NN,3)
real s2(0:255)
real s4(0:3,NN)
data icos4a/0,1,3,2/
data icos4b/1,0,2,3/
data icos4c/2,3,1,0/
data icos4d/3,2,0,1/
data graymap/0,1,3,2/
data first/.true./
save first,one
if(first) then
one=.false.
do i=0,255
do j=0,7
if(iand(i,2**j).ne.0) one(i,j)=.true.
enddo
enddo
first=.false.
endif
do k=1,NN
i1=(k-1)*NSS
csymb=cd(i1:i1+NSS-1)
call four2a(csymb,NSS,1,-1,1)
cs(0:3,k)=csymb(1:4)
s4(0:3,k)=abs(csymb(1:4))
enddo
! Sync quality check
is1=0
is2=0
is3=0
is4=0
badsync=.false.
ibmax=0
do k=1,4
ip=maxloc(s4(:,k))
if(icos4a(k-1).eq.(ip(1)-1)) is1=is1+1
ip=maxloc(s4(:,k+33))
if(icos4b(k-1).eq.(ip(1)-1)) is2=is2+1
ip=maxloc(s4(:,k+66))
if(icos4c(k-1).eq.(ip(1)-1)) is3=is3+1
ip=maxloc(s4(:,k+99))
if(icos4d(k-1).eq.(ip(1)-1)) is4=is4+1
enddo
nsync=is1+is2+is3+is4 !Number of correct hard sync symbols, 0-16
badsync=.false.
! if(nsync .lt. 8) then
! badsync=.true.
! return
! endif
do nseq=1,3 !Try coherent sequences of 1, 2, and 4 symbols
if(nseq.eq.1) nsym=1
if(nseq.eq.2) nsym=2
if(nseq.eq.3) nsym=4
nt=2**(2*nsym)
do ks=1,NN-nsym+1,nsym !87+16=103 symbols.
amax=-1.0
do i=0,nt-1
i1=i/64
i2=iand(i,63)/16
i3=iand(i,15)/4
i4=iand(i,3)
if(nsym.eq.1) then
s2(i)=abs(cs(graymap(i4),ks))
elseif(nsym.eq.2) then
s2(i)=abs(cs(graymap(i3),ks)+cs(graymap(i4),ks+1))
elseif(nsym.eq.4) then
s2(i)=abs(cs(graymap(i1),ks ) + &
cs(graymap(i2),ks+1) + &
cs(graymap(i3),ks+2) + &
cs(graymap(i4),ks+3) &
)
else
print*,"Error - nsym must be 1, 2, or 4."
endif
enddo
ipt=1+(ks-1)*2
if(nsym.eq.1) ibmax=1
if(nsym.eq.2) ibmax=3
if(nsym.eq.4) ibmax=7
do ib=0,ibmax
bm=maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)) - &
maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib))
if(ipt+ib.gt.2*NN) cycle
bitmetrics(ipt+ib,nseq)=bm
enddo
enddo
enddo
bitmetrics(205:206,2)=bitmetrics(205:206,1)
bitmetrics(201:204,3)=bitmetrics(201:204,2)
bitmetrics(205:206,3)=bitmetrics(205:206,1)
call normalizebmet(bitmetrics(:,1),2*NN)
call normalizebmet(bitmetrics(:,2),2*NN)
call normalizebmet(bitmetrics(:,3),2*NN)
return
end subroutine get_wspr4_bitmetrics

63
lib/fsk4hf/getcandidates2.f90
View File

@ -1,63 +0,0 @@
subroutine getcandidates2(id,fa,fb,syncmin,nfqso,maxcand,savg,candidate, &
ncand,sbase)
! For now, hardwired to find the largest peak in the average spectrum
include 'ft2_params.f90'
real s(NH1,NHSYM)
real savg(NH1),savsm(NH1)
real sbase(NH1)
real x(NFFT1)
complex cx(0:NH1)
real candidate(3,maxcand)
integer*2 id(NMAX)
integer*1 s8(8)
integer indx(NH1)
data s8/0,1,1,1,0,0,1,0/
equivalence (x,cx)
! Compute symbol spectra, stepping by NSTEP steps.
savg=0.
tstep=NSTEP/12000.0
df=12000.0/NFFT1 !3.125 Hz
fac=1.0/300.0
do j=1,NHSYM
ia=(j-1)*NSTEP + 1
ib=ia+NSPS-1
x(1:NSPS)=fac*id(ia:ib)
x(NSPS+1:)=0.
call four2a(x,NFFT1,1,-1,0) !r2c FFT
do i=1,NH1
s(i,j)=real(cx(i))**2 + aimag(cx(i))**2
enddo
savg=savg + s(1:NH1,j) !Average spectrum
enddo
savsm=0.
do i=2,NH1-1
savsm(i)=sum(savg(i-1:i+1))/3.
enddo
nfa=fa/df
nfb=fb/df
np=nfb-nfa+1
indx=0
call indexx(savsm(nfa:nfb),np,indx)
xn=savsm(nfa+indx(nint(0.3*np)))
savsm=savsm/xn
imax=-1
xmax=-99.
do i=2,NH1-1
if(savsm(i).gt.savsm(i-1).and. &
savsm(i).gt.savsm(i+1).and. &
savsm(i).gt.xmax) then
xmax=savsm(i)
imax=i
endif
enddo
f0=imax*df
if(xmax.gt.1.2) then
ncand=ncand+1
candidate(1,ncand)=f0
endif
return
end subroutine getcandidates2

58
lib/fsk4hf/getfc1.f90
View File

@ -1,58 +0,0 @@
subroutine getfc1(c,fc1)
parameter (KK=84) !Information bits (72 + CRC12)
parameter (ND=168) !Data symbols: LDPC (168,84), r=1/2
parameter (NS=65) !Sync symbols (2 x 26 + Barker 13)
parameter (NR=3) !Ramp up/down
parameter (NN=NR+NS+ND) !Total symbols (236)
parameter (NSPS=16) !Samples per MSK symbol (16)
parameter (N2=2*NSPS) !Samples per OQPSK symbol (32)
parameter (N13=13*N2) !Samples in central sync vector (416)
parameter (NZ=NSPS*NN) !Samples in baseband waveform (3760)
parameter (NFFT1=4*NSPS,NH1=NFFT1/2)
complex c(0:NZ-1) !Complex waveform
complex c2(0:NFFT1-1) !Short spectra
real s(-NH1+1:NH1) !Coarse spectrum
nspec=NZ/NFFT1
fs=12000.0/72.0
df1=fs/NFFT1
s=0.
do k=1,nspec
ia=(k-1)*N2
ib=ia+N2-1
c2(0:N2-1)=c(ia:ib)
c2(N2:)=0.
call four2a(c2,NFFT1,1,-1,1)
do i=0,NFFT1-1
j=i
if(j.gt.NH1) j=j-NFFT1
s(j)=s(j) + real(c2(i))**2 + aimag(c2(i))**2
enddo
enddo
! call smo121(s,NFFT1)
smax=0.
ipk=0
fc1=0.
ia=nint(40.0/df1)
do i=-ia,ia
f=i*df1
if(s(i).gt.smax) then
smax=s(i)
ipk=i
fc1=f
endif
! write(51,3001) f,s(i),db(s(i))
! 3001 format(f10.3,e12.3,f10.3)
enddo
! The following is for testing SNR calibration:
! sp3n=(s(ipk-1)+s(ipk)+s(ipk+1)) !Sig + 3*noise
! base=(sum(s)-sp3n)/(NFFT1-3.0) !Noise per bin
! psig=sp3n-3*base !Sig only
! pnoise=(2500.0/df1)*base !Noise in 2500 Hz
! xsnrdb=db(psig/pnoise)
return
end subroutine getfc1

47
lib/fsk4hf/getfc1w.f90
View File

@ -1,47 +0,0 @@
subroutine getfc1w(c,fs,fa,fb,fc1,xsnr)
include 'wsprlf_params.f90'
complex c(0:NZ-1) !Complex waveform
complex c2(0:NFFT1-1) !Short spectra
real s(-NH1+1:NH1) !Coarse spectrum
nspec=NZ/NFFT1
df1=fs/NFFT1
s=0.
do k=1,nspec
ia=(k-1)*N2
ib=ia+N2-1
c2(0:N2-1)=c(ia:ib)
c2(N2:)=0.
call four2a(c2,NFFT1,1,-1,1)
do i=0,NFFT1-1
j=i
if(j.gt.NH1) j=j-NFFT1
s(j)=s(j) + real(c2(i))**2 + aimag(c2(i))**2
enddo
enddo
! call smo121(s,NFFT1)
smax=0.
ipk=0
fc1=0.
ia=nint(fa/df1)
ib=nint(fb/df1)
do i=ia,ib
f=i*df1
if(s(i).gt.smax) then
smax=s(i)
ipk=i
fc1=f
endif
! write(51,3001) f,s(i),db(s(i))
! 3001 format(f10.3,e12.3,f10.3)
enddo
! The following is for testing SNR calibration:
sp3n=(s(ipk-1)+s(ipk)+s(ipk+1)) !Sig + 3*noise
base=(sum(s)-sp3n)/(NFFT1-3.0) !Noise per bin
psig=sp3n-3*base !Sig only
pnoise=(2500.0/df1)*base !Noise in 2500 Hz
xsnr=db(psig/pnoise)
return
end subroutine getfc1w

74
lib/fsk4hf/getfc2.f90
View File

@ -1,74 +0,0 @@
subroutine getfc2(c,csync,fc1,fc2,fc3)
parameter (KK=84) !Information bits (72 + CRC12)
parameter (ND=168) !Data symbols: LDPC (168,84), r=1/2
parameter (NS=65) !Sync symbols (2 x 26 + Barker 13)
parameter (NR=3) !Ramp up/down
parameter (NN=NR+NS+ND) !Total symbols (236)
parameter (NSPS=16) !Samples per MSK symbol (16)
parameter (N2=2*NSPS) !Samples per OQPSK symbol (32)
parameter (N13=13*N2) !Samples in central sync vector (416)
parameter (NZ=NSPS*NN) !Samples in baseband waveform (3760)
parameter (NFFT1=4*NSPS,NH1=NFFT1/2)
complex c(0:NZ-1) !Complex waveform
complex cs(0:NZ-1) !For computing spectrum
complex csync(0:NZ-1) !Sync symbols only, from cbb
real a(5)
fs=12000.0/72.0
df=fs/NZ
baud=fs/NSPS
a(1)=-fc1
a(2:5)=0.
call twkfreq1(c,NZ,fs,a,cs) !Mix down by fc1
! Filter, square, then FFT to get refined carrier frequency fc2.
call four2a(cs,NZ,1,-1,1) !To freq domain
ia=nint(0.75*baud/df)
cs(ia:NZ-1-ia)=0. !Save only freqs around fc1
call four2a(cs,NZ,1,1,1) !Back to time domain
cs=cs/NZ
cs=cs*cs !Square the data
call four2a(cs,NZ,1,-1,1) !Compute squared spectrum
! Find two peaks separated by baud
pmax=0.
fc2=0.
ic=nint(baud/df)
ja=nint(0.5*baud/df)
do j=-ja,ja
f2=j*df
ia=nint((f2-0.5*baud)/df)
if(ia.lt.0) ia=ia+NZ
ib=nint((f2+0.5*baud)/df)
p=real(cs(ia))**2 + aimag(cs(ia))**2 + &
real(cs(ib))**2 + aimag(cs(ib))**2
if(p.gt.pmax) then
pmax=p
fc2=0.5*f2
endif
! write(52,1200) f2,p,db(p)
!1200 format(f10.3,2f15.3)
enddo
a(1)=-fc1
a(2:5)=0.
call twkfreq1(c,NZ,fs,a,cs) !Mix down by fc1
cs=cs*conjg(csync)
call four2a(cs,NZ,1,-1,1) !To freq domain
pmax=0.
do i=0,NZ-1
f=i*df
if(i.gt.NZ/2) f=(i-NZ)*df
p=real(cs(i))**2 + aimag(cs(i))**2
! write(51,3001) f,p,db(p)
!3001 format(f10.3,e12.3,f10.3)
if(p.gt.pmax) then
pmax=p
fc3=f
endif
enddo
return
end subroutine getfc2

82
lib/fsk4hf/getfc2w.f90
View File

@ -1,82 +0,0 @@
subroutine getfc2w(c,csync,npeaks,fs,fc1,fpks)
include 'wsprlf_params.f90'
complex c(0:NZ-1) !Complex waveform
complex cs(0:NZ-1) !For computing spectrum
complex csync(0:NZ-1) !Sync symbols only, from cbb
real a(5)
real freqs(413),sp2(413),fpks(npeaks)
integer pkloc(1)
df=fs/NZ
baud=fs/NSPS
a(1)=-fc1
a(2:5)=0.
call twkfreq1(c,NZ,fs,a,cs) !Mix down by fc1
! Filter, square, then FFT to get refined carrier frequency fc2.
call four2a(cs,NZ,1,-1,1) !To freq domain
ia=nint(0.75*baud/df)
cs(ia:NZ-1-ia)=0. !Save only freqs around fc1
call four2a(cs,NZ,1,1,1) !Back to time domain
cs=cs/NZ
cs=cs*cs !Square the data
call four2a(cs,NZ,1,-1,1) !Compute squared spectrum
! Find two peaks separated by baud
pmax=0.
fc2=0.
ja=nint(0.3*baud/df)
k=1
do j=-ja,ja
f2=j*df
ia=nint((f2-0.5*baud)/df)
if(ia.lt.0) ia=ia+NZ
ib=nint((f2+0.5*baud)/df)
p=real(cs(ia))**2 + aimag(cs(ia))**2 + &
real(cs(ib))**2 + aimag(cs(ib))**2
if(p.gt.pmax) then
pmax=p
fc2=0.5*f2
endif
freqs(k)=0.5*f2
sp2(k)=p
k=k+1
! write(52,1200) f2,p,db(p)
!1200 format(f10.3,2f15.3)
enddo
do i=1,npeaks
pkloc=maxloc(sp2)
ipk=pkloc(1)
fpks(i)=freqs(ipk)
ipk0=max(1,ipk-1)
ipk1=min(413,ipk+1)
! ipk0=ipk
! ipk1=ipk
sp2(ipk0:ipk1)=0.0
!write(*,*) i,fpks(i),fc2
enddo
a(1)=-fc1
a(2:5)=0.
call twkfreq1(c,NZ,fs,a,cs) !Mix down by fc1
cs=cs*conjg(csync)
call four2a(cs,NZ,1,-1,1) !To freq domain
pmax=0.
do i=0,NZ-1
f=i*df
if(i.gt.NZ/2) f=(i-NZ)*df
p=real(cs(i))**2 + aimag(cs(i))**2
! write(51,3001) f,p,db(p)
!3001 format(f10.3,e12.3,f10.3)
if(p.gt.pmax) then
pmax=p
fc3=f
endif
enddo
return
end subroutine getfc2w

28
lib/fsk4hf/gran.c
View File

@ -1,28 +0,0 @@
#include <stdlib.h>
#include <math.h>
/* Generate gaussian random float with mean=0 and std_dev=1 */
float gran_()
{
float fac,rsq,v1,v2;
static float gset;
static int iset;
if(iset){
/* Already got one */
iset = 0;
return gset;
}
/* Generate two evenly distributed numbers between -1 and +1
* that are inside the unit circle
*/
do {
v1 = 2.0 * (float)rand() / RAND_MAX - 1;
v2 = 2.0 * (float)rand() / RAND_MAX - 1;
rsq = v1*v1 + v2*v2;
} while(rsq >= 1.0 || rsq == 0.0);
fac = sqrt(-2.0*log(rsq)/rsq);
gset = v1*fac;
iset++;
return v2*fac;
}

76
lib/fsk4hf/ldpc_174_101_generator.f90
View File

@ -1,76 +0,0 @@
character *26 g(73)
data g/ &
"63e951344af12c4cc41106e760", &
"68d44d92ecd93ad6d4692266c8", &
"4580fb1fac614cbfd928ede720", &
"14eeda1b8a01f66880f5012ad8", &
"35a9cfb6458a89bf8aafeaf488", &
"20c8bc97810aea0bea6224ddb8", &
"f577e866d9a5ed407f37bf4010", &
"100d26dff465508c671a3b2710", &
"4e860571d270084b99b18e74a0", &
"495bbc1ba799ac5f5c159ebeb8", &
"c71b622d5e7e351b46cf9f29a8", &
"2e01d802b77181d4789285fdb8", &
"41ee2ab37388eaee0ec6d54860", &
"839084a886a9e1f3c5f56453b0", &
"bbaef43ff6506531465a4a2690", &
"627436a8e4ff531d190f179a68", &
"d48abf3769173ad49de8bf9d98", &
"1a588539d6b05682445316b6e0", &
"59dfa468e4da46b03c5fe69b48", &
"0c94c6716f592a165d9ad056a8", &
"4cae5d652767e32d08b75bf370", &
"9d7bff3c3fea24c15d9a78e550", &
"400576f3f695101962ccbd7818", &
"8731ecdaa728862d0f29f334a8", &
"3b588539d6b0d682547316b6e0", &
"958ee990eb7b62502f49733388", &
"4c84c6716f582a165dbad0d6a8", &
"9294bdce4590c752416f516238", &
"72a2a0f864533375373ff521d8", &
"552a32c530cb00206e8ce56d90", &
"fbc29b77052ba34d9993873c98", &
"eeb3767ac69e86f08d793a44a0", &
"20f4128d200bdae9a24e79efd0", &
"26aaf29464a373e092e963fed0", &
"33cd65456ae8efe40bce1b3378", &
"900d66fff465708c671a3b2730", &
"91aa5e8f40af51c256da031b00", &
"ca41c5a3d010dfe60d87a3ab68", &
"9d68f4c75fceab703c9a74ea58", &
"2d2f3945b24e17547f27f78400", &
"07d78fdbc0f3c361297561f070", &
"ebbcb3f268a60852e7582376f0", &
"c263d7e939dbf3f7823941b9e0", &
"f2244da30cb449300f01de6348", &
"19043d66c33926a9849a3d3188", &
"dd7d8234a953bb695ed6c89240", &
"24f233d9168f595680fe99eec8", &
"177d16017d598f7e1ed3497ac8", &
"387ec44871f376c96bcd0aec38", &
"08f596acd411469152d30bf6d8", &
"27239f5ee0f8198c8b3b1819a0", &
"c69382b7dbe81f06983ed4f2f0", &
"d9d2c29710af363c5f455dbcf8", &
"6e4c7ae7ee52c11db7daf40b10", &
"9b2ef437f6506531445a4a6690", &
"86d5489e3df6deb548094a61c8", &
"7cf277ada2132560d6ba744830", &
"471b62ad5c7e351b44ef9f29a8", &
"bfbb8689f7ded0062e48a6e6b8", &
"380a6a5250f6562b21e157d250", &
"5f1928d58631d732dfa3395db0", &
"d2eef1368dbea33be523fa9ef0", &
"8a55e2c622d7240e23492d9190", &
"8fc03eac7c719359c4af4a4c48", &
"62af8467903663f97025de06c8", &
"1ecb7b94b903e532986f1c36e0", &
"d2918b3db705d74b2ba2ec1a20", &
"1571fd0dc3bd259d14eabd6838", &
"18be78df70f98cc281af2e3580", &
"e547da7243f7d5309626a4aec0", &
"1bac17b4f2bb086bf63d6f1930", &
"0864932f8d6ec6ef479d450db8", &
"10aa89da9daa4c1fb7a4288ab0"/

258
lib/fsk4hf/ldpc_174_101_parity.f90
View File

@ -1,258 +0,0 @@
data Mn/ &
2, 54, 72, &
18, 60, 62, &
37, 50, 70, &
3, 30, 66, &
4, 9, 14, &
5, 19, 23, &
6, 21, 47, &
7, 31, 50, &
8, 39, 70, &
10, 33, 73, &
11, 22, 49, &
12, 60, 61, &
16, 53, 55, &
17, 63, 67, &
24, 59, 64, &
25, 27, 68, &
26, 38, 46, &
28, 57, 72, &
29, 36, 43, &
32, 48, 51, &
34, 52, 69, &
14, 35, 44, &
40, 41, 42, &
45, 56, 65, &
31, 51, 54, &
42, 58, 69, &
1, 37, 72, &
2, 27, 64, &
3, 41, 70, &
4, 10, 12, &
5, 40, 59, &
6, 19, 39, &
7, 53, 68, &
8, 35, 47, &
9, 48, 66, &
11, 18, 36, &
13, 20, 29, &
15, 28, 46, &
16, 23, 54, &
17, 52, 57, &
21, 26, 62, &
22, 63, 73, &
24, 51, 65, &
25, 30, 43, &
32, 47, 61, &
33, 56, 71, &
15, 34, 45, &
38, 43, 60, &
44, 50, 67, &
3, 49, 58, &
22, 55, 72, &
1, 13, 53, &
2, 20, 69, &
4, 46, 49, &
5, 9, 45, &
6, 11, 65, &
7, 35, 57, &
8, 11, 38, &
10, 29, 32, &
12, 16, 21, &
14, 64, 71, &
17, 41, 68, &
1, 18, 66, &
19, 58, 64, &
23, 24, 48, &
25, 31, 67, &
26, 42, 44, &
27, 40, 50, &
28, 56, 62, &
30, 37, 63, &
33, 54, 70, &
34, 36, 73, &
39, 55, 61, &
9, 52, 59, &
50, 54, 60, &
2, 4, 16, &
3, 20, 31, &
5, 55, 67, &
6, 44, 48, &
7, 28, 52, &
8, 29, 30, &
10, 24, 49, &
12, 57, 66, &
13, 42, 73, &
14, 19, 21, &
15, 27, 36, &
17, 39, 43, &
18, 51, 61, &
22, 23, 60, &
25, 46, 70, &
26, 58, 59, &
32, 63, 71, &
5, 33, 65, &
34, 41, 53, &
35, 37, 41, &
38, 68, 73, &
30, 40, 69, &
39, 45, 62, &
47, 69, 72, &
4, 37, 56, &
1, 31, 48, &
1, 21, 58, &
2, 5, 62, &
3, 27, 57, &
4, 43, 51, &
2, 35, 63, &
6, 53, 59, &
7, 29, 66, &
8, 42, 72, &
9, 31, 36, &
10, 35, 55, &
11, 13, 54, &
12, 63, 65, &
10, 11, 15, &
14, 22, 69, &
15, 16, 70, &
9, 16, 24, &
17, 47, 56, &
18, 45, 50, &
19, 30, 44, &
20, 60, 71, &
1, 44, 65, &
22, 26, 68, &
23, 28, 61, &
24, 25, 39, &
13, 46, 50, &
26, 34, 67, &
3, 6, 60, &
14, 28, 40, &
4, 7, 42, &
19, 36, 57, &
25, 32, 34, &
32, 37, 38, &
33, 41, 46, &
17, 18, 23, &
5, 43, 47, &
30, 45, 72, &
12, 37, 64, &
27, 38, 56, &
31, 61, 73, &
40, 49, 52, &
20, 41, 48, &
21, 29, 52, &
8, 68, 71, &
15, 17, 59, &
3, 13, 14, &
2, 61, 66, &
9, 38, 58, &
48, 64, 73, &
49, 53, 62, &
10, 19, 26, &
1, 41, 43, &
52, 55, 71, &
16, 20, 30, &
4, 6, 34, &
51, 69, 70, &
7, 11, 64, &
18, 25, 35, &
54, 58, 67, &
12, 39, 40, &
33, 39, 66, &
5, 37, 68, &
8, 31, 59, &
21, 45, 73, &
27, 51, 55, &
23, 42, 65, &
22, 29, 56, &
20, 28, 67, &
32, 44, 49, &
33, 53, 69, &
13, 24, 47, &
36, 46, 63, &
1, 15, 71, &
48, 57, 62/
data Nm/ &
27, 52, 63, 101, 102, 122, 152, 173, &
1, 28, 53, 76, 103, 106, 147, 0, &
4, 29, 50, 77, 104, 128, 146, 0, &
5, 30, 54, 76, 100, 105, 130, 155, &
6, 31, 55, 78, 93, 103, 136, 162, &
7, 32, 56, 79, 107, 128, 155, 0, &
8, 33, 57, 80, 108, 130, 157, 0, &
9, 34, 58, 81, 109, 144, 163, 0, &
5, 35, 55, 74, 110, 117, 148, 0, &
10, 30, 59, 82, 111, 114, 151, 0, &
11, 36, 56, 58, 112, 114, 157, 0, &
12, 30, 60, 83, 113, 138, 160, 0, &
37, 52, 84, 112, 126, 146, 171, 0, &
5, 22, 61, 85, 115, 129, 146, 0, &
38, 47, 86, 114, 116, 145, 173, 0, &
13, 39, 60, 76, 116, 117, 154, 0, &
14, 40, 62, 87, 118, 135, 145, 0, &
2, 36, 63, 88, 119, 135, 158, 0, &
6, 32, 64, 85, 120, 131, 151, 0, &
37, 53, 77, 121, 142, 154, 168, 0, &
7, 41, 60, 85, 102, 143, 164, 0, &
11, 42, 51, 89, 115, 123, 167, 0, &
6, 39, 65, 89, 124, 135, 166, 0, &
15, 43, 65, 82, 117, 125, 171, 0, &
16, 44, 66, 90, 125, 132, 158, 0, &
17, 41, 67, 91, 123, 127, 151, 0, &
16, 28, 68, 86, 104, 139, 165, 0, &
18, 38, 69, 80, 124, 129, 168, 0, &
19, 37, 59, 81, 108, 143, 167, 0, &
4, 44, 70, 81, 97, 120, 137, 154, &
8, 25, 66, 77, 101, 110, 140, 163, &
20, 45, 59, 92, 132, 133, 169, 0, &
10, 46, 71, 93, 134, 161, 170, 0, &
21, 47, 72, 94, 127, 132, 155, 0, &
22, 34, 57, 95, 106, 111, 158, 0, &
19, 36, 72, 86, 110, 131, 172, 0, &
3, 27, 70, 95, 100, 133, 138, 162, &
17, 48, 58, 96, 133, 139, 148, 0, &
9, 32, 73, 87, 98, 125, 160, 161, &
23, 31, 68, 97, 129, 141, 160, 0, &
23, 29, 62, 94, 95, 134, 142, 152, &
23, 26, 67, 84, 109, 130, 166, 0, &
19, 44, 48, 87, 105, 136, 152, 0, &
22, 49, 67, 79, 120, 122, 169, 0, &
24, 47, 55, 98, 119, 137, 164, 0, &
17, 38, 54, 90, 126, 134, 172, 0, &
7, 34, 45, 99, 118, 136, 171, 0, &
20, 35, 65, 79, 101, 142, 149, 174, &
11, 50, 54, 82, 141, 150, 169, 0, &
3, 8, 49, 68, 75, 119, 126, 0, &
20, 25, 43, 88, 105, 156, 165, 0, &
21, 40, 74, 80, 141, 143, 153, 0, &
13, 33, 52, 94, 107, 150, 170, 0, &
1, 25, 39, 71, 75, 112, 159, 0, &
13, 51, 73, 78, 111, 153, 165, 0, &
24, 46, 69, 100, 118, 139, 167, 0, &
18, 40, 57, 83, 104, 131, 174, 0, &
26, 50, 64, 91, 102, 148, 159, 0, &
15, 31, 74, 91, 107, 145, 163, 0, &
2, 12, 48, 75, 89, 121, 128, 0, &
12, 45, 73, 88, 124, 140, 147, 0, &
2, 41, 69, 98, 103, 150, 174, 0, &
14, 42, 70, 92, 106, 113, 172, 0, &
15, 28, 61, 64, 138, 149, 157, 0, &
24, 43, 56, 93, 113, 122, 166, 0, &
4, 35, 63, 83, 108, 147, 161, 0, &
14, 49, 66, 78, 127, 159, 168, 0, &
16, 33, 62, 96, 123, 144, 162, 0, &
21, 26, 53, 97, 99, 115, 156, 170, &
3, 9, 29, 71, 90, 116, 156, 0, &
46, 61, 92, 121, 144, 153, 173, 0, &
1, 18, 27, 51, 99, 109, 137, 0, &
10, 42, 72, 84, 96, 140, 149, 164/
data nrw/ &
8,7,7,8,8,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, &
7,7,7,7,7,7,7,7,7,8,8,7,7,7,7,7,8,7,8,7, &
8,7,7,7,7,7,7,8,7,7,7,7,7,7,7,7,7,7,7,7, &
7,7,7,7,7,7,7,7,8,7,7,7,8/
ncw=3

105
lib/fsk4hf/ldpc_174_74_generator.f90
View File

@ -1,105 +0,0 @@
! generator matrix for regular column weight 3 (174,74) LDPC code.
character*19 g(100)
data g/ &
"b190e319bd45882ed74", &
"b159282d395467cabe4", &
"f502387ec63db738358", &
"a6c7911729277b2a178", &
"05d812d04122ff2842c", &
"eb040701b66b26d12ec", &
"c617358e34398e73c6c", &
"37b62b499bbb84aeb0c", &
"60257b5d4e41594a250", &
"e8ac26253c0268ba33c", &
"0f243baf67353230318", &
"521d5eb1268bed86854", &
"53bab7dbe89962bba00", &
"417abaf10e0912604b8", &
"c0d371dbb301f49aae8", &
"e7014cf533a2cb9fd24", &
"948175882e16ecd8cc8", &
"87db37137999fb15504", &
"2557139852451e678c8", &
"aaaf0b6b1f70db8e5ac", &
"f5be069b0a41fd5bb28", &
"e7789f2237b2175d494", &
"94554737d22b00d5980", &
"525e935db67c1af214c", &
"9c57c640427a2c2e33c", &
"9a82e00fb570e371cac", &
"39ebbdd43570f690818", &
"a037514614e0d5cc2a4", &
"ff19fc0eee4376f6de0", &
"f8853aad262b1a14cf0", &
"f5687424fe7c5156ee0", &
"fba0aa4876b79e45d78", &
"dfdfb60046769dec900", &
"600b4517a14560fad64", &
"39c618d3f629809c064", &
"5c821087e8c365869f8", &
"a4f26e15e3ef8264c04", &
"ac230e4147016f5bf98", &
"e11a6981f5257957d84", &
"b9dd003c09cf2abc5b0", &
"326ff2588a1bfa6a310", &
"a84e8e04722185f23ac", &
"8a66abe81aff313f9a8", &
"f6047ea2cad01957e08", &
"f14b63fdff262eb74bc", &
"7588be7336de21f7680", &
"312d0e1d5d1c3666fec", &
"5ab69333712cdbf9c38", &
"3c8e8c949be183939f4", &
"ed3b36d068e55ef76d8", &
"8193b051800415c06e0", &
"bc8e88949be18393bd4", &
"a7db37037999fb15404", &
"c5ec69ecc57ed7800b8", &
"475b645148268e10afc", &
"1fe90fea7ae941c04a8", &
"513b196d2a6e43c9504", &
"ffc27ceba420d04f468", &
"972c2cc31e578dba968", &
"7fc874b734a8188a2f8", &
"3d0327a801275734cc4", &
"b1e77d50857f56b6a40", &
"f25389644e47dae2384", &
"4e7e815e6b3c20507a0", &
"27d63d2e80a23f057cc", &
"381388a8a6fad77ec50", &
"b785abf747ea18bc350", &
"40a2a8214e2bed48090", &
"0e891f175b06fed80d4", &
"dbd155acd9fbec5b4a4", &
"9d3476e615c702f8e60", &
"050ea06fbd1f532d164", &
"d03767bca8394f31628", &
"455d568ff3047e9d5ac", &
"6b343bcf7378e1283f4", &
"a0d371dbb311f49aae8", &
"36ea237c911eb2ac27c", &
"54a636ec612a744f368", &
"5cabf5c9d5a0d2d9ba4", &
"00d632bffc3dac0d548", &
"d86bf5593c70dcb91fc", &
"bada10bb78be8c219c0", &
"b98028f926fed2beab0", &
"c0347b3cc45c2888094", &
"0662d6a3c2974e0a910", &
"8036b9e83c9fdc2cda8", &
"e5db38aad196024c21c", &
"746c8af5783b5daedcc", &
"1dc47211c27e39ec5dc", &
"6b98898e40559a2e128", &
"52d9077dbfa44c6d75c", &
"9ca1e6bd4515559a054", &
"7b2dd815e5991f88d14", &
"bfde5ebc6e09940460c", &
"487f5ffeaf139c209f4", &
"08d6b3c9686cc0f6ff4", &
"e198f5466141f53ab84", &
"0a7c7af0ac612d14f40", &
"a4192113ec53f4d165c", &
"1423ae72e003614be88"/

288
lib/fsk4hf/ldpc_174_74_parity.f90
View File

@ -1,288 +0,0 @@
! parity check matrix for regular column weight 3 (174,74) LDPC code
data Mn/ &
28, 32, 98, &
1, 94, 95, &
70, 71, 94, &
3, 9, 39, &
4, 22, 84, &
5, 25, 85, &
6, 55, 100, &
7, 41, 67, &
8, 62, 77, &
10, 37, 40, &
11, 16, 36, &
12, 29, 47, &
14, 57, 91, &
15, 49, 59, &
17, 18, 52, &
19, 48, 58, &
20, 34, 72, &
21, 38, 87, &
23, 46, 79, &
24, 43, 83, &
26, 74, 78, &
27, 51, 98, &
30, 35, 42, &
31, 63, 88, &
25, 33, 82, &
44, 53, 96, &
50, 75, 90, &
46, 54, 71, &
56, 76, 81, &
60, 65, 69, &
61, 95, 97, &
64, 89, 99, &
66, 73, 76, &
68, 80, 92, &
74, 86, 87, &
52, 55, 93, &
1, 3, 21, &
2, 57, 64, &
4, 11, 82, &
5, 60, 81, &
6, 13, 66, &
7, 43, 59, &
8, 27, 85, &
9, 34, 94, &
10, 28, 88, &
12, 19, 53, &
14, 33, 65, &
15, 75, 84, &
16, 56, 68, &
17, 44, 90, &
18, 23, 73, &
20, 26, 83, &
22, 42, 91, &
24, 70, 79, &
29, 96, 97, &
30, 48, 77, &
31, 37, 67, &
32, 35, 78, &
36, 80, 89, &
38, 62, 93, &
39, 54, 72, &
40, 58, 61, &
41, 51, 86, &
9, 45, 63, &
46, 47, 92, &
49, 50, 80, &
69, 75, 98, &
14, 71, 99, &
21, 85, 100, &
1, 6, 50, &
2, 74, 98, &
3, 73, 92, &
4, 32, 79, &
5, 63, 96, &
1, 29, 79, &
2, 6, 84, &
3, 36, 78, &
4, 59, 69, &
5, 72, 80, &
2, 41, 44, &
7, 38, 90, &
8, 58, 99, &
9, 42, 49, &
10, 46, 74, &
11, 14, 73, &
12, 85, 88, &
13, 25, 93, &
5, 11, 61, &
15, 16, 94, &
8, 15, 32, &
17, 64, 76, &
18, 60, 71, &
19, 34, 57, &
20, 77, 96, &
21, 31, 82, &
22, 23, 48, &
16, 17, 22, &
24, 35, 86, &
13, 51, 64, &
26, 33, 39, &
4, 27, 47, &
28, 54, 56, &
1, 62, 76, &
30, 53, 100, &
21, 46, 57, &
32, 55, 61, &
33, 92, 95, &
19, 67, 68, &
14, 35, 75, &
3, 84, 99, &
37, 75, 92, &
7, 30, 63, &
23, 39, 50, &
27, 40, 44, &
41, 66, 91, &
9, 10, 69, &
12, 43, 52, &
6, 20, 88, &
43, 45, 89, &
24, 31, 60, &
47, 50, 70, &
26, 38, 45, &
25, 42, 98, &
40, 79, 87, &
51, 68, 83, &
52, 97, 98, &
48, 71, 78, &
28, 29, 80, &
53, 59, 73, &
49, 54, 95, &
34, 36, 90, &
55, 82, 89, &
4, 77, 90, &
49, 58, 81, &
18, 56, 77, &
62, 63, 65, &
60, 91, 100, &
2, 11, 62, &
15, 24, 93, &
37, 66, 83, &
65, 85, 86, &
5, 10, 48, &
1, 69, 89, &
67, 81, 87, &
13, 56, 75, &
70, 72, 97, &
8, 50, 57, &
6, 19, 33, &
7, 25, 99, &
74, 94, 96, &
14, 52, 87, &
16, 30, 40, &
20, 42, 79, &
17, 21, 72, &
9, 12, 41, &
18, 61, 67, &
3, 83, 97, &
26, 80, 91, &
23, 55, 65, &
27, 31, 95, &
28, 84, 86, &
29, 34, 93, &
46, 51, 63, &
35, 39, 76, &
13, 44, 78, &
32, 37, 38, &
22, 43, 92, &
45, 53, 54, &
58, 73, 74, &
47, 64, 100, &
59, 68, 85, &
66, 82, 96, &
36, 81, 88, &
2, 45, 70/
data Nm/ &
2, 37, 70, 75, 103, 143, &
38, 71, 76, 80, 138, 174, &
4, 37, 72, 77, 110, 157, &
5, 39, 73, 78, 101, 133, &
6, 40, 74, 79, 88, 142, &
7, 41, 70, 76, 118, 148, &
8, 42, 81, 112, 149, 0, &
9, 43, 82, 90, 147, 0, &
4, 44, 64, 83, 116, 155, &
10, 45, 84, 116, 142, 0, &
11, 39, 85, 88, 138, 0, &
12, 46, 86, 117, 155, 0, &
41, 87, 99, 145, 165, 0, &
13, 47, 68, 85, 109, 151, &
14, 48, 89, 90, 139, 0, &
11, 49, 89, 97, 152, 0, &
15, 50, 91, 97, 154, 0, &
15, 51, 92, 135, 156, 0, &
16, 46, 93, 108, 148, 0, &
17, 52, 94, 118, 153, 0, &
18, 37, 69, 95, 105, 154, &
5, 53, 96, 97, 167, 0, &
19, 51, 96, 113, 159, 0, &
20, 54, 98, 120, 139, 0, &
6, 25, 87, 123, 149, 0, &
21, 52, 100, 122, 158, 0, &
22, 43, 101, 114, 160, 0, &
1, 45, 102, 128, 161, 0, &
12, 55, 75, 128, 162, 0, &
23, 56, 104, 112, 152, 0, &
24, 57, 95, 120, 160, 0, &
1, 58, 73, 90, 106, 166, &
25, 47, 100, 107, 148, 0, &
17, 44, 93, 131, 162, 0, &
23, 58, 98, 109, 164, 0, &
11, 59, 77, 131, 173, 0, &
10, 57, 111, 140, 166, 0, &
18, 60, 81, 122, 166, 0, &
4, 61, 100, 113, 164, 0, &
10, 62, 114, 124, 152, 0, &
8, 63, 80, 115, 155, 0, &
23, 53, 83, 123, 153, 0, &
20, 42, 117, 119, 167, 0, &
26, 50, 80, 114, 165, 0, &
64, 119, 122, 168, 174, 0, &
19, 28, 65, 84, 105, 163, &
12, 65, 101, 121, 170, 0, &
16, 56, 96, 127, 142, 0, &
14, 66, 83, 130, 134, 0, &
27, 66, 70, 113, 121, 147, &
22, 63, 99, 125, 163, 0, &
15, 36, 117, 126, 151, 0, &
26, 46, 104, 129, 168, 0, &
28, 61, 102, 130, 168, 0, &
7, 36, 106, 132, 159, 0, &
29, 49, 102, 135, 145, 0, &
13, 38, 93, 105, 147, 0, &
16, 62, 82, 134, 169, 0, &
14, 42, 78, 129, 171, 0, &
30, 40, 92, 120, 137, 0, &
31, 62, 88, 106, 156, 0, &
9, 60, 103, 136, 138, 0, &
24, 64, 74, 112, 136, 163, &
32, 38, 91, 99, 170, 0, &
30, 47, 136, 141, 159, 0, &
33, 41, 115, 140, 172, 0, &
8, 57, 108, 144, 156, 0, &
34, 49, 108, 125, 171, 0, &
30, 67, 78, 116, 143, 0, &
3, 54, 121, 146, 174, 0, &
3, 28, 68, 92, 127, 0, &
17, 61, 79, 146, 154, 0, &
33, 51, 72, 85, 129, 169, &
21, 35, 71, 84, 150, 169, &
27, 48, 67, 109, 111, 145, &
29, 33, 91, 103, 164, 0, &
9, 56, 94, 133, 135, 0, &
21, 58, 77, 127, 165, 0, &
19, 54, 73, 75, 124, 153, &
34, 59, 66, 79, 128, 158, &
29, 40, 134, 144, 173, 0, &
25, 39, 95, 132, 172, 0, &
20, 52, 125, 140, 157, 0, &
5, 48, 76, 110, 161, 0, &
6, 43, 69, 86, 141, 171, &
35, 63, 98, 141, 161, 0, &
18, 35, 124, 144, 151, 0, &
24, 45, 86, 118, 173, 0, &
32, 59, 119, 132, 143, 0, &
27, 50, 81, 131, 133, 0, &
13, 53, 115, 137, 158, 0, &
34, 65, 72, 107, 111, 167, &
36, 60, 87, 139, 162, 0, &
2, 3, 44, 89, 150, 0, &
2, 31, 107, 130, 160, 0, &
26, 55, 74, 94, 150, 172, &
31, 55, 126, 146, 157, 0, &
1, 22, 67, 71, 123, 126, &
32, 68, 82, 110, 149, 0, &
7, 69, 104, 137, 170, 0/
data nrw/ &
6,6,6,6,6,6,5,5,6,5,5,5,5,6,5,5,5,5,5,5, &
6,5,5,5,5,5,5,5,5,5,5,6,5,5,5,5,5,5,5,5, &
5,5,5,5,5,6,5,5,5,6,5,5,5,5,5,5,5,5,5,5, &
5,5,6,5,5,5,5,5,5,5,5,5,6,6,6,5,5,5,6,6, &
5,5,5,5,6,5,5,5,5,5,5,6,5,5,5,6,5,6,5,5/
ncw=3

11
lib/fsk4hf/ldpc_174_91_a_colorder.f90
View File

@ -1,11 +0,0 @@
data colorder/ &
0, 1, 2, 3, 28, 4, 5, 6, 7, 8, 9, 10, 11, 34, 12, 32, 13, 14, 15, 16,&
17, 18, 36, 29, 40, 19, 20, 38, 21, 41, 30, 42, 22, 44, 37, 47, 48, 23, 33, 43,&
49, 45, 56, 39, 25, 26, 46, 50, 51, 52, 24, 57, 58, 61, 31, 54, 64, 35, 27, 62,&
59, 53, 60, 63, 55, 70, 66, 67, 68, 65, 71, 74, 72, 73, 77, 75, 69, 76, 79, 82,&
83, 78, 81, 80, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99,&
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,&
120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,&
140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,&
160,161,162,163,164,165,166,167,168,169,170,171,172,173/

87
lib/fsk4hf/ldpc_174_91_a_generator.f90
View File

@ -1,87 +0,0 @@
character*23 g(83)
data g/ &
"2a6a9ab98f661b797baa21a", &
"5fda604488977fdc30ff630", &
"8a450007032409e8797b13a", &
"0f7923bfa5d559590ef6efe", &
"44dc14bc4461e645f847c78", &
"f8c66224febd3e60f5e3708", &
"6d60329e83fb0e1b1bdac2e", &
"66435a472a7837a0e5d4e12", &
"9d0feced8745a66e328c310", &
"1791b0e7c5eaa43710c4276", &
"e5cbd2d5b4d65d3a432d97e", &
"c2241f8795e0e5bc6bd9052", &
"222d861201a4697c2689576", &
"aa2ee5d6d462e206f59cbe8", &
"e486eb73894e6a0964d8c40", &
"4099d5b42d36301cff6dbd6", &
"40c50b9341f7b5ea08dabde", &
"c90359074895363d428f072", &
"ca819cb6569fbfe26b68ef8", &
"4d983341fb56b8e1dae3450", &
"2dce341bc8fd0e5de04fa52", &
"3e7b01b376e3e5f6080de0e", &
"6c8b0813ca2394c08564f94", &
"c322ca8ea866784adc9451a", &
"6378aa1a03fab3e163aa4b0", &
"3c92ea8df0003883a021d70", &
"c793729067176eca26b83c2", &
"d3fae76046a36dff711207a", &
"bc9bf3ef57137fda1c325da", &
"a4eabe2df65a083ea6387c8", &
"650e3da3a0c0349154131d8", &
"1fb4c59ffc11c648ad06760", &
"1471f9599543f13fd7eb6ae", &
"6111012405186e84cba67ce", &
"c4da3574edafefff976fc08", &
"953f854e40701063115c0f2", &
"1f7ae6982f9a5733c44fb70", &
"83e101fe5e80c1b8541728e", &
"50375654edd53054f81e228", &
"1bb03a21a6cde34dff7ec96", &
"b0b279a934342aa0e188b3a", &
"e1989846a20a09cd77b1f64", &
"4eb68e01cb07fdbc83edee2", &
"f33ac4ec36a7c8e6ea8364c", &
"99b03a21a6c5e34dfffec96", &
"e50e3de3a1c034915413158", &
"fda09f8b05b8fb80ac78600", &
"ca8709be6b193204dd25ab0", &
"35701ff0cc3a03f213a93d2", &
"c2bfdec67f7b5a4c5ee7544", &
"dc184fe7e93a65c1b4b7cd2", &
"8cf8aac820f107d6ec6b30a", &
"e74b3da5a3e43d593d680e2", &
"c1e51f79db6124243fceadc", &
"29237d5d05dc1a4cca2ddd0", &
"050e76be4749b3b279d6414", &
"dd163959ae739673cde18c6", &
"03e100fe5e81c1b85417a8e", &
"06b2b17f70e75fc365bed20", &
"6df9e72abecd3e03e4b77fa", &
"4fa5370361b4bf3cf6b1296", &
"eabbf88f0a88307629bfd1c", &
"190674f88cf69989c8b8a40", &
"37740c13cfad07f61dcac3a", &
"4e7923bfa5d579590ef4ede", &
"fe74d37b8e5a63a2905da28", &
"2101e7a95979b2c5c44257e", &
"841f3ec7a4585a159fb5796", &
"aa7ff31d4b7f859c21254c2", &
"6e69229ba0cdb7ddcd50930", &
"29cfc4288af223bea58b96e", &
"5d03eba9f51956176b87abe", &
"399cbc33a7498b31d9f79e4", &
"034967e48ab80135b1c7fca", &
"721ad006ac715928df9775e", &
"37210b395327446ac7108f8", &
"52acf6de27477ea937e5330", &
"1f3a8549435c198b68231c8", &
"ef6809edb4a3557cd173d0a", &
"09a31639fef9c7a8b6fcae2", &
"03bc87c137eeec711c68d36", &
"b09347742319f90131d3146", &
"a723c9cef1de8c97f34c94c"/

100
lib/fsk4hf/ldpc_174_91_a_params.f90
View File

@ -1,100 +0,0 @@
integer, parameter:: N=174, K=91, M=N-K
character*23 g(83)
integer colorder(N)
data g/ &
"2a6a9ab98f661b797baa21a", &
"5fda604488977fdc30ff630", &
"8a450007032409e8797b13a", &
"0f7923bfa5d559590ef6efe", &
"44dc14bc4461e645f847c78", &
"f8c66224febd3e60f5e3708", &
"6d60329e83fb0e1b1bdac2e", &
"66435a472a7837a0e5d4e12", &
"9d0feced8745a66e328c310", &
"1791b0e7c5eaa43710c4276", &
"e5cbd2d5b4d65d3a432d97e", &
"c2241f8795e0e5bc6bd9052", &
"222d861201a4697c2689576", &
"aa2ee5d6d462e206f59cbe8", &
"e486eb73894e6a0964d8c40", &
"4099d5b42d36301cff6dbd6", &
"40c50b9341f7b5ea08dabde", &
"c90359074895363d428f072", &
"ca819cb6569fbfe26b68ef8", &
"4d983341fb56b8e1dae3450", &
"2dce341bc8fd0e5de04fa52", &
"3e7b01b376e3e5f6080de0e", &
"6c8b0813ca2394c08564f94", &
"c322ca8ea866784adc9451a", &
"6378aa1a03fab3e163aa4b0", &
"3c92ea8df0003883a021d70", &
"c793729067176eca26b83c2", &
"d3fae76046a36dff711207a", &
"bc9bf3ef57137fda1c325da", &
"a4eabe2df65a083ea6387c8", &
"650e3da3a0c0349154131d8", &
"1fb4c59ffc11c648ad06760", &
"1471f9599543f13fd7eb6ae", &
"6111012405186e84cba67ce", &
"c4da3574edafefff976fc08", &
"953f854e40701063115c0f2", &
"1f7ae6982f9a5733c44fb70", &
"83e101fe5e80c1b8541728e", &
"50375654edd53054f81e228", &
"1bb03a21a6cde34dff7ec96", &
"b0b279a934342aa0e188b3a", &
"e1989846a20a09cd77b1f64", &
"4eb68e01cb07fdbc83edee2", &
"f33ac4ec36a7c8e6ea8364c", &
"99b03a21a6c5e34dfffec96", &
"e50e3de3a1c034915413158", &
"fda09f8b05b8fb80ac78600", &
"ca8709be6b193204dd25ab0", &
"35701ff0cc3a03f213a93d2", &
"c2bfdec67f7b5a4c5ee7544", &
"dc184fe7e93a65c1b4b7cd2", &
"8cf8aac820f107d6ec6b30a", &
"e74b3da5a3e43d593d680e2", &
"c1e51f79db6124243fceadc", &
"29237d5d05dc1a4cca2ddd0", &
"050e76be4749b3b279d6414", &
"dd163959ae739673cde18c6", &
"03e100fe5e81c1b85417a8e", &
"06b2b17f70e75fc365bed20", &
"6df9e72abecd3e03e4b77fa", &
"4fa5370361b4bf3cf6b1296", &
"eabbf88f0a88307629bfd1c", &
"190674f88cf69989c8b8a40", &
"37740c13cfad07f61dcac3a", &
"4e7923bfa5d579590ef4ede", &
"fe74d37b8e5a63a2905da28", &
"2101e7a95979b2c5c44257e", &
"841f3ec7a4585a159fb5796", &
"aa7ff31d4b7f859c21254c2", &
"6e69229ba0cdb7ddcd50930", &
"29cfc4288af223bea58b96e", &
"5d03eba9f51956176b87abe", &
"399cbc33a7498b31d9f79e4", &
"034967e48ab80135b1c7fca", &
"721ad006ac715928df9775e", &
"37210b395327446ac7108f8", &
"52acf6de27477ea937e5330", &
"1f3a8549435c198b68231c8", &
"ef6809edb4a3557cd173d0a", &
"09a31639fef9c7a8b6fcae2", &
"03bc87c137eeec711c68d36", &
"b09347742319f90131d3146", &
"a723c9cef1de8c97f34c94c"/
data colorder/ &
0, 1, 2, 3, 28, 4, 5, 6, 7, 8, 9, 10, 11, 34, 12, 32, 13, 14, 15, 16,&
17, 18, 36, 29, 40, 19, 20, 38, 21, 41, 30, 42, 22, 44, 37, 47, 48, 23, 33, 43,&
49, 45, 56, 39, 25, 26, 46, 50, 51, 52, 24, 57, 58, 61, 31, 54, 64, 35, 27, 62,&
59, 53, 60, 63, 55, 70, 66, 67, 68, 65, 71, 74, 72, 73, 77, 75, 69, 76, 79, 82,&
83, 78, 81, 80, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99,&
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,&
120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,&
140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,&
160,161,162,163,164,165,166,167,168,169,170,171,172,173/

269
lib/fsk4hf/ldpc_174_91_a_parity.f90
View File

@ -1,269 +0,0 @@
data Mn/ &
1, 24, 66, &
2, 5, 70, &
3, 31, 65, &
4, 49, 58, &
6, 60, 67, &
7, 32, 75, &
8, 48, 82, &
9, 35, 41, &
10, 39, 62, &
11, 14, 61, &
12, 71, 74, &
13, 23, 78, &
15, 16, 79, &
17, 54, 63, &
18, 50, 57, &
19, 30, 47, &
20, 64, 80, &
21, 28, 69, &
22, 25, 43, &
26, 34, 72, &
27, 36, 37, &
29, 40, 44, &
33, 52, 53, &
38, 55, 83, &
42, 51, 59, &
45, 76, 81, &
46, 68, 77, &
56, 67, 73, &
1, 4, 5, &
2, 47, 51, &
3, 46, 82, &
6, 24, 76, &
7, 9, 16, &
8, 10, 78, &
11, 35, 55, &
12, 38, 64, &
13, 42, 83, &
14, 27, 54, &
15, 21, 34, &
17, 44, 53, &
18, 25, 28, &
19, 33, 57, &
20, 22, 73, &
23, 40, 81, &
26, 49, 68, &
29, 71, 75, &
30, 65, 79, &
31, 36, 60, &
32, 43, 77, &
37, 62, 70, &
39, 69, 74, &
41, 52, 66, &
45, 50, 61, &
48, 63, 80, &
56, 59, 72, &
58, 64, 65, &
1, 13, 28, &
2, 48, 75, &
3, 53, 69, &
4, 11, 44, &
5, 73, 79, &
6, 12, 17, &
7, 57, 60, &
8, 15, 61, &
9, 39, 59, &
10, 19, 49, &
14, 43, 52, &
16, 54, 68, &
18, 41, 63, &
20, 36, 45, &
21, 67, 77, &
10, 22, 55, &
23, 65, 72, &
24, 27, 82, &
25, 26, 29, &
30, 35, 37, &
31, 51, 66, &
17, 32, 78, &
33, 42, 76, &
34, 70, 83, &
38, 46, 81, &
40, 62, 80, &
45, 47, 74, &
50, 56, 71, &
7, 37, 58, &
1, 16, 71, &
2, 6, 61, &
3, 22, 50, &
4, 59, 77, &
5, 41, 81, &
8, 58, 74, &
9, 20, 26, &
11, 21, 31, &
12, 66, 79, &
13, 14, 57, &
15, 33, 40, &
18, 44, 82, &
19, 69, 83, &
23, 49, 63, &
24, 29, 39, &
25, 47, 56, &
27, 55, 72, &
28, 64, 70, &
30, 48, 77, &
32, 34, 45, &
35, 68, 80, &
36, 38, 52, &
42, 43, 62, &
46, 60, 78, &
51, 54, 67, &
53, 73, 75, &
14, 73, 76, &
1, 22, 30, &
2, 35, 43, &
3, 47, 63, &
4, 25, 76, &
5, 33, 78, &
6, 20, 83, &
7, 12, 72, &
8, 54, 70, &
9, 61, 65, &
10, 34, 51, &
11, 46, 75, &
13, 39, 68, &
15, 17, 56, &
16, 23, 36, &
18, 32, 55, &
19, 31, 81, &
21, 37, 71, &
24, 57, 64, &
26, 38, 48, &
27, 49, 50, &
28, 52, 59, &
29, 41, 58, &
40, 60, 74, &
42, 44, 79, &
51, 53, 80, &
62, 67, 82, &
23, 66, 69, &
1, 53, 61, &
2, 18, 39, &
3, 4, 12, &
5, 26, 74, &
6, 30, 52, &
7, 82, 83, &
8, 35, 73, &
9, 19, 67, &
10, 64, 75, &
11, 20, 33, &
13, 45, 48, &
3, 14, 40, &
15, 43, 49, &
16, 55, 76, &
17, 62, 65, &
21, 47, 78, &
22, 59, 81, &
24, 34, 63, &
25, 37, 66, &
27, 79, 80, &
28, 60, 79, &
29, 31, 70, &
32, 58, 69, &
10, 36, 77, &
38, 50, 51, &
13, 41, 56, &
42, 63, 71, &
44, 47, 68, &
1, 46, 72, &
54, 57, 75, &
2, 33, 58, &
4, 17, 83, &
5, 14, 55, &
6, 23, 48, &
7, 52, 56/
data Nm/ &
1, 29, 57, 86, 113, 140, 168, &
2, 30, 58, 87, 114, 141, 170, &
3, 31, 59, 88, 115, 142, 151, &
4, 29, 60, 89, 116, 142, 171, &
2, 29, 61, 90, 117, 143, 172, &
5, 32, 62, 87, 118, 144, 173, &
6, 33, 63, 85, 119, 145, 174, &
7, 34, 64, 91, 120, 146, 0, &
8, 33, 65, 92, 121, 147, 0, &
9, 34, 66, 72, 122, 148, 163, &
10, 35, 60, 93, 123, 149, 0, &
11, 36, 62, 94, 119, 142, 0, &
12, 37, 57, 95, 124, 150, 165, &
10, 38, 67, 95, 112, 151, 172, &
13, 39, 64, 96, 125, 152, 0, &
13, 33, 68, 86, 126, 153, 0, &
14, 40, 62, 78, 125, 154, 171, &
15, 41, 69, 97, 127, 141, 0, &
16, 42, 66, 98, 128, 147, 0, &
17, 43, 70, 92, 118, 149, 0, &
18, 39, 71, 93, 129, 155, 0, &
19, 43, 72, 88, 113, 156, 0, &
12, 44, 73, 99, 126, 139, 173, &
1, 32, 74, 100, 130, 157, 0, &
19, 41, 75, 101, 116, 158, 0, &
20, 45, 75, 92, 131, 143, 0, &
21, 38, 74, 102, 132, 159, 0, &
18, 41, 57, 103, 133, 160, 0, &
22, 46, 75, 100, 134, 161, 0, &
16, 47, 76, 104, 113, 144, 0, &
3, 48, 77, 93, 128, 161, 0, &
6, 49, 78, 105, 127, 162, 0, &
23, 42, 79, 96, 117, 149, 170, &
20, 39, 80, 105, 122, 157, 0, &
8, 35, 76, 106, 114, 146, 0, &
21, 48, 70, 107, 126, 163, 0, &
21, 50, 76, 85, 129, 158, 0, &
24, 36, 81, 107, 131, 164, 0, &
9, 51, 65, 100, 124, 141, 0, &
22, 44, 82, 96, 135, 151, 0, &
8, 52, 69, 90, 134, 165, 0, &
25, 37, 79, 108, 136, 166, 0, &
19, 49, 67, 108, 114, 152, 0, &
22, 40, 60, 97, 136, 167, 0, &
26, 53, 70, 83, 105, 150, 0, &
27, 31, 81, 109, 123, 168, 0, &
16, 30, 83, 101, 115, 155, 167, &
7, 54, 58, 104, 131, 150, 173, &
4, 45, 66, 99, 132, 152, 0, &
15, 53, 84, 88, 132, 164, 0, &
25, 30, 77, 110, 122, 137, 164, &
23, 52, 67, 107, 133, 144, 174, &
23, 40, 59, 111, 137, 140, 0, &
14, 38, 68, 110, 120, 169, 0, &
24, 35, 72, 102, 127, 153, 172, &
28, 55, 84, 101, 125, 165, 174, &
15, 42, 63, 95, 130, 169, 0, &
4, 56, 85, 91, 134, 162, 170, &
25, 55, 65, 89, 133, 156, 0, &
5, 48, 63, 109, 135, 160, 0, &
10, 53, 64, 87, 121, 140, 0, &
9, 50, 82, 108, 138, 154, 0, &
14, 54, 69, 99, 115, 157, 166, &
17, 36, 56, 103, 130, 148, 0, &
3, 47, 56, 73, 121, 154, 0, &
1, 52, 77, 94, 139, 158, 0, &
5, 28, 71, 110, 138, 147, 0, &
27, 45, 68, 106, 124, 167, 0, &
18, 51, 59, 98, 139, 162, 0, &
2, 50, 80, 103, 120, 161, 0, &
11, 46, 84, 86, 129, 166, 0, &
20, 55, 73, 102, 119, 168, 0, &
28, 43, 61, 111, 112, 146, 0, &
11, 51, 83, 91, 135, 143, 0, &
6, 46, 58, 111, 123, 148, 169, &
26, 32, 79, 112, 116, 153, 0, &
27, 49, 71, 89, 104, 163, 0, &
12, 34, 78, 109, 117, 155, 0, &
13, 47, 61, 94, 136, 159, 160, &
17, 54, 82, 106, 137, 159, 0, &
26, 44, 81, 90, 128, 156, 0, &
7, 31, 74, 97, 138, 145, 0, &
24, 37, 80, 98, 118, 145, 171/
data nrw/ &
7,7,7,7,7,7,7,6,6,7,6,6,7,7,6,6,7,6, &
6,6,6,6,7,6,6,6,6,6,6,6,6,6,7,6,6,6, &
6,6,6,6,6,6,6,6,6,6,7,7,6,6,7,7,6,6, &
7,7,6,7,6,6,6,6,7,6,6,6,6,6,6,6,6,6, &
6,6,7,6,6,6,7,6,6,6,7/
ncw=3

154
lib/fsk4hf/ldpc_204_68_params.f90
View File

@ -1,154 +0,0 @@
integer, parameter:: N=204, K=68, M=N-K
character*17 g(136)
integer colorder(N)
data g/ & !parity generator matrix for (204,68) code
"2de7435fd27c0031d", &
"f331b40671e20ea80", &
"48bd3f8cb9a24392f", &
"d4ed71c935162aa2a", &
"c437a3284ec58bce7", &
"35a806dd5be35627c", &
"396e797c33a4739a6", &
"768f331a59c15487b", &
"c214eac24ae5e1732", &
"0b5c53ff3a6da1192", &
"99624981d2703fb97", &
"e9f5447ef7f1ff6af", &
"bd8c730f0cfdf0727", &
"26f61e63e1e098f7f", &
"ef826566137b6526f", &
"af0e4fa251e9b4926", &
"75974a8b2a24292c5", &
"71caf0f2cd10f6d4f", &
"b1103f1f26e6898b7", &
"67ceb7d6f490da64f", &
"ee0e8fbefec23008a", &
"11cc2227e8bd676ca", &
"6e71626ba1e278046", &
"005d28da267e50e13", &
"a9ae4a130aaba8219", &
"d8ab72e0158d0da70", &
"56009d42b37bd66ff", &
"c39a75eca99b0e996", &
"6886de0bf7c0bf4bb", &
"1046cd8f64162f7b5", &
"da0f15843ac21e3a5", &
"e9bf9cd19f3db3913", &
"2fb9cb42d650f47a7", &
"a2b6c5a378fa75a65", &
"41a88f3cd60b79d6c", &
"fcf175794cc3ac96a", &
"8677a3447d40a9f71", &
"97a1f08c250b4bf12", &
"0168f090a1df6e8ea", &
"418a06bf372cc67d9", &
"0f17b880c1ff51239", &
"b2afd6d585deb961b", &
"60298ac5b58dbeee0", &
"8350c03c40119feff", &
"b29c964a8accf6af4", &
"9b46f036a5c178b5d", &
"917398bff051c300a", &
"5e52c03b2f8c5128c", &
"beae6c33c87ba38ab", &
"20843f7b056a02ebf", &
"66690d65acd9de598", &
"8f025841af5b54331", &
"b43cd869d3be2c3db", &
"c9c342fe63c18df50", &
"d331b40671e28ea80", &
"62406a0f4947e6ce9", &
"d67b1495883b22e1b", &
"734534c372408895b", &
"d88750e33d9677dcd", &
"6f96964da55138687", &
"80bee98bb75d50ef2", &
"c428ef3e3f06f4c56", &
"b1a1499b125883a35", &
"ac892d4b37fa9e395", &
"458dbda0f95ab11a5", &
"6f93c9e95b1094eed", &
"2e370d713914f848e", &
"758806dd5be35627c", &
"8c52e01caec798b49", &
"c286cc25bae3669cf", &
"87c56fb895c100884", &
"e89cb1376a18fd911", &
"156ffe5f30dc354e0", &
"f20d0b121d6a6b3ee", &
"7db08891b491a95d2", &
"191fac548d5077bdf", &
"023a37d7ea5660bbc", &
"6781668b363fee682", &
"bbfaf262cab7370da", &
"feea557965b7e474f", &
"c094eb223e1d305b8", &
"2be051abdd5beea35", &
"0790449880fda9d00", &
"f9029a39ec869e7b4", &
"5a29f48926ec9a552", &
"e0463306dc1470f87", &
"9251058334d790f86", &
"3019e1d4578e8a4dc", &
"887e46631502fa111", &
"c25fcd7a42465d326", &
"cf64bcc1056b555c4", &
"3e71c0fe5f0ad733b", &
"11055ec43b076e5b2", &
"3440f64dfa3c30a96", &
"2b73885b4d3299f60", &
"2e71627ba1e268046", &
"ad23743d5e6e5b80c", &
"c9757b05f29bfdc10", &
"f7112bea739247b51", &
"3664062387998b2b1", &
"90897a3b8785aefba", &
"29e126e3201fc1d46", &
"96c9001c84d5257fc", &
"067723447d40a9f71", &
"1a019cc68f7511402", &
"4bd48eb2330032763", &
"d139a5da936b37647", &
"765ab46a4dec5f04f", &
"706f475ad19b91955", &
"1755c988fa8a55e5c", &
"2fd9ed5777eb01d6a", &
"bec27d85b954d3fe8", &
"7135a3b92c45b3f8d", &
"353237872f002163a", &
"e31e4a97aef10c729", &
"da527d5e1cbc4edb6", &
"6e33cdede17c3207e", &
"ef2d2062e84dc401f", &
"8217c84c50c1bf833", &
"12ffbac7b2219c9e0", &
"3729178706f66881f", &
"2fdd748c382a608a1", &
"dd0a00076f9dcec73", &
"46b1d37bced447035", &
"7316f33a9c05ef178", &
"152c39a6de8954cc3", &
"16efffb7b62e12ba3", &
"9d9ec2bb467affd83", &
"467723445d40a9f61", &
"87994762b3bf50697", &
"b1bfa5b51526dde9b", &
"b0a6a19d709a96148", &
"990d567c0aba31a14", &
"171f190792461b1e0", &
"166011c27d2b6b8a4", &
"170c15831244ae73e"/
data colorder/ &
0, 1, 2, 3, 4, 5, 47, 6, 7, 8, 9, 10, 11, 12, 58, 55, 13, &
14, 15, 46, 17, 18, 60, 19, 20, 21, 22, 23, 24, 25, 57, 26, 27, 49, &
28, 52, 65, 16, 50, 73, 59, 68, 63, 29, 30, 31, 32, 51, 62, 56, 66, &
45, 33, 34, 53, 67, 35, 36, 37, 61, 69, 54, 38, 71, 82, 39, 77, 80, &
83, 78, 84, 48, 41, 85, 40, 64, 75, 96, 74, 72, 76, 86, 87, 89, 90, &
79, 70, 92, 99, 93,101, 95,100, 97, 94, 42, 98,103,105,102, 43,104, &
88, 44,106, 81,107,110,108,111,112,109,113,114,117,118,116,121,115, &
119,122,120,125,129,124,127,126,128, 91,123,133,131,130,134,135,137, &
136,132,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152, &
153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169, &
170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186, &
187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203/

142
lib/fsk4hf/ldpc_240_101_generator.f90
View File

@ -1,142 +0,0 @@
character*26 g(139)
data g/ &
"e28df133efbc554bcd30eb1828", &
"b1adf97787f81b4ac02e0caff8", &
"e70c43adce5036f847af367560", &
"c26663f7f7acafdf5abacb6f30", &
"eba93204ddfa3bcf994aea8998", &
"126b51e33c6a740afa0d5ce990", &
"b41a1569e6fede1f2f5395cb68", &
"1d3af0bb43fddbc670a291cc70", &
"e0aebd9921e2c9e1d453ffccb0", &
"897d1370f0df94b8b27a5e4fb8", &
"5e97539338003b13fa8198ad38", &
"7276b87da4a4d777e2752fdd48", &
"989888bd3a85835e2bc6a560f8", &
"7ec4f4a56199ab0a8d6e102478", &
"207007665090258782d1b38a98", &
"1ea1f61cd7f0b7eed7dd346ab8", &
"08f150b27c7f18a027783de0e8", &
"d42324a4e21b62d548d7865858", &
"2e029656269d4fe46e167d21d0", &
"7d84acb7737b0ca6b6f2ef5eb0", &
"6674ca04528ad4782bf5e15248", &
"118ce9825f563ae4963af7a0b0", &
"fb06248cc985e314b1b36ccd38", &
"1c478b7a5aec7e1cfc9c24eb70", &
"185a0f06a84f7f4f484c455020", &
"98b840a3a70688cd58588e3e30", &
"cfb7719de83a3baf582e5b2aa0", &
"9d8cc6b5a01fdbfa307a769048", &
"ed776a728ca162d6fcc8996760", &
"8d2b068128dfb2f8d22c79db50", &
"bd2ba50007789ffb7324aa9190", &
"fd95008fe88812025e78065610", &
"3027849be8e99f9ef68eac1020", &
"88574e1ea39d87414b15e803a8", &
"89365b330e76e6dde740dced08", &
"c83f37b913ed0f6b802aaf21d8", &
"bdca7c1959caa7488b7eb13030", &
"794e0b4888e1ef42992287dd98", &
"526ac87fbaa790c6cd58864e08", &
"940518ba1a51c1da55bc8b2d70", &
"59c5e51ebfbd02ab30ff822378", &
"c81fff87866e04f8f3948c7f10", &
"7913513f3e2a3c0f76b69f6d68", &
"e43cc04da189c44803c4f740a0", &
"fdca7c1959ca85488b7eb13030", &
"95b07fce9b7b1bf4f057ca61b8", &
"d7db48a86691a0c0c9305aac90", &
"0d50bf79a59464597c43ba8058", &
"4a9c34b23fd5eaff8c9dc215e0", &
"3d5305a6f0427938eeb9d1c118", &
"55d8b6b58039f7a3a2d592a900", &
"784f349ecb74c4abbdbb073b90", &
"5973bbb2205f9d6a5c9a55c238", &
"5d2ee61006fec94f69f6b0f460", &
"9e1f52ef1e6589990dd0ce0cc8", &
"85b7b48f4b45775c9f8a36cc90", &
"ae1d6a0171168f6d70804b79f8", &
"a467aa9aa6cdc7094677c730d8", &
"dcf2f56c9ae20fb57e89b916d0", &
"3ae98d26ae96ea714c1a5146d0", &
"103c89581446805b8c71b2e638", &
"6783f3dfec835dd4e92131cc20", &
"52f88428c50f12c55876f7d8a8", &
"51fcb0e56a22fa3b7140aeaa80", &
"07c54871155603e65325f66cd8", &
"a8dd4fac47a113ee5706eef180", &
"f6cdc6f4cc1fa7e4db15bf86f8", &
"2e1c6a0171168f6d70c04a79f8", &
"2a90ab82bef6424db981752dc8", &
"845a1db59c193249d937e889d0", &
"a929d379f1769cb4baa4e41e90", &
"0c2a5829548d82223d6f566d48", &
"420087bc5c4e2f5bc139ad0220", &
"6df8d880ae7209fe52c69ede00", &
"dfbdcef29a985fd40d052d1a88", &
"8567fc332342b1ed8408f5fa00", &
"c908feb4e1866a24ca0c702a08", &
"645f5ee59f9f64fd43a5f2ec30", &
"bee56991e877baf3e9cf11b770", &
"649ea2e4194ca51be28abf3430", &
"90e7394c551bd58d00686d5420", &
"4e3cf731f8f89e8414214afaf0", &
"dcbf16aa8180a7712571e94f98", &
"9b456c015999c52b7fbd1ab390", &
"397ab76924659c4b8b3be4ac58", &
"4f5038c4f9da4b02bdfa178278", &
"4892fada978c98dd4fd363c450", &
"6c8af64b426bc474431c110c98", &
"84a553be5ef0e57390a5af05b0", &
"bed4a9347c9a2064f6d63ac0f8", &
"d973bbb2605f9d6a5c9a57c238", &
"1e3bee9a99fe10d3864ee669d8", &
"a590771ff185d807cb32f46000", &
"9a498fc4b549d81c625f80fc90", &
"28b3e72878aadee7e0e2617950", &
"96ce025d621a91396aa8f3ec20", &
"4f5a77becf838a590d6d406ea8", &
"52d3856dfb9fe78012f10e25c0", &
"b45323c2b28b4752ca0675d2e0", &
"3bae5a8452a785beb35851ad18", &
"65098832d20d915e75bea336e8", &
"5eb6f3c331098e8c0fbfa3aee0", &
"ef19d974a25540c8998fbf1df0", &
"403ea58feff08cf92d5cacc780", &
"6ba93204ddfa7bcb994aea8998", &
"653909166aa7bead4bd9c90020", &
"089cb20e639bc5a44da66f17c0", &
"10f803949961359e994f5ade88", &
"15b7ec1e6106cd55ef7d996590", &
"c99e99de9d85d2b999a17a95d8", &
"ca3e161b97148bac6dd28a6178", &
"e1ab199c992cb4c22aee115358", &
"ea8a4d0e96d3d9f827899b6d88", &
"8af4992d60223f021569a8ab60", &
"5087771abceb87a6d872291fe8", &
"d045e0812e217bb7bbdac92f30", &
"ccccd78ae5fa6e191f21c06908", &
"54545f37df6fed4734ef6509b0", &
"b0780327d899cbc03d95a81a48", &
"a4229c31f2b85e44a322273d50", &
"d182ab001c2085ea7be26a20d0", &
"1a82c30b4fba7dfaafb8d287a8", &
"d974fba598e7fb0630c1587db0", &
"b5c078a8cbab3e73728659ea20", &
"626bbf9eed1a8715c3a7d38f60", &
"c1efe9aa67130865fda93d8be8", &
"d39796dbce155df6306e7b77c0", &
"c7e7c1f032d7209b4549e84aa8", &
"d5799b30a1605baf6b9cd04960", &
"0baf2d21051a926dfd87046d70", &
"da8bf7d1e305c499b573c02cc8", &
"0ccaa7fffb9ae3e42dd0688328", &
"b951b62e18f5290ac13c195130", &
"79b006f001961fb233be80d0e8", &
"56637b6dedfd6e050f06404a48", &
"e0c4bf71a15597523bbd57bde0", &
"1312231ffa04426a34a8fab038", &
"db5f6f0455d24b8358d1cbc3d8", &
"d559e31b34d21f48e1f501af30"/

393
lib/fsk4hf/ldpc_240_101_parity.f90
View File

@ -1,393 +0,0 @@
data Mn/ &
57, 100, 134, &
56, 99, 136, &
1, 12, 15, &
2, 23, 72, &
3, 133, 137, &
4, 93, 125, &
5, 68, 139, &
6, 38, 55, &
7, 40, 78, &
8, 30, 84, &
9, 17, 122, &
10, 34, 95, &
11, 36, 138, &
13, 90, 132, &
14, 50, 117, &
16, 57, 83, &
18, 22, 121, &
19, 60, 89, &
20, 98, 107, &
21, 37, 61, &
24, 26, 75, &
25, 88, 115, &
27, 49, 127, &
28, 74, 119, &
29, 111, 114, &
31, 91, 129, &
32, 96, 104, &
30, 33, 130, &
35, 65, 135, &
41, 42, 87, &
44, 108, 131, &
45, 94, 101, &
45, 46, 97, &
47, 102, 134, &
48, 64, 104, &
19, 51, 116, &
20, 52, 67, &
53, 104, 113, &
12, 54, 103, &
58, 66, 88, &
62, 80, 124, &
63, 70, 71, &
73, 114, 123, &
76, 85, 128, &
77, 106, 109, &
46, 79, 126, &
61, 81, 110, &
82, 92, 120, &
86, 105, 112, &
66, 100, 118, &
23, 51, 136, &
1, 40, 53, &
2, 73, 81, &
3, 63, 130, &
4, 68, 136, &
5, 60, 78, &
6, 72, 131, &
7, 115, 124, &
8, 89, 120, &
9, 15, 44, &
10, 22, 93, &
11, 49, 100, &
13, 55, 80, &
14, 76, 95, &
16, 54, 111, &
17, 41, 110, &
18, 69, 139, &
21, 24, 116, &
25, 39, 71, &
26, 69, 90, &
27, 101, 133, &
28, 64, 126, &
29, 94, 103, &
31, 56, 57, &
32, 91, 102, &
33, 35, 129, &
34, 47, 128, &
36, 86, 117, &
37, 74, 75, &
38, 79, 106, &
42, 82, 123, &
43, 77, 99, &
48, 70, 92, &
50, 109, 118, &
52, 112, 119, &
58, 62, 108, &
59, 84, 134, &
57, 65, 122, &
67, 97, 113, &
83, 127, 135, &
85, 121, 125, &
87, 132, 137, &
96, 98, 105, &
73, 107, 138, &
1, 83, 89, &
2, 41, 70, &
3, 35, 131, &
4, 111, 128, &
5, 29, 99, &
6, 25, 31, &
7, 19, 96, &
1, 39, 110, &
2, 7, 117, &
3, 49, 109, &
4, 81, 96, &
5, 100, 108, &
6, 51, 124, &
2, 20, 132, &
8, 80, 137, &
9, 56, 67, &
10, 63, 102, &
11, 16, 101, &
12, 115, 122, &
13, 32, 128, &
14, 15, 130, &
14, 70, 99, &
11, 51, 69, &
17, 89, 105, &
18, 83, 99, &
19, 44, 79, &
20, 106, 133, &
10, 21, 123, &
22, 23, 61, &
16, 22, 60, &
24, 38, 114, &
25, 37, 42, &
26, 43, 52, &
27, 68, 71, &
28, 65, 139, &
29, 62, 69, &
30, 92, 126, &
31, 78, 123, &
13, 44, 78, &
33, 40, 120, &
7, 34, 119, &
4, 35, 77, &
12, 36, 52, &
25, 98, 136, &
5, 24, 133, &
1, 80, 91, &
33, 96, 97, &
34, 41, 91, &
32, 37, 117, &
26, 72, 125, &
19, 65, 75, &
45, 131, 136, &
46, 55, 70, &
47, 48, 50, &
6, 48, 94, &
3, 74, 79, &
39, 50, 126, &
23, 118, 127, &
21, 36, 113, &
53, 77, 134, &
30, 54, 55, &
17, 46, 135, &
9, 92, 102, &
57, 85, 87, &
58, 125, 138, &
59, 76, 93, &
60, 66, 107, &
47, 132, 138, &
29, 85, 131, &
43, 73, 108, &
64, 75, 129, &
28, 38, 53, &
61, 106, 122, &
56, 71, 114, &
27, 57, 120, &
62, 67, 130, &
54, 104, 118, &
8, 68, 115, &
72, 86, 111, &
73, 74, 94, &
49, 105, 113, &
42, 86, 121, &
40, 59, 109, &
35, 88, 95, &
31, 107, 112, &
58, 64, 87, &
68, 79, 104, &
1, 5, 121, &
15, 82, 93, &
18, 88, 116, &
82, 84, 119, &
7, 71, 103, &
4, 80, 94, &
63, 81, 84, &
66, 76, 137, &
83, 124, 129, &
90, 112, 116, &
89, 111, 134, &
6, 21, 120, &
3, 16, 25, &
12, 28, 131, &
45, 95, 110, &
17, 93, 124, &
97, 121, 127, &
98, 103, 135, &
8, 99, 138, &
41, 101, 139, &
13, 24, 105, &
14, 53, 107, &
10, 64, 98, &
11, 35, 78, &
90, 100, 103, &
9, 72, 101, &
18, 74, 92, &
15, 73, 87, &
2, 88, 113, &
20, 55, 85, &
19, 67, 110, &
26, 27, 95, &
22, 50, 114, &
29, 49, 81, &
32, 52, 83, &
30, 37, 77, &
39, 128, 135, &
23, 128, 130, &
36, 76, 126, &
33, 132, 139, &
34, 89, 118, &
38, 58, 127, &
31, 54, 125, &
40, 70, 75, &
41, 109, 116, &
43, 60, 63, &
44, 84, 86, &
42, 47, 62, &
45, 82, 90, &
43, 46, 91, &
48, 112, 122, &
51, 102, 133, &
59, 61, 108, &
65, 117, 137, &
56, 66, 96, &
59, 69, 104, &
39, 69, 119, &
97, 115, 123, &
106, 111, 129/
data Nm/ &
3, 52, 95, 102, 140, 182, &
4, 53, 96, 103, 108, 210, &
5, 54, 97, 104, 150, 194, &
6, 55, 98, 105, 136, 187, &
7, 56, 99, 106, 139, 182, &
8, 57, 100, 107, 149, 193, &
9, 58, 101, 103, 135, 186, &
10, 59, 109, 172, 200, 0, &
11, 60, 110, 157, 207, 0, &
12, 61, 111, 122, 204, 0, &
13, 62, 112, 117, 205, 0, &
3, 39, 113, 137, 195, 0, &
14, 63, 114, 133, 202, 0, &
15, 64, 115, 116, 203, 0, &
3, 60, 115, 183, 209, 0, &
16, 65, 112, 124, 194, 0, &
11, 66, 118, 156, 197, 0, &
17, 67, 119, 184, 208, 0, &
18, 36, 101, 120, 145, 212, &
19, 37, 108, 121, 211, 0, &
20, 68, 122, 153, 193, 0, &
17, 61, 123, 124, 214, 0, &
4, 51, 123, 152, 219, 0, &
21, 68, 125, 139, 202, 0, &
22, 69, 100, 126, 138, 194, &
21, 70, 127, 144, 213, 0, &
23, 71, 128, 169, 213, 0, &
24, 72, 129, 166, 195, 0, &
25, 73, 99, 130, 163, 215, &
10, 28, 131, 155, 217, 0, &
26, 74, 100, 132, 179, 224, &
27, 75, 114, 143, 216, 0, &
28, 76, 134, 141, 221, 0, &
12, 77, 135, 142, 222, 0, &
29, 76, 97, 136, 178, 205, &
13, 78, 137, 153, 220, 0, &
20, 79, 126, 143, 217, 0, &
8, 80, 125, 166, 223, 0, &
69, 102, 151, 218, 238, 0, &
9, 52, 134, 177, 225, 0, &
30, 66, 96, 142, 201, 226, &
30, 81, 126, 176, 229, 0, &
82, 127, 164, 227, 231, 0, &
31, 60, 120, 133, 228, 0, &
32, 33, 146, 196, 230, 0, &
33, 46, 147, 156, 231, 0, &
34, 77, 148, 162, 229, 0, &
35, 83, 148, 149, 232, 0, &
23, 62, 104, 175, 215, 0, &
15, 84, 148, 151, 214, 0, &
36, 51, 107, 117, 233, 0, &
37, 85, 127, 137, 216, 0, &
38, 52, 154, 166, 203, 0, &
39, 65, 155, 171, 224, 0, &
8, 63, 147, 155, 211, 0, &
2, 74, 110, 168, 236, 0, &
1, 16, 74, 88, 158, 169, &
40, 86, 159, 180, 223, 0, &
87, 160, 177, 234, 237, 0, &
18, 56, 124, 161, 227, 0, &
20, 47, 123, 167, 234, 0, &
41, 86, 130, 170, 229, 0, &
42, 54, 111, 188, 227, 0, &
35, 72, 165, 180, 204, 0, &
29, 88, 129, 145, 235, 0, &
40, 50, 161, 189, 236, 0, &
37, 89, 110, 170, 212, 0, &
7, 55, 128, 172, 181, 0, &
67, 70, 117, 130, 237, 238, &
42, 83, 96, 116, 147, 225, &
42, 69, 128, 168, 186, 0, &
4, 57, 144, 173, 207, 0, &
43, 53, 94, 164, 174, 209, &
24, 79, 150, 174, 208, 0, &
21, 79, 145, 165, 225, 0, &
44, 64, 160, 189, 220, 0, &
45, 82, 136, 154, 217, 0, &
9, 56, 132, 133, 205, 0, &
46, 80, 120, 150, 181, 0, &
41, 63, 109, 140, 187, 0, &
47, 53, 105, 188, 215, 0, &
48, 81, 183, 185, 230, 0, &
16, 90, 95, 119, 190, 216, &
10, 87, 185, 188, 228, 0, &
44, 91, 158, 163, 211, 0, &
49, 78, 173, 176, 228, 0, &
30, 92, 158, 180, 209, 0, &
22, 40, 178, 184, 210, 0, &
18, 59, 95, 118, 192, 222, &
14, 70, 191, 206, 230, 0, &
26, 75, 140, 142, 231, 0, &
48, 83, 131, 157, 208, 0, &
6, 61, 160, 183, 197, 0, &
32, 73, 149, 174, 187, 0, &
12, 64, 178, 196, 213, 0, &
27, 93, 101, 105, 141, 236, &
33, 89, 141, 198, 239, 0, &
19, 93, 138, 199, 204, 0, &
2, 82, 99, 116, 119, 200, &
1, 50, 62, 106, 206, 0, &
32, 71, 112, 201, 207, 0, &
34, 75, 111, 157, 233, 0, &
39, 73, 186, 199, 206, 0, &
27, 35, 38, 171, 181, 237, &
49, 93, 118, 175, 202, 0, &
45, 80, 121, 167, 240, 0, &
19, 94, 161, 179, 203, 0, &
31, 86, 106, 164, 234, 0, &
45, 84, 104, 177, 226, 0, &
47, 66, 102, 196, 212, 0, &
25, 65, 98, 173, 192, 240, &
49, 85, 179, 191, 232, 0, &
38, 89, 153, 175, 210, 0, &
25, 43, 125, 168, 214, 0, &
22, 58, 113, 172, 239, 0, &
36, 68, 184, 191, 226, 0, &
15, 78, 103, 143, 235, 0, &
50, 84, 152, 171, 222, 0, &
24, 85, 135, 185, 238, 0, &
48, 59, 134, 169, 193, 0, &
17, 91, 176, 182, 198, 0, &
11, 88, 113, 167, 232, 0, &
43, 81, 122, 132, 239, 0, &
41, 58, 107, 190, 197, 0, &
6, 91, 144, 159, 224, 0, &
46, 72, 131, 151, 220, 0, &
23, 90, 152, 198, 223, 0, &
44, 77, 98, 114, 218, 219, &
26, 76, 165, 190, 240, 0, &
28, 54, 115, 170, 219, 0, &
31, 57, 97, 146, 163, 195, &
14, 92, 108, 162, 221, 0, &
5, 71, 121, 139, 233, 0, &
1, 34, 87, 154, 192, 0, &
29, 90, 156, 199, 218, 0, &
2, 51, 55, 138, 146, 0, &
5, 92, 109, 189, 235, 0, &
13, 94, 159, 162, 200, 0, &
7, 67, 129, 201, 221, 0/
data nrw/ &
6,6,6,6,6,6,6,5,5,5,5,5,5,5,5,5,5,5,6,5, &
5,5,5,5,6,5,5,5,6,5,6,5,5,5,6,5,5,5,5,5, &
6,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,6,5,5,5, &
5,5,5,5,5,5,5,5,6,6,5,5,6,5,5,5,5,5,5,5, &
5,5,6,5,5,5,5,5,6,5,5,5,5,5,5,6,5,5,6,5, &
5,5,5,6,5,5,5,5,5,5,6,5,5,5,5,5,5,5,5,5, &
5,5,5,5,5,5,5,6,5,5,6,5,5,5,5,5,5,5,5/
ncw=3

182
lib/fsk4hf/ldpc_280_101_generator.f90
View File

@ -1,182 +0,0 @@
character*26 g(179)
data g/ &
"c919bcbfe4091279702a761e98", &
"51b952dddd36200cf73cc1ed30", &
"15871d32e8e888439180cf6fd8", &
"581f858f6c89ee5ccb91664358", &
"3515e85cedf905eda366a8fc20", &
"e9fcaa6aaa9bab21bc91174e80", &
"0ac73221d424e8747628b13968", &
"4999f7116446f1a7a7a1453a30", &
"0e92773bff2a6d4f09caa48898", &
"7dfaec97c17679f6c3b6a425f0", &
"00707d76a2a7d90297ee39f660", &
"8048cc93fc4ad84ccfc021e6e0", &
"0c13df64062fed419c9bf43400", &
"5523d84459c826b7bc3335d508", &
"828ee2552144d041ed44ada8e0", &
"3f1b89fbd93f674df4813f0898", &
"4e13df64062fed419c9bf43400", &
"5d8645307d3d442991d6efafd0", &
"e5cd9b98d73aab17ce04c4df10", &
"06d26e11e2d02e9cb4f191c2b0", &
"5630cebc5b3a09f7d4fe58fab0", &
"bbfa9591589229738ecbc19288", &
"c98654d1f1f16d507e9bb77cf0", &
"c2af2107bb2bdff49d909dc730", &
"51da7da0c9b1bd18a15f580068", &
"5bdfd83e7ca3097146a5359428", &
"34fc4d397d97ca3ceb272f49a0", &
"6716a6d027ade94010e9aa90b0", &
"62ac7bb089d1a13f6e89f92348", &
"737c3ab63210e195e92e8ad478", &
"db2da5b8a21d22a7122ad80e60", &
"1226525dba4221d4768a495878", &
"a99deb4c9b7d316917b1ece958", &
"8123fb46556f22a0b57bdc7eb0", &
"cc6a80e87a7a9bf8addb17a6a8", &
"3d42bb6ca1c8d30e6cee77aa10", &
"ad15a0c2f36d4409a458cc83c0", &
"766a04039736bd8be23513ae58", &
"257a3da77558d7c707170c30c8", &
"8e54a55fd9f00eb669ab787678", &
"4ef1a73cc9da8670d83bebc588", &
"be8bb82558d44fea1ab27376a0", &
"ea9db4f88c60edf410cb0128d8", &
"a84e19a5261818262ee7247278", &
"51f99e4ea17cf84038d4e00bd0", &
"610560db4095fc44d2465308a0", &
"7688745b59c3d6baa6950c4f50", &
"4b8794914d365b6802bd62a9c8", &
"f62c211d05ed28802b9d278298", &
"b9cd45b2ffa8c0dd688f8d2bc0", &
"68555e81f4227a48e76878bc98", &
"7ab58f11d41a2d38b80d2a7558", &
"aba2d33e69077b6acad393af68", &
"81e5f58fa3ab563e73706201a8", &
"7586aea816750c41671eaa7db8", &
"af37b0a97ba5334a3dd01948e8", &
"4fdc03c263a0c42dcc265f7dc8", &
"b23f2d7f28748944cdfffd5af0", &
"5c1e6f37dfba8feacaafdb0f78", &
"3a85b051f4f1c930d921f60828", &
"72319352bd8022ce2cae2e7858", &
"78b79f633ac6879e3ac3a005a0", &
"9f0c470609669953b23328de60", &
"86d3745d50142c82a066ab9490", &
"743e7bf411490f36a9799e37e8", &
"9b8378677870933ef360d7e418", &
"5f7adbf515b663a1434b0d47d8", &
"13249a96b14c6cdcfae5009eb0", &
"da9570e0a52125d0dc4dec4430", &
"ada13ce2dbcb57e2f5b31172f0", &
"84f5485886d4157e9d37efb4d0", &
"23f58c3200bab4ae5dee54edd0", &
"d4377aadf8acb19d4369613ac8", &
"17cefcf65c87885fb6c4d537a0", &
"59d70b8536488298930aaea7f8", &
"49e8dbb08c2ecdaa84bb6a5378", &
"e1694479ecc1f87e503f959e50", &
"dbb3fc94f0f70d4bd4dcf302d8", &
"4ccb3a56f80c236424683b1588", &
"f4f123c72596a00397d56fcdf8", &
"13f9cf266a6957b87cd2b576f0", &
"0904d341bc0878460cd8361ac0", &
"69fd534caf2cccf9c90659a038", &
"757d3d95089a5bc20a7b77c618", &
"30df1d7b8124415c73190b08d8", &
"d39319584987dce0c44176d5d8", &
"1a81df299eb7434a5b6b9322a0", &
"fe4acfab1c22c7bea222f1a6b0", &
"2f2fde37fa8f87a318f7bcda10", &
"fae712210c23665aa7a3f10620", &
"977b8407c7fd22d7715077ee78", &
"2ab2b355b3477df0b738c49d48", &
"93a2468cfd11a522b310069d88", &
"0e5ae6e789ded3c0d436359318", &
"9ece0b13a3c06d560a15d3c448", &
"838e8bbf5e671503ea72ba3118", &
"7c827de9a87d740763c69c6778", &
"1fe395e4e2e6d1373602243488", &
"f2c4efee3d0ce2e22749be9e20", &
"46405cca0e40f36ab83de4a998", &
"8b6e931355a79630ef2dbdbdb8", &
"10df1d3b8124415c72190b08d8", &
"cdff258b07a4f7cfe5c2210ba8", &
"1515e85cedf904eda366a8fc20", &
"a38276f2d077abc1da5e177868", &
"67a7b5ab66f21f391d306c3330", &
"29492cc630f9bad1fdedf0c990", &
"490a6dd38170eab178f7cebf78", &
"ca9db4e88c60edf410cf0128d8", &
"e3f1c23fa8531fb1e4c7768d88", &
"39d7d8fbbb689b2a9bedfd4dd0", &
"d1b952dd5d36200cf734c1ed30", &
"0820a5ccb970d1ab109d84d700", &
"58bc3c509fcd7874e9b1533ba8", &
"08ed7724ac66b7974499b12f40", &
"4738529b2fd04afd89184b64b8", &
"7155b496e3b9f687135b4c55b8", &
"b5d1d3cf38b1765dd730d8b960", &
"296de2c373773a869b9cf804c8", &
"1cdf18b99bcc47ae72bf59df68", &
"ad0888db89dd794be0b2660e98", &
"1f2a8db9db19cd4d69a735d930", &
"44b720007480382206fdbfbb18", &
"c63817aad3801fb993ea9032c0", &
"d44707db5a0b489fd48748cca8", &
"49f98a67c6e128a5300f7ccc50", &
"04849fa9da91d4514355406388", &
"dfad3a11788cf6f6517f987de8", &
"47078a19e38a0763cabd7c8d70", &
"aafa7f864f0da5bc78f8e57ba8", &
"8acb5a34e18e111023b3e7b1f8", &
"5acc41263d6aa1767e5e6acdc8", &
"27623a9f6c1174e35394191820", &
"1f2bde9c006b3b687964b1c5e0", &
"b01c6e357bce202244b4a88d08", &
"61c85d74d7e97576507c9b0e88", &
"bcad5a44d75ae40bc43559d268", &
"10584eaf319552194418563de0", &
"b29b011d717d10a22de0983980", &
"2f9b42d7d2299449491c612b20", &
"389ba33f5fec3bfb3a0ef86b50", &
"3df89f78c19fb27ae7ff19d360", &
"65ff6ba4e107aa919a6afb4ff0", &
"39b607c3f09679a62e134cd390", &
"94ad06f7b7414727d92f998930", &
"169200459898ae0bc7f06714a0", &
"c7a5a945adebb554cb4d86a830", &
"f37c3ab63230e195e92e8ad478", &
"559a51262e91aa9ba0fa96af48", &
"fb2998ca916a557463d00fb160", &
"aa32462ada57a76ae132fc8de8", &
"e6df6b19f58bfee0b96b731b90", &
"e984335d40a54fe914a6249110", &
"ea73d8f3f14bd9fe2374e39120", &
"3adab8e51c36f53584e3669c88", &
"74ef69f64dc4fef86c3b1fe640", &
"d01c6bc112d7ae3e4ba4820a78", &
"62923979fd3c3d1153bcaaf338", &
"038f72995b5072df8fe5f4dfa0", &
"9f07e7cea2f1476fb035978790", &
"2a5aad6a75d5c86cab38fd0070", &
"a254a09cc3180854688d2aa9c8", &
"0495639712a04820f7038ae7c0", &
"d99fc716ca825ad45cca8f4518", &
"01b8d558073c0377ce67344a50", &
"2fbd0f86a17c3f93713fbd09a0", &
"c29dc84bec7b4cd00dd1c17380", &
"5e6238b823f530ae017a03f0e0", &
"51203d329c68b061977d78d4c0", &
"1186729e08cf1dfbec30237968", &
"40363018b431224a1f559d2908", &
"e334e78442b614a0c9a377e1b8", &
"ff2eda86339f589f96382f52e0", &
"58a30e07fc7a37a4f858623778", &
"f5067fe407a4c3b94ce7b63e48", &
"1d09ced788a3642bc0ec640ec8", &
"17734ca67d53cd9d8595970668", &
"47953c2105bd94bff079672740", &
"3444682d1dc0ab486036c1b0d0"/

476
lib/fsk4hf/ldpc_280_101_parity.f90
View File

@ -1,476 +0,0 @@
data Mn/ &
150, 151, 161, &
6, 164, 172, &
92, 128, 158, &
2, 63, 135, &
3, 14, 22, &
4, 18, 29, &
5, 17, 164, &
7, 99, 179, &
8, 88, 115, &
9, 62, 110, &
10, 107, 154, &
11, 50, 140, &
12, 28, 33, &
13, 31, 170, &
15, 69, 175, &
16, 77, 178, &
19, 70, 91, &
20, 95, 177, &
21, 96, 106, &
23, 129, 168, &
24, 49, 169, &
25, 65, 102, &
26, 82, 171, &
27, 45, 137, &
30, 89, 119, &
32, 148, 158, &
34, 94, 152, &
35, 44, 92, &
36, 39, 138, &
37, 55, 58, &
38, 121, 165, &
40, 81, 162, &
41, 139, 150, &
42, 43, 83, &
46, 80, 114, &
47, 52, 54, &
48, 166, 173, &
38, 53, 87, &
56, 64, 126, &
57, 67, 127, &
59, 156, 159, &
60, 97, 133, &
61, 118, 161, &
66, 100, 123, &
68, 124, 131, &
71, 101, 155, &
72, 74, 144, &
73, 112, 141, &
75, 136, 149, &
59, 78, 117, &
79, 130, 163, &
84, 93, 113, &
86, 108, 163, &
103, 146, 157, &
70, 104, 145, &
105, 128, 142, &
74, 109, 122, &
54, 111, 153, &
116, 154, 176, &
120, 132, 167, &
21, 125, 147, &
134, 143, 166, &
7, 81, 160, &
32, 99, 174, &
1, 93, 104, &
2, 69, 98, &
3, 33, 152, &
4, 46, 159, &
5, 126, 178, &
6, 127, 147, &
8, 101, 110, &
9, 73, 158, &
10, 120, 123, &
11, 122, 125, &
12, 58, 170, &
13, 88, 105, &
14, 133, 150, &
15, 92, 100, &
16, 90, 108, &
17, 44, 106, &
18, 35, 175, &
19, 94, 179, &
20, 97, 153, &
22, 109, 130, &
23, 63, 140, &
24, 37, 146, &
25, 141, 168, &
26, 95, 115, &
27, 107, 149, &
28, 91, 168, &
29, 134, 144, &
30, 31, 169, &
34, 40, 96, &
36, 156, 172, &
39, 61, 135, &
41, 42, 121, &
43, 57, 117, &
45, 62, 72, &
47, 137, 167, &
48, 83, 116, &
49, 65, 173, &
1, 50, 141, &
2, 8, 150, &
3, 62, 140, &
4, 104, 124, &
5, 128, 139, &
6, 64, 159, &
7, 103, 176, &
2, 11, 104, &
9, 71, 85, &
10, 80, 131, &
11, 17, 130, &
12, 148, 156, &
13, 39, 164, &
14, 15, 167, &
14, 32, 89, &
16, 114, 135, &
8, 164, 169, &
18, 107, 129, &
19, 53, 102, &
20, 134, 170, &
21, 43, 145, &
22, 24, 76, &
23, 44, 146, &
19, 22, 101, &
25, 41, 48, &
26, 46, 58, &
27, 82, 87, &
28, 78, 179, &
29, 73, 81, &
30, 116, 161, &
31, 96, 157, &
15, 58, 172, &
10, 33, 160, &
34, 110, 118, &
33, 35, 113, &
36, 166, 175, &
32, 37, 152, &
38, 57, 74, &
13, 82, 176, &
40, 42, 45, &
25, 57, 177, &
40, 120, 136, &
21, 92, 121, &
23, 34, 147, &
12, 45, 54, &
3, 46, 48, &
47, 91, 169, &
26, 61, 132, &
49, 123, 147, &
1, 79, 88, &
51, 97, 101, &
52, 155, 177, &
24, 72, 105, &
54, 84, 106, &
55, 63, 126, &
56, 72, 163, &
38, 63, 170, &
37, 71, 178, &
20, 49, 59, &
30, 60, 117, &
61, 65, 137, &
41, 98, 119, &
47, 51, 62, &
6, 76, 131, &
55, 70, 81, &
66, 111, 119, &
60, 67, 94, &
68, 112, 132, &
9, 69, 157, &
70, 75, 89, &
69, 108, 153, &
44, 53, 77, &
29, 130, 149, &
65, 103, 125, &
74, 85, 156, &
56, 67, 68, &
77, 138, 144, &
28, 95, 138, &
79, 133, 142, &
35, 50, 86, &
73, 78, 137, &
27, 126, 175, &
83, 100, 143, &
42, 142, 168, &
40, 48, 158, &
86, 95, 174, &
39, 109, 129, &
59, 88, 125, &
6, 89, 155, &
36, 90, 102, &
75, 97, 141, &
43, 146, 148, &
93, 149, 168, &
52, 83, 94, &
80, 87, 106, &
91, 96, 143, &
3, 43, 126, &
98, 154, 162, &
99, 115, 173, &
5, 84, 100, &
64, 133, 154, &
90, 117, 158, &
7, 108, 151, &
4, 128, 167, &
105, 127, 136, &
1, 83, 114, &
107, 127, 134, &
4, 108, 170, &
92, 109, 171, &
110, 113, 122, &
111, 124, 166, &
12, 112, 150, &
2, 95, 105, &
17, 114, 118, &
99, 139, 144, &
116, 165, 178, &
5, 22, 73, &
16, 115, 162, &
13, 34, 41, &
120, 122, 151, &
121, 160, 172, &
8, 37, 102, &
123, 140, 165, &
7, 53, 93, &
9, 10, 130, &
11, 30, 58, &
31, 66, 179, &
14, 31, 45, &
15, 88, 129, &
18, 101, 148, &
16, 62, 127, &
17, 20, 68, &
19, 86, 98, &
25, 106, 163, &
135, 152, 163, &
23, 124, 137, &
21, 28, 71, &
24, 26, 153, &
29, 90, 123, &
32, 113, 134, &
35, 57, 169, &
27, 50, 139, &
33, 60, 65, &
38, 61, 142, &
145, 153, 154, &
39, 67, 81, &
36, 84, 133, &
18, 161, 173, &
93, 155, 171, &
42, 99, 131, &
49, 87, 162, &
51, 56, 168, &
47, 125, 144, &
44, 143, 159, &
46, 75, 138, &
52, 78, 107, &
54, 109, 174, &
64, 110, 179, &
159, 165, 174, &
66, 135, 171, &
63, 76, 117, &
59, 111, 120, &
72, 160, 166, &
70, 118, 156, &
55, 157, 173, &
74, 100, 176, &
77, 112, 145, &
69, 141, 147, &
94, 140, 151, &
51, 82, 104, &
85, 98, 167, &
80, 119, 146, &
97, 122, 172, &
90, 96, 132, &
79, 91, 178, &
103, 136, 152, &
1, 76, 85, &
115, 121, 149, &
116, 175, 177/
data Nm/ &
65, 102, 151, 207, 278, 0, &
4, 66, 103, 109, 214, 0, &
5, 67, 104, 147, 198, 0, &
6, 68, 105, 205, 209, 0, &
7, 69, 106, 201, 218, 0, &
2, 70, 107, 165, 190, 0, &
8, 63, 108, 204, 225, 0, &
9, 71, 103, 118, 223, 0, &
10, 72, 110, 170, 226, 0, &
11, 73, 111, 134, 226, 0, &
12, 74, 109, 112, 227, 0, &
13, 75, 113, 146, 213, 0, &
14, 76, 114, 140, 220, 0, &
5, 77, 115, 116, 229, 0, &
15, 78, 115, 133, 230, 0, &
16, 79, 117, 219, 232, 0, &
7, 80, 112, 215, 233, 0, &
6, 81, 119, 231, 249, 0, &
17, 82, 120, 125, 234, 0, &
18, 83, 121, 160, 233, 0, &
19, 61, 122, 144, 238, 0, &
5, 84, 123, 125, 218, 0, &
20, 85, 124, 145, 237, 0, &
21, 86, 123, 154, 239, 0, &
22, 87, 126, 142, 235, 0, &
23, 88, 127, 149, 239, 0, &
24, 89, 128, 183, 243, 0, &
13, 90, 129, 179, 238, 0, &
6, 91, 130, 174, 240, 0, &
25, 92, 131, 161, 227, 0, &
14, 92, 132, 228, 229, 0, &
26, 64, 116, 138, 241, 0, &
13, 67, 134, 136, 244, 0, &
27, 93, 135, 145, 220, 0, &
28, 81, 136, 181, 242, 0, &
29, 94, 137, 191, 248, 0, &
30, 86, 138, 159, 223, 0, &
31, 38, 139, 158, 245, 0, &
29, 95, 114, 188, 247, 0, &
32, 93, 141, 143, 186, 0, &
33, 96, 126, 163, 220, 0, &
34, 96, 141, 185, 251, 0, &
34, 97, 122, 193, 198, 0, &
28, 80, 124, 173, 255, 0, &
24, 98, 141, 146, 229, 0, &
35, 68, 127, 147, 256, 0, &
36, 99, 148, 164, 254, 0, &
37, 100, 126, 147, 186, 0, &
21, 101, 150, 160, 252, 0, &
12, 102, 181, 243, 0, 0, &
152, 164, 253, 271, 0, 0, &
36, 153, 195, 257, 0, 0, &
38, 120, 173, 225, 0, 0, &
36, 58, 146, 155, 258, 0, &
30, 156, 166, 266, 0, 0, &
39, 157, 177, 253, 0, 0, &
40, 97, 139, 142, 242, 0, &
30, 75, 127, 133, 227, 0, &
41, 50, 160, 189, 263, 0, &
42, 161, 168, 244, 0, 0, &
43, 95, 149, 162, 245, 0, &
10, 98, 104, 164, 232, 0, &
4, 85, 156, 158, 262, 0, &
39, 107, 202, 259, 0, 0, &
22, 101, 162, 175, 244, 0, &
44, 167, 228, 261, 0, 0, &
40, 168, 177, 247, 0, 0, &
45, 169, 177, 233, 0, 0, &
15, 66, 170, 172, 269, 0, &
17, 55, 166, 171, 265, 0, &
46, 110, 159, 238, 0, 0, &
47, 98, 154, 157, 264, 0, &
48, 72, 130, 182, 218, 0, &
47, 57, 139, 176, 267, 0, &
49, 171, 192, 256, 0, 0, &
123, 165, 262, 278, 0, 0, &
16, 173, 178, 268, 0, 0, &
50, 129, 182, 257, 0, 0, &
51, 151, 180, 276, 0, 0, &
35, 111, 196, 273, 0, 0, &
32, 63, 130, 166, 247, 0, &
23, 128, 140, 271, 0, 0, &
34, 100, 184, 195, 207, 0, &
52, 155, 201, 248, 0, 0, &
110, 176, 272, 278, 0, 0, &
53, 181, 187, 234, 0, 0, &
38, 128, 196, 252, 0, 0, &
9, 76, 151, 189, 230, 0, &
25, 116, 171, 190, 0, 0, &
79, 191, 203, 240, 275, 0, &
17, 90, 148, 197, 276, 0, &
3, 28, 78, 144, 210, 0, &
52, 65, 194, 225, 250, 0, &
27, 82, 168, 195, 270, 0, &
18, 88, 179, 187, 214, 0, &
19, 93, 132, 197, 275, 0, &
42, 83, 152, 192, 274, 0, &
66, 163, 199, 234, 272, 0, &
8, 64, 200, 216, 251, 0, &
44, 78, 184, 201, 267, 0, &
46, 71, 125, 152, 231, 0, &
22, 120, 191, 223, 0, 0, &
54, 108, 175, 277, 0, 0, &
55, 65, 105, 109, 271, 0, &
56, 76, 154, 206, 214, 0, &
19, 80, 155, 196, 235, 0, &
11, 89, 119, 208, 257, 0, &
53, 79, 172, 204, 209, 0, &
57, 84, 188, 210, 258, 0, &
10, 71, 135, 211, 259, 0, &
58, 167, 212, 263, 0, 0, &
48, 169, 213, 268, 0, 0, &
52, 136, 211, 241, 0, 0, &
35, 117, 207, 215, 0, 0, &
9, 88, 200, 219, 279, 0, &
59, 100, 131, 217, 280, 0, &
50, 97, 161, 203, 262, 0, &
43, 135, 215, 265, 0, 0, &
25, 163, 167, 273, 0, 0, &
60, 73, 143, 221, 263, 0, &
31, 96, 144, 222, 279, 0, &
57, 74, 211, 221, 274, 0, &
44, 73, 150, 224, 240, 0, &
45, 105, 212, 237, 0, 0, &
61, 74, 175, 189, 254, 0, &
39, 69, 156, 183, 198, 0, &
40, 70, 206, 208, 232, 0, &
3, 56, 106, 205, 0, 0, &
20, 119, 188, 230, 0, 0, &
51, 84, 112, 174, 226, 0, &
45, 111, 165, 251, 0, 0, &
60, 149, 169, 275, 0, 0, &
42, 77, 180, 202, 248, 0, &
62, 91, 121, 208, 241, 0, &
4, 95, 117, 236, 261, 0, &
49, 143, 206, 277, 0, 0, &
24, 99, 162, 182, 237, 0, &
29, 178, 179, 256, 0, 0, &
33, 106, 216, 243, 0, 0, &
12, 85, 104, 224, 270, 0, &
48, 87, 102, 192, 269, 0, &
56, 180, 185, 245, 0, 0, &
62, 184, 197, 255, 0, 0, &
47, 91, 178, 216, 254, 0, &
55, 122, 246, 268, 0, 0, &
54, 86, 124, 193, 273, 0, &
61, 70, 145, 150, 269, 0, &
26, 113, 193, 231, 0, 0, &
49, 89, 174, 194, 279, 0, &
1, 33, 77, 103, 213, 0, &
1, 204, 221, 270, 0, 0, &
27, 67, 138, 236, 277, 0, &
58, 83, 172, 239, 246, 0, &
11, 59, 199, 202, 246, 0, &
46, 153, 190, 250, 0, 0, &
41, 94, 113, 176, 265, 0, &
54, 132, 170, 266, 0, 0, &
3, 26, 72, 186, 203, 0, &
41, 68, 107, 255, 260, 0, &
63, 134, 222, 264, 0, 0, &
1, 43, 131, 249, 0, 0, &
32, 199, 219, 252, 0, 0, &
51, 53, 157, 235, 236, 0, &
2, 7, 114, 118, 0, 0, &
31, 217, 224, 260, 0, 0, &
37, 62, 137, 212, 264, 0, &
60, 99, 115, 205, 272, 0, &
20, 87, 90, 185, 194, 253, &
21, 92, 118, 148, 242, 0, &
14, 75, 121, 158, 209, 0, &
23, 210, 250, 261, 0, 0, &
2, 94, 133, 222, 274, 0, &
37, 101, 200, 249, 266, 0, &
64, 187, 258, 260, 0, 0, &
15, 81, 137, 183, 280, 0, &
59, 108, 140, 267, 0, 0, &
18, 142, 153, 280, 0, 0, &
16, 69, 159, 217, 276, 0, &
8, 82, 129, 228, 259, 0/
data nrw/ &
5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, &
5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, &
5,5,5,5,5,5,5,5,5,4,4,4,4,5,4,4,5,5,5,4, &
5,5,5,4,5,4,4,4,5,5,4,5,5,5,4,4,4,4,4,4, &
5,4,5,4,4,4,4,5,4,5,5,5,5,5,5,5,5,5,5,5, &
5,4,4,5,5,5,5,5,5,5,4,4,4,4,5,5,5,4,4,5, &
5,5,5,4,5,5,5,4,4,5,4,4,5,5,5,4,5,4,4,5, &
5,4,4,5,4,5,5,4,5,5,4,5,5,5,4,5,4,5,5,4, &
4,4,5,4,4,5,5,6,5,5,4,5,5,4,5,4,4,5,5/
ncw=3

262
lib/fsk4hf/ldpc_300_60_params.f90
View File

@ -1,262 +0,0 @@
integer, parameter:: N=300, K=60, M=N-K
character*15 g(M)
integer colorder(N)
data g/ &
"316fd3bb18bcefd", &
"a9c1c984f91244e", &
"9e04bd3d5d78d89", &
"f81617089621bd4", &
"12997ce2f44dbf4", &
"3ebddaf9b0fa1fc", &
"d0c114b0b0ef162", &
"f8c4f115f98bd92", &
"d0a79c0c5b8ca19", &
"477f6712f357b3b", &
"fa28b2444a7e66b", &
"bedcd4df8d95c64", &
"da30de73e57022c", &
"bc099bbb90fe09e", &
"cffc1e47e5708e8", &
"713d808563ca9a3", &
"70fcf1741d5d5d7", &
"32e80bc15112008", &
"804cef4df9b18ec", &
"3736881819d1033", &
"f4e37db7f9c5efe", &
"9e84b93d4d78d09", &
"2250c3518ec830a", &
"55a529a92e18021", &
"1cb80b14c9f6eae", &
"80c504b031ef926", &
"ece6636d0ac9c6d", &
"5d50a1690782cd0", &
"3d54a1fb30937a2", &
"ba8fe8006318041", &
"02917ce2fc45bf4", &
"abc1d984f95a44e", &
"fc05b4c4ab2d850", &
"467f7718f357b3b", &
"472cc094546c6b2", &
"fcdd94cf8c9cc64", &
"4dbc1647e970cc8", &
"6caa465c442aed1", &
"aead5af8b0da1be", &
"d8e1fa45a2e8431", &
"9d4dc4cc63abb7f", &
"9b2df6b48264637", &
"7335808563ca3a3", &
"36bf8d5cd93e6cc", &
"004ccf4db9b08ec", &
"90a71c8c598ca19", &
"f8c5d115f90bc92", &
"b95546c4e3f7934", &
"7d50a1690786cd0", &
"c90939921a0d7c6", &
"d0c504b030ef126", &
"ce3e6f9396fc542", &
"a0072a59f3707f5", &
"532d0a8fe3da1ea", &
"68b9e5cd7d142db", &
"fedc94df8c9dc64", &
"6da2465c448aed0", &
"3574aa19cb273c0", &
"1e54768c6bc6843", &
"691f65654498186", &
"fe2c92444a6ef6b", &
"9caad933e038cc4", &
"ad4e6f4defb28ec", &
"4f3d80947c6d2b2", &
"1caad933e0b8cc4", &
"b14fd3bf18bcafd", &
"ad091bbbb0f809e", &
"90b71c8c598da19", &
"f8c4d115f90bd92", &
"9d4dcccc63afb7f", &
"fa2c92444a6e76b", &
"1e14768c6bc6c43", &
"d1baf5aacb86087", &
"bdf762b92ee51c7", &
"caacec06ad8a90c", &
"804ccf4df9b08ec", &
"69e969f9da5cbd8", &
"814ccf4df9b086c", &
"cebe4f9796f4542", &
"491f65654499186", &
"8fbf5b9796f6d2a", &
"ce3e4f9396f4542", &
"47558560e7debc3", &
"94aadd33e038cc4", &
"a94eef4debb286e", &
"d8e5d115f91bcd2", &
"532d488fe3da0ab", &
"664e7bc4e23a80c", &
"94a2dd33a038cd4", &
"d8c5d115f91bc92", &
"0fef071eee60bd5", &
"9a89a09163c2b97", &
"0eaf071e6c60bd5", &
"bc0d1bbbb0fe0be", &
"f9babd3d12d0f31", &
"69a969f9da5c9d8", &
"6e4e7bc4e23a82c", &
"b0042659f3227f5", &
"2d51418f0f28347", &
"be0d5bbbb0da0be", &
"225003508ec8302", &
"8fbf4b9796f4d2a", &
"bead5af9b0da1be", &
"6ca2465c440aed1", &
"4fbc1e47ed708c8", &
"bd091bbbb0fc09e", &
"b0062259f3307f5", &
"a8072a59f3727f5", &
"a0062259f3707f5", &
"3c380b14c974eae", &
"30042659f3226f5", &
"48b9e4cd7d142db", &
"728bcd4b38308fb", &
"c0c504b031ef126", &
"314fd3bb18bcafd", &
"1c29148305faec1", &
"44c92a9c28ada63", &
"88e99b370aae32b", &
"695081690386ad8", &
"572d0a8de3da1ea", &
"467f6610f357b2b", &
"733d008563da1a3", &
"d1baf4aacb84087", &
"4315551d71c8ff0", &
"48bde4cd7d140db", &
"3ebd58f9b0da9fc", &
"51baf4aacb84083", &
"814e4f4de9b082c", &
"814ecf4de9b086c", &
"be0d1bbbb0fa0be", &
"4f7580947c792b3", &
"cdf2dce48c39c3b", &
"d8c5c115f91bc12", &
"a94e6f4debb28ee", &
"be2d5afbb0da1be", &
"cdd6dce48439c2b", &
"bebd5af9b0da1fe", &
"fa2892444a6e66b", &
"51bbf4aacb8c083", &
"baa73d81eebcd83", &
"79a2ce47f138cc9", &
"cc28cf198e6dbd4", &
"fcde94dfcc9cc64", &
"1016fcf59286717", &
"12917ce2fc4dbf4", &
"4fbc1647e9708c8", &
"3e382b1cc974fae", &
"d5bafdaad386087", &
"0fef473eee60bd5", &
"c0e504b031ee126", &
"8bbf5b9797f6d2a", &
"0eef071e6e60bd5", &
"1806fcf59386517", &
"fcdc94df8c9cc64", &
"141eca2bfa25656", &
"5fbc1767e9708e8", &
"5aa4c7803a6bdf1", &
"b14bd3b718bcafd", &
"3ebd5af9b0da1fc", &
"d0a7148c5b8ca09", &
"a94ecf4debb086e", &
"733d808563ca1a3", &
"fd9abd1d92d0f31", &
"bc091bbbb0fe09e", &
"d0c514b0b0ef122", &
"4f7d80947c7d2b3", &
"8b3f5b97b7f6d2a", &
"4fbc1767e9708c8", &
"cebf4f9796f4502", &
"9c76c880a864e67", &
"abc1c984f95244e", &
"795081690786ad8", &
"467f6710f357b3b", &
"1c380b14c9f4eae", &
"d5baf5aac386087", &
"bedc94df8c95c64", &
"553d0a8de2da1fa", &
"0315551d71d8ff0", &
"1c1eca2ffa25656", &
"d4bafdaad3c6087", &
"be2d5bfbb0da0be", &
"b0062659f3207f5", &
"5ffc1765e9708e8", &
"8d62e8bcd303e33", &
"cc08cf198e69bd4", &
"573d0a8de3da1fa", &
"cd56dce48639c2b", &
"472dc094546c2b2", &
"7950a16907868d8", &
"7283cf4b38308fb", &
"894ecf4de9b086e", &
"0f7580b47c792b3", &
"cfbf4b9796f4d0a", &
"3e380b14c974fae", &
"732d0085e3da1a3", &
"1816fcf59386717", &
"532d088fe3da1ab", &
"1c300b94c9fcaae", &
"d0a71c8c5b8ca19", &
"9e84bd3d5d78d09", &
"225083508ec830a", &
"f99abd1d12d0f31", &
"35f4aa19cb673c0", &
"cdd2dce48c39c2b", &
"0f7780b47c792bf", &
"0e33a5f114f5730", &
"bc05b4c4ab0d850", &
"1c300b14c9f4aae", &
"cfbc1e47ed708e8", &
"0f7180b47c392b3", &
"d8c7c115f91be12", &
"c09148adfa94e97", &
"9c66c880a844e67", &
"2226c13b73519f8", &
"cebf4b9796f4d02", &
"c0e706b031ee126", &
"6a6629715e53ce3", &
"73f9aa824e7d0b8", &
"473d80947c6c2b2", &
"1df140e0ddb5632", &
"473dc0945c6c2b2", &
"81b4d95f671971d", &
"663945ca758e2b6", &
"02ec3d98a2306fd", &
"5dadb0fa1275690", &
"4bb8aaa854948d0", &
"8359ba40886971c", &
"49cc3d2a2be2ee0", &
"bfdf13af137f318", &
"a1de773a2b1ff04", &
"8ff3945a2f465c7", &
"532d0087e3da1a3", &
"f3eaf7fa454d385", &
"a606aa5aeba07d9", &
"67f0627b0af8a53", &
"56698bed69d1c2c", &
"d5f420011fbf924", &
"2a8f86c810e2c62", &
"43cc1cf1208c206", &
"ee784c4900258de"/
data colorder/ &
0,1,2,3,4,5,6,7,8,9,10,11,123,12,13,14,15,16,17,18, &
19,20,21,22,23,24,25,138,26,145,27,28,29,30,31,32,33,34,35,36, &
37,154,38,39,40,41,42,43,44,144,46,47,48,49,50,51,52,53,143,54, &
125,56,57,58,124,59,120,140,157,160,55,60,61,62,156,162,141,64,65,153, &
181,183,66,170,67,68,69,130,70,164,71,72,73,74,75,63,76,77,135,78, &
79,80,176,169,82,83,84,167,180,85,136,158,129,166,175,142,134,146,121,165, &
88,89,192,90,45,91,92,93,182,189,94,95,96,173,81,97,98,178,122,126, &
132,99,100,152,186,193,101,102,151,103,104,172,159,168,150,190,147,148,201,107, &
205,177,108,198,197,174,127,109,185,110,202,87,199,171,179,187,139,137,106,131, &
206,194,112,149,155,113,128,184,196,86,114,203,212,195,208,105,188,161,163,191, &
200,209,214,204,115,218,133,111,207,117,213,216,211,217,116,215,219,220,210,221, &
118,222,223,225,224,228,226,229,231,227,233,119,234,235,232,230,237,239,236,238, &
240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259, &
260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279, &
280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299/

238
lib/fsk4hf/ldpcsim120.f90
View File

@ -1,238 +0,0 @@
program ldpcsim120
! End to end test of the (120,60)/crc10 encoder and decoder.
use crc
use packjt
parameter(NRECENT=10)
character*12 recent_calls(NRECENT)
character*22 msg,msgsent,msgreceived
character*8 arg
integer*1, allocatable :: codeword(:), decoded(:), message(:)
integer*1, target:: i1Msg8BitBytes(9)
integer*1, target:: i1Dec8BitBytes(9)
integer*1 msgbits(60)
integer*1 apmask(120)
integer*1 cw(120)
integer*2 checksum
integer colorder(120)
integer nerrtot(120),nerrdec(120),nmpcbad(60)
logical checksumok,fsk,bpsk
real*8, allocatable :: rxdata(:)
real, allocatable :: llr(:)
real dllr(120),llrd(120)
data colorder/ &
0,1,2,21,3,4,5,6,7,8,20,10,9,11,12,23,13,28,14,31, &
15,16,22,26,17,30,18,29,25,32,41,34,19,33,27,36,38,43,42,24, &
37,39,45,40,35,44,47,46,50,51,53,48,52,56,54,57,55,49,58,61, &
60,59,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79, &
80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99, &
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119/
do i=1,NRECENT
recent_calls(i)=' '
enddo
nerrtot=0
nerrdec=0
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
nargs=iargc()
if(nargs.ne.3) then
print*,'Usage: ldpcsim niter #trials s '
print*,'eg: ldpcsim 10 1000 0.84'
print*,'If s is negative, then value is ignored and sigma is calculated from SNR.'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ntrials
call getarg(3,arg)
read(arg,*) s
fsk=.false.
bpsk=.true.
! don't count crc bits as data bits
N=120
K=60
! scale Eb/No for a (120,50) code
rate=real(50)/real(N)
write(*,*) "rate: ",rate
write(*,*) "niter= ",max_iterations," s= ",s
allocate ( codeword(N), decoded(K), message(K) )
allocate ( rxdata(N), llr(N) )
! The message should be packed into the first 7 bytes
i1Msg8BitBytes(1:6)=85
i1Msg8BitBytes(7)=64
! The CRC will be put into the last 2 bytes
i1Msg8BitBytes(8:9)=0
checksum = crc10 (c_loc (i1Msg8BitBytes), 9)
! For reference, the next 3 lines show how to check the CRC
i1Msg8BitBytes(8)=checksum/256
i1Msg8BitBytes(9)=iand (checksum,255)
checksumok = crc10_check(c_loc (i1Msg8BitBytes), 9)
if( checksumok ) write(*,*) 'Good checksum'
write(*,*) i1Msg8BitBytes(1:9)
mbit=0
do i=1, 7
i1=i1Msg8BitBytes(i)
do ibit=1,8
mbit=mbit+1
msgbits(mbit)=iand(1,ishft(i1,ibit-8))
enddo
enddo
i1=i1Msg8BitBytes(8) ! First 2 bits of crc10 are LSB of this byte
do ibit=1,2
msgbits(50+ibit)=iand(1,ishft(i1,ibit-2))
enddo
i1=i1Msg8BitBytes(9) ! Now shift in last 8 bits of the CRC
do ibit=1,8
msgbits(52+ibit)=iand(1,ishft(i1,ibit-8))
enddo
write(*,*) 'message'
write(*,'(9(8i1,1x))') msgbits
call encode120(msgbits,codeword)
call init_random_seed()
call sgran()
write(*,*) 'codeword'
write(*,'(15(8i1,1x))') codeword
write(*,*) "Es/N0 SNR2500 ngood nundetected nbadcrc sigma"
do idb = -10, 24
db=idb/2.0-1.0
! sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) ! to make db represent Eb/No
sigma=1/sqrt( 2*(10**(db/10.0)) ) ! db represents Es/No
ngood=0
nue=0
nbadcrc=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
if( bpsk ) then
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
elseif( fsk ) then
if( codeword(i) .eq. 1 ) then
r1=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r2=(sigma*gran())**2 + (sigma*gran())**2
elseif( codeword(i) .eq. 0 ) then
r2=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r1=(sigma*gran())**2 + (sigma*gran())**2
endif
rxdata(i)=0.35*(sqrt(r1)-sqrt(r2))
! rxdata(i)=0.35*(exp(r1)-exp(r2))
! rxdata(i)=0.12*(log(r1)-log(r2))
endif
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
nerrtot(nerr)=nerrtot(nerr)+1
nberr=nberr+nerr
! Correct signal normalization is important for this decoder.
! rxav=sum(rxdata)/N
! rx2av=sum(rxdata*rxdata)/N
! rxsig=sqrt(rx2av-rxav*rxav)
! rxdata=rxdata/rxsig
! To match the metric to the channel, s should be set to the noise standard deviation.
! For now, set s to the value that optimizes decode probability near threshold.
! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of
! magnitude in UER
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
apmask=0
! max_iterations is max number of belief propagation iterations
call bpdecode120(llr, apmask, max_iterations, decoded, niterations, cw)
n2err=0
do i=1,N
if( cw(i)*(2*codeword(i)-1.0) .lt. 0 ) n2err=n2err+1
enddo
!write(*,*) nerr,niterations,n2err
damp=0.75
ndither=0
if( niterations .lt. 0 ) then
do i=1, ndither
do in=1,N
dllr(in)=damp*gran()
enddo
llrd=llr+dllr
call bpdecode120(llrd, apmask, max_iterations, decoded, niterations, cw)
if( niterations .ge. 0 ) exit
enddo
endif
! If the decoder finds a valid codeword, niterations will be .ge. 0.
if( niterations .ge. 0 ) then
! Check the CRC
do ibyte=1,6
itmp=0
do ibit=1,8
itmp=ishft(itmp,1)+iand(1,decoded((ibyte-1)*8+ibit))
enddo
i1Dec8BitBytes(ibyte)=itmp
enddo
i1Dec8BitBytes(7)=decoded(49)*128+decoded(50)*64
! Need to pack the received crc into bytes 8 and 9 for crc10_check
i1Dec8BitBytes(8)=decoded(51)*2+decoded(52)
i1Dec8BitBytes(9)=decoded(53)*128+decoded(54)*64+decoded(55)*32+decoded(56)*16
i1Dec8BitBytes(9)=i1Dec8BitBytes(9)+decoded(57)*8+decoded(58)*4+decoded(59)*2+decoded(60)*1
ncrcflag=0
if( crc10_check( c_loc( i1Dec8BitBytes ), 9 ) ) ncrcflag=1
if( ncrcflag .ne. 1 ) then
nbadcrc=nbadcrc+1
endif
nueflag=0
nerrmpc=0
do i=1,K ! find number of errors in message+crc part of codeword
if( msgbits(i) .ne. decoded(i) ) then
nueflag=1
nerrmpc=nerrmpc+1
endif
enddo
nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1 ! This histogram should inform our selection of CRC poly
if( ncrcflag .eq. 1 .and. nueflag .eq. 0 ) then
ngood=ngood+1
nerrdec(nerr)=nerrdec(nerr)+1
else if( ncrcflag .eq. 1 .and. nueflag .eq. 1 ) then
nue=nue+1;
endif
endif
enddo
snr2500=db+10*log10(0.4166/2500.0)
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,snr2500,ngood,nue,nbadcrc,ss,pberr
enddo
open(unit=23,file='nerrhisto.dat',status='unknown')
do i=1,120
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
enddo
close(23)
open(unit=25,file='nmpcbad.dat',status='unknown')
do i=1,60
write(25,'(i4,2x,i10)') i,nmpcbad(i)
enddo
close(25)
end program ldpcsim120

233
lib/fsk4hf/ldpcsim168.f90
View File

@ -1,233 +0,0 @@
program ldpcsim168
! End to end test of the (168,84)/crc12 encoder and decoder.
use crc
use packjt
parameter(NRECENT=10)
character*12 recent_calls(NRECENT)
character*22 msg,msgsent,msgreceived
character*8 arg
integer*1, allocatable :: codeword(:), decoded(:), message(:)
integer*1, target:: i1Msg8BitBytes(11)
integer*1 msgbits(84)
integer*1 apmask(168), cw(168)
integer*2 checksum
integer*4 i4Msg6BitWords(13)
integer colorder(168)
integer nerrtot(168),nerrdec(168),nmpcbad(84)
logical checksumok,fsk,bpsk
real*8, allocatable :: rxdata(:)
real, allocatable :: llr(:)
data colorder/0,1,2,3,28,4,5,6,7,8,9,10,11,34,12,32,13,14,15,16,17, &
18,36,29,42,31,20,21,41,40,30,38,22,19,47,37,46,35,44,33,49,24, &
43,51,25,26,27,50,52,57,69,54,55,45,59,58,56,61,60,53,48,23,62, &
63,64,67,66,65,68,39,70,71,72,74,73,75,76,77,80,81,78,82,79,83, &
84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104, &
105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125, &
126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146, &
147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167/
do i=1,NRECENT
recent_calls(i)=' '
enddo
nerrtot=0
nerrdec=0
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
nargs=iargc()
if(nargs.ne.3) then
print*,'Usage: ldpcsim niter #trials s '
print*,'eg: ldpcsim 10 1000 0.84'
print*,'If s is negative, then value is ignored and sigma is calculated from SNR.'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ntrials
call getarg(3,arg)
read(arg,*) s
fsk=.false.
bpsk=.true.
! don't count crc bits as data bits
N=168
K=84
! scale Eb/No for a (168,72) code
rate=real(72)/real(N)
write(*,*) "rate: ",rate
write(*,*) "niter= ",max_iterations," s= ",s
allocate ( codeword(N), decoded(K), message(K) )
allocate ( rxdata(N), llr(N) )
! msg="K1JT K9AN EN50"
msg="G4WJS K9AN EN50"
call packmsg(msg,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent
write(*,*) "message sent ",msgsent
i4=0
ik=0
im=0
do i=1,12
nn=i4Msg6BitWords(i)
do j=1, 6
ik=ik+1
i4=i4+i4+iand(1,ishft(nn,j-6))
i4=iand(i4,255)
if(ik.eq.8) then
im=im+1
! if(i4.gt.127) i4=i4-256
i1Msg8BitBytes(im)=i4
ik=0
endif
enddo
enddo
i1Msg8BitBytes(10:11)=0
checksum = crc12 (c_loc (i1Msg8BitBytes), 11)
! For reference, the next 3 lines show how to check the CRC
i1Msg8BitBytes(10)=checksum/256
i1Msg8BitBytes(11)=iand (checksum,255)
checksumok = crc12_check(c_loc (i1Msg8BitBytes), 11)
if( checksumok ) write(*,*) 'Good checksum'
mbit=0
do i=1, 9
i1=i1Msg8BitBytes(i)
do ibit=1,8
mbit=mbit+1
msgbits(mbit)=iand(1,ishft(i1,ibit-8))
enddo
enddo
i1=i1Msg8BitBytes(10) ! First 4 bits of crc12 are LSB of this byte
do ibit=1,4
msgbits(72+ibit)=iand(1,ishft(i1,ibit-4))
enddo
i1=i1Msg8BitBytes(11) ! Now shift in last 8 bits of the CRC
do ibit=1,8
msgbits(76+ibit)=iand(1,ishft(i1,ibit-8))
enddo
write(*,*) 'message'
write(*,'(11(8i1,1x))') msgbits
call encode168(msgbits,codeword)
call init_random_seed()
call sgran()
write(*,*) 'codeword'
write(*,'(21(8i1,1x))') codeword
write(*,*) "Es/N0 SNR2500 ngood nundetected nbadcrc sigma"
do idb = 6,-6,-1
db=idb/2.0-1.0
sigma=1/sqrt( 2*(10**(db/10.0)) )
ngood=0
nue=0
nbadcrc=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
if( bpsk ) then
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
elseif( fsk ) then
if( codeword(i) .eq. 1 ) then
r1=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r2=(sigma*gran())**2 + (sigma*gran())**2
elseif( codeword(i) .eq. 0 ) then
r2=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r1=(sigma*gran())**2 + (sigma*gran())**2
endif
rxdata(i)=0.35*(sqrt(r1)-sqrt(r2))
! rxdata(i)=0.35*(exp(r1)-exp(r2))
! rxdata(i)=0.12*(log(r1)-log(r2))
endif
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
nerrtot(nerr)=nerrtot(nerr)+1
nberr=nberr+nerr
! Correct signal normalization is important for this decoder.
! rxav=sum(rxdata)/N
! rx2av=sum(rxdata*rxdata)/N
! rxsig=sqrt(rx2av-rxav*rxav)
! rxdata=rxdata/rxsig
! To match the metric to the channel, s should be set to the noise standard deviation.
! For now, set s to the value that optimizes decode probability near threshold.
! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of
! magnitude in UER
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
nap=0 ! number of AP bits
llr(colorder(168-84+1:168-84+nap)+1)=5*(2.0*msgbits(1:nap)-1.0)
apmask=0
apmask(colorder(168-84+1:168-84+nap)+1)=1
! max_iterations is max number of belief propagation iterations
call bpdecode168(llr, apmask, max_iterations, decoded, niterations)
! if( niterations .eq. -1 ) then
! norder=3
! call osd168(llr, norder, decoded, niterations, cw)
! endif
! If the decoder finds a valid codeword, niterations will be .ge. 0.
if( niterations .ge. 0 ) then
call extractmessage168(decoded,msgreceived,ncrcflag,recent_calls,nrecent)
if( ncrcflag .ne. 1 ) then
nbadcrc=nbadcrc+1
endif
nueflag=0
nerrmpc=0
do i=1,K ! find number of errors in message+crc part of codeword
if( msgbits(i) .ne. decoded(i) ) then
nueflag=1
nerrmpc=nerrmpc+1
endif
enddo
write(37,*) niterations, ncrcflag, nueflag
nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1
if( ncrcflag .eq. 1 ) then
if( nueflag .eq. 0 ) then
ngood=ngood+1
nerrdec(nerr)=nerrdec(nerr)+1
else if( nueflag .eq. 1 ) then
nue=nue+1;
endif
endif
endif
enddo
snr2500=db+10*log10(10.417/2500.0)
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,snr2500,ngood,nue,nbadcrc,ss,pberr
enddo
open(unit=23,file='nerrhisto.dat',status='unknown')
do i=1,168
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
enddo
close(23)
open(unit=25,file='nmpcbad.dat',status='unknown')
do i=1,84
write(25,'(i4,2x,i10)') i,nmpcbad(i)
enddo
close(25)
end program ldpcsim168

233
lib/fsk4hf/ldpcsim174.f90
View File

@ -1,233 +0,0 @@
program ldpcsim174
! End to end test of the (174,75)/crc12 encoder and decoder.
use crc
use packjt
character*22 msg,msgsent,msgreceived
character*8 arg
character*6 grid
integer*1, allocatable :: codeword(:), decoded(:), message(:)
integer*1, target:: i1Msg8BitBytes(11)
integer*1 msgbits(87)
integer*1 apmask(174), cw(174)
integer*2 checksum
integer*4 i4Msg6BitWords(13)
integer colorder(174)
integer nerrtot(174),nerrdec(174),nmpcbad(87)
logical checksumok,fsk,bpsk
real*8, allocatable :: rxdata(:)
real, allocatable :: llr(:)
data colorder/ &
0, 1, 2, 3, 30, 4, 5, 6, 7, 8, 9, 10, 11, 32, 12, 40, 13, 14, 15, 16,&
17, 18, 37, 45, 29, 19, 20, 21, 41, 22, 42, 31, 33, 34, 44, 35, 47, 51, 50, 43,&
36, 52, 63, 46, 25, 55, 27, 24, 23, 53, 39, 49, 59, 38, 48, 61, 60, 57, 28, 62,&
56, 58, 65, 66, 26, 70, 64, 69, 68, 67, 74, 71, 54, 76, 72, 75, 78, 77, 80, 79,&
73, 83, 84, 81, 82, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99,&
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,&
120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,&
140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,&
160,161,162,163,164,165,166,167,168,169,170,171,172,173/
nerrtot=0
nerrdec=0
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
nargs=iargc()
if(nargs.ne.4) then
print*,'Usage: ldpcsim niter ndepth #trials s '
print*,'eg: ldpcsim 10 2 1000 0.84'
print*,'belief propagation iterations: niter, ordered-statistics depth: ndepth'
print*,'If s is negative, then value is ignored and sigma is calculated from SNR.'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ndepth
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
fsk=.false.
bpsk=.true.
! don't count crc bits as data bits
N=174
K=87
! scale Eb/No for a (174,87) code
rate=real(K)/real(N)
write(*,*) "rate: ",rate
write(*,*) "niter= ",max_iterations," s= ",s
allocate ( codeword(N), decoded(K), message(K) )
allocate ( rxdata(N), llr(N) )
msg="K1JT K9AN EN50"
! msg="G4WJS K9AN EN50"
call packmsg(msg,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent
write(*,*) "message sent ",msgsent
i4=0
ik=0
im=0
do i=1,12
nn=i4Msg6BitWords(i)
do j=1, 6
ik=ik+1
i4=i4+i4+iand(1,ishft(nn,j-6))
i4=iand(i4,255)
if(ik.eq.8) then
im=im+1
! if(i4.gt.127) i4=i4-256
i1Msg8BitBytes(im)=i4
ik=0
endif
enddo
enddo
i1Msg8BitBytes(10:11)=0
checksum = crc12 (c_loc (i1Msg8BitBytes), 11)
! For reference, the next 3 lines show how to check the CRC
i1Msg8BitBytes(10)=checksum/256
i1Msg8BitBytes(11)=iand (checksum,255)
checksumok = crc12_check(c_loc (i1Msg8BitBytes), 11)
if( checksumok ) write(*,*) 'Good checksum'
! K=87, For now:
! msgbits(1:72) JT message bits
! msgbits(73:75) 3 free message bits (set to 0)
! msgbits(76:87) CRC12
mbit=0
do i=1, 9
i1=i1Msg8BitBytes(i)
do ibit=1,8
mbit=mbit+1
msgbits(mbit)=iand(1,ishft(i1,ibit-8))
enddo
enddo
msgbits(73:75)=0 ! the three extra message bits go here
i1=i1Msg8BitBytes(10) ! First 4 bits of crc12 are LSB of this byte
do ibit=1,4
msgbits(75+ibit)=iand(1,ishft(i1,ibit-4))
enddo
i1=i1Msg8BitBytes(11) ! Now shift in last 8 bits of the CRC
do ibit=1,8
msgbits(79+ibit)=iand(1,ishft(i1,ibit-8))
enddo
write(*,*) 'message'
write(*,'(11(8i1,1x))') msgbits
call encode174(msgbits,codeword)
call init_random_seed()
! call sgran()
write(*,*) 'codeword'
write(*,'(22(8i1,1x))') codeword
write(*,*) "Eb/N0 SNR2500 ngood nundetected nbadcrc sigma"
do idb = 20,-10,-1
!do idb = -3,-3,-1
db=idb/2.0-1.0
sigma=1/sqrt( 2*rate*(10**(db/10.0)) )
ngood=0
nue=0
nbadcrc=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
if( bpsk ) then
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
elseif( fsk ) then
if( codeword(i) .eq. 1 ) then
r1=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r2=(sigma*gran())**2 + (sigma*gran())**2
elseif( codeword(i) .eq. 0 ) then
r2=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r1=(sigma*gran())**2 + (sigma*gran())**2
endif
! rxdata(i)=0.35*(sqrt(r1)-sqrt(r2))
! rxdata(i)=0.35*(exp(r1)-exp(r2))
rxdata(i)=0.12*(log(r1)-log(r2))
endif
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
if(nerr.ge.1) nerrtot(nerr)=nerrtot(nerr)+1
nberr=nberr+nerr
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
! To match the metric to the channel, s should be set to the noise standard deviation.
! For now, set s to the value that optimizes decode probability near threshold.
! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of
! magnitude in UER
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
nap=0 ! number of AP bits
llr(colorder(174-87+1:174-87+nap)+1)=5*(2.0*msgbits(1:nap)-1.0)
apmask=0
apmask(colorder(174-87+1:174-87+nap)+1)=1
! max_iterations is max number of belief propagation iterations
call bpdecode174(llr, apmask, max_iterations, decoded, cw, nharderrors,niterations)
if( ndepth .ge. 0 .and. nharderrors .lt. 0 ) call osd174(llr, apmask, ndepth, decoded, cw, nharderrors, dmin)
! If the decoder finds a valid codeword, nharderrors will be .ge. 0.
if( nharderrors .ge. 0 ) then
call extractmessage174(decoded,msgreceived,ncrcflag)
if( ncrcflag .ne. 1 ) then
nbadcrc=nbadcrc+1
endif
nueflag=0
nerrmpc=0
do i=1,K ! find number of errors in message+crc part of codeword
if( msgbits(i) .ne. decoded(i) ) then
nueflag=1
nerrmpc=nerrmpc+1
endif
enddo
if(nerrmpc.ge.1) nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1
if( ncrcflag .eq. 1 ) then
if( nueflag .eq. 0 ) then
ngood=ngood+1
if(nerr.ge.1) nerrdec(nerr)=nerrdec(nerr)+1
else if( nueflag .eq. 1 ) then
nue=nue+1;
endif
endif
endif
enddo
baud=12000/1920
snr2500=db+10.0*log10((baud/2500.0))
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,snr2500,ngood,nue,nbadcrc,ss,pberr
enddo
open(unit=23,file='nerrhisto.dat',status='unknown')
do i=1,174
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
enddo
close(23)
open(unit=25,file='nmpcbad.dat',status='unknown')
do i=1,87
write(25,'(i4,2x,i10)') i,nmpcbad(i)
enddo
close(25)
end program ldpcsim174

144
lib/fsk4hf/ldpcsim174_101.f90
View File

@ -1,144 +0,0 @@
program ldpcsim174_101
! End-to-end test of the (174,101)/crc24 encoder and decoders.
use packjt77
parameter(N=174, K=101, M=N-K)
character*8 arg
character*37 msg0,msg
character*77 c77
character*24 c24
integer*1 msgbits(101)
integer*1 apmask(174)
integer*1 cw(174)
integer*1 codeword(N),message(77),message101(101)
integer ncrc24
real rxdata(N),llr(N)
real dllr(174),llrd(174)
logical first,unpk77_success
data first/.true./
nargs=iargc()
if(nargs.ne.5 .and. nargs.ne.6) then
print*,'Usage: ldpcsim niter ndeep #trials s K [msg]'
print*,'e.g. ldpcsim174_101 20 5 1000 0.85 91 "K9AN K1JT FN20"'
print*,'s : if negative, then value is ignored and sigma is calculated from SNR.'
print*,'niter: is the number of BP iterations.'
print*,'ndeep: -1 is BP only, ndeep>=0 is OSD order'
print*,'K :is the number of message+CRC bits and must be in the range [77,101]'
print*,'WSPR-format message is optional'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ndeep
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
call getarg(5,arg)
read(arg,*) Keff
msg0='K9AN K1JT FN20 '
if(nargs.eq.6) call getarg(6,msg0)
call pack77(msg0,i3,n3,c77)
rate=real(Keff)/real(N)
write(*,*) "code rate: ",rate
write(*,*) "niter : ",max_iterations
write(*,*) "ndeep : ",ndeep
write(*,*) "s : ",s
write(*,*) "K : ",Keff
msgbits=0
read(c77,'(77i1)') msgbits(1:77)
write(*,*) 'message'
write(*,'(77i1)') msgbits(1:77)
call get_crc24(msgbits,101,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') msgbits(78:101)
write(*,'(24i1)') msgbits(78:101)
write(*,*) 'message with crc24'
write(*,'(101i1)') msgbits(1:101)
call encode174_101(msgbits,codeword)
call init_random_seed()
call sgran()
write(*,*) 'codeword'
write(*,'(77i1,1x,24i1,1x,73i1)') codeword
write(*,*) "Eb/N0 Es/N0 ngood nundetected sigma symbol error rate"
do idb = 8,-3,-1
db=idb/2.0-1.0
sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) ! to make db represent Eb/No
! sigma=1/sqrt( 2*(10**(db/10.0)) ) ! db represents Es/No
ngood=0
nue=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
nberr=nberr+nerr
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
apmask=0
! max_iterations is max number of belief propagation iterations
call bpdecode174_101(llr,apmask,max_iterations,message101,cw,nharderror,niterations,nchecks)
dmin=0.0
if( (nharderror .lt. 0) .and. (ndeep .ge. 0) ) then
! call osd174_101(llr, Keff, apmask, ndeep, message101, cw, nharderror, dmin)
maxsuper=2
call decode174_101(llr, Keff, ndeep, apmask, maxsuper, message101, cw, nharderror, iterations, ncheck, dmin, isuper)
endif
if(nharderror.ge.0) then
n2err=0
do i=1,N
if( cw(i)*(2*codeword(i)-1.0) .lt. 0 ) n2err=n2err+1
enddo
if(n2err.eq.0) then
ngood=ngood+1
else
nue=nue+1
endif
endif
enddo
! snr2500=db+10*log10(200.0/116.0/2500.0)
esn0=db+10*log10(rate)
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,esn0,ngood,nue,ss,pberr
if(first) then
write(c77,'(77i1)') message101(1:77)
write(*,'(101i1)') message101
call unpack77(c77,0,msg,unpk77_success)
if(unpk77_success) then
write(*,1100) msg(1:37)
1100 format('Decoded message: ',a37)
else
print*,'Error unpacking message'
endif
first=.false.
endif
enddo
end program ldpcsim174_101

159
lib/fsk4hf/ldpcsim174_74.f90
View File

@ -1,159 +0,0 @@
program ldpcsim174_74
! End-to-end test of the (174,74)/crc24 encoder and decoders.
use packjt77
parameter(N=174, K=74, M=N-K)
character*8 arg
character*37 msg0,msg
character*77 c77
character*50 cmsg
character*24 c24
integer*1 msgbits(74)
integer*1 apmask(174)
integer*1 cw(174)
integer*1 codeword(N),message74(74)
integer ncrc24
integer nerrtot(174),nerrdec(174),nmpcbad(74)
real rxdata(N),llr(N)
real dllr(174),llrd(174)
logical first,unpk77_success
data first/.true./
nerrtot=0
nerrdec=0
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
nargs=iargc()
if(nargs.ne.5 .and. nargs.ne.6) then
print*,'Usage: ldpcsim niter ndeep #trials s K [msg]'
print*,'e.g. ldpcsim174_74 20 5 1000 0.85 64 "K9AN EN50 37"'
print*,'s : if negative, then value is ignored and sigma is calculated from SNR.'
print*,'niter: is the number of BP iterations.'
print*,'ndeep: -1 is BP only, ndeep>=0 is OSD order'
print*,'K :is the number of message+CRC bits and must be in the range [50,74]'
print*,'WSPR-format message is optional'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ndeep
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
call getarg(5,arg)
read(arg,*) Keff
msg0='K9AN EN50 37 '
if(nargs.eq.6) call getarg(6,msg0)
call pack77(msg0,i3,n3,c77)
cmsg=c77(1:50)
rate=real(Keff)/real(N)
write(*,*) "code rate: ",rate
write(*,*) "niter : ",max_iterations
write(*,*) "ndeep : ",ndeep
write(*,*) "s : ",s
write(*,*) "K : ",Keff
msgbits=0
read(cmsg,'(50i1)') msgbits(1:50)
write(*,*) 'message'
write(*,'(74i1)') msgbits
call get_crc24(msgbits,74,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') msgbits(51:74)
call encode174_74(msgbits,codeword)
call init_random_seed()
call sgran()
write(*,*) 'codeword'
write(*,'(50i1,1x,24i1,1x,100i1)') codeword
write(*,*) "Eb/N0 Es/N0 ngood nundetected sigma symbol error rate"
do idb = 8,-3,-1
db=idb/2.0-1.0
sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) ! to make db represent Eb/No
! sigma=1/sqrt( 2*(10**(db/10.0)) ) ! db represents Es/No
ngood=0
nue=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
if(nerr.ge.1) nerrtot(nerr)=nerrtot(nerr)+1
nberr=nberr+nerr
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
apmask=0
! max_iterations is max number of belief propagation iterations
call bpdecode174_74(llr,apmask,max_iterations,message74,cw,nharderror,niterations,nchecks)
dmin=0.0
if( (nharderror .lt. 0) .and. (ndeep .ge. 0) ) then
! call osd174_74(llr, Keff, apmask, ndeep, message74, cw, nharderror, dmin)
call decode174_74(llr,Keff,ndeep,apmask,max_iterations,message74,cw,nharderror,niterations,ncheck,dmin,isuper)
endif
if(nharderror.ge.0) then
n2err=0
do i=1,N
if( cw(i)*(2*codeword(i)-1.0) .lt. 0 ) n2err=n2err+1
enddo
if(n2err.eq.0) then
ngood=ngood+1
else
nue=nue+1
endif
endif
enddo
! snr2500=db+10*log10(200.0/116.0/2500.0)
esn0=db+10*log10(rate)
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,esn0,ngood,nue,ss,pberr
if(first) then
write(c77,'(74i1)') message74
c77(51:77)='000000000000000000000110000'
call unpack77(c77,0,msg,unpk77_success)
if(unpk77_success) then
write(*,1100) msg(1:14)
1100 format('Decoded message: ',a14)
else
print*,'Error unpacking message'
endif
first=.false.
endif
enddo
open(unit=23,file='nerrhisto.dat',status='unknown')
do i=1,120
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
enddo
close(23)
open(unit=25,file='nmpcbad.dat',status='unknown')
do i=1,68
write(25,'(i4,2x,i10)') i,nmpcbad(i)
enddo
close(25)
end program ldpcsim174_74

205
lib/fsk4hf/ldpcsim204.f90
View File

@ -1,205 +0,0 @@
program ldpcsim204
! End-to-end test of the (300,60)/crc10 encoder and decoders.
use crc
use packjt
parameter(NRECENT=10)
character*12 recent_calls(NRECENT)
character*8 arg
character*68 cmsg
character*14 c14
integer*1, allocatable :: codeword(:), decoded(:), message(:)
integer*1, target:: i1Msg8BitBytes(9)
integer*1, target:: i1Dec8BitBytes(9)
integer*1 msgbits(68)
integer*1 apmask(204)
integer*1 cw(204)
integer*2 ncrc14,nrcrc14
integer colorder(204)
integer nerrtot(204),nerrdec(204),nmpcbad(68)
logical checksumok,fsk,bpsk
real*8, allocatable :: rxdata(:)
real, allocatable :: llr(:)
real dllr(204),llrd(204)
data colorder/ &
0, 1, 2, 3, 4, 5, 47, 6, 7, 8, 9, 10, 11, 12, 58, 55, 13, &
14, 15, 46, 17, 18, 60, 19, 20, 21, 22, 23, 24, 25, 57, 26, 27, 49, &
28, 52, 65, 16, 50, 73, 59, 68, 63, 29, 30, 31, 32, 51, 62, 56, 66, &
45, 33, 34, 53, 67, 35, 36, 37, 61, 69, 54, 38, 71, 82, 39, 77, 80, &
83, 78, 84, 48, 41, 85, 40, 64, 75, 96, 74, 72, 76, 86, 87, 89, 90, &
79, 70, 92, 99, 93,101, 95,100, 97, 94, 42, 98,103,105,102, 43,104, &
88, 44,106, 81,107,110,108,111,112,109,113,114,117,118,116,121,115, &
119,122,120,125,129,124,127,126,128, 91,123,133,131,130,134,135,137, &
136,132,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152, &
153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169, &
170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186, &
187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203/
data cmsg/'11111111000000001111111100000000111111110000000011000000000000000000'/
do i=1,NRECENT
recent_calls(i)=' '
enddo
nerrtot=0
nerrdec=0
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
nargs=iargc()
if(nargs.ne.4) then
print*,'Usage: ldpcsim niter ndeep #trials s '
print*,'eg: ldpcsim 100 4 1000 0.84'
print*,'If s is negative, then value is ignored and sigma is calculated from SNR.'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ndeep
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
fsk=.false.
bpsk=.true.
N=204
K=68
rate=real(K)/real(N)
write(*,*) "rate: ",rate
write(*,*) "niter= ",max_iterations," s= ",s
allocate ( codeword(N), decoded(K), message(K) )
allocate ( rxdata(N), llr(N) )
read(cmsg,'(68i1)') msgbits
call get_crc14(msgbits,ncrcsf)
write(c14,'(b14.14)') ncrcsf
read(c14,'(14i1)') msgbits(55:68)
write(*,*) 'message'
write(*,'(9(8i1,1x))') msgbits
call encode204(msgbits,codeword)
call init_random_seed()
call sgran()
write(*,*) 'codeword'
write(*,'(204i1)') codeword
write(*,*) "Eb/N0 SNR2500 ngood nundetected nbadcrc sigma"
do idb = 10,-10,-1
!do idb = 2, 2, -1
db=idb/2.0-1.0
sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) ! to make db represent Eb/No
! sigma=1/sqrt( 2*(10**(db/10.0)) ) ! db represents Es/No
ngood=0
nue=0
nbadcrc=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
if( bpsk ) then
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
elseif( fsk ) then
if( codeword(i) .eq. 1 ) then
r1=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r2=(sigma*gran())**2 + (sigma*gran())**2
elseif( codeword(i) .eq. 0 ) then
r2=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r1=(sigma*gran())**2 + (sigma*gran())**2
endif
rxdata(i)=0.35*(sqrt(r1)-sqrt(r2))
! rxdata(i)=0.35*(exp(r1)-exp(r2))
! rxdata(i)=0.12*(log(r1)-log(r2))
endif
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
if(nerr.ge.1) nerrtot(nerr)=nerrtot(nerr)+1
nberr=nberr+nerr
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
! To match the metric to the channel, s should be set to the noise standard deviation.
! For now, set s to the value that optimizes decode probability near threshold.
! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of
! magnitude in UER
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
apmask=0
! max_iterations is max number of belief propagation iterations
call bpdecode204(llr,apmask,max_iterations,decoded,cw,nharderror,niterations)
if(nharderror.lt.0) niterations=-1
if( (nharderror .lt. 0) .and. (ndeep .ge. 0) ) then
call osd204(llr, apmask, ndeep, decoded, cw, nhardmin, dmin)
niterations=nhardmin
endif
n2err=0
do i=1,N
if( cw(i)*(2*codeword(i)-1.0) .lt. 0 ) n2err=n2err+1
enddo
! If the decoder finds a valid codeword, niterations will be .ge. 0.
if( niterations .ge. 0 ) then
call get_crc14(decoded,ncheck)
ncrcflag=0
if(ncheck.eq.0) ncrcflag=1
if( ncrcflag .ne. 1 ) then
nbadcrc=nbadcrc+1
endif
nueflag=0
nerrmpc=0
do i=1,K ! find number of errors in message+crc part of codeword
if( msgbits(i) .ne. decoded(i) ) then
if(ncrcflag.eq.1) nueflag=1
nerrmpc=nerrmpc+1
endif
enddo
if(nerrmpc.ge.1) nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1 ! This histogram should inform our selection of CRC poly
if( ncrcflag .eq. 1 .and. nueflag .eq. 0 ) then
ngood=ngood+1
if(nerr.ge.1) nerrdec(nerr)=nerrdec(nerr)+1
else if( ncrcflag .eq. 1 .and. nueflag .eq. 1 ) then
nue=nue+1;
endif
endif
enddo
snr2500=db+10*log10(200.0/116.0/2500.0)
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,snr2500,ngood,nue,nbadcrc,ss,pberr
enddo
open(unit=23,file='nerrhisto.dat',status='unknown')
do i=1,120
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
enddo
close(23)
open(unit=25,file='nmpcbad.dat',status='unknown')
do i=1,68
write(25,'(i4,2x,i10)') i,nmpcbad(i)
enddo
close(25)
end program ldpcsim204

144
lib/fsk4hf/ldpcsim240_101.f90
View File

@ -1,144 +0,0 @@
program ldpcsim240_101
! End-to-end test of the (240,101)/crc24 encoder and decoders.
use packjt77
parameter(N=240, K=101, M=N-K)
character*8 arg
character*37 msg0,msg
character*77 c77
character*24 c24
integer*1 msgbits(101)
integer*1 apmask(240)
integer*1 cw(240)
integer*1 codeword(N),message101(101)
integer ncrc24
real rxdata(N),llr(N)
real llrd(240)
logical first,unpk77_success
data first/.true./
nargs=iargc()
if(nargs.ne.5 .and. nargs.ne.6) then
print*,'Usage: ldpcsim niter ndeep #trials s K [msg]'
print*,'e.g. ldpcsim240_101 20 5 1000 0.85 91 "K9AN K1JT FN20"'
print*,'s : if negative, then value is ignored and sigma is calculated from SNR.'
print*,'niter: is the number of BP iterations.'
print*,'ndeep: -1 is BP only, ndeep>=0 is OSD order'
print*,'K :is the number of message+CRC bits and must be in the range [77,101]'
print*,'WSPR-format message is optional'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ndeep
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
call getarg(5,arg)
read(arg,*) Keff
msg0='K9AN K1JT FN20 '
if(nargs.eq.6) call getarg(6,msg0)
call pack77(msg0,i3,n3,c77)
rate=real(Keff)/real(N)
write(*,*) "code rate: ",rate
write(*,*) "niter : ",max_iterations
write(*,*) "ndeep : ",ndeep
write(*,*) "s : ",s
write(*,*) "K : ",Keff
msgbits=0
read(c77,'(77i1)') msgbits(1:77)
write(*,*) 'message'
write(*,'(77i1)') msgbits(1:77)
call get_crc24(msgbits,101,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') msgbits(78:101)
write(*,'(24i1)') msgbits(78:101)
write(*,*) 'message with crc24'
write(*,'(101i1)') msgbits(1:101)
call encode240_101(msgbits,codeword)
call init_random_seed()
call sgran()
write(*,*) 'codeword'
write(*,'(77i1,1x,24i1,1x,73i1)') codeword
write(*,*) "Eb/N0 Es/N0 ngood nundetected sigma symbol error rate"
do idb = 8,-3,-1
db=idb/2.0-1.0
sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) ! to make db represent Eb/No
! sigma=1/sqrt( 2*(10**(db/10.0)) ) ! db represents Es/No
ngood=0
nue=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
nberr=nberr+nerr
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
apmask=0
! max_iterations is max number of belief propagation iterations
call bpdecode240_101(llr,apmask,max_iterations,message101,cw,nharderror,niterations,nchecks)
dmin=0.0
if( (nharderror .lt. 0) .and. (ndeep .ge. 0) ) then
! call osd240_101(llr, Keff, apmask, ndeep, message101, cw, nharderror, dmin)
maxsuper=2
call decode240_101(llr, Keff, ndeep, apmask, maxsuper, message101, cw, nharderror, iterations, ncheck, dmin, isuper)
endif
if(nharderror.ge.0) then
n2err=0
do i=1,N
if( cw(i)*(2*codeword(i)-1.0) .lt. 0 ) n2err=n2err+1
enddo
if(n2err.eq.0) then
ngood=ngood+1
else
nue=nue+1
endif
endif
enddo
! snr2500=db+10*log10(200.0/116.0/2500.0)
esn0=db+10*log10(rate)
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,esn0,ngood,nue,ss,pberr
if(first) then
write(c77,'(77i1)') message101(1:77)
write(*,'(101i1)') message101
call unpack77(c77,0,msg,unpk77_success)
if(unpk77_success) then
write(*,1100) msg(1:37)
1100 format('Decoded message: ',a37)
else
print*,'Error unpacking message'
endif
first=.false.
endif
enddo
end program ldpcsim240_101

144
lib/fsk4hf/ldpcsim280_101.f90
View File

@ -1,144 +0,0 @@
program ldpcsim280_101
! End-to-end test of the (280,101)/crc24 encoder and decoders.
use packjt77
parameter(N=280, K=101, M=N-K)
character*8 arg
character*37 msg0,msg
character*77 c77
character*24 c24
integer*1 msgbits(101)
integer*1 apmask(280)
integer*1 cw(280)
integer*1 codeword(N),message101(101)
integer ncrc24
real rxdata(N),llr(N)
real llrd(280)
logical first,unpk77_success
data first/.true./
nargs=iargc()
if(nargs.ne.5 .and. nargs.ne.6) then
print*,'Usage: ldpcsim niter ndeep #trials s K [msg]'
print*,'e.g. ldpcsim280_101 20 5 1000 0.85 91 "K9AN K1JT FN20"'
print*,'s : if negative, then value is ignored and sigma is calculated from SNR.'
print*,'niter: is the number of BP iterations.'
print*,'ndeep: -1 is BP only, ndeep>=0 is OSD order'
print*,'K :is the number of message+CRC bits and must be in the range [77,101]'
print*,'WSPR-format message is optional'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ndeep
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
call getarg(5,arg)
read(arg,*) Keff
msg0='K9AN K1JT FN20 '
if(nargs.eq.6) call getarg(6,msg0)
call pack77(msg0,i3,n3,c77)
rate=real(Keff)/real(N)
write(*,*) "code rate: ",rate
write(*,*) "niter : ",max_iterations
write(*,*) "ndeep : ",ndeep
write(*,*) "s : ",s
write(*,*) "K : ",Keff
msgbits=0
read(c77,'(77i1)') msgbits(1:77)
write(*,*) 'message'
write(*,'(77i1)') msgbits(1:77)
call get_crc24(msgbits,101,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') msgbits(78:101)
write(*,'(24i1)') msgbits(78:101)
write(*,*) 'message with crc24'
write(*,'(101i1)') msgbits(1:101)
call encode280_101(msgbits,codeword)
call init_random_seed()
call sgran()
write(*,*) 'codeword'
write(*,'(77i1,1x,24i1,1x,73i1)') codeword
write(*,*) "Eb/N0 Es/N0 ngood nundetected sigma symbol error rate"
do idb = 8,-3,-1
db=idb/2.0-1.0
sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) ! to make db represent Eb/No
! sigma=1/sqrt( 2*(10**(db/10.0)) ) ! db represents Es/No
ngood=0
nue=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
nberr=nberr+nerr
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
apmask=0
! max_iterations is max number of belief propagation iterations
call bpdecode280_101(llr,apmask,max_iterations,message101,cw,nharderror,niterations,nchecks)
dmin=0.0
if( (nharderror .lt. 0) .and. (ndeep .ge. 0) ) then
! call osd280_101(llr, Keff, apmask, ndeep, message101, cw, nharderror, dmin)
maxsuper=2
call decode280_101(llr, Keff, ndeep, apmask, maxsuper, message101, cw, nharderror, iterations, ncheck, dmin, isuper)
endif
if(nharderror.ge.0) then
n2err=0
do i=1,N
if( cw(i)*(2*codeword(i)-1.0) .lt. 0 ) n2err=n2err+1
enddo
if(n2err.eq.0) then
ngood=ngood+1
else
nue=nue+1
endif
endif
enddo
! snr2500=db+10*log10(200.0/116.0/2500.0)
esn0=db+10*log10(rate)
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,esn0,ngood,nue,ss,pberr
if(first) then
write(c77,'(77i1)') message101(1:77)
write(*,'(101i1)') message101
call unpack77(c77,0,msg,unpk77_success)
if(unpk77_success) then
write(*,1100) msg(1:37)
1100 format('Decoded message: ',a37)
else
print*,'Error unpacking message'
endif
first=.false.
endif
enddo
end program ldpcsim280_101

254
lib/fsk4hf/ldpcsim300.f90
View File

@ -1,254 +0,0 @@
program ldpcsim300
! End-to-end test of the (300,60)/crc10 encoder and decoders.
use crc
use packjt
parameter(NRECENT=10)
character*12 recent_calls(NRECENT)
character*8 arg
integer*1, allocatable :: codeword(:), decoded(:), message(:)
integer*1, target:: i1Msg8BitBytes(9)
integer*1, target:: i1Dec8BitBytes(9)
integer*1 msgbits(60)
integer*1 apmask(300)
integer*1 cw(300)
integer*2 checksum
integer colorder(300)
integer nerrtot(300),nerrdec(300),nmpcbad(60)
logical checksumok,fsk,bpsk
real*8, allocatable :: rxdata(:)
real, allocatable :: llr(:)
real dllr(300),llrd(300)
data colorder/ &
0,1,2,3,4,5,6,7,8,9,10,11,123,12,13,14,15,16,17,18, &
19,20,21,22,23,24,25,138,26,145,27,28,29,30,31,32,33,34,35,36, &
37,154,38,39,40,41,42,43,44,144,46,47,48,49,50,51,52,53,143,54, &
125,56,57,58,124,59,120,140,157,160,55,60,61,62,156,162,141,64,65,153, &
181,183,66,170,67,68,69,130,70,164,71,72,73,74,75,63,76,77,135,78, &
79,80,176,169,82,83,84,167,180,85,136,158,129,166,175,142,134,146,121,165, &
88,89,192,90,45,91,92,93,182,189,94,95,96,173,81,97,98,178,122,126, &
132,99,100,152,186,193,101,102,151,103,104,172,159,168,150,190,147,148,201,107, &
205,177,108,198,197,174,127,109,185,110,202,87,199,171,179,187,139,137,106,131, &
206,194,112,149,155,113,128,184,196,86,114,203,212,195,208,105,188,161,163,191, &
200,209,214,204,115,218,133,111,207,117,213,216,211,217,116,215,219,220,210,221, &
118,222,223,225,224,228,226,229,231,227,233,119,234,235,232,230,237,239,236,238, &
240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259, &
260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279, &
280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299/
do i=1,NRECENT
recent_calls(i)=' '
enddo
nerrtot=0
nerrdec=0
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
nargs=iargc()
if(nargs.ne.4) then
print*,'Usage: ldpcsim niter ndeep #trials s '
print*,'eg: ldpcsim 100 4 1000 0.84'
print*,'If s is negative, then value is ignored and sigma is calculated from SNR.'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ndeep
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
fsk=.false.
bpsk=.true.
! don't count crc bits as data bits
N=300
K=60
! scale Eb/No for a (300,50) code
rate=real(50)/real(N)
write(*,*) "rate: ",rate
write(*,*) "niter= ",max_iterations," s= ",s
allocate ( codeword(N), decoded(K), message(K) )
allocate ( rxdata(N), llr(N) )
! The message should be packed into the first 7 bytes
i1Msg8BitBytes(1:6)=85
i1Msg8BitBytes(7)=64
! The CRC will be put into the last 2 bytes
i1Msg8BitBytes(8:9)=0
checksum = crc10 (c_loc (i1Msg8BitBytes), 9)
! For reference, the next 3 lines show how to check the CRC
i1Msg8BitBytes(8)=checksum/256
i1Msg8BitBytes(9)=iand (checksum,255)
checksumok = crc10_check(c_loc (i1Msg8BitBytes), 9)
if( checksumok ) write(*,*) 'Good checksum'
write(*,*) i1Msg8BitBytes(1:9)
mbit=0
do i=1, 7
i1=i1Msg8BitBytes(i)
do ibit=1,8
mbit=mbit+1
msgbits(mbit)=iand(1,ishft(i1,ibit-8))
enddo
enddo
i1=i1Msg8BitBytes(8) ! First 2 bits of crc10 are LSB of this byte
do ibit=1,2
msgbits(50+ibit)=iand(1,ishft(i1,ibit-2))
enddo
i1=i1Msg8BitBytes(9) ! Now shift in last 8 bits of the CRC
do ibit=1,8
msgbits(52+ibit)=iand(1,ishft(i1,ibit-8))
enddo
write(*,*) 'message'
write(*,'(9(8i1,1x))') msgbits
call encode300(msgbits,codeword)
call init_random_seed()
call sgran()
write(*,*) 'codeword'
write(*,'(38(8i1,1x))') codeword
write(*,*) "Eb/N0 SNR2500 ngood nundetected nbadcrc sigma"
do idb = 20,-16,-1
!do idb = -16, -16, -1
db=idb/2.0-1.0
sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) ! to make db represent Eb/No
! sigma=1/sqrt( 2*(10**(db/10.0)) ) ! db represents Es/No
ngood=0
nue=0
nbadcrc=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
if( bpsk ) then
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
elseif( fsk ) then
if( codeword(i) .eq. 1 ) then
r1=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r2=(sigma*gran())**2 + (sigma*gran())**2
elseif( codeword(i) .eq. 0 ) then
r2=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r1=(sigma*gran())**2 + (sigma*gran())**2
endif
rxdata(i)=0.35*(sqrt(r1)-sqrt(r2))
! rxdata(i)=0.35*(exp(r1)-exp(r2))
! rxdata(i)=0.12*(log(r1)-log(r2))
endif
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
if(nerr.ge.1) nerrtot(nerr)=nerrtot(nerr)+1
nberr=nberr+nerr
! Correct signal normalization is important for this decoder.
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
! To match the metric to the channel, s should be set to the noise standard deviation.
! For now, set s to the value that optimizes decode probability near threshold.
! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of
! magnitude in UER
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
apmask=0
! max_iterations is max number of belief propagation iterations
call bpdecode300(llr, apmask, max_iterations, decoded, niterations, cw)
if( (niterations .lt. 0) .and. (ndeep .ge. 0) ) then
call osd300(llr, apmask, ndeep, decoded, cw, nhardmin, dmin)
niterations=nhardmin
endif
n2err=0
do i=1,N
if( cw(i)*(2*codeword(i)-1.0) .lt. 0 ) n2err=n2err+1
enddo
!write(*,*) nerr,niterations,n2err
damp=0.75
ndither=0
if( niterations .lt. 0 ) then
do i=1, ndither
do in=1,N
dllr(in)=damp*gran()
enddo
llrd=llr+dllr
call bpdecode300(llrd, apmask, max_iterations, decoded, niterations, cw)
if( niterations .ge. 0 ) exit
enddo
endif
! If the decoder finds a valid codeword, niterations will be .ge. 0.
if( niterations .ge. 0 ) then
! Check the CRC
do ibyte=1,6
itmp=0
do ibit=1,8
itmp=ishft(itmp,1)+iand(1,decoded((ibyte-1)*8+ibit))
enddo
i1Dec8BitBytes(ibyte)=itmp
enddo
i1Dec8BitBytes(7)=decoded(49)*128+decoded(50)*64
! Need to pack the received crc into bytes 8 and 9 for crc10_check
i1Dec8BitBytes(8)=decoded(51)*2+decoded(52)
i1Dec8BitBytes(9)=decoded(53)*128+decoded(54)*64+decoded(55)*32+decoded(56)*16
i1Dec8BitBytes(9)=i1Dec8BitBytes(9)+decoded(57)*8+decoded(58)*4+decoded(59)*2+decoded(60)*1
ncrcflag=0
if( crc10_check( c_loc( i1Dec8BitBytes ), 9 ) ) ncrcflag=1
if( ncrcflag .ne. 1 ) then
nbadcrc=nbadcrc+1
endif
nueflag=0
nerrmpc=0
do i=1,K ! find number of errors in message+crc part of codeword
if( msgbits(i) .ne. decoded(i) ) then
nueflag=1
nerrmpc=nerrmpc+1
endif
enddo
if(nerrmpc.ge.1) nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1 ! This histogram should inform our selection of CRC poly
if( ncrcflag .eq. 1 .and. nueflag .eq. 0 ) then
ngood=ngood+1
if(nerr.ge.1) nerrdec(nerr)=nerrdec(nerr)+1
else if( ncrcflag .eq. 1 .and. nueflag .eq. 1 ) then
nue=nue+1;
endif
endif
enddo
snr2500=db+10*log10(1.389/2500.0)
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,snr2500,ngood,nue,nbadcrc,ss,pberr
enddo
open(unit=23,file='nerrhisto.dat',status='unknown')
do i=1,120
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
enddo
close(23)
open(unit=25,file='nmpcbad.dat',status='unknown')
do i=1,60
write(25,'(i4,2x,i10)') i,nmpcbad(i)
enddo
close(25)
end program ldpcsim300

81
lib/fsk4hf/msksoftsym.f90
View File

@ -1,81 +0,0 @@
subroutine msksoftsym(zz,aa,bb,id,nterms,ierror,rxdata,nhard0,nhardsync0)
parameter (KK=84) !Information bits (72 + CRC12)
parameter (ND=168) !Data symbols: LDPC (168,84), r=1/2
parameter (NS=65) !Sync symbols (2 x 26 + Barker 13)
parameter (NR=3) !Ramp up/down
parameter (NN=NR+NS+ND) !Total symbols (236)
parameter (NSPS=16) !Samples per MSK symbol (16)
parameter (N2=2*NSPS) !Samples per OQPSK symbol (32)
parameter (N13=13*N2) !Samples in central sync vector (416)
parameter (NZ=NSPS*NN) !Samples in baseband waveform (3760)
parameter (NFFT1=4*NSPS,NH1=NFFT1/2)
complex zz(NS+ND) !Complex symbol values (intermediate)
complex z,z0
real rxdata(ND) !Soft symbols
real aa(20),bb(20) !Fitted polyco's
integer id(NS+ND) !NRZ values (+/-1) for Sync and Data
integer ierror(NS+ND)
n=0
ierror=0
do j=1,117
xx=j*2.0/117.0 - 1.0
yii=1.
yqq=0.
if(nterms.gt.0) then
yii=aa(1)
yqq=bb(1)
do i=2,nterms
yii=yii + aa(i)*xx**(i-1)
yqq=yqq + bb(i)*xx**(i-1)
enddo
endif
z0=cmplx(yii,yqq)
z=zz(j)*conjg(z0)
p=real(z)
if(abs(id(j)).eq.2) then
if(real(z)*id(j).lt.0) then !Sync bit
nhardsync0=nhardsync0+1
ierror(j)=2
endif
else
n=n+1 !Data bit
rxdata(n)=p
ierr=0
if(id(j)*p.lt.0) then
ierr=1
ierror(j)=1
endif
nhard0=nhard0+ierr
endif
enddo
do j=118,233
xx=(j-116.5)*2.0/117.0 - 1.0
yii=1.
yqq=0.
if(nterms.gt.0) then
yii=aa(1)
yqq=bb(1)
do i=2,nterms
yii=yii + aa(i)*xx**(i-1)
yqq=yqq + bb(i)*xx**(i-1)
enddo
endif
z0=cmplx(yii,yqq)
z=zz(j)*conjg(z0)
p=aimag(z)
n=n+1
rxdata(n)=p
ierr=0
if(id(j)*p.lt.0) then
ierr=1
ierror(j)=1
endif
nhard0=nhard0+ierr
enddo
return
end subroutine msksoftsym

78
lib/fsk4hf/msksoftsymw.f90
View File

@ -1,78 +0,0 @@
subroutine msksoftsymw(zz,aa,bb,id,nterms,ierror,rxdata,nhard0,nhardsync0)
include 'wsprlf_params.f90'
complex zz(NS+ND) !Complex symbol values (intermediate)
complex z,z0
real rxdata(ND) !Soft symbols
real aa(20),bb(20) !Fitted polyco's
integer id(NS+ND) !NRZ values (+/-1) for Sync and Data
integer ierror(NS+ND)
n=0
ierror=0
ierr=0
jz=(NS+ND+1)/2
do j=1,jz
xx=j*2.0/jz - 1.0
yii=1.
yqq=0.
if(nterms.gt.0) then
yii=aa(1)
yqq=bb(1)
do i=2,nterms
yii=yii + aa(i)*xx**(i-1)
yqq=yqq + bb(i)*xx**(i-1)
enddo
endif
z0=cmplx(yii,yqq)
z=zz(j)*conjg(z0)
p=real(z)
if(abs(id(j)).eq.2) then
if(real(z)*id(j).lt.0) then !Sync bit
nhardsync0=nhardsync0+1
ierror(j)=2
endif
else
n=n+1 !Data bit
rxdata(n)=p
ierr=0
if(id(j)*p.lt.0) then
ierr=1
ierror(j)=1
endif
nhard0=nhard0+ierr
endif
! write(41,3301) j,id(j),ierror(j),ierr,n,p,p*id(j)
!3301 format(5i6,2f10.3)
enddo
do j=jz+1,NS+ND
xx=(j-jz+0.5)*2.0/jz - 1.0
yii=1.
yqq=0.
if(nterms.gt.0) then
yii=aa(1)
yqq=bb(1)
do i=2,nterms
yii=yii + aa(i)*xx**(i-1)
yqq=yqq + bb(i)*xx**(i-1)
enddo
endif
z0=cmplx(yii,yqq)
z=zz(j)*conjg(z0)
p=aimag(z)
n=n+1
if(n.gt.ND) exit
rxdata(n)=p
ierr=0
if(id(j)*p.lt.0) then
ierr=1
ierror(j)=1
endif
nhard0=nhard0+ierr
! write(41,3301) j,id(j),ierror(j),ierr,n,p,p*id(j)
enddo
return
end subroutine msksoftsymw

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