From 451b6747b7af3e6c05c70eaa72f97da75821ac4f Mon Sep 17 00:00:00 2001 From: Bill Somerville Date: Wed, 3 Jun 2020 15:27:49 +0100 Subject: [PATCH] Spring cleaning --- lib/fsk4hf/Makefile | 50 -- lib/fsk4hf/Makefile.win | 84 --- lib/fsk4hf/bitflip128_90.f90 | 59 --- lib/fsk4hf/bpdecode120.f90 | 306 ----------- lib/fsk4hf/bpdecode168.f90 | 380 ------------- lib/fsk4hf/bpdecode174_101.f90 | 111 ---- lib/fsk4hf/bpdecode174_74.f90 | 113 ---- lib/fsk4hf/bpdecode174b.f90 | 393 -------------- lib/fsk4hf/bpdecode204.f90 | 482 ----------------- lib/fsk4hf/bpdecode240_101.f90 | 111 ---- lib/fsk4hf/bpdecode280_101.f90 | 111 ---- lib/fsk4hf/bpdecode300.f90 | 708 ------------------------- lib/fsk4hf/chkcrc10.f90 | 27 - lib/fsk4hf/chkcrc12.f90 | 27 - lib/fsk4hf/costasxcorr.m | 14 - lib/fsk4hf/cpolyfit.f90 | 76 --- lib/fsk4hf/cpolyfitw.f90 | 68 --- lib/fsk4hf/dbpsksim.f90 | 241 --------- lib/fsk4hf/decode174_101.f90 | 128 ----- lib/fsk4hf/decode174_74.f90 | 128 ----- lib/fsk4hf/decode240_101.f90 | 133 ----- lib/fsk4hf/decode280_101.f90 | 133 ----- lib/fsk4hf/dopspread.f90 | 62 --- lib/fsk4hf/encode120.f90 | 116 ---- lib/fsk4hf/encode168.f90 | 141 ----- lib/fsk4hf/encode174_101.f90 | 46 -- lib/fsk4hf/encode174_74.f90 | 47 -- lib/fsk4hf/encode204.f90 | 48 -- lib/fsk4hf/encode240_101.f90 | 46 -- lib/fsk4hf/encode280_101.f90 | 46 -- lib/fsk4hf/encode300.f90 | 308 ----------- lib/fsk4hf/encode4K25A.f90 | 56 -- lib/fsk4hf/extractmessage168.f90 | 48 -- lib/fsk4hf/fftw3.f90 | 64 --- lib/fsk4hf/four2a.f90 | 115 ---- lib/fsk4hf/fsk4hf.f90 | 145 ----- lib/fsk4hf/fsk4sim.f90 | 185 ------- lib/fsk4hf/ft280d.f90 | 427 --------------- lib/fsk4hf/ft280sim.f90 | 113 ---- lib/fsk4hf/ft2_params.f90 | 12 - lib/fsk4hf/ft2d.f90 | 335 ------------ lib/fsk4hf/ft2sim.f90 | 154 ------ lib/fsk4hf/ft4d.f90 | 329 ------------ lib/fsk4hf/ft4s280_params.f90 | 16 - lib/fsk4hf/ft4s_params.f90 | 16 - lib/fsk4hf/ft4sd.f90 | 473 ----------------- lib/fsk4hf/ft4slowsim.f90 | 113 ---- lib/fsk4hf/gen_wspr4wave.f90 | 68 --- lib/fsk4hf/genbpsk.f90 | 44 -- lib/fsk4hf/genfsk4.f90 | 36 -- lib/fsk4hf/genfsk4hf.f90 | 51 -- lib/fsk4hf/genft2.f90 | 86 --- lib/fsk4hf/genft280.f90 | 95 ---- lib/fsk4hf/genft4slow.f90 | 98 ---- lib/fsk4hf/genmskhf.f90 | 126 ----- lib/fsk4hf/genwspr4.f90 | 95 ---- lib/fsk4hf/genwspr5.f90 | 107 ---- lib/fsk4hf/genwspr_fsk8.f90 | 45 -- lib/fsk4hf/genwsprcpm.f90 | 76 --- lib/fsk4hf/genwsprdpsk.f90 | 63 --- lib/fsk4hf/genwsprlf.f90 | 137 ----- lib/fsk4hf/get_crc24.f90 | 25 - lib/fsk4hf/get_ft280_bitmetrics.f90 | 117 ---- lib/fsk4hf/get_ft4s_bitmetrics.f90 | 133 ----- lib/fsk4hf/get_wspr4_bitmetrics.f90 | 118 ----- lib/fsk4hf/getcandidates2.f90 | 63 --- lib/fsk4hf/getfc1.f90 | 58 -- lib/fsk4hf/getfc1w.f90 | 47 -- lib/fsk4hf/getfc2.f90 | 74 --- lib/fsk4hf/getfc2w.f90 | 82 --- lib/fsk4hf/gran.c | 28 - lib/fsk4hf/ldpc_174_101_generator.f90 | 76 --- lib/fsk4hf/ldpc_174_101_parity.f90 | 258 --------- lib/fsk4hf/ldpc_174_74_generator.f90 | 105 ---- lib/fsk4hf/ldpc_174_74_parity.f90 | 288 ---------- lib/fsk4hf/ldpc_174_91_a_colorder.f90 | 11 - lib/fsk4hf/ldpc_174_91_a_generator.f90 | 87 --- lib/fsk4hf/ldpc_174_91_a_params.f90 | 100 ---- lib/fsk4hf/ldpc_174_91_a_parity.f90 | 269 ---------- lib/fsk4hf/ldpc_204_68_params.f90 | 154 ------ lib/fsk4hf/ldpc_240_101_generator.f90 | 142 ----- lib/fsk4hf/ldpc_240_101_parity.f90 | 393 -------------- lib/fsk4hf/ldpc_280_101_generator.f90 | 182 ------- lib/fsk4hf/ldpc_280_101_parity.f90 | 476 ----------------- lib/fsk4hf/ldpc_300_60_params.f90 | 262 --------- lib/fsk4hf/ldpcsim120.f90 | 238 --------- lib/fsk4hf/ldpcsim168.f90 | 233 -------- lib/fsk4hf/ldpcsim174.f90 | 233 -------- lib/fsk4hf/ldpcsim174_101.f90 | 144 ----- lib/fsk4hf/ldpcsim174_74.f90 | 159 ------ lib/fsk4hf/ldpcsim204.f90 | 205 ------- lib/fsk4hf/ldpcsim240_101.f90 | 144 ----- lib/fsk4hf/ldpcsim280_101.f90 | 144 ----- lib/fsk4hf/ldpcsim300.f90 | 254 --------- lib/fsk4hf/msksoftsym.f90 | 81 --- lib/fsk4hf/msksoftsymw.f90 | 78 --- lib/fsk4hf/osd174_101.f90 | 403 -------------- lib/fsk4hf/osd174_74.f90 | 405 -------------- lib/fsk4hf/osd204.f90 | 372 ------------- lib/fsk4hf/osd240_101.f90 | 403 -------------- lib/fsk4hf/osd280_101.f90 | 403 -------------- lib/fsk4hf/osd300.f90 | 365 ------------- lib/fsk4hf/osdtbcc.f90 | 372 ------------- lib/fsk4hf/osdwspr.f90 | 373 ------------- lib/fsk4hf/polyfit4.f90 | 109 ---- lib/fsk4hf/spb.m | 89 ---- lib/fsk4hf/spb_128_90.dat | 19 - lib/fsk4hf/spec4.f90 | 35 -- lib/fsk4hf/spec8.f90 | 31 -- lib/fsk4hf/tccsim.f90 | 194 ------- lib/fsk4hf/tweak1.f90 | 23 - lib/fsk4hf/wavhdr.f90 | 110 ---- lib/fsk4hf/wspr4_params.f90 | 16 - lib/fsk4hf/wspr4d.f90 | 424 --------------- lib/fsk4hf/wspr4sim.f90 | 114 ---- lib/fsk4hf/wspr5_downsample.f90 | 29 - lib/fsk4hf/wspr5_wav.f90 | 48 -- lib/fsk4hf/wspr5d.f90 | 220 -------- lib/fsk4hf/wspr5d_exp.f90 | 570 -------------------- lib/fsk4hf/wspr5sim.f90 | 111 ---- lib/fsk4hf/wspr_fsk8_downsample.f90 | 27 - lib/fsk4hf/wspr_fsk8_params.f90 | 14 - lib/fsk4hf/wspr_fsk8_sim.f90 | 107 ---- lib/fsk4hf/wspr_fsk8_wav.f90 | 44 -- lib/fsk4hf/wspr_fsk8d.f90 | 197 ------- lib/fsk4hf/wspr_params.f90 | 23 - lib/fsk4hf/wspr_wav.f90 | 49 -- lib/fsk4hf/wsprcpm_params.f90 | 14 - lib/fsk4hf/wsprcpm_wav.f90 | 44 -- lib/fsk4hf/wsprcpmd.f90 | 586 -------------------- lib/fsk4hf/wsprcpmsim.f90 | 107 ---- lib/fsk4hf/wsprdpsk_params.f90 | 14 - lib/fsk4hf/wsprdpskd.f90 | 439 --------------- lib/fsk4hf/wsprdpsksim.f90 | 175 ------ lib/fsk4hf/wsprlf.f90 | 110 ---- lib/fsk4hf/wsprlf_params.f90 | 14 - lib/fsk4hf/wsprlfsim.f90 | 286 ---------- lib/fsk4hf/wsprsimf.f90 | 113 ---- 138 files changed, 21533 deletions(-) delete mode 100644 lib/fsk4hf/Makefile delete mode 100644 lib/fsk4hf/Makefile.win delete mode 100644 lib/fsk4hf/bitflip128_90.f90 delete mode 100644 lib/fsk4hf/bpdecode120.f90 delete mode 100644 lib/fsk4hf/bpdecode168.f90 delete mode 100644 lib/fsk4hf/bpdecode174_101.f90 delete mode 100644 lib/fsk4hf/bpdecode174_74.f90 delete mode 100644 lib/fsk4hf/bpdecode174b.f90 delete mode 100644 lib/fsk4hf/bpdecode204.f90 delete mode 100644 lib/fsk4hf/bpdecode240_101.f90 delete mode 100644 lib/fsk4hf/bpdecode280_101.f90 delete mode 100644 lib/fsk4hf/bpdecode300.f90 delete mode 100644 lib/fsk4hf/chkcrc10.f90 delete mode 100644 lib/fsk4hf/chkcrc12.f90 delete mode 100644 lib/fsk4hf/costasxcorr.m delete mode 100644 lib/fsk4hf/cpolyfit.f90 delete mode 100644 lib/fsk4hf/cpolyfitw.f90 delete mode 100644 lib/fsk4hf/dbpsksim.f90 delete mode 100644 lib/fsk4hf/decode174_101.f90 delete mode 100644 lib/fsk4hf/decode174_74.f90 delete mode 100644 lib/fsk4hf/decode240_101.f90 delete mode 100644 lib/fsk4hf/decode280_101.f90 delete mode 100644 lib/fsk4hf/dopspread.f90 delete mode 100644 lib/fsk4hf/encode120.f90 delete mode 100644 lib/fsk4hf/encode168.f90 delete mode 100644 lib/fsk4hf/encode174_101.f90 delete mode 100644 lib/fsk4hf/encode174_74.f90 delete mode 100644 lib/fsk4hf/encode204.f90 delete mode 100644 lib/fsk4hf/encode240_101.f90 delete mode 100644 lib/fsk4hf/encode280_101.f90 delete mode 100644 lib/fsk4hf/encode300.f90 delete mode 100644 lib/fsk4hf/encode4K25A.f90 delete mode 100644 lib/fsk4hf/extractmessage168.f90 delete mode 100644 lib/fsk4hf/fftw3.f90 delete mode 100644 lib/fsk4hf/four2a.f90 delete mode 100644 lib/fsk4hf/fsk4hf.f90 delete mode 100644 lib/fsk4hf/fsk4sim.f90 delete mode 100644 lib/fsk4hf/ft280d.f90 delete mode 100644 lib/fsk4hf/ft280sim.f90 delete mode 100644 lib/fsk4hf/ft2_params.f90 delete mode 100644 lib/fsk4hf/ft2d.f90 delete mode 100644 lib/fsk4hf/ft2sim.f90 delete mode 100644 lib/fsk4hf/ft4d.f90 delete mode 100644 lib/fsk4hf/ft4s280_params.f90 delete mode 100644 lib/fsk4hf/ft4s_params.f90 delete mode 100644 lib/fsk4hf/ft4sd.f90 delete mode 100644 lib/fsk4hf/ft4slowsim.f90 delete mode 100644 lib/fsk4hf/gen_wspr4wave.f90 delete mode 100644 lib/fsk4hf/genbpsk.f90 delete mode 100644 lib/fsk4hf/genfsk4.f90 delete mode 100644 lib/fsk4hf/genfsk4hf.f90 delete mode 100644 lib/fsk4hf/genft2.f90 delete mode 100644 lib/fsk4hf/genft280.f90 delete mode 100644 lib/fsk4hf/genft4slow.f90 delete mode 100644 lib/fsk4hf/genmskhf.f90 delete mode 100644 lib/fsk4hf/genwspr4.f90 delete mode 100644 lib/fsk4hf/genwspr5.f90 delete mode 100644 lib/fsk4hf/genwspr_fsk8.f90 delete mode 100644 lib/fsk4hf/genwsprcpm.f90 delete mode 100644 lib/fsk4hf/genwsprdpsk.f90 delete mode 100644 lib/fsk4hf/genwsprlf.f90 delete mode 100644 lib/fsk4hf/get_crc24.f90 delete mode 100644 lib/fsk4hf/get_ft280_bitmetrics.f90 delete mode 100644 lib/fsk4hf/get_ft4s_bitmetrics.f90 delete mode 100644 lib/fsk4hf/get_wspr4_bitmetrics.f90 delete mode 100644 lib/fsk4hf/getcandidates2.f90 delete mode 100644 lib/fsk4hf/getfc1.f90 delete mode 100644 lib/fsk4hf/getfc1w.f90 delete mode 100644 lib/fsk4hf/getfc2.f90 delete mode 100644 lib/fsk4hf/getfc2w.f90 delete mode 100644 lib/fsk4hf/gran.c delete mode 100644 lib/fsk4hf/ldpc_174_101_generator.f90 delete mode 100644 lib/fsk4hf/ldpc_174_101_parity.f90 delete mode 100644 lib/fsk4hf/ldpc_174_74_generator.f90 delete mode 100644 lib/fsk4hf/ldpc_174_74_parity.f90 delete mode 100644 lib/fsk4hf/ldpc_174_91_a_colorder.f90 delete mode 100644 lib/fsk4hf/ldpc_174_91_a_generator.f90 delete mode 100644 lib/fsk4hf/ldpc_174_91_a_params.f90 delete mode 100644 lib/fsk4hf/ldpc_174_91_a_parity.f90 delete mode 100644 lib/fsk4hf/ldpc_204_68_params.f90 delete mode 100644 lib/fsk4hf/ldpc_240_101_generator.f90 delete mode 100644 lib/fsk4hf/ldpc_240_101_parity.f90 delete mode 100644 lib/fsk4hf/ldpc_280_101_generator.f90 delete mode 100644 lib/fsk4hf/ldpc_280_101_parity.f90 delete mode 100644 lib/fsk4hf/ldpc_300_60_params.f90 delete mode 100644 lib/fsk4hf/ldpcsim120.f90 delete mode 100644 lib/fsk4hf/ldpcsim168.f90 delete mode 100644 lib/fsk4hf/ldpcsim174.f90 delete mode 100644 lib/fsk4hf/ldpcsim174_101.f90 delete mode 100644 lib/fsk4hf/ldpcsim174_74.f90 delete mode 100644 lib/fsk4hf/ldpcsim204.f90 delete mode 100644 lib/fsk4hf/ldpcsim240_101.f90 delete mode 100644 lib/fsk4hf/ldpcsim280_101.f90 delete mode 100644 lib/fsk4hf/ldpcsim300.f90 delete mode 100644 lib/fsk4hf/msksoftsym.f90 delete mode 100644 lib/fsk4hf/msksoftsymw.f90 delete mode 100644 lib/fsk4hf/osd174_101.f90 delete mode 100644 lib/fsk4hf/osd174_74.f90 delete mode 100644 lib/fsk4hf/osd204.f90 delete mode 100644 lib/fsk4hf/osd240_101.f90 delete mode 100644 lib/fsk4hf/osd280_101.f90 delete mode 100644 lib/fsk4hf/osd300.f90 delete mode 100644 lib/fsk4hf/osdtbcc.f90 delete mode 100644 lib/fsk4hf/osdwspr.f90 delete mode 100644 lib/fsk4hf/polyfit4.f90 delete mode 100644 lib/fsk4hf/spb.m delete mode 100644 lib/fsk4hf/spb_128_90.dat delete mode 100644 lib/fsk4hf/spec4.f90 delete mode 100644 lib/fsk4hf/spec8.f90 delete mode 100644 lib/fsk4hf/tccsim.f90 delete mode 100644 lib/fsk4hf/tweak1.f90 delete mode 100644 lib/fsk4hf/wavhdr.f90 delete mode 100644 lib/fsk4hf/wspr4_params.f90 delete mode 100644 lib/fsk4hf/wspr4d.f90 delete mode 100644 lib/fsk4hf/wspr4sim.f90 delete mode 100644 lib/fsk4hf/wspr5_downsample.f90 delete mode 100644 lib/fsk4hf/wspr5_wav.f90 delete mode 100644 lib/fsk4hf/wspr5d.f90 delete mode 100644 lib/fsk4hf/wspr5d_exp.f90 delete mode 100644 lib/fsk4hf/wspr5sim.f90 delete mode 100644 lib/fsk4hf/wspr_fsk8_downsample.f90 delete mode 100644 lib/fsk4hf/wspr_fsk8_params.f90 delete mode 100644 lib/fsk4hf/wspr_fsk8_sim.f90 delete mode 100644 lib/fsk4hf/wspr_fsk8_wav.f90 delete mode 100644 lib/fsk4hf/wspr_fsk8d.f90 delete mode 100644 lib/fsk4hf/wspr_params.f90 delete mode 100644 lib/fsk4hf/wspr_wav.f90 delete mode 100644 lib/fsk4hf/wsprcpm_params.f90 delete mode 100644 lib/fsk4hf/wsprcpm_wav.f90 delete mode 100644 lib/fsk4hf/wsprcpmd.f90 delete mode 100644 lib/fsk4hf/wsprcpmsim.f90 delete mode 100644 lib/fsk4hf/wsprdpsk_params.f90 delete mode 100644 lib/fsk4hf/wsprdpskd.f90 delete mode 100644 lib/fsk4hf/wsprdpsksim.f90 delete mode 100644 lib/fsk4hf/wsprlf.f90 delete mode 100644 lib/fsk4hf/wsprlf_params.f90 delete mode 100644 lib/fsk4hf/wsprlfsim.f90 delete mode 100644 lib/fsk4hf/wsprsimf.f90 diff --git a/lib/fsk4hf/Makefile b/lib/fsk4hf/Makefile deleted file mode 100644 index 9372821bc..000000000 --- a/lib/fsk4hf/Makefile +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/Makefile.win b/lib/fsk4hf/Makefile.win deleted file mode 100644 index ab383557d..000000000 --- a/lib/fsk4hf/Makefile.win +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/bitflip128_90.f90 b/lib/fsk4hf/bitflip128_90.f90 deleted file mode 100644 index a4d73a1c6..000000000 --- a/lib/fsk4hf/bitflip128_90.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/bpdecode120.f90 b/lib/fsk4hf/bpdecode120.f90 deleted file mode 100644 index c9b11ac39..000000000 --- a/lib/fsk4hf/bpdecode120.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/bpdecode168.f90 b/lib/fsk4hf/bpdecode168.f90 deleted file mode 100644 index d527f71d2..000000000 --- a/lib/fsk4hf/bpdecode168.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/bpdecode174_101.f90 b/lib/fsk4hf/bpdecode174_101.f90 deleted file mode 100644 index 5ef96be3a..000000000 --- a/lib/fsk4hf/bpdecode174_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/bpdecode174_74.f90 b/lib/fsk4hf/bpdecode174_74.f90 deleted file mode 100644 index 190138753..000000000 --- a/lib/fsk4hf/bpdecode174_74.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/bpdecode174b.f90 b/lib/fsk4hf/bpdecode174b.f90 deleted file mode 100644 index 8291e7603..000000000 --- a/lib/fsk4hf/bpdecode174b.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/bpdecode204.f90 b/lib/fsk4hf/bpdecode204.f90 deleted file mode 100644 index 160b51a91..000000000 --- a/lib/fsk4hf/bpdecode204.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/bpdecode240_101.f90 b/lib/fsk4hf/bpdecode240_101.f90 deleted file mode 100644 index 1e2adbb68..000000000 --- a/lib/fsk4hf/bpdecode240_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/bpdecode280_101.f90 b/lib/fsk4hf/bpdecode280_101.f90 deleted file mode 100644 index a817a3d5c..000000000 --- a/lib/fsk4hf/bpdecode280_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/bpdecode300.f90 b/lib/fsk4hf/bpdecode300.f90 deleted file mode 100644 index 22f7f885a..000000000 --- a/lib/fsk4hf/bpdecode300.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/chkcrc10.f90 b/lib/fsk4hf/chkcrc10.f90 deleted file mode 100644 index abe7bd79e..000000000 --- a/lib/fsk4hf/chkcrc10.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/chkcrc12.f90 b/lib/fsk4hf/chkcrc12.f90 deleted file mode 100644 index a177fa110..000000000 --- a/lib/fsk4hf/chkcrc12.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/costasxcorr.m b/lib/fsk4hf/costasxcorr.m deleted file mode 100644 index 7d104c25d..000000000 --- a/lib/fsk4hf/costasxcorr.m +++ /dev/null @@ -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") - diff --git a/lib/fsk4hf/cpolyfit.f90 b/lib/fsk4hf/cpolyfit.f90 deleted file mode 100644 index fd0d5987f..000000000 --- a/lib/fsk4hf/cpolyfit.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/cpolyfitw.f90 b/lib/fsk4hf/cpolyfitw.f90 deleted file mode 100644 index 561052f8f..000000000 --- a/lib/fsk4hf/cpolyfitw.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/dbpsksim.f90 b/lib/fsk4hf/dbpsksim.f90 deleted file mode 100644 index 8b9ea12c6..000000000 --- a/lib/fsk4hf/dbpsksim.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/decode174_101.f90 b/lib/fsk4hf/decode174_101.f90 deleted file mode 100644 index 147e1065e..000000000 --- a/lib/fsk4hf/decode174_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/decode174_74.f90 b/lib/fsk4hf/decode174_74.f90 deleted file mode 100644 index 9d8020de2..000000000 --- a/lib/fsk4hf/decode174_74.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/decode240_101.f90 b/lib/fsk4hf/decode240_101.f90 deleted file mode 100644 index 71cbc8ff3..000000000 --- a/lib/fsk4hf/decode240_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/decode280_101.f90 b/lib/fsk4hf/decode280_101.f90 deleted file mode 100644 index 31bde307d..000000000 --- a/lib/fsk4hf/decode280_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/dopspread.f90 b/lib/fsk4hf/dopspread.f90 deleted file mode 100644 index cadfbecc6..000000000 --- a/lib/fsk4hf/dopspread.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/encode120.f90 b/lib/fsk4hf/encode120.f90 deleted file mode 100644 index 577bbe860..000000000 --- a/lib/fsk4hf/encode120.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/encode168.f90 b/lib/fsk4hf/encode168.f90 deleted file mode 100644 index bf1212154..000000000 --- a/lib/fsk4hf/encode168.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/encode174_101.f90 b/lib/fsk4hf/encode174_101.f90 deleted file mode 100644 index 3dd9be1d3..000000000 --- a/lib/fsk4hf/encode174_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/encode174_74.f90 b/lib/fsk4hf/encode174_74.f90 deleted file mode 100644 index ba8ab18b1..000000000 --- a/lib/fsk4hf/encode174_74.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/encode204.f90 b/lib/fsk4hf/encode204.f90 deleted file mode 100644 index b824196a7..000000000 --- a/lib/fsk4hf/encode204.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/encode240_101.f90 b/lib/fsk4hf/encode240_101.f90 deleted file mode 100644 index da0021df3..000000000 --- a/lib/fsk4hf/encode240_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/encode280_101.f90 b/lib/fsk4hf/encode280_101.f90 deleted file mode 100644 index 704816355..000000000 --- a/lib/fsk4hf/encode280_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/encode300.f90 b/lib/fsk4hf/encode300.f90 deleted file mode 100644 index f1d3bbaef..000000000 --- a/lib/fsk4hf/encode300.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/encode4K25A.f90 b/lib/fsk4hf/encode4K25A.f90 deleted file mode 100644 index cd1ae762a..000000000 --- a/lib/fsk4hf/encode4K25A.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/extractmessage168.f90 b/lib/fsk4hf/extractmessage168.f90 deleted file mode 100644 index 466d2a638..000000000 --- a/lib/fsk4hf/extractmessage168.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/fftw3.f90 b/lib/fsk4hf/fftw3.f90 deleted file mode 100644 index 440ccc28c..000000000 --- a/lib/fsk4hf/fftw3.f90 +++ /dev/null @@ -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) diff --git a/lib/fsk4hf/four2a.f90 b/lib/fsk4hf/four2a.f90 deleted file mode 100644 index 57c7239e1..000000000 --- a/lib/fsk4hf/four2a.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/fsk4hf.f90 b/lib/fsk4hf/fsk4hf.f90 deleted file mode 100644 index 191e05c31..000000000 --- a/lib/fsk4hf/fsk4hf.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/fsk4sim.f90 b/lib/fsk4hf/fsk4sim.f90 deleted file mode 100644 index 9800616e9..000000000 --- a/lib/fsk4hf/fsk4sim.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ft280d.f90 b/lib/fsk4hf/ft280d.f90 deleted file mode 100644 index 2f97692e0..000000000 --- a/lib/fsk4hf/ft280d.f90 +++ /dev/null @@ -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 ] [-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("") - -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 - diff --git a/lib/fsk4hf/ft280sim.f90 b/lib/fsk4hf/ft280sim.f90 deleted file mode 100644 index 96a7251d0..000000000 --- a/lib/fsk4hf/ft280sim.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ft2_params.f90 b/lib/fsk4hf/ft2_params.f90 deleted file mode 100644 index 351119b4b..000000000 --- a/lib/fsk4hf/ft2_params.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ft2d.f90 b/lib/fsk4hf/ft2d.f90 deleted file mode 100644 index fda1f1826..000000000 --- a/lib/fsk4hf/ft2d.f90 +++ /dev/null @@ -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 ] [-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("") - -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 - diff --git a/lib/fsk4hf/ft2sim.f90 b/lib/fsk4hf/ft2sim.f90 deleted file mode 100644 index ea0518a52..000000000 --- a/lib/fsk4hf/ft2sim.f90 +++ /dev/null @@ -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 -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 diff --git a/lib/fsk4hf/ft4d.f90 b/lib/fsk4hf/ft4d.f90 deleted file mode 100644 index d1bf262c1..000000000 --- a/lib/fsk4hf/ft4d.f90 +++ /dev/null @@ -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 ] [-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("") - -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 - diff --git a/lib/fsk4hf/ft4s280_params.f90 b/lib/fsk4hf/ft4s280_params.f90 deleted file mode 100644 index 29483e48a..000000000 --- a/lib/fsk4hf/ft4s280_params.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ft4s_params.f90 b/lib/fsk4hf/ft4s_params.f90 deleted file mode 100644 index 510d7e505..000000000 --- a/lib/fsk4hf/ft4s_params.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ft4sd.f90 b/lib/fsk4hf/ft4sd.f90 deleted file mode 100644 index b74f397d6..000000000 --- a/lib/fsk4hf/ft4sd.f90 +++ /dev/null @@ -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 ] [-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("") - -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 - diff --git a/lib/fsk4hf/ft4slowsim.f90 b/lib/fsk4hf/ft4slowsim.f90 deleted file mode 100644 index a5f0d80f3..000000000 --- a/lib/fsk4hf/ft4slowsim.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/gen_wspr4wave.f90 b/lib/fsk4hf/gen_wspr4wave.f90 deleted file mode 100644 index 31b3f68ba..000000000 --- a/lib/fsk4hf/gen_wspr4wave.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genbpsk.f90 b/lib/fsk4hf/genbpsk.f90 deleted file mode 100644 index 6c283e72f..000000000 --- a/lib/fsk4hf/genbpsk.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genfsk4.f90 b/lib/fsk4hf/genfsk4.f90 deleted file mode 100644 index d8b0394b2..000000000 --- a/lib/fsk4hf/genfsk4.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genfsk4hf.f90 b/lib/fsk4hf/genfsk4hf.f90 deleted file mode 100644 index 924e97931..000000000 --- a/lib/fsk4hf/genfsk4hf.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genft2.f90 b/lib/fsk4hf/genft2.f90 deleted file mode 100644 index 2eb36bccc..000000000 --- a/lib/fsk4hf/genft2.f90 +++ /dev/null @@ -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 " 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 diff --git a/lib/fsk4hf/genft280.f90 b/lib/fsk4hf/genft280.f90 deleted file mode 100644 index bc8de4b18..000000000 --- a/lib/fsk4hf/genft280.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genft4slow.f90 b/lib/fsk4hf/genft4slow.f90 deleted file mode 100644 index cd58094a3..000000000 --- a/lib/fsk4hf/genft4slow.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genmskhf.f90 b/lib/fsk4hf/genmskhf.f90 deleted file mode 100644 index 7d4b0838c..000000000 --- a/lib/fsk4hf/genmskhf.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genwspr4.f90 b/lib/fsk4hf/genwspr4.f90 deleted file mode 100644 index c2f5f42f2..000000000 --- a/lib/fsk4hf/genwspr4.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genwspr5.f90 b/lib/fsk4hf/genwspr5.f90 deleted file mode 100644 index e09bcd6f7..000000000 --- a/lib/fsk4hf/genwspr5.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genwspr_fsk8.f90 b/lib/fsk4hf/genwspr_fsk8.f90 deleted file mode 100644 index 2ef6ace30..000000000 --- a/lib/fsk4hf/genwspr_fsk8.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genwsprcpm.f90 b/lib/fsk4hf/genwsprcpm.f90 deleted file mode 100644 index 6e9eb9ab1..000000000 --- a/lib/fsk4hf/genwsprcpm.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genwsprdpsk.f90 b/lib/fsk4hf/genwsprdpsk.f90 deleted file mode 100644 index 1b6c58b10..000000000 --- a/lib/fsk4hf/genwsprdpsk.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/genwsprlf.f90 b/lib/fsk4hf/genwsprlf.f90 deleted file mode 100644 index 4c5b31cf9..000000000 --- a/lib/fsk4hf/genwsprlf.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/get_crc24.f90 b/lib/fsk4hf/get_crc24.f90 deleted file mode 100644 index cb7f3a05f..000000000 --- a/lib/fsk4hf/get_crc24.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/get_ft280_bitmetrics.f90 b/lib/fsk4hf/get_ft280_bitmetrics.f90 deleted file mode 100644 index 761577aa7..000000000 --- a/lib/fsk4hf/get_ft280_bitmetrics.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/get_ft4s_bitmetrics.f90 b/lib/fsk4hf/get_ft4s_bitmetrics.f90 deleted file mode 100644 index a2af01f1e..000000000 --- a/lib/fsk4hf/get_ft4s_bitmetrics.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/get_wspr4_bitmetrics.f90 b/lib/fsk4hf/get_wspr4_bitmetrics.f90 deleted file mode 100644 index d0d82af10..000000000 --- a/lib/fsk4hf/get_wspr4_bitmetrics.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/getcandidates2.f90 b/lib/fsk4hf/getcandidates2.f90 deleted file mode 100644 index 3aa841c83..000000000 --- a/lib/fsk4hf/getcandidates2.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/getfc1.f90 b/lib/fsk4hf/getfc1.f90 deleted file mode 100644 index b82b0303b..000000000 --- a/lib/fsk4hf/getfc1.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/getfc1w.f90 b/lib/fsk4hf/getfc1w.f90 deleted file mode 100644 index 532b9837d..000000000 --- a/lib/fsk4hf/getfc1w.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/getfc2.f90 b/lib/fsk4hf/getfc2.f90 deleted file mode 100644 index 9506168dd..000000000 --- a/lib/fsk4hf/getfc2.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/getfc2w.f90 b/lib/fsk4hf/getfc2w.f90 deleted file mode 100644 index 0d100ee56..000000000 --- a/lib/fsk4hf/getfc2w.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/gran.c b/lib/fsk4hf/gran.c deleted file mode 100644 index 24b986503..000000000 --- a/lib/fsk4hf/gran.c +++ /dev/null @@ -1,28 +0,0 @@ -#include -#include - -/* 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; -} diff --git a/lib/fsk4hf/ldpc_174_101_generator.f90 b/lib/fsk4hf/ldpc_174_101_generator.f90 deleted file mode 100644 index 26b300d7c..000000000 --- a/lib/fsk4hf/ldpc_174_101_generator.f90 +++ /dev/null @@ -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"/ diff --git a/lib/fsk4hf/ldpc_174_101_parity.f90 b/lib/fsk4hf/ldpc_174_101_parity.f90 deleted file mode 100644 index 1c1cc321f..000000000 --- a/lib/fsk4hf/ldpc_174_101_parity.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpc_174_74_generator.f90 b/lib/fsk4hf/ldpc_174_74_generator.f90 deleted file mode 100644 index 116ccfddc..000000000 --- a/lib/fsk4hf/ldpc_174_74_generator.f90 +++ /dev/null @@ -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"/ diff --git a/lib/fsk4hf/ldpc_174_74_parity.f90 b/lib/fsk4hf/ldpc_174_74_parity.f90 deleted file mode 100644 index 12187cc32..000000000 --- a/lib/fsk4hf/ldpc_174_74_parity.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpc_174_91_a_colorder.f90 b/lib/fsk4hf/ldpc_174_91_a_colorder.f90 deleted file mode 100644 index 65a2314fb..000000000 --- a/lib/fsk4hf/ldpc_174_91_a_colorder.f90 +++ /dev/null @@ -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/ - diff --git a/lib/fsk4hf/ldpc_174_91_a_generator.f90 b/lib/fsk4hf/ldpc_174_91_a_generator.f90 deleted file mode 100644 index 889826abe..000000000 --- a/lib/fsk4hf/ldpc_174_91_a_generator.f90 +++ /dev/null @@ -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"/ - diff --git a/lib/fsk4hf/ldpc_174_91_a_params.f90 b/lib/fsk4hf/ldpc_174_91_a_params.f90 deleted file mode 100644 index dd44be23e..000000000 --- a/lib/fsk4hf/ldpc_174_91_a_params.f90 +++ /dev/null @@ -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/ - diff --git a/lib/fsk4hf/ldpc_174_91_a_parity.f90 b/lib/fsk4hf/ldpc_174_91_a_parity.f90 deleted file mode 100644 index 44f36463f..000000000 --- a/lib/fsk4hf/ldpc_174_91_a_parity.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpc_204_68_params.f90 b/lib/fsk4hf/ldpc_204_68_params.f90 deleted file mode 100644 index 6e75ef114..000000000 --- a/lib/fsk4hf/ldpc_204_68_params.f90 +++ /dev/null @@ -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/ diff --git a/lib/fsk4hf/ldpc_240_101_generator.f90 b/lib/fsk4hf/ldpc_240_101_generator.f90 deleted file mode 100644 index 782e0a211..000000000 --- a/lib/fsk4hf/ldpc_240_101_generator.f90 +++ /dev/null @@ -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"/ diff --git a/lib/fsk4hf/ldpc_240_101_parity.f90 b/lib/fsk4hf/ldpc_240_101_parity.f90 deleted file mode 100644 index d3c1280c6..000000000 --- a/lib/fsk4hf/ldpc_240_101_parity.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpc_280_101_generator.f90 b/lib/fsk4hf/ldpc_280_101_generator.f90 deleted file mode 100644 index 521e80026..000000000 --- a/lib/fsk4hf/ldpc_280_101_generator.f90 +++ /dev/null @@ -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"/ diff --git a/lib/fsk4hf/ldpc_280_101_parity.f90 b/lib/fsk4hf/ldpc_280_101_parity.f90 deleted file mode 100644 index b1cabb7d1..000000000 --- a/lib/fsk4hf/ldpc_280_101_parity.f90 +++ /dev/null @@ -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 - diff --git a/lib/fsk4hf/ldpc_300_60_params.f90 b/lib/fsk4hf/ldpc_300_60_params.f90 deleted file mode 100644 index 53ee994ea..000000000 --- a/lib/fsk4hf/ldpc_300_60_params.f90 +++ /dev/null @@ -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/ - diff --git a/lib/fsk4hf/ldpcsim120.f90 b/lib/fsk4hf/ldpcsim120.f90 deleted file mode 100644 index 0b7d92865..000000000 --- a/lib/fsk4hf/ldpcsim120.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpcsim168.f90 b/lib/fsk4hf/ldpcsim168.f90 deleted file mode 100644 index 57dbbd558..000000000 --- a/lib/fsk4hf/ldpcsim168.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpcsim174.f90 b/lib/fsk4hf/ldpcsim174.f90 deleted file mode 100644 index 900011684..000000000 --- a/lib/fsk4hf/ldpcsim174.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpcsim174_101.f90 b/lib/fsk4hf/ldpcsim174_101.f90 deleted file mode 100644 index 7833b10cf..000000000 --- a/lib/fsk4hf/ldpcsim174_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpcsim174_74.f90 b/lib/fsk4hf/ldpcsim174_74.f90 deleted file mode 100644 index f432a2e7e..000000000 --- a/lib/fsk4hf/ldpcsim174_74.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpcsim204.f90 b/lib/fsk4hf/ldpcsim204.f90 deleted file mode 100644 index 6d6c1e6b9..000000000 --- a/lib/fsk4hf/ldpcsim204.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpcsim240_101.f90 b/lib/fsk4hf/ldpcsim240_101.f90 deleted file mode 100644 index d87241fa4..000000000 --- a/lib/fsk4hf/ldpcsim240_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpcsim280_101.f90 b/lib/fsk4hf/ldpcsim280_101.f90 deleted file mode 100644 index 060e32c80..000000000 --- a/lib/fsk4hf/ldpcsim280_101.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/ldpcsim300.f90 b/lib/fsk4hf/ldpcsim300.f90 deleted file mode 100644 index a2c31e6b0..000000000 --- a/lib/fsk4hf/ldpcsim300.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/msksoftsym.f90 b/lib/fsk4hf/msksoftsym.f90 deleted file mode 100644 index 016b23e1e..000000000 --- a/lib/fsk4hf/msksoftsym.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/msksoftsymw.f90 b/lib/fsk4hf/msksoftsymw.f90 deleted file mode 100644 index c7402ec47..000000000 --- a/lib/fsk4hf/msksoftsymw.f90 +++ /dev/null @@ -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 diff --git a/lib/fsk4hf/osd174_101.f90 b/lib/fsk4hf/osd174_101.f90 deleted file mode 100644 index e705ffe03..000000000 --- a/lib/fsk4hf/osd174_101.f90 +++ /dev/null @@ -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 - diff --git a/lib/fsk4hf/osd174_74.f90 b/lib/fsk4hf/osd174_74.f90 deleted file mode 100644 index e954f4eff..000000000 --- a/lib/fsk4hf/osd174_74.f90 +++ /dev/null @@ -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 - diff --git a/lib/fsk4hf/osd204.f90 b/lib/fsk4hf/osd204.f90 deleted file mode 100644 index 51a80c947..000000000 --- a/lib/fsk4hf/osd204.f90 +++ /dev/null @@ -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 - diff --git a/lib/fsk4hf/osd240_101.f90 b/lib/fsk4hf/osd240_101.f90 deleted file mode 100644 index 3e2506805..000000000 --- a/lib/fsk4hf/osd240_101.f90 +++ /dev/null @@ -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 - diff --git a/lib/fsk4hf/osd280_101.f90 b/lib/fsk4hf/osd280_101.f90 deleted file mode 100644 index acea3f664..000000000 --- a/lib/fsk4hf/osd280_101.f90 +++ /dev/null @@ -1,403 +0,0 @@ -subroutine osd280_101(llr,k,apmask,ndeep,message101,cw,nhardmin,dmin) -! -! An ordered-statistics decoder for the (280,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=280 - 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 encode280_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=17 - elseif(ndeep.eq.5) then - nord=3 - npre1=1 - npre2=1 - nt=40 - ntheta=12 - ntau=15 - elseif(ndeep.eq.6) then - nord=4 - npre1=1 - npre2=1 - nt=95 - ntheta=12 - ntau=15 - 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 osd280_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 - diff --git a/lib/fsk4hf/osd300.f90 b/lib/fsk4hf/osd300.f90 deleted file mode 100644 index 565f4ce53..000000000 --- a/lib/fsk4hf/osd300.f90 +++ /dev/null @@ -1,365 +0,0 @@ -subroutine osd300(llr,apmask,ndeep,decoded,cw,nhardmin,dmin) -! -! An ordered-statistics decoder for the (300,60) code. -! -include "ldpc_300_60_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, 15 - 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.5) ndeep=5 -if( ndeep.eq. 1) then - nord=1 - npre1=0 - npre2=0 - nt=120 - ntheta=12 -elseif(ndeep.eq.2) then - nord=1 - npre1=1 - npre2=0 - nt=120 - ntheta=12 -elseif(ndeep.eq.3) then - nord=1 - npre1=1 - npre2=1 - nt=120 - ntheta=12 - ntau=15 -elseif(ndeep.eq.4) then - nord=2 - npre1=1 - npre2=0 - nt=120 - ntheta=12 - ntau=15 -elseif(ndeep.eq.5) then - nord=3 - npre1=1 - npre2=1 - nt=80 - ntheta=40 - 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 osd300 - -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 - diff --git a/lib/fsk4hf/osdtbcc.f90 b/lib/fsk4hf/osdtbcc.f90 deleted file mode 100644 index 462fcc792..000000000 --- a/lib/fsk4hf/osdtbcc.f90 +++ /dev/null @@ -1,372 +0,0 @@ -subroutine osdtbcc(llr,apmask,ndeep,decoded,cw,nhardmin,dmin) -! -use iso_c_binding -parameter (N=280, K=70, L=16) - -integer*1 p1(L),p2(L),p3(L),p4(L) -integer*1 gg(100) - -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./ -!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:L)=p1 - gg(L+1:2*L)=p2 - gg(2*L+1:3*L)=p3 - gg(3*L+1:4*L)=p4 - gen=0 - gen(1,1:4*L)=gg(1:4*L) - do i=2,K - gen(i,:)=cshift(gen(i-1,:),-4) - enddo - first=.false. -endif - -! Re-order received vector to place systematic msg bits at the end. -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 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.5) ndeep=5 -if( ndeep.eq. 1) then - nord=1 - npre1=0 - npre2=0 - nt=120 - ntheta=12 -elseif(ndeep.eq.2) then - nord=1 - npre1=1 - npre2=0 - nt=120 - ntheta=12 -elseif(ndeep.eq.3) then - nord=1 - npre1=1 - npre2=1 - nt=120 - ntheta=12 - ntau=15 -elseif(ndeep.eq.4) then - nord=2 - npre1=1 - npre2=0 - nt=120 - ntheta=12 - ntau=15 -elseif(ndeep.eq.5) then - nord=3 - npre1=1 - npre2=1 - nt=80 - 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=0 -return -end subroutine osdtbcc - -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 - diff --git a/lib/fsk4hf/osdwspr.f90 b/lib/fsk4hf/osdwspr.f90 deleted file mode 100644 index 26069eb14..000000000 --- a/lib/fsk4hf/osdwspr.f90 +++ /dev/null @@ -1,373 +0,0 @@ -subroutine osdwspr(ss,apmask,ndeep,cw,nhardmin,dmin) -! -use iso_c_binding -parameter (N=162, K=50, L=32) - -!integer*1 p1(L),p2(L),p3(L),p4(L) -integer*1 gg(64) - -real ss(N) -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 indx(N),ndeep,nhardmin -real rx(N),absrx(N),dmin -logical first,reset -data first/.true./ -!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/ -data gg/1,1,0,1,0,1,0,0,1,0,0,0,1,1,0,0,1,0,1,0,0,1,0,1,1,1,0,1,1,0,0,0, & - 0,1,0,0,0,0,0,0,1,0,0,1,1,1,1,0,0,0,1,0,0,1,0,0,1,0,1,1,1,1,1,1/ - -save first,gen - -if( first ) then ! fill the generator matrix -! gg=0 -! gg(1:L)=p1 -! gg(L+1:2*L)=p2 -! gg(2*L+1:3*L)=p3 -! gg(3*L+1:4*L)=p4 - gen=0 - gen(1,1:2*L)=gg(1:2*L) - do i=2,K - gen(i,:)=cshift(gen(i-1,:),-2) - enddo - first=.false. -endif - -! Re-order received vector to place systematic msg bits at the end. -rx=ss/127.0 -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 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.5) ndeep=5 -if( ndeep.eq. 1) then - nord=1 - npre1=0 - npre2=0 - nt=60 - ntheta=12 -elseif(ndeep.eq.2) then - nord=1 - npre1=1 - npre2=0 - nt=60 - ntheta=12 -elseif(ndeep.eq.3) then - nord=1 - npre1=1 - npre2=1 - nt=60 - ntheta=22 - ntau=16 -elseif(ndeep.eq.4) then - nord=2 - npre1=1 - npre2=0 - nt=60 - ntheta=22 - ntau=16 -elseif(ndeep.eq.5) 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 as-received order. -cw(indices)=cw -hdec(indices)=hdec -return -end subroutine osdwspr - -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 - diff --git a/lib/fsk4hf/polyfit4.f90 b/lib/fsk4hf/polyfit4.f90 deleted file mode 100644 index 892cd2cd6..000000000 --- a/lib/fsk4hf/polyfit4.f90 +++ /dev/null @@ -1,109 +0,0 @@ -subroutine polyfit4(x,y,sigmay,npts,nterms,mode,a,chisqr) - - parameter (MAXN=20) - implicit real*8 (a-h,o-z) - real x(npts), y(npts), sigmay(npts), a(nterms),chisqr - real*8 sumx(2*MAXN-1), sumy(MAXN), array(MAXN,MAXN) - -! Accumulate weighted sums - nmax = 2*nterms-1 - sumx=0. - sumy=0. - chisq=0. - do i=1,npts - xi=x(i) - yi=y(i) - if(mode.lt.0) then - weight=1./abs(yi) - else if(mode.eq.0) then - weight=1 - else - weight=1./sigmay(i)**2 - end if - xterm=weight - do n=1,nmax - sumx(n)=sumx(n)+xterm - xterm=xterm*xi - enddo - yterm=weight*yi - do n=1,nterms - sumy(n)=sumy(n)+yterm - yterm=yterm*xi - enddo - chisq=chisq+weight*yi**2 - enddo - -! Construct matrices and calculate coefficients - do j=1,nterms - do k=1,nterms - n=j+k-1 - array(j,k)=sumx(n) - enddo - enddo - - delta=determ4(array,nterms) - if(delta.eq.0) then - chisqr=0. - a=0. - else - do l=1,nterms - do j=1,nterms - do k=1,nterms - n=j+k-1 - array(j,k)=sumx(n) - enddo - array(j,l)=sumy(j) - enddo - a(l)=determ4(array,nterms)/delta - enddo - -! Calculate chi square - - do j=1,nterms - chisq=chisq-2*a(j)*sumy(j) - do k=1,nterms - n=j+k-1 - chisq=chisq+a(j)*a(k)*sumx(n) - enddo - enddo - free=npts-nterms - chisqr=chisq/free - end if - - return -end subroutine polyfit4 - -real*8 function determ4(array,norder) - - parameter (MAXN=20) - implicit real*8 (a-h,o-z) - real*8 array(MAXN,MAXN) - - determ4=1. - do k=1,norder - if (array(k,k).ne.0) go to 41 - do j=k,norder - if(array(k,j).ne.0) go to 31 - enddo - determ4=0. - go to 60 - -31 do i=k,norder - s8=array(i,j) - array(i,j)=array(i,k) - array(i,k)=s8 - enddo - determ4=-1.*determ4 -41 determ4=determ4*array(k,k) - if(k.lt.norder) then - k1=k+1 - do i=k1,norder - do j=k1,norder - array(i,j)=array(i,j)-array(i,k)*array(k,j)/array(k,k) - enddo - enddo - end if - enddo - -60 return -end function determ4 diff --git a/lib/fsk4hf/spb.m b/lib/fsk4hf/spb.m deleted file mode 100644 index 9bb164506..000000000 --- a/lib/fsk4hf/spb.m +++ /dev/null @@ -1,89 +0,0 @@ -clear all; -global N -global R -global A - -#------------------------------------------------------------------------------- -function retval = f1(theta) - global N; - global R; - retval=0.0; - gterm = gammaln(N/2) - gammaln((N+1)/2) - log(2*sqrt(pi)); - rhs = -N*R*log(2); - lhs=gterm + (N-1)*log(sin(theta)) + log(1-(tan(theta).^2)/N) - log(cos(theta)); - retval = rhs-real(lhs); -endfunction -#------------------------------------------------------------------------------- - -#------------------------------------------------------------------------------- -function retval = d(N,i,x) - t1=(x.^2)/2; - t2=gammaln(N/2); - t3=-gammaln(i/2+1); - t4=-gammaln(N-i); - t5=(N-1-i)*log(sqrt(2)*x); - t6=-log(2)/2; - t7arg=1+(-1)^i * gammainc((x.^2)/2.0,(i+1)/2); - t7=log(t7arg); - retval=t1+t2+t3+t4+t5+t6+t7; -endfunction -#------------------------------------------------------------------------------- - -#------------------------------------------------------------------------------- -function retval = maxstar(x1,x2) - retval = max(x1,x2)+log(1+exp(-abs(x1-x2))); -endfunction -#------------------------------------------------------------------------------- - -#------------------------------------------------------------------------------- -function retval = spb_integrand(x) - global N; - global A; - - t1=log(N-1); - t2=-N*(A^2)/2; - t3=-0.5*log(2*pi); - t4=(N-2)*log(sin(x)); - - arg=sqrt(N)*A*cos(x); - t5=maxstar(d(N,0,arg),d(N,1,arg)); - for i=2:N-1 - t5=maxstar(t5,d(N,i,arg)); - endfor - - retval=exp(t1+t2+t3+t4+t5); -endfunction -#------------------------------------------------------------------------------- - -#------------------------------------------------------------------------------- -function retval = qfunc(x) - retval = 0.5 * erfc(x/sqrt(2)); -endfunction -#------------------------------------------------------------------------------- - -#------------------------------------------------------------------------------- -# Calculate sphere packing lower bound on the probability of word error -# given block length (N), code rate (R), and Eb/No. -# -# Ref: -# "Log-Domain Calculation of the 1959 Sphere-Packing Bound with Application to -# M-ary PSK Block Coded Modulation," Igal Sason and Gil Weichman, -# doi: 10.1109/EEEI.2006.321097 -#------------------------------------------------------------------------------- -N=128 -K=90 -R=K/N - -delta=0.01; -[ths,fval,info,output]=fzero(@f1,[delta,pi/2-delta], optimset ("jacobian", "off")); - -for ebnodb=-3:0.5:4 - ebno=10^(ebnodb/10.0); - esno=ebno*R; - A=sqrt(2*esno); - term1=quadcc(@spb_integrand,ths,pi/2); - term2=qfunc(sqrt(N)*A); - pe=term1+term2; - ps=1-pe; - printf("%f %f\n",ebnodb,ps); -endfor diff --git a/lib/fsk4hf/spb_128_90.dat b/lib/fsk4hf/spb_128_90.dat deleted file mode 100644 index 9e32e28e9..000000000 --- a/lib/fsk4hf/spb_128_90.dat +++ /dev/null @@ -1,19 +0,0 @@ -N = 128 -K = 90 -R = 0.70312 --3.000000 0.000341 --2.500000 0.001513 --2.000000 0.006049 --1.500000 0.021280 --1.000000 0.064283 --0.500000 0.162755 -0.000000 0.338430 -0.500000 0.571867 -1.000000 0.791634 -1.500000 0.930284 -2.000000 0.985385 -2.500000 0.998258 -3.000000 0.999893 -3.500000 0.999997 -4.000000 1.000000 - diff --git a/lib/fsk4hf/spec4.f90 b/lib/fsk4hf/spec4.f90 deleted file mode 100644 index e05889507..000000000 --- a/lib/fsk4hf/spec4.f90 +++ /dev/null @@ -1,35 +0,0 @@ -subroutine spec4(c,s,savg) - - 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) - parameter (NFFT=2*NSPS,NH=NSPS) - - complex c(0:NZ-1) - complex c1(0:NFFT-1) - real s(0:NH,NN) - real savg(0:NH) - - fs=12000.0/84.0 - df=fs/NFFT - savg=0. - do j=1,NN - ia=(j-1)*NSPS - ib=ia + NSPS-1 - c1(0:NSPS-1)=c(ia:ib) - c1(NSPS:)=0. - call four2a(c1,NFFT,1,-1,1) - do k=1,NSPS - s(k,j)=real(c1(k))**2 + aimag(c1(k))**2 - enddo - savg=savg+s(0:NH,j) - enddo - s=s/NZ - savg=savg/(NN*NZ) - - return -end subroutine spec4 diff --git a/lib/fsk4hf/spec8.f90 b/lib/fsk4hf/spec8.f90 deleted file mode 100644 index 43fbc7ee2..000000000 --- a/lib/fsk4hf/spec8.f90 +++ /dev/null @@ -1,31 +0,0 @@ -subroutine spec8(c,s,savg) - - include 'wspr_fsk8_params.f90' - complex c(0:NMAXD-1) - complex c1(0:NSPS-1) - real s(0:NH2,NN) - real savg(0:NH2) - - fs=12000.0/NDOWN - df=fs/NSPS - savg=0. - do j=1,NN - ia=(j-1)*NSPS - ib=ia + NSPS-1 - c1(0:NSPS-1)=c(ia:ib) - c1(NSPS:)=0. - call four2a(c1,NSPS,1,-1,1) - do i=0,NH2 - s(i,j)=real(c1(i))**2 + aimag(c1(i))**2 - enddo - savg=savg+s(0:NH2,j) - enddo - s=s/NZ - savg=savg/(NN*NZ) -! do i=0,NH2 -! write(31,3101) i*df,savg(i) -!3101 format(f10.3,f12.3) -! enddo - - return -end subroutine spec8 diff --git a/lib/fsk4hf/tccsim.f90 b/lib/fsk4hf/tccsim.f90 deleted file mode 100644 index 644b87a39..000000000 --- a/lib/fsk4hf/tccsim.f90 +++ /dev/null @@ -1,194 +0,0 @@ -! -! Simulator for terminated convolutional codes (so, far, only rate 1/2) -! BPSK on AWGN Channel -! -! Hybrid decoder - Fano Sequential Decoder and Ordered Statistics Decoder (OSD)a -! -program tccsim - - parameter (N=162,K=50) - integer*1 gen(K,N) - integer*1 gg(64) - integer*1 mbits(50),mbits2(50) - integer*4 mettab(-128:127,0:1) - - parameter (NSYM=162) - parameter (MAXSYM=162) - character*12 arg - character*22 msg,msg2 - integer*1 data0(13) - integer*1 data1(13) - integer*1 dat(206) - integer*1 softsym(162) - integer*1 apmask(162),cw0(162),cw(162) - real*4 xx0(0:255) - real ss(162) - - character*64 g ! Interleaved polynomial coefficients - data g/'1101010010001100101001011101100001000000100111100010010010111111'/ - - data xx0/ & !Metric table - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 0.988, 1.000, 0.991, 0.993, 1.000, 0.995, 1.000, 0.991, & - 1.000, 0.991, 0.992, 0.991, 0.990, 0.990, 0.992, 0.996, & - 0.990, 0.994, 0.993, 0.991, 0.992, 0.989, 0.991, 0.987, & - 0.985, 0.989, 0.984, 0.983, 0.979, 0.977, 0.971, 0.975, & - 0.974, 0.970, 0.970, 0.970, 0.967, 0.962, 0.960, 0.957, & - 0.956, 0.953, 0.942, 0.946, 0.937, 0.933, 0.929, 0.920, & - 0.917, 0.911, 0.903, 0.895, 0.884, 0.877, 0.869, 0.858, & - 0.846, 0.834, 0.821, 0.806, 0.790, 0.775, 0.755, 0.737, & - 0.713, 0.691, 0.667, 0.640, 0.612, 0.581, 0.548, 0.510, & - 0.472, 0.425, 0.378, 0.328, 0.274, 0.212, 0.146, 0.075, & - 0.000,-0.079,-0.163,-0.249,-0.338,-0.425,-0.514,-0.606, & - -0.706,-0.796,-0.895,-0.987,-1.084,-1.181,-1.280,-1.376, & - -1.473,-1.587,-1.678,-1.790,-1.882,-1.992,-2.096,-2.201, & - -2.301,-2.411,-2.531,-2.608,-2.690,-2.829,-2.939,-3.058, & - -3.164,-3.212,-3.377,-3.463,-3.550,-3.768,-3.677,-3.975, & - -4.062,-4.098,-4.186,-4.261,-4.472,-4.621,-4.623,-4.608, & - -4.822,-4.870,-4.652,-4.954,-5.108,-5.377,-5.544,-5.995, & - -5.632,-5.826,-6.304,-6.002,-6.559,-6.369,-6.658,-7.016, & - -6.184,-7.332,-6.534,-6.152,-6.113,-6.288,-6.426,-6.313, & - -9.966,-6.371,-9.966,-7.055,-9.966,-6.629,-6.313,-9.966, & - -5.858,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, & - -9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, & - -9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, & - -9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, & - -9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, & - -9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966/ - - bias=0.42 - scale=120 -! ndelta=nint(3.4*scale) - ndelta=100 - ib=150 - slope=2 - do i=0,255 - mettab(i-128,0)=nint(scale*(xx0(i)-bias)) - if(i.gt.ib) mettab(i-128,0)=mettab(ib-128,0)-slope*(i-ib) - if(i.ge.1) mettab(128-i,1)=mettab(i-128,0) - enddo - mettab(-128,1)=mettab(-127,1) - -! Get command-line argument(s) - nargs=iargc() - if(nargs.ne.3) then - print*,'Usage: tccsim "message" ntrials ndepth' - go to 999 - endif - call getarg(1,msg) !Get message from command line - write(*,1000) msg -1000 format('Message: ',a22) - call getarg(2,arg) - read(arg,*) ntrials - call getarg(3,arg) - read(arg,*) ndepth - - nbits=50+31 !User bits=99, constraint length=32 - nbytes=(nbits+7)/8 - limit=20000 - - data0=0 - call wqencode(msg,ntype0,data0) !Source encoding -write(*,*) 'data0 ',data0 -! Demonstrates how to create the generator matrix from a string that contains the interleaved -! polynomial coefficients - gen=0 - do j=1,64 - read(g(j:j),"(i1)") gg(j) ! read polynomial coeffs from string - enddo - do i=1,K - gen(i,2*(i-1)+1:2*(i-1)+64)=gg ! fill the generator matrix with cyclic shifts of gg - enddo - -! get message bits from data0 - nbits=0 - do i=1,7 - do ib=7,0,-1 - nbits=nbits+1 - if(nbits .le. 50) then - mbits(nbits)=0 - if(btest(data0(i),ib)) mbits(nbits)=1 - endif - enddo - enddo - - write(*,*) 'Source encoded message bits: ' - write(*,'(6(8i1,1x),2i1)') mbits - -! Encode message bits using the generator matrix, generating a 162-bit codeword. - cw0=0 - do i=1,50 - if(mbits(i).eq.1) cw0=mod(cw0+gen(i,:),2) - enddo - - write(*,*) 'Codeword from generator matrix: ' - write(*,'(162i1)') cw0 - -! call encode232(data0,nbytes,dat) !Convolutional encoding -! write(*,*) 'Codeword from encode232: ' -! write(*,'(162i2)') dat - -! call inter_mept(dat,1) !Interleaving - -! Here, we have channel symbols. - -! call inter_mept(dat,-1) !Remove interleaving - - call init_random_seed() - call sgran() - - do isnr=10,-20,-1 - sigma=1/sqrt(2*(10**((isnr/2.0)/10.0))) - ngood=0 - nbad=0 - do i=1,ntrials - do j=1,162 - ss(j)=-(2*cw0(j)-1)+sigma*gran() !Simulate soft symbols - enddo - - rms=sqrt(sum(ss**2)) - ss=100*ss/rms - where(ss>127.0) ss=127.0 - where(ss<-127.0) ss=-127.0 - softsym=ss - -! Call the sequential (Fano algorithm) decoder - nbits=50+31 -! call fano232(softsym,nbits,mettab,ndelta,limit,data1,ncycles,metric,nerr) -nerr=1 - iflag=0 - nhardmin=0 - dmin=0.0 - -! If Fano fails, call OSD - if(nerr.ne.0 .and. ndepth.ge.0) then - apmask=0 - cw=0 - call osdwspr(softsym,apmask,ndepth,cw,nhardmin,dmin) -! OSD produces a codeword, but code is not systematic -! Use Fano with hard decisions to retrieve the message from the codeword -! cw=-(2*cw-1)*64 -! nbits=50+31 -!dat=0 -!dat(1:162)=cw -! call fano232(dat,nbits,mettab,ndelta,limit,data1,ncycles,metric,nerr) -! iflag=1 - endif -! call wqdecode(data1,msg2,ntype1) -! write(*,*) msg2,iflag,nhardmin,dmin - if(any(cw.ne.cw0)) nbad=nbad+1 - if(all(cw.eq.cw0)) ngood=ngood+1 - enddo - - write(*,'(f4.1,i8,i8)') isnr/2.0,ngood,nbad - enddo - -999 end program tccsim - -#include '../wsprcode/wspr_old_subs.f90' - diff --git a/lib/fsk4hf/tweak1.f90 b/lib/fsk4hf/tweak1.f90 deleted file mode 100644 index c62c40872..000000000 --- a/lib/fsk4hf/tweak1.f90 +++ /dev/null @@ -1,23 +0,0 @@ -subroutine tweak1(ca,jz,f0,cb) - -! Shift frequency of analytic signal ca, with output to cb - - complex ca(jz),cb(jz) - real*8 twopi - complex*16 w,wstep - complex w4 - data twopi/0.d0/ - save twopi - - if(twopi.eq.0.d0) twopi=8.d0*atan(1.d0) - w=1.d0 - dphi=twopi*f0/12000.d0 - wstep=cmplx(cos(dphi),sin(dphi)) - do i=1,jz - w=w*wstep - w4=w - cb(i)=w4*ca(i) - enddo - - return -end subroutine tweak1 diff --git a/lib/fsk4hf/wavhdr.f90 b/lib/fsk4hf/wavhdr.f90 deleted file mode 100644 index b54fba787..000000000 --- a/lib/fsk4hf/wavhdr.f90 +++ /dev/null @@ -1,110 +0,0 @@ -module wavhdr - type hdr - character*4 ariff - integer*4 lenfile - character*4 awave - character*4 afmt - integer*4 lenfmt - integer*2 nfmt2 - integer*2 nchan2 - integer*4 nsamrate - integer*4 nbytesec - integer*2 nbytesam2 - integer*2 nbitsam2 - character*4 adata - integer*4 ndata - end type hdr - - contains - - function default_header(nsamrate,npts) - type(hdr) default_header,h - h%ariff='RIFF' - h%awave='WAVE' - h%afmt='fmt ' - h%lenfmt=16 - h%nfmt2=1 - h%nchan2=1 - h%nsamrate=nsamrate - h%nbitsam2=16 - h%nbytesam2=h%nbitsam2 * h%nchan2 / 8 - h%adata='data' - h%nbytesec=h%nsamrate * h%nbitsam2 * h%nchan2 / 8 - h%ndata=2*npts - h%lenfile=h%ndata + 44 - 8 - default_header=h - end function default_header - - subroutine set_wsjtx_wav_params(fMHz,mode,nsubmode,ntrperiod,id2) - - parameter (NBANDS=23,NMODES=11) - character*8 mode,modes(NMODES) - integer*2 id2(4) - integer iperiod(7) - real fband(NBANDS) - data fband/0.137,0.474,1.8,3.5,5.1,7.0,10.14,14.0,18.1,21.0,24.9, & - 28.0,50.0,144.0,222.0,432.0,902.0,1296.0,2304.0,3400.0, & - 5760.0,10368.0,24048.0/ - data modes/'Echo','FSK441','ISCAT','JT4','JT65','JT6M','JT9', & - 'JT9+JT65','JTMS','JTMSK','WSPR'/ - data iperiod/5,10,15,30,60,120,900/ - - dmin=1.e30 - iband=0 - do i=1,NBANDS - if(abs(fMHz-fband(i)).lt.dmin) then - dmin=abs(fMHz-fband(i)) - iband=i - endif - enddo - - imode=0 - do i=1,NMODES - if(mode.eq.modes(i)) imode=i - enddo - - ip=0 - do i=1,7 - if(ntrperiod.eq.iperiod(i)) ip=i - enddo - - id2(1)=iband - id2(2)=imode - id2(3)=nsubmode - id2(4)=ip - - return - end subroutine set_wsjtx_wav_params - - subroutine get_wsjtx_wav_params(id2,band,mode,nsubmode,ntrperiod,ok) - - parameter (NBANDS=23,NMODES=11) - character*8 mode,modes(NMODES) - character*6 band,bands(NBANDS) - integer*2 id2(4) - integer iperiod(7) - logical ok - data modes/'Echo','FSK441','ISCAT','JT4','JT65','JT6M','JT9', & - 'JT9+JT65','JTMS','JTMSK','WSPR'/ - data iperiod/5,10,15,30,60,120,900/ - data bands/'2190m','630m','160m','80m','60m','40m','30m','20m', & - '17m','15m','12m','10m','6m','2m','1.25m','70cm','33cm', & - '23cm','13cm','9cm','6cm','3cm','1.25cm'/ - - ok=.true. - if(id2(1).lt.1 .or. id2(1).gt.NBANDS) ok=.false. - if(id2(2).lt.1 .or. id2(2).gt.NMODES) ok=.false. - if(id2(3).lt.1 .or. id2(3).gt.8) ok=.false. - if(id2(4).lt.1 .or. id2(4).gt.7) ok=.false. - - if(ok) then - band=bands(id2(1)) - mode=modes(id2(2)) - nsubmode=id2(3) - ntrperiod=iperiod(id2(4)) - endif - - return - end subroutine get_wsjtx_wav_params - -end module wavhdr diff --git a/lib/fsk4hf/wspr4_params.f90 b/lib/fsk4hf/wspr4_params.f90 deleted file mode 100644 index d4e575382..000000000 --- a/lib/fsk4hf/wspr4_params.f90 +++ /dev/null @@ -1,16 +0,0 @@ -! WSPR4 -! LDPC(174,74)/CRC24 code, four 4x4 Costas arrays for sync, ramp-up and ramp-down symbols - -parameter (KK=50) !Information bits (50 + CRC24) -parameter (ND=87) !Data symbols -parameter (NS=16) !Sync symbols -parameter (NN=NS+ND) !Sync and data symbols (103) -parameter (NN2=NS+ND+2) !Total channel symbols (105) -parameter (NSPS=13312) !Samples per symbol at 12000 S/s -parameter (NZ=NSPS*NN) !Sync and Data samples (1,397,136) -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 diff --git a/lib/fsk4hf/wspr4d.f90 b/lib/fsk4hf/wspr4d.f90 deleted file mode 100644 index 0e29833b5..000000000 --- a/lib/fsk4hf/wspr4d.f90 +++ /dev/null @@ -1,424 +0,0 @@ -program wspr4d - -! Decode WSPR4 data read from *.c2 or *.wav files. - - use packjt77 - include 'wspr4_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:103*NSPS2-1) !Complex waveform - complex cd(0:103*16-1) !Complex waveform - real*8 fMHz - real llr(174),llra(174),llrb(174),llrc(174) - real candidates(100,2) - real bitmetrics(206,3) - integer ihdr(11) - integer*2 iwave(NMAX) !Generated full-length waveform - integer*1 apmask(174),cw(174) - integer*1 hbits(206) - integer*1 message74(74) - 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) - - nargs=iargc() - if(nargs.lt.1) then - print*,'Usage: wspr4d [-a ] [-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 - - open(13,file=trim(data_dir)//'/ALL_WSPR.TXT',status='unknown', & - position='append') - - 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 wspr4_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 getcandidate4(c2,npts,fs,fa,fb,ncand,candidates) !First approx for freq - - ndecodes=0 - do icand=1,ncand - fc0=candidates(icand,1) - xsnr=candidates(icand,2) - - do isync=0,1 - - del=1.5*fs/416.0 - if(isync.eq.0) then - fc1=fc0-del - is0=375 - ishw=300 - dis=50 - ifhw=10 - df=.1 - else if(isync.eq.1) then - fc1=fc2 - is0=isbest - ishw=100 - dis=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,dis - call coherent_sync(c2,istart,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 - idecoded=0 - do ijitter=0,2 - if(idecoded.eq.1) exit - if(ijitter.eq.0) ioffset=0 - if(ijitter.eq.1) ioffset=50 - if(ijitter.eq.2) ioffset=-50 - is0=isbest+ioffset - if(is0.lt.0) cycle - cframe=c2(is0:is0+103*416-1) - call downsample4(cframe,fc2,cd) - s2=sum(cd*conjg(cd))/(16*103) - cd=cd/sqrt(s2) - call get_wspr4_bitmetrics(cd,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( 67: 74).eq.(/0,1,0,0,1,1,1,0/)) - ns3=count(hbits(133:140).eq.(/1,1,1,0,0,1,0,0/)) - ns4=count(hbits(199:206).eq.(/1,0,1,1,0,0,0,1/)) - nsync_qual=ns1+ns2+ns3+ns4 -! if(nsync_qual.lt. 20) cycle - - scalefac=2.83 - llra( 1: 58)=bitmetrics( 9: 66, 1) - llra( 59:116)=bitmetrics( 75:132, 1) - llra(117:174)=bitmetrics(141:198, 1) - llra=scalefac*llra - llrb( 1: 58)=bitmetrics( 9: 66, 2) - llrb( 59:116)=bitmetrics( 75:132, 2) - llrb(117:174)=bitmetrics(141:198, 2) - llrb=scalefac*llrb - llrc( 1: 58)=bitmetrics( 9: 66, 3) - llrc( 59:116)=bitmetrics( 75:132, 3) - llrc(117:174)=bitmetrics(141:198, 3) - llrc=scalefac*llrc - apmask=0 - max_iterations=40 - - do itry=3,1,-1 - if(itry.eq.1) llr=llra - if(itry.eq.2) llr=llrb - if(itry.eq.3) llr=llrc - nhardbp=0 - nhardosd=0 - dmin=0.0 - call bpdecode174_74(llr,apmask,max_iterations,message74,cw,nhardbp,niterations,nchecks) - Keff=64 -! if(nhardbp.lt.0) call osd174_74(llr,Keff,apmask,5,message74,cw,nhardosd,dmin) - maxsuperits=2 - ndeep=4 - if(nhardbp.lt.0) then - call decode174_74(llr,Keff,ndeep,apmask,maxsuperits,message74,cw,nhardosd,iter,ncheck,dmin,isuper) - endif - if(nhardbp.ge.0 .or. nhardosd.ge.0) then - write(c77,'(50i1)') message74(1:50) - c77(51:77)='000000000000000000000110000' - call unpack77(c77,0,msg,unpk77_success) - if(unpk77_success .and. index(msg,'K9AN').gt.0) then - idecoded=1 - ngood=ngood+1 - write(*,1100) ifile,xsnr,isbest/375.0-1.0,1500.0+fc2+del,msg(1:14),itry,nhardbp,nhardosd,dmin,ijitter -1100 format(i5,2x,f6.1,2x,f6.2,2x,f8.2,2x,a14,i4,i4,i4,f7.2,i6) - exit - else - cycle - endif - endif - enddo ! metrics - enddo ! istart jitter - enddo !candidate list - enddo !files - nfiles=nargs-iarg+1 - write(*,*) 'nfiles: ',nfiles,' ngood: ',ngood - write(*,1120) -1120 format("") - -999 end program wspr4d - -subroutine coherent_sync(cd0,i0,f0,itwk,sync) - -! Compute sync power for a complex, downsampled FT4 signal. - - include 'wspr4_params.f90' - parameter(NP=NMAX/NDOWN,NSS=NSPS/NDOWN) - complex cd0(0:NP-1) - complex csynca(4*NSS),csyncb(4*NSS),csyncc(4*NSS),csyncd(4*NSS) - complex csync2(4*NSS) - complex ctwk(4*NSS) - complex ctmp(4*NSS) - complex z1,z2,z3,z4 - logical first - integer icos4a(0:3),icos4b(0:3),icos4c(0:3),icos4d(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 first/.true./ - save first,twopi,csynca,csyncb,csyncc,csyncd,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 - do i=0,3 - dphia=twopi*icos4a(i)/real(NSS) - dphib=twopi*icos4b(i)/real(NSS) - dphic=twopi*icos4c(i)/real(NSS) - dphid=twopi*icos4d(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)) - phia=mod(phia+dphia,twopi) - phib=mod(phib+dphib,twopi) - phic=mod(phic+dphic,twopi) - phid=mod(phid+dphid,twopi) - k=k+1 - enddo - enddo - first=.false. - fac=1.0/(4.0*NSS) - endif - - i1=i0 !four Costas arrays - i2=i0+33*NSS - i3=i0+66*NSS - i4=i0+99*NSS - - z1=0. - z2=0. - z3=0. - z4=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 - z1=0. - 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.32) 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 - z4=0. - if(i4.ge.0 .and. i4+4*NSS-1.le.NP-1) then - z4=sum(cd0(i4:i4+4*NSS-1)*conjg(csync2)) - elseif( i4+4*NSS-1.gt.NP-1 ) then - npts=(NP-1-i4+1) - if(npts.le.32) then - z4=0. - else - z4=sum(cd0(i4:i4+npts-1)*conjg(csync2(1:npts))) - endif - endif - - sync = p(z1) + p(z2) + p(z3) + p(z4) - - return -end subroutine coherent_sync - -subroutine downsample4(ci,f0,co) - parameter(NI=103*416,NH=NI/2,NO=NI/26) ! downsample from 416 samples per symbol to 16 - 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 - 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 getcandidate4(c,npts,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 - 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)-28.5 - endif - enddo - return -end subroutine getcandidate4 - -subroutine wspr4_downsample(iwave,c) - -! Input: i*2 data in iwave() at sample rate 12000 Hz -! Output: Complex data in c(), sampled at 375 Hz - - include 'wspr4_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 wspr4_downsample - diff --git a/lib/fsk4hf/wspr4sim.f90 b/lib/fsk4hf/wspr4sim.f90 deleted file mode 100644 index eaca79c5a..000000000 --- a/lib/fsk4hf/wspr4sim.f90 +++ /dev/null @@ -1,114 +0,0 @@ -program wspr4sim - -! Generate simulated signals for experimental "wspr4" mode - - use wavhdr - use packjt77 - include 'wspr4_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(74) - integer*2 iwave(NMAX) !Generated full-length waveform - -! Get command-line argument(s) - nargs=iargc() - if(nargs.ne.7) then - print*,'Usage: wspr4sim "message" f0 DT fdop del nfiles snr' - print*,'Examples: wspr4sim "K9AN EN50 37" 1500 0.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,*) fspread !Watterson frequency spread (Hz) - call getarg(5,arg) - read(arg,*) delay !Watterson delay (ms) - call getarg(6,arg) - read(arg,*) nfiles !Number of files - call getarg(7,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=1.0 !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=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 genwspr4(msg37,0,msgsent37,msgbits,itone) - 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(*,'(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) - peak=maxval(abs(wave)) - nslots=1 - 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 wspr4sim diff --git a/lib/fsk4hf/wspr5_downsample.f90 b/lib/fsk4hf/wspr5_downsample.f90 deleted file mode 100644 index 6fdb9021d..000000000 --- a/lib/fsk4hf/wspr5_downsample.f90 +++ /dev/null @@ -1,29 +0,0 @@ -subroutine wspr5_downsample(iwave,c) - -! Input: i*2 data in iwave() at sample rate 12000 Hz -! Output: Complex data in c(), sampled at 400 Hz - - include 'wsprlf_params.f90' - parameter (NMAX=300*12000,NFFT2=NMAX/30) - integer*2 iwave(NMAX) - complex c(0:NZ-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:NZ-1) - - return -end subroutine wspr5_downsample diff --git a/lib/fsk4hf/wspr5_wav.f90 b/lib/fsk4hf/wspr5_wav.f90 deleted file mode 100644 index 0b09ccde2..000000000 --- a/lib/fsk4hf/wspr5_wav.f90 +++ /dev/null @@ -1,48 +0,0 @@ -subroutine wspr5_wav(baud,xdt,f0,itone,snrdb,iwave) - -! Generate iwave() from itone(). - - include 'wsprlf_params.f90' - parameter (NMAX=300*12000) - integer itone(NN) - integer*2 iwave(NMAX) - real*8 twopi,dt,dphi0,dphi1,dphi,phi - real dat(NMAX) - - twopi=8.d0*atan(1.d0) - dt=1.d0/12000.d0 - - dat=0. - if(snrdb.lt.90) then - do i=1,NMAX - dat(i)=gran() !Generate gaussian noise - enddo - bandwidth_ratio=2500.0/6000.0 - sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*snrdb) - else - sig=1.0 - endif - - dphi0=twopi*(f0-0.25d0*baud)*dt - dphi1=twopi*(f0+0.25d0*baud)*dt - phi=0.d0 - k=nint(xdt/dt) - do j=1,NN - dphi=dphi0 - if(itone(j).eq.1) dphi=dphi1 - if(k.eq.0) phi=-dphi - do i=1,NSPS0 - k=k+1 - phi=phi+dphi - if(phi.gt.twopi) phi=phi-twopi - xphi=phi - if(k.gt.0 .and. k.le.NMAX) dat(k)=dat(k) + sig*sin(xphi) - enddo - enddo - fac=32767.0 - rms=100.0 - if(snrdb.ge.90.0) iwave=nint(fac*dat) - if(snrdb.lt.90.0) iwave=nint(rms*dat) - - return -end subroutine wspr5_wav diff --git a/lib/fsk4hf/wspr5d.f90 b/lib/fsk4hf/wspr5d.f90 deleted file mode 100644 index 8a3c800b8..000000000 --- a/lib/fsk4hf/wspr5d.f90 +++ /dev/null @@ -1,220 +0,0 @@ -program wspr5d - -! Decode WSPR-LF data read from *.c5 or *.wav files. - -! WSPR-LF is a potential WSPR-like mode intended for use at LF and MF. -! It uses an LDPC (300,60) code, OQPSK modulation, and 5 minute T/R sequences. - -! Reception and Demodulation algorithm: -! 1. Compute coarse spectrum; find fc1 = approx carrier freq -! 2. Mix from fc1 to 0; LPF at +/- 0.75*R -! 3. Square, FFT; find peaks near -R/2 and +R/2 to get fc2 -! 4. Mix from fc2 to 0 -! 5. Fit cb13 (central part of csync) to c -> lag, phase -! 6. Fit complex ploynomial for channel equalization -! 7. Get soft bits from equalized data - -! Still to do: find and decode more than one signal in the specified passband. - - include 'wsprlf_params.f90' - parameter (NMAX=300*12000) - character arg*8,message*22,cbits*50,infile*80,fname*16,datetime*11 - character*120 data_dir - complex csync(0:NZ-1) !Sync symbols only, from cbb - complex c(0:NZ-1) !Complex waveform - complex c1(0:NZ-1) !Complex waveform - complex zz(NS+ND) !Complex symbol values (intermediate) - complex z - real*8 fMHz - real rxdata(ND),llr(ND) !Soft symbols - real pp(2*NSPS) !Shaped pulse for OQPSK - real a(5) !For twkfreq1 - real aa(20),bb(20) !Fitted polyco's - real fpks(20) - integer id(NS+ND) !NRZ values (+/-1) for Sync and Data - integer ierror(NS+ND) - integer isync(48) !Long sync vector - integer ib13(13) !Barker 13 code - integer ihdr(11) - integer*8 n8 - integer*2 iwave(NMAX) !Generated full-length waveform - integer*1 idat(7) - integer*1 decoded(KK),apmask(ND),cw(ND) - data ib13/1,1,1,1,1,-1,-1,1,1,-1,1,-1,1/ - - nargs=iargc() - if(nargs.lt.2) then - print*,'Usage: wspr5d [-a ] [-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 - - open(13,file=trim(data_dir)//'/ALL_WSPR.TXT',status='unknown', & - position='append') -! maxn=4 !Default value - maxn=2 - twopi=8.0*atan(1.0) - fs=NSPS*12000.0/NSPS0 !Sample rate - dt=1.0/fs !Sample interval (s) - tt=NSPS*dt !Duration of "itone" symbols (s) - ts=2*NSPS*dt !Duration of OQPSK symbols (s) - baud=1.0/tt !Keying rate for "itone" symbols (baud) - txt=NZ*dt !Transmission length (s) - - do i=1,N2 !Half-sine pulse shape - pp(i)=sin(0.5*(i-1)*twopi/(2*NSPS)) - enddo - n8=z'cbf089223a51' - do i=1,48 - isync(i)=-1 - if(iand(n8,1).eq.1) isync(i)=1 - n8=n8/2 - enddo - -! Define array id() for sync symbols - id=0 - do j=1,48 !First group of 48 - id(2*j-1)=2*isync(j) - enddo - do j=1,13 !Barker 13 code - id(j+96)=2*ib13(j) - enddo - do j=1,48 !Second group of 48 - id(2*j+109)=2*isync(j) - enddo - - csync=0. - do j=1,205 - if(abs(id(j)).eq.2) then - ia=nint((j-0.5)*N2) - ib=ia+N2-1 - csync(ia:ib)=pp*id(j)/abs(id(j)) - endif - enddo - -write(*,*) 'iarg, nargs ',iarg,nargs - do ifile=iarg,nargs - call getarg(ifile,infile) - open(10,file=infile,status='old',access='stream') - j1=index(infile,'.c5') - j2=index(infile,'.wav') - if(j1.gt.0) then - read(10,end=999) fname,ntrmin,fMHz,c - 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 wspr5_downsample(iwave,c) - else - print*,'Wrong file format?' - go to 999 - endif - close(10) - fa=100.0 - fb=150.0 - call getfc1w(c,fs,fa,fb,fc1,xsnr) !First approx for freq - npeaks=20 - call getfc2w(c,csync,npeaks,fs,fc1,fpks) !Refined freq - - a(1)=-fc1 - a(2:5)=0. - call twkfreq1(c,NZ,fs,a,c) !Mix c down by fc1+fc2 -! Find time offset xdt - amax=0. - jpk=0 - iaa=0 - ibb=NZ-1 - jmax=1260 - do j=-jmax,jmax,NSPS/8 - ia=j - ib=NZ-1+j - if(ia.lt.0) then - ia=0 - iaa=-j - else - iaa=0 - endif - if(ib.gt.NZ-1) then - ib=NZ-1 - ibb=NZ-1-j - endif - z=sum(c(ia:ib)*conjg(csync(iaa:ibb))) - if(abs(z).gt.amax) then - amax=abs(z) - jpk=j - endif - enddo - xdt=jpk/fs -xdt=1.0 -jpk=fs*xdt - do i=0,NZ-1 - j=i+jpk - if(j.ge.0 .and. j.lt.NZ) c1(i)=c(j) - enddo - - nterms=maxn - do itry=1,npeaks - nhard0=0 - nhardsync0=0 - ifer=1 - a(1)=-fpks(itry) - a(2:5)=0. - call twkfreq1(c1,NZ,fs,a,c) !Mix c1 into c - call cpolyfitw(c,pp,id,maxn,aa,bb,zz,nhs) - call msksoftsymw(zz,aa,bb,id,nterms,ierror,rxdata,nhard0,nhardsync0) - if(nhardsync0.gt.35) cycle - 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 bpdecode300(llr,apmask,max_iterations,decoded,niterations,cw) - nhardmin=0 - if(niterations.lt.0) call osd300(llr,apmask,5,decoded,cw,nhardmin,dmin) - nbadcrc=0 - call chkcrc10(decoded,nbadcrc) - if(nbadcrc.ne.0) ifer=1 - if(ifer.eq.0) exit - enddo !Freq dither loop - message=' ' - if(ifer.eq.0) then - write(cbits,1100) decoded(1:50) -1100 format(50i1) - read(cbits,1102) idat -1102 format(6b8,b2) - idat(7)=ishft(idat(7),6) - call wqdecode(idat,message,itype) - nsnr=nint(xsnr) -! freq=fMHz + 1.d-6*(fc1+fc2) -! freq=fMHz + 1.d-6*(fc1+fpks(itry)) - freq=fc1+fpks(itry) - nfdot=0 - write(13,1110) datetime,0,nsnr,xdt,freq,message,nfdot -1110 format(a11,2i4,f6.2,f12.7,2x,a22,i3) - write(*,1112) datetime(8:11),nsnr,xdt,freq,nfdot,message,itry,nhardmin -!1112 format(a4,i4,f5.1,f11.6,i3,2x,a22,i4) -1112 format(a4,i4,f8.3,f8.3,i3,2x,a22,i4,i4) - endif - enddo ! ifile loop - write(*,1120) -1120 format("") - -999 end program wspr5d diff --git a/lib/fsk4hf/wspr5d_exp.f90 b/lib/fsk4hf/wspr5d_exp.f90 deleted file mode 100644 index b4f75c545..000000000 --- a/lib/fsk4hf/wspr5d_exp.f90 +++ /dev/null @@ -1,570 +0,0 @@ -program wspr5d - -! Decode WSPR-LF data read from *.c5 or *.wav files. - -! WSPR-LF is a potential WSPR-like mode intended for use at LF and MF. -! It uses an LDPC (300,60) code, OQPSK modulation, and 5 minute T/R sequences. -! -! Still to do: find and decode more than one signal in the specified passband. - -! include 'wsprlf_params.f90' - - parameter (NDOWN=30) - parameter (KK=60) - parameter (ND=300) - parameter (NS=109) - parameter (NR=3) - parameter (NN=NR+NS+ND) - parameter (NSPS0=8640) - parameter (NSPS=16) - parameter (N2=2*NSPS) - parameter (NZ=NSPS*NN) - parameter (NZ400=288*NN) - parameter (NMAX=300*12000) - - character arg*8,message*22,cbits*50,infile*80,fname*16,datetime*11 - character*120 data_dir - complex csync(0:NZ-1) !Sync symbols only, from cbb - complex c400(0:NZ400-1) !Complex waveform - complex c(0:NZ-1) !Complex waveform - complex cd(0:NZ-1) !Complex waveform - complex ca(0:NZ-1) !Complex waveform - complex zz,zzsum - complex cc(110) !Complex correlation coefficients - complex*8 cfac - real*8 fMHz - real rxdata(ND),llr(ND) !Soft symbols - real pp(32) !Shaped pulse for OQPSK - real sbits(412),softbits(9) - real fpks(20) - integer id(NS+ND) !NRZ values (+/-1) for Sync and Data - integer isync(48) !Long sync vector - integer ib13(13) !Barker 13 code - integer ihdr(11) - integer*8 n8 - integer*2 iwave(NMAX) !Generated full-length waveform - integer*1 idat(7) - integer*1 decoded(KK),apmask(ND),cw(ND) - integer*1 hbits(412),bits(13) - logical reset - data ib13/1,1,1,1,1,-1,-1,1,1,-1,1,-1,1/ - - nargs=iargc() - if(nargs.lt.2) then - print*,'Usage: wspr5d [-a ] [-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 - - open(13,file=trim(data_dir)//'/ALL_WSPR.TXT',status='unknown', & - position='append') - maxn=8 !Default value - twopi=8.0*atan(1.0) - fs=NSPS*12000.0/NSPS0 !Sample rate - dt=1.0/fs !Sample interval (s) - tt=NSPS*dt !Duration of "itone" symbols (s) - ts=2*NSPS*dt !Duration of OQPSK symbols (s) - baud=1.0/tt !Keying rate for "itone" symbols (baud) - txt=NZ*dt !Transmission length (s) - - do i=1,32 !Half-sine pulse shape - pp(i)=sin(0.5*(i-1)*twopi/(32)) - enddo - n8=z'cbf089223a51' - do i=1,48 - isync(i)=-1 - if(iand(n8,1).eq.1) isync(i)=1 - n8=n8/2 - enddo - -! Define array id() for sync symbols - id=0 - do j=1,48 !First group of 48 - id(2*j-1)=2*isync(j) - enddo - do j=1,13 !Barker 13 code - id(j+96)=2*ib13(j) - enddo - do j=1,48 !Second group of 48 - id(2*j+109)=2*isync(j) - enddo - - csync=0. - do j=1,205 - if(abs(id(j)).eq.2) then - ia=nint((j-0.5)*N2) - ib=ia+N2-1 - csync(ia:ib)=pp*id(j)/abs(id(j)) - endif - enddo - - do ifile=iarg,nargs - call getarg(ifile,infile) - open(10,file=infile,status='old',access='stream') - j1=index(infile,'.c5') - j2=index(infile,'.wav') - if(j1.gt.0) then - read(10,end=999) fname,ntrmin,fMHz,c400 - 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 wspr5_downsample(iwave,c400) - else - print*,'Wrong file format?' - go to 999 - endif - close(10) - - fa=100.0 - fb=150.0 - fs400=400.0 - call getfc1(c400,fs400,fa,fb,fc1,xsnr) !First approx for freq - npeaks=5 - call getfc2(c400,npeaks,fs400,fc1,fpks) !Refined freq -! do idf=1,npeaks ! consider the top npeak peaks - do idf=1,1 ! for genie-aided sync - fc1=125.0 ! genie provided - fc2=0.0 ! from the genie -! fc2=fpks(idf) - call downsample(c400,fc1+fc2,cd) - s2=sum(cd*conjg(cd))/(16*412) - cd=cd/sqrt(s2) - do is=0,0 ! dt search range is zeroed for genie-aided sync - idt=is/2 - if( mod(is,2).eq. 1 ) idt=-(is+1)/2 - xdt=real(22+idt)/22.222 - 1.0 - ca=cshift(cd,22+idt) - zzsum=0.0 - do iseq=1,4,3 - if(iseq.eq.4) then - k=1-2*3 - nseq=9 - istep=3*4 - else - k=1-2*iseq - nseq=iseq*3 - istep=iseq*4 - endif -icc=1 - do i=1,408,istep - j=(i+1)*16 - if(iseq.eq.4) then -! phase=-1.18596900 -! For now, average complex corr. coeffs over the entire frame to -! estimate phase - phase=atan2(imag(zzsum),real(zzsum)) - k=k+3*2 - call mskcohdet(nseq,ca(j),pp,id(k),softbits,phase) - else - k=k+iseq*2 - call mskseqdet(nseq,ca(j),pp,id(k),softbits,1,zz) - cc(icc)=zz -write(32,*) icc,real(cc(icc)),imag(cc(icc)) - icc=icc+1 - zzsum=zzsum+zz - endif - sbits(i+1)=softbits(1) - sbits(i+2)=softbits(2) - if( id(k+1) .ne. 0 ) sbits(i+2)=id(k+1)*25 - sbits(i+3)=softbits(3) - if( iseq .ge. 2 ) then - sbits(i+5)=softbits(4) - sbits(i+6)=softbits(5) - if( id(k+3) .ne. 0 ) sbits(i+6)=id(k+3)*25 - sbits(i+7)=softbits(6) - if( iseq .ge. 3 ) then - sbits(i+9)=softbits(7) - sbits(i+10)=softbits(8) - if( id(k+5) .ne. 0 ) sbits(i+10)=id(k+5)*25 - sbits(i+11)=softbits(9) - endif - endif - enddo - -cm=0.0 -do idel=-200,200 - df=idel*0.001 -! dpha=twopi*df*12.0*(16/22.0) - dpha=twopi*df*4.0*(16/22.0) - phase=0.0 - zzsum=0.0 - do i=1,102 - cfac=cmplx(cos(phase),sin(phase)) - zzsum=zzsum+cc(i)*cfac - phase=mod(phase+dpha,twopi) - enddo - if(abs(zzsum).gt.cm) then - cm=abs(zzsum) - dfbest=df - endif -! write(*,*) df,abs(zzsum) -enddo -write(*,*) 'dfbest ',dfbest -write(*,*) 'final estimated frequency is: ',fc1+fc2+dfbest - j=1 - do i=1,205 - if( abs(id(i)) .ne. 2 ) then - rxdata(j)=sbits(2*i-1) - j=j+1 - endif - enddo - do i=1,204 - rxdata(j)=sbits(2*i) - j=j+1 - enddo - rxav=sum(rxdata)/ND - rx2av=sum(rxdata*rxdata)/ND - rxsig=sqrt(rx2av-rxav*rxav) - rxdata=rxdata/rxsig - sigma=1.20 - llr=2*rxdata/(sigma*sigma) - apmask=0 - max_iterations=40 - - ifer=0 - call bpdecode300(llr,apmask,max_iterations,decoded,niterations,cw) -! niterations will be equal to the Hamming distance between hard received word and the codeword - nhardmin=0 - if(niterations.lt.0) call osd300(llr,apmask,5,decoded,cw,nhardmin,dmin) - if(nhardmin.gt.0) niterations=nhardmin - nbadcrc=0 - call chkcrc10(decoded,nbadcrc) - if(nbadcrc.ne.0) ifer=1 - - if( ifer.eq.0 ) then - write(cbits,1200) decoded(1:50) -1200 format(50i1) - read(cbits,1202) idat -1202 format(6b8,b2) - idat(7)=ishft(idat(7),6) - call wqdecode(idat,message,itype) - nsnr=nint(xsnr) -! freq=fMHz + 1.d-6*(fc1+fc2) - freq=fc1+fc2 - nfdot=0 - write(13,1210) datetime,0,nsnr,xdt,freq,message,nfdot -1210 format(a11,2i4,f6.2,f12.7,2x,a22,i3) - write(*,1212) datetime(8:11),nsnr,xdt,freq,nfdot,message,'*',idf,nseq,is,iseq,niterations -!1212 format(a4,i4,f5.1,f11.6,i3,2x,a22,a1,i3,i3,i3,i4) -1212 format(a4,i4,f8.3,f8.3,i3,2x,a22,a1,i3,i3,i3,i3,i4) - goto 888 - endif - enddo !iseq - enddo - enddo -888 continue - enddo - - write(*,1120) -1120 format("") - -999 end program wspr5d - -subroutine getmetric(ib,ps,xmet) - real ps(0:511) - xm1=0 - xm0=0 - do i=0,511 - 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 getmetric - -subroutine mskseqdet(ns,cdat,pp,bsync,softbits,ncoh,zz) -! -! Detect sequences of 3, 6, or 9 bits (ns). -! Sync bits are assumed to be known. -! -complex cdat(16*12),cbest(16*12),cideal(16*12) -complex cdf(16*12),cfac,zz -real cm(0:511),cmbest(0:511) -real pp(32),softbits(9) -integer bit(13),bestbits(13),sgn(13) -integer bsync(7) - -twopi=8.0*atan(1.0) -dt=30.0*18.0/12000.0 -cmax=0; -fbest=0.0; -np=2**ns-1 -idfmax=40 -if( ncoh .eq. 1 ) idfmax=0 -do idf=0,idfmax - if( mod(idf,2).eq.0 ) deltaf=idf/2*0.02 - if( mod(idf,2).eq.1 ) deltaf=-(idf+1)/2*0.02 - dphi=twopi*deltaf*dt - cfac=cmplx(cos(dphi),sin(dphi)) - cdf=1.0 - do i=2,16*(ns-1) - cdf(i)=cdf(i-1)*cfac - enddo - - cm=0 - ibflag=0 - do i=0,np - bit(1)=(bsync(1)+2)/4 - bit(2)=iand(i/(2**(ns-1)),1) - bit(3)=iand(i/(2**(ns-2)),1) - if( bsync(2).ne.0 ) then ! force the barker bits - bit(3)=(bsync(2)+2)/4 - endif - bit(4)=iand(i/(2**(ns-3)),1) - bit(5)=(bsync(3)+2)/4 - - if( ns .ge. 6 ) then - bit(6)=iand(i/(2**(ns-4)),1) - bit(7)=iand(i/(2**(ns-5)),1) - if( bsync(4).ne.0 ) then ! force the barker bits - bit(7)=(bsync(4)+2)/4 - endif - bit(8)=iand(i/(2**(ns-6)),1) - bit(9)=(bsync(5)+2)/4 - if( ns .eq. 9 ) then - bit(10)=iand(i/4,1) - bit(11)=iand(i/2,1) - if( bsync(6).ne.0 ) then ! force the barker bits - bit(11)=(bsync(6)+2)/4 - endif - bit(12)=iand(i/1,1) - bit(13)=(bsync(7)+2)/4 - endif - endif - - sgn=2*bit-1 - cideal(1:16) =cmplx(sgn(1)*pp(17:32),sgn(2)*pp(1:16)) - cideal(17:32) =cmplx(sgn(3)*pp(1:16),sgn(2)*pp(17:32)) - cideal(33:48) =cmplx(sgn(3)*pp(17:32),sgn(4)*pp(1:16)) - cideal(49:64) =cmplx(sgn(5)*pp(1:16),sgn(4)*pp(17:32)) - if( ns .ge. 6 ) then - cideal(65:80) =cmplx(sgn(5)*pp(17:32),sgn(6)*pp(1:16)) - cideal(81:96) =cmplx(sgn(7)*pp(1:16),sgn(6)*pp(17:32)) - cideal(97:112) =cmplx(sgn(7)*pp(17:32),sgn(8)*pp(1:16)) - cideal(113:128)=cmplx(sgn(9)*pp(1:16),sgn(8)*pp(17:32)) - if( ns .eq. 9 ) then - cideal(129:144) =cmplx(sgn(9)*pp(17:32),sgn(10)*pp(1:16)) - cideal(145:160) =cmplx(sgn(11)*pp(1:16),sgn(10)*pp(17:32)) - cideal(161:176) =cmplx(sgn(11)*pp(17:32),sgn(12)*pp(1:16)) - cideal(177:192)=cmplx(sgn(13)*pp(1:16),sgn(12)*pp(17:32)) - endif - endif - cideal=cideal*cdf - cm(i)=abs(sum(cdat(1:64*ns/3)*conjg(cideal(1:64*ns/3))))/1.e3 - if( cm(i) .gt. cmax ) then - ibflag=1 - cmax=cm(i) - bestbits=bit - cbest=cideal - fbest=deltaf - zz=sum(cdat(1:64*ns/3)*conjg(cbest(1:64*ns/3)))/1.e3 - endif - enddo - if( ibflag .eq. 1 ) then ! new best found - cmbest=cm - endif -enddo -softbits=0.0 -call getmetric(1,cmbest,softbits(ns)) -call getmetric(2,cmbest,softbits(ns-1)) -call getmetric(4,cmbest,softbits(ns-2)) -if( ns .ge. 6 ) then - call getmetric(8,cmbest,softbits(ns-3)) - call getmetric(16,cmbest,softbits(ns-4)) - call getmetric(32,cmbest,softbits(ns-5)) - if( ns .eq. 9 ) then - call getmetric(64,cmbest,softbits(3)) - call getmetric(128,cmbest,softbits(2)) - call getmetric(256,cmbest,softbits(1)) - endif -endif -end subroutine mskseqdet - -subroutine mskcohdet(ns,cdat,pp,bsync,softbits,phase) -! -! Coherent demodulate blocks of 9 bits (ns). -! - complex cdat(16*12),crot(16*12) - real pp(32),softbits(9) - - np=2**ns-1 - - softbits=0.0 - crot=cdat*cmplx(cos(phase),-sin(phase)) - softbits(1)=sum(imag(crot(1:32)*pp)) - softbits(2)=sum(real(crot(17:48)*pp)) - softbits(3)=sum(imag(crot(33:64)*pp)) - softbits(4)=sum(imag(crot(65:96)*pp)) - softbits(5)=sum(real(crot(81:112)*pp)) - softbits(6)=sum(imag(crot(97:128)*pp)) - softbits(7)=sum(imag(crot(129:160)*pp)) - softbits(8)=sum(real(crot(145:176)*pp)) - softbits(9)=sum(imag(crot(161:192)*pp)) - softbits=softbits/64. -end subroutine mskcohdet - -subroutine downsample(ci,f0,co) - parameter(NI=412*288,NO=NI/18) - complex ci(0:NI-1),ct(0:NI-1) - complex co(0:NO-1) - - df=400.0/NI - ct=ci - call four2a(ct,NI,1,-1,1) !c2c FFT to freq domain - i0=nint(f0/df) - co=0.0 - co(0)=ct(i0) -! b=3.0 !optimized for sequence detection - b=6.0 - do i=1,NO/2 - arg=(i*df/b)**2 - filt=exp(-arg) - co(i)=ct(i0+i)*filt - co(NO-i)=ct(i0-i)*filt - enddo - co=co/NO - call four2a(co,NO,1,1,1) !c2c FFT back to time domain - return -end subroutine downsample - -subroutine getfc1(c,fs,fa,fb,fc1,xsnr) - -! include 'wsprlf_params.f90' - parameter (NZ=288*412) - parameter (NSPS=288) - parameter (N2=2*NSPS) - parameter (NFFT1=16*NSPS) - parameter (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/N2 - 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) - xsnr=xsnr+5.0 - return -end subroutine getfc1 - -subroutine getfc2(c,npeaks,fs,fc1,fpks) - -! include 'wsprlf_params.f90' - parameter (NZ=288*412) - parameter (NSPS=288) - parameter (N2=2*NSPS) - parameter (NFFT1=16*NSPS) - parameter (NH1=NFFT1/2) - - complex c(0:NZ-1) !Complex waveform - complex cs(0:NZ-1) !For computing spectrum - 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 -! do i=1,NZ/2 -! filt=1/(1+((i*df)**2/(0.50*baud)**2)**8) -! cs(i)=cs(i)*filt -! cs(NZ+1-i)=cs(NZ+1-i)*filt -! enddo - 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) - ja=nint(0.5*baud/df) - k=1 - sp2=0.0 - 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-2) - ipk1=min(413,ipk+2) -! ipk0=ipk -! ipk1=ipk - sp2(ipk0:ipk1)=0.0 - enddo - return -end subroutine getfc2 diff --git a/lib/fsk4hf/wspr5sim.f90 b/lib/fsk4hf/wspr5sim.f90 deleted file mode 100644 index 5c2147b96..000000000 --- a/lib/fsk4hf/wspr5sim.f90 +++ /dev/null @@ -1,111 +0,0 @@ -program wspr5sim - -! Generate simulated data for a 5-minute "WSPR-LF" mode. Output is saved -! to a *.c5 or *.wav file. - - use wavhdr - include 'wsprlf_params.f90' !Set various constants - parameter (NMAX=300*12000) - type(hdr) h !Header for .wav file - character arg*12,fname*16 - character msg*22,msgsent*22 - complex c0(0:NZ-1) - complex c(0:NZ-1) - real*8 fMHz - integer itone(NN) - integer*2 iwave(NMAX) !Generated full-length waveform - -! Get command-line argument(s) - nargs=iargc() - if(nargs.ne.8) then - print*,'Usage: wspr5sim "message" f0 DT fsp del nwav nfiles snr' - print*,'Example: wspr5sim "K1ABC FN42 30" 50 0.0 0.1 1.0 1 10 -33' - go to 999 - endif - call getarg(1,msg) !Message to be transmitted - call getarg(2,arg) - read(arg,*) f0 !Freq relative to WSPR-band center (Hz) - 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,*) nwav !1 for *.wav file, 0 for *.c5 file - call getarg(7,arg) - read(arg,*) nfiles !Number of files - call getarg(8,arg) - read(arg,*) snrdb !SNR_2500 - - twopi=8.0*atan(1.0) - fs=12000.0/NDOWN !Sample rate - dt=1.0/fs !Sample interval (s) - tt=NSPS*dt !Duration of "itone" symbols (s) - ts=2*NSPS*dt !Duration of OQPSK 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) - sig=sqrt(bandwidth_ratio) * 10.0**(0.05*snrdb) - if(snrdb.gt.90.0) sig=1.0 - txt=NN*NSPS0/12000.0 - - call genwspr5(msg,msgsent,itone) !Encode the message, get itone - write(*,1000) f0,xdt,txt,snrdb,fspread,delay,nfiles,msgsent -1000 format('f0:',f9.3,' DT:',f6.2,' txt:',f6.1,' SNR:',f6.1, & - ' fspread:',f6.1,' delay:',f6.1,' nfiles:',i3,2x,a22) - - dphi0=twopi*(f0-0.25*baud)*dt - dphi1=twopi*(f0+0.25*baud)*dt - phi=0.0 - c0=0. - k=-1 + nint(xdt/dt) - do j=1,NN !Generate OQPSK waveform from itone - dphi=dphi0 - if(itone(j).eq.1) dphi=dphi1 - if(k.eq.0) phi=-dphi - do i=1,NSPS - k=k+1 - phi=phi+dphi - if(phi.gt.twopi) phi=phi-twopi - xphi=phi - if(k.ge.0 .and. k.lt.NZ) c0(k)=cmplx(cos(xphi),sin(xphi)) - enddo - enddo - - call sgran() - do ifile=1,nfiles - c=c0 - if(nwav.eq.0) then - if( fspread .ne. 0.0 .or. delay .ne. 0.0 ) then - call watterson(c,NZ,fs,delay,fspread) - endif - c=c*sig - if(snrdb.lt.90) then - do i=0,NZ-1 !Add gaussian noise at specified SNR - xnoise=gran() - ynoise=gran() - c(i)=c(i) + cmplx(xnoise,ynoise) - enddo - endif - write(fname,1100) ifile -1100 format('000000_',i4.4,'.c5') - open(10,file=fname,status='unknown',access='stream') - fMHz=10.1387d0 - nmin=5 - write(10) fname,nmin,fMHz,c !Save to *.c5 file - close(10) - else - call wspr5_wav(baud,xdt,f0,itone,snrdb,iwave) - h=default_header(12000,NMAX) - write(fname,1102) ifile -1102 format('000000_',i4.4,'.wav') - open(10,file=fname,status='unknown',access='stream') - write(10) h,iwave !Save to *.wav file - close(10) - endif - write(*,1110) ifile,xdt,f0,snrdb,fname -1110 format(i4,f7.2,f8.2,f7.1,2x,a16) - enddo - -999 end program wspr5sim diff --git a/lib/fsk4hf/wspr_fsk8_downsample.f90 b/lib/fsk4hf/wspr_fsk8_downsample.f90 deleted file mode 100644 index 9750e0cbc..000000000 --- a/lib/fsk4hf/wspr_fsk8_downsample.f90 +++ /dev/null @@ -1,27 +0,0 @@ -subroutine wspr_fsk8_downsample(iwave,c) - -! Input: i*2 data in iwave() at sample rate 12000 Hz -! Output: Complex data in c(), sampled at 12000/24=500 Hz - - include 'wspr_fsk8_params.f90' - integer*2 iwave(NMAX) - complex c(0:NMAXD-1) - complex c1(0:NMAXD-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,NMAXD/2 - c1(i)=cx(i0+i) - c1(NMAXD-i)=cx(i0-i) - enddo - c=c1/NMAXD - call four2a(c,NMAXD,1,1,1) !c2c FFT back to time domain - - return -end subroutine wspr_fsk8_downsample diff --git a/lib/fsk4hf/wspr_fsk8_params.f90 b/lib/fsk4hf/wspr_fsk8_params.f90 deleted file mode 100644 index c080f0296..000000000 --- a/lib/fsk4hf/wspr_fsk8_params.f90 +++ /dev/null @@ -1,14 +0,0 @@ -! LDPC (300,60) code -parameter (NDOWN=24) !Downsample factor -parameter (KK=60) !Information bits (50 + CRC10) -parameter (ND=100) !Data symbols -parameter (NS=14) !Sync symbols (2 @ Costas 7x7) -parameter (NN=NS+ND) !Total symbols (114) -parameter (NSPS0=24576) !Samples per symbol at 12000 S/s -parameter (NSPS=NSPS0/NDOWN) !Sam/sym, downsampled (1024) -parameter (N7=7*NSPS) !Samples in Costas 7x7 array (7168) -parameter (NZ=NSPS*NN) !Samples in downsampled waveform (116,736) -parameter (NMAX=240*12000) !Samples in iwave() -parameter (NMAXD=NMAX/24) !Samples in c(), after downsampling -parameter (NFFT1=4*NSPS,NH1=NFFT1/2) -parameter (NH2=NSPS/2) diff --git a/lib/fsk4hf/wspr_fsk8_sim.f90 b/lib/fsk4hf/wspr_fsk8_sim.f90 deleted file mode 100644 index 40d808a0b..000000000 --- a/lib/fsk4hf/wspr_fsk8_sim.f90 +++ /dev/null @@ -1,107 +0,0 @@ -program wspr_fsk8_sim - -! Generate simulated data for a 4-minute "WSPR-LF" mode using 8-FSK. -! Output is saved to a *.wav file. - - use wavhdr - include 'wspr_fsk8_params.f90' !Set various constants - type(hdr) h !Header for .wav file - character arg*12,fname*16 - character msg*22,msgsent*22 - complex c0(0:NZ-1) - complex c(0:NZ-1) - real*8 fMHz - integer itone(NN) - integer*2 iwave(NMAX) !Generated full-length waveform - -! Get command-line argument(s) - nargs=iargc() - if(nargs.ne.8) then - print*,'Usage: wspr5sim "message" f0 DT fsp del nwav nfiles snr' - print*,'Example: wspr5sim "K1ABC FN42 30" 50 0.0 0.1 1.0 1 10 -33' - go to 999 - endif - call getarg(1,msg) !Message to be transmitted - call getarg(2,arg) - read(arg,*) f0 !Freq relative to WSPR-band center (Hz) - 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,*) nwav !1 for *.wav file, 0 for *.c4 file - call getarg(7,arg) - read(arg,*) nfiles !Number of files - call getarg(8,arg) - read(arg,*) snrdb !SNR_2500 - - twopi=8.0*atan(1.0) - fs=12000.0/NDOWN !Sample rate after downsampling - dt=1.0/fs !Sample interval (s) - tt=NSPS*dt !Duration of symbols (s) - baud=1.0/tt !Keying rate - bw=8*baud - txt=NZ*dt !Transmission length (s) - bandwidth_ratio=2500.0/(fs/2.0) - sig=sqrt(bandwidth_ratio) * 10.0**(0.05*snrdb) - if(snrdb.gt.90.0) sig=1.0 - txt=NN*NSPS0/12000.0 - - call genwspr_fsk8(msg,msgsent,itone) !Encode the message, get itone - write(*,1000) f0,xdt,txt,snrdb,bw,msgsent -1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, & - ' BW:',f4.1,2x,a22) - - - phi=0.0 - c0=0. - k=-1 + nint(xdt/dt) - do j=1,NN !Generate OQPSK waveform from itone - dphi=twopi*(f0+itone(j)*baud)*dt - if(k.eq.0) phi=-dphi - do i=1,NSPS - k=k+1 - phi=phi+dphi - if(phi.gt.twopi) phi=phi-twopi - xphi=phi - if(k.ge.0 .and. k.lt.NZ) c0(k)=cmplx(cos(xphi),sin(xphi)) - enddo - enddo - - call sgran() - do ifile=1,nfiles - if(nwav.eq.0) then - c=c0 - if( fspread .ne. 0.0 .or. delay .ne. 0.0 ) then - call watterson(c,NZ,fs,delay,fspread) - endif - c=c*sig - if( snrdb.lt.90) then - do i=0,NZ-1 - xnoise=gran() - ynoise=gran() - c(i)=c(i)+cmplx(xnoise,ynoise) - enddo - endif - write(fname,1100) ifile -1100 format('000000_',i4.4,'.c4') - open(10,file=fname,status='unknown',access='stream') - fMHz=1.866d0 - nmin=4 - write(10) fname,nmin,fMHz,c - else - call wspr_fsk8_wav(baud,xdt,f0,itone,snrdb,iwave) - h=default_header(12000,NMAX) - write(fname,1102) ifile -1102 format('000000_',i4.4,'.wav') - open(10,file=fname,status='unknown',access='stream') - write(10) h,iwave !Save to *.wav file - close(10) - endif - write(*,1110) ifile,xdt,f0,snrdb,fname -1110 format(i4,f7.2,f8.2,f7.1,2x,a16) - enddo - -999 end program wspr_fsk8_sim diff --git a/lib/fsk4hf/wspr_fsk8_wav.f90 b/lib/fsk4hf/wspr_fsk8_wav.f90 deleted file mode 100644 index 3b0a0ff38..000000000 --- a/lib/fsk4hf/wspr_fsk8_wav.f90 +++ /dev/null @@ -1,44 +0,0 @@ -subroutine wspr_fsk8_wav(baud,xdt,f0,itone,snrdb,iwave) - -! Generate iwave() from itone(). - - include 'wspr_fsk8_params.f90' - integer itone(NN) - integer*2 iwave(NMAX) - real*8 twopi,dt,dphi,phi - real dat(NMAX) - - twopi=8.d0*atan(1.d0) - dt=1.d0/12000.d0 - - dat=0. - if(snrdb.lt.90) then - do i=1,NMAX - dat(i)=gran() !Generate gaussian noise, rms = 1.0 - enddo - bandwidth_ratio=2500.0/6000.0 - sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*snrdb) - else - sig=1.0 - endif - - phi=0.d0 - k=nint((xdt+1.0)/dt) - do j=1,NN - dphi=twopi*(f0+ itone(j)*baud)*dt - if(k.eq.0) phi=-dphi - do i=1,NSPS0 - k=k+1 - phi=phi+dphi - if(phi.gt.twopi) phi=phi-twopi - xphi=phi - if(k.gt.0 .and. k.le.NMAX) dat(k)=dat(k) + sig*sin(xphi) - enddo - enddo - fac=32767.0 - rms=100.0 - if(snrdb.ge.90.0) iwave=nint(fac*dat) - if(snrdb.lt.90.0) iwave=nint(rms*dat) - - return -end subroutine wspr_fsk8_wav diff --git a/lib/fsk4hf/wspr_fsk8d.f90 b/lib/fsk4hf/wspr_fsk8d.f90 deleted file mode 100644 index 1f69c4402..000000000 --- a/lib/fsk4hf/wspr_fsk8d.f90 +++ /dev/null @@ -1,197 +0,0 @@ -program wspr_fsk8d - -! WSPR-LF is a potential WSPR-like mode intended for use at LF and MF. -! This version uses 4-minute T/R sequences, an LDPC (300,60) code, -! 8-FSK modulation, and noncoherent demodulation. This decoder reads -! data from *.wav files. - -! Reception and Demodulation algorithm: -! 1. Compute coarse spectrum; find fc1 = approx carrier freq -! 2. Mix from fc1 to 0; LPF at +/- 0.75*R -! 3. Find two 7x7 Costas arrays to get xdt and fc2 -! 4. Mix from fc2 to 0, compute aligned symbol spectra -! 5. Get soft bits from symbol spectra - -! Still to do: find and decode more than one signal in the specified passband. - - include 'wspr_fsk8_params.f90' - character arg*8,message*22,cbits*50,infile*80,fname*16,datetime*11 - character*120 data_dir - complex csync(0:N7-1) !Sync symbols for Costas 7x7 array - complex c1(0:2*N7-1) - complex c2(0:2*N7-1) - complex c(0:NMAXD-1) !Complex waveform - real*8 fMHz - real rxdata(3*ND),llr(3*ND) !Soft symbols - real a(5) !For twkfreq1 - real s(0:NH2,NN) - real savg(0:NH2) - real ss(0:N7) - real ss0(0:N7) - real ps(0:7) - integer ihdr(11) - integer*2 iwave(NMAX) !Generated full-length waveform - integer*1 idat(7) - integer*1 decoded(KK),apmask(3*ND),cw(3*ND) - integer icos7(0:6) - data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern - - nargs=iargc() - if(nargs.lt.7) then - print*,'Usage: wspr_fsk8d -d db -f fMHz -a data_dir file1 [file2 ...]' - go to 999 - endif - call getarg(1,arg) - if(arg(1:3).ne.'-d ') go to 999 - call getarg(2,arg) - read(arg,*) degrade - rxbw=3000. - - call getarg(3,arg) - if(arg(1:3).ne.'-f ') go to 999 - call getarg(4,arg) - read(arg,*) fMHz - - call getarg(5,arg) - if(arg(1:3).ne.'-a ') go to 999 - call getarg(6,data_dir) - - open(13,file=trim(data_dir)//'/ALL_WSPR.TXT',status='unknown', & - position='append') - - twopi=8.0*atan(1.0) - fs=NSPS*12000.0/NSPS0 !Sample rate after downsampling (Hz) - dt=1.0/fs !Sample interval (s) - ts=NSPS*dt !Symbol duration (s) - baud=1.0/ts !Keying rate (Hz) - txt=NZ*dt !Transmission length (s) - - phi=0. - k=-1 - do j=0,6 - dphi=twopi*baud*icos7(j)*dt - do i=1,NSPS - phi=phi+dphi - if(phi.gt.twopi) phi=phi-twopi - k=k+1 - csync(k)=cmplx(cos(phi),sin(phi)) - enddo - enddo - - do ifile=7,nargs - call getarg(ifile,infile) - open(10,file=infile,status='old',access='stream') - j1=index(infile,'.c4') - j2=index(infile,'.wav') - if(j1.gt.0) then - read(10,end=999) fname,ntrmin,fMHz,c(0:NZ-1) - 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) - if(degrade.gt.0.0) call degrade_snr(iwave,NMAX,degrade,rxbw) - call wspr_fsk8_downsample(iwave,c) - else - print*,'Wrong file format?' - go to 999 - endif - close(10) - pmax=0. - df1=fs/(2*N7) - ia=nint(100.0/df1) - ib=nint(150.0/df1) - ipk=0 - jpk=0 -! Get xdt and f0 from the sync arrays - do j0=0,1000,50 - j0b=j0+107*NSPS - c1(0:N7-1)=c(j0:j0+N7-1)*conjg(csync) - c1(N7:)=0. - c2(0:N7-1)=c(j0b:j0b+N7-1)*conjg(csync) - c2(N7:)=0. - call four2a(c1,2*N7,1,-1,1) - call four2a(c2,2*N7,1,-1,1) - do i=0,N7 - p=1.e-9*(real(c1(i))**2 + aimag(c1(i))**2 + & - real(c2(i))**2 + aimag(c2(i))**2) - ss(i)=p - enddo - do i=ia,ib - p=ss(i) - if(p.gt.pmax) then - pmax=p - ipk=i - jpk=j0 - endif - enddo - if(jpk.eq.j0) ss0=ss - enddo - f0=ipk*df1 - xdt=jpk*dt - 1.0 - - sp3n=(ss0(ipk-1)+ss0(ipk)+ss0(ipk+1)) !Sig + 3*noise - call pctile(ss0,N7,45,base) - psig=sp3n-3*base !Sig only - pnoise=(2500.0/df1)*base !Noise in 2500 Hz - xsnr=db(psig/pnoise) !SNR from sync tones - - if(jpk.ge.0) c(0:NMAXD-1-jpk)=c(jpk:NMAXD-1) - - a(1)=-f0 - a(2:5)=0. - call twkfreq1(c,NZ,fs,a,c) !Mix from f0 down to 0 - call spec8(c,s,savg) !Get symbol spectra - - do j=1,ND - k=j+7 - ps=s(0:7,k) - ps=sqrt(ps) !### ??? ### -! ps=log(ps) - r1=max(ps(1),ps(3),ps(5),ps(7))-max(ps(0),ps(2),ps(4),ps(6)) - r2=max(ps(2),ps(3),ps(6),ps(7))-max(ps(0),ps(1),ps(4),ps(5)) - r4=max(ps(4),ps(5),ps(6),ps(7))-max(ps(0),ps(1),ps(2),ps(3)) - rxdata(3*j-2)=r4 - rxdata(3*j-1)=r2 - rxdata(3*j)=r1 - enddo - - rxav=sum(rxdata)/ND - rx2av=sum(rxdata*rxdata)/ND - rxsig=sqrt(rx2av-rxav*rxav) - rxdata=rxdata/rxsig - s0=1.1 - llr=2.0*rxdata/(s0*s0) - apmask=0 - max_iterations=40 - ifer=0 - call bpdecode300(llr,apmask,max_iterations,decoded,niterations,cw) - if(niterations.lt.0) call osd300(llr,apmask,5,decoded,cw,nhardmin,dmin) - if(nhardmin.ge.0) niterations=nhardmin - nbadcrc=0 - if(niterations.ge.0) call chkcrc10(decoded,nbadcrc) - if(niterations.lt.0 .or. nbadcrc.ne.0) ifer=1 - nsnr=nint(xsnr) -! freq=fMHz + 1.d-6*f0 - freq=1.d-6*(f0+1500) - nfdot=0 - message=' ' - if(ifer.eq.0) then - write(cbits,1100) decoded(1:50) -1100 format(50i1) - read(cbits,1102) idat -1102 format(6b8,b2) - idat(7)=ishft(idat(7),6) - call wqdecode(idat,message,itype) - write(*,1112) datetime(8:11),nsnr,xdt,freq,nfdot,message -1112 format(a4,i4,f5.1,f11.6,i3,2x,a22) - endif - write(13,1110) datetime,0,nsnr,xdt,freq,message,nfdot -1110 format(a11,2i4,f6.2,f12.7,2x,a22,i3) - enddo ! ifile loop - write(*,1120) -1120 format("") - -999 end program wspr_fsk8d - diff --git a/lib/fsk4hf/wspr_params.f90 b/lib/fsk4hf/wspr_params.f90 deleted file mode 100644 index 18feaea2f..000000000 --- a/lib/fsk4hf/wspr_params.f90 +++ /dev/null @@ -1,23 +0,0 @@ - parameter (NN=162) - parameter (NSPS0=8192) !Samples per symbol at 12000 S/s - parameter (NDOWN=32) - parameter (NSPS=NSPS0/NDOWN) - parameter (NZ=NSPS*NN) !Samples in waveform at 12000 S/s - parameter (NZ0=NSPS0*NN) !Samples in waveform at 375 S/s - parameter (NMAX=120*12000) !Samples in waveform at 375 S/s - -! Define the sync vector: - integer*1 sync(162) - data sync/ & - 1,1,0,0,0,0,0,0,1,0,0,0,1,1,1,0,0,0,1,0, & - 0,1,0,1,1,1,1,0,0,0,0,0,0,0,1,0,0,1,0,1, & - 0,0,0,0,0,0,1,0,1,1,0,0,1,1,0,1,0,0,0,1, & - 1,0,1,0,0,0,0,1,1,0,1,0,1,0,1,0,1,0,0,1, & - 0,0,1,0,1,1,0,0,0,1,1,0,1,0,1,0,0,0,1,0, & - 0,0,0,0,1,0,0,1,0,0,1,1,1,0,1,1,0,0,1,1, & - 0,1,0,0,0,1,1,1,0,0,0,0,0,1,0,1,0,0,1,1, & - 0,0,0,0,0,0,0,1,1,0,1,0,1,1,0,0,0,1,1,0, & - 0,0/ - - - diff --git a/lib/fsk4hf/wspr_wav.f90 b/lib/fsk4hf/wspr_wav.f90 deleted file mode 100644 index 188242bbc..000000000 --- a/lib/fsk4hf/wspr_wav.f90 +++ /dev/null @@ -1,49 +0,0 @@ -subroutine wspr_wav(baud,xdt,h,f0,itone,snrdb,iwave) - -! Generate iwave() from itone(). - - include 'wspr_params.f90' - integer itone(NN) - integer*2 iwave(NMAX) - real*8 twopi,dt,dphi0,dphi1,dphi,phi - real dat(NMAX) - - twopi=8.d0*atan(1.d0) - dt=1.d0/12000.d0 - baud=375.0/256.0 - - dat=0. - if(snrdb.lt.90) then - do i=1,NMAX - dat(i)=gran() !Generate gaussian noise - enddo - bandwidth_ratio=2500.0/6000.0 - sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*snrdb) - else - sig=1.0 - endif - - phi=0.d0 - k=nint(xdt/dt) - do j=1,NN - dphi=twopi*(f0+h*(itone(j)-1.5)*baud)*dt - do i=1,NSPS0 - k=k+1 - phi=mod(phi+dphi,twopi) - if(k.gt.0 .and. k.le.NMAX) dat(k)=dat(k) + sig*sin(phi) - enddo - enddo - - rms=100.0 - if(snrdb.lt.90.0) then - dat=rms*dat; - if(maxval(abs(dat)).gt.32767.0) print*,"Warning - data will be clipped." - else - datpk=maxval(abs(dat)) - fac=32767.9/datpk - dat=fac*dat - endif - iwave=nint(dat) - - return -end subroutine wspr_wav diff --git a/lib/fsk4hf/wsprcpm_params.f90 b/lib/fsk4hf/wsprcpm_params.f90 deleted file mode 100644 index b09ed86e7..000000000 --- a/lib/fsk4hf/wsprcpm_params.f90 +++ /dev/null @@ -1,14 +0,0 @@ -parameter (KK=64) !Information bits (50 + CRC14) ? -parameter (ND=200) !Data symbols: LDPC (204,68), r=1/3, don't send last 4 bits -parameter (NS=16) !Sync symbols (16) -parameter (NN=NS+ND) !Total symbols (216) - -parameter (NSPS0=6400) !Samples per symbol at 12000 S/s - -parameter (NDOWN=32) !Downsample to 200 sa/symbol (375 Hz) for candidate selection -parameter (NSPS=NSPS0/NDOWN) !Samples per symbol -parameter (NZ=NSPS*NN) !Samples in baseband waveform - -parameter (NZ0=NSPS0*NN) !Samples in waveform at 12000 S/s -parameter (NFFT1=4*NSPS,NH1=NFFT1/2) - diff --git a/lib/fsk4hf/wsprcpm_wav.f90 b/lib/fsk4hf/wsprcpm_wav.f90 deleted file mode 100644 index 28665245c..000000000 --- a/lib/fsk4hf/wsprcpm_wav.f90 +++ /dev/null @@ -1,44 +0,0 @@ -subroutine wsprcpm_wav(baud,xdt,h,f0,itone,snrdb,iwave) - -! Generate iwave() from itone(). - - include 'wsprcpm_params.f90' - parameter (NMAX=120*12000) - integer itone(NN) - integer*2 iwave(NMAX) - real*8 twopi,dt,dphi0,dphi1,dphi,phi - real dat(NMAX) - - twopi=8.d0*atan(1.d0) - dt=1.d0/12000.d0 - - dat=0. - if(snrdb.lt.90) then - do i=1,NMAX - dat(i)=gran() !Generate gaussian noise - enddo - bandwidth_ratio=2500.0/6000.0 - sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*snrdb) - else - sig=1.0 - endif - - phi=0.d0 - k=nint(xdt/dt) - do j=1,NN - dphi=twopi*(f0+itone(j)*(h/2.0d0)*baud)*dt - do i=1,NSPS0 - k=k+1 - phi=phi+dphi - if(phi.gt.twopi) phi=phi-twopi - xphi=phi - if(k.gt.0 .and. k.le.NMAX) dat(k)=dat(k) + sig*sin(xphi) - enddo - enddo - fac=32767.0 - rms=100.0 - if(snrdb.ge.90.0) iwave=nint(fac*dat) - if(snrdb.lt.90.0) iwave=nint(rms*dat) - - return -end subroutine wsprcpm_wav diff --git a/lib/fsk4hf/wsprcpmd.f90 b/lib/fsk4hf/wsprcpmd.f90 deleted file mode 100644 index 455b53f41..000000000 --- a/lib/fsk4hf/wsprcpmd.f90 +++ /dev/null @@ -1,586 +0,0 @@ -program wsprcpmd - -! Decode WSPRCPM data read from *.c2 or *.wav files. - -! WSPRCPM is a WSPR-like mode based on full-response CPM. -! -! Currently configured to use (204,68) r=1/3 LDPC code, regular column weight 3. -! 50 data bits + 14 bit CRC + 4 "0" bits. The 4 "0" bits are unused bits that -! are not transmitted. At the decoder, these bits are treated as "AP" bits. -! This shortens the code to (200,64) r=0.32, slightly decreasing the code rate. -! -! Frame format is: -! d100 p32 d100 (232) channel symbols -! - use crc - include 'wsprcpm_params.f90' - parameter(NMAX=120*12000) - character arg*8,message*22,cbits*50,infile*80,fname*16,datetime*11 - character ch1*1,ch4*4,cseq*31 - character*22 decodes(100) - character*120 data_dir - character*32 uwbits - character*68 dmsg - complex c2(0:120*12000/32-1) !Complex waveform - complex cframe(0:216*200-1) !Complex waveform - complex cd(0:216*10-1) !Complex waveform - complex c1(0:9,0:1),c0(0:9,0:1) - complex ccor(0:1,216) - complex cp(0:1,0:1) - complex csum,cterm - real*8 fMHz - real rxdata(ND),llr(204) !Soft symbols - real sbits(216),sbits1(216),sbits3(216) - real ps(0:8191),psbest(0:8191) - real candidates(100,2) - integer iuniqueword0 - integer isync(200) !Unique word - integer isync2(216) -! integer ipreamble(16) !Preamble vector - integer isyncword(16) - integer ihdr(11) - integer*2 iwave(NMAX) !Generated full-length waveform - integer*1,target :: idat(9) - integer*1 decoded(68),apmask(204),cw(204) - integer*1 hbits(216),hbits1(216),hbits3(216) -! 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 cseq /'9D9F C48B 797A DD60 58CB 2EBC 6'/ - data iuniqueword0/z'30C9E8AD'/ - - k=0 - do i=1,31 - ch1=cseq(i:i) - if(ch1.eq.' ') cycle - read(ch1,'(z1)') n - write(ch4,'(b4.4)') n - do j=1,4 - k=k+1 - isync(k)=0 - if(ch4(j:j).eq.'1') isync(k)=1 - enddo - enddo - isync(101:200)=isync(1:100) - - fs=12000.0/NDOWN !Sample rate - 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) - h=0.50 !h=0.8 seems to be optimum for AWGN sensitivity (not for fading) - twopi=8.0*atan(1.0) - pi=4.0*atan(1.0) - - nargs=iargc() - if(nargs.lt.1) then - print*,'Usage: wsprcpmd [-a ] [-f fMHz] [-c ncoh] [-h h] 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 - if(arg(1:2).eq.'-h') then - call getarg(iarg+1,arg) - read(arg,*) h - iarg=iarg+2 - endif - - isync2(1:100)=isync(1:100) - isync2(101:116)=(/0,1,1,0,1,0,0,1,0,1,1,0,1,0,0,1/) - isync2(117:216)=isync(101:200) - -! data MSB -! data sync tone -! 0 0 0 -! 0 1 1 -! 1 0 2 -! 1 1 3 - - dphi=twopi*baud*(h/2.0)*dt*20 ! dt*10 is samp interval after downsample - do j=0,1 - if(j.eq.0) then - dphi0=-3*dphi - dphi1=+1*dphi - else - dphi0=-1*dphi - dphi1=+3*dphi - endif - phi0=0.0 - phi1=0.0 - do i=0,9 - c1(i,j)=cmplx(cos(phi1),sin(phi1)) - c0(i,j)=cmplx(cos(phi0),sin(phi0)) - phi1=mod(phi1+dphi1,twopi) - phi0=mod(phi0+dphi0,twopi) - enddo - cp(1,j)=cmplx(cos(phi1),sin(phi1)) - cp(0,j)=cmplx(cos(phi0),sin(phi0)) - enddo - - open(13,file=trim(data_dir)//'/ALL_WSPR.TXT',status='unknown', & - position='append') - - xs1=0.0 - xs2=0.0 - fr1=0.0 - fr2=0.0 - nav=0 - 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 wsprcpm_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 - nsync=16 - call getcandidate2(c2,npts,fs,fa,fb,ncand,candidates) !First approx for freq - ndecodes=0 - do icand=1,ncand - fc0=candidates(icand,1) - xsnr=candidates(icand,2) - xmax=-1e32 - do i=-7,7 - ft=fc0+i*0.2 - call noncoherent_frame_sync(c2,h,ft,isync2,is,xf1) - if(xf1.gt.xmax) then - xmax=xf1 - fc1=ft - is0=is - endif - enddo - fcest=fc1 - imode=0 ! refine freq - call coherent_sync(c2,h,isyncword,nsync,NSPS,is0,fcest,imode,xp0) - imode=1 ! refine istart - istart=is0 - call coherent_sync(c2,h,isyncword,nsync,NSPS,istart,fcest,imode,xp1) - write(*,'(i5,i5,i5,6(f11.5,2x))') ifile-2,is0,istart,fc0,fc1,fcest,xf1,xp0,xp1 - -!genie sync -!istart=375 -!fcest=0.0 - do ijitter=0,4 - io=-10*(ijitter/2+1) - if(mod(ijitter,2).eq.0) io=10*(ijitter/2) - ib=max(0,istart+io) - cframe=c2(ib:ib+216*200-1) - call downsample2(cframe,fcest,h,cd) - - s2=sum(cd*conjg(cd))/(10*216) - cd=cd/sqrt(s2) - - do nseq=1,5 - if( nseq.eq.1 ) then ! noncoherent single-symbol detection - sbits1=0.0 - do ibit=1,216 - j=isync2(ibit) - ib=(ibit-1)*10 - ccor(1,ibit)=sum(cd(ib:ib+9)*conjg(c1(0:9,j))) - ccor(0,ibit)=sum(cd(ib:ib+9)*conjg(c0(0:9,j))) - 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 - ps=0 - if( nseq.eq. 2 ) nbit=3 - if( nseq.eq. 3 ) nbit=5 - if( nseq.eq. 4 ) nbit=7 - if( nseq.eq. 5 ) nbit=9 - if( nseq.eq. 6 ) nbit=11 - if( nseq.eq. 7 ) nbit=13 - numseq=2**(nbit) - do ibit=nbit/2+1,216-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 - j=isync2(ibit-(nbit/2+1)+k) - ibb=iand(iseq/(2**i),1) - csum=csum+ccor(ibb,ibit-(nbit/2+1)+k)*cterm - cterm=cterm*conjg(cp(ibb,j)) - 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 getmetric2(2**(nbit/2),psbest,numseq,sbits3(ibit)) - hbits3(ibit)=0 - if(sbits3(ibit).gt.0) hbits3(ibit)=1 - enddo - sbits=sbits3 - hbits=hbits3 - endif - - rxdata(1:100)=sbits(1:100) - rxdata(101:200)=sbits(117:216); - rxav=sum(rxdata(1:200))/200.0 - rx2av=sum(rxdata(1:200)*rxdata(1:200))/200.0 - rxsig=sqrt(rx2av-rxav*rxav) - rxdata=rxdata/rxsig - sigma=0.90 - llr(201:204)=-5.0 - llr(1:200)=2*rxdata/(sigma*sigma) - apmask=0 - apmask(201:204)=1 - max_iterations=40 - ifer=0 - call bpdecode204(llr,apmask,max_iterations,decoded,cw,nharderror,niterations) - nhardmin=-1 - if(nharderror.lt.0) call osd204(llr,apmask,4,decoded,cw,nhardmin,dmin) - if(sum(decoded).eq.0) cycle - if(nhardmin.ge.0 .or. nharderror.ge.0) then - idat=0 - write(dmsg,'(68i1)') decoded - read(dmsg(1:50),'(6b8.8,b2.2)') idat(1:7) - idat(7)=idat(7)*64 - read(dmsg(51:64),'(b14.14)') ndec_crc - ncalc_crc=iand(crc14(c_loc(idat),9),z'FFFF') - nbadcrc=1 - if(ncalc_crc .eq. ndec_crc) nbadcrc=0 - else - cycle - endif - if( nbadcrc.eq.0 ) then - write(cbits,1200) decoded(1:50) -1200 format(50i1) - read(cbits,1202) idat -1202 format(8b8,b4) - idat(7)=ishft(idat(7),6) - call wqdecode(idat,message,itype) - 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=fMHz + 1.d-6*(fc1+fbest) - nfdot=0 - write(13,1210) datetime,0,nsnr,xdt,freq,message,nfdot -1210 format(a11,2i4,f6.2,f12.7,2x,a22,i3) - write(*,1212) datetime(8:11),nsnr,xdt,freq,nfdot,message,'*',nseq,ijitter,nharderror,nhardmin -1212 format(a4,i4,f5.1,f11.6,i3,2x,a22,a1,i5,i5,i5,i5) - goto 888 - endif - enddo ! nseq - enddo !jitter -888 continue - enddo !candidate list - enddo !files - - write(*,1120) -1120 format("") - -999 end program wsprcpmd - - -subroutine coherent_sync(c2,h,isyncword,nsync,nsps,istart,fc,imode,xmax) -! imode=0: refine fc using given istart -! imode=1: refine istart using given fc - complex c2(0:120*12000/32-1) - complex csync(0:16*200-1) - complex ctmp1(0:4*16*200-1) - complex ctwkp(0:16*200-1) - complex ccohp(0:15) - integer isyncword(nsync) - logical first/.true./ - save dt,first,twopi,csync - - if(first) then - baud=12000.0/6400.0 - dt=32.0/12000.0 - twopi=8.0*atan(1.0) - k=0 - phi=0.0 - dphi=twopi*baud*0.5*h*dt - do i=1,16 - dp=dphi*2*(isyncword(i)-1.5) - do j=1,200 - csync(k)=cmplx(cos(phi),sin(phi)) - phi=mod(phi+dp,twopi) - k=k+1 - enddo - enddo - first=.false. - endif - dphi=twopi*fc*dt - ctwkp=cmplx(0.0,0.0) - phi=0 - do i=0,nsync*nsps-1 - ctwkp(i)=csync(i)*cmplx(cos(phi),sin(phi)) - phi=mod(phi+dphi,twopi) - enddo - ipstart=istart+100*200 - ctmp1=0.0 - xmax=0.0 - if(imode.eq.1) then !refine DT with given fc - do iii=-50,50,5 - ctmp1(0:16*200-1)=c2(ipstart+iii:ipstart+iii+16*200-1)*conjg(ctwkp) - xnorm=sqrt(sum(abs(ctmp1(0:16*200-1))**2))*sqrt(16.0*200.0) - xc=abs(sum(ctmp1))/xnorm - if(xc.gt.xmax) then - iiibest=iii - xmax=xc - endif - enddo - istart=istart+iiibest - return - endif -! else refine fc with given DT - ctmp1(0:16*200-1)=c2(ipstart:ipstart+16*200-1)*conjg(ctwkp) - xnorm=sqrt(sum(abs(ctmp1(0:16*200-1))**2))*sqrt(16.0*200.0) - ctmp1=ctmp1/xnorm - call four2a(ctmp1,4*16*200,1,-1,1) !c2c FFT to freq domain - xmax=0.0 - ctmp1=cshift(ctmp1,-200) - dfp=1/(4*6400.0/12000.0*16) -! do i=150,250 - do i=190,210 - xa=abs(ctmp1(i)) -!write(51,*) (i-200)*dfp,xa - if(xa.gt.xmax) then - ishift=i - xmax=xa - endif - enddo - delta=(ishift-200)*dfp - xm1=abs(ctmp1(ishift-1)) - x0=abs(ctmp1(ishift)) - xp1=abs(ctmp1(ishift+1)) - xint=(log(xm1)-log(xp1))/(log(xm1)+log(xp1)-2*log(x0)) - delta2=delta+xint*dfp/2.0 - fc=fc+delta2 - return -end subroutine coherent_sync - -subroutine noncoherent_frame_sync(c2,h,fc,isync2,istart,ssmax) - complex c2(0:120*12000/32-1) - complex ct0(0:199),ct1(0:199),ct2(0:199),ct3(0:199) - integer isync2(216) - - twopi=8.0*atan(1.0) - dt=32.0/12000.0 - baud=12000.0/6400.0 - imax=370 ! defines dt search range (375 samples/s) - ssmax=-1e32 - izero=375 - do it = -imax,imax,5 -! noncoherent wspr-type dt estimation - dp0=twopi*(fc-1.5*h*baud)*dt - dp1=twopi*(fc-0.5*h*baud)*dt - dp2=twopi*(fc+0.5*h*baud)*dt - dp3=twopi*(fc+1.5*h*baud)*dt - th0=0.0 - th1=0.0 - th2=0.0 - th3=0.0 - do i=0,199 - ct0(i)=cmplx(cos(th0),sin(th0)) - ct1(i)=cmplx(cos(th1),sin(th1)) - ct2(i)=cmplx(cos(th2),sin(th2)) - ct3(i)=cmplx(cos(th3),sin(th3)) - th0=mod(th0+dp0,twopi) - th1=mod(th1+dp1,twopi) - th2=mod(th2+dp2,twopi) - th3=mod(th3+dp3,twopi) - enddo - xs=0.0 - xn=0.0 - do is=1,216 - i0=izero+it+(is-1)*200 - p0=abs(sum(c2(i0:i0+199)*conjg(ct0))) - p1=abs(sum(c2(i0:i0+199)*conjg(ct1))) - p2=abs(sum(c2(i0:i0+199)*conjg(ct2))) - p3=abs(sum(c2(i0:i0+199)*conjg(ct3))) - p0=p0**2 - p1=p1**2 - p2=p2**2 - p3=p3**2 - if(isync2(is).eq.0) then -! xs=xs+(p0+p2)/2.0 - xs=xs+max(p0,p2) - xn=xn+(p1+p3)/2.0 - elseif(isync2(is).eq.1) then -! xs=xs+(p1+p3)/2.0 - xs=xs+max(p1,p3) - xn=xn+(p0+p2)/2.0 - endif - enddo - sy=xs/xn -!write(41,*) it,sy - if(sy.gt.ssmax) then - ioffset=it - ssmax=sy - endif - enddo - istart=izero+ioffset - return -end subroutine noncoherent_frame_sync - -subroutine getmetric2(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 getmetric2 - -subroutine downsample2(ci,f0,h,co) - parameter(NI=216*200,NH=NI/2,NO=NI/20) ! 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/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=max(1.0,h)*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 getcandidate2(c,npts,fs,fa,fb,ncand,candidates) - parameter(NDAT=200,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 - 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.12).and.ncand.lt.100) then - ncand=ncand+1 - candidates(ncand,1)=df*(i-NH2) - candidates(ncand,2)=10*log10(bigspec(i)-1)-26.0 - endif - enddo - return -end subroutine getcandidate2 - -subroutine wsprcpm_downsample(iwave,c) - -! Input: i*2 data in iwave() at sample rate 12000 Hz -! Output: Complex data in c(), sampled at 400 Hz - - include 'wsprcpm_params.f90' - parameter (NMAX=120*12000,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 wsprcpm_downsample - diff --git a/lib/fsk4hf/wsprcpmsim.f90 b/lib/fsk4hf/wsprcpmsim.f90 deleted file mode 100644 index 42f40ed30..000000000 --- a/lib/fsk4hf/wsprcpmsim.f90 +++ /dev/null @@ -1,107 +0,0 @@ -program wsprcpmsim - -! Generate simulated data for a 2-minute "WSPR-LF" mode. Output is saved -! to a *.c2 or *.wav file. - - use wavhdr - include 'wsprcpm_params.f90' !Set various constants - parameter (NMAX=120*12000) - type(hdr) hwav !Header for .wav file - character arg*12,fname*16 - character msg*22,msgsent*22 - complex c0(0:NMAX/NDOWN-1) - complex c(0:NMAX/NDOWN-1) - real*8 fMHz - integer itone(NN) - integer*2 iwave(NMAX) !Generated full-length waveform - -! Get command-line argument(s) - nargs=iargc() - if(nargs.ne.9) then - print*,'Usage: wsprcpmsim "message" f0 DT fsp del nwav nfiles snr h' - print*,'Example: wsprcpmsim "K1ABC FN42 30" 50 1.0 0.1 1.0 1 10 -32 1.0' - go to 999 - endif - call getarg(1,msg) !Message to be transmitted - call getarg(2,arg) - read(arg,*) f0 !Freq relative to WSPR-band center (Hz) - 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,*) nwav !1 for *.wav file, 0 for *.c2 file - call getarg(7,arg) - read(arg,*) nfiles !Number of files - call getarg(8,arg) - read(arg,*) snrdb !SNR_2500 - call getarg(9,arg) - read(arg,*) h !h - - twopi=8.0*atan(1.0) - fs=12000.0/NDOWN ! - 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) - sig=sqrt(bandwidth_ratio) * 10.0**(0.05*snrdb) - if(snrdb.gt.90.0) sig=1.0 - txt=NN*NSPS0/12000.0 - - call genwsprcpm(msg,msgsent,itone) !Encode the message, get itone - write(*,1000) f0,xdt,txt,snrdb,fspread,delay,nfiles,msgsent -1000 format('f0:',f9.3,' DT:',f6.2,' txt:',f6.1,' SNR:',f6.1, & - ' fspread:',f6.1,' delay:',f6.1,' nfiles:',i3,2x,a22) - - c0=0. - k=-1 + nint(xdt/dt) - do j=1,NN -write(*,*) j,itone(j) - dp=twopi*(f0+itone(j)*(h/2.0)*baud)*dt - do i=1,NSPS - k=k+1 - phi=mod(phi+dp,twopi) - if(k.ge.0 .and. k.lt.NMAX/NDOWN) c0(k)=cmplx(cos(phi),sin(phi)) - enddo - enddo - call sgran() - do ifile=1,nfiles - c=c0 - if(nwav.eq.0) then - if( fspread .ne. 0.0 .or. delay .ne. 0.0 ) then - ntot=NMAX/NDOWN - nsig=NN*NSPS - call watterson(c,ntot,nsig,fs,delay,fspread) - endif - c=c*sig - if(snrdb.lt.90) then - do i=0,NMAX/NDOWN-1 !Add gaussian noise at specified SNR - xnoise=gran() - ynoise=gran() - c(i)=c(i) + cmplx(xnoise,ynoise) - enddo - endif - write(fname,1100) ifile -1100 format('000000_',i4.4,'.c2') - open(10,file=fname,status='unknown',access='stream') - fMHz=10.1387d0 - nmin=2 - write(10) fname,nmin,fMHz,c !Save to *.c2 file - close(10) - else - call wsprcpm_wav(baud,xdt,h,f0,itone,snrdb,iwave) - hwav=default_header(12000,NMAX) - write(fname,1102) ifile -1102 format('000000_',i4.4,'.wav') - open(10,file=fname,status='unknown',access='stream') - write(10) hwav,iwave !Save to *.wav file - close(10) - endif - write(*,1110) ifile,xdt,f0,snrdb,fname -1110 format(i4,f7.2,f8.2,f7.1,2x,a16) - enddo - -999 end program wsprcpmsim diff --git a/lib/fsk4hf/wsprdpsk_params.f90 b/lib/fsk4hf/wsprdpsk_params.f90 deleted file mode 100644 index 8c473cf20..000000000 --- a/lib/fsk4hf/wsprdpsk_params.f90 +++ /dev/null @@ -1,14 +0,0 @@ -parameter (KK=64) !Information bits (50 + CRC14) ? -parameter (ND=200) !Data symbols: LDPC (204,68), r=1/3, don't send last 4 bits -parameter (NS=32) !Sync symbols (32) -parameter (NN=NS+ND) !Total symbols (232) - -parameter (NSPS0=6000) !Samples per symbol at 12000 S/s - -parameter (NDOWN=30) !Downsample to 200 sa/symbol (400 Hz) for candidate selection -parameter (NSPS=NSPS0/NDOWN) !Samples per symbol (200) -parameter (NZ=NSPS*NN) !Samples in baseband waveform - -parameter (NZ0=NSPS0*NN) !Samples in waveform at 12000 S/s -parameter (NFFT1=4*NSPS,NH1=NFFT1/2) - diff --git a/lib/fsk4hf/wsprdpskd.f90 b/lib/fsk4hf/wsprdpskd.f90 deleted file mode 100644 index 223e2e4fc..000000000 --- a/lib/fsk4hf/wsprdpskd.f90 +++ /dev/null @@ -1,439 +0,0 @@ -program wsprdpskd - -! Decode WSPRDPSK data read from *.c2 or *.wav files. - -! Currently configured to use (204,68) r=1/3 LDPC code, regular column weight 3. -! 50 data bits + 14 bit CRC + 4 "0" bits. The 4 "0" bits are unused bits that -! are not transmitted. At the decoder, these bits are treated as "AP" bits. -! This shortens the code to (200,64) r=0.32, slightly decreasing the code rate. -! Frame format is: -! d100 p32 d100 (232) channel symbols -! - use crc - include 'wsprdpsk_params.f90' - parameter(NMAX=120*12000) - character arg*8,message*22,cbits*50,infile*80,fname*16,datetime*11 - character*22 decodes(100) - character*120 data_dir - character*32 uwbits - character*68 dmsg - complex c2(0:120*12000/30-1) !Complex waveform - complex cframe(0:232*200-1) !Complex waveform - complex cd(0:240*10-1) !Complex waveform - complex cs(0:240) - complex c1(0:9,0:1),c0(0:9,0:1) - complex ccor(0:1,232) - complex csum,cterm - real*8 fMHz - real rxdata(ND),llr(204) !Soft symbols - real sbits(232),sbits1(232),sbits3(232) - real ps(0:8191),psbest(0:8191) - real candidates(100,2) - integer iuniqueword0 - integer isync(200) !Unique word - integer isync2(232) - integer ipreamble(16) !Preamble vector - integer ihdr(11) - integer*2 iwave(NMAX) !Generated full-length waveform - integer*1,target :: idat(9) - integer*1 decoded(68),apmask(204),cw(204) - integer*1 hbits(232),hbits1(232),hbits3(232) - integer*1 b(14),bbest(14) - data ipreamble/1,1,1,1,0,0,0,0,0,0,0,0,1,1,1,1/ - data iuniqueword0/z'30C9E8AD'/ - - write(uwbits,'(b32.32)') iuniqueword0 - read(uwbits,'(32i1)') isync(1:32) - read(uwbits,'(32i1)') isync(33:64) - read(uwbits,'(32i1)') isync(65:96) - read(uwbits,'(32i1)') isync(97:128) - read(uwbits,'(32i1)') isync(129:160) - read(uwbits,'(32i1)') isync(161:192) - read(uwbits,'(8i1)') isync(193:200) - - fs=12000.0/NDOWN !Sample rate - 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) - h=1.00 !h=0.8 seems to be optimum for AWGN sensitivity (not for fading) - twopi=8.0*atan(1.0) - - isync2(1:100)=isync(1:100) - isync2(101:104)=0 ! This is *not* backwards. - isync2(105:112)=1 - isync2(113:116)=0 - isync2(117:216)=isync(101:200) - - dphi=twopi*baud*(h/2.0)*dt*20 ! dt*20 is samp interval after downsample - do j=0,1 - if(j.eq.0) then - dphi0=-3*dphi - dphi1=+1*dphi - else - dphi0=-1*dphi - dphi1=+3*dphi - endif - phi0=0.0 - phi1=0.0 - do i=0,9 - c1(i,j)=cmplx(cos(phi1),sin(phi1)) - c0(i,j)=cmplx(cos(phi0),sin(phi0)) - phi1=mod(phi1+dphi1,twopi) - phi0=mod(phi0+dphi0,twopi) - enddo - enddo - - nargs=iargc() - if(nargs.lt.1) then - print*,'Usage: wsprdpskd [-a ] [-f fMHz] [-c ncoh] 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 - npdi=16 - if(arg(1:2).eq.'-c') then - call getarg(iarg+1,arg) - read(arg,*) ncoh - iarg=iarg+2 - npdi=16/ncoh - endif -! write(*,*) 'ncoh: ',ncoh,' npdi: ',npdi - - open(13,file=trim(data_dir)//'/ALL_WSPR.TXT',status='unknown', & - position='append') - - xs1=0.0 - xs2=0.0 - fr1=0.0 - fr2=0.0 - nav=0 - 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 wsprdpsk_downsample(iwave,c2) - else - print*,'Wrong file format?' - go to 999 - endif - close(10) - - fa=-10.0 - fb=10.0 - fs=12000.0/30.0 - npts=120*12000.0/30.0 -! call getcandidate2(c2,npts,fs,fa,fb,ncand,candidates) !First approx for freq - ncand=1 - candidates(1,1)=0.0 - candidates(1,2)=-28 - ndecodes=0 - do icand=1,ncand - fc0=candidates(icand,1) - xsnr=candidates(icand,2) - call dsdpsk(c2,fc0,cd) - i0=40 - do i=0,231 - cs(i)=cd(i0+10*i)/5e4 - enddo -! 2-bit differential detection - do i=1,231 -! do i=1,232 - sbits(i)=-real(cs(i)*conjg(cs(i-1))) !2 symbol dpsk -! sbits(i)=real(cs(i-1)) !for coherent dpsk -! sbits(i)=real(cs(i)) !for coherent bpsk - enddo -! do i=1,231 -! sbits3(i)=-sbits(i+1)*sbits(i) ! for coherent dpsk -! enddo - -! detect a differentially encoded block of symbols using the -! Divsalar and Simon approach, except that we estimate only -! the central symbol of the block and then step the block forward -! by one symbol. -! - sbits3=sbits -!goto 100 - nbit=13 ! number of decoded bits to be derived from nbit+1 symbols - numseq=2**nbit - il=(nbit+1)/2 - ih=231-nbit/2 - do isym=il,ih - rmax=-1e32 - b=0 - do iseq=0,numseq-1 - do i=1,nbit - b(i)=merge(1,0,iand(iseq,2**(nbit-i))>0) - enddo - b(1:nbit)=2*b(1:nbit)-1 - i1=isym-(nbit+1)/2 - csum=cs(i1) - do i=1,nbit - bb=1 - do m=1,i - bb=bb*b(m) - enddo - csum=csum+bb*cs(i1+i) - enddo -! ps(iseq)=abs(csum)**2 - ps(iseq)=abs(csum) - if(ps(iseq).gt.rmax) then - bbest=b - rmax=ps(iseq) - endif - enddo - if(isym.eq.il) then - do i=1,isym-1 - call getmetric(2**(nbit-i),ps,numseq,xmet) - sbits3(i)=-xmet - enddo - endif - call getmetric(2**((nbit-1)/2),ps,numseq,xmet) - sbits3(isym)=-xmet - if(isym.eq.ih) then - do i=ih+1,231 - call getmetric(2**(231-i),ps,numseq,xmet) - sbits3(i)=-xmet - enddo - endif - enddo -100 continue - rxdata(1:100)=sbits3(1:100) - rxdata(101:200)=sbits3(132:231); - rxav=sum(rxdata(1:200))/200.0 - rx2av=sum(rxdata(1:200)*rxdata(1:200))/200.0 - rxsig=sqrt(rx2av-rxav*rxav) - rxdata=rxdata/rxsig - sigma=0.90 - llr(201:204)=-5.0 - llr(1:200)=2*rxdata/(sigma*sigma) - apmask=0 - apmask(201:204)=1 - max_iterations=40 - ifer=0 - call bpdecode204(llr,apmask,max_iterations,decoded,cw,nharderror,niterations) - nhardmin=-1 - if(nharderror.lt.0) call osd204(llr,apmask,5,decoded,cw,nhardmin,dmin) - if(sum(decoded).eq.0) cycle - if(nhardmin.ge.0 .or. nharderror.ge.0) then - idat=0 - write(dmsg,'(68i1)') decoded - read(dmsg(1:50),'(6b8.8,b2.2)') idat(1:7) - idat(7)=idat(7)*64 - read(dmsg(51:64),'(b14.14)') ndec_crc - ncalc_crc=iand(crc14(c_loc(idat),9),z'FFFF') - nbadcrc=1 - if(ncalc_crc .eq. ndec_crc) nbadcrc=0 - else - cycle - endif - if( nbadcrc.eq.0 ) then - write(cbits,1200) decoded(1:50) -1200 format(50i1) - read(cbits,1202) idat -1202 format(8b8,b4) - idat(7)=ishft(idat(7),6) - call wqdecode(idat,message,itype) - 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=fMHz + 1.d-6*(fc1+fbest) - nfdot=0 - write(13,1210) datetime,0,nsnr,xdt,freq,message,nfdot -1210 format(a11,2i4,f6.2,f12.7,2x,a22,i3) - write(*,1212) datetime(8:11),nsnr,xdt,freq,nfdot,message,'*',idf,nseq,ijitter,nharderror,nhardmin -1212 format(a4,i4,f5.1,f11.6,i3,2x,a22,a1,i5,i5,i5,i5,i5) - goto 888 - endif -888 continue - enddo !candidate list - enddo !files - - write(*,1120) -1120 format("") - -999 end program wsprdpskd - -subroutine getmetric(ib,ps,ns,xmet) - real ps(0:ns-1) - xm1=-1e32 - xm0=-1e32 - do i=0,ns-1 - if( iand(i/ib,1) .eq. 1 .and. ps(i) .gt. xm1 ) then - xm1=ps(i) - endif - if( iand(i/ib,1) .eq. 0 .and. ps(i) .gt. xm0 ) then - xm0=ps(i) - endif - enddo - xmet=xm1-xm0 - return -end subroutine getmetric - -subroutine getmetric3(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 ) then - xm1=xm1+ps(i) - endif - if( iand(i/ib,1) .eq. 0 ) then - xm0=xm0+ps(i) - endif - enddo - xmet=xm1-xm0 - return -end subroutine getmetric3 - -subroutine dsdpsk(ci,f0,co) - parameter(NI=240*200,NH=NI/2,NO=NI/20) ! downsample from 200 samples per symbol to 10 - complex ci(0:NI-1),ct(0:NI-1) - complex co(0:NO-1) - - pi=4.0*atan(1.0) - fs=12000.0/30.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) - - dt=20/fs - beta=1.0 - tt=10*dt - baud=1/tt - bw=(1+beta)*baud/2.0 - bf=(1-beta)*baud/2.0 - iw=bw/df - if=bf/df - co=0.0 - co(0)=ct(0) - do i=1,iw - filt=((1.0+cos(pi*(i-if)/(iw-if)))/2.0)**0.5 - 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 dsdpsk - -subroutine getcandidate2(c,npts,fs,fa,fb,ncand,candidates) - parameter(NDAT=200,NFFT1=120*12000/30,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)/20.0)**2) - 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))-30.0 - endif - enddo -! do i=1,ncand -! write(*,*) i,candidates(i,1),candidates(i,2) -! enddo - return -end subroutine getcandidate2 - -subroutine wsprdpsk_downsample(iwave,c) - -! Input: i*2 data in iwave() at sample rate 12000 Hz -! Output: Complex data in c(), sampled at 400 Hz - - include 'wsprdpsk_params.f90' - parameter (NMAX=120*12000,NFFT2=NMAX/30) - integer*2 iwave(NMAX) - complex c(0:NMAX/30-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/30-1) - return -end subroutine wsprdpsk_downsample - diff --git a/lib/fsk4hf/wsprdpsksim.f90 b/lib/fsk4hf/wsprdpsksim.f90 deleted file mode 100644 index fa5e34e4d..000000000 --- a/lib/fsk4hf/wsprdpsksim.f90 +++ /dev/null @@ -1,175 +0,0 @@ -program wsprdpsksim - -! Generate simulated data for a 2-minute "WSPR-DPSK" mode. Output is saved -! to a *.c2 or *.wav file. - - use wavhdr - include 'wsprdpsk_params.f90' !Set various constants - parameter (NMAX=120*12000) - type(hdr) hwav !Header for .wav file - character arg*12,fname*16 - character msg*22,msgsent*22 - complex c0(0:NMAX/NDOWN-1) - complex c(0:NMAX/NDOWN-1) - complex c0wav(0:NMAX-1) - complex cwav(0:NMAX-1) - real*8 fMHz - integer imessage(NN) - integer*2 iwave(NMAX) !Generated full-length waveform - -! Get command-line argument(s) - nargs=iargc() - if(nargs.ne.8) then - print*,'Usage: wsprdpsksim "message" f0 DT fsp del nwav nfiles snr' - print*,'Example: wsprdpsksim "K1ABC FN42 30" 50 0.0 0.1 1.0 1 10 -33' - go to 999 - endif - call getarg(1,msg) !Message to be transmitted - call getarg(2,arg) - read(arg,*) f0 !Freq relative to WSPR-band center (Hz) - 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,*) nwav !1 for *.wav file, 0 for *.c2 file - call getarg(7,arg) - read(arg,*) nfiles !Number of files - call getarg(8,arg) - read(arg,*) snrdb !SNR_2500 - - twopi=8.0*atan(1.0) - pi=twopi/2.0 - fs=12000.0/NDOWN - 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) - sig=sqrt(bandwidth_ratio) * 10.0**(0.05*snrdb) - if(snrdb.gt.90.0) sig=1.0 - txt=NN*NSPS0/12000.0 - - call genwsprdpsk(msg,msgsent,imessage) !Encode the message, get itone - imessage=2*imessage-1 - write(*,1000) f0,xdt,txt,snrdb,fspread,delay,nfiles,msgsent -1000 format('f0:',f9.3,' DT:',f6.2,' txt:',f6.1,' SNR:',f6.1, & - ' fspread:',f6.1,' delay:',f6.1,' nfiles:',i3,2x,a22) - - - beta=1.0 ! excess bandwidth - if(nwav.eq.0) then - df=fs/(NMAX/NDOWN) ! - c=0 - bw=(1+beta)*baud/2.0 - bf=(1-beta)*baud/2.0 - iw=bw/df - if=bf/df - c(0:if-1)=1.0 - if(iw.gt.if) then - do i=if,iw - c(i)=((1.0+cos(pi*(i-if)/(iw-if)))/2.0)**0.5 - enddo - endif - c(NMAX/NDOWN-1:NMAX/NDOWN-iw:-1)=c(1:iw) - - istart=xdt/dt - c0=0.0 - do i=1,NN - c0(istart+(i-1)*200)=imessage(i) - enddo - call four2a(c0,NMAX/NDOWN,1,1,1) - c0=c0*conjg(c) - ic=f0/df - c0=cshift(c0,ic) - call four2a(c0,NMAX/NDOWN,1,-1,1) - xx=sum(abs(c0(istart:istart+NN*200-1)**2))/(NN*200) - c0=c0/sqrt(xx) - - call sgran() - do ifile=1,nfiles - c=c0 - if( fspread .ne. 0.0 .or. delay .ne. 0.0 ) then - call watterson(c,NMAX/NDOWN,fs,delay,fspread) - endif - c=c*sig - if(snrdb.lt.90) then - do i=0,NMAX/NDOWN-1 !Add gaussian noise at specified SNR - xnoise=gran() - ynoise=gran() - c(i)=c(i) + cmplx(xnoise,ynoise) - enddo - endif -snrtest=sum(abs(c(istart:istart+NN*200-1)**2))/(NN*200)/2.0-1.0 -write(*,*) 'sample SNR: ',10*log10(snrtest)+10*log10(0.4/2.5) - write(fname,1100) ifile -1100 format('000000_',i4.4,'.c2') - open(10,file=fname,status='unknown',access='stream') - fMHz=10.1387d0 - nmin=2 - write(10) fname,nmin,fMHz,c !Save to *.c2 file - close(10) - enddo - else - fs=12000.0 - df=fs/NMAX - dt=1/fs - 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 - cwav=0 - bw=(1+beta)*baud/2.0 - bf=(1-beta)*baud/2.0 - iw=bw/df - if=bf/df - cwav(0:if-1)=1.0 - if(iw.gt.if) then - do i=if,iw - cwav(i)=((1.0+cos(pi*(i-if)/(iw-if)))/2.0)**0.5 - enddo - endif - cwav(NMAX-1:NMAX-iw:-1)=cwav(1:iw) - - istart=xdt/dt - c0wav=0.0 - do i=1,NN - c0wav(istart+(i-1)*200*NDOWN)=imessage(i) - enddo - call four2a(c0wav,NMAX,1,1,1) - c0wav=c0wav*conjg(cwav) - ic=f0/df - c0wav=cshift(c0wav,-ic) - call four2a(c0wav,NMAX,1,-1,1) - xx=sum(abs(c0wav(istart:istart+NN*200*NDOWN-1))**2)/(NN*200*NDOWN) - c0wav=c0wav/sqrt(xx) -write(*,*) 'Peak power: ',maxval(abs(c0wav)**2) -write(*,*) 'Average power: ',sum(abs(c0wav(istart:istart+NN*200*NDOWN-1))**2)/(NN*200*NDOWN) - call sgran() - do ifile=1,nfiles - cwav=c0wav - if( fspread .ne. 0.0 .or. delay .ne. 0.0 ) then - call watterson(cwav,NMAX,fs,delay,fspread) - endif - cwav=cwav*sig - if(snrdb.lt.90) then - do i=1,NMAX !Add gaussian noise at specified SNR - xnoise=gran() - iwave(i)=100*(real(cwav(i-1)) + xnoise) - enddo - endif -snrtest=sum(real(iwave(istart:istart+NN*200*NDOWN-1)**2)/(NN*200*NDOWN))/100.0**2-1 -write(*,*) 'sample SNR: ',10*log10(snrtest)+10*log10(6.0/2.5) - hwav=default_header(12000,NMAX) - write(fname,1102) ifile -1102 format('000000_',i4.4,'.wav') - open(10,file=fname,status='unknown',access='stream') - write(10) hwav,iwave !Save to *.wav file - close(10) - enddo - endif - write(*,1110) ifile,xdt,f0,snrdb,fname -1110 format(i4,f7.2,f8.2,f7.1,2x,a16) - -999 end program wsprdpsksim diff --git a/lib/fsk4hf/wsprlf.f90 b/lib/fsk4hf/wsprlf.f90 deleted file mode 100644 index efc3e8463..000000000 --- a/lib/fsk4hf/wsprlf.f90 +++ /dev/null @@ -1,110 +0,0 @@ -program wsprlf - - parameter (NN=121) !Total symbols - parameter (NSPS=28800) !Samples per symbol @ fs=12000 Hz - parameter (NZ=NSPS*NN) !Samples in waveform - - character*8 arg - complex c(0:NZ-1) - real*8 twopi,fs,f0,dt,phi,dphi - real x(0:NZ-1) - real p(0:NZ/2) - real h0(0:NSPS/2) !Pulse shape, rising edge - real h1(0:NSPS/2) !Pulse shape, trailing edge - real tmp(NN) - integer id(NN) !Generated data - integer ie(NN) !Differentially encoded data - data fs/12000.d0/ - - nargs=iargc() - if(nargs.ne.3) then - print*,'Usage: wsprlf f0 t1 snr' - goto 999 - endif - call getarg(1,arg) - read(arg,*) f0 - call getarg(2,arg) - read(arg,*) t1 - call getarg(3,arg) - read(arg,*) snrdb - - call random_number(tmp) !Generate random bipolar data - id=1 - where(tmp.lt.0.5) id=-1 - ie(1)=1 - do i=2,NN !Differentially encode - ie(i)=id(i)*ie(i-1) - enddo - - n1=nint(t1*NSPS) - twopi=8.d0*atan(1.d0) - - do i=0,2*n1-1 !Define the shape functions - if(i.le.n1-1) then - h0(i)=0.5*(1.0-cos(0.5*i*twopi/n1)) - else - h1(i-n1)=0.5*(1.0-cos(0.5*i*twopi/n1)) - endif - enddo - if(t1.eq.0.0) h0=1 - if(t1.eq.0.0) h1=1 - -! Shape the channel pulses - x=1. - x(0:n1-1)=h0(0:n1-1) !Leading edge of 1st pulse - do j=2,NN !Leading edges - if(ie(j).ne.ie(j-1)) then - ia=(j-1)*NSPS + 1 - ib=ia+n1-1 - x(ia:ib)=h0(0:n1-1) - endif - enddo - do j=1,NN-1 !Trailing edges - if(ie(j+1).ne.ie(j)) then - ib=j*NSPS - ia=ib-n1+1 - x(ia:ib)=h1(0:n1-1) - endif - enddo - ib=NN*NSPS-1 - ia=ib-n1+1 - x(ia:ib)=h1(0:n1-1) !Trailing edge of last pulse - - dt=1.d0/fs - ts=dt*NSPS - baud=fs/NSPS - write(*,1000) baud,ts -1000 format('Baud:',f6.3,' Tsym:',f6.3) - - dphi=twopi*f0*dt - phi=0.d0 - i=-1 - do j=1,NN !Generate the baseband waveform - a=ie(j) - do k=1,NSPS - i=i+1 - x(i)=a*x(i) - phi=phi+dphi - if(phi.gt.twopi) phi=phi-twopi - xphi=phi - c(i)=x(i)*cmplx(cos(xphi),sin(xphi)) - sym=i*dt/ts - if(j.le.20) write(13,1010) sym,x(i),c(i) -1010 format(4f12.6) - enddo - enddo - - call four2a(c,NZ,1,-1,1) !To freq domain - df=fs/NZ - nh=NZ/2 - do i=0,nh - f=i*df - p(i)=real(c(i))**2 + aimag(c(i))**2 - enddo - p=p/maxval(p) - do i=0,nh !Save spectrum for plotting - write(14,1020) i*df,p(i),10.0*log10(p(i)+1.e-8) -1020 format(f10.3,2e12.3) - enddo - -999 end program wsprlf diff --git a/lib/fsk4hf/wsprlf_params.f90 b/lib/fsk4hf/wsprlf_params.f90 deleted file mode 100644 index d0c3f5c7c..000000000 --- a/lib/fsk4hf/wsprlf_params.f90 +++ /dev/null @@ -1,14 +0,0 @@ -!parameter (NDOWN=540) !Downsample factor (default 540) -parameter (NDOWN=30) !Downsample factor (default 540) -parameter (KK=60) !Information bits (50 + CRC10) -parameter (ND=300) !Data symbols: LDPC (300,60), r=1/5 -parameter (NS=109) !Sync symbols (2 x 48 + Barker 13) -parameter (NR=3) !Ramp up/down -parameter (NN=NR+NS+ND) !Total symbols (412) -parameter (NSPS0=8640) !Samples per symbol at 12000 S/s -parameter (NSPS=NSPS0/NDOWN) !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 (6592) -parameter (NZMAX=NSPS0*NN) -parameter (NFFT1=4*NSPS,NH1=NFFT1/2) diff --git a/lib/fsk4hf/wsprlfsim.f90 b/lib/fsk4hf/wsprlfsim.f90 deleted file mode 100644 index 6ee0710bb..000000000 --- a/lib/fsk4hf/wsprlfsim.f90 +++ /dev/null @@ -1,286 +0,0 @@ -program wsprlfsim - -! Simulate characteristics of a potential "WSPR-LF" mode using LDPC (300,60) -! code, OQPSK modulation, and 5 minute T/R sequences. - -! Reception and Demodulation algorithm: -! 1. Compute coarse spectrum; find fc1 = approx carrier freq -! 2. Mix from fc1 to 0; LPF at +/- 0.75*R -! 3. Square, FFT; find peaks near -R/2 and +R/2 to get fc2 -! 4. Mix from fc2 to 0 -! 5. Fit cb13 (central part of csync) to c -> lag, phase -! 6. Fit complex ploynomial for channel equalization -! 7. Get soft bits from equalized data - - include 'wsprlf_params.f90' - -! Q: Would it be better for central Sync array to use both I and Q channels? - - character*8 arg - complex cbb(0:NZ-1) !Complex baseband waveform - complex csync(0:NZ-1) !Sync symbols only, from cbb - complex c(0:NZ-1) !Complex waveform - complex c0(0:NZ-1) !Complex waveform - complex c1(0:NZ-1) !Complex waveform - complex zz(NS+ND) !Complex symbol values (intermediate) - complex z - real xnoise(0:NZ-1) !Generated random noise - real ynoise(0:NZ-1) !Generated random noise - real rxdata(ND),llr(ND) !Soft symbols - real pp(2*NSPS) !Shaped pulse for OQPSK - real a(5) !For twkfreq1 - real aa(20),bb(20) !Fitted polyco's - real t(11) - character*12 label(11) - integer*8 count0,count1,count2,count3,clkfreq - integer nc(11) - integer id(NS+ND) !NRZ values (+/-1) for Sync and Data - integer ierror(NS+ND) - integer icw(NN) - integer itone(NN) - integer*1 msgbits(KK),decoded(KK),apmask(ND),cw(ND) -! integer*1 codeword(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,1,0,1,0,1,1,0,0,1,1/ - data label/'genwsprlf','twkfreq1 a','watterson','noise gen','getfc1w', & - 'getfc2w','twkfreq1 b','xdt loop','cpolyfitw','msksoftsym', & - 'bpdecode300'/ - - nargs=iargc() - if(nargs.ne.6) then - print*,'Usage: wsprlfsim f0(Hz) delay(ms) fspread(Hz) maxn iters snr(dB)' - print*,'Example: wsprlfsim 0 0 0 5 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,*) maxn !Max nterms for polyfit - call getarg(5,arg) - read(arg,*) iters !Iterations at each SNR - call getarg(6,arg) - read(arg,*) snrdb !Specified SNR_2500 - - nc=0 - twopi=8.0*atan(1.0) - fs=NSPS*12000.0/NSPS0 !Sample rate = 22.2222... Hz - dt=1.0/fs !Sample interval (s) - tt=NSPS*dt !Duration of "itone" symbols (s) - ts=2*NSPS*dt !Duration of OQPSK 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) fs,f0,delay,fspread,maxn,baud,3*baud,txt,iters -1000 format('fs:',f10.3,' f0:',f5.1,' Delay:',f4.1,' fSpread:',f5.2, & - ' maxn:',i3,/'Baud:',f8.3,' BW:',f5.1,' TxT:',f6.1,' iters:',i4/) - write(*,1004) -1004 format(/' SNR sync data ser ber fer fsigma tsigma', & - ' tsec'/68('-')) - - do i=1,N2 !Half-sine pulse shape - pp(i)=sin(0.5*(i-1)*twopi/(2*NSPS)) - enddo - - t=0. - call system_clock(count0,clkfreq) - call genwsprlf(msgbits,id,icw,cbb,csync,itone)!Generate baseband waveform - call system_clock(count1,clkfreq) - t(1)=float(count1-count0)/float(clkfreq) - nc(1)=nc(1)+1 - do i=0,NZ-1 - write(40,4001) i,cbb(i),csync(i) -4001 format(i8,4f12.6) - enddo - - call system_clock(count0,clkfreq) - a=0. - a(1)=f0 - call twkfreq1(cbb,NZ,fs,a,c0) !Mix baseband to specified frequency - call system_clock(count1,clkfreq) - t(2)=float(count1-count0)/float(clkfreq) - nc(2)=nc(2)+1 - - isna=-20 - isnb=-40 - if(snrdb.ne.0.0) then - isna=nint(snrdb) - isnb=isna - endif - do isnr=isna,isnb,-1 !Loop over SNR range - if(isna.ne.isnb) snrdb=isnr - sig=sqrt(bandwidth_ratio) * 10.0**(0.05*snrdb) - if(snrdb.gt.90.0) sig=1.0 - nhard=0 - nhardsync=0 - nfe=0 - sqf=0. - sqt=0. - - call system_clock(count2,clkfreq) - do iter=1,iters !Loop over requested iterations - c=c0 -write(*,*) 'iter ',iter - call system_clock(count0,clkfreq) - if(delay.ne.0.0 .or. fspread.ne.0.0) then - call watterson(c,NZ,fs,delay,fspread) - endif - call system_clock(count1,clkfreq) - t(3)=t(3)+float(count1-count0)/float(clkfreq) - nc(3)=nc(3)+1 - - call system_clock(count0,clkfreq) - 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 - call system_clock(count1,clkfreq) - t(4)=t(4)+float(count1-count0)/float(clkfreq) - nc(4)=nc(4)+1 - - call system_clock(count0,clkfreq) - call getfc1w(c,fs,fc1) !First approx for freq - call system_clock(count1,clkfreq) - t(5)=t(5)+float(count1-count0)/float(clkfreq) - nc(5)=nc(5)+1 -write(*,*) 'fc1 ',fc1 - call system_clock(count0,clkfreq) - call getfc2w(c,csync,fs,fc1,fc2,fc3) !Refined freq -write(*,*) 'fc1,fc2,fc3 ',fc1,fc2,fc3 - call system_clock(count1,clkfreq) - t(6)=t(6)+float(count1-count0)/float(clkfreq) - nc(6)=nc(6)+1 - sqf=sqf + (fc1+fc2-f0)**2 - - call system_clock(count0,clkfreq) -!NB: Measured performance is about equally good using fc2 or fc3 here: - a(1)=-(fc1+fc2) - a(2:5)=0. - call twkfreq1(c,NZ,fs,a,c) !Mix c down by fc1+fc2 - call system_clock(count1,clkfreq) - t(7)=t(7)+float(count1-count0)/float(clkfreq) - nc(7)=nc(7)+1 - -! The following may not be necessary? -! z=sum(c(3088:3503)*cb13)/208.0 !Get phase from Barker 13 vector -! z0=z/abs(z) -! c=c*conjg(z0) - - call system_clock(count0,clkfreq) -!---------------------------------------------------------------- DT -! Not presently used: - amax=0. - jpk=0 - iaa=0 - ibb=NZ-1 - do j=-20*NSPS,20*NSPS,NSPS/8 - ia=j - ib=NZ-1+j - if(ia.lt.0) then - ia=0 - iaa=-j - else - iaa=0 - endif - if(ib.gt.NZ-1) then - ib=NZ-1 - ibb=NZ-1-j - endif - z=sum(c(ia:ib)*conjg(csync(iaa:ibb))) - if(abs(z).gt.amax) then - amax=abs(z) - jpk=j - endif - enddo - xdt=jpk/fs - sqt=sqt + xdt**2 - call system_clock(count1,clkfreq) - t(8)=t(8)+float(count1-count0)/float(clkfreq) - nc(8)=nc(8)+1 - -!----------------------------------------------------------------- - - nterms=maxn - c1=c - do itry=1,20 - idf=itry/2 - if(mod(itry,2).eq.0) idf=-idf - nhard0=0 - nhardsync0=0 - ifer=1 - a(1)=idf*0.00085 - a(2:5)=0. - call system_clock(count0,clkfreq) - call twkfreq1(c1,NZ,fs,a,c) !Mix c1 into c - call cpolyfitw(c,pp,id,maxn,aa,bb,zz,nhs) - call system_clock(count1,clkfreq) - t(9)=t(9)+float(count1-count0)/float(clkfreq) - nc(9)=nc(9)+1 - - call system_clock(count0,clkfreq) - call msksoftsymw(zz,aa,bb,id,nterms,ierror,rxdata,nhard0,nhardsync0) - call system_clock(count1,clkfreq) - t(10)=t(10)+float(count1-count0)/float(clkfreq) - nc(10)=nc(10)+1 - - if(nhardsync0.gt.35) cycle - 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 system_clock(count0,clkfreq) - call bpdecode300(llr,apmask,max_iterations,decoded,niterations,cw) - call system_clock(count1,clkfreq) - t(11)=t(11)+float(count1-count0)/float(clkfreq) - nc(11)=nc(11)+1 - nbadcrc=0 - if(niterations.ge.0) call chkcrc10(decoded,nbadcrc) - if(niterations.lt.0 .or. count(msgbits.ne.decoded).gt.0 .or. & - nbadcrc.ne.0) ifer=1 - if(ifer.eq.0) exit - enddo !Freq dither loop - nhard=nhard+nhard0 - nhardsync=nhardsync+nhardsync0 - nfe=nfe+ifer - if(nhardsync0+nhard0+niterations+ifer.gt.0) write(42,1045) snrdb, & - nhardsync0,nhard0,niterations,ifer,xdt -1045 format(f6.1,4i6,f8.2) - enddo - call system_clock(count3,clkfreq) - tsec=float(count3-count2)/float(clkfreq) - - fsigma=sqrt(sqf/iters) - tsigma=sqrt(sqt/iters) - ser=float(nhardsync)/(NS*iters) - ber=float(nhard)/(ND*iters) - fer=float(nfe)/iters - write(*,1050) snrdb,nhardsync,nhard,ser,ber,fer,fsigma,tsigma,tsec -1050 format(f6.1,2i7,2f8.4,f7.3,2f8.2f8.3) - enddo - - write(*,1060) NS*iters,ND*iters -1060 format(68('-')/6x,2i7) - - write(*,1065) -1065 format(/'Timing sec frac calls'/39('-')) - do i=1,11 - write(*,1070) label(i),t(i),t(i)/sum(t),nc(i) -1070 format(a12,2f9.3,i8) - enddo - write(*,1072) sum(t),1.0 -1072 format(39('-')/12x,2f10.3) - -999 end program wsprlfsim diff --git a/lib/fsk4hf/wsprsimf.f90 b/lib/fsk4hf/wsprsimf.f90 deleted file mode 100644 index d6ee25d44..000000000 --- a/lib/fsk4hf/wsprsimf.f90 +++ /dev/null @@ -1,113 +0,0 @@ -!------------------------------------------------------------------------------- -! -! This file is part of the WSPR application, Weak Signal Propagation Reporter -! -!------------------------------------------------------------------------------- - -program wsprsim - - use wavhdr - include 'wspr_params.f90' - type(hdr) hwav - character arg*12,fname14*14,fname15*15 - character*22 msg,msgsent - complex c0(0:NMAX/NDOWN-1) - complex c(0:NMAX/NDOWN-1) - integer itone(NN) - integer*2 iwave(NMAX) - real*8 fMHz - -! Get command-line argument(s) - nargs=iargc() - if(nargs.ne.8) then - print*,'Usage: wsprsim "message" f0 DT fsp del nwav nfiles snr' - print*,'Example: wsprsim "K1ABC FN42 30" 50 0.0 0.1 1.0 1 10 -33' - go to 999 - endif - call getarg(1,msg) !Message to be transmitted - call getarg(2,arg) - read(arg,*) f0 !Freq relative to WSPR-band center (Hz) - 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,*) nwav !1 for *.wav file, 0 for *.c2 file - call getarg(7,arg) - read(arg,*) nfiles !Number of files - call getarg(8,arg) - read(arg,*) snrdb !SNR_2500 - - twopi=8.0*atan(1.0) - fs=12000.0/NDOWN - dt=1.0/fs - tt=NSPS*dt - baud=12000.0/8192.0 - - txt=NZ*dt !Transmission length (s) - bandwidth_ratio=2500.0/(fs/2.0) - sig=sqrt(bandwidth_ratio) * 10.0**(0.05*snrdb) - if(snrdb.gt.90.0) sig=1.0 - txt=NN*NSPS0/12000.0 - - call genwspr(msg,msgsent,itone) !Encode the message, get itone - - write(*,1000) f0,xdt,txt,snrdb,fspread,delay,nfiles,msgsent -1000 format('f0:',f9.3,' DT:',f6.2,' txt:',f6.1,' SNR:',f6.1, & - ' fspread:',f6.1,' delay:',f6.1,' nfiles:',i3,2x,a22) -! write(*,*) "Channel symbols: " -! write(*,'(162i2)') itone - - h=1.0 - phi=0.0 - c0=0. - k=-1 + nint(xdt/dt) - do j=1,NN - dphi=-twopi*(f0+h*(itone(j)-1.5)*baud)*dt - do i=1,NSPS - k=k+1 - phi=mod(phi+dphi,twopi) - if(k.ge.0 .and. k.lt.NMAX/NDOWN) c0(k)=cmplx(cos(phi),sin(phi)) - enddo - enddo - call sgran() - do ifile=1,nfiles - c=c0 - if(nwav.eq.0) then - if( fspread .ne. 0.0 .or. delay .ne. 0.0 ) then - call watterson(c,NMAX/NDOWN,NN*NSPS,fs,delay,fspread) - endif - c=c*sig - if(snrdb.lt.90) then - do i=0,NMAX/NDOWN-1 !Add gaussian noise at specified SNR - xnoise=gran() - ynoise=gran() - c(i)=c(i) + cmplx(xnoise,ynoise) - enddo - endif - write(fname14,1100) ifile -1100 format('000000_',i4.4,'.c2') - open(10,file=fname14,status='unknown',access='stream') - fMHz=10.1387d0 - nmin=2 - write(10) fname14,nmin,fMHz,c !Save to *.c2 file - close(10) - write(*,1108) ifile,xdt,f0,snrdb,fname14 -1108 format(i4,f7.2,f8.2,f7.1,2x,a14) - else - freq=1500.0+f0 - call wspr_wav(baud,xdt,h,freq,itone,snrdb,iwave) - hwav=default_header(12000,NMAX) - write(fname15,1102) ifile -1102 format('000000_',i4.4,'.wav') - open(10,file=fname15,status='unknown',access='stream') - write(10) hwav,iwave !Save to *.wav file - close(10) - write(*,1110) ifile,xdt,f0,snrdb,fname15 -1110 format(i4,f7.2,f8.2,f7.1,2x,a15) - endif - enddo - -999 end program wsprsim