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

Spring cleaning

This commit is contained in:
Bill Somerville 2020-06-03 15:27:49 +01:00
parent 62932bec5c
commit 40e05d2a9f
No known key found for this signature in database
GPG Key ID: D864B06D1E81618F
138 changed files with 0 additions and 21533 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

403
lib/fsk4hf/osd174_101.f90
View File

@ -1,403 +0,0 @@
subroutine osd174_101(llr,k,apmask,ndeep,message101,cw,nhardmin,dmin)
!
! An ordered-statistics decoder for the (174,101) code.
! Message payload is 77 bits. Any or all of a 24-bit CRC can be
! used for detecting incorrect codewords. The remaining CRC bits are
! cascaded with the LDPC code for the purpose of improving the
! distance spectrum of the code.
!
! If p1 (0.le.p1.le.24) is the number of CRC24 bits that are
! to be used for bad codeword detection, then the argument k should
! be set to 77+p1.
!
! Valid values for k are in the range [77,101].
!
character*24 c24
integer, parameter:: N=174
integer*1 apmask(N),apmaskr(N)
integer*1, allocatable, save :: gen(:,:)
integer*1, allocatable :: genmrb(:,:),g2(:,:)
integer*1, allocatable :: temp(:),m0(:),me(:),mi(:),misub(:),e2sub(:),e2(:),ui(:)
integer*1, allocatable :: r2pat(:)
integer indices(N),nxor(N)
integer*1 cw(N),ce(N),c0(N),hdec(N)
integer*1, allocatable :: decoded(:)
integer*1 message101(101)
integer indx(N)
real llr(N),rx(N),absrx(N)
logical first,reset
data first/.true./
save first
allocate( genmrb(k,N), g2(N,k) )
allocate( temp(k), m0(k), me(k), mi(k), misub(k), e2sub(N-k), e2(N-k), ui(N-k) )
allocate( r2pat(N-k), decoded(k) )
if( first ) then ! fill the generator matrix
!
! Create generator matrix for partial CRC cascaded with LDPC code.
!
! Let p2=101-k and p1+p2=24.
!
! The last p2 bits of the CRC24 are cascaded with the LDPC code.
!
! The first p1=k-77 CRC24 bits will be used for error detection.
!
allocate( gen(k,N) )
gen=0
do i=1,k
message101=0
message101(i)=1
if(i.le.77) then
call get_crc24(message101,101,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') message101(78:101)
message101(78:k)=0
endif
call encode174_101(message101,cw)
gen(i,:)=cw
enddo
first=.false.
endif
rx=llr
apmaskr=apmask
! Hard decisions on the received word.
hdec=0
where(rx .ge. 0) hdec=1
! Use magnitude of received symbols as a measure of reliability.
absrx=abs(rx)
call indexx(absrx,N,indx)
! Re-order the columns of the generator matrix in order of decreasing reliability.
do i=1,N
genmrb(1:k,i)=gen(1:k,indx(N+1-i))
indices(i)=indx(N+1-i)
enddo
! Do gaussian elimination to create a generator matrix with the most reliable
! received bits in positions 1:k in order of decreasing reliability (more or less).
do id=1,k ! diagonal element indices
do icol=id,k+20 ! The 20 is ad hoc - beware
iflag=0
if( genmrb(id,icol) .eq. 1 ) then
iflag=1
if( icol .ne. id ) then ! reorder column
temp(1:k)=genmrb(1:k,id)
genmrb(1:k,id)=genmrb(1:k,icol)
genmrb(1:k,icol)=temp(1:k)
itmp=indices(id)
indices(id)=indices(icol)
indices(icol)=itmp
endif
do ii=1,k
if( ii .ne. id .and. genmrb(ii,id) .eq. 1 ) then
genmrb(ii,1:N)=ieor(genmrb(ii,1:N),genmrb(id,1:N))
endif
enddo
exit
endif
enddo
enddo
g2=transpose(genmrb)
! The hard decisions for the k MRB bits define the order 0 message, m0.
! Encode m0 using the modified generator matrix to find the "order 0" codeword.
! Flip various combinations of bits in m0 and re-encode to generate a list of
! codewords. Return the member of the list that has the smallest Euclidean
! distance to the received word.
hdec=hdec(indices) ! hard decisions from received symbols
m0=hdec(1:k) ! zero'th order message
absrx=absrx(indices)
rx=rx(indices)
apmaskr=apmaskr(indices)
call mrbencode101(m0,c0,g2,N,k)
nxor=ieor(c0,hdec)
nhardmin=sum(nxor)
dmin=sum(nxor*absrx)
cw=c0
ntotal=0
nrejected=0
npre1=0
npre2=0
if(ndeep.eq.0) goto 998 ! norder=0
if(ndeep.gt.6) ndeep=6
if( ndeep.eq. 1) then
nord=1
npre1=0
npre2=0
nt=40
ntheta=12
elseif(ndeep.eq.2) then
nord=1
npre1=1
npre2=0
nt=40
ntheta=12
elseif(ndeep.eq.3) then
nord=1
npre1=1
npre2=1
nt=40
ntheta=12
ntau=14
elseif(ndeep.eq.4) then
nord=2
npre1=1
npre2=1
nt=40
ntheta=12
ntau=19
elseif(ndeep.eq.5) then
nord=3
npre1=1
npre2=1
nt=40
ntheta=12
ntau=19
elseif(ndeep.eq.6) then
nord=4
npre1=1
npre2=1
nt=40
ntheta=12
ntau=19
endif
do iorder=1,nord
misub(1:k-iorder)=0
misub(k-iorder+1:k)=1
iflag=k-iorder+1
do while(iflag .ge.0)
if(iorder.eq.nord .and. npre1.eq.0) then
iend=iflag
else
iend=1
endif
d1=0.
do n1=iflag,iend,-1
mi=misub
mi(n1)=1
if(any(iand(apmaskr(1:k),mi).eq.1)) cycle
ntotal=ntotal+1
me=ieor(m0,mi)
if(n1.eq.iflag) then
call mrbencode101(me,ce,g2,N,k)
e2sub=ieor(ce(k+1:N),hdec(k+1:N))
e2=e2sub
nd1kpt=sum(e2sub(1:nt))+1
d1=sum(ieor(me(1:k),hdec(1:k))*absrx(1:k))
else
e2=ieor(e2sub,g2(k+1:N,n1))
nd1kpt=sum(e2(1:nt))+2
endif
if(nd1kpt .le. ntheta) then
call mrbencode101(me,ce,g2,N,k)
nxor=ieor(ce,hdec)
if(n1.eq.iflag) then
dd=d1+sum(e2sub*absrx(k+1:N))
else
dd=d1+ieor(ce(n1),hdec(n1))*absrx(n1)+sum(e2*absrx(k+1:N))
endif
if( dd .lt. dmin ) then
dmin=dd
cw=ce
nhardmin=sum(nxor)
nd1kptbest=nd1kpt
endif
else
nrejected=nrejected+1
endif
enddo
! Get the next test error pattern, iflag will go negative
! when the last pattern with weight iorder has been generated.
call nextpat101(misub,k,iorder,iflag)
enddo
enddo
if(npre2.eq.1) then
reset=.true.
ntotal=0
do i1=k,1,-1
do i2=i1-1,1,-1
ntotal=ntotal+1
mi(1:ntau)=ieor(g2(k+1:k+ntau,i1),g2(k+1:k+ntau,i2))
call boxit101(reset,mi(1:ntau),ntau,ntotal,i1,i2)
enddo
enddo
ncount2=0
ntotal2=0
reset=.true.
! Now run through again and do the second pre-processing rule
misub(1:k-nord)=0
misub(k-nord+1:k)=1
iflag=k-nord+1
do while(iflag .ge.0)
me=ieor(m0,misub)
call mrbencode101(me,ce,g2,N,k)
e2sub=ieor(ce(k+1:N),hdec(k+1:N))
do i2=0,ntau
ntotal2=ntotal2+1
ui=0
if(i2.gt.0) ui(i2)=1
r2pat=ieor(e2sub,ui)
778 continue
call fetchit101(reset,r2pat(1:ntau),ntau,in1,in2)
if(in1.gt.0.and.in2.gt.0) then
ncount2=ncount2+1
mi=misub
mi(in1)=1
mi(in2)=1
if(sum(mi).lt.nord+npre1+npre2.or.any(iand(apmaskr(1:k),mi).eq.1)) cycle
me=ieor(m0,mi)
call mrbencode101(me,ce,g2,N,k)
nxor=ieor(ce,hdec)
dd=sum(nxor*absrx)
if( dd .lt. dmin ) then
dmin=dd
cw=ce
nhardmin=sum(nxor)
endif
goto 778
endif
enddo
call nextpat101(misub,k,nord,iflag)
enddo
endif
998 continue
! Re-order the codeword to [message bits][parity bits] format.
cw(indices)=cw
hdec(indices)=hdec
message101=cw(1:101)
call get_crc24(message101,101,nbadcrc)
if(nbadcrc.ne.0) nhardmin=-nhardmin
return
end subroutine osd174_101
subroutine mrbencode101(me,codeword,g2,N,K)
integer*1 me(K),codeword(N),g2(N,K)
! fast encoding for low-weight test patterns
codeword=0
do i=1,K
if( me(i) .eq. 1 ) then
codeword=ieor(codeword,g2(1:N,i))
endif
enddo
return
end subroutine mrbencode101
subroutine nextpat101(mi,k,iorder,iflag)
integer*1 mi(k),ms(k)
! generate the next test error pattern
ind=-1
do i=1,k-1
if( mi(i).eq.0 .and. mi(i+1).eq.1) ind=i
enddo
if( ind .lt. 0 ) then ! no more patterns of this order
iflag=ind
return
endif
ms=0
ms(1:ind-1)=mi(1:ind-1)
ms(ind)=1
ms(ind+1)=0
if( ind+1 .lt. k ) then
nz=iorder-sum(ms)
ms(k-nz+1:k)=1
endif
mi=ms
do i=1,k ! iflag will point to the lowest-index 1 in mi
if(mi(i).eq.1) then
iflag=i
exit
endif
enddo
return
end subroutine nextpat101
subroutine boxit101(reset,e2,ntau,npindex,i1,i2)
integer*1 e2(1:ntau)
integer indexes(5000,2),fp(0:525000),np(5000)
logical reset
common/boxes/indexes,fp,np
if(reset) then
patterns=-1
fp=-1
np=-1
sc=-1
indexes=-1
reset=.false.
endif
indexes(npindex,1)=i1
indexes(npindex,2)=i2
ipat=0
do i=1,ntau
if(e2(i).eq.1) then
ipat=ipat+ishft(1,ntau-i)
endif
enddo
ip=fp(ipat) ! see what's currently stored in fp(ipat)
if(ip.eq.-1) then
fp(ipat)=npindex
else
do while (np(ip).ne.-1)
ip=np(ip)
enddo
np(ip)=npindex
endif
return
end subroutine boxit101
subroutine fetchit101(reset,e2,ntau,i1,i2)
integer indexes(5000,2),fp(0:525000),np(5000)
integer lastpat
integer*1 e2(ntau)
logical reset
common/boxes/indexes,fp,np
save lastpat,inext
if(reset) then
lastpat=-1
reset=.false.
endif
ipat=0
do i=1,ntau
if(e2(i).eq.1) then
ipat=ipat+ishft(1,ntau-i)
endif
enddo
index=fp(ipat)
if(lastpat.ne.ipat .and. index.gt.0) then ! return first set of indices
i1=indexes(index,1)
i2=indexes(index,2)
inext=np(index)
elseif(lastpat.eq.ipat .and. inext.gt.0) then
i1=indexes(inext,1)
i2=indexes(inext,2)
inext=np(inext)
else
i1=-1
i2=-1
inext=-1
endif
lastpat=ipat
return
end subroutine fetchit101

405
lib/fsk4hf/osd174_74.f90
View File

@ -1,405 +0,0 @@
subroutine osd174_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin)
!
! An ordered-statistics decoder for the (174,74) code.
! Message payload is 50 bits. Any or all of a 24-bit CRC can be
! used for detecting incorrect codewords. The remaining CRC bits are
! cascaded with the LDPC code for the purpose of improving the
! distance spectrum of the code.
!
! If p1 (0.le.p1.le.24) is the number of CRC24 bits that are
! to be used for bad codeword detection, then the argument k should
! be set to 50+p1.
!
! Valid values for k are in the range [50,74].
!
character*24 c24
integer, parameter:: N=174
integer*1 apmask(N),apmaskr(N)
integer*1, allocatable, save :: gen(:,:)
integer*1, allocatable :: genmrb(:,:),g2(:,:)
integer*1, allocatable :: temp(:),m0(:),me(:),mi(:),misub(:),e2sub(:),e2(:),ui(:)
integer*1, allocatable :: r2pat(:)
integer indices(N),nxor(N)
integer*1 cw(N),ce(N),c0(N),hdec(N)
integer*1, allocatable :: decoded(:)
integer*1 message74(74)
integer indx(N)
real llr(N),rx(N),absrx(N)
!include "ldpc_174_74_generator.f90"
logical first,reset
data first/.true./
save first
allocate( genmrb(k,N), g2(N,k) )
allocate( temp(k), m0(k), me(k), mi(k), misub(k), e2sub(N-k), e2(N-k), ui(N-k) )
allocate( r2pat(N-k), decoded(k) )
if( first ) then ! fill the generator matrix
!
! Create generator matrix for partial CRC cascaded with LDPC code.
!
! Let p2=74-k and p1+p2=24.
!
! The last p2 bits of the CRC24 are cascaded with the LDPC code.
!
! The first p1=k-50 CRC24 bits will be used for error detection.
!
allocate( gen(k,N) )
gen=0
do i=1,k
message74=0
message74(i)=1
if(i.le.50) then
call get_crc24(message74,74,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') message74(51:74)
message74(51:k)=0
endif
call encode174_74(message74,cw)
gen(i,:)=cw
enddo
first=.false.
endif
rx=llr
apmaskr=apmask
! Hard decisions on the received word.
hdec=0
where(rx .ge. 0) hdec=1
! Use magnitude of received symbols as a measure of reliability.
absrx=abs(rx)
call indexx(absrx,N,indx)
! Re-order the columns of the generator matrix in order of decreasing reliability.
do i=1,N
genmrb(1:k,i)=gen(1:k,indx(N+1-i))
indices(i)=indx(N+1-i)
enddo
! Do gaussian elimination to create a generator matrix with the most reliable
! received bits in positions 1:k in order of decreasing reliability (more or less).
do id=1,k ! diagonal element indices
do icol=id,k+20 ! The 20 is ad hoc - beware
iflag=0
if( genmrb(id,icol) .eq. 1 ) then
iflag=1
if( icol .ne. id ) then ! reorder column
temp(1:k)=genmrb(1:k,id)
genmrb(1:k,id)=genmrb(1:k,icol)
genmrb(1:k,icol)=temp(1:k)
itmp=indices(id)
indices(id)=indices(icol)
indices(icol)=itmp
endif
do ii=1,k
if( ii .ne. id .and. genmrb(ii,id) .eq. 1 ) then
genmrb(ii,1:N)=ieor(genmrb(ii,1:N),genmrb(id,1:N))
endif
enddo
exit
endif
enddo
enddo
g2=transpose(genmrb)
! The hard decisions for the k MRB bits define the order 0 message, m0.
! Encode m0 using the modified generator matrix to find the "order 0" codeword.
! Flip various combinations of bits in m0 and re-encode to generate a list of
! codewords. Return the member of the list that has the smallest Euclidean
! distance to the received word.
hdec=hdec(indices) ! hard decisions from received symbols
m0=hdec(1:k) ! zero'th order message
absrx=absrx(indices)
rx=rx(indices)
apmaskr=apmaskr(indices)
call mrbencode74(m0,c0,g2,N,k)
nxor=ieor(c0,hdec)
nhardmin=sum(nxor)
dmin=sum(nxor*absrx)
cw=c0
ntotal=0
nrejected=0
npre1=0
npre2=0
if(ndeep.eq.0) goto 998 ! norder=0
if(ndeep.gt.6) ndeep=6
if( ndeep.eq. 1) then
nord=1
npre1=0
npre2=0
nt=40
ntheta=12
elseif(ndeep.eq.2) then
nord=1
npre1=1
npre2=0
nt=40
ntheta=12
elseif(ndeep.eq.3) then
nord=1
npre1=1
npre2=1
nt=40
ntheta=12
ntau=14
elseif(ndeep.eq.4) then
nord=2
npre1=1
npre2=1
nt=40
ntheta=12
ntau=19
elseif(ndeep.eq.5) then
nord=3
npre1=1
npre2=1
nt=40
ntheta=12
ntau=19
elseif(ndeep.eq.6) then
nord=4
npre1=1
npre2=1
nt=40
ntheta=12
ntau=19
endif
do iorder=1,nord
misub(1:k-iorder)=0
misub(k-iorder+1:k)=1
iflag=k-iorder+1
do while(iflag .ge.0)
if(iorder.eq.nord .and. npre1.eq.0) then
iend=iflag
else
iend=1
endif
d1=0.
do n1=iflag,iend,-1
mi=misub
mi(n1)=1
if(any(iand(apmaskr(1:k),mi).eq.1)) cycle
ntotal=ntotal+1
me=ieor(m0,mi)
if(n1.eq.iflag) then
call mrbencode74(me,ce,g2,N,k)
e2sub=ieor(ce(k+1:N),hdec(k+1:N))
e2=e2sub
nd1kpt=sum(e2sub(1:nt))+1
d1=sum(ieor(me(1:k),hdec(1:k))*absrx(1:k))
else
e2=ieor(e2sub,g2(k+1:N,n1))
nd1kpt=sum(e2(1:nt))+2
endif
if(nd1kpt .le. ntheta) then
call mrbencode74(me,ce,g2,N,k)
nxor=ieor(ce,hdec)
if(n1.eq.iflag) then
dd=d1+sum(e2sub*absrx(k+1:N))
else
dd=d1+ieor(ce(n1),hdec(n1))*absrx(n1)+sum(e2*absrx(k+1:N))
endif
if( dd .lt. dmin ) then
dmin=dd
cw=ce
nhardmin=sum(nxor)
nd1kptbest=nd1kpt
endif
else
nrejected=nrejected+1
endif
enddo
! Get the next test error pattern, iflag will go negative
! when the last pattern with weight iorder has been generated.
call nextpat74(misub,k,iorder,iflag)
enddo
enddo
if(npre2.eq.1) then
reset=.true.
ntotal=0
do i1=k,1,-1
do i2=i1-1,1,-1
ntotal=ntotal+1
mi(1:ntau)=ieor(g2(k+1:k+ntau,i1),g2(k+1:k+ntau,i2))
call boxit74(reset,mi(1:ntau),ntau,ntotal,i1,i2)
enddo
enddo
ncount2=0
ntotal2=0
reset=.true.
! Now run through again and do the second pre-processing rule
misub(1:k-nord)=0
misub(k-nord+1:k)=1
iflag=k-nord+1
do while(iflag .ge.0)
me=ieor(m0,misub)
call mrbencode74(me,ce,g2,N,k)
e2sub=ieor(ce(k+1:N),hdec(k+1:N))
do i2=0,ntau
ntotal2=ntotal2+1
ui=0
if(i2.gt.0) ui(i2)=1
r2pat=ieor(e2sub,ui)
778 continue
call fetchit74(reset,r2pat(1:ntau),ntau,in1,in2)
if(in1.gt.0.and.in2.gt.0) then
ncount2=ncount2+1
mi=misub
mi(in1)=1
mi(in2)=1
if(sum(mi).lt.nord+npre1+npre2.or.any(iand(apmaskr(1:k),mi).eq.1)) cycle
me=ieor(m0,mi)
call mrbencode74(me,ce,g2,N,k)
nxor=ieor(ce,hdec)
dd=sum(nxor*absrx)
if( dd .lt. dmin ) then
dmin=dd
cw=ce
nhardmin=sum(nxor)
endif
goto 778
endif
enddo
call nextpat74(misub,k,nord,iflag)
enddo
endif
998 continue
! Re-order the codeword to [message bits][parity bits] format.
cw(indices)=cw
hdec(indices)=hdec
message74=cw(1:74)
call get_crc24(message74,74,nbadcrc)
if(nbadcrc.ne.0) nhardmin=-nhardmin
return
end subroutine osd174_74
subroutine mrbencode74(me,codeword,g2,N,K)
integer*1 me(K),codeword(N),g2(N,K)
! fast encoding for low-weight test patterns
codeword=0
do i=1,K
if( me(i) .eq. 1 ) then
codeword=ieor(codeword,g2(1:N,i))
endif
enddo
return
end subroutine mrbencode74
subroutine nextpat74(mi,k,iorder,iflag)
integer*1 mi(k),ms(k)
! generate the next test error pattern
ind=-1
do i=1,k-1
if( mi(i).eq.0 .and. mi(i+1).eq.1) ind=i
enddo
if( ind .lt. 0 ) then ! no more patterns of this order
iflag=ind
return
endif
ms=0
ms(1:ind-1)=mi(1:ind-1)
ms(ind)=1
ms(ind+1)=0
if( ind+1 .lt. k ) then
nz=iorder-sum(ms)
ms(k-nz+1:k)=1
endif
mi=ms
do i=1,k ! iflag will point to the lowest-index 1 in mi
if(mi(i).eq.1) then
iflag=i
exit
endif
enddo
return
end subroutine nextpat74
subroutine boxit74(reset,e2,ntau,npindex,i1,i2)
integer*1 e2(1:ntau)
integer indexes(5000,2),fp(0:525000),np(5000)
logical reset
common/boxes/indexes,fp,np
if(reset) then
patterns=-1
fp=-1
np=-1
sc=-1
indexes=-1
reset=.false.
endif
indexes(npindex,1)=i1
indexes(npindex,2)=i2
ipat=0
do i=1,ntau
if(e2(i).eq.1) then
ipat=ipat+ishft(1,ntau-i)
endif
enddo
ip=fp(ipat) ! see what's currently stored in fp(ipat)
if(ip.eq.-1) then
fp(ipat)=npindex
else
do while (np(ip).ne.-1)
ip=np(ip)
enddo
np(ip)=npindex
endif
return
end subroutine boxit74
subroutine fetchit74(reset,e2,ntau,i1,i2)
integer indexes(5000,2),fp(0:525000),np(5000)
integer lastpat
integer*1 e2(ntau)
logical reset
common/boxes/indexes,fp,np
save lastpat,inext
if(reset) then
lastpat=-1
reset=.false.
endif
ipat=0
do i=1,ntau
if(e2(i).eq.1) then
ipat=ipat+ishft(1,ntau-i)
endif
enddo
index=fp(ipat)
if(lastpat.ne.ipat .and. index.gt.0) then ! return first set of indices
i1=indexes(index,1)
i2=indexes(index,2)
inext=np(index)
elseif(lastpat.eq.ipat .and. inext.gt.0) then
i1=indexes(inext,1)
i2=indexes(inext,2)
inext=np(inext)
else
i1=-1
i2=-1
inext=-1
endif
lastpat=ipat
return
end subroutine fetchit74

372
lib/fsk4hf/osd204.f90
View File

@ -1,372 +0,0 @@
subroutine osd204(llr,apmask,ndeep,decoded,cw,nhardmin,dmin)
!
! An ordered-statistics decoder for the (204,68) code.
!
include "ldpc_204_68_params.f90"
integer*1 apmask(N),apmaskr(N)
integer*1 gen(K,N)
integer*1 genmrb(K,N),g2(N,K)
integer*1 temp(K),m0(K),me(K),mi(K),misub(K),e2sub(N-K),e2(N-K),ui(N-K)
integer*1 r2pat(N-K)
integer indices(N),nxor(N)
integer*1 cw(N),ce(N),c0(N),hdec(N)
integer*1 decoded(K)
integer indx(N)
real llr(N),rx(N),absrx(N)
logical first,reset
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
irow=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(irow,i)=1
enddo
enddo
enddo
do irow=1,K
gen(irow,M+irow)=1
enddo
first=.false.
endif
! Re-order received vector to place systematic msg bits at the end.
rx=llr(colorder+1)
apmaskr=apmask(colorder+1)
! Hard decisions on the received word.
hdec=0
where(rx .ge. 0) hdec=1
! Use magnitude of received symbols as a measure of reliability.
absrx=abs(rx)
call indexx(absrx,N,indx)
! Re-order the columns of the generator matrix in order of decreasing reliability.
do i=1,N
genmrb(1:K,i)=gen(1:K,indx(N+1-i))
indices(i)=indx(N+1-i)
enddo
! Do gaussian elimination to create a generator matrix with the most reliable
! received bits in positions 1:K in order of decreasing reliability (more or less).
do id=1,K ! diagonal element indices
do icol=id,K+20 ! The 20 is ad hoc - beware
iflag=0
if( genmrb(id,icol) .eq. 1 ) then
iflag=1
if( icol .ne. id ) then ! reorder column
temp(1:K)=genmrb(1:K,id)
genmrb(1:K,id)=genmrb(1:K,icol)
genmrb(1:K,icol)=temp(1:K)
itmp=indices(id)
indices(id)=indices(icol)
indices(icol)=itmp
endif
do ii=1,K
if( ii .ne. id .and. genmrb(ii,id) .eq. 1 ) then
genmrb(ii,1:N)=ieor(genmrb(ii,1:N),genmrb(id,1:N))
endif
enddo
exit
endif
enddo
enddo
g2=transpose(genmrb)
! The hard decisions for the K MRB bits define the order 0 message, m0.
! Encode m0 using the modified generator matrix to find the "order 0" codeword.
! Flip various combinations of bits in m0 and re-encode to generate a list of
! codewords. Return the member of the list that has the smallest Euclidean
! distance to the received word.
hdec=hdec(indices) ! hard decisions from received symbols
m0=hdec(1:K) ! zero'th order message
absrx=absrx(indices)
rx=rx(indices)
apmaskr=apmaskr(indices)
call mrbencode(m0,c0,g2,N,K)
nxor=ieor(c0,hdec)
nhardmin=sum(nxor)
dmin=sum(nxor*absrx)
cw=c0
ntotal=0
nrejected=0
if(ndeep.eq.0) goto 998 ! norder=0
if(ndeep.gt.6) ndeep=6
if( ndeep.eq. 1) then
nord=1
npre1=0
npre2=0
nt=40
ntheta=12
elseif(ndeep.eq.2) then
nord=1
npre1=1
npre2=0
nt=40
ntheta=12
elseif(ndeep.eq.3) then
nord=1
npre1=1
npre2=1
nt=40
ntheta=12
ntau=14
elseif(ndeep.eq.4) then
nord=2
npre1=1
npre2=0
nt=40
ntheta=12
ntau=19
elseif(ndeep.eq.5) then
nord=2
npre1=1
npre2=1
nt=40
ntheta=12
ntau=19
elseif(ndeep.eq.6) then
nord=3
npre1=1
npre2=1
nt=60
ntheta=22
ntau=16
endif
do iorder=1,nord
misub(1:K-iorder)=0
misub(K-iorder+1:K)=1
iflag=K-iorder+1
do while(iflag .ge.0)
if(iorder.eq.nord .and. npre1.eq.0) then
iend=iflag
else
iend=1
endif
do n1=iflag,iend,-1
mi=misub
mi(n1)=1
if(any(iand(apmaskr(1:K),mi).eq.1)) cycle
ntotal=ntotal+1
me=ieor(m0,mi)
if(n1.eq.iflag) then
call mrbencode(me,ce,g2,N,K)
e2sub=ieor(ce(K+1:N),hdec(K+1:N))
e2=e2sub
nd1Kpt=sum(e2sub(1:nt))+1
d1=sum(ieor(me(1:K),hdec(1:K))*absrx(1:K))
else
e2=ieor(e2sub,g2(K+1:N,n1))
nd1Kpt=sum(e2(1:nt))+2
endif
if(nd1Kpt .le. ntheta) then
call mrbencode(me,ce,g2,N,K)
nxor=ieor(ce,hdec)
if(n1.eq.iflag) then
dd=d1+sum(e2sub*absrx(K+1:N))
else
dd=d1+ieor(ce(n1),hdec(n1))*absrx(n1)+sum(e2*absrx(K+1:N))
endif
if( dd .lt. dmin ) then
dmin=dd
cw=ce
nhardmin=sum(nxor)
nd1Kptbest=nd1Kpt
endif
else
nrejected=nrejected+1
endif
enddo
! Get the next test error pattern, iflag will go negative
! when the last pattern with weight iorder has been generated.
call nextpat(misub,k,iorder,iflag)
enddo
enddo
if(npre2.eq.1) then
reset=.true.
ntotal=0
do i1=K,1,-1
do i2=i1-1,1,-1
ntotal=ntotal+1
mi(1:ntau)=ieor(g2(K+1:K+ntau,i1),g2(K+1:K+ntau,i2))
call boxit(reset,mi(1:ntau),ntau,ntotal,i1,i2)
enddo
enddo
ncount2=0
ntotal2=0
reset=.true.
! Now run through again and do the second pre-processing rule
misub(1:K-nord)=0
misub(K-nord+1:K)=1
iflag=K-nord+1
do while(iflag .ge.0)
me=ieor(m0,misub)
call mrbencode(me,ce,g2,N,K)
e2sub=ieor(ce(K+1:N),hdec(K+1:N))
do i2=0,ntau
ntotal2=ntotal2+1
ui=0
if(i2.gt.0) ui(i2)=1
r2pat=ieor(e2sub,ui)
778 continue
call fetchit(reset,r2pat(1:ntau),ntau,in1,in2)
if(in1.gt.0.and.in2.gt.0) then
ncount2=ncount2+1
mi=misub
mi(in1)=1
mi(in2)=1
if(sum(mi).lt.nord+npre1+npre2.or.any(iand(apmaskr(1:K),mi).eq.1)) cycle
me=ieor(m0,mi)
call mrbencode(me,ce,g2,N,K)
nxor=ieor(ce,hdec)
dd=sum(nxor*absrx)
if( dd .lt. dmin ) then
dmin=dd
cw=ce
nhardmin=sum(nxor)
endif
goto 778
endif
enddo
call nextpat(misub,K,nord,iflag)
enddo
endif
998 continue
! Re-order the codeword to place message bits at the end.
cw(indices)=cw
hdec(indices)=hdec
decoded=cw(M+1:N)
cw(colorder+1)=cw ! put the codeword back into received-word order
return
end subroutine osd204
subroutine mrbencode(me,codeword,g2,N,K)
integer*1 me(K),codeword(N),g2(N,K)
! fast encoding for low-weight test patterns
codeword=0
do i=1,K
if( me(i) .eq. 1 ) then
codeword=ieor(codeword,g2(1:N,i))
endif
enddo
return
end subroutine mrbencode
subroutine nextpat(mi,k,iorder,iflag)
integer*1 mi(k),ms(k)
! generate the next test error pattern
ind=-1
do i=1,k-1
if( mi(i).eq.0 .and. mi(i+1).eq.1) ind=i
enddo
if( ind .lt. 0 ) then ! no more patterns of this order
iflag=ind
return
endif
ms=0
ms(1:ind-1)=mi(1:ind-1)
ms(ind)=1
ms(ind+1)=0
if( ind+1 .lt. k ) then
nz=iorder-sum(ms)
ms(k-nz+1:k)=1
endif
mi=ms
do i=1,k ! iflag will point to the lowest-index 1 in mi
if(mi(i).eq.1) then
iflag=i
exit
endif
enddo
return
end subroutine nextpat
subroutine boxit(reset,e2,ntau,npindex,i1,i2)
integer*1 e2(1:ntau)
integer indexes(4000,2),fp(0:525000),np(4000)
logical reset
common/boxes/indexes,fp,np
if(reset) then
patterns=-1
fp=-1
np=-1
sc=-1
indexes=-1
reset=.false.
endif
indexes(npindex,1)=i1
indexes(npindex,2)=i2
ipat=0
do i=1,ntau
if(e2(i).eq.1) then
ipat=ipat+ishft(1,ntau-i)
endif
enddo
ip=fp(ipat) ! see what's currently stored in fp(ipat)
if(ip.eq.-1) then
fp(ipat)=npindex
else
do while (np(ip).ne.-1)
ip=np(ip)
enddo
np(ip)=npindex
endif
return
end subroutine boxit
subroutine fetchit(reset,e2,ntau,i1,i2)
integer indexes(4000,2),fp(0:525000),np(4000)
integer lastpat
integer*1 e2(ntau)
logical reset
common/boxes/indexes,fp,np
save lastpat,inext
if(reset) then
lastpat=-1
reset=.false.
endif
ipat=0
do i=1,ntau
if(e2(i).eq.1) then
ipat=ipat+ishft(1,ntau-i)
endif
enddo
index=fp(ipat)
if(lastpat.ne.ipat .and. index.gt.0) then ! return first set of indices
i1=indexes(index,1)
i2=indexes(index,2)
inext=np(index)
elseif(lastpat.eq.ipat .and. inext.gt.0) then
i1=indexes(inext,1)
i2=indexes(inext,2)
inext=np(inext)
else
i1=-1
i2=-1
inext=-1
endif
lastpat=ipat
return
end subroutine fetchit

403
lib/fsk4hf/osd240_101.f90
View File

@ -1,403 +0,0 @@
subroutine osd240_101(llr,k,apmask,ndeep,message101,cw,nhardmin,dmin)
!
! An ordered-statistics decoder for the (240,101) code.
! Message payload is 77 bits. Any or all of a 24-bit CRC can be
! used for detecting incorrect codewords. The remaining CRC bits are
! cascaded with the LDPC code for the purpose of improving the
! distance spectrum of the code.
!
! If p1 (0.le.p1.le.24) is the number of CRC24 bits that are
! to be used for bad codeword detection, then the argument k should
! be set to 77+p1.
!
! Valid values for k are in the range [77,101].
!
character*24 c24
integer, parameter:: N=240
integer*1 apmask(N),apmaskr(N)
integer*1, allocatable, save :: gen(:,:)
integer*1, allocatable :: genmrb(:,:),g2(:,:)
integer*1, allocatable :: temp(:),m0(:),me(:),mi(:),misub(:),e2sub(:),e2(:),ui(:)
integer*1, allocatable :: r2pat(:)
integer indices(N),nxor(N)
integer*1 cw(N),ce(N),c0(N),hdec(N)
integer*1, allocatable :: decoded(:)
integer*1 message101(101)
integer indx(N)
real llr(N),rx(N),absrx(N)
logical first,reset
data first/.true./
save first
allocate( genmrb(k,N), g2(N,k) )
allocate( temp(k), m0(k), me(k), mi(k), misub(k), e2sub(N-k), e2(N-k), ui(N-k) )
allocate( r2pat(N-k), decoded(k) )
if( first ) then ! fill the generator matrix
!
! Create generator matrix for partial CRC cascaded with LDPC code.
!
! Let p2=101-k and p1+p2=24.
!
! The last p2 bits of the CRC24 are cascaded with the LDPC code.
!
! The first p1=k-77 CRC24 bits will be used for error detection.
!
allocate( gen(k,N) )
gen=0
do i=1,k
message101=0
message101(i)=1
if(i.le.77) then
call get_crc24(message101,101,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') message101(78:101)
message101(78:k)=0
endif
call encode240_101(message101,cw)
gen(i,:)=cw
enddo
first=.false.
endif
rx=llr
apmaskr=apmask
! Hard decisions on the received word.
hdec=0
where(rx .ge. 0) hdec=1
! Use magnitude of received symbols as a measure of reliability.
absrx=abs(rx)
call indexx(absrx,N,indx)
! Re-order the columns of the generator matrix in order of decreasing reliability.
do i=1,N
genmrb(1:k,i)=gen(1:k,indx(N+1-i))
indices(i)=indx(N+1-i)
enddo
! Do gaussian elimination to create a generator matrix with the most reliable
! received bits in positions 1:k in order of decreasing reliability (more or less).
do id=1,k ! diagonal element indices
do icol=id,k+20 ! The 20 is ad hoc - beware
iflag=0
if( genmrb(id,icol) .eq. 1 ) then
iflag=1
if( icol .ne. id ) then ! reorder column
temp(1:k)=genmrb(1:k,id)
genmrb(1:k,id)=genmrb(1:k,icol)
genmrb(1:k,icol)=temp(1:k)
itmp=indices(id)
indices(id)=indices(icol)
indices(icol)=itmp
endif
do ii=1,k
if( ii .ne. id .and. genmrb(ii,id) .eq. 1 ) then
genmrb(ii,1:N)=ieor(genmrb(ii,1:N),genmrb(id,1:N))
endif
enddo
exit
endif
enddo
enddo
g2=transpose(genmrb)
! The hard decisions for the k MRB bits define the order 0 message, m0.
! Encode m0 using the modified generator matrix to find the "order 0" codeword.
! Flip various combinations of bits in m0 and re-encode to generate a list of
! codewords. Return the member of the list that has the smallest Euclidean
! distance to the received word.
hdec=hdec(indices) ! hard decisions from received symbols
m0=hdec(1:k) ! zero'th order message
absrx=absrx(indices)
rx=rx(indices)
apmaskr=apmaskr(indices)
call mrbencode101(m0,c0,g2,N,k)
nxor=ieor(c0,hdec)
nhardmin=sum(nxor)
dmin=sum(nxor*absrx)
cw=c0
ntotal=0
nrejected=0
npre1=0
npre2=0
if(ndeep.eq.0) goto 998 ! norder=0
if(ndeep.gt.6) ndeep=6
if( ndeep.eq. 1) then
nord=1
npre1=0
npre2=0
nt=40
ntheta=12
elseif(ndeep.eq.2) then
nord=1
npre1=1
npre2=0
nt=40
ntheta=12
elseif(ndeep.eq.3) then
nord=1
npre1=1
npre2=1
nt=40
ntheta=12
ntau=14
elseif(ndeep.eq.4) then
nord=2
npre1=1
npre2=1
nt=40
ntheta=12
ntau=19
elseif(ndeep.eq.5) then
nord=3
npre1=1
npre2=1
nt=40
ntheta=12
ntau=19
elseif(ndeep.eq.6) then
nord=4
npre1=1
npre2=1
nt=40
ntheta=12
ntau=19
endif
do iorder=1,nord
misub(1:k-iorder)=0
misub(k-iorder+1:k)=1
iflag=k-iorder+1
do while(iflag .ge.0)
if(iorder.eq.nord .and. npre1.eq.0) then
iend=iflag
else
iend=1
endif
d1=0.
do n1=iflag,iend,-1
mi=misub
mi(n1)=1
if(any(iand(apmaskr(1:k),mi).eq.1)) cycle
ntotal=ntotal+1
me=ieor(m0,mi)
if(n1.eq.iflag) then
call mrbencode101(me,ce,g2,N,k)
e2sub=ieor(ce(k+1:N),hdec(k+1:N))
e2=e2sub
nd1kpt=sum(e2sub(1:nt))+1
d1=sum(ieor(me(1:k),hdec(1:k))*absrx(1:k))
else
e2=ieor(e2sub,g2(k+1:N,n1))
nd1kpt=sum(e2(1:nt))+2
endif
if(nd1kpt .le. ntheta) then
call mrbencode101(me,ce,g2,N,k)
nxor=ieor(ce,hdec)
if(n1.eq.iflag) then
dd=d1+sum(e2sub*absrx(k+1:N))
else
dd=d1+ieor(ce(n1),hdec(n1))*absrx(n1)+sum(e2*absrx(k+1:N))
endif
if( dd .lt. dmin ) then
dmin=dd
cw=ce
nhardmin=sum(nxor)
nd1kptbest=nd1kpt
endif
else
nrejected=nrejected+1
endif
enddo
! Get the next test error pattern, iflag will go negative
! when the last pattern with weight iorder has been generated.
call nextpat101(misub,k,iorder,iflag)
enddo
enddo
if(npre2.eq.1) then
reset=.true.
ntotal=0
do i1=k,1,-1
do i2=i1-1,1,-1
ntotal=ntotal+1
mi(1:ntau)=ieor(g2(k+1:k+ntau,i1),g2(k+1:k+ntau,i2))
call boxit101(reset,mi(1:ntau),ntau,ntotal,i1,i2)
enddo
enddo
ncount2=0
ntotal2=0
reset=.true.
! Now run through again and do the second pre-processing rule
misub(1:k-nord)=0
misub(k-nord+1:k)=1
iflag=k-nord+1
do while(iflag .ge.0)
me=ieor(m0,misub)
call mrbencode101(me,ce,g2,N,k)
e2sub=ieor(ce(k+1:N),hdec(k+1:N))
do i2=0,ntau
ntotal2=ntotal2+1
ui=0
if(i2.gt.0) ui(i2)=1
r2pat=ieor(e2sub,ui)
778 continue
call fetchit101(reset,r2pat(1:ntau),ntau,in1,in2)
if(in1.gt.0.and.in2.gt.0) then
ncount2=ncount2+1
mi=misub
mi(in1)=1
mi(in2)=1
if(sum(mi).lt.nord+npre1+npre2.or.any(iand(apmaskr(1:k),mi).eq.1)) cycle
me=ieor(m0,mi)
call mrbencode101(me,ce,g2,N,k)
nxor=ieor(ce,hdec)
dd=sum(nxor*absrx)
if( dd .lt. dmin ) then
dmin=dd
cw=ce
nhardmin=sum(nxor)
endif
goto 778
endif
enddo
call nextpat101(misub,k,nord,iflag)
enddo
endif
998 continue
! Re-order the codeword to [message bits][parity bits] format.
cw(indices)=cw
hdec(indices)=hdec
message101=cw(1:101)
call get_crc24(message101,101,nbadcrc)
if(nbadcrc.ne.0) nhardmin=-nhardmin
return
end subroutine osd240_101
subroutine mrbencode101(me,codeword,g2,N,K)
integer*1 me(K),codeword(N),g2(N,K)
! fast encoding for low-weight test patterns
codeword=0
do i=1,K
if( me(i) .eq. 1 ) then
codeword=ieor(codeword,g2(1:N,i))
endif
enddo
return
end subroutine mrbencode101
subroutine nextpat101(mi,k,iorder,iflag)
integer*1 mi(k),ms(k)
! generate the next test error pattern
ind=-1
do i=1,k-1
if( mi(i).eq.0 .and. mi(i+1).eq.1) ind=i
enddo
if( ind .lt. 0 ) then ! no more patterns of this order
iflag=ind
return
endif
ms=0
ms(1:ind-1)=mi(1:ind-1)
ms(ind)=1
ms(ind+1)=0
if( ind+1 .lt. k ) then
nz=iorder-sum(ms)
ms(k-nz+1:k)=1
endif
mi=ms
do i=1,k ! iflag will point to the lowest-index 1 in mi
if(mi(i).eq.1) then
iflag=i
exit
endif
enddo
return
end subroutine nextpat101
subroutine boxit101(reset,e2,ntau,npindex,i1,i2)
integer*1 e2(1:ntau)
integer indexes(5000,2),fp(0:525000),np(5000)
logical reset
common/boxes/indexes,fp,np
if(reset) then
patterns=-1
fp=-1
np=-1
sc=-1
indexes=-1
reset=.false.
endif
indexes(npindex,1)=i1
indexes(npindex,2)=i2
ipat=0
do i=1,ntau
if(e2(i).eq.1) then
ipat=ipat+ishft(1,ntau-i)
endif
enddo
ip=fp(ipat) ! see what's currently stored in fp(ipat)
if(ip.eq.-1) then
fp(ipat)=npindex
else
do while (np(ip).ne.-1)
ip=np(ip)
enddo
np(ip)=npindex
endif
return
end subroutine boxit101
subroutine fetchit101(reset,e2,ntau,i1,i2)
integer indexes(5000,2),fp(0:525000),np(5000)
integer lastpat
integer*1 e2(ntau)
logical reset
common/boxes/indexes,fp,np
save lastpat,inext
if(reset) then
lastpat=-1
reset=.false.
endif
ipat=0
do i=1,ntau
if(e2(i).eq.1) then
ipat=ipat+ishft(1,ntau-i)
endif
enddo
index=fp(ipat)
if(lastpat.ne.ipat .and. index.gt.0) then ! return first set of indices
i1=indexes(index,1)
i2=indexes(index,2)
inext=np(index)
elseif(lastpat.eq.ipat .and. inext.gt.0) then
i1=indexes(inext,1)
i2=indexes(inext,2)
inext=np(inext)
else
i1=-1
i2=-1
inext=-1
endif
lastpat=ipat
return
end subroutine fetchit101

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